From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/tbtables/README | 11 + pkg/tbtables/Revisions | 16 + pkg/tbtables/cfitsio/Licence.txt | 46 + pkg/tbtables/cfitsio/Makefile.in | 145 + pkg/tbtables/cfitsio/README | 151 + pkg/tbtables/cfitsio/README.MacOS | 31 + pkg/tbtables/cfitsio/buffers.c | 1448 ++++ pkg/tbtables/cfitsio/cfileio.c | 5572 ++++++++++++ pkg/tbtables/cfitsio/cfitsio.doc | 8406 ++++++++++++++++++ pkg/tbtables/cfitsio/cfitsio.ps | 12896 ++++++++++++++++++++++++++++ pkg/tbtables/cfitsio/cfitsio.tex | 9422 ++++++++++++++++++++ pkg/tbtables/cfitsio/cfitsio.toc | 118 + pkg/tbtables/cfitsio/cfitsio_mac.sit.hqx | 1 + pkg/tbtables/cfitsio/cfortran.doc | 2051 +++++ pkg/tbtables/cfitsio/cfortran.h | 2397 ++++++ pkg/tbtables/cfitsio/changes.txt | 2521 ++++++ pkg/tbtables/cfitsio/checksum.c | 508 ++ pkg/tbtables/cfitsio/compress.c | 155 + pkg/tbtables/cfitsio/compress.h | 212 + pkg/tbtables/cfitsio/configure | 1886 ++++ pkg/tbtables/cfitsio/configure.in | 352 + pkg/tbtables/cfitsio/cookbook.c | 571 ++ pkg/tbtables/cfitsio/cookbook.f | 772 ++ pkg/tbtables/cfitsio/drvrfile.c | 730 ++ pkg/tbtables/cfitsio/drvrmem.c | 1163 +++ pkg/tbtables/cfitsio/drvrnet.c | 2587 ++++++ pkg/tbtables/cfitsio/drvrsmem.c | 953 ++ pkg/tbtables/cfitsio/drvrsmem.h | 179 + pkg/tbtables/cfitsio/editcol.c | 2068 +++++ pkg/tbtables/cfitsio/edithdu.c | 793 ++ pkg/tbtables/cfitsio/eval.l | 512 ++ pkg/tbtables/cfitsio/eval.y | 5227 +++++++++++ pkg/tbtables/cfitsio/eval_defs.h | 153 + pkg/tbtables/cfitsio/eval_f.c | 2293 +++++ pkg/tbtables/cfitsio/eval_l.c | 2219 +++++ pkg/tbtables/cfitsio/eval_tab.h | 41 + pkg/tbtables/cfitsio/eval_y.c | 6686 ++++++++++++++ pkg/tbtables/cfitsio/f77.inc | 31 + pkg/tbtables/cfitsio/f77_wrap.h | 278 + pkg/tbtables/cfitsio/f77_wrap1.c | 960 +++ pkg/tbtables/cfitsio/f77_wrap2.c | 1081 +++ pkg/tbtables/cfitsio/fitscopy.c | 64 + pkg/tbtables/cfitsio/fitscore.c | 7007 +++++++++++++++ pkg/tbtables/cfitsio/fitsio.doc | 6137 +++++++++++++ pkg/tbtables/cfitsio/fitsio.h | 1565 ++++ pkg/tbtables/cfitsio/fitsio.ps | 9852 +++++++++++++++++++++ pkg/tbtables/cfitsio/fitsio.tex | 7203 ++++++++++++++++ pkg/tbtables/cfitsio/fitsio.toc | 90 + pkg/tbtables/cfitsio/fitsio2.h | 1135 +++ pkg/tbtables/cfitsio/getcol.c | 919 ++ pkg/tbtables/cfitsio/getcolb.c | 2111 +++++ pkg/tbtables/cfitsio/getcold.c | 1768 ++++ pkg/tbtables/cfitsio/getcole.c | 1775 ++++ pkg/tbtables/cfitsio/getcoli.c | 2043 +++++ pkg/tbtables/cfitsio/getcolj.c | 3856 +++++++++ pkg/tbtables/cfitsio/getcolk.c | 2037 +++++ pkg/tbtables/cfitsio/getcoll.c | 612 ++ pkg/tbtables/cfitsio/getcols.c | 743 ++ pkg/tbtables/cfitsio/getcolsb.c | 2133 +++++ pkg/tbtables/cfitsio/getcolui.c | 2050 +++++ pkg/tbtables/cfitsio/getcoluj.c | 2044 +++++ pkg/tbtables/cfitsio/getcoluk.c | 2059 +++++ pkg/tbtables/cfitsio/getkey.c | 2544 ++++++ pkg/tbtables/cfitsio/group.c | 6418 ++++++++++++++ pkg/tbtables/cfitsio/group.h | 65 + pkg/tbtables/cfitsio/grparser.c | 1365 +++ pkg/tbtables/cfitsio/grparser.h | 185 + pkg/tbtables/cfitsio/histo.c | 1300 +++ pkg/tbtables/cfitsio/imcompress.c | 2997 +++++++ pkg/tbtables/cfitsio/iraffits.c | 1975 +++++ pkg/tbtables/cfitsio/iter_a.c | 147 + pkg/tbtables/cfitsio/iter_a.f | 224 + pkg/tbtables/cfitsio/iter_a.fit | 1111 +++ pkg/tbtables/cfitsio/iter_b.c | 114 + pkg/tbtables/cfitsio/iter_b.f | 193 + pkg/tbtables/cfitsio/iter_b.fit | Bin 0 -> 408960 bytes pkg/tbtables/cfitsio/iter_c.c | 171 + pkg/tbtables/cfitsio/iter_c.f | 347 + pkg/tbtables/cfitsio/iter_c.fit | 701 ++ pkg/tbtables/cfitsio/listhead.c | 62 + pkg/tbtables/cfitsio/longnam.h | 538 ++ pkg/tbtables/cfitsio/make_dfloat.com | 83 + pkg/tbtables/cfitsio/make_gfloat.com | 81 + pkg/tbtables/cfitsio/make_ieee.com | 80 + pkg/tbtables/cfitsio/makefile.bc | 496 ++ pkg/tbtables/cfitsio/makefile.os2 | 22 + pkg/tbtables/cfitsio/makefile.vcc | 691 ++ pkg/tbtables/cfitsio/makepc.bat | 69 + pkg/tbtables/cfitsio/mkpkg | 66 + pkg/tbtables/cfitsio/modkey.c | 1614 ++++ pkg/tbtables/cfitsio/pctype.h | 155 + pkg/tbtables/cfitsio/pliocomp.c | 331 + pkg/tbtables/cfitsio/putcol.c | 1714 ++++ pkg/tbtables/cfitsio/putcolb.c | 1031 +++ pkg/tbtables/cfitsio/putcold.c | 1147 +++ pkg/tbtables/cfitsio/putcole.c | 1154 +++ pkg/tbtables/cfitsio/putcoli.c | 1039 +++ pkg/tbtables/cfitsio/putcolj.c | 2018 +++++ pkg/tbtables/cfitsio/putcolk.c | 1067 +++ pkg/tbtables/cfitsio/putcoll.c | 355 + pkg/tbtables/cfitsio/putcols.c | 284 + pkg/tbtables/cfitsio/putcolsb.c | 1030 +++ pkg/tbtables/cfitsio/putcolu.c | 587 ++ pkg/tbtables/cfitsio/putcolui.c | 1022 +++ pkg/tbtables/cfitsio/putcoluj.c | 1029 +++ pkg/tbtables/cfitsio/putcoluk.c | 1046 +++ pkg/tbtables/cfitsio/putkey.c | 2706 ++++++ pkg/tbtables/cfitsio/quantize.c | 613 ++ pkg/tbtables/cfitsio/quick.ps | 3850 +++++++++ pkg/tbtables/cfitsio/quick.tex | 2156 +++++ pkg/tbtables/cfitsio/quick.toc | 25 + pkg/tbtables/cfitsio/region.c | 919 ++ pkg/tbtables/cfitsio/region.h | 80 + pkg/tbtables/cfitsio/ricecomp.c | 510 ++ pkg/tbtables/cfitsio/ricecomp.h | 107 + pkg/tbtables/cfitsio/sample.tpl | 121 + pkg/tbtables/cfitsio/scalnull.c | 230 + pkg/tbtables/cfitsio/smem.c | 67 + pkg/tbtables/cfitsio/speed.c | 485 ++ pkg/tbtables/cfitsio/swapproc.c | 98 + pkg/tbtables/cfitsio/testf77.f | 2488 ++++++ pkg/tbtables/cfitsio/testf77.out | 746 ++ pkg/tbtables/cfitsio/testf77.std | Bin 0 -> 66240 bytes pkg/tbtables/cfitsio/testprog.c | 2588 ++++++ pkg/tbtables/cfitsio/testprog.out | 797 ++ pkg/tbtables/cfitsio/testprog.std | 48 + pkg/tbtables/cfitsio/testprog.tpt | 12 + pkg/tbtables/cfitsio/vmsieee.c | 130 + pkg/tbtables/cfitsio/vmsieeed.mar | 137 + pkg/tbtables/cfitsio/vmsieeer.mar | 106 + pkg/tbtables/cfitsio/wcssub.c | 327 + pkg/tbtables/cfitsio/wcsutil.c | 72 + pkg/tbtables/cfitsio/wcsutil.c.OLD | 786 ++ pkg/tbtables/cfitsio/winDumpExts.mak | 191 + pkg/tbtables/cfitsio/windumpexts.c | 503 ++ pkg/tbtables/doc/Notes | 46 + pkg/tbtables/doc/README | 10 + pkg/tbtables/doc/calls.doc | 190 + pkg/tbtables/doc/cfitsio.install | 57 + pkg/tbtables/doc/descrip.doc | 62 + pkg/tbtables/doc/ex.x | 109 + pkg/tbtables/doc/example.doc | 122 + pkg/tbtables/doc/fileformat.doc | 91 + pkg/tbtables/doc/tbtcpy.lis | 30 + pkg/tbtables/doc/text_tables.doc | 234 + pkg/tbtables/doc/versions.doc | 29 + pkg/tbtables/fitsio/README | 11 + pkg/tbtables/fitsio/fitsspp.com | 23 + pkg/tbtables/fitsio/fitsspp.x | 831 ++ pkg/tbtables/fitsio/fitssppb/README | 14 + pkg/tbtables/fitsio/fitssppb/fitsio.h | 15 + pkg/tbtables/fitsio/fitssppb/fsadef.x | 24 + pkg/tbtables/fitsio/fitssppb/fsarch.x | 9 + pkg/tbtables/fitsio/fitssppb/fsasfm.x | 15 + pkg/tbtables/fitsio/fitssppb/fsbdef.x | 23 + pkg/tbtables/fitsio/fitssppb/fsbnfm.x | 21 + pkg/tbtables/fitsio/fitssppb/fsclos.x | 13 + pkg/tbtables/fitsio/fitssppb/fscmps.x | 18 + pkg/tbtables/fitsio/fitssppb/fscmsg.x | 11 + pkg/tbtables/fitsio/fitssppb/fscopy.x | 17 + pkg/tbtables/fitsio/fitssppb/fscpdt.x | 15 + pkg/tbtables/fitsio/fitssppb/fscrhd.x | 15 + pkg/tbtables/fitsio/fitssppb/fsdcol.x | 14 + pkg/tbtables/fitsio/fitssppb/fsddef.x | 16 + pkg/tbtables/fitsio/fitssppb/fsdelt.x | 13 + pkg/tbtables/fitsio/fitssppb/fsdhdu.x | 14 + pkg/tbtables/fitsio/fitssppb/fsdkey.x | 17 + pkg/tbtables/fitsio/fitssppb/fsdrec.x | 14 + pkg/tbtables/fitsio/fitssppb/fsdrow.x | 15 + pkg/tbtables/fitsio/fitssppb/fsdsum.x | 14 + pkg/tbtables/fitsio/fitssppb/fsdtyp.x | 26 + pkg/tbtables/fitsio/fitssppb/fsesum.x | 14 + pkg/tbtables/fitsio/fitssppb/fsfiou.x | 13 + pkg/tbtables/fitsio/fitssppb/fsg2db.x | 23 + pkg/tbtables/fitsio/fitssppb/fsg2dd.x | 23 + pkg/tbtables/fitsio/fitssppb/fsg2de.x | 23 + pkg/tbtables/fitsio/fitssppb/fsg2di.x | 23 + pkg/tbtables/fitsio/fitssppb/fsg2dj.x | 23 + pkg/tbtables/fitsio/fitssppb/fsg3db.x | 27 + pkg/tbtables/fitsio/fitssppb/fsg3dd.x | 27 + pkg/tbtables/fitsio/fitssppb/fsg3de.x | 27 + pkg/tbtables/fitsio/fitssppb/fsg3di.x | 27 + pkg/tbtables/fitsio/fitssppb/fsg3dj.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgabc.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgacl.x | 33 + pkg/tbtables/fitsio/fitssppb/fsgbcl.x | 32 + pkg/tbtables/fitsio/fitssppb/fsgcfb.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcfc.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcfd.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcfe.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcfi.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcfj.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcfl.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgcfm.x | 26 + pkg/tbtables/fitsio/fitssppb/fsgcfs.x | 38 + pkg/tbtables/fitsio/fitssppb/fsgcks.x | 13 + pkg/tbtables/fitsio/fitssppb/fsgcl.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgcnn.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgcno.x | 20 + pkg/tbtables/fitsio/fitssppb/fsgcrd.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgcvb.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcvc.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcvd.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcve.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcvi.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcvj.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgcvm.x | 26 + pkg/tbtables/fitsio/fitssppb/fsgcvs.x | 41 + pkg/tbtables/fitsio/fitssppb/fsgcx.x | 23 + pkg/tbtables/fitsio/fitssppb/fsgcxd.x | 19 + pkg/tbtables/fitsio/fitssppb/fsgcxi.x | 19 + pkg/tbtables/fitsio/fitssppb/fsgcxj.x | 19 + pkg/tbtables/fitsio/fitssppb/fsgdes.x | 19 + pkg/tbtables/fitsio/fitssppb/fsgerr.x | 16 + pkg/tbtables/fitsio/fitssppb/fsggpb.x | 20 + pkg/tbtables/fitsio/fitssppb/fsggpd.x | 20 + pkg/tbtables/fitsio/fitssppb/fsggpe.x | 20 + pkg/tbtables/fitsio/fitssppb/fsggpi.x | 20 + pkg/tbtables/fitsio/fitssppb/fsggpj.x | 20 + pkg/tbtables/fitsio/fitssppb/fsghad.x | 14 + pkg/tbtables/fitsio/fitssppb/fsghbn.x | 38 + pkg/tbtables/fitsio/fitssppb/fsghdn.x | 14 + pkg/tbtables/fitsio/fitssppb/fsghpr.x | 23 + pkg/tbtables/fitsio/fitssppb/fsghps.x | 15 + pkg/tbtables/fitsio/fitssppb/fsghsp.x | 16 + pkg/tbtables/fitsio/fitssppb/fsghtb.x | 40 + pkg/tbtables/fitsio/fitssppb/fsgics.x | 16 + pkg/tbtables/fitsio/fitssppb/fsgiou.x | 13 + pkg/tbtables/fitsio/fitssppb/fsgkey.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgknd.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgkne.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgknj.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgknl.x | 21 + pkg/tbtables/fitsio/fitssppb/fsgkns.x | 49 + pkg/tbtables/fitsio/fitssppb/fsgkyd.x | 22 + pkg/tbtables/fitsio/fitssppb/fsgkye.x | 22 + pkg/tbtables/fitsio/fitssppb/fsgkyj.x | 22 + pkg/tbtables/fitsio/fitssppb/fsgkyl.x | 22 + pkg/tbtables/fitsio/fitssppb/fsgkyn.x | 26 + pkg/tbtables/fitsio/fitssppb/fsgkys.x | 25 + pkg/tbtables/fitsio/fitssppb/fsgkyt.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgmsg.x | 15 + pkg/tbtables/fitsio/fitssppb/fsgpfb.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpfd.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpfe.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpfi.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpfj.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpvb.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpvd.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpve.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpvi.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgpvj.x | 27 + pkg/tbtables/fitsio/fitssppb/fsgrec.x | 20 + pkg/tbtables/fitsio/fitssppb/fsgrsz.x | 35 + pkg/tbtables/fitsio/fitssppb/fsgsdt.x | 14 + pkg/tbtables/fitsio/fitssppb/fsgsfb.x | 23 + pkg/tbtables/fitsio/fitssppb/fsgsfd.x | 23 + pkg/tbtables/fitsio/fitssppb/fsgsfe.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgsfi.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgsfj.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgsvb.x | 23 + pkg/tbtables/fitsio/fitssppb/fsgsvd.x | 23 + pkg/tbtables/fitsio/fitssppb/fsgsve.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgsvi.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgsvj.x | 24 + pkg/tbtables/fitsio/fitssppb/fsgtbb.x | 19 + pkg/tbtables/fitsio/fitssppb/fsgtbs.x | 38 + pkg/tbtables/fitsio/fitssppb/fsgtcl.x | 12 + pkg/tbtables/fitsio/fitssppb/fsgtcs.x | 18 + pkg/tbtables/fitsio/fitssppb/fsgtdm.x | 17 + pkg/tbtables/fitsio/fitssppb/fsgthd.x | 23 + pkg/tbtables/fitsio/fitssppb/fshdef.x | 16 + pkg/tbtables/fitsio/fitssppb/fsibin.x | 35 + pkg/tbtables/fitsio/fitssppb/fsicol.x | 21 + pkg/tbtables/fitsio/fitssppb/fsiimg.x | 16 + pkg/tbtables/fitsio/fitssppb/fsikyd.x | 25 + pkg/tbtables/fitsio/fitssppb/fsikye.x | 22 + pkg/tbtables/fitsio/fitssppb/fsikyf.x | 22 + pkg/tbtables/fitsio/fitssppb/fsikyg.x | 22 + pkg/tbtables/fitsio/fitssppb/fsikyj.x | 21 + pkg/tbtables/fitsio/fitssppb/fsikyl.x | 21 + pkg/tbtables/fitsio/fitssppb/fsikys.x | 23 + pkg/tbtables/fitsio/fitssppb/fsinit.x | 18 + pkg/tbtables/fitsio/fitssppb/fsirec.x | 18 + pkg/tbtables/fitsio/fitssppb/fsirow.x | 15 + pkg/tbtables/fitsio/fitssppb/fsitab.x | 36 + pkg/tbtables/fitsio/fitssppb/fskeyn.x | 22 + pkg/tbtables/fitsio/fitssppb/fsmahd.x | 17 + pkg/tbtables/fitsio/fitssppb/fsmcom.x | 20 + pkg/tbtables/fitsio/fitssppb/fsmcrd.x | 22 + pkg/tbtables/fitsio/fitssppb/fsmkyd.x | 25 + pkg/tbtables/fitsio/fitssppb/fsmkye.x | 22 + pkg/tbtables/fitsio/fitssppb/fsmkyf.x | 22 + pkg/tbtables/fitsio/fitssppb/fsmkyg.x | 22 + pkg/tbtables/fitsio/fitssppb/fsmkyj.x | 21 + pkg/tbtables/fitsio/fitssppb/fsmkyl.x | 21 + pkg/tbtables/fitsio/fitssppb/fsmkys.x | 23 + pkg/tbtables/fitsio/fitssppb/fsmnam.x | 20 + pkg/tbtables/fitsio/fitssppb/fsmrec.x | 19 + pkg/tbtables/fitsio/fitssppb/fsmrhd.x | 17 + pkg/tbtables/fitsio/fitssppb/fsnkey.x | 22 + pkg/tbtables/fitsio/fitssppb/fsopen.x | 19 + pkg/tbtables/fitsio/fitssppb/fsp2db.x | 21 + pkg/tbtables/fitsio/fitssppb/fsp2dd.x | 21 + pkg/tbtables/fitsio/fitssppb/fsp2de.x | 21 + pkg/tbtables/fitsio/fitssppb/fsp2di.x | 21 + pkg/tbtables/fitsio/fitssppb/fsp2dj.x | 21 + pkg/tbtables/fitsio/fitssppb/fsp3db.x | 23 + pkg/tbtables/fitsio/fitssppb/fsp3dd.x | 23 + pkg/tbtables/fitsio/fitssppb/fsp3de.x | 23 + pkg/tbtables/fitsio/fitssppb/fsp3di.x | 23 + pkg/tbtables/fitsio/fitssppb/fsp3dj.x | 23 + pkg/tbtables/fitsio/fitssppb/fspcks.x | 11 + pkg/tbtables/fitsio/fitssppb/fspclb.x | 19 + pkg/tbtables/fitsio/fitssppb/fspclc.x | 21 + pkg/tbtables/fitsio/fitssppb/fspcld.x | 19 + pkg/tbtables/fitsio/fitssppb/fspcle.x | 19 + pkg/tbtables/fitsio/fitssppb/fspcli.x | 19 + pkg/tbtables/fitsio/fitssppb/fspclj.x | 19 + pkg/tbtables/fitsio/fitssppb/fspcll.x | 20 + pkg/tbtables/fitsio/fitssppb/fspclm.x | 21 + pkg/tbtables/fitsio/fitssppb/fspcls.x | 29 + pkg/tbtables/fitsio/fitssppb/fspclu.x | 17 + pkg/tbtables/fitsio/fitssppb/fspclx.x | 23 + pkg/tbtables/fitsio/fitssppb/fspcnb.x | 20 + pkg/tbtables/fitsio/fitssppb/fspcnd.x | 20 + pkg/tbtables/fitsio/fitssppb/fspcne.x | 20 + pkg/tbtables/fitsio/fitssppb/fspcni.x | 20 + pkg/tbtables/fitsio/fitssppb/fspcnj.x | 20 + pkg/tbtables/fitsio/fitssppb/fspcom.x | 17 + pkg/tbtables/fitsio/fitssppb/fspdat.x | 13 + pkg/tbtables/fitsio/fitssppb/fspdef.x | 19 + pkg/tbtables/fitsio/fitssppb/fspdes.x | 19 + pkg/tbtables/fitsio/fitssppb/fspgpb.x | 20 + pkg/tbtables/fitsio/fitssppb/fspgpd.x | 20 + pkg/tbtables/fitsio/fitssppb/fspgpe.x | 20 + pkg/tbtables/fitsio/fitssppb/fspgpi.x | 20 + pkg/tbtables/fitsio/fitssppb/fspgpj.x | 20 + pkg/tbtables/fitsio/fitssppb/fsphbn.x | 35 + pkg/tbtables/fitsio/fitssppb/fsphis.x | 17 + pkg/tbtables/fitsio/fitssppb/fsphpr.x | 22 + pkg/tbtables/fitsio/fitssppb/fsphtb.x | 36 + pkg/tbtables/fitsio/fitssppb/fspkls.x | 23 + pkg/tbtables/fitsio/fitssppb/fspknd.x | 27 + pkg/tbtables/fitsio/fitssppb/fspkne.x | 27 + pkg/tbtables/fitsio/fitssppb/fspknf.x | 27 + pkg/tbtables/fitsio/fitssppb/fspkng.x | 27 + pkg/tbtables/fitsio/fitssppb/fspknj.x | 26 + pkg/tbtables/fitsio/fitssppb/fspknl.x | 26 + pkg/tbtables/fitsio/fitssppb/fspkns.x | 34 + pkg/tbtables/fitsio/fitssppb/fspkyd.x | 25 + pkg/tbtables/fitsio/fitssppb/fspkye.x | 22 + pkg/tbtables/fitsio/fitssppb/fspkyf.x | 22 + pkg/tbtables/fitsio/fitssppb/fspkyg.x | 22 + pkg/tbtables/fitsio/fitssppb/fspkyj.x | 21 + pkg/tbtables/fitsio/fitssppb/fspkyl.x | 21 + pkg/tbtables/fitsio/fitssppb/fspkys.x | 23 + pkg/tbtables/fitsio/fitssppb/fspkyt.x | 24 + pkg/tbtables/fitsio/fitssppb/fsplsw.x | 13 + pkg/tbtables/fitsio/fitssppb/fspmsg.x | 15 + pkg/tbtables/fitsio/fitssppb/fspnul.x | 16 + pkg/tbtables/fitsio/fitssppb/fsppnb.x | 21 + pkg/tbtables/fitsio/fitssppb/fsppnd.x | 21 + pkg/tbtables/fitsio/fitssppb/fsppne.x | 21 + pkg/tbtables/fitsio/fitssppb/fsppni.x | 21 + pkg/tbtables/fitsio/fitssppb/fsppnj.x | 21 + pkg/tbtables/fitsio/fitssppb/fspprb.x | 20 + pkg/tbtables/fitsio/fitssppb/fspprd.x | 20 + pkg/tbtables/fitsio/fitssppb/fsppre.x | 20 + pkg/tbtables/fitsio/fitssppb/fsppri.x | 20 + pkg/tbtables/fitsio/fitssppb/fspprj.x | 20 + pkg/tbtables/fitsio/fitssppb/fsppru.x | 16 + pkg/tbtables/fitsio/fitssppb/fsprec.x | 17 + pkg/tbtables/fitsio/fitssppb/fspscl.x | 17 + pkg/tbtables/fitsio/fitssppb/fspssb.x | 24 + pkg/tbtables/fitsio/fitssppb/fspssd.x | 24 + pkg/tbtables/fitsio/fitssppb/fspsse.x | 24 + pkg/tbtables/fitsio/fitssppb/fspssi.x | 24 + pkg/tbtables/fitsio/fitssppb/fspssj.x | 24 + pkg/tbtables/fitsio/fitssppb/fspsvc.x | 23 + pkg/tbtables/fitsio/fitssppb/fsptbb.x | 19 + pkg/tbtables/fitsio/fitssppb/fsptbs.x | 38 + pkg/tbtables/fitsio/fitssppb/fsptdm.x | 16 + pkg/tbtables/fitsio/fitssppb/fspthp.x | 18 + pkg/tbtables/fitsio/fitssppb/fsrdef.x | 15 + pkg/tbtables/fitsio/fitssppb/fssnul.x | 19 + pkg/tbtables/fitsio/fitssppb/fstkey.x | 17 + pkg/tbtables/fitsio/fitssppb/fstnul.x | 16 + pkg/tbtables/fitsio/fitssppb/fstscl.x | 17 + pkg/tbtables/fitsio/fitssppb/fsucks.x | 11 + pkg/tbtables/fitsio/fitssppb/fsucrd.x | 21 + pkg/tbtables/fitsio/fitssppb/fsukyd.x | 25 + pkg/tbtables/fitsio/fitssppb/fsukye.x | 22 + pkg/tbtables/fitsio/fitssppb/fsukyf.x | 22 + pkg/tbtables/fitsio/fitssppb/fsukyg.x | 22 + pkg/tbtables/fitsio/fitssppb/fsukyj.x | 21 + pkg/tbtables/fitsio/fitssppb/fsukyl.x | 21 + pkg/tbtables/fitsio/fitssppb/fsukys.x | 23 + pkg/tbtables/fitsio/fitssppb/fsvcks.x | 13 + pkg/tbtables/fitsio/fitssppb/fsvers.x | 14 + pkg/tbtables/fitsio/fitssppb/fswldp.x | 17 + pkg/tbtables/fitsio/fitssppb/fsxypx.x | 17 + pkg/tbtables/fitsio/fitssppb/mkpkg | 262 + pkg/tbtables/fitsio/ftadef.f | 143 + pkg/tbtables/fitsio/ftaini.f | 183 + pkg/tbtables/fitsio/ftarch.f | 40 + pkg/tbtables/fitsio/ftas2c.f | 52 + pkg/tbtables/fitsio/ftasfm.f | 143 + pkg/tbtables/fitsio/ftbdef.f | 121 + pkg/tbtables/fitsio/ftbini.f | 181 + pkg/tbtables/fitsio/ftbnfm.f | 137 + pkg/tbtables/fitsio/ftc2as.f | 54 + pkg/tbtables/fitsio/ftc2d.f | 38 + pkg/tbtables/fitsio/ftc2dd.f | 37 + pkg/tbtables/fitsio/ftc2i.f | 37 + pkg/tbtables/fitsio/ftc2ii.f | 37 + pkg/tbtables/fitsio/ftc2l.f | 26 + pkg/tbtables/fitsio/ftc2ll.f | 18 + pkg/tbtables/fitsio/ftc2r.f | 40 + pkg/tbtables/fitsio/ftc2rr.f | 39 + pkg/tbtables/fitsio/ftc2s.f | 65 + pkg/tbtables/fitsio/ftc2x.f | 37 + pkg/tbtables/fitsio/ftcdel.f | 136 + pkg/tbtables/fitsio/ftcdfl.f | 80 + pkg/tbtables/fitsio/ftchdu.f | 58 + pkg/tbtables/fitsio/ftchfl.f | 72 + pkg/tbtables/fitsio/ftcins.f | 173 + pkg/tbtables/fitsio/ftclos.f | 21 + pkg/tbtables/fitsio/ftcmps.f | 104 + pkg/tbtables/fitsio/ftcmsg.f | 6 + pkg/tbtables/fitsio/ftcopy.f | 84 + pkg/tbtables/fitsio/ftcpdt.f | 58 + pkg/tbtables/fitsio/ftcrep.f | 29 + pkg/tbtables/fitsio/ftcrhd.f | 53 + pkg/tbtables/fitsio/ftcsum.f | 52 + pkg/tbtables/fitsio/ftd2e.f | 43 + pkg/tbtables/fitsio/ftd2f.f | 36 + pkg/tbtables/fitsio/ftdblk.f | 98 + pkg/tbtables/fitsio/ftdcol.f | 132 + pkg/tbtables/fitsio/ftddef.f | 54 + pkg/tbtables/fitsio/ftdelt.f | 39 + pkg/tbtables/fitsio/ftdhdu.f | 58 + pkg/tbtables/fitsio/ftdkey.f | 55 + pkg/tbtables/fitsio/ftdrec.f | 64 + pkg/tbtables/fitsio/ftdrow.f | 94 + pkg/tbtables/fitsio/ftdsum.f | 68 + pkg/tbtables/fitsio/ftdtyp.f | 35 + pkg/tbtables/fitsio/ftesum.f | 94 + pkg/tbtables/fitsio/ftfiou.f | 11 + pkg/tbtables/fitsio/ftfrcl.f | 91 + pkg/tbtables/fitsio/ftg2db.f | 36 + pkg/tbtables/fitsio/ftg2dd.f | 36 + pkg/tbtables/fitsio/ftg2de.f | 36 + pkg/tbtables/fitsio/ftg2di.f | 36 + pkg/tbtables/fitsio/ftg2dj.f | 36 + pkg/tbtables/fitsio/ftg3db.f | 39 + pkg/tbtables/fitsio/ftg3dd.f | 39 + pkg/tbtables/fitsio/ftg3de.f | 39 + pkg/tbtables/fitsio/ftg3di.f | 39 + pkg/tbtables/fitsio/ftg3dj.f | 39 + pkg/tbtables/fitsio/ftgabc.f | 49 + pkg/tbtables/fitsio/ftgacl.f | 70 + pkg/tbtables/fitsio/ftgatp.f | 169 + pkg/tbtables/fitsio/ftgbcl.f | 119 + pkg/tbtables/fitsio/ftgbit.f | 68 + pkg/tbtables/fitsio/ftgbnh.f | 12 + pkg/tbtables/fitsio/ftgbtp.f | 119 + pkg/tbtables/fitsio/ftgcfb.f | 33 + pkg/tbtables/fitsio/ftgcfc.f | 33 + pkg/tbtables/fitsio/ftgcfd.f | 33 + pkg/tbtables/fitsio/ftgcfe.f | 33 + pkg/tbtables/fitsio/ftgcfi.f | 33 + pkg/tbtables/fitsio/ftgcfj.f | 32 + pkg/tbtables/fitsio/ftgcfl.f | 150 + pkg/tbtables/fitsio/ftgcfm.f | 34 + pkg/tbtables/fitsio/ftgcfs.f | 34 + pkg/tbtables/fitsio/ftgcks.f | 54 + pkg/tbtables/fitsio/ftgcl.f | 184 + pkg/tbtables/fitsio/ftgclb.f | 380 + pkg/tbtables/fitsio/ftgclc.f | 238 + pkg/tbtables/fitsio/ftgcld.f | 382 + pkg/tbtables/fitsio/ftgcle.f | 382 + pkg/tbtables/fitsio/ftgcli.f | 382 + pkg/tbtables/fitsio/ftgclj.f | 384 + pkg/tbtables/fitsio/ftgclm.f | 239 + pkg/tbtables/fitsio/ftgcls.f | 207 + pkg/tbtables/fitsio/ftgcnn.f | 140 + pkg/tbtables/fitsio/ftgcno.f | 22 + pkg/tbtables/fitsio/ftgcrd.f | 76 + pkg/tbtables/fitsio/ftgcvb.f | 29 + pkg/tbtables/fitsio/ftgcvc.f | 28 + pkg/tbtables/fitsio/ftgcvd.f | 29 + pkg/tbtables/fitsio/ftgcve.f | 28 + pkg/tbtables/fitsio/ftgcvi.f | 28 + pkg/tbtables/fitsio/ftgcvj.f | 28 + pkg/tbtables/fitsio/ftgcvm.f | 29 + pkg/tbtables/fitsio/ftgcvs.f | 28 + pkg/tbtables/fitsio/ftgcx.f | 140 + pkg/tbtables/fitsio/ftgcxd.f | 78 + pkg/tbtables/fitsio/ftgcxi.f | 86 + pkg/tbtables/fitsio/ftgcxj.f | 88 + pkg/tbtables/fitsio/ftgdes.f | 63 + pkg/tbtables/fitsio/ftgerr.f | 173 + pkg/tbtables/fitsio/ftgext.f | 62 + pkg/tbtables/fitsio/ftggpb.f | 31 + pkg/tbtables/fitsio/ftggpd.f | 31 + pkg/tbtables/fitsio/ftggpe.f | 31 + pkg/tbtables/fitsio/ftggpi.f | 31 + pkg/tbtables/fitsio/ftggpj.f | 31 + pkg/tbtables/fitsio/ftghad.f | 30 + pkg/tbtables/fitsio/ftghbn.f | 59 + pkg/tbtables/fitsio/ftghdn.f | 26 + pkg/tbtables/fitsio/ftghpr.f | 28 + pkg/tbtables/fitsio/ftghps.f | 35 + pkg/tbtables/fitsio/ftghsp.f | 40 + pkg/tbtables/fitsio/ftghtb.f | 70 + pkg/tbtables/fitsio/ftgi1b.f | 26 + pkg/tbtables/fitsio/ftgics.f | 47 + pkg/tbtables/fitsio/ftgiou.f | 11 + pkg/tbtables/fitsio/ftgkey.f | 24 + pkg/tbtables/fitsio/ftgknd.f | 79 + pkg/tbtables/fitsio/ftgkne.f | 79 + pkg/tbtables/fitsio/ftgknj.f | 79 + pkg/tbtables/fitsio/ftgknl.f | 73 + pkg/tbtables/fitsio/ftgkns.f | 94 + pkg/tbtables/fitsio/ftgkyd.f | 26 + pkg/tbtables/fitsio/ftgkye.f | 26 + pkg/tbtables/fitsio/ftgkyj.f | 25 + pkg/tbtables/fitsio/ftgkyl.f | 25 + pkg/tbtables/fitsio/ftgkyn.f | 49 + pkg/tbtables/fitsio/ftgkys.f | 68 + pkg/tbtables/fitsio/ftgkyt.f | 53 + pkg/tbtables/fitsio/ftgmsg.f | 7 + pkg/tbtables/fitsio/ftgnst.f | 70 + pkg/tbtables/fitsio/ftgpfb.f | 42 + pkg/tbtables/fitsio/ftgpfd.f | 42 + pkg/tbtables/fitsio/ftgpfe.f | 42 + pkg/tbtables/fitsio/ftgpfi.f | 42 + pkg/tbtables/fitsio/ftgpfj.f | 42 + pkg/tbtables/fitsio/ftgphx.f | 281 + pkg/tbtables/fitsio/ftgprh.f | 14 + pkg/tbtables/fitsio/ftgpvb.f | 37 + pkg/tbtables/fitsio/ftgpvd.f | 37 + pkg/tbtables/fitsio/ftgpve.f | 37 + pkg/tbtables/fitsio/ftgpvi.f | 37 + pkg/tbtables/fitsio/ftgpvj.f | 37 + pkg/tbtables/fitsio/ftgrec.f | 71 + pkg/tbtables/fitsio/ftgsfb.f | 142 + pkg/tbtables/fitsio/ftgsfd.f | 142 + pkg/tbtables/fitsio/ftgsfe.f | 142 + pkg/tbtables/fitsio/ftgsfi.f | 142 + pkg/tbtables/fitsio/ftgsfj.f | 142 + pkg/tbtables/fitsio/ftgsvb.f | 143 + pkg/tbtables/fitsio/ftgsvd.f | 143 + pkg/tbtables/fitsio/ftgsve.f | 143 + pkg/tbtables/fitsio/ftgsvi.f | 143 + pkg/tbtables/fitsio/ftgsvj.f | 143 + pkg/tbtables/fitsio/ftgtbb.f | 64 + pkg/tbtables/fitsio/ftgtbc.f | 81 + pkg/tbtables/fitsio/ftgtbh.f | 12 + pkg/tbtables/fitsio/ftgtbn.f | 123 + pkg/tbtables/fitsio/ftgtbs.f | 71 + pkg/tbtables/fitsio/ftgtcl.f | 64 + pkg/tbtables/fitsio/ftgtcs.f | 53 + pkg/tbtables/fitsio/ftgtdm.f | 99 + pkg/tbtables/fitsio/ftgthd.f | 297 + pkg/tbtables/fitsio/ftgtkn.f | 64 + pkg/tbtables/fitsio/ftgttb.f | 127 + pkg/tbtables/fitsio/fthdef.f | 40 + pkg/tbtables/fitsio/fthpdn.f | 92 + pkg/tbtables/fitsio/fthpup.f | 92 + pkg/tbtables/fitsio/fti1i1.f | 129 + pkg/tbtables/fitsio/fti1i2.f | 140 + pkg/tbtables/fitsio/fti1i4.f | 141 + pkg/tbtables/fitsio/fti1r4.f | 104 + pkg/tbtables/fitsio/fti1r8.f | 104 + pkg/tbtables/fitsio/fti2c.f | 15 + pkg/tbtables/fitsio/fti2i1.f | 156 + pkg/tbtables/fitsio/fti2i2.f | 136 + pkg/tbtables/fitsio/fti2i4.f | 129 + pkg/tbtables/fitsio/fti2r4.f | 92 + pkg/tbtables/fitsio/fti2r8.f | 92 + pkg/tbtables/fitsio/fti4i1.f | 151 + pkg/tbtables/fitsio/fti4i2.f | 157 + pkg/tbtables/fitsio/fti4i4.f | 129 + pkg/tbtables/fitsio/fti4r4.f | 92 + pkg/tbtables/fitsio/fti4r8.f | 92 + pkg/tbtables/fitsio/ftibin.f | 108 + pkg/tbtables/fitsio/ftiblk.f | 189 + pkg/tbtables/fitsio/fticol.f | 154 + pkg/tbtables/fitsio/ftiimg.f | 87 + pkg/tbtables/fitsio/ftikyd.f | 34 + pkg/tbtables/fitsio/ftikye.f | 34 + pkg/tbtables/fitsio/ftikyf.f | 34 + pkg/tbtables/fitsio/ftikyg.f | 34 + pkg/tbtables/fitsio/ftikyj.f | 32 + pkg/tbtables/fitsio/ftikyl.f | 33 + pkg/tbtables/fitsio/ftikys.f | 71 + pkg/tbtables/fitsio/ftinit.f | 43 + pkg/tbtables/fitsio/ftirec.f | 72 + pkg/tbtables/fitsio/ftirow.f | 92 + pkg/tbtables/fitsio/ftitab.f | 108 + pkg/tbtables/fitsio/ftkeyn.f | 70 + pkg/tbtables/fitsio/ftkshf.f | 118 + pkg/tbtables/fitsio/ftl2c.f | 15 + pkg/tbtables/fitsio/ftmahd.f | 73 + pkg/tbtables/fitsio/ftmcom.f | 41 + pkg/tbtables/fitsio/ftmcrd.f | 35 + pkg/tbtables/fitsio/ftmkey.f | 28 + pkg/tbtables/fitsio/ftmkyd.f | 38 + pkg/tbtables/fitsio/ftmkye.f | 34 + pkg/tbtables/fitsio/ftmkyf.f | 34 + pkg/tbtables/fitsio/ftmkyg.f | 34 + pkg/tbtables/fitsio/ftmkyj.f | 32 + pkg/tbtables/fitsio/ftmkyl.f | 33 + pkg/tbtables/fitsio/ftmkys.f | 121 + pkg/tbtables/fitsio/ftmnam.f | 34 + pkg/tbtables/fitsio/ftmodr.f | 46 + pkg/tbtables/fitsio/ftmrec.f | 25 + pkg/tbtables/fitsio/ftmrhd.f | 39 + pkg/tbtables/fitsio/ftnkey.f | 70 + pkg/tbtables/fitsio/ftnulc.f | 78 + pkg/tbtables/fitsio/ftnulm.f | 78 + pkg/tbtables/fitsio/ftopen.f | 58 + pkg/tbtables/fitsio/ftp2db.f | 29 + pkg/tbtables/fitsio/ftp2dd.f | 29 + pkg/tbtables/fitsio/ftp2de.f | 29 + pkg/tbtables/fitsio/ftp2di.f | 29 + pkg/tbtables/fitsio/ftp2dj.f | 29 + pkg/tbtables/fitsio/ftp3db.f | 33 + pkg/tbtables/fitsio/ftp3dd.f | 33 + pkg/tbtables/fitsio/ftp3de.f | 33 + pkg/tbtables/fitsio/ftp3di.f | 33 + pkg/tbtables/fitsio/ftp3dj.f | 33 + pkg/tbtables/fitsio/ftpbit.f | 111 + pkg/tbtables/fitsio/ftpbnh.f | 12 + pkg/tbtables/fitsio/ftpcks.f | 170 + pkg/tbtables/fitsio/ftpclb.f | 318 + pkg/tbtables/fitsio/ftpclc.f | 188 + pkg/tbtables/fitsio/ftpcld.f | 320 + pkg/tbtables/fitsio/ftpcle.f | 317 + pkg/tbtables/fitsio/ftpcli.f | 316 + pkg/tbtables/fitsio/ftpclj.f | 320 + pkg/tbtables/fitsio/ftpcll.f | 162 + pkg/tbtables/fitsio/ftpclm.f | 186 + pkg/tbtables/fitsio/ftpcls.f | 196 + pkg/tbtables/fitsio/ftpclu.f | 279 + pkg/tbtables/fitsio/ftpclx.f | 189 + pkg/tbtables/fitsio/ftpcnb.f | 96 + pkg/tbtables/fitsio/ftpcnd.f | 96 + pkg/tbtables/fitsio/ftpcne.f | 96 + pkg/tbtables/fitsio/ftpcni.f | 96 + pkg/tbtables/fitsio/ftpcnj.f | 96 + pkg/tbtables/fitsio/ftpcom.f | 39 + pkg/tbtables/fitsio/ftpdat.f | 33 + pkg/tbtables/fitsio/ftpdef.f | 156 + pkg/tbtables/fitsio/ftpdes.f | 63 + pkg/tbtables/fitsio/ftpdfl.f | 94 + pkg/tbtables/fitsio/ftpgpb.f | 28 + pkg/tbtables/fitsio/ftpgpd.f | 27 + pkg/tbtables/fitsio/ftpgpe.f | 27 + pkg/tbtables/fitsio/ftpgpi.f | 27 + pkg/tbtables/fitsio/ftpgpj.f | 27 + pkg/tbtables/fitsio/ftphbn.f | 130 + pkg/tbtables/fitsio/ftphis.f | 39 + pkg/tbtables/fitsio/ftphpr.f | 122 + pkg/tbtables/fitsio/ftphtb.f | 110 + pkg/tbtables/fitsio/ftpi1b.f | 26 + pkg/tbtables/fitsio/ftpini.f | 167 + pkg/tbtables/fitsio/ftpkey.f | 28 + pkg/tbtables/fitsio/ftpkls.f | 103 + pkg/tbtables/fitsio/ftpknd.f | 45 + pkg/tbtables/fitsio/ftpkne.f | 45 + pkg/tbtables/fitsio/ftpknf.f | 45 + pkg/tbtables/fitsio/ftpkng.f | 45 + pkg/tbtables/fitsio/ftpknj.f | 43 + pkg/tbtables/fitsio/ftpknl.f | 44 + pkg/tbtables/fitsio/ftpkns.f | 42 + pkg/tbtables/fitsio/ftpkyd.f | 32 + pkg/tbtables/fitsio/ftpkye.f | 26 + pkg/tbtables/fitsio/ftpkyf.f | 26 + pkg/tbtables/fitsio/ftpkyg.f | 26 + pkg/tbtables/fitsio/ftpkyj.f | 24 + pkg/tbtables/fitsio/ftpkyl.f | 25 + pkg/tbtables/fitsio/ftpkys.f | 58 + pkg/tbtables/fitsio/ftpkyt.f | 41 + pkg/tbtables/fitsio/ftplsw.f | 39 + pkg/tbtables/fitsio/ftpmsg.f | 7 + pkg/tbtables/fitsio/ftpnul.f | 58 + pkg/tbtables/fitsio/ftppnb.f | 31 + pkg/tbtables/fitsio/ftppnd.f | 31 + pkg/tbtables/fitsio/ftppne.f | 31 + pkg/tbtables/fitsio/ftppni.f | 31 + pkg/tbtables/fitsio/ftppnj.f | 31 + pkg/tbtables/fitsio/ftpprb.f | 30 + pkg/tbtables/fitsio/ftpprd.f | 29 + pkg/tbtables/fitsio/ftppre.f | 29 + pkg/tbtables/fitsio/ftpprh.f | 12 + pkg/tbtables/fitsio/ftppri.f | 29 + pkg/tbtables/fitsio/ftpprj.f | 29 + pkg/tbtables/fitsio/ftppru.f | 24 + pkg/tbtables/fitsio/ftprec.f | 67 + pkg/tbtables/fitsio/ftprsv.f | 82 + pkg/tbtables/fitsio/ftpscl.f | 66 + pkg/tbtables/fitsio/ftpssb.f | 114 + pkg/tbtables/fitsio/ftpssd.f | 114 + pkg/tbtables/fitsio/ftpsse.f | 114 + pkg/tbtables/fitsio/ftpssi.f | 114 + pkg/tbtables/fitsio/ftpssj.f | 114 + pkg/tbtables/fitsio/ftpsvc.f | 117 + pkg/tbtables/fitsio/ftptbb.f | 64 + pkg/tbtables/fitsio/ftptbh.f | 12 + pkg/tbtables/fitsio/ftptbs.f | 64 + pkg/tbtables/fitsio/ftptdm.f | 60 + pkg/tbtables/fitsio/ftpthp.f | 46 + pkg/tbtables/fitsio/ftr2e.f | 36 + pkg/tbtables/fitsio/ftr2f.f | 34 + pkg/tbtables/fitsio/ftr4i1.f | 154 + pkg/tbtables/fitsio/ftr4i2.f | 161 + pkg/tbtables/fitsio/ftr4i4.f | 165 + pkg/tbtables/fitsio/ftr4r4.f | 93 + pkg/tbtables/fitsio/ftr4r8.f | 93 + pkg/tbtables/fitsio/ftr8i1.f | 154 + pkg/tbtables/fitsio/ftr8i2.f | 159 + pkg/tbtables/fitsio/ftr8i4.f | 160 + pkg/tbtables/fitsio/ftr8r4.f | 93 + pkg/tbtables/fitsio/ftr8r8.f | 93 + pkg/tbtables/fitsio/ftrdef.f | 41 + pkg/tbtables/fitsio/ftrhdu.f | 108 + pkg/tbtables/fitsio/ftrsnm.f | 15 + pkg/tbtables/fitsio/ftrwdn.f | 183 + pkg/tbtables/fitsio/ftrwup.f | 136 + pkg/tbtables/fitsio/fts2c.f | 57 + pkg/tbtables/fitsio/ftsdnn.f | 15 + pkg/tbtables/fitsio/ftsnul.f | 59 + pkg/tbtables/fitsio/ftsrnn.f | 14 + pkg/tbtables/fitsio/fttbit.f | 18 + pkg/tbtables/fitsio/fttdnn.f | 96 + pkg/tbtables/fitsio/fttkey.f | 50 + pkg/tbtables/fitsio/fttkyn.f | 65 + pkg/tbtables/fitsio/fttnul.f | 56 + pkg/tbtables/fitsio/fttrec.f | 44 + pkg/tbtables/fitsio/fttrnn.f | 65 + pkg/tbtables/fitsio/fttscl.f | 65 + pkg/tbtables/fitsio/ftucks.f | 124 + pkg/tbtables/fitsio/ftucrd.f | 28 + pkg/tbtables/fitsio/ftukyd.f | 31 + pkg/tbtables/fitsio/ftukye.f | 31 + pkg/tbtables/fitsio/ftukyf.f | 31 + pkg/tbtables/fitsio/ftukyg.f | 31 + pkg/tbtables/fitsio/ftukyj.f | 29 + pkg/tbtables/fitsio/ftukyl.f | 30 + pkg/tbtables/fitsio/ftukys.f | 30 + pkg/tbtables/fitsio/ftuscc.f | 32 + pkg/tbtables/fitsio/ftuscm.f | 32 + pkg/tbtables/fitsio/ftvcks.f | 83 + pkg/tbtables/fitsio/ftvers.f | 72 + pkg/tbtables/fitsio/ftwend.f | 67 + pkg/tbtables/fitsio/ftwldp.f | 289 + pkg/tbtables/fitsio/ftxiou.f | 37 + pkg/tbtables/fitsio/ftxmsg.f | 47 + pkg/tbtables/fitsio/ftxypx.f | 230 + pkg/tbtables/fitsio/mkpkg | 374 + pkg/tbtables/fitsio/unix/README | 15 + pkg/tbtables/fitsio/unix/ftgcbf.x | 17 + pkg/tbtables/fitsio/unix/ftpcbf.x | 20 + pkg/tbtables/fitsio/unix/mkpkg | 11 + pkg/tbtables/fitsio/vms/README | 15 + pkg/tbtables/fitsio/vms/ftgcbf.x | 20 + pkg/tbtables/fitsio/vms/ftpcbf.x | 18 + pkg/tbtables/fitsio/vms/mkpkg | 11 + pkg/tbtables/fitsio_spp.h | 20 + pkg/tbtables/mkpkg | 250 + pkg/tbtables/selector/generic/mkpkg | 16 + pkg/tbtables/selector/generic/tcsrdaryb.x | 116 + pkg/tbtables/selector/generic/tcsrdaryc.x | 117 + pkg/tbtables/selector/generic/tcsrdaryd.x | 116 + pkg/tbtables/selector/generic/tcsrdaryi.x | 116 + pkg/tbtables/selector/generic/tcsrdaryr.x | 116 + pkg/tbtables/selector/generic/tcsrdarys.x | 116 + pkg/tbtables/selector/mkpkg | 50 + pkg/tbtables/selector/omniread.x | 625 ++ pkg/tbtables/selector/rdselect.x | 152 + pkg/tbtables/selector/rst.x | 1067 +++ pkg/tbtables/selector/selrows.x | 30 + pkg/tbtables/selector/tbcga.x | 110 + pkg/tbtables/selector/tbcnel.x | 52 + pkg/tbtables/selector/tcs.h | 12 + pkg/tbtables/selector/tcsaddcol.x | 26 + pkg/tbtables/selector/tcsclose.x | 14 + pkg/tbtables/selector/tcscolumn.x | 12 + pkg/tbtables/selector/tcsintinfo.x | 14 + pkg/tbtables/selector/tcslinesize.x | 26 + pkg/tbtables/selector/tcsopen.x | 818 ++ pkg/tbtables/selector/tcsrdary.gx | 140 + pkg/tbtables/selector/tcsshape.x | 24 + pkg/tbtables/selector/tcstotsize.x | 28 + pkg/tbtables/selector/tcstxtinfo.x | 15 + pkg/tbtables/selector/trs.h | 55 + pkg/tbtables/selector/trsclose.x | 25 + pkg/tbtables/selector/trseval.x | 292 + pkg/tbtables/selector/trsgencode.x | 414 + pkg/tbtables/selector/trsopen.com | 15 + pkg/tbtables/selector/trsopen.x | 926 ++ pkg/tbtables/selector/trsopen.y | 601 ++ pkg/tbtables/selector/trsrows.x | 99 + pkg/tbtables/selector/trstree.x | 211 + pkg/tbtables/selector/trstrim.x | 54 + pkg/tbtables/selector/whatfile.h | 6 + pkg/tbtables/selector/whatfile.x | 63 + pkg/tbtables/tbagt.x | 238 + pkg/tbtables/tbapt.x | 214 + pkg/tbtables/tbbadf.x | 47 + pkg/tbtables/tbbaln.x | 71 + pkg/tbtables/tbbcmt.x | 69 + pkg/tbtables/tbbftp.x | 90 + pkg/tbtables/tbbnll.x | 162 + pkg/tbtables/tbbptf.x | 71 + pkg/tbtables/tbbtyp.x | 52 + pkg/tbtables/tbbwrd.x | 219 + pkg/tbtables/tbcadd.x | 120 + pkg/tbtables/tbcchg.x | 35 + pkg/tbtables/tbcdef.x | 162 + pkg/tbtables/tbcdef1.x | 36 + pkg/tbtables/tbcdes.x | 35 + pkg/tbtables/tbcfmt.x | 39 + pkg/tbtables/tbcfnd.x | 69 + pkg/tbtables/tbcfnd1.x | 25 + pkg/tbtables/tbcftl.x | 23 + pkg/tbtables/tbcgt.x | 272 + pkg/tbtables/tbciga.x | 95 + pkg/tbtables/tbcigi.x | 70 + pkg/tbtables/tbcigt.x | 32 + pkg/tbtables/tbcinf.x | 36 + pkg/tbtables/tbcnam.x | 33 + pkg/tbtables/tbcnit.x | 33 + pkg/tbtables/tbcnum.x | 35 + pkg/tbtables/tbcpt.x | 301 + pkg/tbtables/tbcrcd.x | 211 + pkg/tbtables/tbcscal.x | 75 + pkg/tbtables/tbctpe.x | 103 + pkg/tbtables/tbcwcd.x | 117 + pkg/tbtables/tbdsav.x | 76 + pkg/tbtables/tbegp.x | 123 + pkg/tbtables/tbegt.x | 489 ++ pkg/tbtables/tbeoff.x | 60 + pkg/tbtables/tbepp.x | 109 + pkg/tbtables/tbept.x | 504 ++ pkg/tbtables/tbeszt.x | 24 + pkg/tbtables/tbfag.x | 494 ++ pkg/tbtables/tbfanp.x | 161 + pkg/tbtables/tbfap.x | 557 ++ pkg/tbtables/tbfcal.x | 113 + pkg/tbtables/tbfchp.x | 27 + pkg/tbtables/tbfckn.x | 69 + pkg/tbtables/tbfclo.x | 28 + pkg/tbtables/tbfdef.x | 198 + pkg/tbtables/tbfdel.x | 31 + pkg/tbtables/tbferr.x | 38 + pkg/tbtables/tbffkw.x | 47 + pkg/tbtables/tbffmt.x | 58 + pkg/tbtables/tbffnd.x | 180 + pkg/tbtables/tbfgcm.x | 50 + pkg/tbtables/tbfgnp.x | 160 + pkg/tbtables/tbfhdl.x | 27 + pkg/tbtables/tbfhg.x | 241 + pkg/tbtables/tbfhp.x | 330 + pkg/tbtables/tbfhp_f.x | 334 + pkg/tbtables/tbfiga.x | 57 + pkg/tbtables/tbfnam.x | 53 + pkg/tbtables/tbfnew.x | 436 + pkg/tbtables/tbfnit.x | 53 + pkg/tbtables/tbfnll.x | 42 + pkg/tbtables/tbfopn.x | 127 + pkg/tbtables/tbfpcm.x | 27 + pkg/tbtables/tbfpnp.x | 146 + pkg/tbtables/tbfpri.x | 181 + pkg/tbtables/tbfptf.x | 95 + pkg/tbtables/tbfrcd.x | 262 + pkg/tbtables/tbfres.x | 58 + pkg/tbtables/tbfrsi.x | 70 + pkg/tbtables/tbfscal.x | 47 + pkg/tbtables/tbfsft.x | 84 + pkg/tbtables/tbfsiz.x | 50 + pkg/tbtables/tbftya.x | 94 + pkg/tbtables/tbftyb.x | 116 + pkg/tbtables/tbfudf.x | 33 + pkg/tbtables/tbfwcd.x | 38 + pkg/tbtables/tbfwer.x | 139 + pkg/tbtables/tbfwsi.x | 33 + pkg/tbtables/tbfxff.c | 795 ++ pkg/tbtables/tbhad.x | 232 + pkg/tbtables/tbhanp.x | 118 + pkg/tbtables/tbhcal.x | 140 + pkg/tbtables/tbhckn.x | 87 + pkg/tbtables/tbhdel.x | 70 + pkg/tbtables/tbhfcm.x | 56 + pkg/tbtables/tbhfkr.x | 58 + pkg/tbtables/tbhfkw.x | 46 + pkg/tbtables/tbhgcm.x | 75 + pkg/tbtables/tbhgnp.x | 115 + pkg/tbtables/tbhgt.x | 244 + pkg/tbtables/tbhisc.x | 35 + pkg/tbtables/tbhkeq.x | 30 + pkg/tbtables/tbhpcm.x | 117 + pkg/tbtables/tbhpnp.x | 179 + pkg/tbtables/tbhpt.x | 268 + pkg/tbtables/tbhrpr.x | 140 + pkg/tbtables/tbhwpr.x | 103 + pkg/tbtables/tblerr.h | 31 + pkg/tbtables/tblfits.h | 25 + pkg/tbtables/tbltext.h | 13 + pkg/tbtables/tbnopen.x | 241 + pkg/tbtables/tbnparse.x | 397 + pkg/tbtables/tbparse.x | 67 + pkg/tbtables/tbpset.x | 109 + pkg/tbtables/tbpsta.x | 175 + pkg/tbtables/tbrchg.x | 25 + pkg/tbtables/tbrcmp.x | 288 + pkg/tbtables/tbrcpy.x | 125 + pkg/tbtables/tbrcsc.x | 173 + pkg/tbtables/tbrdel.x | 77 + pkg/tbtables/tbrgt.x | 267 + pkg/tbtables/tbrnll.x | 67 + pkg/tbtables/tbrpt.x | 248 + pkg/tbtables/tbrsft.x | 51 + pkg/tbtables/tbrswp.x | 138 + pkg/tbtables/tbrudf.x | 66 + pkg/tbtables/tbscol.x | 32 + pkg/tbtables/tbsirow.x | 36 + pkg/tbtables/tbsopn.x | 58 + pkg/tbtables/tbsrow.x | 61 + pkg/tbtables/tbswer.x | 69 + pkg/tbtables/tbswer1.x | 53 + pkg/tbtables/tbtables.h | 200 + pkg/tbtables/tbtacc.x | 40 + pkg/tbtables/tbtbod.x | 28 + pkg/tbtables/tbtchs.x | 176 + pkg/tbtables/tbtclo.x | 91 + pkg/tbtables/tbtcpy.x | 224 + pkg/tbtables/tbtcre.x | 66 + pkg/tbtables/tbtdel.x | 111 + pkg/tbtables/tbtext.x | 100 + pkg/tbtables/tbtflu.x | 34 + pkg/tbtables/tbtfst.x | 45 + pkg/tbtables/tbtnam.x | 51 + pkg/tbtables/tbtopn.x | 280 + pkg/tbtables/tbtopns.x | 298 + pkg/tbtables/tbtren.x | 28 + pkg/tbtables/tbtrsi.x | 74 + pkg/tbtables/tbtscd.x | 58 + pkg/tbtables/tbtscu.x | 63 + pkg/tbtables/tbtsrt.x | 70 + pkg/tbtables/tbttyp.x | 262 + pkg/tbtables/tbtwer.x | 41 + pkg/tbtables/tbtwsi.x | 55 + pkg/tbtables/tbuopn.x | 103 + pkg/tbtables/tbxag.x | 649 ++ pkg/tbtables/tbxap.x | 807 ++ pkg/tbtables/tbxcg.x | 723 ++ pkg/tbtables/tbxcp.x | 621 ++ pkg/tbtables/tbxncn.x | 31 + pkg/tbtables/tbxnew.x | 71 + pkg/tbtables/tbxnll.x | 34 + pkg/tbtables/tbxoff.x | 19 + pkg/tbtables/tbxrg.x | 601 ++ pkg/tbtables/tbxrp.x | 964 +++ pkg/tbtables/tbxscp.x | 77 + pkg/tbtables/tbxsft.x | 76 + pkg/tbtables/tbxsiz.x | 87 + pkg/tbtables/tbxudf.x | 37 + pkg/tbtables/tbxwer.x | 37 + pkg/tbtables/tbxwnc.x | 37 + pkg/tbtables/tbycg.x | 735 ++ pkg/tbtables/tbycp.x | 594 ++ pkg/tbtables/tbyncn.x | 24 + pkg/tbtables/tbynew.x | 81 + pkg/tbtables/tbynll.x | 39 + pkg/tbtables/tbyoff.x | 20 + pkg/tbtables/tbyrg.x | 569 ++ pkg/tbtables/tbyrp.x | 455 + pkg/tbtables/tbyscn.x | 86 + pkg/tbtables/tbyscp.x | 91 + pkg/tbtables/tbysft.x | 211 + pkg/tbtables/tbysiz.x | 93 + pkg/tbtables/tbyudf.x | 71 + pkg/tbtables/tbywer.x | 32 + pkg/tbtables/tbywnc.x | 31 + pkg/tbtables/tbzadd.x | 61 + pkg/tbtables/tbzcg.x | 163 + pkg/tbtables/tbzclo.x | 59 + pkg/tbtables/tbzcol.x | 120 + pkg/tbtables/tbzcp.x | 149 + pkg/tbtables/tbzd2t.x | 75 + pkg/tbtables/tbzgt.x | 235 + pkg/tbtables/tbzi2d.x | 41 + pkg/tbtables/tbzi2t.x | 49 + pkg/tbtables/tbzkey.x | 70 + pkg/tbtables/tbzlin.x | 190 + pkg/tbtables/tbzmem.x | 300 + pkg/tbtables/tbznew.x | 50 + pkg/tbtables/tbznll.x | 56 + pkg/tbtables/tbzopn.x | 70 + pkg/tbtables/tbzpt.x | 219 + pkg/tbtables/tbzrds.x | 162 + pkg/tbtables/tbzrdx.x | 135 + pkg/tbtables/tbzsft.x | 146 + pkg/tbtables/tbzsiz.x | 74 + pkg/tbtables/tbzsub.x | 54 + pkg/tbtables/tbzt2t.x | 60 + pkg/tbtables/tbztyp.x | 27 + pkg/tbtables/tbzudf.x | 43 + pkg/tbtables/tbzwer.x | 34 + pkg/tbtables/tbzwrt.x | 257 + pkg/tbtables/underscore.h | 137 + 1015 files changed, 267357 insertions(+) create mode 100644 pkg/tbtables/README create mode 100644 pkg/tbtables/Revisions create mode 100644 pkg/tbtables/cfitsio/Licence.txt create mode 100644 pkg/tbtables/cfitsio/Makefile.in create mode 100644 pkg/tbtables/cfitsio/README create mode 100644 pkg/tbtables/cfitsio/README.MacOS create mode 100644 pkg/tbtables/cfitsio/buffers.c create mode 100644 pkg/tbtables/cfitsio/cfileio.c create mode 100644 pkg/tbtables/cfitsio/cfitsio.doc create mode 100644 pkg/tbtables/cfitsio/cfitsio.ps create mode 100644 pkg/tbtables/cfitsio/cfitsio.tex create mode 100644 pkg/tbtables/cfitsio/cfitsio.toc create mode 100644 pkg/tbtables/cfitsio/cfitsio_mac.sit.hqx create mode 100644 pkg/tbtables/cfitsio/cfortran.doc create mode 100644 pkg/tbtables/cfitsio/cfortran.h create mode 100644 pkg/tbtables/cfitsio/changes.txt create mode 100644 pkg/tbtables/cfitsio/checksum.c create mode 100644 pkg/tbtables/cfitsio/compress.c create mode 100644 pkg/tbtables/cfitsio/compress.h create mode 100755 pkg/tbtables/cfitsio/configure create mode 100644 pkg/tbtables/cfitsio/configure.in create mode 100644 pkg/tbtables/cfitsio/cookbook.c create mode 100644 pkg/tbtables/cfitsio/cookbook.f create mode 100644 pkg/tbtables/cfitsio/drvrfile.c create mode 100644 pkg/tbtables/cfitsio/drvrmem.c create mode 100644 pkg/tbtables/cfitsio/drvrnet.c create mode 100644 pkg/tbtables/cfitsio/drvrsmem.c create mode 100644 pkg/tbtables/cfitsio/drvrsmem.h create mode 100644 pkg/tbtables/cfitsio/editcol.c create mode 100644 pkg/tbtables/cfitsio/edithdu.c create mode 100644 pkg/tbtables/cfitsio/eval.l create mode 100644 pkg/tbtables/cfitsio/eval.y create mode 100644 pkg/tbtables/cfitsio/eval_defs.h create mode 100644 pkg/tbtables/cfitsio/eval_f.c create mode 100644 pkg/tbtables/cfitsio/eval_l.c create mode 100644 pkg/tbtables/cfitsio/eval_tab.h create mode 100644 pkg/tbtables/cfitsio/eval_y.c create mode 100644 pkg/tbtables/cfitsio/f77.inc create mode 100644 pkg/tbtables/cfitsio/f77_wrap.h create mode 100644 pkg/tbtables/cfitsio/f77_wrap1.c create mode 100644 pkg/tbtables/cfitsio/f77_wrap2.c create mode 100644 pkg/tbtables/cfitsio/fitscopy.c create mode 100644 pkg/tbtables/cfitsio/fitscore.c create mode 100644 pkg/tbtables/cfitsio/fitsio.doc create mode 100644 pkg/tbtables/cfitsio/fitsio.h create mode 100644 pkg/tbtables/cfitsio/fitsio.ps create mode 100644 pkg/tbtables/cfitsio/fitsio.tex create mode 100644 pkg/tbtables/cfitsio/fitsio.toc create mode 100644 pkg/tbtables/cfitsio/fitsio2.h create mode 100644 pkg/tbtables/cfitsio/getcol.c create mode 100644 pkg/tbtables/cfitsio/getcolb.c create mode 100644 pkg/tbtables/cfitsio/getcold.c create mode 100644 pkg/tbtables/cfitsio/getcole.c create mode 100644 pkg/tbtables/cfitsio/getcoli.c create mode 100644 pkg/tbtables/cfitsio/getcolj.c create mode 100644 pkg/tbtables/cfitsio/getcolk.c create mode 100644 pkg/tbtables/cfitsio/getcoll.c create mode 100644 pkg/tbtables/cfitsio/getcols.c create mode 100644 pkg/tbtables/cfitsio/getcolsb.c create mode 100644 pkg/tbtables/cfitsio/getcolui.c create mode 100644 pkg/tbtables/cfitsio/getcoluj.c create mode 100644 pkg/tbtables/cfitsio/getcoluk.c create mode 100644 pkg/tbtables/cfitsio/getkey.c create mode 100644 pkg/tbtables/cfitsio/group.c create mode 100644 pkg/tbtables/cfitsio/group.h create mode 100644 pkg/tbtables/cfitsio/grparser.c create mode 100644 pkg/tbtables/cfitsio/grparser.h create mode 100644 pkg/tbtables/cfitsio/histo.c create mode 100644 pkg/tbtables/cfitsio/imcompress.c create mode 100644 pkg/tbtables/cfitsio/iraffits.c create mode 100644 pkg/tbtables/cfitsio/iter_a.c create mode 100644 pkg/tbtables/cfitsio/iter_a.f create mode 100644 pkg/tbtables/cfitsio/iter_a.fit create mode 100644 pkg/tbtables/cfitsio/iter_b.c create mode 100644 pkg/tbtables/cfitsio/iter_b.f create mode 100644 pkg/tbtables/cfitsio/iter_b.fit create mode 100644 pkg/tbtables/cfitsio/iter_c.c create mode 100644 pkg/tbtables/cfitsio/iter_c.f create mode 100644 pkg/tbtables/cfitsio/iter_c.fit create mode 100644 pkg/tbtables/cfitsio/listhead.c create mode 100644 pkg/tbtables/cfitsio/longnam.h create mode 100644 pkg/tbtables/cfitsio/make_dfloat.com create mode 100644 pkg/tbtables/cfitsio/make_gfloat.com create mode 100644 pkg/tbtables/cfitsio/make_ieee.com create mode 100644 pkg/tbtables/cfitsio/makefile.bc create mode 100644 pkg/tbtables/cfitsio/makefile.os2 create mode 100644 pkg/tbtables/cfitsio/makefile.vcc create mode 100644 pkg/tbtables/cfitsio/makepc.bat create mode 100644 pkg/tbtables/cfitsio/mkpkg create mode 100644 pkg/tbtables/cfitsio/modkey.c create mode 100644 pkg/tbtables/cfitsio/pctype.h create mode 100644 pkg/tbtables/cfitsio/pliocomp.c create mode 100644 pkg/tbtables/cfitsio/putcol.c create mode 100644 pkg/tbtables/cfitsio/putcolb.c create mode 100644 pkg/tbtables/cfitsio/putcold.c create mode 100644 pkg/tbtables/cfitsio/putcole.c create mode 100644 pkg/tbtables/cfitsio/putcoli.c create mode 100644 pkg/tbtables/cfitsio/putcolj.c create mode 100644 pkg/tbtables/cfitsio/putcolk.c create mode 100644 pkg/tbtables/cfitsio/putcoll.c create mode 100644 pkg/tbtables/cfitsio/putcols.c create mode 100644 pkg/tbtables/cfitsio/putcolsb.c create mode 100644 pkg/tbtables/cfitsio/putcolu.c create mode 100644 pkg/tbtables/cfitsio/putcolui.c create mode 100644 pkg/tbtables/cfitsio/putcoluj.c create mode 100644 pkg/tbtables/cfitsio/putcoluk.c create mode 100644 pkg/tbtables/cfitsio/putkey.c create mode 100644 pkg/tbtables/cfitsio/quantize.c create mode 100644 pkg/tbtables/cfitsio/quick.ps create mode 100644 pkg/tbtables/cfitsio/quick.tex create mode 100644 pkg/tbtables/cfitsio/quick.toc create mode 100644 pkg/tbtables/cfitsio/region.c create mode 100644 pkg/tbtables/cfitsio/region.h create mode 100644 pkg/tbtables/cfitsio/ricecomp.c create mode 100644 pkg/tbtables/cfitsio/ricecomp.h create mode 100644 pkg/tbtables/cfitsio/sample.tpl create mode 100644 pkg/tbtables/cfitsio/scalnull.c create mode 100644 pkg/tbtables/cfitsio/smem.c create mode 100644 pkg/tbtables/cfitsio/speed.c create mode 100644 pkg/tbtables/cfitsio/swapproc.c create mode 100644 pkg/tbtables/cfitsio/testf77.f create mode 100644 pkg/tbtables/cfitsio/testf77.out create mode 100644 pkg/tbtables/cfitsio/testf77.std create mode 100644 pkg/tbtables/cfitsio/testprog.c create mode 100644 pkg/tbtables/cfitsio/testprog.out create mode 100644 pkg/tbtables/cfitsio/testprog.std create mode 100644 pkg/tbtables/cfitsio/testprog.tpt create mode 100644 pkg/tbtables/cfitsio/vmsieee.c create mode 100644 pkg/tbtables/cfitsio/vmsieeed.mar create mode 100644 pkg/tbtables/cfitsio/vmsieeer.mar create mode 100644 pkg/tbtables/cfitsio/wcssub.c create mode 100644 pkg/tbtables/cfitsio/wcsutil.c create mode 100644 pkg/tbtables/cfitsio/wcsutil.c.OLD create mode 100644 pkg/tbtables/cfitsio/winDumpExts.mak create mode 100644 pkg/tbtables/cfitsio/windumpexts.c create mode 100644 pkg/tbtables/doc/Notes create mode 100644 pkg/tbtables/doc/README create mode 100644 pkg/tbtables/doc/calls.doc create mode 100644 pkg/tbtables/doc/cfitsio.install create mode 100644 pkg/tbtables/doc/descrip.doc create mode 100644 pkg/tbtables/doc/ex.x create mode 100644 pkg/tbtables/doc/example.doc create mode 100644 pkg/tbtables/doc/fileformat.doc create mode 100644 pkg/tbtables/doc/tbtcpy.lis create mode 100644 pkg/tbtables/doc/text_tables.doc create mode 100644 pkg/tbtables/doc/versions.doc create mode 100644 pkg/tbtables/fitsio/README create mode 100644 pkg/tbtables/fitsio/fitsspp.com create mode 100644 pkg/tbtables/fitsio/fitsspp.x create mode 100644 pkg/tbtables/fitsio/fitssppb/README create mode 100644 pkg/tbtables/fitsio/fitssppb/fitsio.h create mode 100644 pkg/tbtables/fitsio/fitssppb/fsadef.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsarch.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsasfm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsbdef.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsbnfm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsclos.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fscmps.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fscmsg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fscopy.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fscpdt.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fscrhd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdcol.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsddef.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdelt.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdhdu.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdkey.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdrec.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdrow.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdsum.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsdtyp.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsesum.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsfiou.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg2db.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg2dd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg2de.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg2di.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg2dj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg3db.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg3dd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg3de.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg3di.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsg3dj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgabc.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgacl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgbcl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfc.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfe.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcfs.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcks.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcnn.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcno.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcrd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvc.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcve.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcvs.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcx.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcxd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcxi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgcxj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgdes.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgerr.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsggpb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsggpd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsggpe.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsggpi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsggpj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghad.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghbn.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghdn.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghpr.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghps.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghsp.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsghtb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgics.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgiou.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkey.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgknd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkne.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgknj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgknl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkns.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkyd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkye.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkyj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkyl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkyn.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkys.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgkyt.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgmsg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpfb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpfd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpfe.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpfi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpfj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpvb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpvd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpve.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpvi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgpvj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgrec.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgrsz.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsdt.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsfb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsfd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsfe.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsfi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsfj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsvb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsvd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsve.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsvi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgsvj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgtbb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgtbs.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgtcl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgtcs.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgtdm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsgthd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fshdef.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsibin.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsicol.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsiimg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikyd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikye.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikyf.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikyg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikyj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikyl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsikys.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsinit.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsirec.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsirow.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsitab.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fskeyn.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmahd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmcom.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmcrd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkyd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkye.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkyf.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkyg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkyj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkyl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmkys.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmnam.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmrec.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsmrhd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsnkey.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsopen.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp2db.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp2dd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp2de.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp2di.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp2dj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp3db.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp3dd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp3de.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp3di.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsp3dj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcks.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspclb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspclc.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcld.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcle.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcli.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspclj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcll.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspclm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcls.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspclu.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspclx.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcnb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcnd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcne.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcni.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcnj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspcom.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspdat.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspdef.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspdes.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspgpb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspgpd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspgpe.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspgpi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspgpj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsphbn.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsphis.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsphpr.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsphtb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkls.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspknd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkne.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspknf.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkng.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspknj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspknl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkns.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkyd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkye.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkyf.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkyg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkyj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkyl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkys.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspkyt.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsplsw.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspmsg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspnul.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppnb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppnd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppne.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppni.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppnj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspprb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspprd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppre.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppri.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspprj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsppru.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsprec.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspscl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspssb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspssd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspsse.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspssi.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspssj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspsvc.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsptbb.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsptbs.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsptdm.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fspthp.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsrdef.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fssnul.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fstkey.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fstnul.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fstscl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsucks.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsucrd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukyd.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukye.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukyf.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukyg.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukyj.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukyl.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsukys.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsvcks.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsvers.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fswldp.x create mode 100644 pkg/tbtables/fitsio/fitssppb/fsxypx.x create mode 100644 pkg/tbtables/fitsio/fitssppb/mkpkg create mode 100644 pkg/tbtables/fitsio/ftadef.f create mode 100644 pkg/tbtables/fitsio/ftaini.f create mode 100644 pkg/tbtables/fitsio/ftarch.f create mode 100644 pkg/tbtables/fitsio/ftas2c.f create mode 100644 pkg/tbtables/fitsio/ftasfm.f create mode 100644 pkg/tbtables/fitsio/ftbdef.f create mode 100644 pkg/tbtables/fitsio/ftbini.f create mode 100644 pkg/tbtables/fitsio/ftbnfm.f create mode 100644 pkg/tbtables/fitsio/ftc2as.f create mode 100644 pkg/tbtables/fitsio/ftc2d.f create mode 100644 pkg/tbtables/fitsio/ftc2dd.f create mode 100644 pkg/tbtables/fitsio/ftc2i.f create mode 100644 pkg/tbtables/fitsio/ftc2ii.f create mode 100644 pkg/tbtables/fitsio/ftc2l.f create mode 100644 pkg/tbtables/fitsio/ftc2ll.f create mode 100644 pkg/tbtables/fitsio/ftc2r.f create mode 100644 pkg/tbtables/fitsio/ftc2rr.f create mode 100644 pkg/tbtables/fitsio/ftc2s.f create mode 100644 pkg/tbtables/fitsio/ftc2x.f create mode 100644 pkg/tbtables/fitsio/ftcdel.f create mode 100644 pkg/tbtables/fitsio/ftcdfl.f create mode 100644 pkg/tbtables/fitsio/ftchdu.f create mode 100644 pkg/tbtables/fitsio/ftchfl.f create mode 100644 pkg/tbtables/fitsio/ftcins.f create mode 100644 pkg/tbtables/fitsio/ftclos.f create mode 100644 pkg/tbtables/fitsio/ftcmps.f create mode 100644 pkg/tbtables/fitsio/ftcmsg.f create mode 100644 pkg/tbtables/fitsio/ftcopy.f create mode 100644 pkg/tbtables/fitsio/ftcpdt.f create mode 100644 pkg/tbtables/fitsio/ftcrep.f create mode 100644 pkg/tbtables/fitsio/ftcrhd.f create mode 100644 pkg/tbtables/fitsio/ftcsum.f create mode 100644 pkg/tbtables/fitsio/ftd2e.f create mode 100644 pkg/tbtables/fitsio/ftd2f.f create mode 100644 pkg/tbtables/fitsio/ftdblk.f create mode 100644 pkg/tbtables/fitsio/ftdcol.f create mode 100644 pkg/tbtables/fitsio/ftddef.f create mode 100644 pkg/tbtables/fitsio/ftdelt.f create mode 100644 pkg/tbtables/fitsio/ftdhdu.f create mode 100644 pkg/tbtables/fitsio/ftdkey.f create mode 100644 pkg/tbtables/fitsio/ftdrec.f create mode 100644 pkg/tbtables/fitsio/ftdrow.f create mode 100644 pkg/tbtables/fitsio/ftdsum.f create mode 100644 pkg/tbtables/fitsio/ftdtyp.f create mode 100644 pkg/tbtables/fitsio/ftesum.f create mode 100644 pkg/tbtables/fitsio/ftfiou.f create mode 100644 pkg/tbtables/fitsio/ftfrcl.f create mode 100644 pkg/tbtables/fitsio/ftg2db.f create mode 100644 pkg/tbtables/fitsio/ftg2dd.f create mode 100644 pkg/tbtables/fitsio/ftg2de.f create mode 100644 pkg/tbtables/fitsio/ftg2di.f create mode 100644 pkg/tbtables/fitsio/ftg2dj.f create mode 100644 pkg/tbtables/fitsio/ftg3db.f create mode 100644 pkg/tbtables/fitsio/ftg3dd.f create mode 100644 pkg/tbtables/fitsio/ftg3de.f create mode 100644 pkg/tbtables/fitsio/ftg3di.f create mode 100644 pkg/tbtables/fitsio/ftg3dj.f create mode 100644 pkg/tbtables/fitsio/ftgabc.f create mode 100644 pkg/tbtables/fitsio/ftgacl.f create mode 100644 pkg/tbtables/fitsio/ftgatp.f create mode 100644 pkg/tbtables/fitsio/ftgbcl.f create mode 100644 pkg/tbtables/fitsio/ftgbit.f create mode 100644 pkg/tbtables/fitsio/ftgbnh.f create mode 100644 pkg/tbtables/fitsio/ftgbtp.f create mode 100644 pkg/tbtables/fitsio/ftgcfb.f create mode 100644 pkg/tbtables/fitsio/ftgcfc.f create mode 100644 pkg/tbtables/fitsio/ftgcfd.f create mode 100644 pkg/tbtables/fitsio/ftgcfe.f create mode 100644 pkg/tbtables/fitsio/ftgcfi.f create mode 100644 pkg/tbtables/fitsio/ftgcfj.f create mode 100644 pkg/tbtables/fitsio/ftgcfl.f create mode 100644 pkg/tbtables/fitsio/ftgcfm.f create mode 100644 pkg/tbtables/fitsio/ftgcfs.f create mode 100644 pkg/tbtables/fitsio/ftgcks.f create mode 100644 pkg/tbtables/fitsio/ftgcl.f create mode 100644 pkg/tbtables/fitsio/ftgclb.f create mode 100644 pkg/tbtables/fitsio/ftgclc.f create mode 100644 pkg/tbtables/fitsio/ftgcld.f create mode 100644 pkg/tbtables/fitsio/ftgcle.f create mode 100644 pkg/tbtables/fitsio/ftgcli.f create mode 100644 pkg/tbtables/fitsio/ftgclj.f create mode 100644 pkg/tbtables/fitsio/ftgclm.f create mode 100644 pkg/tbtables/fitsio/ftgcls.f create mode 100644 pkg/tbtables/fitsio/ftgcnn.f create mode 100644 pkg/tbtables/fitsio/ftgcno.f create mode 100644 pkg/tbtables/fitsio/ftgcrd.f create mode 100644 pkg/tbtables/fitsio/ftgcvb.f create mode 100644 pkg/tbtables/fitsio/ftgcvc.f create mode 100644 pkg/tbtables/fitsio/ftgcvd.f create mode 100644 pkg/tbtables/fitsio/ftgcve.f create mode 100644 pkg/tbtables/fitsio/ftgcvi.f create mode 100644 pkg/tbtables/fitsio/ftgcvj.f create mode 100644 pkg/tbtables/fitsio/ftgcvm.f create mode 100644 pkg/tbtables/fitsio/ftgcvs.f create mode 100644 pkg/tbtables/fitsio/ftgcx.f create mode 100644 pkg/tbtables/fitsio/ftgcxd.f create mode 100644 pkg/tbtables/fitsio/ftgcxi.f create mode 100644 pkg/tbtables/fitsio/ftgcxj.f create mode 100644 pkg/tbtables/fitsio/ftgdes.f create mode 100644 pkg/tbtables/fitsio/ftgerr.f create mode 100644 pkg/tbtables/fitsio/ftgext.f create mode 100644 pkg/tbtables/fitsio/ftggpb.f create mode 100644 pkg/tbtables/fitsio/ftggpd.f create mode 100644 pkg/tbtables/fitsio/ftggpe.f create mode 100644 pkg/tbtables/fitsio/ftggpi.f create mode 100644 pkg/tbtables/fitsio/ftggpj.f create mode 100644 pkg/tbtables/fitsio/ftghad.f create mode 100644 pkg/tbtables/fitsio/ftghbn.f create mode 100644 pkg/tbtables/fitsio/ftghdn.f create mode 100644 pkg/tbtables/fitsio/ftghpr.f create mode 100644 pkg/tbtables/fitsio/ftghps.f create mode 100644 pkg/tbtables/fitsio/ftghsp.f create mode 100644 pkg/tbtables/fitsio/ftghtb.f create mode 100644 pkg/tbtables/fitsio/ftgi1b.f create mode 100644 pkg/tbtables/fitsio/ftgics.f create mode 100644 pkg/tbtables/fitsio/ftgiou.f create mode 100644 pkg/tbtables/fitsio/ftgkey.f create mode 100644 pkg/tbtables/fitsio/ftgknd.f create mode 100644 pkg/tbtables/fitsio/ftgkne.f create mode 100644 pkg/tbtables/fitsio/ftgknj.f create mode 100644 pkg/tbtables/fitsio/ftgknl.f create mode 100644 pkg/tbtables/fitsio/ftgkns.f create mode 100644 pkg/tbtables/fitsio/ftgkyd.f create mode 100644 pkg/tbtables/fitsio/ftgkye.f create mode 100644 pkg/tbtables/fitsio/ftgkyj.f create mode 100644 pkg/tbtables/fitsio/ftgkyl.f create mode 100644 pkg/tbtables/fitsio/ftgkyn.f create mode 100644 pkg/tbtables/fitsio/ftgkys.f create mode 100644 pkg/tbtables/fitsio/ftgkyt.f create mode 100644 pkg/tbtables/fitsio/ftgmsg.f create mode 100644 pkg/tbtables/fitsio/ftgnst.f create mode 100644 pkg/tbtables/fitsio/ftgpfb.f create mode 100644 pkg/tbtables/fitsio/ftgpfd.f create mode 100644 pkg/tbtables/fitsio/ftgpfe.f create mode 100644 pkg/tbtables/fitsio/ftgpfi.f create mode 100644 pkg/tbtables/fitsio/ftgpfj.f create mode 100644 pkg/tbtables/fitsio/ftgphx.f create mode 100644 pkg/tbtables/fitsio/ftgprh.f create mode 100644 pkg/tbtables/fitsio/ftgpvb.f create mode 100644 pkg/tbtables/fitsio/ftgpvd.f create mode 100644 pkg/tbtables/fitsio/ftgpve.f create mode 100644 pkg/tbtables/fitsio/ftgpvi.f create mode 100644 pkg/tbtables/fitsio/ftgpvj.f create mode 100644 pkg/tbtables/fitsio/ftgrec.f create mode 100644 pkg/tbtables/fitsio/ftgsfb.f create mode 100644 pkg/tbtables/fitsio/ftgsfd.f create mode 100644 pkg/tbtables/fitsio/ftgsfe.f create mode 100644 pkg/tbtables/fitsio/ftgsfi.f create mode 100644 pkg/tbtables/fitsio/ftgsfj.f create mode 100644 pkg/tbtables/fitsio/ftgsvb.f create mode 100644 pkg/tbtables/fitsio/ftgsvd.f create mode 100644 pkg/tbtables/fitsio/ftgsve.f create mode 100644 pkg/tbtables/fitsio/ftgsvi.f create mode 100644 pkg/tbtables/fitsio/ftgsvj.f create mode 100644 pkg/tbtables/fitsio/ftgtbb.f create mode 100644 pkg/tbtables/fitsio/ftgtbc.f create mode 100644 pkg/tbtables/fitsio/ftgtbh.f create mode 100644 pkg/tbtables/fitsio/ftgtbn.f create mode 100644 pkg/tbtables/fitsio/ftgtbs.f create mode 100644 pkg/tbtables/fitsio/ftgtcl.f create mode 100644 pkg/tbtables/fitsio/ftgtcs.f create mode 100644 pkg/tbtables/fitsio/ftgtdm.f create mode 100644 pkg/tbtables/fitsio/ftgthd.f create mode 100644 pkg/tbtables/fitsio/ftgtkn.f create mode 100644 pkg/tbtables/fitsio/ftgttb.f create mode 100644 pkg/tbtables/fitsio/fthdef.f create mode 100644 pkg/tbtables/fitsio/fthpdn.f create mode 100644 pkg/tbtables/fitsio/fthpup.f create mode 100644 pkg/tbtables/fitsio/fti1i1.f create mode 100644 pkg/tbtables/fitsio/fti1i2.f create mode 100644 pkg/tbtables/fitsio/fti1i4.f create mode 100644 pkg/tbtables/fitsio/fti1r4.f create mode 100644 pkg/tbtables/fitsio/fti1r8.f create mode 100644 pkg/tbtables/fitsio/fti2c.f create mode 100644 pkg/tbtables/fitsio/fti2i1.f create mode 100644 pkg/tbtables/fitsio/fti2i2.f create mode 100644 pkg/tbtables/fitsio/fti2i4.f create mode 100644 pkg/tbtables/fitsio/fti2r4.f create mode 100644 pkg/tbtables/fitsio/fti2r8.f create mode 100644 pkg/tbtables/fitsio/fti4i1.f create mode 100644 pkg/tbtables/fitsio/fti4i2.f create mode 100644 pkg/tbtables/fitsio/fti4i4.f create mode 100644 pkg/tbtables/fitsio/fti4r4.f create mode 100644 pkg/tbtables/fitsio/fti4r8.f create mode 100644 pkg/tbtables/fitsio/ftibin.f create mode 100644 pkg/tbtables/fitsio/ftiblk.f create mode 100644 pkg/tbtables/fitsio/fticol.f create mode 100644 pkg/tbtables/fitsio/ftiimg.f create mode 100644 pkg/tbtables/fitsio/ftikyd.f create mode 100644 pkg/tbtables/fitsio/ftikye.f create mode 100644 pkg/tbtables/fitsio/ftikyf.f create mode 100644 pkg/tbtables/fitsio/ftikyg.f create mode 100644 pkg/tbtables/fitsio/ftikyj.f create mode 100644 pkg/tbtables/fitsio/ftikyl.f create mode 100644 pkg/tbtables/fitsio/ftikys.f create mode 100644 pkg/tbtables/fitsio/ftinit.f create mode 100644 pkg/tbtables/fitsio/ftirec.f create mode 100644 pkg/tbtables/fitsio/ftirow.f create mode 100644 pkg/tbtables/fitsio/ftitab.f create mode 100644 pkg/tbtables/fitsio/ftkeyn.f create mode 100644 pkg/tbtables/fitsio/ftkshf.f create mode 100644 pkg/tbtables/fitsio/ftl2c.f create mode 100644 pkg/tbtables/fitsio/ftmahd.f create mode 100644 pkg/tbtables/fitsio/ftmcom.f create mode 100644 pkg/tbtables/fitsio/ftmcrd.f create mode 100644 pkg/tbtables/fitsio/ftmkey.f create mode 100644 pkg/tbtables/fitsio/ftmkyd.f create mode 100644 pkg/tbtables/fitsio/ftmkye.f create mode 100644 pkg/tbtables/fitsio/ftmkyf.f create mode 100644 pkg/tbtables/fitsio/ftmkyg.f create mode 100644 pkg/tbtables/fitsio/ftmkyj.f create mode 100644 pkg/tbtables/fitsio/ftmkyl.f create mode 100644 pkg/tbtables/fitsio/ftmkys.f create mode 100644 pkg/tbtables/fitsio/ftmnam.f create mode 100644 pkg/tbtables/fitsio/ftmodr.f create mode 100644 pkg/tbtables/fitsio/ftmrec.f create mode 100644 pkg/tbtables/fitsio/ftmrhd.f create mode 100644 pkg/tbtables/fitsio/ftnkey.f create mode 100644 pkg/tbtables/fitsio/ftnulc.f create mode 100644 pkg/tbtables/fitsio/ftnulm.f create mode 100644 pkg/tbtables/fitsio/ftopen.f create mode 100644 pkg/tbtables/fitsio/ftp2db.f create mode 100644 pkg/tbtables/fitsio/ftp2dd.f create mode 100644 pkg/tbtables/fitsio/ftp2de.f create mode 100644 pkg/tbtables/fitsio/ftp2di.f create mode 100644 pkg/tbtables/fitsio/ftp2dj.f create mode 100644 pkg/tbtables/fitsio/ftp3db.f create mode 100644 pkg/tbtables/fitsio/ftp3dd.f create mode 100644 pkg/tbtables/fitsio/ftp3de.f create mode 100644 pkg/tbtables/fitsio/ftp3di.f create mode 100644 pkg/tbtables/fitsio/ftp3dj.f create mode 100644 pkg/tbtables/fitsio/ftpbit.f create mode 100644 pkg/tbtables/fitsio/ftpbnh.f create mode 100644 pkg/tbtables/fitsio/ftpcks.f create mode 100644 pkg/tbtables/fitsio/ftpclb.f create mode 100644 pkg/tbtables/fitsio/ftpclc.f create mode 100644 pkg/tbtables/fitsio/ftpcld.f create mode 100644 pkg/tbtables/fitsio/ftpcle.f create mode 100644 pkg/tbtables/fitsio/ftpcli.f create mode 100644 pkg/tbtables/fitsio/ftpclj.f create mode 100644 pkg/tbtables/fitsio/ftpcll.f create mode 100644 pkg/tbtables/fitsio/ftpclm.f create mode 100644 pkg/tbtables/fitsio/ftpcls.f create mode 100644 pkg/tbtables/fitsio/ftpclu.f create mode 100644 pkg/tbtables/fitsio/ftpclx.f create mode 100644 pkg/tbtables/fitsio/ftpcnb.f create mode 100644 pkg/tbtables/fitsio/ftpcnd.f create mode 100644 pkg/tbtables/fitsio/ftpcne.f create mode 100644 pkg/tbtables/fitsio/ftpcni.f create mode 100644 pkg/tbtables/fitsio/ftpcnj.f create mode 100644 pkg/tbtables/fitsio/ftpcom.f create mode 100644 pkg/tbtables/fitsio/ftpdat.f create mode 100644 pkg/tbtables/fitsio/ftpdef.f create mode 100644 pkg/tbtables/fitsio/ftpdes.f create mode 100644 pkg/tbtables/fitsio/ftpdfl.f create mode 100644 pkg/tbtables/fitsio/ftpgpb.f create mode 100644 pkg/tbtables/fitsio/ftpgpd.f create mode 100644 pkg/tbtables/fitsio/ftpgpe.f create mode 100644 pkg/tbtables/fitsio/ftpgpi.f create mode 100644 pkg/tbtables/fitsio/ftpgpj.f create mode 100644 pkg/tbtables/fitsio/ftphbn.f create mode 100644 pkg/tbtables/fitsio/ftphis.f create mode 100644 pkg/tbtables/fitsio/ftphpr.f create mode 100644 pkg/tbtables/fitsio/ftphtb.f create mode 100644 pkg/tbtables/fitsio/ftpi1b.f create mode 100644 pkg/tbtables/fitsio/ftpini.f create mode 100644 pkg/tbtables/fitsio/ftpkey.f create mode 100644 pkg/tbtables/fitsio/ftpkls.f create mode 100644 pkg/tbtables/fitsio/ftpknd.f create mode 100644 pkg/tbtables/fitsio/ftpkne.f create mode 100644 pkg/tbtables/fitsio/ftpknf.f create mode 100644 pkg/tbtables/fitsio/ftpkng.f create mode 100644 pkg/tbtables/fitsio/ftpknj.f create mode 100644 pkg/tbtables/fitsio/ftpknl.f create mode 100644 pkg/tbtables/fitsio/ftpkns.f create mode 100644 pkg/tbtables/fitsio/ftpkyd.f create mode 100644 pkg/tbtables/fitsio/ftpkye.f create mode 100644 pkg/tbtables/fitsio/ftpkyf.f create mode 100644 pkg/tbtables/fitsio/ftpkyg.f create mode 100644 pkg/tbtables/fitsio/ftpkyj.f create mode 100644 pkg/tbtables/fitsio/ftpkyl.f create mode 100644 pkg/tbtables/fitsio/ftpkys.f create mode 100644 pkg/tbtables/fitsio/ftpkyt.f create mode 100644 pkg/tbtables/fitsio/ftplsw.f create mode 100644 pkg/tbtables/fitsio/ftpmsg.f create mode 100644 pkg/tbtables/fitsio/ftpnul.f create mode 100644 pkg/tbtables/fitsio/ftppnb.f create mode 100644 pkg/tbtables/fitsio/ftppnd.f create mode 100644 pkg/tbtables/fitsio/ftppne.f create mode 100644 pkg/tbtables/fitsio/ftppni.f create mode 100644 pkg/tbtables/fitsio/ftppnj.f create mode 100644 pkg/tbtables/fitsio/ftpprb.f create mode 100644 pkg/tbtables/fitsio/ftpprd.f create mode 100644 pkg/tbtables/fitsio/ftppre.f create mode 100644 pkg/tbtables/fitsio/ftpprh.f create mode 100644 pkg/tbtables/fitsio/ftppri.f create mode 100644 pkg/tbtables/fitsio/ftpprj.f create mode 100644 pkg/tbtables/fitsio/ftppru.f create mode 100644 pkg/tbtables/fitsio/ftprec.f create mode 100644 pkg/tbtables/fitsio/ftprsv.f create mode 100644 pkg/tbtables/fitsio/ftpscl.f create mode 100644 pkg/tbtables/fitsio/ftpssb.f create mode 100644 pkg/tbtables/fitsio/ftpssd.f create mode 100644 pkg/tbtables/fitsio/ftpsse.f create mode 100644 pkg/tbtables/fitsio/ftpssi.f create mode 100644 pkg/tbtables/fitsio/ftpssj.f create mode 100644 pkg/tbtables/fitsio/ftpsvc.f create mode 100644 pkg/tbtables/fitsio/ftptbb.f create mode 100644 pkg/tbtables/fitsio/ftptbh.f create mode 100644 pkg/tbtables/fitsio/ftptbs.f create mode 100644 pkg/tbtables/fitsio/ftptdm.f create mode 100644 pkg/tbtables/fitsio/ftpthp.f create mode 100644 pkg/tbtables/fitsio/ftr2e.f create mode 100644 pkg/tbtables/fitsio/ftr2f.f create mode 100644 pkg/tbtables/fitsio/ftr4i1.f create mode 100644 pkg/tbtables/fitsio/ftr4i2.f create mode 100644 pkg/tbtables/fitsio/ftr4i4.f create mode 100644 pkg/tbtables/fitsio/ftr4r4.f create mode 100644 pkg/tbtables/fitsio/ftr4r8.f create mode 100644 pkg/tbtables/fitsio/ftr8i1.f create mode 100644 pkg/tbtables/fitsio/ftr8i2.f create mode 100644 pkg/tbtables/fitsio/ftr8i4.f create mode 100644 pkg/tbtables/fitsio/ftr8r4.f create mode 100644 pkg/tbtables/fitsio/ftr8r8.f create mode 100644 pkg/tbtables/fitsio/ftrdef.f create mode 100644 pkg/tbtables/fitsio/ftrhdu.f create mode 100644 pkg/tbtables/fitsio/ftrsnm.f create mode 100644 pkg/tbtables/fitsio/ftrwdn.f create mode 100644 pkg/tbtables/fitsio/ftrwup.f create mode 100644 pkg/tbtables/fitsio/fts2c.f create mode 100644 pkg/tbtables/fitsio/ftsdnn.f create mode 100644 pkg/tbtables/fitsio/ftsnul.f create mode 100644 pkg/tbtables/fitsio/ftsrnn.f create mode 100644 pkg/tbtables/fitsio/fttbit.f create mode 100644 pkg/tbtables/fitsio/fttdnn.f create mode 100644 pkg/tbtables/fitsio/fttkey.f create mode 100644 pkg/tbtables/fitsio/fttkyn.f create mode 100644 pkg/tbtables/fitsio/fttnul.f create mode 100644 pkg/tbtables/fitsio/fttrec.f create mode 100644 pkg/tbtables/fitsio/fttrnn.f create mode 100644 pkg/tbtables/fitsio/fttscl.f create mode 100644 pkg/tbtables/fitsio/ftucks.f create mode 100644 pkg/tbtables/fitsio/ftucrd.f create mode 100644 pkg/tbtables/fitsio/ftukyd.f create mode 100644 pkg/tbtables/fitsio/ftukye.f create mode 100644 pkg/tbtables/fitsio/ftukyf.f create mode 100644 pkg/tbtables/fitsio/ftukyg.f create mode 100644 pkg/tbtables/fitsio/ftukyj.f create mode 100644 pkg/tbtables/fitsio/ftukyl.f create mode 100644 pkg/tbtables/fitsio/ftukys.f create mode 100644 pkg/tbtables/fitsio/ftuscc.f create mode 100644 pkg/tbtables/fitsio/ftuscm.f create mode 100644 pkg/tbtables/fitsio/ftvcks.f create mode 100644 pkg/tbtables/fitsio/ftvers.f create mode 100644 pkg/tbtables/fitsio/ftwend.f create mode 100644 pkg/tbtables/fitsio/ftwldp.f create mode 100644 pkg/tbtables/fitsio/ftxiou.f create mode 100644 pkg/tbtables/fitsio/ftxmsg.f create mode 100644 pkg/tbtables/fitsio/ftxypx.f create mode 100644 pkg/tbtables/fitsio/mkpkg create mode 100644 pkg/tbtables/fitsio/unix/README create mode 100644 pkg/tbtables/fitsio/unix/ftgcbf.x create mode 100644 pkg/tbtables/fitsio/unix/ftpcbf.x create mode 100644 pkg/tbtables/fitsio/unix/mkpkg create mode 100644 pkg/tbtables/fitsio/vms/README create mode 100644 pkg/tbtables/fitsio/vms/ftgcbf.x create mode 100644 pkg/tbtables/fitsio/vms/ftpcbf.x create mode 100644 pkg/tbtables/fitsio/vms/mkpkg create mode 100644 pkg/tbtables/fitsio_spp.h create mode 100644 pkg/tbtables/mkpkg create mode 100644 pkg/tbtables/selector/generic/mkpkg create mode 100644 pkg/tbtables/selector/generic/tcsrdaryb.x create mode 100644 pkg/tbtables/selector/generic/tcsrdaryc.x create mode 100644 pkg/tbtables/selector/generic/tcsrdaryd.x create mode 100644 pkg/tbtables/selector/generic/tcsrdaryi.x create mode 100644 pkg/tbtables/selector/generic/tcsrdaryr.x create mode 100644 pkg/tbtables/selector/generic/tcsrdarys.x create mode 100644 pkg/tbtables/selector/mkpkg create mode 100644 pkg/tbtables/selector/omniread.x create mode 100644 pkg/tbtables/selector/rdselect.x create mode 100644 pkg/tbtables/selector/rst.x create mode 100644 pkg/tbtables/selector/selrows.x create mode 100644 pkg/tbtables/selector/tbcga.x create mode 100644 pkg/tbtables/selector/tbcnel.x create mode 100644 pkg/tbtables/selector/tcs.h create mode 100644 pkg/tbtables/selector/tcsaddcol.x create mode 100644 pkg/tbtables/selector/tcsclose.x create mode 100644 pkg/tbtables/selector/tcscolumn.x create mode 100644 pkg/tbtables/selector/tcsintinfo.x create mode 100644 pkg/tbtables/selector/tcslinesize.x create mode 100644 pkg/tbtables/selector/tcsopen.x create mode 100644 pkg/tbtables/selector/tcsrdary.gx create mode 100644 pkg/tbtables/selector/tcsshape.x create mode 100644 pkg/tbtables/selector/tcstotsize.x create mode 100644 pkg/tbtables/selector/tcstxtinfo.x create mode 100644 pkg/tbtables/selector/trs.h create mode 100644 pkg/tbtables/selector/trsclose.x create mode 100644 pkg/tbtables/selector/trseval.x create mode 100644 pkg/tbtables/selector/trsgencode.x create mode 100644 pkg/tbtables/selector/trsopen.com create mode 100644 pkg/tbtables/selector/trsopen.x create mode 100644 pkg/tbtables/selector/trsopen.y create mode 100644 pkg/tbtables/selector/trsrows.x create mode 100644 pkg/tbtables/selector/trstree.x create mode 100644 pkg/tbtables/selector/trstrim.x create mode 100644 pkg/tbtables/selector/whatfile.h create mode 100644 pkg/tbtables/selector/whatfile.x create mode 100644 pkg/tbtables/tbagt.x create mode 100644 pkg/tbtables/tbapt.x create mode 100644 pkg/tbtables/tbbadf.x create mode 100644 pkg/tbtables/tbbaln.x create mode 100644 pkg/tbtables/tbbcmt.x create mode 100644 pkg/tbtables/tbbftp.x create mode 100644 pkg/tbtables/tbbnll.x create mode 100644 pkg/tbtables/tbbptf.x create mode 100644 pkg/tbtables/tbbtyp.x create mode 100644 pkg/tbtables/tbbwrd.x create mode 100644 pkg/tbtables/tbcadd.x create mode 100644 pkg/tbtables/tbcchg.x create mode 100644 pkg/tbtables/tbcdef.x create mode 100644 pkg/tbtables/tbcdef1.x create mode 100644 pkg/tbtables/tbcdes.x create mode 100644 pkg/tbtables/tbcfmt.x create mode 100644 pkg/tbtables/tbcfnd.x create mode 100644 pkg/tbtables/tbcfnd1.x create mode 100644 pkg/tbtables/tbcftl.x create mode 100644 pkg/tbtables/tbcgt.x create mode 100644 pkg/tbtables/tbciga.x create mode 100644 pkg/tbtables/tbcigi.x create mode 100644 pkg/tbtables/tbcigt.x create mode 100644 pkg/tbtables/tbcinf.x create mode 100644 pkg/tbtables/tbcnam.x create mode 100644 pkg/tbtables/tbcnit.x create mode 100644 pkg/tbtables/tbcnum.x create mode 100644 pkg/tbtables/tbcpt.x create mode 100644 pkg/tbtables/tbcrcd.x create mode 100644 pkg/tbtables/tbcscal.x create mode 100644 pkg/tbtables/tbctpe.x create mode 100644 pkg/tbtables/tbcwcd.x create mode 100644 pkg/tbtables/tbdsav.x create mode 100644 pkg/tbtables/tbegp.x create mode 100644 pkg/tbtables/tbegt.x create mode 100644 pkg/tbtables/tbeoff.x create mode 100644 pkg/tbtables/tbepp.x create mode 100644 pkg/tbtables/tbept.x create mode 100644 pkg/tbtables/tbeszt.x create mode 100644 pkg/tbtables/tbfag.x create mode 100644 pkg/tbtables/tbfanp.x create mode 100644 pkg/tbtables/tbfap.x create mode 100644 pkg/tbtables/tbfcal.x create mode 100644 pkg/tbtables/tbfchp.x create mode 100644 pkg/tbtables/tbfckn.x create mode 100644 pkg/tbtables/tbfclo.x create mode 100644 pkg/tbtables/tbfdef.x create mode 100644 pkg/tbtables/tbfdel.x create mode 100644 pkg/tbtables/tbferr.x create mode 100644 pkg/tbtables/tbffkw.x create mode 100644 pkg/tbtables/tbffmt.x create mode 100644 pkg/tbtables/tbffnd.x create mode 100644 pkg/tbtables/tbfgcm.x create mode 100644 pkg/tbtables/tbfgnp.x create mode 100644 pkg/tbtables/tbfhdl.x create mode 100644 pkg/tbtables/tbfhg.x create mode 100644 pkg/tbtables/tbfhp.x create mode 100644 pkg/tbtables/tbfhp_f.x create mode 100644 pkg/tbtables/tbfiga.x create mode 100644 pkg/tbtables/tbfnam.x create mode 100644 pkg/tbtables/tbfnew.x create mode 100644 pkg/tbtables/tbfnit.x create mode 100644 pkg/tbtables/tbfnll.x create mode 100644 pkg/tbtables/tbfopn.x create mode 100644 pkg/tbtables/tbfpcm.x create mode 100644 pkg/tbtables/tbfpnp.x create mode 100644 pkg/tbtables/tbfpri.x create mode 100644 pkg/tbtables/tbfptf.x create mode 100644 pkg/tbtables/tbfrcd.x create mode 100644 pkg/tbtables/tbfres.x create mode 100644 pkg/tbtables/tbfrsi.x create mode 100644 pkg/tbtables/tbfscal.x create mode 100644 pkg/tbtables/tbfsft.x create mode 100644 pkg/tbtables/tbfsiz.x create mode 100644 pkg/tbtables/tbftya.x create mode 100644 pkg/tbtables/tbftyb.x create mode 100644 pkg/tbtables/tbfudf.x create mode 100644 pkg/tbtables/tbfwcd.x create mode 100644 pkg/tbtables/tbfwer.x create mode 100644 pkg/tbtables/tbfwsi.x create mode 100644 pkg/tbtables/tbfxff.c create mode 100644 pkg/tbtables/tbhad.x create mode 100644 pkg/tbtables/tbhanp.x create mode 100644 pkg/tbtables/tbhcal.x create mode 100644 pkg/tbtables/tbhckn.x create mode 100644 pkg/tbtables/tbhdel.x create mode 100644 pkg/tbtables/tbhfcm.x create mode 100644 pkg/tbtables/tbhfkr.x create mode 100644 pkg/tbtables/tbhfkw.x create mode 100644 pkg/tbtables/tbhgcm.x create mode 100644 pkg/tbtables/tbhgnp.x create mode 100644 pkg/tbtables/tbhgt.x create mode 100644 pkg/tbtables/tbhisc.x create mode 100644 pkg/tbtables/tbhkeq.x create mode 100644 pkg/tbtables/tbhpcm.x create mode 100644 pkg/tbtables/tbhpnp.x create mode 100644 pkg/tbtables/tbhpt.x create mode 100644 pkg/tbtables/tbhrpr.x create mode 100644 pkg/tbtables/tbhwpr.x create mode 100644 pkg/tbtables/tblerr.h create mode 100644 pkg/tbtables/tblfits.h create mode 100644 pkg/tbtables/tbltext.h create mode 100644 pkg/tbtables/tbnopen.x create mode 100644 pkg/tbtables/tbnparse.x create mode 100644 pkg/tbtables/tbparse.x create mode 100644 pkg/tbtables/tbpset.x create mode 100644 pkg/tbtables/tbpsta.x create mode 100644 pkg/tbtables/tbrchg.x create mode 100644 pkg/tbtables/tbrcmp.x create mode 100644 pkg/tbtables/tbrcpy.x create mode 100644 pkg/tbtables/tbrcsc.x create mode 100644 pkg/tbtables/tbrdel.x create mode 100644 pkg/tbtables/tbrgt.x create mode 100644 pkg/tbtables/tbrnll.x create mode 100644 pkg/tbtables/tbrpt.x create mode 100644 pkg/tbtables/tbrsft.x create mode 100644 pkg/tbtables/tbrswp.x create mode 100644 pkg/tbtables/tbrudf.x create mode 100644 pkg/tbtables/tbscol.x create mode 100644 pkg/tbtables/tbsirow.x create mode 100644 pkg/tbtables/tbsopn.x create mode 100644 pkg/tbtables/tbsrow.x create mode 100644 pkg/tbtables/tbswer.x create mode 100644 pkg/tbtables/tbswer1.x create mode 100644 pkg/tbtables/tbtables.h create mode 100644 pkg/tbtables/tbtacc.x create mode 100644 pkg/tbtables/tbtbod.x create mode 100644 pkg/tbtables/tbtchs.x create mode 100644 pkg/tbtables/tbtclo.x create mode 100644 pkg/tbtables/tbtcpy.x create mode 100644 pkg/tbtables/tbtcre.x create mode 100644 pkg/tbtables/tbtdel.x create mode 100644 pkg/tbtables/tbtext.x create mode 100644 pkg/tbtables/tbtflu.x create mode 100644 pkg/tbtables/tbtfst.x create mode 100644 pkg/tbtables/tbtnam.x create mode 100644 pkg/tbtables/tbtopn.x create mode 100644 pkg/tbtables/tbtopns.x create mode 100644 pkg/tbtables/tbtren.x create mode 100644 pkg/tbtables/tbtrsi.x create mode 100644 pkg/tbtables/tbtscd.x create mode 100644 pkg/tbtables/tbtscu.x create mode 100644 pkg/tbtables/tbtsrt.x create mode 100644 pkg/tbtables/tbttyp.x create mode 100644 pkg/tbtables/tbtwer.x create mode 100644 pkg/tbtables/tbtwsi.x create mode 100644 pkg/tbtables/tbuopn.x create mode 100644 pkg/tbtables/tbxag.x create mode 100644 pkg/tbtables/tbxap.x create mode 100644 pkg/tbtables/tbxcg.x create mode 100644 pkg/tbtables/tbxcp.x create mode 100644 pkg/tbtables/tbxncn.x create mode 100644 pkg/tbtables/tbxnew.x create mode 100644 pkg/tbtables/tbxnll.x create mode 100644 pkg/tbtables/tbxoff.x create mode 100644 pkg/tbtables/tbxrg.x create mode 100644 pkg/tbtables/tbxrp.x create mode 100644 pkg/tbtables/tbxscp.x create mode 100644 pkg/tbtables/tbxsft.x create mode 100644 pkg/tbtables/tbxsiz.x create mode 100644 pkg/tbtables/tbxudf.x create mode 100644 pkg/tbtables/tbxwer.x create mode 100644 pkg/tbtables/tbxwnc.x create mode 100644 pkg/tbtables/tbycg.x create mode 100644 pkg/tbtables/tbycp.x create mode 100644 pkg/tbtables/tbyncn.x create mode 100644 pkg/tbtables/tbynew.x create mode 100644 pkg/tbtables/tbynll.x create mode 100644 pkg/tbtables/tbyoff.x create mode 100644 pkg/tbtables/tbyrg.x create mode 100644 pkg/tbtables/tbyrp.x create mode 100644 pkg/tbtables/tbyscn.x create mode 100644 pkg/tbtables/tbyscp.x create mode 100644 pkg/tbtables/tbysft.x create mode 100644 pkg/tbtables/tbysiz.x create mode 100644 pkg/tbtables/tbyudf.x create mode 100644 pkg/tbtables/tbywer.x create mode 100644 pkg/tbtables/tbywnc.x create mode 100644 pkg/tbtables/tbzadd.x create mode 100644 pkg/tbtables/tbzcg.x create mode 100644 pkg/tbtables/tbzclo.x create mode 100644 pkg/tbtables/tbzcol.x create mode 100644 pkg/tbtables/tbzcp.x create mode 100644 pkg/tbtables/tbzd2t.x create mode 100644 pkg/tbtables/tbzgt.x create mode 100644 pkg/tbtables/tbzi2d.x create mode 100644 pkg/tbtables/tbzi2t.x create mode 100644 pkg/tbtables/tbzkey.x create mode 100644 pkg/tbtables/tbzlin.x create mode 100644 pkg/tbtables/tbzmem.x create mode 100644 pkg/tbtables/tbznew.x create mode 100644 pkg/tbtables/tbznll.x create mode 100644 pkg/tbtables/tbzopn.x create mode 100644 pkg/tbtables/tbzpt.x create mode 100644 pkg/tbtables/tbzrds.x create mode 100644 pkg/tbtables/tbzrdx.x create mode 100644 pkg/tbtables/tbzsft.x create mode 100644 pkg/tbtables/tbzsiz.x create mode 100644 pkg/tbtables/tbzsub.x create mode 100644 pkg/tbtables/tbzt2t.x create mode 100644 pkg/tbtables/tbztyp.x create mode 100644 pkg/tbtables/tbzudf.x create mode 100644 pkg/tbtables/tbzwer.x create mode 100644 pkg/tbtables/tbzwrt.x create mode 100644 pkg/tbtables/underscore.h (limited to 'pkg/tbtables') diff --git a/pkg/tbtables/README b/pkg/tbtables/README new file mode 100644 index 00000000..25eaaed4 --- /dev/null +++ b/pkg/tbtables/README @@ -0,0 +1,11 @@ +This directory contains the source for the SDAS table I/O routines. All +procedure names begin with "tb". The next letter usually gives some idea of +the kind of object the procedure deals with (t - table, r - row, c - column, +p - parameter, h - header parameter). Procedures beginning with "tbx", "tby", +"tbf" or "tbz" are lower-level routines for row-ordered tables, column-ordered +tables, FITS tables or text tables respectively. + +The top-level procedures are listed in calls.doc in the doc subdirectory. + +A description of the file format of a table is given by fileformat.doc in +the doc subdirectory. diff --git a/pkg/tbtables/Revisions b/pkg/tbtables/Revisions new file mode 100644 index 00000000..0e3d2432 --- /dev/null +++ b/pkg/tbtables/Revisions @@ -0,0 +1,16 @@ +tbyscp.x + The 'sbuf' pointer was being used with Memr (5/4/13, MJF) + +tbhanp.x + Quote strings in text, strip trailing spaces, and capitalize keywords + to be consistent with tbhpnp. (1/7/11, Valdes) + +tbhpnp.x + Don't remove leading whitespace. (1/7/11, Valdes) + +tbttyp.x + 1. Changes to better control the types and extensions. The accepted + extensions are |tab|fits|fit|fxb|txt|dat|cat|tmp|. + 2. If no extensions is given the default is now text instead of STSDAS + table. + (1/7/11, Valdes) diff --git a/pkg/tbtables/cfitsio/Licence.txt b/pkg/tbtables/cfitsio/Licence.txt new file mode 100644 index 00000000..f7698098 --- /dev/null +++ b/pkg/tbtables/cfitsio/Licence.txt @@ -0,0 +1,46 @@ +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. +(However, see the restriction on the use of the gzip compression code, +below). + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER. + +The file compress.c contains (slightly modified) source code that +originally came from gzip-1.2.4, copyright (C) 1992-1993 by Jean-loup +Gailly. This gzip code is distributed under the GNU General Public +Licence and thus requires that any software that uses the CFITSIO +library (which in turn uses the gzip code) must conform to the +provisions in the GNU General Public License. A copy of the GNU +licence is included at the beginning of compress.c file. + +An alternate version of the compress.c file (called compress_alternate.c) +is provided for users who want to use the CFITSIO library but are +unwilling or unable to publicly release their software under the terms +of the GNU General Public License. This alternate version contains +non-functional stubs for the file compression and uncompression +routines used by CFITSIO. Replace the file 'compress.c' with +'compress_alternate.c' before compiling the CFITSIO library. This will +produce a version of CFITSIO which does not support reading or writing +compressed FITS files but is otherwise identical to the standard +version. diff --git a/pkg/tbtables/cfitsio/Makefile.in b/pkg/tbtables/cfitsio/Makefile.in new file mode 100644 index 00000000..72ce5904 --- /dev/null +++ b/pkg/tbtables/cfitsio/Makefile.in @@ -0,0 +1,145 @@ +# +# Makefile for cfitsio library: +# libcfits.a +# +# Oct-96 : original version by +# +# JDD/WDP +# NASA GSFC +# Oct 1996 +# +# 25-Jan-01 : removed conditional drvrsmem.c compilation because this +# is now handled within the source file itself. +# 09-Mar-98 : modified to conditionally compile drvrsmem.c. Also +# changes to target all (deleted clean), added DEFS, LIBS, added +# DEFS to .c.o, added SOURCES_SHMEM and MY_SHMEM, expanded getcol* +# and putcol* in SOURCES, modified OBJECTS, mv changed to /bin/mv +# (to bypass aliasing), cp changed to /bin/cp, add smem and +# testprog targets. See also changes and comments in configure.in +# + +CFITSIO_LIB = @CFITSIO_PREFIX@/lib +CFITSIO_INCLUDE = @CFITSIO_PREFIX@/include + +SHELL = /bin/sh +RANLIB = @RANLIB@ +CC = @CC@ +CFLAGS = @CFLAGS@ +FC = @FC@ +LDFLAGS = $(CFLAGS) +DEFS = @DEFS@ +LIBS = @LIBS@ +FLEX = flex +BISON = bison + +SHLIB_LD = @SHLIB_LD@ +SHLIB_SUFFIX = @SHLIB_SUFFIX@ + +.c.o: + $(CC) -c $(CFLAGS) $(DEFS) $< + + +CORE_SOURCES = buffers.c cfileio.c checksum.c compress.c drvrfile.c drvrmem.c \ + drvrnet.c drvrsmem.c editcol.c edithdu.c eval_l.c eval_y.c \ + eval_f.c fitscore.c getcol.c getcolb.c getcold.c getcole.c \ + getcoli.c getcolj.c getcolk.c getcoll.c getcols.c getcolsb.c \ + getcoluk.c getcolui.c getcoluj.c getkey.c group.c grparser.c \ + histo.c iraffits.c \ + modkey.c putcol.c putcolb.c putcold.c putcole.c putcoli.c \ + putcolj.c putcolk.c putcoluk.c putcoll.c putcols.c putcolsb.c \ + putcolu.c putcolui.c putcoluj.c putkey.c region.c scalnull.c \ + swapproc.c wcssub.c wcsutil.c imcompress.c quantize.c ricecomp.c \ + pliocomp.c + +SOURCES = ${CORE_SOURCES} @F77_WRAPPERS@ + +OBJECTS = ${SOURCES:.c=.o} + +CORE_OBJECTS = ${CORE_SOURCES:.c=.o} + + +FITSIO_SRC = f77_wrap1.c f77_wrap2.c f77_wrap3.c f77_wrap4.c + +# ============ description of all targets ============= +# - <<-- ignore error code + +all: + @if [ "x${FC}" = x ]; then \ + ${MAKE} all-nofitsio; \ + else \ + ${MAKE} stand_alone; \ + fi + +all-nofitsio: + ${MAKE} stand_alone "FITSIO_SRC=" + +stand_alone: libcfitsio.a + +libcfitsio.a: ${OBJECTS} + ar rv libcfitsio.a ${OBJECTS}; \ + ${RANLIB} libcfitsio.a; + +shared: libcfitsio${SHLIB_SUFFIX} + +libcfitsio${SHLIB_SUFFIX}: ${OBJECTS} + ${SHLIB_LD} -o $@ ${OBJECTS} + +install: libcfitsio.a ${CFITSIO_LIB} ${CFITSIO_INCLUDE} + @if [ -f libcfitsio.a ]; then \ + /bin/mv libcfitsio.a ${CFITSIO_LIB}; \ + fi; \ + if [ -f libcfitsio${SHLIB_SUFFIX} ]; then \ + /bin/mv libcfitsio${SHLIB_SUFFIX} ${CFITSIO_LIB}; \ + fi; \ + /bin/cp fitsio.h fitsio2.h longnam.h drvrsmem.h ${CFITSIO_INCLUDE}/ + +smem: smem.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o smem smem.o -L. -lcfitsio -lm + +testprog: testprog.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o testprog testprog.o -L. -lcfitsio -lm ${LIBS} + +fitscopy: fitscopy.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o fitscopy fitscopy.o -L. -lcfitsio -lm ${LIBS} + +speed: speed.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o speed speed.o -L. -lcfitsio -lm ${LIBS} + +imcopy: imcopy.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o imcopy imcopy.o -L. -lcfitsio -lm ${LIBS} + +listhead: listhead.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o listhead listhead.o -L. -lcfitsio -lm ${LIBS} + +cookbook: cookbook.o libcfitsio.a ${OBJECTS} + ${CC} $(CFLAGS) $(DEFS) -o cookbook cookbook.o -L. -lcfitsio -lm ${LIBS} + +eval: # Rebuild eval_* files from flex/bison source + $(FLEX) -t eval.l > eval_l.c1 + /bin/sed -e 's/yy/ff/g' -e 's/YY/FF/g' eval_l.c1 > eval_l.c + /bin/rm -f eval_l.c1 + $(BISON) -d -v -y eval.y + /bin/sed -e 's/yy/ff/g' -e 's/YY/FF/g' y.tab.c > eval_y.c + /bin/sed -e 's/yy/ff/g' -e 's/YY/FF/g' y.tab.h > eval_tab.h + /bin/rm -f y.tab.c y.tab.h + +clean: + - /bin/rm -f *.o libcfitsio.a libcfitsio${SHLIB_SUFFIX} \ + smem testprog y.output + +distclean: clean + - /bin/rm -f Makefile config.* + +# Make target which outputs the list of the .o contained in the cfitsio lib +# usefull to build a single big shared library containing Tcl/Tk and other +# extensions. used for the Tcl Plugin. + +cfitsioLibObjs: + @echo ${CORE_OBJECTS} + +# This target actually builds the objects needed for the lib in the above +# case +objs: ${CORE_OBJECTS} + +${CFITSIO_LIB} ${CFITSIO_INCLUDE}: + @if [ ! -d $@ ]; then mkdir $@; fi diff --git a/pkg/tbtables/cfitsio/README b/pkg/tbtables/cfitsio/README new file mode 100644 index 00000000..bcd3123e --- /dev/null +++ b/pkg/tbtables/cfitsio/README @@ -0,0 +1,151 @@ + CFITSIO Interface Library + +CFITSIO is a library of ANSI C routines for reading and writing FITS +format data files. A set of Fortran-callable wrapper routines are also +included for the convenience of Fortran programmers. This README file +gives a brief summary of how to build and test CFITSIO, but the CFITSIO +User's Guide, found in the files cfitsio.doc (plain text), cfitsio.tex +(LaTeX source file), or cfitsio.ps (postscript format), should be +referenced for the latest and most complete information. + +BUILDING CFITSIO +---------------- + +The CFITSIO code is contained in about 40 *.c source files and several *.h +header files. The CFITSIO library is built on Unix systems by typing: + + > ./configure [--prefix=/target/installation/path] + > make (or 'make shared') + > make install (this step is optional) + +at the operating system prompt. The configure command customizes the +Makefile for the particular system, then the `make' command compiles the +source files and builds the library. Type `./configure' and not simply +`configure' to ensure that the configure script in the current directory +is run and not some other system-wide configure script. The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, + + > ./configure --prefix=/usr1/local + +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include files to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +On VAX/VMS and ALPHA/VMS systems the make.com command file may be used +to build the cfitsio.olb object library using the default G-floating +point option for double variables. The make\_dfloat.com and make\_ieee.com +files may be used instead to build the library with the other floating +point options. + +A precompiled DLL version of CFITSIO is available for IBM-PC users of +the Borland or Microsoft Visual C++ compilers in the files +cfitsiodll_2xxx_borland.zip and cfitsiodll_2xxx_vcc.zip, where '2xxx' +represents the current release number. These zip archives also +contains other files and instructions on how to use the CFITSIO DLL +library. The CFITSIO library may also be built from the source code +using the makefile.bc or makefile.vcc files. Finally, the makepc.bat +file gives an example of building CFITSIO with the Borland C++ v4.5 +compiler using simpler DOS commands. + +On OS/2 systems, CFITSIO can be built using the supplied makefile by +typing 'make -f makefile.os2'. This makefile requires the GCC compiler +and EMX library, which are available from many Internet sites +containing OS/2 software, such as +ftp-os2.nmsu.edu/pub/os2/dev/emx/v0.9c and +ftp.leo.org/pub/comp/os/os2/leo/devtools/emx+gcc. + +When building on Mac OS-X, users should follow the Unix instructions, +above. Previous MacOS versions of the cfitsio library can be built by +(1) un binhex and unstuff cfitsio_mac.sit.hqx, (2) put CFitsioPPC.mcp +in the cfitsio directory, and (3) load CFitsioPPC.mcp into CodeWarrior +Pro 5 and make. This builds the cfitsio library for PPC. There are +also targets for both the test program and the speed test program. + +To use the MacOS port you can add Cfitsio PPC.lib to your Codewarrior +Pro 5 project. Note that this only has been tested for the PPC and +probably won't work + on 68k macs. + +TESTING CFITSIO +--------------- + +The CFITSIO library should be tested by building and running +the testprog.c program that is included with the release. +On Unix systems, type: +- + % make testprog + % testprog > testprog.lis + % diff testprog.lis testprog.out + % cmp testprog.fit testprog.std +- + On VMS systems, +(assuming cc is the name of the C compiler command), type: +- + $ cc testprog.c + $ link testprog, cfitsio/lib + $ run testprog +- +The testprog program should produce a FITS file called `testprog.fit' +that is identical to the testprog.std FITS file included in this +release. The diagnostic messages (which were piped to the file +testprog.lis in the Unix example) should be identical to the listing +contained in the file testprog.out. The 'diff' and 'cmp' commands +shown above should not report any differences in the files. + +USING CFITSIO +------------- + +The CFITSIO User's Guide, contained in the files cfitsio.doc (plain +text file) and cfitsio.ps (postscript file), provides detailed +documentation about how to build and use the CFITSIO library. +It contains a description of every user-callable routine in the +CFITSIO interface. + +The cookbook.c file provides some sample routines for performing common +operations on various types of FITS files. Programmers are urged to +examine these routines for recommended programming practices when using +CFITSIO. Users are free to copy or modify these routines for their own +purposes. + +SUPPORTED PLATFORMS +------------------- + +CFITSIO has currently been tested on the following platforms: + + Operating System Compiler + ---------------- -------- + OPERATING SYSTEM COMPILER + Sun OS gcc and cc (3.0.1) + Sun Solaris gcc and cc + Silicon Graphics IRIX gcc and cc + Silicon Graphics IRIX64 MIPS + Dec Alpha OSF/1 gcc and cc + DECstation Ultrix gcc + Dec Alpha OpenVMS cc + DEC VAX/VMS gcc and cc + HP-UX gcc + IBM AIX gcc + Linux gcc + MkLinux DR3 + Windows 95/98/NT Borland C++ V4.5 + Windows 95/98/NT/ME/XP Microsoft/Compaq Visual C++ v5.0, v6.0 + Windows 95/98/NT Cygwin gcc + OS/2 gcc + EMX + Mac OS 7.1 or greater Metrowerks 10.+ + Mac OS-X 10.1 or greater cc (gcc) + +CFITSIO will probably run on most other Unix platforms without +modification. Cray supercomputers and IBM mainframe computers are +currently not supported. + +Reports of any success or failure to run CFITSIO on other platforms +would be appreciated. Any problem reports or suggestions for +improvements are also welcome and should be sent to the primary author. + +------------------------------------------------------------------------- +William D. Pence +pence@tetra.gsfc.nasa.gov +HEASARC, NASA/GSFC diff --git a/pkg/tbtables/cfitsio/README.MacOS b/pkg/tbtables/cfitsio/README.MacOS new file mode 100644 index 00000000..6deedcff --- /dev/null +++ b/pkg/tbtables/cfitsio/README.MacOS @@ -0,0 +1,31 @@ +To build the CFITSIO library on Mac OS-X systems, follow the +instructions for Unix platforms given in the CFITSIO User's Reference +Guide (cfitsio.doc). + +To build the MacOS port on classic Mac OS-9 or earlier: + +1. Un binhex and unstuff cfitsio_mac.sit.hqx +2. put CFitsioPPC.mcp in the cfitsio directory. +2. Load CFitsioPPC.mcp into CodeWarrior Pro 5 and make. + This builds the cfitsio library for PPC. There are also targets for both + the test program and the speed test program. + +To use the MacOS port you can add Cfitsio PPC.lib to your Codewarrior Pro 5 +project. Note that this only has been tested for the PPC. It probably +won't work on 68k macs. Also note that the fortran bindings aren't +included. I haven't worked with the codewarrior f2c plugin so I don't know +how these would work. If one is interested, please write and I can look +into this. + +bruce.oneel@obs.unige.ch + +Modifications... + +10/22/98: pwilson@sewanee.gsfc.nasa.gov + New files added for project. Converted to CodeWarrior Pro 3. + The speed test program does not run... complains about a missing library? +11/09/98: pwilson@sewanee.gsfc.nasa.gov + Fixed speed test problem thanks to Tom Andersen. +07/17/00: pwilson@milkyway.gsfc.nasa.gov + Updated to CodeWarrior Pro 5 and CFITSIO 2.037. + diff --git a/pkg/tbtables/cfitsio/buffers.c b/pkg/tbtables/cfitsio/buffers.c new file mode 100644 index 00000000..914f674d --- /dev/null +++ b/pkg/tbtables/cfitsio/buffers.c @@ -0,0 +1,1448 @@ +/* This file, buffers.c, contains the core set of FITSIO routines */ +/* that use or manage the internal set of IO buffers. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" + +char iobuffer[NIOBUF][IOBUFLEN]; /* initialize to zero by default */ +FITSfile *bufptr[NIOBUF]; /* initialize to zero by default */ +long bufrecnum[NIOBUF]; /* initialize to zero by default */ +int dirty[NIOBUF], ageindex[NIOBUF]; /* ages get initialized in ffwhbf */ + +/*--------------------------------------------------------------------------*/ +int ffmbyt(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T bytepos, /* I - byte position in file to move to */ + int err_mode, /* I - 1=ignore error, 0 = return error */ + int *status) /* IO - error status */ +{ +/* + Move to the input byte location in the file. When writing to a file, a move + may sometimes be made to a position beyond the current EOF. The err_mode + parameter determines whether such conditions should be returned as an error + or simply ignored. +*/ + long record; + + if (*status > 0) + return(*status); + + if (bytepos < 0) + return(*status = NEG_FILE_POS); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + record = bytepos / IOBUFLEN; /* zero-indexed record number */ + + /* if this is not the current record, then load it */ + if ( ((fptr->Fptr)->curbuf < 0) || + (record != bufrecnum[(fptr->Fptr)->curbuf])) + ffldrc(fptr, record, err_mode, status); + + if (*status <= 0) + (fptr->Fptr)->bytepos = bytepos; /* save new file position */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpbyt(fitsfile *fptr, /* I - FITS file pointer */ + long nbytes, /* I - number of bytes to write */ + void *buffer, /* I - buffer containing the bytes to write */ + int *status) /* IO - error status */ +/* + put (write) the buffer of bytes to the output FITS file, starting at + the current file position. Write large blocks of data directly to disk; + write smaller segments to intermediate IO buffers to improve efficiency. +*/ +{ + int ii, nbuff; + OFF_T filepos; + long recstart, recend; + long ntodo, bufpos, nspace, nwrite; + char *cptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + cptr = (char *)buffer; + ntodo = nbytes; + + if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */ + { /* so reload the last one that was used */ + ffldrc(fptr, ((fptr->Fptr)->bytepos) / IOBUFLEN, REPORT_EOF, status); + } + + if (nbytes >= MINDIRECT) + { + /* write large blocks of data directly to disk instead of via buffers */ + /* first, fill up the current IO buffer before flushing it to disk */ + + nbuff = (fptr->Fptr)->curbuf; /* current IO buffer number */ + filepos = (fptr->Fptr)->bytepos; /* save the write starting position */ + recstart = bufrecnum[nbuff]; /* starting record */ + recend = (filepos + nbytes - 1) / IOBUFLEN; /* ending record */ + + /* bufpos is the starting position within the IO buffer */ + bufpos = filepos - ((OFF_T)recstart * IOBUFLEN); + nspace = IOBUFLEN - bufpos; /* amount of space left in the buffer */ + + if (nspace) + { /* fill up the IO buffer */ + memcpy(iobuffer[nbuff] + bufpos, cptr, nspace); + ntodo -= nspace; /* decrement remaining number of bytes */ + cptr += nspace; /* increment user buffer pointer */ + filepos += nspace; /* increment file position pointer */ + dirty[nbuff] = TRUE; /* mark record as having been modified */ + } + + for (ii = 0; ii < NIOBUF; ii++) /* flush any affected buffers to disk */ + { + if (bufptr[ii] == fptr->Fptr && bufrecnum[ii] >= recstart + && bufrecnum[ii] <= recend ) + { + if (dirty[ii]) /* flush modified buffer to disk */ + ffbfwt(ii, status); + + bufptr[ii] = NULL; /* disassociate buffer from the file */ + } + } + + /* move to the correct write position */ + if ((fptr->Fptr)->io_pos != filepos) + ffseek(fptr->Fptr, filepos); + + nwrite = ((ntodo - 1) / IOBUFLEN) * IOBUFLEN; /* don't write last buff */ + + ffwrite(fptr->Fptr, nwrite, cptr, status); /* write the data */ + ntodo -= nwrite; /* decrement remaining number of bytes */ + cptr += nwrite; /* increment user buffer pointer */ + (fptr->Fptr)->io_pos = filepos + nwrite; /* update the file position */ + + if ((fptr->Fptr)->io_pos >= (fptr->Fptr)->filesize) /* at the EOF? */ + { + (fptr->Fptr)->filesize = (fptr->Fptr)->io_pos; /* increment file size */ + + /* initialize the current buffer with the correct fill value */ + if ((fptr->Fptr)->hdutype == ASCII_TBL) + memset(iobuffer[nbuff], 32, IOBUFLEN); /* blank fill */ + else + memset(iobuffer[nbuff], 0, IOBUFLEN); /* zero fill */ + } + else + { + /* read next record */ + ffread(fptr->Fptr, IOBUFLEN, iobuffer[nbuff], status); + (fptr->Fptr)->io_pos += IOBUFLEN; + } + + /* copy remaining bytes from user buffer into current IO buffer */ + memcpy(iobuffer[nbuff], cptr, ntodo); + dirty[nbuff] = TRUE; /* mark record as having been modified */ + bufrecnum[nbuff] = recend; /* record number */ + bufptr[nbuff] = fptr->Fptr; /* file pointer associated with IO buffer */ + + (fptr->Fptr)->logfilesize = maxvalue((fptr->Fptr)->logfilesize, + (OFF_T)(recend + 1) * IOBUFLEN); + (fptr->Fptr)->bytepos = filepos + nwrite + ntodo; + } + else + { + /* bufpos is the starting position in IO buffer */ + bufpos = (fptr->Fptr)->bytepos - ((OFF_T)bufrecnum[(fptr->Fptr)->curbuf] * + IOBUFLEN); + nspace = IOBUFLEN - bufpos; /* amount of space left in the buffer */ + + while (ntodo) + { + nwrite = minvalue(ntodo, nspace); + + /* copy bytes from user's buffer to the IO buffer */ + memcpy(iobuffer[(fptr->Fptr)->curbuf] + bufpos, cptr, nwrite); + ntodo -= nwrite; /* decrement remaining number of bytes */ + cptr += nwrite; + (fptr->Fptr)->bytepos += nwrite; /* increment file position pointer */ + dirty[(fptr->Fptr)->curbuf] = TRUE; /* mark record as modified */ + + if (ntodo) /* load next record into a buffer */ + { + ffldrc(fptr, (fptr->Fptr)->bytepos / IOBUFLEN, IGNORE_EOF, status); + bufpos = 0; + nspace = IOBUFLEN; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpbytoff(fitsfile *fptr, /* I - FITS file pointer */ + long gsize, /* I - size of each group of bytes */ + long ngroups, /* I - number of groups to write */ + long offset, /* I - size of gap between groups */ + void *buffer, /* I - buffer to be written */ + int *status) /* IO - error status */ +/* + put (write) the buffer of bytes to the output FITS file, with an offset + between each group of bytes. This function combines ffmbyt and ffpbyt + for increased efficiency. +*/ +{ + int bcurrent; + long ii, bufpos, nspace, nwrite, record; + char *cptr, *ioptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */ + { /* so reload the last one that was used */ + ffldrc(fptr, ((fptr->Fptr)->bytepos) / IOBUFLEN, REPORT_EOF, status); + } + + cptr = (char *)buffer; + bcurrent = (fptr->Fptr)->curbuf; /* number of the current IO buffer */ + record = bufrecnum[bcurrent]; /* zero-indexed record number */ + bufpos = (fptr->Fptr)->bytepos - ((OFF_T)record * IOBUFLEN); /* start pos */ + nspace = IOBUFLEN - bufpos; /* amount of space left in buffer */ + ioptr = iobuffer[bcurrent] + bufpos; + + for (ii = 1; ii < ngroups; ii++) /* write all but the last group */ + { + /* copy bytes from user's buffer to the IO buffer */ + nwrite = minvalue(gsize, nspace); + memcpy(ioptr, cptr, nwrite); + cptr += nwrite; /* increment buffer pointer */ + + if (nwrite < gsize) /* entire group did not fit */ + { + dirty[bcurrent] = TRUE; /* mark record as having been modified */ + record++; + ffldrc(fptr, record, IGNORE_EOF, status); /* load next record */ + bcurrent = (fptr->Fptr)->curbuf; + ioptr = iobuffer[bcurrent]; + + nwrite = gsize - nwrite; + memcpy(ioptr, cptr, nwrite); + cptr += nwrite; /* increment buffer pointer */ + ioptr += (offset + nwrite); /* increment IO buffer pointer */ + nspace = IOBUFLEN - offset - nwrite; /* amount of space left */ + } + else + { + ioptr += (offset + nwrite); /* increment IO bufer pointer */ + nspace -= (offset + nwrite); + } + + if (nspace <= 0) /* beyond current record? */ + { + dirty[bcurrent] = TRUE; + record += ((IOBUFLEN - nspace) / IOBUFLEN); /* new record number */ + ffldrc(fptr, record, IGNORE_EOF, status); + bcurrent = (fptr->Fptr)->curbuf; + + bufpos = (-nspace) % IOBUFLEN; /* starting buffer pos */ + nspace = IOBUFLEN - bufpos; + ioptr = iobuffer[bcurrent] + bufpos; + } + } + + /* now write the last group */ + nwrite = minvalue(gsize, nspace); + memcpy(ioptr, cptr, nwrite); + cptr += nwrite; /* increment buffer pointer */ + + if (nwrite < gsize) /* entire group did not fit */ + { + dirty[bcurrent] = TRUE; /* mark record as having been modified */ + record++; + ffldrc(fptr, record, IGNORE_EOF, status); /* load next record */ + bcurrent = (fptr->Fptr)->curbuf; + ioptr = iobuffer[bcurrent]; + + nwrite = gsize - nwrite; + memcpy(ioptr, cptr, nwrite); + } + + dirty[bcurrent] = TRUE; /* mark record as having been modified */ + (fptr->Fptr)->bytepos = (fptr->Fptr)->bytepos + (ngroups * gsize) + + (ngroups - 1) * offset; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgbyt(fitsfile *fptr, /* I - FITS file pointer */ + long nbytes, /* I - number of bytes to read */ + void *buffer, /* O - buffer to read into */ + int *status) /* IO - error status */ +/* + get (read) the requested number of bytes from the file, starting at + the current file position. Read large blocks of data directly from disk; + read smaller segments via intermediate IO buffers to improve efficiency. +*/ +{ + int ii; + OFF_T filepos; + long recstart, recend, ntodo, bufpos, nspace, nread; + char *cptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + cptr = (char *)buffer; + + if (nbytes >= MINDIRECT) + { + /* read large blocks of data directly from disk instead of via buffers */ + filepos = (fptr->Fptr)->bytepos; /* save the read starting position */ + +/* note that in this case, ffmbyt has not been called, and so */ +/* bufrecnum[(fptr->Fptr)->curbuf] does not point to the intended */ +/* output buffer */ + + recstart = filepos / IOBUFLEN; /* starting record */ + recend = (filepos + nbytes - 1) / IOBUFLEN; /* ending record */ + + for (ii = 0; ii < NIOBUF; ii++) /* flush any affected buffers to disk */ + { + if (dirty[ii] && bufptr[ii] == fptr->Fptr && + bufrecnum[ii] >= recstart && bufrecnum[ii] <= recend) + { + ffbfwt(ii, status); /* flush modified buffer to disk */ + } + } + + /* move to the correct read position */ + if ((fptr->Fptr)->io_pos != filepos) + ffseek(fptr->Fptr, filepos); + + ffread(fptr->Fptr, nbytes, cptr, status); /* read the data */ + (fptr->Fptr)->io_pos = filepos + nbytes; /* update the file position */ + } + else + { + /* read small chucks of data using the IO buffers for efficiency */ + + if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */ + { /* so reload the last one that was used */ + ffldrc(fptr, ((fptr->Fptr)->bytepos) / IOBUFLEN, REPORT_EOF, status); + } + + /* bufpos is the starting position in IO buffer */ + bufpos = (fptr->Fptr)->bytepos - ((OFF_T)bufrecnum[(fptr->Fptr)->curbuf] * + IOBUFLEN); + nspace = IOBUFLEN - bufpos; /* amount of space left in the buffer */ + + ntodo = nbytes; + while (ntodo) + { + nread = minvalue(ntodo, nspace); + + /* copy bytes from IO buffer to user's buffer */ + memcpy(cptr, iobuffer[(fptr->Fptr)->curbuf] + bufpos, nread); + ntodo -= nread; /* decrement remaining number of bytes */ + cptr += nread; + (fptr->Fptr)->bytepos += nread; /* increment file position pointer */ + + if (ntodo) /* load next record into a buffer */ + { + ffldrc(fptr, (fptr->Fptr)->bytepos / IOBUFLEN, REPORT_EOF, status); + bufpos = 0; + nspace = IOBUFLEN; + } + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgbytoff(fitsfile *fptr, /* I - FITS file pointer */ + long gsize, /* I - size of each group of bytes */ + long ngroups, /* I - number of groups to read */ + long offset, /* I - size of gap between groups (may be < 0) */ + void *buffer, /* I - buffer to be filled */ + int *status) /* IO - error status */ +/* + get (read) the requested number of bytes from the file, starting at + the current file position. This function combines ffmbyt and ffgbyt + for increased efficiency. +*/ +{ + int bcurrent; + long ii, bufpos, nspace, nread, record; + char *cptr, *ioptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */ + { /* so reload the last one that was used */ + ffldrc(fptr, ((fptr->Fptr)->bytepos) / IOBUFLEN, REPORT_EOF, status); + } + + cptr = (char *)buffer; + bcurrent = (fptr->Fptr)->curbuf; /* number of the current IO buffer */ + record = bufrecnum[bcurrent]; /* zero-indexed record number */ + bufpos = (fptr->Fptr)->bytepos - ((OFF_T)record * IOBUFLEN); /* start pos */ + nspace = IOBUFLEN - bufpos; /* amount of space left in buffer */ + ioptr = iobuffer[bcurrent] + bufpos; + + for (ii = 1; ii < ngroups; ii++) /* read all but the last group */ + { + /* copy bytes from IO buffer to the user's buffer */ + nread = minvalue(gsize, nspace); + memcpy(cptr, ioptr, nread); + cptr += nread; /* increment buffer pointer */ + + if (nread < gsize) /* entire group did not fit */ + { + record++; + ffldrc(fptr, record, REPORT_EOF, status); /* load next record */ + bcurrent = (fptr->Fptr)->curbuf; + ioptr = iobuffer[bcurrent]; + + nread = gsize - nread; + memcpy(cptr, ioptr, nread); + cptr += nread; /* increment buffer pointer */ + ioptr += (offset + nread); /* increment IO buffer pointer */ + nspace = IOBUFLEN - offset - nread; /* amount of space left */ + } + else + { + ioptr += (offset + nread); /* increment IO bufer pointer */ + nspace -= (offset + nread); + } + + if (nspace <= 0 || nspace > IOBUFLEN) /* beyond current record? */ + { + if (nspace <= 0) + { + record += ((IOBUFLEN - nspace) / IOBUFLEN); /* new record number */ + bufpos = (-nspace) % IOBUFLEN; /* starting buffer pos */ + } + else + { + record -= ((nspace - 1 ) / IOBUFLEN); /* new record number */ + bufpos = IOBUFLEN - (nspace % IOBUFLEN); /* starting buffer pos */ + } + + ffldrc(fptr, record, REPORT_EOF, status); + bcurrent = (fptr->Fptr)->curbuf; + + nspace = IOBUFLEN - bufpos; + ioptr = iobuffer[bcurrent] + bufpos; + } + } + + /* now read the last group */ + nread = minvalue(gsize, nspace); + memcpy(cptr, ioptr, nread); + cptr += nread; /* increment buffer pointer */ + + if (nread < gsize) /* entire group did not fit */ + { + record++; + ffldrc(fptr, record, REPORT_EOF, status); /* load next record */ + bcurrent = (fptr->Fptr)->curbuf; + ioptr = iobuffer[bcurrent]; + + nread = gsize - nread; + memcpy(cptr, ioptr, nread); + } + + (fptr->Fptr)->bytepos = (fptr->Fptr)->bytepos + (ngroups * gsize) + + (ngroups - 1) * offset; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffldrc(fitsfile *fptr, /* I - FITS file pointer */ + long record, /* I - record number to be loaded */ + int err_mode, /* I - 1=ignore EOF, 0 = return EOF error */ + int *status) /* IO - error status */ +{ +/* + low-level routine to load a specified record from a file into + a physical buffer, if it is not already loaded. Reset all + pointers to make this the new current record for that file. + Update ages of all the physical buffers. +*/ + int ibuff, nbuff; + OFF_T rstart; + + /* check if record is already loaded in one of the buffers */ + /* search from youngest to oldest buffer for efficiency */ + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + for (ibuff = NIOBUF - 1; ibuff >= 0; ibuff--) + { + nbuff = ageindex[ibuff]; + if (bufptr[nbuff] == fptr->Fptr && record == bufrecnum[nbuff]) + goto updatebuf; /* use 'goto' for efficiency */ + } + + /* record is not already loaded */ + rstart = (OFF_T)record * IOBUFLEN; + + if ( !err_mode && (rstart >= (fptr->Fptr)->logfilesize) ) /* EOF? */ + return(*status = END_OF_FILE); + + if (ffwhbf(fptr, &nbuff) < 0) /* which buffer should we reuse? */ + return(*status = TOO_MANY_FILES); + + if (dirty[nbuff]) + ffbfwt(nbuff, status); /* write dirty buffer to disk */ + + if (rstart >= (fptr->Fptr)->filesize) /* EOF? */ + { + /* initialize an empty buffer with the correct fill value */ + if ((fptr->Fptr)->hdutype == ASCII_TBL) + memset(iobuffer[nbuff], 32, IOBUFLEN); /* blank fill */ + else + memset(iobuffer[nbuff], 0, IOBUFLEN); /* zero fill */ + + (fptr->Fptr)->logfilesize = maxvalue((fptr->Fptr)->logfilesize, + rstart + IOBUFLEN); + + dirty[nbuff] = TRUE; /* mark record as having been modified */ + } + else /* not EOF, so read record from disk */ + { + if ((fptr->Fptr)->io_pos != rstart) + ffseek(fptr->Fptr, rstart); + + ffread(fptr->Fptr, IOBUFLEN, iobuffer[nbuff], status); + (fptr->Fptr)->io_pos = rstart + IOBUFLEN; /* set new IO position */ + } + + bufptr[nbuff] = fptr->Fptr; /* file pointer for this buffer */ + bufrecnum[nbuff] = record; /* record number contained in buffer */ + +updatebuf: + + (fptr->Fptr)->curbuf = nbuff; /* this is the current buffer for this file */ + + if (ibuff < 0) + { + /* find the current position of the buffer in the age index */ + for (ibuff = 0; ibuff < NIOBUF; ibuff++) + if (ageindex[ibuff] == nbuff) + break; + } + + /* increment the age of all the buffers that were younger than it */ + for (ibuff++; ibuff < NIOBUF; ibuff++) + ageindex[ibuff - 1] = ageindex[ibuff]; + + ageindex[NIOBUF - 1] = nbuff; /* this is now the youngest buffer */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffwhbf(fitsfile *fptr, /* I - FITS file pointer */ + int *nbuff) /* O - which buffer to use */ +{ +/* + decide which buffer to (re)use to hold a new file record +*/ + int ii, ibuff; + static int ageinit = 0; + + if (!ageinit) /* first time thru, initialize default age of buffers */ + { + for (ii = 0; ii < NIOBUF; ii++) + ageindex[ii] = ii; + ageinit = 1; + } + + for (ii = 0; ii < NIOBUF; ii++) + { + ibuff = ageindex[ii]; /* search from the oldest to youngest buffer */ + + if (bufptr[ibuff] == NULL || /* if buffer is empty, or */ + bufptr[ibuff]->curbuf != ibuff) /* is not the current buffer */ + return(*nbuff = ibuff); /* then choose this buffer */ + } + + /* all the buffers are locked, so we have to reuse the current one */ + /* If there is no current buffer (e.g., file has just been opened) */ + /* then use the oldest buffer. */ + + if ((fptr->Fptr)->curbuf < 0) { + bufptr[ageindex[0]]->curbuf = -1; /* this buffer no longer contains */ + /* the current buffer of another file */ + return(*nbuff = ageindex[0]); /* return oldest buffer */ + } else { + return(*nbuff = (fptr->Fptr)->curbuf); /* return current buffer */ + } +} +/*--------------------------------------------------------------------------*/ +int ffflus(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Flush all the data in the current FITS file to disk. This ensures that if + the program subsequently dies, the disk FITS file will be closed correctly. +*/ +{ + int hdunum, hdutype; + + if (*status > 0) + return(*status); + + ffghdn(fptr, &hdunum); /* get the current HDU number */ + + if (ffchdu(fptr,status) > 0) /* close out the current HDU */ + ffpmsg("ffflus could not close the current HDU."); + + ffflsh(fptr, FALSE, status); /* flush any modified IO buffers to disk */ + + if (ffgext(fptr, hdunum - 1, &hdutype, status) > 0) /* reopen HDU */ + ffpmsg("ffflus could not reopen the current HDU."); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffflsh(fitsfile *fptr, /* I - FITS file pointer */ + int clearbuf, /* I - also clear buffer contents? */ + int *status) /* IO - error status */ +{ +/* + flush all dirty IO buffers associated with the file to disk +*/ + int ii; + +/* + no need to move to a different HDU + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); +*/ + for (ii = 0; ii < NIOBUF; ii++) + { + if (bufptr[ii] == fptr->Fptr) + { + if (dirty[ii]) /* flush modified buffer to disk */ + ffbfwt(ii, status); + + if (clearbuf) + bufptr[ii] = NULL; /* set contents of buffer as undefined */ + } + } + + if (*status != READONLY_FILE) + ffflushx(fptr->Fptr); /* flush system buffers to disk */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffbfeof(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +{ +/* + clear any buffers beyond the end of file +*/ + int ii; + + for (ii = 0; ii < NIOBUF; ii++) + { + if (bufptr[ii] == fptr->Fptr) + { + if ( (OFF_T) bufrecnum[ii] * IOBUFLEN >= fptr->Fptr->filesize) + { + bufptr[ii] = NULL; /* set contents of buffer as undefined */ + } + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffbfwt(int nbuff, /* I - which buffer to write */ + int *status) /* IO - error status */ +{ +/* + write contents of buffer to file; If the position of the buffer + is beyond the current EOF, then the file may need to be extended + with fill values, and/or with the contents of some of the other + i/o buffers. +*/ + FITSfile *Fptr; + int ii,ibuff; + long jj, irec, minrec, nloop; + OFF_T filepos; + + static char zeros[IOBUFLEN]; /* initialized to zero by default */ + + Fptr = bufptr[nbuff]; + if (!(Fptr->writemode) ) + { + ffpmsg("Error: trying to write to READONLY file."); + dirty[nbuff] = FALSE; /* reset buffer status to prevent later probs */ + *status = READONLY_FILE; + return(*status); + } + + filepos = (OFF_T)bufrecnum[nbuff] * IOBUFLEN; + + if (filepos <= Fptr->filesize) + { + /* record is located within current file, so just write it */ + + /* move to the correct write position */ + if (Fptr->io_pos != filepos) + ffseek(Fptr, filepos); + + ffwrite(Fptr, IOBUFLEN, iobuffer[nbuff], status); + Fptr->io_pos = filepos + IOBUFLEN; + + if (filepos == Fptr->filesize) /* appended new record? */ + Fptr->filesize += IOBUFLEN; /* increment the file size */ + + dirty[nbuff] = FALSE; + } + + else /* if record is beyond the EOF, append any other records */ + /* and/or insert fill values if necessary */ + { + /* move to EOF */ + if (Fptr->io_pos != Fptr->filesize) + ffseek(Fptr, Fptr->filesize); + + ibuff = NIOBUF; /* initialize to impossible value */ + while(ibuff != nbuff) /* repeat until requested buffer is written */ + { + minrec = Fptr->filesize / IOBUFLEN; + + /* write lowest record beyond the EOF first */ + + irec = bufrecnum[nbuff]; /* initially point to the requested buffer */ + ibuff = nbuff; + + for (ii = 0; ii < NIOBUF; ii++) + { + if (bufptr[ii] == Fptr && bufrecnum[ii] >= minrec && + bufrecnum[ii] < irec) + { + irec = bufrecnum[ii]; /* found a lower record */ + ibuff = ii; + } + } + + filepos = (OFF_T)irec * IOBUFLEN; /* byte offset of record in file */ + + /* append 1 or more fill records if necessary */ + if (filepos > Fptr->filesize) + { + nloop = (filepos - (Fptr->filesize)) / IOBUFLEN; + for (jj = 0; jj < nloop && !(*status); jj++) + ffwrite(Fptr, IOBUFLEN, zeros, status); + +/* +ffseek(Fptr, filepos); +*/ + Fptr->filesize = filepos; /* increment the file size */ + } + + /* write the buffer itself */ + ffwrite(Fptr, IOBUFLEN, iobuffer[ibuff], status); + dirty[ibuff] = FALSE; + + Fptr->filesize += IOBUFLEN; /* increment the file size */ + } /* loop back if more buffers need to be written */ + + Fptr->io_pos = Fptr->filesize; /* currently positioned at EOF */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgrsz( fitsfile *fptr, /* I - FITS file pionter */ + long *ndata, /* O - optimal amount of data to access */ + int *status) /* IO - error status */ +/* + Returns an optimal value for the number of rows in a binary table + or the number of pixels in an image that should be read or written + at one time for maximum efficiency. Accessing more data than this + may cause excessive flushing and rereading of buffers to/from disk. +*/ +{ + int nfiles, typecode, bytesperpixel; + long repeat, width; + + /* There are NIOBUF internal buffers available each IOBUFLEN bytes long. */ + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header to get hdu struct */ + return(*status); + + /* determine how many different FITS files are currently open */ + nfiles = fits_get_num_files(); + + /* one buffer (at least) is always allocated to each open file */ + + if ((fptr->Fptr)->hdutype == IMAGE_HDU ) /* calc pixels per buffer size */ + { + /* image pixels are in column 2 of the 'table' */ + ffgtcl(fptr, 2, &typecode, &repeat, &width, status); + bytesperpixel = typecode / 10; + *ndata = ((NIOBUF - nfiles) * IOBUFLEN) / bytesperpixel; + } + else /* calc number of rows that fit in buffers */ + { + *ndata = ((NIOBUF - nfiles) * IOBUFLEN) / maxvalue(1, + (fptr->Fptr)->rowlength); + *ndata = maxvalue(1, *ndata); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_num_files(void) +/* + Returns the number of FITS files currently opened in CFITSIO +*/ +{ + int ii, jj, unique, nfiles; + + /* determine how many different FITS files are currently open */ + nfiles = 0; + for (ii = 0; ii < NIOBUF; ii++) + { + if (bufptr[ii]) + { + unique = TRUE; + + for (jj = 0; jj < ii; jj++) + { + if (bufptr[ii] == bufptr[jj]) + { + unique = FALSE; + break; + } + } + + if (unique) + nfiles++; + } + } + return(nfiles); +} +/*--------------------------------------------------------------------------*/ +int ffgtbb(fitsfile *fptr, /* I - FITS file pointer */ + long firstrow, /* I - starting row (1 = first row) */ + long firstchar, /* I - starting byte in row (1=first) */ + long nchars, /* I - number of bytes to read */ + unsigned char *values, /* I - array of bytes to read */ + int *status) /* IO - error status */ +/* + read a consecutive string of bytes from an ascii or binary table. + This will span multiple rows of the table if nchars + firstchar is + greater than the length of a row. +*/ +{ + OFF_T bytepos; + long endrow; + + if (*status > 0 || nchars <= 0) + return(*status); + + else if (firstrow < 1) + return(*status=BAD_ROW_NUM); + + else if (firstchar < 1) + return(*status=BAD_ELEM_NUM); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* check that we do not exceed number of rows in the table */ + endrow = ((firstchar + nchars - 2) / (fptr->Fptr)->rowlength) + firstrow; + if (endrow > (fptr->Fptr)->numrows) + { + ffpmsg("attempt to read past end of table (ffgtbb)"); + return(*status=BAD_ROW_NUM); + } + + /* move the i/o pointer to the start of the sequence of characters */ + bytepos = (fptr->Fptr)->datastart + + ((fptr->Fptr)->rowlength * (firstrow - 1)) + + firstchar - 1; + + ffmbyt(fptr, bytepos, REPORT_EOF, status); + ffgbyt(fptr, nchars, values, status); /* read the bytes */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgi1b(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T byteloc, /* I - position within file to start reading */ + long nvals, /* I - number of pixels to read */ + long incre, /* I - byte increment between pixels */ + unsigned char *values, /* O - returned array of values */ + int *status) /* IO - error status */ +/* + get (read) the array of values from the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ + OFF_T postemp; + + if (incre == 1) /* read all the values at once (contiguous bytes) */ + { + if (nvals < MINDIRECT) /* read normally via IO buffers */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbyt(fptr, nvals, values, status); + } + else /* read directly from disk, bypassing IO buffers */ + { + postemp = (fptr->Fptr)->bytepos; /* store current file position */ + (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */ + ffgbyt(fptr, nvals, values, status); + (fptr->Fptr)->bytepos = postemp; /* reset to original position */ + } + } + else /* have to read each value individually (not contiguous ) */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbytoff(fptr, 1, nvals, incre - 1, values, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgi2b(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T byteloc, /* I - position within file to start reading */ + long nvals, /* I - number of pixels to read */ + long incre, /* I - byte increment between pixels */ + short *values, /* O - returned array of values */ + int *status) /* IO - error status */ +/* + get (read) the array of values from the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ + OFF_T postemp; + + if (incre == 2) /* read all the values at once (contiguous bytes) */ + { + if (nvals * 2 < MINDIRECT) /* read normally via IO buffers */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbyt(fptr, nvals * 2, values, status); + } + else /* read directly from disk, bypassing IO buffers */ + { + postemp = (fptr->Fptr)->bytepos; /* store current file position */ + (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */ + ffgbyt(fptr, nvals * 2, values, status); + (fptr->Fptr)->bytepos = postemp; /* reset to original position */ + } + } + else /* have to read each value individually (not contiguous ) */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbytoff(fptr, 2, nvals, incre - 2, values, status); + } + +#if BYTESWAPPED + ffswap2(values, nvals); /* reverse order of bytes in each value */ +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgi4b(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T byteloc, /* I - position within file to start reading */ + long nvals, /* I - number of pixels to read */ + long incre, /* I - byte increment between pixels */ + INT32BIT *values, /* O - returned array of values */ + int *status) /* IO - error status */ +/* + get (read) the array of values from the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ + OFF_T postemp; + + if (incre == 4) /* read all the values at once (contiguous bytes) */ + { + if (nvals * 4 < MINDIRECT) /* read normally via IO buffers */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbyt(fptr, nvals * 4, values, status); + } + else /* read directly from disk, bypassing IO buffers */ + { + postemp = (fptr->Fptr)->bytepos; /* store current file position */ + (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */ + ffgbyt(fptr, nvals * 4, values, status); + (fptr->Fptr)->bytepos = postemp; /* reset to original position */ + } + } + else /* have to read each value individually (not contiguous ) */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbytoff(fptr, 4, nvals, incre - 4, values, status); + } + +#if BYTESWAPPED + ffswap4(values, nvals); /* reverse order of bytes in each value */ +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgi8b(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T byteloc, /* I - position within file to start reading */ + long nvals, /* I - number of pixels to read */ + long incre, /* I - byte increment between pixels */ + long *values, /* O - returned array of values */ + int *status) /* IO - error status */ +/* + get (read) the array of values from the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + This routine reads 'nvals' 8-byte integers into 'values'. + This works both on platforms that have sizeof(long) = 64, and 32, + as long as 'values' has been allocated to large enough to hold + 8 * nvals bytes of data. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +*/ +{ + OFF_T postemp; + + if (incre == 8) /* read all the values at once (contiguous bytes) */ + { + if (nvals * 8 < MINDIRECT) /* read normally via IO buffers */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbyt(fptr, nvals * 8, values, status); + } + else /* read directly from disk, bypassing IO buffers */ + { + postemp = (fptr->Fptr)->bytepos; /* store current file position */ + (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */ + ffgbyt(fptr, nvals * 8, values, status); + (fptr->Fptr)->bytepos = postemp; /* reset to original position */ + } + } + else /* have to read each value individually (not contiguous ) */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbytoff(fptr, 8, nvals, incre - 8, values, status); + } + +#if BYTESWAPPED + ffswap8((double *) values, nvals); /* reverse bytes in each value */ +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgr4b(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T byteloc, /* I - position within file to start reading */ + long nvals, /* I - number of pixels to read */ + long incre, /* I - byte increment between pixels */ + float *values, /* O - returned array of values */ + int *status) /* IO - error status */ +/* + get (read) the array of values from the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ + OFF_T postemp; + +#if MACHINE == VAXVMS + long ii; + +#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT) + short *sptr; + long ii; + +#endif + + + if (incre == 4) /* read all the values at once (contiguous bytes) */ + { + if (nvals * 4 < MINDIRECT) /* read normally via IO buffers */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbyt(fptr, nvals * 4, values, status); + } + else /* read directly from disk, bypassing IO buffers */ + { + postemp = (fptr->Fptr)->bytepos; /* store current file position */ + (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */ + ffgbyt(fptr, nvals * 4, values, status); + (fptr->Fptr)->bytepos = postemp; /* reset to original position */ + } + } + else /* have to read each value individually (not contiguous ) */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbytoff(fptr, 4, nvals, incre - 4, values, status); + } + + +#if MACHINE == VAXVMS + + ii = nvals; /* call VAX macro routine to convert */ + ieevur(values, values, &ii); /* from IEEE float -> F float */ + +#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT) + + ffswap2( (short *) values, nvals * 2); /* swap pairs of bytes */ + + /* convert from IEEE float format to VMS GFLOAT float format */ + sptr = (short *) values; + for (ii = 0; ii < nvals; ii++, sptr += 2) + { + if (!fnan(*sptr) ) /* test for NaN or underflow */ + values[ii] *= 4.0; + } + +#elif BYTESWAPPED + ffswap4((INT32BIT *)values, nvals); /* reverse order of bytes in values */ +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgr8b(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T byteloc, /* I - position within file to start reading */ + long nvals, /* I - number of pixels to read */ + long incre, /* I - byte increment between pixels */ + double *values, /* O - returned array of values */ + int *status) /* IO - error status */ +/* + get (read) the array of values from the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ + OFF_T postemp; + +#if MACHINE == VAXVMS + long ii; + +#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT) + short *sptr; + long ii; + +#endif + + if (incre == 8) /* read all the values at once (contiguous bytes) */ + { + if (nvals * 8 < MINDIRECT) /* read normally via IO buffers */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbyt(fptr, nvals * 8, values, status); + } + else /* read directly from disk, bypassing IO buffers */ + { + postemp = (fptr->Fptr)->bytepos; /* store current file position */ + (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */ + ffgbyt(fptr, nvals * 8, values, status); + (fptr->Fptr)->bytepos = postemp; /* reset to original position */ + } + } + else /* have to read each value individually (not contiguous ) */ + { + ffmbyt(fptr, byteloc, REPORT_EOF, status); + ffgbytoff(fptr, 8, nvals, incre - 8, values, status); + } + +#if MACHINE == VAXVMS + ii = nvals; /* call VAX macro routine to convert */ + ieevud(values, values, &ii); /* from IEEE float -> D float */ + +#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT) + ffswap2( (short *) values, nvals * 4); /* swap pairs of bytes */ + + /* convert from IEEE float format to VMS GFLOAT float format */ + sptr = (short *) values; + for (ii = 0; ii < nvals; ii++, sptr += 4) + { + if (!dnan(*sptr) ) /* test for NaN or underflow */ + values[ii] *= 4.0; + } + +#elif BYTESWAPPED + ffswap8(values, nvals); /* reverse order of bytes in each value */ +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffptbb(fitsfile *fptr, /* I - FITS file pointer */ + long firstrow, /* I - starting row (1 = first row) */ + long firstchar, /* I - starting byte in row (1=first) */ + long nchars, /* I - number of bytes to write */ + unsigned char *values, /* I - array of bytes to write */ + int *status) /* IO - error status */ +/* + write a consecutive string of bytes to an ascii or binary table. + This will span multiple rows of the table if nchars + firstchar is + greater than the length of a row. +*/ +{ + OFF_T bytepos; + long endrow, nrows; + char message[81]; + + if (*status > 0 || nchars <= 0) + return(*status); + + else if (firstrow < 1) + return(*status=BAD_ROW_NUM); + + else if (firstchar < 1) + return(*status=BAD_ELEM_NUM); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart < 0) /* rescan header if data undefined */ + ffrdef(fptr, status); + + endrow = ((firstchar + nchars - 2) / (fptr->Fptr)->rowlength) + firstrow; + + /* check if we are writing beyond the current end of table */ + if (endrow > (fptr->Fptr)->numrows) + { + /* if there are more HDUs following the current one, or */ + /* if there is a data heap, then we must insert space */ + /* for the new rows. */ + if ( !((fptr->Fptr)->lasthdu) || (fptr->Fptr)->heapsize > 0) + { + nrows = endrow - ((fptr->Fptr)->numrows); + + /* ffirow also updates the heap address and numrows */ + if (ffirow(fptr, (fptr->Fptr)->numrows, nrows, status) > 0) + { + sprintf(message, + "ffptbb failed to add space for %ld new rows in table.", + nrows); + ffpmsg(message); + return(*status); + } + } + else + { + /* manally update heap starting address */ + (fptr->Fptr)->heapstart += + ((OFF_T)(endrow - (fptr->Fptr)->numrows) * + (fptr->Fptr)->rowlength ); + + (fptr->Fptr)->numrows = endrow; /* update number of rows */ + } + } + + /* move the i/o pointer to the start of the sequence of characters */ + bytepos = (fptr->Fptr)->datastart + + ((fptr->Fptr)->rowlength * (firstrow - 1)) + + firstchar - 1; + + ffmbyt(fptr, bytepos, IGNORE_EOF, status); + ffpbyt(fptr, nchars, values, status); /* write the bytes */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpi1b(fitsfile *fptr, /* I - FITS file pointer */ + long nvals, /* I - number of pixels in the values array */ + long incre, /* I - byte increment between pixels */ + unsigned char *values, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + put (write) the array of values to the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ + if (incre == 1) /* write all the values at once (contiguous bytes) */ + + ffpbyt(fptr, nvals, values, status); + + else /* have to write each value individually (not contiguous ) */ + + ffpbytoff(fptr, 1, nvals, incre - 1, values, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpi2b(fitsfile *fptr, /* I - FITS file pointer */ + long nvals, /* I - number of pixels in the values array */ + long incre, /* I - byte increment between pixels */ + short *values, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + put (write) the array of values to the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ +#if BYTESWAPPED + ffswap2(values, nvals); /* reverse order of bytes in each value */ +#endif + + if (incre == 2) /* write all the values at once (contiguous bytes) */ + + ffpbyt(fptr, nvals * 2, values, status); + + else /* have to write each value individually (not contiguous ) */ + + ffpbytoff(fptr, 2, nvals, incre - 2, values, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpi4b(fitsfile *fptr, /* I - FITS file pointer */ + long nvals, /* I - number of pixels in the values array */ + long incre, /* I - byte increment between pixels */ + INT32BIT *values, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + put (write) the array of values to the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ +#if BYTESWAPPED + ffswap4(values, nvals); /* reverse order of bytes in each value */ +#endif + + if (incre == 4) /* write all the values at once (contiguous bytes) */ + + ffpbyt(fptr, nvals * 4, values, status); + + else /* have to write each value individually (not contiguous ) */ + + ffpbytoff(fptr, 4, nvals, incre - 4, values, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpi8b(fitsfile *fptr, /* I - FITS file pointer */ + long nvals, /* I - number of pixels in the values array */ + long incre, /* I - byte increment between pixels */ + long *values, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + put (write) the array of values to the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + This routine writes 'nvals' 8-byte integers from 'values'. + This works both on platforms that have sizeof(long) = 64, and 32, + as long as 'values' has been allocated to large enough to hold + 8 * nvals bytes of data. + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +*/ +{ +#if BYTESWAPPED + ffswap8((double *) values, nvals); /* reverse bytes in each value */ +#endif + + if (incre == 8) /* write all the values at once (contiguous bytes) */ + + ffpbyt(fptr, nvals * 8, values, status); + + else /* have to write each value individually (not contiguous ) */ + + ffpbytoff(fptr, 8, nvals, incre - 8, values, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpr4b(fitsfile *fptr, /* I - FITS file pointer */ + long nvals, /* I - number of pixels in the values array */ + long incre, /* I - byte increment between pixels */ + float *values, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + put (write) the array of values to the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ +#if MACHINE == VAXVMS + long ii; + + ii = nvals; /* call VAX macro routine to convert */ + ieevpr(values, values, &ii); /* from F float -> IEEE float */ + +#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT) + long ii; + + /* convert from VMS FFLOAT float format to IEEE float format */ + for (ii = 0; ii < nvals; ii++) + values[ii] *= 0.25; + + ffswap2( (short *) values, nvals * 2); /* swap pairs of bytes */ + +#elif BYTESWAPPED + ffswap4((INT32BIT *) values, nvals); /* reverse order of bytes in values */ +#endif + + if (incre == 4) /* write all the values at once (contiguous bytes) */ + + ffpbyt(fptr, nvals * 4, values, status); + + else /* have to write each value individually (not contiguous ) */ + + ffpbytoff(fptr, 4, nvals, incre - 4, values, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpr8b(fitsfile *fptr, /* I - FITS file pointer */ + long nvals, /* I - number of pixels in the values array */ + long incre, /* I - byte increment between pixels */ + double *values, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + put (write) the array of values to the FITS file, doing machine dependent + format conversion (e.g. byte-swapping) if necessary. +*/ +{ +#if MACHINE == VAXVMS + long ii; + + ii = nvals; /* call VAX macro routine to convert */ + ieevpd(values, values, &ii); /* from D float -> IEEE float */ + +#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT) + long ii; + + /* convert from VMS GFLOAT float format to IEEE float format */ + for (ii = 0; ii < nvals; ii++) + values[ii] *= 0.25; + + ffswap2( (short *) values, nvals * 4); /* swap pairs of bytes */ + +#elif BYTESWAPPED + ffswap8(values, nvals); /* reverse order of bytes in each value */ +#endif + + if (incre == 8) /* write all the values at once (contiguous bytes) */ + + ffpbyt(fptr, nvals * 8, values, status); + + else /* have to write each value individually (not contiguous ) */ + + ffpbytoff(fptr, 8, nvals, incre - 8, values, status); + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/cfileio.c b/pkg/tbtables/cfitsio/cfileio.c new file mode 100644 index 00000000..839350fd --- /dev/null +++ b/pkg/tbtables/cfitsio/cfileio.c @@ -0,0 +1,5572 @@ +/* This file, cfileio.c, contains the low-level file access routines. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include +#include /* apparently needed to define size_t */ +#include "fitsio2.h" +#include "group.h" + +#define MAX_PREFIX_LEN 20 /* max length of file type prefix (e.g. 'http://') */ +#define MAX_DRIVERS 22 /* max number of file I/O drivers */ + +typedef struct /* structure containing pointers to I/O driver functions */ +{ char prefix[MAX_PREFIX_LEN]; + int (*init)(void); + int (*shutdown)(void); + int (*setoptions)(int option); + int (*getoptions)(int *options); + int (*getversion)(int *version); + int (*checkfile)(char *urltype, char *infile, char *outfile); + int (*open)(char *filename, int rwmode, int *driverhandle); + int (*create)(char *filename, int *drivehandle); + int (*truncate)(int drivehandle, OFF_T size); + int (*close)(int drivehandle); + int (*remove)(char *filename); + int (*size)(int drivehandle, OFF_T *size); + int (*flush)(int drivehandle); + int (*seek)(int drivehandle, OFF_T offset); + int (*read)(int drivehandle, void *buffer, long nbytes); + int (*write)(int drivehandle, void *buffer, long nbytes); +} fitsdriver; + +fitsdriver driverTable[MAX_DRIVERS]; /* allocate driver tables */ + +FITSfile *FptrTable[NMAXFILES]; /* this table of Fptr pointers is */ + /* used by fits_already_open */ + +int need_to_initialize = 1; /* true if CFITSIO has not been initialized */ +int no_of_drivers = 0; /* number of currently defined I/O drivers */ + +/*--------------------------------------------------------------------------*/ +int ffomem(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - name of file to open */ + int mode, /* I - 0 = open readonly; 1 = read/write */ + void **buffptr, /* I - address of memory pointer */ + size_t *buffsize, /* I - size of buffer, in bytes */ + size_t deltasize, /* I - increment for future realloc's */ + void *(*mem_realloc)(void *p, size_t newsize), /* function */ + int *status) /* IO - error status */ +/* + Open an existing FITS file in core memory. This is a specialized version + of ffopen. +*/ +{ + int driver, handle, hdutyp, slen, movetotype, extvers, extnum; + char extname[FLEN_VALUE]; + OFF_T filesize; + char urltype[MAX_PREFIX_LEN], infile[FLEN_FILENAME], outfile[FLEN_FILENAME]; + char extspec[FLEN_FILENAME], rowfilter[FLEN_FILENAME]; + char binspec[FLEN_FILENAME], colspec[FLEN_FILENAME]; + char imagecolname[FLEN_VALUE], rowexpress[FLEN_FILENAME]; + char *url, errmsg[FLEN_ERRMSG]; + char *hdtype[3] = {"IMAGE", "TABLE", "BINTABLE"}; + + if (*status > 0) + return(*status); + + *fptr = 0; /* initialize null file pointer */ + + if (need_to_initialize) /* this is called only once */ + { + *status = fits_init_cfitsio(); + + if (*status > 0) + return(*status); + } + + url = (char *) name; + while (*url == ' ') /* ignore leading spaces in the file spec */ + url++; + + /* parse the input file specification */ + ffiurl(url, urltype, infile, outfile, extspec, + rowfilter, binspec, colspec, status); + + strcpy(urltype, "memkeep://"); /* URL type for pre-existing memory file */ + + *status = urltype2driver(urltype, &driver); + + if (*status > 0) + { + ffpmsg("could not find driver for pre-existing memory file: (ffomem)"); + return(*status); + } + + /* call driver routine to open the memory file */ + *status = mem_openmem( buffptr, buffsize,deltasize, + mem_realloc, &handle); + + if (*status > 0) + { + ffpmsg("failed to open pre-existing memory file: (ffomem)"); + return(*status); + } + + /* get initial file size */ + *status = (*driverTable[driver].size)(handle, &filesize); + + if (*status > 0) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed get the size of the memory file: (ffomem)"); + return(*status); + } + + /* allocate fitsfile structure and initialize = 0 */ + *fptr = (fitsfile *) calloc(1, sizeof(fitsfile)); + + if (!(*fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for following file: (ffomem)"); + ffpmsg(url); + return(*status = MEMORY_ALLOCATION); + } + + /* allocate FITSfile structure and initialize = 0 */ + (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile)); + + if (!((*fptr)->Fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for following file: (ffomem)"); + ffpmsg(url); + free(*fptr); + *fptr = 0; + return(*status = MEMORY_ALLOCATION); + } + + slen = strlen(url) + 1; + slen = maxvalue(slen, 32); /* reserve at least 32 chars */ + ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */ + + if ( !(((*fptr)->Fptr)->filename) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for filename: (ffomem)"); + ffpmsg(url); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + /* mem for headstart array */ + ((*fptr)->Fptr)->headstart = (OFF_T *) calloc(1001, sizeof(OFF_T)); + + if ( !(((*fptr)->Fptr)->headstart) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for headstart array: (ffomem)"); + ffpmsg(url); + free( ((*fptr)->Fptr)->filename); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + /* store the parameters describing the file */ + ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */ + ((*fptr)->Fptr)->filehandle = handle; /* file handle */ + ((*fptr)->Fptr)->driver = driver; /* driver number */ + strcpy(((*fptr)->Fptr)->filename, url); /* full input filename */ + ((*fptr)->Fptr)->filesize = filesize; /* physical file size */ + ((*fptr)->Fptr)->logfilesize = filesize; /* logical file size */ + ((*fptr)->Fptr)->writemode = mode; /* read-write mode */ + ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */ + ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */ + ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */ + ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */ + + ffldrc(*fptr, 0, REPORT_EOF, status); /* load first record */ + + fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */ + + if (ffrhdu(*fptr, &hdutyp, status) > 0) /* determine HDU structure */ + { + ffpmsg( + "ffomem could not interpret primary array header of file: (ffomem)"); + ffpmsg(url); + + if (*status == UNKNOWN_REC) + ffpmsg("This does not look like a FITS file."); + + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + } + + /* ---------------------------------------------------------- */ + /* move to desired extension, if specified as part of the URL */ + /* ---------------------------------------------------------- */ + + imagecolname[0] = '\0'; + rowexpress[0] = '\0'; + + if (*extspec) + { + /* parse the extension specifier into individual parameters */ + ffexts(extspec, &extnum, + extname, &extvers, &movetotype, imagecolname, rowexpress, status); + + + if (*status > 0) + return(*status); + + if (extnum) + { + ffmahd(*fptr, extnum + 1, &hdutyp, status); + } + else if (*extname) /* move to named extension, if specified */ + { + ffmnhd(*fptr, movetotype, extname, extvers, status); + } + + if (*status > 0) + { + ffpmsg("ffomem could not move to the specified extension:"); + if (extnum > 0) + { + sprintf(errmsg, + " extension number %d doesn't exist or couldn't be opened.",extnum); + ffpmsg(errmsg); + } + else + { + sprintf(errmsg, + " extension with EXTNAME = %s,", extname); + ffpmsg(errmsg); + + if (extvers) + { + sprintf(errmsg, + " and with EXTVERS = %d,", extvers); + ffpmsg(errmsg); + } + + if (movetotype != ANY_HDU) + { + sprintf(errmsg, + " and with XTENSION = %s,", hdtype[movetotype]); + ffpmsg(errmsg); + } + + ffpmsg(" doesn't exist or couldn't be opened."); + } + return(*status); + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdkopn(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - full name of file to open */ + int mode, /* I - 0 = open readonly; 1 = read/write */ + int *status) /* IO - error status */ +/* + Open an existing FITS file on magnetic disk with either readonly or + read/write access. The routine does not support CFITSIO's extended + filename syntax and simply uses the entire input 'name' string as + the name of the file. +*/ +{ + if (*status > 0) + return(*status); + + *status = OPEN_DISK_FILE; + + ffopen(fptr, name, mode, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdopn(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - full name of file to open */ + int mode, /* I - 0 = open readonly; 1 = read/write */ + int *status) /* IO - error status */ +/* + Open an existing FITS file with either readonly or read/write access. and + move to the first HDU that contains 'interesting' data, if the primary + array contains a null image (i.e., NAXIS = 0). +*/ +{ + if (*status > 0) + return(*status); + + *status = SKIP_NULL_PRIMARY; + + ffopen(fptr, name, mode, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftopn(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - full name of file to open */ + int mode, /* I - 0 = open readonly; 1 = read/write */ + int *status) /* IO - error status */ +/* + Open an existing FITS file with either readonly or read/write access. and + move to the first HDU that contains 'interesting' table (not an image). +*/ +{ + int hdutype; + + if (*status > 0) + return(*status); + + *status = SKIP_IMAGE; + + ffopen(fptr, name, mode, status); + + if (ffghdt(*fptr, &hdutype, status) <= 0) { + if (hdutype == IMAGE_HDU) + *status = NOT_TABLE; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffiopn(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - full name of file to open */ + int mode, /* I - 0 = open readonly; 1 = read/write */ + int *status) /* IO - error status */ +/* + Open an existing FITS file with either readonly or read/write access. and + move to the first HDU that contains 'interesting' image (not an table). +*/ +{ + int hdutype; + + if (*status > 0) + return(*status); + + *status = SKIP_TABLE; + + ffopen(fptr, name, mode, status); + + if (ffghdt(*fptr, &hdutype, status) <= 0) { + if (hdutype != IMAGE_HDU) + *status = NOT_IMAGE; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffopen(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - full name of file to open */ + int mode, /* I - 0 = open readonly; 1 = read/write */ + int *status) /* IO - error status */ +/* + Open an existing FITS file with either readonly or read/write access. +*/ +{ + int driver, hdutyp, hdunum, slen, writecopy, isopen; + OFF_T filesize; + long rownum, nrows, goodrows; + int extnum, extvers, handle, movetotype, tstatus = 0; + char urltype[MAX_PREFIX_LEN], infile[FLEN_FILENAME], outfile[FLEN_FILENAME]; + char origurltype[MAX_PREFIX_LEN], extspec[FLEN_FILENAME]; + char extname[FLEN_VALUE], rowfilter[FLEN_FILENAME], tblname[FLEN_VALUE]; + char imagecolname[FLEN_VALUE], rowexpress[FLEN_FILENAME]; + char binspec[FLEN_FILENAME], colspec[FLEN_FILENAME]; + char histfilename[FLEN_FILENAME]; + char filtfilename[FLEN_FILENAME]; + char wtcol[FLEN_VALUE]; + char minname[4][FLEN_VALUE], maxname[4][FLEN_VALUE]; + char binname[4][FLEN_VALUE]; + char card[FLEN_CARD]; + + char *url; + double minin[4], maxin[4], binsizein[4], weight; + int imagetype, naxis = 1, haxis, recip; + int skip_null = 0, skip_image = 0, skip_table = 0, open_disk_file = 0; + char colname[4][FLEN_VALUE]; + char errmsg[FLEN_ERRMSG]; + char *hdtype[3] = {"IMAGE", "TABLE", "BINTABLE"}; + char *rowselect = 0; + + if (*status > 0) + return(*status); + + if (*status == SKIP_NULL_PRIMARY) + { + /* this special status value is used as a flag by ffdopn to tell */ + /* ffopen to skip over a null primary array when opening the file. */ + + skip_null = 1; + *status = 0; + } + else if (*status == SKIP_IMAGE) + { + /* this special status value is used as a flag by fftopn to tell */ + /* ffopen to move to 1st significant table when opening the file. */ + + skip_image = 1; + *status = 0; + } + else if (*status == SKIP_TABLE) + { + /* this special status value is used as a flag by ffiopn to tell */ + /* ffopen to move to 1st significant image when opening the file. */ + + skip_table = 1; + *status = 0; + } + else if (*status == OPEN_DISK_FILE) + { + /* this special status value is used as a flag by ffdkopn to tell */ + /* ffopen to not interpret the input filename using CFITSIO's */ + /* extended filename syntax, and simply open the specified disk file */ + + open_disk_file = 1; + *status = 0; + } + + *fptr = 0; /* initialize null file pointer */ + writecopy = 0; /* have we made a write-able copy of the input file? */ + + if (need_to_initialize) /* this is called only once */ + *status = fits_init_cfitsio(); + + if (*status > 0) + return(*status); + + url = (char *) name; + while (*url == ' ') /* ignore leading spaces in the filename */ + url++; + + if (*url == '\0') + { + ffpmsg("Name of file to open is blank. (ffopen)"); + return(*status = FILE_NOT_OPENED); + } + + if (open_disk_file) + { + /* treat the input URL literally as the name of the file to open */ + /* and don't try to parse the URL using the extended filename syntax */ + + strcpy(infile,url); + strcpy(urltype, "file://"); + outfile[0] = '\0'; + extspec[0] = '\0'; + binspec[0] = '\0'; + colspec[0] = '\0'; + rowfilter[0] = '\0'; + } + else + { + /* parse the input file specification */ + ffiurl(url, urltype, infile, outfile, extspec, + rowfilter, binspec, colspec, status); + } + + if (*status > 0) + { + ffpmsg("could not parse the input filename: (ffopen)"); + ffpmsg(url); + return(*status); + } + + imagecolname[0] = '\0'; + rowexpress[0] = '\0'; + + if (*extspec) + { + /* parse the extension specifier into individual parameters */ + ffexts(extspec, &extnum, + extname, &extvers, &movetotype, imagecolname, rowexpress, status); + + if (*status > 0) + return(*status); + } + + /*-------------------------------------------------------------------*/ + /* special cases: */ + /*-------------------------------------------------------------------*/ + + histfilename[0] = '\0'; + filtfilename[0] = '\0'; + if (*outfile && (*binspec || *imagecolname)) + { + /* if binspec or imagecolumn are specified, then the */ + /* output file name is intended for the final image, */ + /* and not a copy of the input file. */ + strcpy(histfilename, outfile); + outfile[0] = '\0'; + } + else if (*outfile && (*rowfilter || *colspec)) + { + /* if rowfilter or colspece are specified, then the */ + /* output file name is intended for the filtered file */ + /* and not a copy of the input file. */ + strcpy(filtfilename, outfile); + outfile[0] = '\0'; + } + + /*-------------------------------------------------------------------*/ + /* check if this same file is already open, and if so, attach to it */ + /*-------------------------------------------------------------------*/ + + if (fits_already_open(fptr, url, urltype, infile, extspec, rowfilter, + binspec, colspec, mode, &isopen, status) > 0) + { + return(*status); + } + + if (isopen) + goto move2hdu; + + /* get the driver number corresponding to this urltype */ + *status = urltype2driver(urltype, &driver); + + if (*status > 0) + { + ffpmsg("could not find driver for this file: (ffopen)"); + ffpmsg(urltype); + ffpmsg(url); + return(*status); + } + + /*------------------------------------------------------------------- + deal with all those messy special cases which may require that + a different driver be used: + - is disk file compressed? + - are ftp: or http: files compressed? + - has user requested that a local copy be made of + the ftp or http file? + -------------------------------------------------------------------*/ + + if (driverTable[driver].checkfile) + { + strcpy(origurltype,urltype); /* Save the urltype */ + + /* 'checkfile' may modify the urltype, infile and outfile strings */ + *status = (*driverTable[driver].checkfile)(urltype, infile, outfile); + + if (*status) + { + ffpmsg("checkfile failed for this file: (ffopen)"); + ffpmsg(url); + return(*status); + } + + if (strcmp(origurltype, urltype)) /* did driver changed on us? */ + { + *status = urltype2driver(urltype, &driver); + if (*status > 0) + { + ffpmsg("could not change driver for this file: (ffopen)"); + ffpmsg(url); + ffpmsg(urltype); + return(*status); + } + } + } + + /* call appropriate driver to open the file */ + if (driverTable[driver].open) + { + *status = (*driverTable[driver].open)(infile, mode, &handle); + if (*status > 0) + { + ffpmsg("failed to find or open the following file: (ffopen)"); + ffpmsg(url); + return(*status); + } + } + else + { + ffpmsg("cannot open an existing file of this type: (ffopen)"); + ffpmsg(url); + return(*status = FILE_NOT_OPENED); + } + + /* get initial file size */ + *status = (*driverTable[driver].size)(handle, &filesize); + if (*status > 0) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed get the size of the following file: (ffopen)"); + ffpmsg(url); + return(*status); + } + + /* allocate fitsfile structure and initialize = 0 */ + *fptr = (fitsfile *) calloc(1, sizeof(fitsfile)); + + if (!(*fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for following file: (ffopen)"); + ffpmsg(url); + return(*status = MEMORY_ALLOCATION); + } + + /* allocate FITSfile structure and initialize = 0 */ + (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile)); + + if (!((*fptr)->Fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for following file: (ffopen)"); + ffpmsg(url); + free(*fptr); + *fptr = 0; + return(*status = MEMORY_ALLOCATION); + } + + slen = strlen(url) + 1; + slen = maxvalue(slen, 32); /* reserve at least 32 chars */ + ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */ + + if ( !(((*fptr)->Fptr)->filename) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for filename: (ffopen)"); + ffpmsg(url); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + /* mem for headstart array */ + ((*fptr)->Fptr)->headstart = (OFF_T *) calloc(1001, sizeof(OFF_T)); + + if ( !(((*fptr)->Fptr)->headstart) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for headstart array: (ffopen)"); + ffpmsg(url); + free( ((*fptr)->Fptr)->filename); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + /* store the parameters describing the file */ + ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */ + ((*fptr)->Fptr)->filehandle = handle; /* file handle */ + ((*fptr)->Fptr)->driver = driver; /* driver number */ + strcpy(((*fptr)->Fptr)->filename, url); /* full input filename */ + ((*fptr)->Fptr)->filesize = filesize; /* physical file size */ + ((*fptr)->Fptr)->logfilesize = filesize; /* logical file size */ + ((*fptr)->Fptr)->writemode = mode; /* read-write mode */ + ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */ + ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */ + ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */ + ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */ + + ffldrc(*fptr, 0, REPORT_EOF, status); /* load first record */ + + fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */ + + if (ffrhdu(*fptr, &hdutyp, status) > 0) /* determine HDU structure */ + { + ffpmsg( + "ffopen could not interpret primary array header of file: "); + ffpmsg(url); + + if (*status == UNKNOWN_REC) + ffpmsg("This does not look like a FITS file."); + + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + + /* ------------------------------------------------------------- */ + /* At this point, the input file has been opened. If outfile was */ + /* specified, then we have opened a copy of the file, not the */ + /* original file so it is safe to modify it if necessary */ + /* ------------------------------------------------------------- */ + + if (*outfile) + writecopy = 1; + +move2hdu: + + /* ---------------------------------------------------------- */ + /* move to desired extension, if specified as part of the URL */ + /* ---------------------------------------------------------- */ + + if (*extspec) + { + if (extnum) /* extension number was specified */ + { + ffmahd(*fptr, extnum + 1, &hdutyp, status); + } + else if (*extname) /* move to named extension, if specified */ + { + ffmnhd(*fptr, movetotype, extname, extvers, status); + } + + if (*status > 0) /* clean up after error */ + { + ffpmsg("ffopen could not move to the specified extension:"); + if (extnum > 0) + { + sprintf(errmsg, + " extension number %d doesn't exist or couldn't be opened.",extnum); + ffpmsg(errmsg); + } + else + { + sprintf(errmsg, + " extension with EXTNAME = %s,", extname); + ffpmsg(errmsg); + + if (extvers) + { + sprintf(errmsg, + " and with EXTVERS = %d,", extvers); + ffpmsg(errmsg); + } + + if (movetotype != ANY_HDU) + { + sprintf(errmsg, + " and with XTENSION = %s,", hdtype[movetotype]); + ffpmsg(errmsg); + } + + ffpmsg(" doesn't exist or couldn't be opened."); + } + + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + } + else if (skip_null || skip_image || skip_table || + (*imagecolname || *colspec || *rowfilter || *binspec)) + { + /* ------------------------------------------------------------------ + + If no explicit extension specifier is given as part of the file + name, and, if a) skip_null is true (set if ffopen is called by + ffdopn) or b) skip_image or skip_table is true (set if ffopen is + called by fftopn or ffdopn) or c) other file filters are + specified, then CFITSIO will attempt to move to the first + 'interesting' HDU after opening an existing FITS file (or to + first interesting table HDU if skip_image is true); + + An 'interesting' HDU is defined to be either an image with NAXIS + > 0 (i.e., not a null array) or a table which has an EXTNAME + value which does not contain any of the following strings: + 'GTI' - Good Time Interval extension + 'OBSTABLE' - used in Beppo SAX data files + + The main purpose for this is to allow CFITSIO to skip over a null + primary and other non-interesting HDUs when opening an existing + file, and move directly to the first extension that contains + significant data. + ------------------------------------------------------------------ */ + + fits_get_hdu_num(*fptr, &hdunum); + if (hdunum == 1) { + + fits_get_img_dim(*fptr, &naxis, status); + + if (naxis == 0 || skip_image) /* skip primary array */ + { + while(1) + { + /* see if the next HDU is 'interesting' */ + if (fits_movrel_hdu(*fptr, 1, &hdutyp, status)) + { + if (*status == END_OF_FILE) + *status = 0; /* reset expected error */ + + /* didn't find an interesting HDU so move back to beginning */ + fits_movabs_hdu(*fptr, 1, &hdutyp, status); + break; + } + + if (hdutyp == IMAGE_HDU && skip_image) { + + continue; /* skip images */ + + } else if (hdutyp != IMAGE_HDU && skip_table) { + + continue; /* skip tables */ + + } else if (hdutyp == IMAGE_HDU) { + + fits_get_img_dim(*fptr, &naxis, status); + if (naxis > 0) + break; /* found a non-null image */ + + } else { + + tstatus = 0; + tblname[0] = '\0'; + fits_read_key(*fptr, TSTRING, "EXTNAME", tblname, NULL,&tstatus); + + if ( (!strstr(tblname, "GTI") && !strstr(tblname, "gti")) && + strncasecmp(tblname, "OBSTABLE", 8) ) + break; /* found an interesting table */ + } + } /* end while */ + } + } /* end if (hdunum==1) */ + } + + if (*imagecolname) + { + /* ----------------------------------------------------------------- */ + /* we need to open an image contained in a single table cell */ + /* First, determine which row of the table to use. */ + /* ----------------------------------------------------------------- */ + + if (isdigit((int) *rowexpress)) /* is the row specification a number? */ + { + sscanf(rowexpress, "%ld", &rownum); + if (rownum < 1) + { + ffpmsg("illegal rownum for image cell:"); + ffpmsg(rowexpress); + ffpmsg("Could not open the following image in a table cell:"); + ffpmsg(extspec); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status = BAD_ROW_NUM); + } + } + else if (fits_find_first_row(*fptr, rowexpress, &rownum, status) > 0) + { + ffpmsg("Failed to find row matching this expression:"); + ffpmsg(rowexpress); + ffpmsg("Could not open the following image in a table cell:"); + ffpmsg(extspec); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + + if (rownum == 0) + { + ffpmsg("row statisfying this expression doesn't exist::"); + ffpmsg(rowexpress); + ffpmsg("Could not open the following image in a table cell:"); + ffpmsg(extspec); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status = BAD_ROW_NUM); + } + + /* determine the name of the new file to contain copy of the image */ + if (*histfilename) + strcpy(outfile, histfilename); /* the original outfile name */ + else + strcpy(outfile, "mem://_1"); /* create image file in memory */ + + /* Copy the image into new primary array and open it as the current */ + /* fptr. This will close the table that contains the original image. */ + + if (fits_copy_image_cell(fptr, outfile, imagecolname, rownum, + status) > 0) + { + ffpmsg("Failed to copy table cell to new primary array:"); + ffpmsg(extspec); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + + writecopy = 1; /* we are now dealing with a copy of the original file */ + + /* add some HISTORY; fits_copy_image_cell also wrote HISTORY keywords */ + + if (*extname) + sprintf(card,"HISTORY in HDU '%.16s' of file '%.36s'",extname,infile); + else + sprintf(card,"HISTORY in HDU %d of file '%.45s'", extnum, infile); + + ffprec(*fptr, card, status); + } + + /* --------------------------------------------------------------------- */ + /* edit columns (and/or keywords) in the table, if specified in the URL */ + /* --------------------------------------------------------------------- */ + + if (*colspec) + { + /* the column specifier will modify the file, so make sure */ + /* we are already dealing with a copy, or else make a new copy */ + + if (!writecopy) /* Is the current file already a copy? */ + writecopy = fits_is_this_a_copy(urltype); + + if (!writecopy) + { + if (*filtfilename && *outfile == '\0') + strcpy(outfile, filtfilename); /* the original outfile name */ + else + strcpy(outfile, "mem://_1"); /* will create copy in memory */ + + writecopy = 1; + } + else + { + ((*fptr)->Fptr)->writemode = READWRITE; /* we have write access */ + outfile[0] = '\0'; + } + + if (ffedit_columns(fptr, outfile, colspec, status) > 0) + { + ffpmsg("editing columns in input table failed (ffopen)"); + ffpmsg(" while trying to perform the following operation:"); + ffpmsg(colspec); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + } + + /* ------------------------------------------------------------------- */ + /* select rows from the table, if specified in the URL */ + /* or select a subimage (if this is an image HDU and not a table) */ + /* ------------------------------------------------------------------- */ + + if (*rowfilter) + { + fits_get_hdu_type(*fptr, &hdutyp, status); /* get type of HDU */ + if (hdutyp == IMAGE_HDU) + { + /* this is an image so 'rowfilter' is an image section specification */ + + if (*filtfilename && *outfile == '\0') + strcpy(outfile, filtfilename); /* the original outfile name */ + else if (*outfile == '\0') /* output file name not already defined? */ + strcpy(outfile, "mem://_2"); /* will create file in memory */ + + /* create new file containing the image section, plus a copy of */ + /* any other HDUs that exist in the input file. This routine */ + /* will close the original image file and return a pointer */ + /* to the new file. */ + + if (fits_select_image_section(fptr, outfile, rowfilter, status) > 0) + { + ffpmsg("on-the-fly selection of image section failed (ffopen)"); + ffpmsg(" while trying to use the following section filter:"); + ffpmsg(rowfilter); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + writecopy = 1; + } + else + { + /* this is a table HDU, so the rowfilter is really a row filter */ + + if (*binspec) + { + /* since we are going to make a histogram of the selected rows, */ + /* it would be a waste of time and memory to make a whole copy of */ + /* the selected rows. Instead, just construct an array of TRUE */ + /* or FALSE values that indicate which rows are to be included */ + /* in the histogram and pass that to the histogram generating */ + /* routine */ + + fits_get_num_rows(*fptr, &nrows, status); /* get no. of rows */ + + rowselect = (char *) calloc(nrows, 1); + if (!rowselect) + { + ffpmsg( + "failed to allocate memory for selected columns array (ffopen)"); + ffpmsg(" while trying to select rows with the following filter:"); + ffpmsg(rowfilter); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + if (fits_find_rows(*fptr, rowfilter, 1L, nrows, &goodrows, + rowselect, status) > 0) + { + ffpmsg("selection of rows in input table failed (ffopen)"); + ffpmsg(" while trying to select rows with the following filter:"); + ffpmsg(rowfilter); + free(rowselect); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + } + else + { + if (!writecopy) /* Is the current file already a copy? */ + writecopy = fits_is_this_a_copy(urltype); + + if (!writecopy) + { + if (*filtfilename && *outfile == '\0') + strcpy(outfile, filtfilename); /* the original outfile name */ + else if (*outfile == '\0') /* output filename not already defined? */ + strcpy(outfile, "mem://_2"); /* will create copy in memory */ + } + else + { + ((*fptr)->Fptr)->writemode = READWRITE; /* we have write access */ + outfile[0] = '\0'; + } + + /* select rows in the table. If a copy of the input file has */ + /* not already been made, then this routine will make a copy */ + /* and then close the input file, so that the modifications will */ + /* only be made on the copy, not the original */ + + if (ffselect_table(fptr, outfile, rowfilter, status) > 0) + { + ffpmsg("on-the-fly selection of rows in input table failed (ffopen)"); + ffpmsg(" while trying to select rows with the following filter:"); + ffpmsg(rowfilter); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + + /* write history records */ + ffphis(*fptr, + "CFITSIO used the following filtering expression to create this table:", + status); + ffphis(*fptr, name, status); + + } /* end of no binspec case */ + } /* end of table HDU case */ + } /* end of rowfilter exists case */ + + /* ------------------------------------------------------------------- */ + /* make an image histogram by binning columns, if specified in the URL */ + /* ------------------------------------------------------------------- */ + + if (*binspec) + { + if (*histfilename) + strcpy(outfile, histfilename); /* the original outfile name */ + else + strcpy(outfile, "mem://_3"); /* create histogram in memory */ + /* if not already copied the file */ + + /* parse the binning specifier into individual parameters */ + ffbins(binspec, &imagetype, &haxis, colname, + minin, maxin, binsizein, + minname, maxname, binname, + &weight, wtcol, &recip, status); + + /* Create the histogram primary array and open it as the current fptr */ + /* This will close the table that was used to create the histogram. */ + ffhist(fptr, outfile, imagetype, haxis, colname, minin, maxin, + binsizein, minname, maxname, binname, + weight, wtcol, recip, rowselect, status); + + if (rowselect) + free(rowselect); + + if (*status > 0) + { + ffpmsg("on-the-fly histogramming of input table failed (ffopen)"); + ffpmsg(" while trying to execute the following histogram specification:"); + ffpmsg(binspec); + ffclos(*fptr, status); + *fptr = 0; /* return null file pointer */ + return(*status); + } + + /* write history records */ + ffphis(*fptr, + "CFITSIO used the following expression to create this histogram:", + status); + ffphis(*fptr, name, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffreopen(fitsfile *openfptr, /* I - FITS file pointer to open file */ + fitsfile **newfptr, /* O - pointer to new re opened file */ + int *status) /* IO - error status */ +/* + Reopen an existing FITS file with either readonly or read/write access. + The reopened file shares the same FITSfile structure but may point to a + different HDU within the file. +*/ +{ + if (*status > 0) + return(*status); + + /* check that the open file pointer is valid */ + if (!openfptr) + return(*status = NULL_INPUT_PTR); + else if ((openfptr->Fptr)->validcode != VALIDSTRUC) /* check magic value */ + return(*status = BAD_FILEPTR); + + /* allocate fitsfile structure and initialize = 0 */ + *newfptr = (fitsfile *) calloc(1, sizeof(fitsfile)); + + (*newfptr)->Fptr = openfptr->Fptr; /* both point to the same structure */ + (*newfptr)->HDUposition = 0; /* set initial position to primary array */ + (((*newfptr)->Fptr)->open_count)++; /* increment the file usage counter */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_store_Fptr(FITSfile *Fptr, /* O - FITS file pointer */ + int *status) /* IO - error status */ +/* + store the new Fptr address for future use by fits_already_open +*/ +{ + int ii; + + if (*status > 0) + return(*status); + + for (ii = 0; ii < NMAXFILES; ii++) { + if (FptrTable[ii] == 0) { + FptrTable[ii] = Fptr; + break; + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_clear_Fptr(FITSfile *Fptr, /* O - FITS file pointer */ + int *status) /* IO - error status */ +/* + clear the Fptr address from the Fptr Table +*/ +{ + int ii; + + for (ii = 0; ii < NMAXFILES; ii++) { + if (FptrTable[ii] == Fptr) { + FptrTable[ii] = 0; + break; + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_already_open(fitsfile **fptr, /* I/O - FITS file pointer */ + char *url, + char *urltype, + char *infile, + char *extspec, + char *rowfilter, + char *binspec, + char *colspec, + int mode, /* I - 0 = open readonly; 1 = read/write */ + int *isopen, /* O - 1 = file is already open */ + int *status) /* IO - error status */ +/* + Check if the file to be opened is already open. If so, then attach to it. +*/ + /* + this function was changed so that for files of access method FILE:// + the file paths are compared using standard URL syntax and absolute + paths (as opposed to relative paths). This eliminates some instances + where a file is already opened but it is not realized because it + was opened with another file path. For instance, if the CWD is + /a/b/c and I open /a/b/c/foo.fits then open ./foo.fits the previous + version of this function would not have reconized that the two files + were the same. This version does recognize that the two files are + the same. + */ +{ + FITSfile *oldFptr; + int ii; + char oldurltype[MAX_PREFIX_LEN], oldinfile[FLEN_FILENAME]; + char oldextspec[FLEN_FILENAME], oldoutfile[FLEN_FILENAME]; + char oldrowfilter[FLEN_FILENAME]; + char oldbinspec[FLEN_FILENAME], oldcolspec[FLEN_FILENAME]; + char cwd[FLEN_FILENAME]; + char tmpStr[FLEN_FILENAME]; + char tmpinfile[FLEN_FILENAME]; + + *isopen = 0; + + if(strcasecmp(urltype,"FILE://") == 0) + { + fits_path2url(infile,tmpinfile,status); + + if(tmpinfile[0] != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,tmpinfile); + fits_clean_url(cwd,tmpinfile,status); + } + } + else + strcpy(tmpinfile,infile); + + for (ii = 0; ii < NMAXFILES; ii++) /* check every buffer */ + { + if (FptrTable[ii] != 0) + { + oldFptr = FptrTable[ii]; + + ffiurl(oldFptr->filename, oldurltype, + oldinfile, oldoutfile, oldextspec, oldrowfilter, + oldbinspec, oldcolspec, status); + + if (*status > 0) + { + ffpmsg("could not parse the previously opened filename: (ffopen)"); + ffpmsg(oldFptr->filename); + return(*status); + } + + if(strcasecmp(oldurltype,"FILE://") == 0) + { + fits_path2url(oldinfile,tmpStr,status); + + if(tmpStr[0] != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,tmpStr); + fits_clean_url(cwd,tmpStr,status); + } + + strcpy(oldinfile,tmpStr); + } + + if (!strcmp(urltype, oldurltype) && !strcmp(tmpinfile, oldinfile) ) + { + /* identical type of file and root file name */ + + if ( (!rowfilter[0] && !oldrowfilter[0] && + !binspec[0] && !oldbinspec[0] && + !colspec[0] && !oldcolspec[0]) + + /* no filtering or binning specs for either file, so */ + /* this is a case where the same file is being reopened. */ + /* It doesn't matter if the extensions are different */ + + || /* or */ + + (!strcmp(rowfilter, oldrowfilter) && + !strcmp(binspec, oldbinspec) && + !strcmp(colspec, oldcolspec) && + !strcmp(extspec, oldextspec) ) ) + + /* filtering specs are given and are identical, and */ + /* the same extension is specified */ + + { + if (mode == READWRITE && oldFptr->writemode == READONLY) + { + /* + cannot assume that a file previously opened with READONLY + can now be written to (e.g., files on CDROM, or over the + the network, or STDIN), so return with an error. + */ + + ffpmsg( + "cannot reopen file READWRITE when previously opened READONLY"); + ffpmsg(url); + return(*status = FILE_NOT_OPENED); + } + + *fptr = (fitsfile *) calloc(1, sizeof(fitsfile)); + + if (!(*fptr)) + { + ffpmsg( + "failed to allocate structure for following file: (ffopen)"); + ffpmsg(url); + return(*status = MEMORY_ALLOCATION); + } + + (*fptr)->Fptr = oldFptr; /* point to the structure */ + (*fptr)->HDUposition = 0; /* set initial position */ + (((*fptr)->Fptr)->open_count)++; /* increment usage counter */ + + if (binspec[0]) /* if binning specified, don't move */ + extspec[0] = '\0'; + + /* all the filtering has already been applied, so ignore */ + rowfilter[0] = '\0'; + binspec[0] = '\0'; + colspec[0] = '\0'; + + *isopen = 1; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_is_this_a_copy(char *urltype) /* I - type of file */ +/* + specialized routine that returns 1 if the file is known to be a temporary + copy of the originally opened file. Otherwise it returns 0. +*/ +{ + int iscopy; + + if (!strncmp(urltype, "mem", 3) ) + iscopy = 1; /* file copy is in memory */ + else if (!strncmp(urltype, "compress", 8) ) + iscopy = 1; /* compressed diskfile that is uncompressed in memory */ + else if (!strncmp(urltype, "http", 4) ) + iscopy = 1; /* copied file using http protocol */ + else if (!strncmp(urltype, "ftp", 3) ) + iscopy = 1; /* copied file using ftp protocol */ + else if (!strncpy(urltype, "stdin", 5) ) + iscopy = 1; /* piped stdin has been copied to memory */ + else + iscopy = 0; /* file is not known to be a copy */ + + return(iscopy); +} +/*--------------------------------------------------------------------------*/ +int ffedit_columns( + fitsfile **fptr, /* IO - pointer to input table; on output it */ + /* points to the new selected rows table */ + char *outfile, /* I - name for output file */ + char *expr, /* I - column edit expression */ + int *status) +/* + modify columns in a table and/or header keywords in the HDU +*/ +{ + fitsfile *newptr; + int ii, hdunum, slen, colnum, deletecol = 0, savecol = 0; + int numcols = 0, *colindex = 0, tstatus = 0; + char *cptr, *cptr2, *cptr3, clause[FLEN_FILENAME], keyname[FLEN_KEYWORD]; + char colname[FLEN_VALUE], oldname[FLEN_VALUE], colformat[FLEN_VALUE]; + char *file_expr = NULL; + + if (*outfile) + { + /* create new empty file in to hold the selected rows */ + if (ffinit(&newptr, outfile, status) > 0) + { + ffpmsg("failed to create file for copy (ffedit_columns)"); + return(*status); + } + + fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */ + + /* copy all HDUs to the output copy */ + + for (ii = 1; 1; ii++) + { + if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0) + break; + + fits_copy_hdu(*fptr, newptr, 0, status); + } + + if (*status == END_OF_FILE) + { + *status = 0; /* got the expected EOF error; reset = 0 */ + } + else if (*status > 0) + { + ffclos(newptr, status); + ffpmsg("failed to copy all HDUs from input file (ffedit_columns)"); + return(*status); + } + + /* close the original file and return ptr to the new image */ + ffclos(*fptr, status); + + *fptr = newptr; /* reset the pointer to the new table */ + + /* move back to the selected table HDU */ + if (fits_movabs_hdu(*fptr, hdunum, NULL, status) > 0) + { + ffpmsg("failed to copy the input file (ffedit_columns)"); + return(*status); + } + } + + /* remove the "col " from the beginning of the column edit expression */ + cptr = expr + 4; + + while (*cptr == ' ') + cptr++; /* skip leading white space */ + + /* Check if need to import expression from a file */ + + if( *cptr=='@' ) { + if( ffimport_file( cptr+1, &file_expr, status ) ) return(*status); + cptr = file_expr; + while (*cptr == ' ') + cptr++; /* skip leading white space... again */ + } + + tstatus = 0; + ffgncl(*fptr, &numcols, &tstatus); /* get initial # of cols */ + + /* parse expression and get first clause, if more than 1 */ + + while ((slen = fits_get_token(&cptr, ";", clause, NULL)) > 0 ) + { + if( *cptr==';' ) cptr++; + clause[slen] = '\0'; + + if (clause[0] == '!' || clause[0] == '-') + { + /* ===================================== */ + /* Case I. delete this column or keyword */ + /* ===================================== */ + + if (ffgcno(*fptr, CASEINSEN, &clause[1], &colnum, status) <= 0) + { + /* a column with this name exists, so try to delete it */ + if (ffdcol(*fptr, colnum, status) > 0) + { + ffpmsg("failed to delete column in input file:"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status); + } + deletecol = 1; /* set flag that at least one col was deleted */ + numcols--; + } + else + { + /* try deleting a keyword with this name */ + *status = 0; + if (ffdkey(*fptr, &clause[1], status) > 0) + { + ffpmsg("column or keyword to be deleted does not exist:"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status); + } + } + } + else + { + /* ===================================================== */ + /* Case II: + this is either a column name, (case 1) + + or a new column name followed by double = ("==") followed + by the old name which is to be renamed. (case 2A) + + or a column or keyword name followed by a single "=" and a + calculation expression (case 2B) */ + /* ===================================================== */ + cptr2 = clause; + slen = fits_get_token(&cptr2, "( =", colname, NULL); + + + if (slen == 0) + { + ffpmsg("error: column or keyword name is blank:"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status= URL_PARSE_ERROR); + } + + /* if we encountered an opening parenthesis, then we need to */ + /* find the closing parenthesis, and concatinate the 2 strings */ + /* This supports expressions like: + [col #EXTNAME(Extension name)="GTI"] + */ + if (*cptr2 == '(') + { + fits_get_token(&cptr2, ")", oldname, NULL); + strcat(colname, oldname); + strcat(colname, ")"); + cptr2++; + } + + while (*cptr2 == ' ') + cptr2++; /* skip white space */ + + if (*cptr2 != '=') + { + /* ------------------------------------ */ + /* case 1 - simply the name of a column */ + /* ------------------------------------ */ + + /* look for matching column */ + ffgcno(*fptr, CASEINSEN, colname, &colnum, status); + + while (*status == COL_NOT_UNIQUE) + { + /* the column name contained wild cards, and it */ + /* matches more than one column in the table. */ + + /* keep this column in the output file */ + savecol = 1; + + if (!colindex) + colindex = calloc(999, sizeof(int)); + + colindex[colnum - 1] = 1; /* flag this column number */ + + /* look for other matching column names */ + ffgcno(*fptr, CASEINSEN, colname, &colnum, status); + + if (*status == COL_NOT_FOUND) + *status = 999; /* temporary status flag value */ + } + + if (*status <= 0) + { + /* keep this column in the output file */ + savecol = 1; + + if (!colindex) + colindex = calloc(999, sizeof(int)); + + colindex[colnum - 1] = 1; /* flag this column number */ + } + else if (*status == 999) + { + /* this special flag value does not represent an error */ + *status = 0; + } + else + { + ffpmsg("Syntax error in columns specifier in input URL:"); + ffpmsg(cptr2); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status = URL_PARSE_ERROR); + } + } + else + { + /* ----------------------------------------------- */ + /* case 2 where the token ends with an equals sign */ + /* ----------------------------------------------- */ + + cptr2++; /* skip over the first '=' */ + + if (*cptr2 == '=') + { + /*................................................. */ + /* Case A: rename a column or keyword; syntax is + "new_name == old_name" */ + /*................................................. */ + + cptr2++; /* skip the 2nd '=' */ + while (*cptr2 == ' ') + cptr2++; /* skip white space */ + + fits_get_token(&cptr2, " ", oldname, NULL); + + /* get column number of the existing column */ + if (ffgcno(*fptr, CASEINSEN, oldname, &colnum, status) <= 0) + { + /* modify the TTYPEn keyword value with the new name */ + ffkeyn("TTYPE", colnum, keyname, status); + + if (ffmkys(*fptr, keyname, colname, NULL, status) > 0) + { + ffpmsg("failed to rename column in input file"); + ffpmsg(" oldname ="); + ffpmsg(oldname); + ffpmsg(" newname ="); + ffpmsg(colname); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status); + } + /* keep this column in the output file */ + savecol = 1; + if (!colindex) + colindex = calloc(999, sizeof(int)); + + colindex[colnum - 1] = 1; /* flag this column number */ + } + else + { + /* try renaming a keyword */ + *status = 0; + if (ffmnam(*fptr, oldname, colname, status) > 0) + { + ffpmsg("column or keyword to be renamed does not exist:"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status); + } + } + } + else + { + /*...................................................... */ + /* Case B: */ + /* this must be a general column/keyword calc expression */ + /* "name = expression" or "colname(TFORM) = expression" */ + /*...................................................... */ + + /* parse the name and TFORM values, if present */ + colformat[0] = '\0'; + cptr3 = colname; + + fits_get_token(&cptr3, "(", oldname, NULL); + + if (cptr3[0] == '(' ) + { + cptr3++; /* skip the '(' */ + fits_get_token(&cptr3, ")", colformat, NULL); + } + + /* calculate values for the column or keyword */ + /* cptr2 = the expression to be calculated */ + /* oldname = name of the column or keyword */ + /* colformat = column format, or keyword comment string */ + + fits_calculator(*fptr, cptr2, *fptr, oldname, colformat, + status); + + /* test if this is a column and not a keyword */ + tstatus = 0; + ffgcno(*fptr, CASEINSEN, oldname, &colnum, &tstatus); + if (tstatus == 0) + { + /* keep this column in the output file */ + savecol = 1; + + if (!colindex) + colindex = calloc(999, sizeof(int)); + + colindex[colnum - 1] = 1; + if (colnum > numcols)numcols++; + } + } + } + } + } + + if (savecol && !deletecol) + { + /* need to delete all but the specified columns */ + for (ii = numcols; ii > 0; ii--) + { + if (!colindex[ii-1]) /* delete this column */ + { + if (ffdcol(*fptr, ii, status) > 0) + { + ffpmsg("failed to delete column in input file:"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status); + } + } + } + } + + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_copy_image_cell( + fitsfile **fptr, /* IO - pointer to input table; on output it */ + /* points to the new image primary array */ + char *outfile, /* I - name for output file */ + char *colname, /* I - name of column containing the image */ + long rownum, /* I - number of the row containing the image */ + int *status) +{ + fitsfile *newptr; + unsigned char buffer[30000]; + int ii, hdutype, colnum, typecode, bitpix, naxis, maxelem, tstatus; + long naxes[9], nbytes, firstbyte, twidth; + OFF_T repeat, startpos, elemnum, rowlen; + long incre, tnull, ntodo; + double scale, zero; + char tform[20]; + char keyname[FLEN_KEYWORD], card[FLEN_CARD]; + char axisnum[10], root[9]; + + if (*status > 0) + return(*status); + + /* get column number */ + if (ffgcno(*fptr, CASEINSEN, colname, &colnum, status) > 0) + { + ffpmsg("column containing image in table cell does not exist:"); + ffpmsg(colname); + return(*status); + } + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if ( ffgcpr(*fptr, colnum, rownum, 1L, 1L, 0, &scale, &zero, + tform, &twidth, &typecode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, (char *) buffer, status) > 0 ) + return(*status); + + if (hdutype != BINARY_TBL) + { + ffpmsg("This extension is not a binary table."); + ffpmsg(" Cannot open the image in a binary table cell."); + return(*status = NOT_BTABLE); + } + + if (typecode < 0) + { + /* variable length array */ + typecode *= -1; + + /* variable length arrays are 1-dimensional by default */ + naxis = 1; + naxes[0] = (long) repeat; + } + else + { + /* get the dimensions of the image */ + ffgtdm(*fptr, colnum, 9, &naxis, naxes, status); + } + + if (*status > 0) + { + ffpmsg("Error getting the dimensions of the image"); + return(*status); + } + + /* determine BITPIX value for the image */ + if (typecode == TBYTE) + { + bitpix = BYTE_IMG; + nbytes = (long) repeat; + } + else if (typecode == TSHORT) + { + bitpix = SHORT_IMG; + nbytes = (long) repeat * 2; + } + else if (typecode == TLONG) + { + bitpix = LONG_IMG; + nbytes = (long) repeat * 4; + } + else if (typecode == TFLOAT) + { + bitpix = FLOAT_IMG; + nbytes = (long) repeat * 4; + } + else if (typecode == TDOUBLE) + { + bitpix = DOUBLE_IMG; + nbytes = (long) repeat * 8; + } + else + { + ffpmsg("Error: the following image column has invalid datatype:"); + ffpmsg(colname); + ffpmsg(tform); + ffpmsg("Cannot open an image in a single row of this column."); + return(*status = BAD_TFORM); + } + + /* create new empty file to hold copy of the image */ + if (ffinit(&newptr, outfile, status) > 0) + { + ffpmsg("failed to create file for copy of image in table cell:"); + ffpmsg(outfile); + return(*status); + } + + if (ffcrim(newptr, bitpix, naxis, naxes, status) > 0) + { + ffpmsg("failed to write required primary array keywords in this file:"); + ffpmsg(outfile); + return(*status); + } + + /* write the BSCAL and BZERO keywords, if needed */ + if (scale != 1.0) + ffpky(newptr, TDOUBLE, "BSCALE", &scale, "Array scaling factor", + status); + + if (zero != 0.0) + ffpky(newptr, TDOUBLE, "BZERO", &zero, "Array scaling zero point", + status); + + ffkeyn("TUNIT", colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "BUNIT ", 8); + ffprec(newptr, card, status); + } + + ffkeyn("TNULL", colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "BLANK ", 8); + ffprec(newptr, card, status); + } + + /* convert the nominal WCS keywords, if present */ + strcpy(axisnum,"123456789"); + for (ii = 0; ii < naxis; ii++) + { + strcpy(root, "1CTYP"); + root[0] = axisnum[ii]; + ffkeyn(root, colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "CTYPE1 ", 8); + card[5] = axisnum[ii]; + ffprec(newptr, card, status); + } + + strcpy(root, "1CUNI"); + root[0] = axisnum[ii]; + ffkeyn(root, colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "CUNIT1 ", 8); + card[5] = axisnum[ii]; + ffprec(newptr, card, status); + } + + strcpy(root, "1CRPX"); + root[0] = axisnum[ii]; + ffkeyn(root, colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "CRPIX1 ", 8); + card[5] = axisnum[ii]; + ffprec(newptr, card, status); + } + + strcpy(root, "1CRVL"); + root[0] = axisnum[ii]; + ffkeyn(root, colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "CRVAL1 ", 8); + card[5] = axisnum[ii]; + ffprec(newptr, card, status); + } + + strcpy(root, "1CDLT"); + root[0] = axisnum[ii]; + ffkeyn(root, colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "CDELT1 ", 8); + card[5] = axisnum[ii]; + ffprec(newptr, card, status); + } + + strcpy(root, "1CROT"); + root[0] = axisnum[ii]; + ffkeyn(root, colnum, keyname, status); + tstatus = 0; + if (ffgcrd(*fptr, keyname, card, &tstatus) == 0) + { + strncpy(card, "CROTA1 ", 8); + card[5] = axisnum[ii]; + ffprec(newptr, card, status); + } + } + + /* copy all other relevant keywords */ + fits_copy_image_keywords(*fptr, newptr, status); + + /* add some HISTORY */ + sprintf(card,"HISTORY This image was copied from row %ld of column '%s',", + rownum, colname); + ffprec(newptr, card, status); + + /* finally, copy the data, one buffer size at a time */ + ffmbyt(*fptr, startpos, TRUE, status); + firstbyte = 1; + + /* the upper limit on the number of bytes must match the declaration */ + /* read up to the first 30000 bytes in the normal way with ffgbyt */ + ntodo = minvalue(30000L, nbytes); + ffgbyt(*fptr, ntodo, buffer, status); + ffptbb(newptr, 1, firstbyte, ntodo, buffer, status); + + nbytes -= ntodo; + firstbyte += ntodo; + + /* read any additional bytes with low-level ffread routine, for speed */ + while (nbytes && (*status <= 0) ) + { + ntodo = minvalue(30000L, nbytes); + ffread((*fptr)->Fptr, ntodo, buffer, status); + ffptbb(newptr, 1, firstbyte, ntodo, buffer, status); + nbytes -= ntodo; + firstbyte += ntodo; + } + + /* close the original file and return ptr to the new image */ + ffclos(*fptr, status); + + *fptr = newptr; /* reset the pointer to the new table */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_copy_image_keywords( + fitsfile *infptr, /* I - pointer to input table */ + fitsfile *outfptr, /* I - pointer to input table */ + int *status) +/* + Copy relevant keywords from the table header into the newly created + primary array header. Convert names of keywords where appropriate. +*/ +{ + int nrec, nkeys, nmore; + char rec[FLEN_CARD], *root; + + if (*status > 0) + return(*status); + + ffghsp(infptr, &nkeys, &nmore, status); /* get number of keywords */ + root = rec + 1; + + for (nrec = 9; nrec <= nkeys; nrec++) + { + ffgrec(infptr, nrec, rec, status); + + if (*rec == 'T') + { + if (!strncmp(root, "FORM", 4) || !strncmp(root, "HEAP", 4) || + !strncmp(root, "TYPE", 4) || !strncmp(root, "SCAL", 4) || + !strncmp(root, "ZERO", 4) || !strncmp(root, "DISP", 4) || + !strncmp(root, "LMIN", 4) || !strncmp(root, "LMAX", 4) || + !strncmp(root, "DMIN", 4) || !strncmp(root, "DMAX", 4) || + !strncmp(root, "CTYP", 4) || !strncmp(root, "CRPX", 4) || + !strncmp(root, "CRVL", 4) || !strncmp(root, "CDLT", 4) || + !strncmp(root, "CROT", 4) || !strncmp(root, "CUNI", 4) || + !strncmp(root, "UNIT", 4) || !strncmp(root, "NULL", 4) || + !strncmp(root, "DIM" , 3) || !strncmp(root, "BCOL", 4) ) + + /* will have to deal with the WCS keywords separately */ + { + continue; /* ignore these keywords */ + } + else + { + ffprec(outfptr, rec, status); /* copy the keyword */ + } + } + else if (isdigit((int) *rec) ) + { + if ( !strncmp(root, "CTYP", 4) || !strncmp(root, "CRPX", 4) || + !strncmp(root, "CRVL", 4) || !strncmp(root, "CDLT", 4) || + !strncmp(root, "CROT", 4) || !strncmp(root, "CUNI", 4) ) + + /* will have to deal with the WCS keywords separately */ + { + continue; /* ignore these keywords */ + } + else + { + ffprec(outfptr, rec, status); /* copy the keyword */ + } + } + else if (*rec == 'E' && *root == 'X') + { + if (!strncmp(root, "XTNAME", 6) || !strncmp(root, "XTVER", 5) || + !strncmp(root, "XTLEVEL", 7) ) + { + continue; + } + else + { + ffprec(outfptr, rec, status); /* copy the keyword */ + } + } + else + { + ffprec(outfptr, rec, status); /* copy the keyword */ + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_select_image_section( + fitsfile **fptr, /* IO - pointer to input image; on output it */ + /* points to the new subimage */ + char *outfile, /* I - name for output file */ + char *expr, /* I - Image section expression */ + int *status) +{ + /* + copies an image section from the input file to an output file + */ + + fitsfile *newptr; + int ii, hdunum, naxis, bitpix, tstatus, anynull, nkey, numkeys; + long naxes[9], smin, smax, sinc, fpixels[9], lpixels[9], incs[9]; + long outnaxes[9], outsize, buffsize, dummy[2]; + char *cptr, keyname[FLEN_KEYWORD], card[FLEN_CARD]; + double *buffer = 0, crpix, cdelt; + + /* create new empty file to hold the image section */ + if (ffinit(&newptr, outfile, status) > 0) + { + ffpmsg( + "failed to create output file for image section:"); + ffpmsg(outfile); + return(*status); + } + + fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */ + + /* copy all preceding extensions to the output file */ + for (ii = 1; ii < hdunum; ii++) + { + fits_movabs_hdu(*fptr, ii, NULL, status); + if (fits_copy_hdu(*fptr, newptr, 0, status) > 0) + { + ffclos(newptr, status); + return(*status); + } + } + + /* move back to the original HDU position */ + fits_movabs_hdu(*fptr, hdunum, NULL, status); + + /* get the size of the input image */ + fits_get_img_type(*fptr, &bitpix, status); + fits_get_img_dim(*fptr, &naxis, status); + if (fits_get_img_size(*fptr, naxis, naxes, status) > 0) + { + ffclos(newptr, status); + return(*status); + } + + if (naxis < 1 || naxis > 9) + { + ffpmsg( + "Input image either had NAXIS = 0 (NULL image) or has > 9 dimensions"); + ffclos(newptr, status); + return(*status = BAD_NAXIS); + } + + /* create output image with same size and type as the input image */ + /* Will update the size later */ + fits_create_img(newptr, bitpix, naxis, naxes, status); + + /* copy all other non-structural keywords from the input to output file */ + fits_get_hdrspace(*fptr, &numkeys, NULL, status); + + for (nkey = 4; nkey <= numkeys; nkey++) /* skip the first few keywords */ + { + fits_read_record(*fptr, nkey, card, status); + + if (fits_get_keyclass(card) > TYP_CMPRS_KEY) + { + /* write the record to the output file */ + fits_write_record(newptr, card, status); + } + } + + if (*status > 0) + { + ffpmsg("error copying header from input image to output image"); + return(*status); + } + + /* parse the section specifier to get min, max, and inc for each axis */ + /* and the size of each output image axis */ + + outsize = 1; + cptr = expr; + for (ii=0; ii < naxis; ii++) + { + + if (fits_get_section_range(&cptr, &smin, &smax, &sinc, status) > 0) + { + ffpmsg("error parsing the following image section specifier:"); + ffpmsg(expr); + ffclos(newptr, status); + return(*status); + } + + if (smax == 0) + smax = naxes[ii]; /* use whole axis by default */ + else if (smin == 0) + smin = naxes[ii]; /* use inverted whole axis */ + + if (smin > naxes[ii] || smax > naxes[ii]) + { + ffpmsg("image section exceeds dimensions of input image:"); + ffpmsg(expr); + ffclos(newptr, status); + return(*status = BAD_NAXIS); + } + + fpixels[ii] = smin; + lpixels[ii] = smax; + incs[ii] = sinc; + + if (smin <= smax) + outnaxes[ii] = (smax - smin + sinc) / sinc; + else + outnaxes[ii] = (smin - smax + sinc) / sinc; + + outsize = outsize * outnaxes[ii]; + + /* modify the NAXISn keyword */ + fits_make_keyn("NAXIS", ii + 1, keyname, status); + fits_modify_key_lng(newptr, keyname, outnaxes[ii], NULL, status); + + /* modify the WCS keywords if necessary */ + + if (fpixels[ii] != 1 || incs[ii] != 1) + { + /* read the CRPIXn keyword if it exists in the input file */ + fits_make_keyn("CRPIX", ii + 1, keyname, status); + tstatus = 0; + + if (fits_read_key(*fptr, TDOUBLE, keyname, + &crpix, NULL, &tstatus) == 0) + { + /* calculate the new CRPIXn value */ + if (fpixels[ii] <= lpixels[ii]) + crpix = (crpix - (fpixels[ii] - 1.0) - .5) / incs[ii] + 0.5; + else + crpix = (fpixels[ii] - (crpix - 1.0) - .5) / incs[ii] + 0.5; + + /* modify the value in the output file */ + fits_modify_key_dbl(newptr, keyname, crpix, 15, NULL, status); + + if (incs[ii] != 1 || fpixels[ii] > lpixels[ii]) + { + /* read the CDELTn keyword if it exists in the input file */ + fits_make_keyn("CDELT", ii + 1, keyname, status); + tstatus = 0; + + if (fits_read_key(*fptr, TDOUBLE, keyname, + &cdelt, NULL, &tstatus) == 0) + { + /* calculate the new CDELTn value */ + if (fpixels[ii] <= lpixels[ii]) + cdelt = cdelt * incs[ii]; + else + cdelt = cdelt * (-incs[ii]); + + /* modify the value in the output file */ + fits_modify_key_dbl(newptr, keyname, cdelt, 15, NULL, status); + } + + /* modify the CDi_j keywords if thet exist in the input file */ + + fits_make_keyn("CD1_", ii + 1, keyname, status); + tstatus = 0; + if (fits_read_key(*fptr, TDOUBLE, keyname, + &cdelt, NULL, &tstatus) == 0) + { + /* calculate the new CDi_j value */ + if (fpixels[ii] <= lpixels[ii]) + cdelt = cdelt * incs[ii]; + else + cdelt = cdelt * (-incs[ii]); + + /* modify the value in the output file */ + fits_modify_key_dbl(newptr, keyname, cdelt, 15, NULL, status); + } + + fits_make_keyn("CD2_", ii + 1, keyname, status); + tstatus = 0; + if (fits_read_key(*fptr, TDOUBLE, keyname, + &cdelt, NULL, &tstatus) == 0) + { + /* calculate the new CDi_j value */ + if (fpixels[ii] <= lpixels[ii]) + cdelt = cdelt * incs[ii]; + else + cdelt = cdelt * (-incs[ii]); + + /* modify the value in the output file */ + fits_modify_key_dbl(newptr, keyname, cdelt, 15, NULL, status); + } + } + } + } + } /* end of main NAXIS loop */ + + if (ffrdef(newptr, status) > 0) /* force the header to be scanned */ + { + ffclos(newptr, status); + return(*status); + } + + /* write a dummy value to the last pixel in the output section */ + /* This will force memory to be allocated for the FITS files if it */ + /* is being written in memory, before we allocate some more memory */ + /* below. Hopefully this leads to better memory management and */ + /* reduces the probability that the memory for the FITS file will have */ + /* to be reallocated to a new location later. */ + + /* turn off any scaling of the pixel values */ + fits_set_bscale(*fptr, 1.0, 0.0, status); + fits_set_bscale(newptr, 1.0, 0.0, status); + + dummy[0] = 0; + if (fits_write_img(newptr, TLONG, outsize, 1, dummy, status) > 0) + { + ffpmsg("error trying to write dummy value to the last image pixel"); + ffclos(newptr, status); + return(*status); + } + + /* allocate memory for the entire image section */ + buffsize = (abs(bitpix) / 8) * outsize; + + buffer = (double *) malloc(buffsize); + if (!buffer) + { + ffpmsg("error allocating memory for image section"); + ffclos(newptr, status); + return(*status = MEMORY_ALLOCATION); + } + + /* read the image section then write it to the output file */ + + if (bitpix == 8) + { + ffgsvb(*fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0, + (unsigned char *) buffer, &anynull, status); + + ffpprb(newptr, 1, 1, outsize, (unsigned char *) buffer, status); + } + else if (bitpix == 16) + { + ffgsvi(*fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0, + (short *) buffer, &anynull, status); + + ffppri(newptr, 1, 1, outsize, (short *) buffer, status); + } + else if (bitpix == 32) + { + ffgsvk(*fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0, + (int *) buffer, &anynull, status); + + ffpprk(newptr, 1, 1, outsize, (int *) buffer, status); + } + else if (bitpix == -32) + { + ffgsve(*fptr, 1, naxis, naxes, fpixels, lpixels, incs, FLOATNULLVALUE, + (float *) buffer, &anynull, status); + + ffppne(newptr, 1, 1, outsize, (float *) buffer, FLOATNULLVALUE, status); + } + else if (bitpix == -64) + { + ffgsvd(*fptr, 1, naxis, naxes, fpixels, lpixels, incs, DOUBLENULLVALUE, + buffer, &anynull, status); + + ffppnd(newptr, 1, 1, outsize, buffer, DOUBLENULLVALUE, + status); + } + + free(buffer); /* finished with the memory */ + + if (*status > 0) + { + ffpmsg("error copying image section from input to output file"); + ffclos(newptr, status); + return(*status); + } + + /* copy any remaining HDUs to the output file */ + + for (ii = hdunum + 1; 1; ii++) + { + if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0) + break; + + fits_copy_hdu(*fptr, newptr, 0, status); + } + + if (*status == END_OF_FILE) + *status = 0; /* got the expected EOF error; reset = 0 */ + else if (*status > 0) + { + ffclos(newptr, status); + return(*status); + } + + /* close the original file and return ptr to the new image */ + ffclos(*fptr, status); + + *fptr = newptr; /* reset the pointer to the new table */ + + /* move back to the image subsection */ + if (ii - 1 != hdunum) + fits_movabs_hdu(*fptr, hdunum, NULL, status); + else + { + /* may have to reset BSCALE and BZERO pixel scaling, */ + /* since the keywords were previously turned off */ + + if (ffrdef(*fptr, status) > 0) + { + ffclos(*fptr, status); + return(*status); + } + + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_section_range(char **ptr, + long *secmin, + long *secmax, + long *incre, + int *status) +/* + Parse the input image section specification string, returning + the min, max and increment values. + Typical string = "1:512:2" or "1:512" +*/ +{ + int slen, isanumber; + char token[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + slen = fits_get_token(ptr, " ,:", token, &isanumber); /* get 1st token */ + + if (*token == '*') /* wild card means to use the whole range */ + { + *secmin = 1; + *secmax = 0; + } + else if (*token == '-' && *(token+1) == '*' ) /* invert the whole range */ + { + *secmin = 0; + *secmax = 1; + } + else + { + if (slen == 0 || !isanumber || **ptr != ':') + return(*status = URL_PARSE_ERROR); + + /* the token contains the min value */ + *secmin = atol(token); + + (*ptr)++; /* skip the colon between the min and max values */ + slen = fits_get_token(ptr, " ,:", token, &isanumber); /* get token */ + + if (slen == 0 || !isanumber) + return(*status = URL_PARSE_ERROR); + + /* the token contains the max value */ + *secmax = atol(token); + } + + if (**ptr == ':') + { + (*ptr)++; /* skip the colon between the max and incre values */ + slen = fits_get_token(ptr, " ,", token, &isanumber); /* get token */ + + if (slen == 0 || !isanumber) + return(*status = URL_PARSE_ERROR); + + *incre = atol(token); + } + else + *incre = 1; /* default increment if none is supplied */ + + if (**ptr == ',') + (*ptr)++; + + while (**ptr == ' ') /* skip any trailing blanks */ + (*ptr)++; + + if (*secmin < 0 || *secmax < 0 || *incre < 1) + *status = URL_PARSE_ERROR; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffselect_table( + fitsfile **fptr, /* IO - pointer to input table; on output it */ + /* points to the new selected rows table */ + char *outfile, /* I - name for output file */ + char *expr, /* I - Boolean expression */ + int *status) +{ + fitsfile *newptr; + int ii, hdunum; + + if (*outfile) + { + /* create new empty file in to hold the selected rows */ + if (ffinit(&newptr, outfile, status) > 0) + { + ffpmsg( + "failed to create file for selected rows from input table"); + ffpmsg(outfile); + return(*status); + } + + fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */ + + /* copy all preceding extensions to the output file */ + for (ii = 1; ii < hdunum; ii++) + { + fits_movabs_hdu(*fptr, ii, NULL, status); + if (fits_copy_hdu(*fptr, newptr, 0, status) > 0) + { + ffclos(newptr, status); + return(*status); + } + } + + /* copy all the header keywords from the input to output file */ + fits_movabs_hdu(*fptr, hdunum, NULL, status); + if (fits_copy_header(*fptr, newptr, status) > 0) + { + ffclos(newptr, status); + return(*status); + } + + /* set number of rows = 0 */ + fits_modify_key_lng(newptr, "NAXIS2", 0, NULL,status); + (newptr->Fptr)->numrows = 0; + (newptr->Fptr)->origrows = 0; + + if (ffrdef(newptr, status) > 0) /* force the header to be scanned */ + { + ffclos(newptr, status); + return(*status); + } + } + else + newptr = *fptr; /* will delete rows in place in the table */ + + /* copy rows which satisfy the selection expression to the output table */ + /* or delete the nonqualifying rows if *fptr = newptr. */ + if (fits_select_rows(*fptr, newptr, expr, status) > 0) + { + if (*outfile) + ffclos(newptr, status); + + return(*status); + } + + if (*outfile) + { + /* copy any remaining HDUs to the output copy */ + + for (ii = hdunum + 1; 1; ii++) + { + if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0) + break; + + fits_copy_hdu(*fptr, newptr, 0, status); + } + + if (*status == END_OF_FILE) + *status = 0; /* got the expected EOF error; reset = 0 */ + else if (*status > 0) + { + ffclos(newptr, status); + return(*status); + } + + /* close the original file and return ptr to the new image */ + ffclos(*fptr, status); + + *fptr = newptr; /* reset the pointer to the new table */ + + /* move back to the selected table HDU */ + fits_movabs_hdu(*fptr, hdunum, NULL, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffparsecompspec(fitsfile *fptr, /* I - FITS file pointer */ + char *compspec, /* I - image compression specification */ + int *status) /* IO - error status */ +/* + Parse the image compression specification that was give in square brackets + following the output FITS file name, as in these examples: + + myfile.fits[compress] - default Rice compression, row by row + myfile.fits[compress TYPE] - the first letter of TYPE defines the + compression algorithm: + R = Rice + G = GZIP + P = PLIO + + myfile.fits[compress TYPE 100,100] - the numbers give the dimensions + of the compression tiles. Default + is NAXIS1, 1, 1, ... + + myfile.fits[compress; 5] The number following the semicolon + mufile.fits[compress TYPE; 5] gives the value of the noisebits + myfile.fits[compress TYPE 100,100; 5] parameter that is used when + quantizing floating point images. + +The compression parameters are saved in the fptr->Fptr structure for use +when writing FITS images. + +*/ +{ + char *ptr1; + + /* initialize with default values */ + int ii, compresstype = RICE_1, noisebits = 4; + long tilesize[9] = {0,1,1,1,1,1,1,1,1}; + + ptr1 = compspec; + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + + if (strncmp(ptr1, "compress", 8) && strncmp(ptr1, "COMPRESS", 8) ) + { + /* apparently this string does not specify compression parameters */ + return(*status = URL_PARSE_ERROR); + } + + ptr1 += 8; + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + + /* ========================= */ + /* look for compression type */ + /* ========================= */ + + if (*ptr1 == 'r' || *ptr1 == 'R') + { + compresstype = RICE_1; + while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0') + ptr1++; + } + else if (*ptr1 == 'g' || *ptr1 == 'G') + { + compresstype = GZIP_1; + while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0') + ptr1++; + + } + else if (*ptr1 == 'p' || *ptr1 == 'P') + { + compresstype = PLIO_1; + while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0') + ptr1++; + } + + /* ======================== */ + /* look for tile dimensions */ + /* ======================== */ + + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + + ii = 0; + while (isdigit( (int) *ptr1) && ii < 9) + { + tilesize[ii] = atol(ptr1); /* read the integer value */ + ii++; + + while (isdigit((int) *ptr1)) /* skip over the integer */ + ptr1++; + + if (*ptr1 == ',') + ptr1++; /* skip over the comma */ + + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + } + + /* ============================= */ + /* look for noise bits parameter */ + /* ============================= */ + + if (*ptr1 == ';') + { + ptr1++; + + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + + if (!isdigit((int) *ptr1) ) + return(*status = URL_PARSE_ERROR); + + noisebits = atol(ptr1); /* read the integer value */ + + while (isdigit((int) *ptr1)) /* skip over the integer */ + ptr1++; + } + + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + + if (*ptr1 != 0) /* remaining junk in the string?? */ + return(*status = URL_PARSE_ERROR); + + /* ================================= */ + /* finished parsing; save the values */ + /* ================================= */ + + (fptr->Fptr)->request_compress_type = compresstype; + for (ii = 0; ii < 9; ii++) + (fptr->Fptr)->request_tilesize[ii] = tilesize[ii]; + (fptr->Fptr)->request_rice_nbits = noisebits; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdkinit(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - name of file to create */ + int *status) /* IO - error status */ +/* + Create and initialize a new FITS file on disk. This routine differs + from ffinit in that the input 'name' is literally taken as the name + of the disk file to be created, and it does not support CFITSIO's + extended filename syntax. +*/ +{ + if (*status > 0) + return(*status); + + *status = CREATE_DISK_FILE; + + ffinit(fptr, name,status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffinit(fitsfile **fptr, /* O - FITS file pointer */ + const char *name, /* I - name of file to create */ + int *status) /* IO - error status */ +/* + Create and initialize a new FITS file. +*/ +{ + int driver, slen, clobber = 0; + char *url; + char urltype[MAX_PREFIX_LEN], outfile[FLEN_FILENAME]; + char tmplfile[FLEN_FILENAME], compspec[80]; + int handle, create_disk_file = 0; + + if (*status > 0) + return(*status); + + if (*status == CREATE_DISK_FILE) + { + create_disk_file = 1; + *status = 0; + } + + *fptr = 0; /* initialize null file pointer */ + + if (need_to_initialize) /* this is called only once */ + *status = fits_init_cfitsio(); + + if (*status > 0) + return(*status); + + url = (char *) name; + while (*url == ' ') /* ignore leading spaces in the filename */ + url++; + + if (*url == '\0') + { + ffpmsg("Name of file to create is blank. (ffinit)"); + return(*status = FILE_NOT_CREATED); + } + + if (create_disk_file) + { + strcpy(outfile, url); + strcpy(urltype, "file://"); + tmplfile[0] = '\0'; + compspec[0] = '\0'; + } + else + { + + /* check for clobber symbol, i.e, overwrite existing file */ + if (*url == '!') + { + clobber = TRUE; + url++; + } + else + clobber = FALSE; + + /* parse the output file specification */ + ffourl(url, urltype, outfile, tmplfile, compspec, status); + + if (*status > 0) + { + ffpmsg("could not parse the output filename: (ffinit)"); + ffpmsg(url); + return(*status); + } + } + + /* find which driver corresponds to the urltype */ + *status = urltype2driver(urltype, &driver); + + if (*status) + { + ffpmsg("could not find driver for this file: (ffinit)"); + ffpmsg(url); + return(*status); + } + + /* delete pre-existing file, if asked to do so */ + if (clobber) + { + if (driverTable[driver].remove) + (*driverTable[driver].remove)(outfile); + } + + /* call appropriate driver to create the file */ + if (driverTable[driver].create) + { + *status = (*driverTable[driver].create)(outfile, &handle); + if (*status) + { + ffpmsg("failed to create new file (already exists?):"); + ffpmsg(url); + return(*status); + } + } + else + { + ffpmsg("cannot create a new file of this type: (ffinit)"); + ffpmsg(url); + return(*status = FILE_NOT_CREATED); + } + + /* allocate fitsfile structure and initialize = 0 */ + *fptr = (fitsfile *) calloc(1, sizeof(fitsfile)); + + if (!(*fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for following file: (ffopen)"); + ffpmsg(url); + return(*status = MEMORY_ALLOCATION); + } + + /* allocate FITSfile structure and initialize = 0 */ + (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile)); + + if (!((*fptr)->Fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for following file: (ffopen)"); + ffpmsg(url); + free(*fptr); + *fptr = 0; + return(*status = MEMORY_ALLOCATION); + } + + slen = strlen(url) + 1; + slen = maxvalue(slen, 32); /* reserve at least 32 chars */ + ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */ + + if ( !(((*fptr)->Fptr)->filename) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for filename: (ffinit)"); + ffpmsg(url); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = FILE_NOT_CREATED); + } + + /* mem for headstart array */ + ((*fptr)->Fptr)->headstart = (OFF_T *) calloc(1001, sizeof(OFF_T)); + + if ( !(((*fptr)->Fptr)->headstart) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for headstart array: (ffinit)"); + ffpmsg(url); + free( ((*fptr)->Fptr)->filename); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + /* store the parameters describing the file */ + ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */ + ((*fptr)->Fptr)->filehandle = handle; /* store the file pointer */ + ((*fptr)->Fptr)->driver = driver; /* driver number */ + strcpy(((*fptr)->Fptr)->filename, url); /* full input filename */ + ((*fptr)->Fptr)->filesize = 0; /* physical file size */ + ((*fptr)->Fptr)->logfilesize = 0; /* logical file size */ + ((*fptr)->Fptr)->writemode = 1; /* read-write mode */ + ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */ + ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */ + ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */ + ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */ + + ffldrc(*fptr, 0, IGNORE_EOF, status); /* initialize first record */ + + fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */ + + /* if template file was given, use it to define structure of new file */ + + if (tmplfile[0]) + ffoptplt(*fptr, tmplfile, status); + + /* parse and save image compression specification, if given */ + if (compspec[0]) + ffparsecompspec(*fptr, compspec, status); + + return(*status); /* successful return */ +} +/*--------------------------------------------------------------------------*/ +/* ffimem == fits_create_memfile */ + +int ffimem(fitsfile **fptr, /* O - FITS file pointer */ + void **buffptr, /* I - address of memory pointer */ + size_t *buffsize, /* I - size of buffer, in bytes */ + size_t deltasize, /* I - increment for future realloc's */ + void *(*mem_realloc)(void *p, size_t newsize), /* function */ + int *status) /* IO - error status */ + +/* + Create and initialize a new FITS file in memory +*/ +{ + int driver, slen; + char urltype[MAX_PREFIX_LEN]; + int handle; + + if (*status > 0) + return(*status); + + *fptr = 0; /* initialize null file pointer */ + + if (need_to_initialize) /* this is called only once */ + *status = fits_init_cfitsio(); + + if (*status > 0) + return(*status); + + strcpy(urltype, "memkeep://"); /* URL type for pre-existing memory file */ + + *status = urltype2driver(urltype, &driver); + + if (*status > 0) + { + ffpmsg("could not find driver for pre-existing memory file: (ffimem)"); + return(*status); + } + + /* call driver routine to "open" the memory file */ + *status = mem_openmem( buffptr, buffsize, deltasize, + mem_realloc, &handle); + + if (*status > 0) + { + ffpmsg("failed to open pre-existing memory file: (ffimem)"); + return(*status); + } + + /* allocate fitsfile structure and initialize = 0 */ + *fptr = (fitsfile *) calloc(1, sizeof(fitsfile)); + + if (!(*fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for memory file: (ffimem)"); + return(*status = MEMORY_ALLOCATION); + } + + /* allocate FITSfile structure and initialize = 0 */ + (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile)); + + if (!((*fptr)->Fptr)) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate structure for memory file: (ffimem)"); + free(*fptr); + *fptr = 0; + return(*status = MEMORY_ALLOCATION); + } + + slen = 32; /* reserve at least 32 chars */ + ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */ + + if ( !(((*fptr)->Fptr)->filename) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for filename: (ffimem)"); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + /* mem for headstart array */ + ((*fptr)->Fptr)->headstart = (OFF_T *) calloc(1001, sizeof(OFF_T)); + + if ( !(((*fptr)->Fptr)->headstart) ) + { + (*driverTable[driver].close)(handle); /* close the file */ + ffpmsg("failed to allocate memory for headstart array: (ffinit)"); + free( ((*fptr)->Fptr)->filename); + free((*fptr)->Fptr); + free(*fptr); + *fptr = 0; /* return null file pointer */ + return(*status = MEMORY_ALLOCATION); + } + + /* store the parameters describing the file */ + ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */ + ((*fptr)->Fptr)->filehandle = handle; /* file handle */ + ((*fptr)->Fptr)->driver = driver; /* driver number */ + strcpy(((*fptr)->Fptr)->filename, "memfile"); /* dummy filename */ + ((*fptr)->Fptr)->filesize = *buffsize; /* physical file size */ + ((*fptr)->Fptr)->logfilesize = *buffsize; /* logical file size */ + ((*fptr)->Fptr)->writemode = 1; /* read-write mode */ + ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */ + ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */ + ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */ + ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */ + + ffldrc(*fptr, 0, IGNORE_EOF, status); /* initialize first record */ + fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_init_cfitsio(void) +/* + initialize anything that is required before using the CFITSIO routines +*/ +{ + int status; + + union u_tag { + short ival; + char cval[2]; + } u; + + need_to_initialize = 0; + + /* test for correct byteswapping. */ + + u.ival = 1; + if ((BYTESWAPPED && u.cval[0] != 1) || + (BYTESWAPPED == FALSE && u.cval[1] != 1) ) + { + printf ("\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n"); + printf(" Byteswapping is not being done correctly on this system.\n"); + printf(" Check the MACHINE and BYTESWAPPED definitions in fitsio2.h\n"); + printf(" Please report this problem to the author at\n"); + printf(" pence@tetra.gsfc.nasa.gov\n"); + printf( "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n"); + return(1); + } + + /* register the standard I/O drivers that are always available */ + + /* 1--------------------disk file driver-----------------------*/ + status = fits_register_driver("file://", + file_init, + file_shutdown, + file_setoptions, + file_getoptions, + file_getversion, + file_checkfile, + file_open, + file_create, +#ifdef HAVE_FTRUNCATE + file_truncate, +#else + NULL, /* no file truncate function */ +#endif + file_close, + file_remove, + file_size, + file_flush, + file_seek, + file_read, + file_write); + + if (status) + { + ffpmsg("failed to register the file:// driver (init_cfitsio)"); + return(status); + } + + /* 2------------ output temporary memory file driver ----------------*/ + status = fits_register_driver("mem://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + NULL, /* open function not allowed */ + mem_create, + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + + if (status) + { + ffpmsg("failed to register the mem:// driver (init_cfitsio)"); + return(status); + } + + /* 3--------------input pre-existing memory file driver----------------*/ + status = fits_register_driver("memkeep://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + NULL, /* file open driver function is not used */ + NULL, /* create function not allowed */ + mem_truncate, + mem_close_keep, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + + if (status) + { + ffpmsg("failed to register the memkeep:// driver (init_cfitsio)"); + return(status); + } + + /* 4-------------------stdin stream driver----------------------*/ + /* the stdin stream is copied to memory then opened in memory */ + + status = fits_register_driver("stdin://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + stdin_checkfile, + stdin_open, + NULL, /* create function not allowed */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the stdin:// driver (init_cfitsio)"); + return(status); + } + + /* 5-------------------stdin file stream driver----------------------*/ + /* the stdin stream is copied to a disk file then the disk file is opened */ + + status = fits_register_driver("stdinfile://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + stdin_open, + NULL, /* create function not allowed */ +#ifdef HAVE_FTRUNCATE + file_truncate, +#else + NULL, /* no file truncate function */ +#endif + file_close, + file_remove, + file_size, + file_flush, + file_seek, + file_read, + file_write); + + if (status) + { + ffpmsg("failed to register the stdinfile:// driver (init_cfitsio)"); + return(status); + } + + + /* 6-----------------------stdout stream driver------------------*/ + status = fits_register_driver("stdout://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + NULL, /* open function not required */ + mem_create, + mem_truncate, + stdout_close, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the stdout:// driver (init_cfitsio)"); + return(status); + } + + /* 7------------------iraf disk file to memory driver -----------*/ + status = fits_register_driver("irafmem://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + mem_iraf_open, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the irafmem:// driver (init_cfitsio)"); + return(status); + } + + /* 8------------------raw binary file to memory driver -----------*/ + status = fits_register_driver("rawfile://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + mem_rawfile_open, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the rawfile:// driver (init_cfitsio)"); + return(status); + } + + /* 9------------------compressed disk file to memory driver -----------*/ + status = fits_register_driver("compress://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + mem_compress_open, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the compress:// driver (init_cfitsio)"); + return(status); + } + + /* 10------------------compressed disk file to memory driver -----------*/ + /* Identical to compress://, except it allows READWRITE access */ + + status = fits_register_driver("compressmem://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + mem_compress_openrw, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the compressmem:// driver (init_cfitsio)"); + return(status); + } + + /* 11------------------compressed disk file to disk file driver -------*/ + status = fits_register_driver("compressfile://", + file_init, + file_shutdown, + file_setoptions, + file_getoptions, + file_getversion, + NULL, /* checkfile not needed */ + file_compress_open, + file_create, +#ifdef HAVE_FTRUNCATE + file_truncate, +#else + NULL, /* no file truncate function */ +#endif + file_close, + file_remove, + file_size, + file_flush, + file_seek, + file_read, + file_write); + + if (status) + { + ffpmsg("failed to register the compressfile:// driver (init_cfitsio)"); + return(status); + } + + /* 12---create file in memory, then compress it to disk file on close--*/ + status = fits_register_driver("compressoutfile://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + NULL, /* open function not allowed */ + mem_create_comp, + mem_truncate, + mem_close_comp, + file_remove, /* delete existing compressed disk file */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + + if (status) + { + ffpmsg( + "failed to register the compressoutfile:// driver (init_cfitsio)"); + return(status); + } + + /* Register Optional drivers */ + +#ifdef HAVE_NET_SERVICES + + /* 13--------------------root driver-----------------------*/ + + status = fits_register_driver("root://", + root_init, + root_shutdown, + root_setoptions, + root_getoptions, + root_getversion, + NULL, /* checkfile not needed */ + root_open, + root_create, + NULL, /* No truncate possible */ + root_close, + NULL, /* No remove possible */ + root_size, /* no size possible */ + root_flush, + root_seek, /* Though will always succeed */ + root_read, + root_write); + + if (status) + { + ffpmsg("failed to register the root:// driver (init_cfitsio)"); + return(status); + } + + /* 14--------------------http driver-----------------------*/ + status = fits_register_driver("http://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + http_checkfile, + http_open, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the http:// driver (init_cfitsio)"); + return(status); + } + + /* 15--------------------http file driver-----------------------*/ + + status = fits_register_driver("httpfile://", + file_init, + file_shutdown, + file_setoptions, + file_getoptions, + file_getversion, + NULL, /* checkfile not needed */ + http_file_open, + file_create, +#ifdef HAVE_FTRUNCATE + file_truncate, +#else + NULL, /* no file truncate function */ +#endif + file_close, + file_remove, + file_size, + file_flush, + file_seek, + file_read, + file_write); + + if (status) + { + ffpmsg("failed to register the httpfile:// driver (init_cfitsio)"); + return(status); + } + + /* 16--------------------http memory driver-----------------------*/ + /* same as http:// driver, except memory file can be opened READWRITE */ + status = fits_register_driver("httpmem://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + http_checkfile, + http_file_open, /* this will simply call http_open */ + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the httpmem:// driver (init_cfitsio)"); + return(status); + } + + /* 17--------------------httpcompress file driver-----------------------*/ + + status = fits_register_driver("httpcompress://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + http_compress_open, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the httpcompress:// driver (init_cfitsio)"); + return(status); + } + + + /* 18--------------------ftp driver-----------------------*/ + status = fits_register_driver("ftp://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + ftp_checkfile, + ftp_open, + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the ftp:// driver (init_cfitsio)"); + return(status); + } + + /* 19--------------------ftp file driver-----------------------*/ + status = fits_register_driver("ftpfile://", + file_init, + file_shutdown, + file_setoptions, + file_getoptions, + file_getversion, + NULL, /* checkfile not needed */ + ftp_file_open, + file_create, +#ifdef HAVE_FTRUNCATE + file_truncate, +#else + NULL, /* no file truncate function */ +#endif + file_close, + file_remove, + file_size, + file_flush, + file_seek, + file_read, + file_write); + + if (status) + { + ffpmsg("failed to register the ftpfile:// driver (init_cfitsio)"); + return(status); + } + + /* 20--------------------ftp mem driver-----------------------*/ + /* same as ftp:// driver, except memory file can be opened READWRITE */ + status = fits_register_driver("ftpmem://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + ftp_checkfile, + ftp_file_open, /* this will simply call ftp_open */ + NULL, /* create function not required */ + mem_truncate, + mem_close_free, + NULL, /* remove function not required */ + mem_size, + NULL, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the ftpmem:// driver (init_cfitsio)"); + return(status); + } + + /* 21--------------------ftp compressed file driver------------------*/ + status = fits_register_driver("ftpcompress://", + mem_init, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + ftp_compress_open, + 0, /* create function not required */ + mem_truncate, + mem_close_free, + 0, /* remove function not required */ + mem_size, + 0, /* flush function not required */ + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the ftpcompress:// driver (init_cfitsio)"); + return(status); + } + /* === End of net drivers section === */ +#endif + +/* ==================== SHARED MEMORY DRIVER SECTION ======================= */ + +#ifdef HAVE_SHMEM_SERVICES + + /* 22--------------------shared memory driver-----------------------*/ + status = fits_register_driver("shmem://", + smem_init, + smem_shutdown, + smem_setoptions, + smem_getoptions, + smem_getversion, + NULL, /* checkfile not needed */ + smem_open, + smem_create, + NULL, /* truncate file not supported yet */ + smem_close, + smem_remove, + smem_size, + smem_flush, + smem_seek, + smem_read, + smem_write ); + + if (status) + { + ffpmsg("failed to register the shmem:// driver (init_cfitsio)"); + return(status); + } + +#endif + +/* ==================== END OF SHARED MEMORY DRIVER SECTION ================ */ + + return(status); +} +/*--------------------------------------------------------------------------*/ +int fits_register_driver(char *prefix, + int (*init)(void), + int (*shutdown)(void), + int (*setoptions)(int option), + int (*getoptions)(int *options), + int (*getversion)(int *version), + int (*checkfile) (char *urltype, char *infile, char *outfile), + int (*open)(char *filename, int rwmode, int *driverhandle), + int (*create)(char *filename, int *driverhandle), + int (*truncate)(int driverhandle, OFF_T filesize), + int (*close)(int driverhandle), + int (*fremove)(char *filename), + int (*size)(int driverhandle, OFF_T *size), + int (*flush)(int driverhandle), + int (*seek)(int driverhandle, OFF_T offset), + int (*read) (int driverhandle, void *buffer, long nbytes), + int (*write)(int driverhandle, void *buffer, long nbytes) ) +/* + register all the functions needed to support an I/O driver +*/ +{ + int status; + + if (no_of_drivers + 1 > MAX_DRIVERS) + return(TOO_MANY_DRIVERS); + + if (prefix == NULL) + return(BAD_URL_PREFIX); + + + if (init != NULL) + { + status = (*init)(); + if (status) + return(status); + } + + /* fill in data in table */ + strncpy(driverTable[no_of_drivers].prefix, prefix, MAX_PREFIX_LEN); + driverTable[no_of_drivers].prefix[MAX_PREFIX_LEN - 1] = 0; + driverTable[no_of_drivers].init = init; + driverTable[no_of_drivers].shutdown = shutdown; + driverTable[no_of_drivers].setoptions = setoptions; + driverTable[no_of_drivers].getoptions = getoptions; + driverTable[no_of_drivers].getversion = getversion; + driverTable[no_of_drivers].checkfile = checkfile; + driverTable[no_of_drivers].open = open; + driverTable[no_of_drivers].create = create; + driverTable[no_of_drivers].truncate = truncate; + driverTable[no_of_drivers].close = close; + driverTable[no_of_drivers].remove = fremove; + driverTable[no_of_drivers].size = size; + driverTable[no_of_drivers].flush = flush; + driverTable[no_of_drivers].seek = seek; + driverTable[no_of_drivers].read = read; + driverTable[no_of_drivers].write = write; + + no_of_drivers++; /* increment the number of drivers */ + return(0); + } +/*--------------------------------------------------------------------------*/ +int ffiurl(char *url, /* input filename */ + char *urltype, /* e.g., 'file://', 'http://', 'mem://' */ + char *infilex, /* root filename (may be complete path) */ + char *outfile, /* optional output file name */ + char *extspec, /* extension spec: +n or [extname, extver] */ + char *rowfilterx, /* boolean row filter expression */ + char *binspec, /* histogram binning specifier */ + char *colspec, /* column or keyword modifier expression */ + int *status) +/* + parse the input URL into its basic components. + This routine is big and ugly and should be redesigned someday! +*/ +{ + int ii, jj, slen, infilelen, plus_ext = 0, collen; + char *ptr1, *ptr2, *ptr3, *tmptr; + int hasAt, hasDot, hasOper, followingOper, spaceTerm, rowFilter; + int colStart, binStart; + + + /* must have temporary variable for these, in case inputs are NULL */ + char *infile; + char *rowfilter; + char *tmpstr; + + if (*status > 0) + return(*status); + + /* Initialize null strings */ + if (infilex) *infilex = '\0'; + if (urltype) *urltype = '\0'; + if (outfile) *outfile = '\0'; + if (extspec) *extspec = '\0'; + if (binspec) *binspec = '\0'; + if (colspec) *colspec = '\0'; + if (rowfilterx) *rowfilterx = '\0'; + + slen = strlen(url); + + if (slen == 0) /* blank filename ?? */ + return(*status); + + /* allocate memory for 3 strings, each as long as the input url */ + infile = (char *) calloc(3, slen + 1); + if (!infile) + return(*status = MEMORY_ALLOCATION); + + rowfilter = &infile[slen + 1]; + tmpstr = &rowfilter[slen + 1]; + + ptr1 = url; + + /* -------------------------------------------------------- */ + /* get urltype (e.g., file://, ftp://, http://, etc.) */ + /* --------------------------------------------------------- */ + + if (*ptr1 == '-' && ( *(ptr1 +1) == 0 || *(ptr1 +1) == ' ' || + *(ptr1 +1) == '[' || *(ptr1 +1) == '(' ) ) + { + /* "-" means read file from stdin. Also support "- ", */ + /* "-[extname]" and '-(outfile.fits)" but exclude disk file */ + /* names that begin with a minus sign, e.g., "-55d33m.fits" */ + + if (urltype) + strcat(urltype, "stdin://"); + ptr1++; + } + else if (!strncasecmp(ptr1, "stdin", 5)) + { + if (urltype) + strcat(urltype, "stdin://"); + ptr1 = ptr1 + 5; + } + else + { + ptr2 = strstr(ptr1, "://"); + ptr3 = strstr(ptr1, "(" ); + + if (ptr3 && (ptr3 < ptr2) ) + { + /* the urltype follows a '(' character, so it must apply */ + /* to the output file, and is not the urltype of the input file */ + ptr2 = 0; /* so reset pointer to zero */ + } + + if (ptr2) /* copy the explicit urltype string */ + { + if (urltype) + strncat(urltype, ptr1, ptr2 - ptr1 + 3); + ptr1 = ptr2 + 3; + } + else if (!strncmp(ptr1, "ftp:", 4) ) + { /* the 2 //'s are optional */ + if (urltype) + strcat(urltype, "ftp://"); + ptr1 += 4; + } + else if (!strncmp(ptr1, "http:", 5) ) + { /* the 2 //'s are optional */ + if (urltype) + strcat(urltype, "http://"); + ptr1 += 5; + } + else if (!strncmp(ptr1, "mem:", 4) ) + { /* the 2 //'s are optional */ + if (urltype) + strcat(urltype, "mem://"); + ptr1 += 4; + } + else if (!strncmp(ptr1, "shmem:", 6) ) + { /* the 2 //'s are optional */ + if (urltype) + strcat(urltype, "shmem://"); + ptr1 += 6; + } + else if (!strncmp(ptr1, "file:", 5) ) + { /* the 2 //'s are optional */ + if (urltype) + strcat(urltype, "file://"); + ptr1 += 5; + } + else /* assume file driver */ + { + if (urltype) + strcat(urltype, "file://"); + } + } + + /* ---------------------------------------------------------- + If this is a http:// type file, then the cgi file name could + include the '[' character, which should not be interpreted + as part of CFITSIO's Extended File Name Syntax. Test for this + case by seeing if the last character is a ']' or ')'. If it + is not, then just treat the whole input string as the file name + and do not attempt to interprete the name using the extended + filename syntax. + ----------------------------------------------------------- */ + + if (urltype && !strncmp(urltype, "http://", 7) ) + { + /* test for opening parenthesis or bracket in the file name */ + if( strchr(ptr1, '(' ) || strchr(ptr1, '[' ) ) + { + slen = strlen(ptr1); + ptr3 = ptr1 + slen - 1; + while (*ptr3 == ' ') /* ignore trailing blanks */ + ptr3--; + + if (*ptr3 != ']' && *ptr3 != ')' ) + { + /* name doesn't end with a ']' or ')' so don't try */ + /* to parse this unusual string (may be cgi string) */ + if (infilex) + strcpy(infilex, ptr1); + + free(infile); + return(*status); + } + } + } + + /* ---------------------------------------------------------- + Look for VMS style filenames like: + disk:[directory.subdirectory]filename.ext, or + [directory.subdirectory]filename.ext + + Check if the first character is a '[' and urltype != stdin + or if there is a ':[' string in the remaining url string. If + so, then need to move past this bracket character before + search for the opening bracket of a filter specification. + ----------------------------------------------------------- */ + + tmptr = ptr1; + if (*ptr1 == '[') + { + if (*url != '-') + tmptr = ptr1 + 1; /* this bracket encloses a VMS directory name */ + } + else + { + tmptr = strstr(ptr1, ":["); + if (tmptr) /* these 2 chars are part of the VMS disk and directory */ + tmptr += 2; + else + tmptr = ptr1; + } + + /* ------------------------ */ + /* get the input file name */ + /* ------------------------ */ + + ptr2 = strchr(tmptr, '('); /* search for opening parenthesis ( */ + ptr3 = strchr(tmptr, '['); /* search for opening bracket [ */ + + if (ptr2 == ptr3) /* simple case: no [ or ( in the file name */ + { + strcat(infile, ptr1); + } + else if (!ptr3 || /* no bracket, so () enclose output file name */ + (ptr2 && (ptr2 < ptr3)) ) /* () enclose output name before bracket */ + { + strncat(infile, ptr1, ptr2 - ptr1); + ptr2++; + + ptr1 = strchr(ptr2, ')' ); /* search for closing ) */ + if (!ptr1) + { + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ) */ + } + + if (outfile) + strncat(outfile, ptr2, ptr1 - ptr2); + + /* the opening [ could have been part of output name, */ + /* e.g., file(out[compress])[3][#row > 5] */ + /* so search again for opening bracket following the closing ) */ + ptr3 = strchr(ptr1, '['); + + } + else /* bracket comes first, so there is no output name */ + { + strncat(infile, ptr1, ptr3 - ptr1); + } + + /* strip off any trailing blanks in the names */ + + slen = strlen(infile); + while ( (--slen) > 0 && infile[slen] == ' ') + infile[slen] = '\0'; + + if (outfile) + { + slen = strlen(outfile); + while ( (--slen) > 0 && outfile[slen] == ' ') + outfile[slen] = '\0'; + } + + /* --------------------------------------------- */ + /* check if this is an IRAF file (.imh extension */ + /* --------------------------------------------- */ + + if (strstr(infile, ".imh")) + { + if (urltype) + strcpy(urltype, "irafmem://"); + } + + /* --------------------------------------------- */ + /* check if the 'filename+n' convention has been */ + /* used to specifiy which HDU number to open */ + /* --------------------------------------------- */ + + jj = strlen(infile); + + for (ii = jj - 1; ii >= 0; ii--) + { + if (infile[ii] == '+') /* search backwards for '+' sign */ + break; + } + + if (ii > 0 && (jj - ii) < 7) /* limit extension numbers to 5 digits */ + { + infilelen = ii; + ii++; + ptr1 = infile+ii; /* pointer to start of sequence */ + + for (; ii < jj; ii++) + { + if (!isdigit((int) infile[ii] ) ) /* are all the chars digits? */ + break; + } + + if (ii == jj) + { + /* yes, the '+n' convention was used. Copy */ + /* the digits to the output extspec string. */ + plus_ext = 1; + + if (extspec) + strncpy(extspec, ptr1, jj - infilelen); + + infile[infilelen] = '\0'; /* delete the extension number */ + } + } + + /* -------------------------------------------------------------------- */ + /* if '*' was given for the output name expand it to the root file name */ + /* -------------------------------------------------------------------- */ + + if (outfile && outfile[0] == '*') + { + /* scan input name backwards to the first '/' character */ + for (ii = jj - 1; ii >= 0; ii--) + { + if (infile[ii] == '/' || ii == 0) + { + strcpy(outfile, &infile[ii + 1]); + break; + } + } + } + + /* ------------------------------------------ */ + /* copy strings from local copy to the output */ + /* ------------------------------------------ */ + if (infilex) + strcpy(infilex, infile); + + /* ---------------------------------------------------------- */ + /* if no '[' character in the input string, then we are done. */ + /* ---------------------------------------------------------- */ + if (!ptr3) + { + free(infile); + return(*status); + } + + /* ------------------------------------------- */ + /* see if [ extension specification ] is given */ + /* ------------------------------------------- */ + + if (!plus_ext) /* extension no. not already specified? Then */ + /* first brackets must enclose extension name or # */ + /* or it encloses a image subsection specification */ + /* or a raw binary image specifier */ + + /* Or, the extension specification may have been */ + /* omitted and we have to guess what the user intended */ + { + ptr1 = ptr3 + 1; /* pointer to first char after the [ */ + + ptr2 = strchr(ptr1, ']' ); /* search for closing ] */ + if (!ptr2) + { + ffpmsg("input file URL is missing closing bracket ']'"); + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + + /* ---------------------------------------------- */ + /* First, test if this is a rawfile specifier */ + /* which looks something like: '[ib512,512:2880]' */ + /* Test if first character is b,i,j,d,r,f, or u, */ + /* and optional second character is b or l, */ + /* followed by one or more digits, */ + /* finally followed by a ',', ':', or ']' */ + /* ---------------------------------------------- */ + + if (*ptr1 == 'b' || *ptr1 == 'B' || *ptr1 == 'i' || *ptr1 == 'I' || + *ptr1 == 'j' || *ptr1 == 'J' || *ptr1 == 'd' || *ptr1 == 'D' || + *ptr1 == 'r' || *ptr1 == 'R' || *ptr1 == 'f' || *ptr1 == 'F' || + *ptr1 == 'u' || *ptr1 == 'U') + { + /* next optional character may be a b or l (for Big or Little) */ + ptr1++; + if (*ptr1 == 'b' || *ptr1 == 'B' || *ptr1 == 'l' || *ptr1 == 'L') + ptr1++; + + if (isdigit((int) *ptr1)) /* must have at least 1 digit */ + { + while (isdigit((int) *ptr1)) + ptr1++; /* skip over digits */ + + if (*ptr1 == ',' || *ptr1 == ':' || *ptr1 == ']' ) + { + /* OK, this looks like a rawfile specifier */ + + if (urltype) + { + if (strstr(urltype, "stdin") ) + strcpy(urltype, "rawstdin://"); + else + strcpy(urltype, "rawfile://"); + } + + /* append the raw array specifier to infilex */ + if (infilex) + { + strcat(infilex, ptr3); + ptr1 = strchr(infilex, ']'); /* find the closing ] char */ + if (ptr1) + *(ptr1 + 1) = '\0'; /* terminate string after the ] */ + } + + if (extspec) + strcpy(extspec, "0"); /* the 0 ext number is implicit */ + + tmptr = strchr(ptr2 + 1, '[' ); /* search for another [ char */ + + /* copy any remaining characters into rowfilterx */ + if (tmptr && rowfilterx) + { + strcat(rowfilterx, tmptr + 1); + + tmptr = strchr(rowfilterx, ']' ); /* search for closing ] */ + if (tmptr) + *tmptr = '\0'; /* overwrite the ] with null terminator */ + } + + free(infile); /* finished parsing, so return */ + return(*status); + } + } + } /* end of rawfile specifier test */ + + /* -------------------------------------------------------- */ + /* Not a rawfile, so next, test if this is an image section */ + /* i.e., an integer followed by a ':' or a '*' or '-*' */ + /* -------------------------------------------------------- */ + + ptr1 = ptr3 + 1; /* reset pointer to first char after the [ */ + tmptr = ptr1; + + while (*tmptr == ' ') + tmptr++; /* skip leading blanks */ + + while (isdigit((int) *tmptr)) + tmptr++; /* skip over leading digits */ + + if (*tmptr == ':' || *tmptr == '*' || *tmptr == '-') + { + /* this is an image section specifier */ + strcat(rowfilter, ptr3); +/* + don't want to assume 0 extension any more; may imply an image extension. + if (extspec) + strcpy(extspec, "0"); +*/ + } + else + { + /* ----------------------------------------------------------------- + Not an image section or rawfile spec so may be an extension spec. + + Examples of valid extension specifiers: + [3] - 3rd extension; 0 = primary array + [events] - events extension + [events, 2] - events extension, with EXTVER = 2 + [events,2] - spaces are optional + [events, 3, b] - same as above, plus XTENSION = 'BINTABLE' + [PICS; colName(12)] - an image in row 12 of the colName column + in the PICS table extension + [PICS; colName(exposure > 1000)] - as above, but find image in + first row with with exposure column value > 1000. + [Rate Table] - extension name can contain spaces! + [Rate Table;colName(exposure>1000)] + + Examples of other types of specifiers (Not extension specifiers) + + [bin] !!! this is ambiguous, and can't be distinguished from + a valid extension specifier + [bini X=1:512:16] (also binb, binj, binr, and bind are allowed) + [binr (X,Y) = 5] + [bin @binfilter.txt] + + [col Time;rate] + [col PI=PHA * 1.1] + [col -Time; status] + + [X > 5] + [X>5] + [@filter.txt] + [StatusCol] !!! this is ambiguous, and can't be distinguished + from a valid extension specifier + [StatusCol==0] + [StatusCol || x>6] + [gtifilter()] + [regfilter("region.reg)] + + There will always be some ambiguity between an extension name and + a boolean row filtering expression, (as in a couple of the above + examples). If there is any doubt, the expression should be treated + as an extension specification; The user can always add an explicit + expression specifier to override this interpretation. + + The following decision logic will be used: + + 1) locate the first token, terminated with a space, comma, + semi-colon, or closing bracket. + + 2) the token is not part of an extension specifier if any of + the following is true: + + - if the token begins with '@' and contains a '.' + - if the token contains an operator: = > < || && + - if the token begins with "gtifilter(" or "regfilter(" + - if the token is terminated by a space and is followed by + additional characters (not a ']') AND any of the following: + - the token is 'col' + - the token is 3 or 4 chars long and begins with 'bin' + - the second token begins with an operator: + ! = < > | & + - * / % + + + 3) otherwise, the string is assumed to be an extension specifier + + ----------------------------------------------------------------- */ + + tmptr = ptr1; + while(*tmptr == ' ') + tmptr++; + + hasAt = 0; + hasDot = 0; + hasOper = 0; + followingOper = 0; + spaceTerm = 0; + rowFilter = 0; + colStart = 0; + binStart = 0; + + if (*tmptr == '@') /* test for leading @ symbol */ + hasAt = 1; + + if ( !strncasecmp(tmptr, "col ", 4) ) + colStart = 1; + + if ( !strncasecmp(tmptr, "bin", 3) ) + binStart = 1; + + if ( !strncasecmp(tmptr, "gtifilter(", 10) || + !strncasecmp(tmptr, "regfilter(", 10) ) + { + rowFilter = 1; + } + else + { + /* parse the first token of the expression */ + for (ii = 0; ii < ptr2 - ptr1 + 1; ii++, tmptr++) + { + if (*tmptr == '.') + hasDot = 1; + else if (*tmptr == '=' || *tmptr == '>' || *tmptr == '<' || + (*tmptr == '|' && *(tmptr+1) == '|') || + (*tmptr == '&' && *(tmptr+1) == '&') ) + hasOper = 1; + + else if (*tmptr == ',' || *tmptr == ';' || *tmptr == ']') + { + break; + } + else if (*tmptr == ' ') /* a space char? */ + { + while(*tmptr == ' ') /* skip spaces */ + tmptr++; + + if (*tmptr == ']') /* is this the end? */ + break; + + spaceTerm = 1; /* 1st token is terminated by space */ + + /* test if this is a column or binning specifier */ + if (colStart || (ii <= 4 && binStart) ) + rowFilter = 1; + else + { + + /* check if next character is an operator */ + if (*tmptr == '=' || *tmptr == '>' || *tmptr == '<' || + *tmptr == '|' || *tmptr == '&' || *tmptr == '!' || + *tmptr == '+' || *tmptr == '-' || *tmptr == '*' || + *tmptr == '/' || *tmptr == '%') + followingOper = 1; + } + break; + } + } + } + + /* test if this is NOT an extension specifier */ + if ( rowFilter || + (hasAt && hasDot) || + hasOper || + (spaceTerm && followingOper) ) + { + /* this is (probably) not an extension specifier */ + /* so copy all chars to filter spec string */ + strcat(rowfilter, ptr3); + } + else + { + /* this appears to be a legit extension specifier */ + /* copy the extension specification */ + if (extspec) + strncat(extspec, ptr1, ptr2 - ptr1); + + /* copy any remaining chars to filter spec string */ + strcat(rowfilter, ptr2 + 1); + } + } + } /* end of if (!plus_ext) */ + else + { + /* ------------------------------------------------------------------ */ + /* already have extension, so this must be a filter spec of some sort */ + /* ------------------------------------------------------------------ */ + + strcat(rowfilter, ptr3); + } + + /* strip off any trailing blanks from filter */ + slen = strlen(rowfilter); + while ( (--slen) >= 0 && rowfilter[slen] == ' ') + rowfilter[slen] = '\0'; + + if (!rowfilter[0]) + { + free(infile); + return(*status); /* nothing left to parse */ + } + + /* ------------------------------------------------ */ + /* does the filter contain a binning specification? */ + /* ------------------------------------------------ */ + + ptr1 = strstr(rowfilter, "[bin"); /* search for "[bin" */ + if (!ptr1) + ptr1 = strstr(rowfilter, "[BIN"); /* search for "[BIN" */ + if (!ptr1) + ptr1 = strstr(rowfilter, "[Bin"); /* search for "[Bin" */ + + if (ptr1) + { + ptr2 = ptr1 + 4; /* end of the '[bin' string */ + if (*ptr2 == 'b' || *ptr2 == 'i' || *ptr2 == 'j' || + *ptr2 == 'r' || *ptr2 == 'd') + ptr2++; /* skip the datatype code letter */ + + + if ( *ptr2 != ' ' && *ptr2 != ']') + ptr1 = NULL; /* bin string must be followed by space or ] */ + } + + if (ptr1) + { + /* found the binning string */ + if (binspec) + { + strcpy(binspec, ptr1 + 1); + ptr2 = strchr(binspec, ']'); + + if (ptr2) /* terminate the binning filter */ + { + *ptr2 = '\0'; + + if ( *(--ptr2) == ' ') /* delete trailing spaces */ + *ptr2 = '\0'; + } + else + { + ffpmsg("input file URL is missing closing bracket ']'"); + ffpmsg(rowfilter); + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + } + + /* delete the binning spec from the row filter string */ + ptr2 = strchr(ptr1, ']'); + strcpy(tmpstr, ptr2+1); /* copy any chars after the binspec */ + strcpy(ptr1, tmpstr); /* overwrite binspec */ + } + + /* --------------------------------------------------------- */ + /* does the filter contain a column selection specification? */ + /* --------------------------------------------------------- */ + + ptr1 = strstr(rowfilter, "[col "); + if (!ptr1) + { + ptr1 = strstr(rowfilter, "[COL "); + + if (!ptr1) + ptr1 = strstr(rowfilter, "[Col "); + } + + if (ptr1) + { /* find the end of the column specifier */ + ptr2 = ptr1 + 5; + while (*ptr2 != ']') + { + if (*ptr2 == '\0') + { + ffpmsg("input file URL is missing closing bracket ']'"); + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + + if (*ptr2 == '\'') /* start of a literal string */ + { + ptr2 = strchr(ptr2 + 1, '\''); /* find closing quote */ + if (!ptr2) + { + ffpmsg + ("literal string in input file URL is missing closing single quote"); + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + } + + if (*ptr2 == '[') /* set of nested square brackets */ + { + ptr2 = strchr(ptr2 + 1, ']'); /* find closing bracket */ + if (!ptr2) + { + ffpmsg + ("nested brackets in input file URL is missing closing bracket"); + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + } + + ptr2++; /* continue search for the closing bracket character */ + } + + collen = ptr2 - ptr1 - 1; + + if (colspec) /* copy the column specifier to output string */ + { + strncpy(colspec, ptr1 + 1, collen); + colspec[collen] = '\0'; + + while (colspec[--collen] == ' ') + colspec[collen] = '\0'; /* strip trailing blanks */ + } + + /* delete the column selection spec from the row filter string */ + strcpy(tmpstr, ptr2 + 1); /* copy any chars after the colspec */ + strcpy(ptr1, tmpstr); /* overwrite binspec */ + } + + /* copy the remaining string to the rowfilter output... should only */ + /* contain a rowfilter expression of the form "[expr]" */ + + if (rowfilterx && rowfilter[0]) { + ptr2 = rowfilter + strlen(rowfilter) - 1; + if( rowfilter[0]=='[' && *ptr2==']' ) { + *ptr2 = '\0'; + strcpy(rowfilterx, rowfilter+1); + } else { + ffpmsg("input file URL lacks valid row filter expression"); + *status = URL_PARSE_ERROR; + } + } + + free(infile); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffexist(const char *infile, /* I - input filename or URL */ + int *exists, /* O - 2 = a compressed version of file exists */ + /* 1 = yes, disk file exists */ + /* 0 = no, disk file could not be found */ + /* -1 = infile is not a disk file (could */ + /* be a http, ftp, smem, or stdin file) */ + int *status) /* I/O status */ + +/* + test if the input file specifier is an existing file on disk + If the specified file can't be found, it then searches for a + compressed version of the file. +*/ +{ + FILE *diskfile; + char rootname[FLEN_FILENAME]; + char *ptr1; + + if (*status > 0) + return(*status); + + /* strip off any extname or filters from the name */ + ffrtnm( (char *)infile, rootname, status); + + ptr1 = strstr(rootname, "://"); + + if (ptr1 || *rootname == '-') { + if (!strncmp(rootname, "file", 4) ) { + ptr1 = ptr1 + 3; /* pointer to start of the disk file name */ + } else { + *exists = -1; /* this is not a disk file */ + return (*status); + } + } else { + ptr1 = rootname; + } + + /* see if the disk file exists */ + if (file_openfile(ptr1, 0, &diskfile)) { + + /* no, couldn't open file, so see if there is a compressed version */ + if (file_is_compressed(ptr1) ) { + *exists = 2; /* a compressed version of the file exists */ + } else { + *exists = 0; /* neither file nor compressed version exist */ + } + + } else { + + /* yes, file exists */ + *exists = 1; + fclose(diskfile); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffrtnm(char *url, + char *rootname, + int *status) +/* + parse the input URL, returning the root name (filetype://basename). +*/ + +{ + int ii, jj, slen, infilelen; + char *ptr1, *ptr2, *ptr3; + char urltype[MAX_PREFIX_LEN]; + char infile[FLEN_FILENAME]; + + if (*status > 0) + return(*status); + + ptr1 = url; + *rootname = '\0'; + *urltype = '\0'; + *infile = '\0'; + + /* get urltype (e.g., file://, ftp://, http://, etc.) */ + if (*ptr1 == '-') /* "-" means read file from stdin */ + { + strcat(urltype, "-"); + ptr1++; + } + else if (!strncmp(ptr1, "stdin", 5) || !strncmp(ptr1, "STDIN", 5)) + { + strcat(urltype, "-"); + ptr1 = ptr1 + 5; + } + else + { + ptr2 = strstr(ptr1, "://"); + ptr3 = strstr(ptr1, "(" ); + + if (ptr3 && (ptr3 < ptr2) ) + { + /* the urltype follows a '(' character, so it must apply */ + /* to the output file, and is not the urltype of the input file */ + ptr2 = 0; /* so reset pointer to zero */ + } + + + if (ptr2) /* copy the explicit urltype string */ + { + strncat(urltype, ptr1, ptr2 - ptr1 + 3); + ptr1 = ptr2 + 3; + } + else if (!strncmp(ptr1, "ftp:", 4) ) + { /* the 2 //'s are optional */ + strcat(urltype, "ftp://"); + ptr1 += 4; + } + else if (!strncmp(ptr1, "http:", 5) ) + { /* the 2 //'s are optional */ + strcat(urltype, "http://"); + ptr1 += 5; + } + else if (!strncmp(ptr1, "mem:", 4) ) + { /* the 2 //'s are optional */ + strcat(urltype, "mem://"); + ptr1 += 4; + } + else if (!strncmp(ptr1, "shmem:", 6) ) + { /* the 2 //'s are optional */ + strcat(urltype, "shmem://"); + ptr1 += 6; + } + else if (!strncmp(ptr1, "file:", 5) ) + { /* the 2 //'s are optional */ + ptr1 += 5; + } + + /* else assume file driver */ + } + + /* get the input file name */ + ptr2 = strchr(ptr1, '('); /* search for opening parenthesis ( */ + ptr3 = strchr(ptr1, '['); /* search for opening bracket [ */ + + if (ptr2 == ptr3) /* simple case: no [ or ( in the file name */ + { + strcat(infile, ptr1); + } + else if (!ptr3) /* no bracket, so () enclose output file name */ + { + strncat(infile, ptr1, ptr2 - ptr1); + ptr2++; + + ptr1 = strchr(ptr2, ')' ); /* search for closing ) */ + if (!ptr1) + return(*status = URL_PARSE_ERROR); /* error, no closing ) */ + + } + else if (ptr2 && (ptr2 < ptr3)) /* () enclose output name before bracket */ + { + strncat(infile, ptr1, ptr2 - ptr1); + ptr2++; + + ptr1 = strchr(ptr2, ')' ); /* search for closing ) */ + if (!ptr1) + return(*status = URL_PARSE_ERROR); /* error, no closing ) */ + } + else /* bracket comes first, so there is no output name */ + { + strncat(infile, ptr1, ptr3 - ptr1); + } + + /* strip off any trailing blanks in the names */ + slen = strlen(infile); + for (ii = slen - 1; ii > 0; ii--) + { + if (infile[ii] == ' ') + infile[ii] = '\0'; + else + break; + } + + /* --------------------------------------------- */ + /* check if the 'filename+n' convention has been */ + /* used to specifiy which HDU number to open */ + /* --------------------------------------------- */ + + jj = strlen(infile); + + for (ii = jj - 1; ii >= 0; ii--) + { + if (infile[ii] == '+') /* search backwards for '+' sign */ + break; + } + + if (ii > 0 && (jj - ii) < 5) /* limit extension numbers to 4 digits */ + { + infilelen = ii; + ii++; + + + for (; ii < jj; ii++) + { + if (!isdigit((int) infile[ii] ) ) /* are all the chars digits? */ + break; + } + + if (ii == jj) + { + /* yes, the '+n' convention was used. */ + + infile[infilelen] = '\0'; /* delete the extension number */ + } + } + + strcat(rootname, urltype); /* construct the root name */ + strcat(rootname, infile); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffourl(char *url, /* I - full input URL */ + char *urltype, /* O - url type */ + char *outfile, /* O - base file name */ + char *tpltfile, /* O - template file name, if any */ + char *compspec, /* O - compression specification, if any */ + int *status) +/* + parse the output URL into its basic components. +*/ + +{ + char *ptr1, *ptr2, *ptr3; + + if (*status > 0) + return(*status); + + if (urltype) + *urltype = '\0'; + if (outfile) + *outfile = '\0'; + if (tpltfile) + *tpltfile = '\0'; + if (compspec) + *compspec = '\0'; + + ptr1 = url; + while (*ptr1 == ' ') /* ignore leading blanks */ + ptr1++; + + if ( ( (*ptr1 == '-') && ( *(ptr1 +1) == 0 || *(ptr1 +1) == ' ' ) ) + || !strcmp(ptr1, "stdout") + || !strcmp(ptr1, "STDOUT")) + + /* "-" means write to stdout; also support "- " */ + /* but exclude disk file names that begin with a minus sign */ + /* e.g., "-55d33m.fits" */ + { + if (urltype) + strcpy(urltype, "stdout://"); + } + else + { + /* not writing to stdout */ + /* get urltype (e.g., file://, ftp://, http://, etc.) */ + + ptr2 = strstr(ptr1, "://"); + if (ptr2) /* copy the explicit urltype string */ + { + if (urltype) + strncat(urltype, ptr1, ptr2 - ptr1 + 3); + + ptr1 = ptr2 + 3; + } + else /* assume file driver */ + { + if (urltype) + strcat(urltype, "file://"); + } + + /* look for template file name, enclosed in parenthesis */ + ptr2 = strchr(ptr1, '('); + + /* look for image compression parameters, enclosed in sq. brackets */ + ptr3 = strchr(ptr1, '['); + + if (outfile) + { + if (ptr2) /* template file was specified */ + strncat(outfile, ptr1, ptr2 - ptr1); + + else if (ptr3) /* compression was specified */ + strncat(outfile, ptr1, ptr3 - ptr1); + + else /* no template file or compression */ + strcpy(outfile, ptr1); + } + + + if (ptr2) /* template file was specified */ + { + ptr2++; + + ptr1 = strchr(ptr2, ')' ); /* search for closing ) */ + + if (!ptr1) + { + return(*status = URL_PARSE_ERROR); /* error, no closing ) */ + } + + if (tpltfile) + strncat(tpltfile, ptr2, ptr1 - ptr2); + } + + if (ptr3) /* compression was specified */ + { + ptr3++; + + ptr1 = strchr(ptr3, ']' ); /* search for closing ] */ + + if (!ptr1) + { + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + + if (compspec) + strncat(compspec, ptr3, ptr1 - ptr3); + } + + /* check if a .gz compressed output file is to be created */ + /* by seeing if the filename ends in '.gz' */ + if (urltype && outfile) + { + if (!strcmp(urltype, "file://") ) + { + ptr1 = strstr(outfile, ".gz"); + if (ptr1) + { /* make sure the ".gz" is at the end of the file name */ + ptr1 += 3; + if (*ptr1 == 0 || *ptr1 == ' ' ) + strcpy(urltype, "compressoutfile://"); + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffexts(char *extspec, + int *extnum, + char *extname, + int *extvers, + int *hdutype, + char *imagecolname, + char *rowexpress, + int *status) +{ +/* + Parse the input extension specification string, returning either the + extension number or the values of the EXTNAME, EXTVERS, and XTENSION + keywords in desired extension. Also return the name of the column containing + an image, and an expression to be used to determine which row to use, + if present. +*/ + char *ptr1, *ptr2; + int slen, nvals; + int notint = 1; /* initially assume specified extname is not an integer */ + char tmpname[FLEN_VALUE], *loc; + + *extnum = 0; + *extname = '\0'; + *extvers = 0; + *hdutype = ANY_HDU; + *imagecolname = '\0'; + *rowexpress = '\0'; + + if (*status > 0) + return(*status); + + ptr1 = extspec; /* pointer to first char */ + + while (*ptr1 == ' ') /* skip over any leading blanks */ + ptr1++; + + if (isdigit((int) *ptr1)) /* is the extension specification a number? */ + { + notint = 0; /* looks like extname may actually be the ext. number */ + *extnum = strtol(ptr1, &loc, 10); /* read the string as an integer */ + + while (*loc == ' ') /* skip over trailing blanks */ + loc++; + + /* check for read error, or junk following the integer */ + if ((*loc != '\0' ) || (errno == ERANGE) ) + { + *extnum = 0; + notint = 1; /* no, extname was not a simple integer after all */ + } + + if ( *extnum < 0 || *extnum > 99999) + { + *extnum = 0; /* this is not a reasonable extension number */ + ffpmsg("specified extension number is out of range:"); + ffpmsg(extspec); + return(*status = URL_PARSE_ERROR); + } + } + + +/* This logic was too simple, and failed on extnames like '1000TEMP' + where it would try to move to the 1000th extension + + if (isdigit((int) *ptr1)) + { + sscanf(ptr1, "%d", extnum); + if (*extnum < 0 || *extnum > 9999) + { + *extnum = 0; + ffpmsg("specified extension number is out of range:"); + ffpmsg(extspec); + return(*status = URL_PARSE_ERROR); + } + } +*/ + + if (notint) + { + /* not a number, so EXTNAME must be specified, followed by */ + /* optional EXTVERS and XTENSION values */ + + /* don't use space char as end indicator, because there */ + /* may be imbedded spaces in the EXTNAME value */ + slen = strcspn(ptr1, ",:;"); /* length of EXTNAME */ + strncat(extname, ptr1, slen); /* EXTNAME value */ + + /* now remove any trailing blanks */ + while (slen > 0 && *(extname + slen -1) == ' ') + { + *(extname + slen -1) = '\0'; + slen--; + } + + ptr1 += slen; + slen = strspn(ptr1, " ,:"); /* skip delimiter characters */ + ptr1 += slen; + + slen = strcspn(ptr1, " ,:;"); /* length of EXTVERS */ + if (slen) + { + nvals = sscanf(ptr1, "%d", extvers); /* EXTVERS value */ + if (nvals != 1) + { + ffpmsg("illegal EXTVER value in input URL:"); + ffpmsg(extspec); + return(*status = URL_PARSE_ERROR); + } + + ptr1 += slen; + slen = strspn(ptr1, " ,:"); /* skip delimiter characters */ + ptr1 += slen; + + slen = strcspn(ptr1, ";"); /* length of HDUTYPE */ + if (slen) + { + if (*ptr1 == 'b' || *ptr1 == 'B') + *hdutype = BINARY_TBL; + else if (*ptr1 == 't' || *ptr1 == 'T' || + *ptr1 == 'a' || *ptr1 == 'A') + *hdutype = ASCII_TBL; + else if (*ptr1 == 'i' || *ptr1 == 'I') + *hdutype = IMAGE_HDU; + else + { + ffpmsg("unknown type of HDU in input URL:"); + ffpmsg(extspec); + return(*status = URL_PARSE_ERROR); + } + } + } + else + { + strcpy(tmpname, extname); + ffupch(tmpname); + if (!strcmp(tmpname, "PRIMARY") || !strcmp(tmpname, "P") ) + *extname = '\0'; /* return extnum = 0 */ + } + } + + ptr1 = strchr(ptr1, ';'); + if (ptr1) + { + /* an image is to be opened; the image is contained in a single */ + /* cell of a binary table. A column name and an expression to */ + /* determine which row to use has been entered. */ + + ptr1++; /* skip over the ';' delimiter */ + while (*ptr1 == ' ') /* skip over any leading blanks */ + ptr1++; + + ptr2 = strchr(ptr1, '('); + if (!ptr2) + { + ffpmsg("illegal specification of image in table cell in input URL:"); + ffpmsg(" did not find a row expression enclosed in ( )"); + ffpmsg(extspec); + return(*status = URL_PARSE_ERROR); + } + + strncat(imagecolname, ptr1, ptr2 - ptr1); /* copy column name */ + + ptr2++; /* skip over the '(' delimiter */ + while (*ptr2 == ' ') /* skip over any leading blanks */ + ptr2++; + + + ptr1 = strchr(ptr2, ')'); + if (!ptr2) + { + ffpmsg("illegal specification of image in table cell in input URL:"); + ffpmsg(" missing closing ')' character in row expression"); + ffpmsg(extspec); + return(*status = URL_PARSE_ERROR); + } + + strncat(rowexpress, ptr2, ptr1 - ptr2); /* row expression */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffextn(char *url, /* I - input filename/URL */ + int *extension_num, /* O - returned extension number */ + int *status) +{ +/* + Parse the input url string and return the number of the extension that + CFITSIO would automatically move to if CFITSIO were to open this input URL. + The extension numbers are one's based, so 1 = the primary array, 2 = the + first extension, etc. + + The extension number that gets returned is determined by the following + algorithm: + + 1. If the input URL includes a binning specification (e.g. + 'myfile.fits[3][bin X,Y]') then the returned extension number + will always = 1, since CFITSIO would create a temporary primary + image on the fly in this case. The same is true if an image + within a single cell of a binary table is opened. + + 2. Else if the input URL specifies an extension number (e.g., + 'myfile.fits[3]' or 'myfile.fits+3') then the specified extension + number (+ 1) is returned. + + 3. Else if the extension name is specified in brackets + (e.g., this 'myfile.fits[EVENTS]') then the file will be opened and searched + for the extension number. If the input URL is '-' (reading from the stdin + file stream) this is not possible and an error will be returned. + + 4. Else if the URL does not specify an extension (e.g. 'myfile.fits') then + a special extension number = -99 will be returned to signal that no + extension was specified. This feature is mainly for compatibility with + existing FTOOLS software. CFITSIO would open the primary array by default + (extension_num = 1) in this case. + +*/ + fitsfile *fptr; + char urltype[20]; + char infile[FLEN_FILENAME]; + char outfile[FLEN_FILENAME]; + char extspec[FLEN_FILENAME]; + char extname[FLEN_FILENAME]; + char rowfilter[FLEN_FILENAME]; + char binspec[FLEN_FILENAME]; + char colspec[FLEN_FILENAME]; + char imagecolname[FLEN_VALUE], rowexpress[FLEN_FILENAME]; + char *cptr; + int extnum, extvers, hdutype, tstatus = 0; + + if (*status > 0) + return(*status); + + /* parse the input URL into its basic components */ + ffiurl(url, urltype, infile, outfile, + extspec, rowfilter,binspec, colspec, status); + + if (*status > 0) + return(*status); + + if (*binspec) /* is there a binning specification? */ + { + *extension_num = 1; /* a temporary primary array image is created */ + return(*status); + } + + if (*extspec) /* is an extension specified? */ + { + ffexts(extspec, &extnum, + extname, &extvers, &hdutype, imagecolname, rowexpress, status); + + if (*status > 0) + return(*status); + + if (*imagecolname) /* is an image within a table cell being opened? */ + { + *extension_num = 1; /* a temporary primary array image is created */ + return(*status); + } + + if (*extname) + { + /* have to open the file to search for the extension name (curses!) */ + + if (!strcmp(urltype, "stdin://")) + /* opening stdin would destroying it! */ + return(*status = URL_PARSE_ERROR); + + /* First, strip off any filtering specification */ + strcpy(infile, url); + cptr = strchr(infile, ']'); /* locate the closing bracket */ + if (!cptr) + { + return(*status = URL_PARSE_ERROR); + } + else + { + cptr++; + *cptr = '\0'; /* terminate URl after the extension spec */ + } + + if (ffopen(&fptr, infile, READONLY, status) > 0) /* open the file */ + { + ffclos(fptr, &tstatus); + return(*status); + } + + ffghdn(fptr, &extnum); /* where am I in the file? */ + *extension_num = extnum; + ffclos(fptr, status); + + return(*status); + } + else + { + *extension_num = extnum + 1; /* return the specified number (+ 1) */ + return(*status); + } + } + else + { + *extension_num = -99; /* no specific extension was specified */ + /* defaults to primary array */ + return(*status); + } +} +/*--------------------------------------------------------------------------*/ + +int ffurlt(fitsfile *fptr, char *urlType, int *status) +/* + return the prefix string associated with the driver in use by the + fitsfile pointer fptr +*/ + +{ + strcpy(urlType, driverTable[fptr->Fptr->driver].prefix); + return(*status); +} + +/*--------------------------------------------------------------------------*/ +int ffimport_file( char *filename, /* Text file to read */ + char **contents, /* Pointer to pointer to hold file */ + int *status ) /* CFITSIO error code */ +/* + Read and concatenate all the lines from the given text file. User + must free the pointer returned in contents. Pointer is guaranteed + to hold 2 characters more than the length of the text... allows the + calling routine to append (or prepend) a newline (or quotes?) without + reallocating memory. +*/ +{ + int allocLen, totalLen, llen, eoline; + char *lines,line[256]; + FILE *aFile; + + if( *status > 0 ) return( *status ); + + totalLen = 0; + allocLen = 1024; + lines = (char *)malloc( allocLen * sizeof(char) ); + if( !lines ) { + ffpmsg("Couldn't allocate memory to hold ASCII file contents."); + return(*status = MEMORY_ALLOCATION ); + } + lines[0] = '\0'; + + if( (aFile = fopen( filename, "r" ))==NULL ) { + sprintf(line,"Could not open ASCII file %s.",filename); + ffpmsg(line); + free( lines ); + return(*status = FILE_NOT_OPENED); + } + + while( fgets(line,256,aFile)!=NULL ) { + llen = strlen(line); + if ((llen > 1) && (line[0] == '/' && line[1] == '/')) + continue; /* skip comment lines begging with // */ + + eoline = 0; + + /* replace CR and newline chars at end of line with nulls */ + if ((llen > 0) && (line[llen-1]=='\n' || line[llen-1] == '\r')) { + line[--llen] = '\0'; + eoline = 1; /* found an end of line character */ + + if ((llen > 0) && (line[llen-1]=='\n' || line[llen-1] == '\r')) { + line[--llen] = '\0'; + } + } + + if( totalLen + llen + 3 >= allocLen ) { + allocLen += 256; + lines = (char *)realloc(lines, allocLen * sizeof(char) ); + if( ! lines ) { + ffpmsg("Couldn't allocate memory to hold ASCII file contents."); + *status = MEMORY_ALLOCATION; + break; + } + } + strcpy( lines+totalLen, line ); + totalLen += llen; + + if (eoline) { + strcpy( lines+totalLen, " "); /* add a space between lines */ + totalLen += 1; + } + } + fclose(aFile); + + *contents = lines; + return( *status ); +} + +/*--------------------------------------------------------------------------*/ +int fits_get_token(char **ptr, + char *delimiter, + char *token, + int *isanumber) /* O - is this token a number? */ +/* + parse off the next token, delimited by a character in 'delimiter', + from the input ptr string; increment *ptr to the end of the token. + Returns the length of the token, not including the delimiter char; +*/ +{ + int slen, ii; + + *token = '\0'; + + while (**ptr == ' ') /* skip over leading blanks */ + (*ptr)++; + + slen = strcspn(*ptr, delimiter); /* length of next token */ + if (slen) + { + strncat(token, *ptr, slen); /* copy token */ + + (*ptr) += slen; /* skip over the token */ + + if (isanumber) + { + *isanumber = 1; + + for (ii = 0; ii < slen; ii++) + { + if ( !isdigit((int) token[ii]) && token[ii] != '.' && + token[ii] != '-' && token[ii] != '+' && + token[ii] != 'E' && token[ii] != 'e') + { + *isanumber = 0; + break; + } + } + } + } + + return(slen); +} +/*---------------------------------------------------------------------------*/ +char *fits_split_names( + char *list) /* I - input list of names */ +{ +/* + A sequence of calls to fits_split_names will split the input string + into name tokens. The string typically contains a list of file or + column names. The names must be delimited by a comma and/or spaces. + This routine ignores spaces and commas that occur within parentheses, + brackets, or curly brackets. It also strips any leading and trailing + blanks from the returned name. + + This routine is similar to the ANSI C 'strtok' function: + + The first call to fits_split_names has a non-null input string. + It finds the first name in the string and terminates it by + overwriting the next character of the string with a '\0' and returns + a pointer to the name. Each subsequent call, indicated by a NULL + value of the input string, returns the next name, searching from + just past the end of the previous name. It returns NULL when no + further names are found. + + The following line illustrates how a string would be split into 3 names: + myfile[1][bin (x,y)=4], file2.fits file3.fits + ^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^ ^^^^^^^^^^ + 1st name 2nd name 3rd name + +*/ + int depth = 0; + char *start; + static char *ptr; + + if (list) /* reset ptr if a string is given */ + ptr = list; + + while (*ptr == ' ')ptr++; /* skip leading white space */ + + if (*ptr == '\0')return(0); /* no remaining file names */ + + start = ptr; + + while (*ptr != '\0') { + if ((*ptr == '[') || (*ptr == '(') || (*ptr == '{')) depth ++; + else if ((*ptr == '}') || (*ptr == ')') || (*ptr == ']')) depth --; + else if ((depth == 0) && (*ptr == ',' || *ptr == ' ')) { + *ptr = '\0'; /* terminate the filename here */ + ptr++; /* save pointer to start of next filename */ + break; + } + ptr++; + } + + return(start); +} +/*--------------------------------------------------------------------------*/ +int urltype2driver(char *urltype, int *driver) +/* + compare input URL with list of known drivers, returning the + matching driver numberL. +*/ + +{ + int ii; + + /* find matching driver; search most recent drivers first */ + + for (ii=no_of_drivers - 1; ii >= 0; ii--) + { + if (0 == strcmp(driverTable[ii].prefix, urltype)) + { + *driver = ii; + return(0); + } + } + + return(NO_MATCHING_DRIVER); +} +/*--------------------------------------------------------------------------*/ +int ffclos(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + close the FITS file by completing the current HDU, flushing it to disk, + then calling the system dependent routine to physically close the FITS file +*/ +{ + int tstatus = NO_CLOSE_ERROR, zerostatus = 0; + + if (!fptr) + return(*status = NULL_INPUT_PTR); + else if ((fptr->Fptr)->validcode != VALIDSTRUC) /* check for magic value */ + return(*status = BAD_FILEPTR); + + /* close and flush the current HDU */ + if (*status > 0) + ffchdu(fptr, &tstatus); /* turn off the error message from ffchdu */ + else + ffchdu(fptr, status); + + ((fptr->Fptr)->open_count)--; /* decrement usage counter */ + + if ((fptr->Fptr)->open_count == 0) /* if no other files use structure */ + { + ffflsh(fptr, TRUE, status); /* flush and disassociate IO buffers */ + + /* call driver function to actually close the file */ + if ( + (*driverTable[(fptr->Fptr)->driver].close)((fptr->Fptr)->filehandle) ) + { + if (*status <= 0) + { + *status = FILE_NOT_CLOSED; /* report if no previous error */ + + ffpmsg("failed to close the following file: (ffclos)"); + ffpmsg((fptr->Fptr)->filename); + } + } + + fits_clear_Fptr( fptr->Fptr, status); /* clear Fptr address */ + free((fptr->Fptr)->headstart); /* free memory for headstart array */ + free((fptr->Fptr)->filename); /* free memory for the filename */ + (fptr->Fptr)->filename = 0; + (fptr->Fptr)->validcode = 0; /* magic value to indicate invalid fptr */ + free(fptr->Fptr); /* free memory for the FITS file structure */ + free(fptr); /* free memory for the FITS file structure */ + } + else + { + /* + to minimize the fallout from any previous error (e.g., trying to + open a non-existent extension in a already opened file), + always call ffflsh with status = 0. + */ + /* just flush the buffers, don't disassociate them */ + if (*status > 0) + ffflsh(fptr, FALSE, &zerostatus); + else + ffflsh(fptr, FALSE, status); + + free(fptr); /* free memory for the FITS file structure */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdelt(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + close and DELETE the FITS file. +*/ +{ + char *basename; + int slen, tstatus = 0; + + if (!fptr) + return(*status = NULL_INPUT_PTR); + else if ((fptr->Fptr)->validcode != VALIDSTRUC) /* check for magic value */ + return(*status = BAD_FILEPTR); + + ffchdu(fptr, status); /* close the current HDU, ignore any errors */ + ffflsh(fptr, TRUE, status); /* flush and disassociate IO buffers */ + + /* call driver function to actually close the file */ + if ( (*driverTable[(fptr->Fptr)->driver].close)((fptr->Fptr)->filehandle) ) + { + if (*status <= 0) + { + *status = FILE_NOT_CLOSED; /* report error if no previous error */ + + ffpmsg("failed to close the following file: (ffdelt)"); + ffpmsg((fptr->Fptr)->filename); + } + } + + /* call driver function to actually delete the file */ + if ( (driverTable[(fptr->Fptr)->driver].remove) ) + { + /* parse the input URL to get the base filename */ + slen = strlen((fptr->Fptr)->filename); + basename = (char *) malloc(slen +1); + if (!basename) + return(*status = MEMORY_ALLOCATION); + + ffiurl((fptr->Fptr)->filename, NULL, basename, NULL, NULL, NULL, NULL, + NULL, &tstatus); + + if ((*driverTable[(fptr->Fptr)->driver].remove)(basename)) + { + ffpmsg("failed to delete the following file: (ffdelt)"); + ffpmsg((fptr->Fptr)->filename); + if (!(*status)) + *status = FILE_NOT_CLOSED; + } + free(basename); + } + + fits_clear_Fptr( fptr->Fptr, status); /* clear Fptr address */ + free((fptr->Fptr)->headstart); /* free memory for headstart array */ + free((fptr->Fptr)->filename); /* free memory for the filename */ + (fptr->Fptr)->filename = 0; + (fptr->Fptr)->validcode = 0; /* magic value to indicate invalid fptr */ + free(fptr->Fptr); /* free memory for the FITS file structure */ + free(fptr); /* free memory for the FITS file structure */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftrun( fitsfile *fptr, /* I - FITS file pointer */ + OFF_T filesize, /* I - size to truncate the file */ + int *status) /* O - error status */ +/* + low level routine to truncate a file to a new smaller size. +*/ +{ + if (driverTable[(fptr->Fptr)->driver].truncate) + { + ffflsh(fptr, FALSE, status); /* flush all the buffers first */ + (fptr->Fptr)->filesize = filesize; + (fptr->Fptr)->logfilesize = filesize; + (fptr->Fptr)->bytepos = filesize; + ffbfeof(fptr, status); /* eliminate any buffers beyond current EOF */ + return (*status = + (*driverTable[(fptr->Fptr)->driver].truncate)((fptr->Fptr)->filehandle, + filesize) ); + } + else + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffflushx( FITSfile *fptr) /* I - FITS file pointer */ +/* + low level routine to flush internal file buffers to the file. +*/ +{ + if (driverTable[fptr->driver].flush) + return ( (*driverTable[fptr->driver].flush)(fptr->filehandle) ); + else + return(0); /* no flush function defined for this driver */ +} +/*--------------------------------------------------------------------------*/ +int ffseek( FITSfile *fptr, /* I - FITS file pointer */ + OFF_T position) /* I - byte position to seek to */ +/* + low level routine to seek to a position in a file. +*/ +{ + return( (*driverTable[fptr->driver].seek)(fptr->filehandle, position) ); +} +/*--------------------------------------------------------------------------*/ +int ffwrite( FITSfile *fptr, /* I - FITS file pointer */ + long nbytes, /* I - number of bytes to write */ + void *buffer, /* I - buffer to write */ + int *status) /* O - error status */ +/* + low level routine to write bytes to a file. +*/ +{ + if ( (*driverTable[fptr->driver].write)(fptr->filehandle, buffer, nbytes) ) + *status = WRITE_ERROR; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffread( FITSfile *fptr, /* I - FITS file pointer */ + long nbytes, /* I - number of bytes to read */ + void *buffer, /* O - buffer to read into */ + int *status) /* O - error status */ +/* + low level routine to read bytes from a file. +*/ +{ + int readstatus; + + readstatus = (*driverTable[fptr->driver].read)(fptr->filehandle, + buffer, nbytes); + + if (readstatus == END_OF_FILE) + *status = END_OF_FILE; + else if (readstatus > 0) + *status = READ_ERROR; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftplt(fitsfile **fptr, /* O - FITS file pointer */ + const char *filename, /* I - name of file to create */ + const char *tempname, /* I - name of template file */ + int *status) /* IO - error status */ +/* + Create and initialize a new FITS file based on a template file. + Uses C fopen and fgets functions. +*/ +{ + if (*status > 0) + return(*status); + + if ( ffinit(fptr, filename, status) ) /* create empty file */ + return(*status); + + ffoptplt(*fptr, tempname, status); /* open and use template */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffoptplt(fitsfile *fptr, /* O - FITS file pointer */ + const char *tempname, /* I - name of template file */ + int *status) /* IO - error status */ +/* + open template file and use it to create new file +*/ +{ + fitsfile *tptr; + int tstatus = 0, nkeys, nadd, ii; + char card[FLEN_CARD]; + + if (*status > 0) + return(*status); + + if (tempname == NULL || *tempname == '\0') /* no template file? */ + return(*status); + + /* try opening template */ + ffopen(&tptr, (char *) tempname, READONLY, &tstatus); + + if (tstatus) /* not a FITS file, so treat it as an ASCII template */ + { + ffxmsg(2, card); /* clear the error message */ + fits_execute_template(fptr, (char *) tempname, status); + + ffmahd(fptr, 1, 0, status); /* move back to the primary array */ + return(*status); + } + else /* template is a valid FITS file */ + { + ffmahd(tptr, 1, NULL, status); /* make sure we are at the beginning */ + while (*status <= 0) + { + ffghsp(tptr, &nkeys, &nadd, status); /* get no. of keywords */ + + for (ii = 1; ii <= nkeys; ii++) /* copy keywords */ + { + ffgrec(tptr, ii, card, status); + ffprec(fptr, card, status); + } + + ffmrhd(tptr, 1, 0, status); /* move to next HDU until error */ + ffcrhd(fptr, status); /* create empty new HDU in output file */ + } + + if (*status == END_OF_FILE) + { + *status = 0; /* expected error condition */ + } + ffclos(tptr, status); /* close the template file */ + } + + ffmahd(fptr, 1, 0, status); /* move to the primary array */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +void ffrprt( FILE *stream, int status) +/* + Print out report of cfitsio error status and messages on the error stack. + Uses C FILE stream. +*/ +{ + char status_str[FLEN_STATUS], errmsg[FLEN_ERRMSG]; + + if (status) + { + + fits_get_errstatus(status, status_str); /* get the error description */ + fprintf(stream, "\nFITSIO status = %d: %s\n", status, status_str); + + while ( fits_read_errmsg(errmsg) ) /* get error stack messages */ + fprintf(stream, "%s\n", errmsg); + } + return; +} diff --git a/pkg/tbtables/cfitsio/cfitsio.doc b/pkg/tbtables/cfitsio/cfitsio.doc new file mode 100644 index 00000000..6ef31dfb --- /dev/null +++ b/pkg/tbtables/cfitsio/cfitsio.doc @@ -0,0 +1,8406 @@ + CFITSIO - An Interface to FITS Format Files for C Programmers + + William D Pence, HEASARC, NASA/GSFC + Version 2.4 + + +[Note: This file contains various formatting command symbols ('*', '-') +in the first column which are used when generating the LATeX version of +this document.] + +*I. Introduction + +**A. A Brief Overview + +CFITSIO is a machine-independent library of routines for reading and +writing data files in the FITS (Flexible Image Transport System) data +format. It can also read IRAF format image files and raw binary data +arrays by converting them on the fly into a virtual FITS format file. +This library is written in ANSI C and provides a powerful yet simple +interface for accessing FITS files which will run on most commonly used +computers and workstations. CFITSIO supports all the features +described in the official NOST definition of the FITS format and can +read and write all the currently defined types of extensions, including +ASCII tables (TABLE), Binary tables (BINTABLE) and IMAGE extensions. +The CFITSIO routines insulate the programmer from having to deal with +the complicated formatting details in the FITS file, however, it is +assumed that users have a general knowledge about the structure and +usage of FITS files. + +CFITSIO also contains a set of Fortran callable wrapper routines which +allow Fortran programs to call the CFITSIO routines. See the companion +``FITSIO User's Guide'' for the definition of the Fortran subroutine +calling sequences. These wrappers replace the older Fortran FITSIO +library which is no longer supported. + +The CFITSIO package was initially developed by the HEASARC (High Energy +Astrophysics Science Archive Research Center) at the NASA Goddard Space +Flight Center to convert various existing and newly acquired +astronomical data sets into FITS format and to further analyze data +already in FITS format. New features continue to be added to CFITSIO +in large part due to contributions of ideas or actual code from +users of the package. The Integral Science Data Center in Switzerland, +and the XMM/ESTEC project in The Netherlands made especially significant +contributions that resulted in many of the new features that appeared +in v2.0 of CFITSIO. + +**B. Sources of FITS Software and Information + +The latest version of the CFITSIO source code, +documentation, and example programs are available on the World-Wide +Web or via anonymous ftp from: +- + http://heasarc.gsfc.nasa.gov/fitsio + ftp://legacy.gsfc.nasa.gov/software/fitsio/c +- + +Any questions, bug reports, or suggested enhancements related to the CFITSIO +package should be sent to the primary author: +- + Dr. William Pence Telephone: (301) 286-4599 + HEASARC, Code 662 E-mail: pence@tetra.gsfc.nasa.gov + NASA/Goddard Space Flight Center + Greenbelt, MD 20771, USA +- +This User's Guide assumes that readers already have a general +understanding of the definition and structure of FITS format files. +Further information about FITS formats is available from the FITS Support +Office at {\tt http://fits.gsfc.nasa.gov}. In particular, the +'NOST FITS Standard' gives the authoritative definition of the FITS data +format, and the `FITS User's Guide' provides additional historical background +and practical advice on using FITS files. + +The HEASARC also provides a very sophisticated FITS file analysis +program called `Fv' which can be used to display and edit the contents +of any FITS file as well as construct new FITS files from scratch. The +display functions in Fv allow users to interactively adjust the +brightness and contrast of images, pan, zoom, and blink images, and +measure the positions and brightnesses of objects within images. FITS +tables can be displayed like a spread sheet, and then modified using +powerful calculator and sorting functions. Fv is freely available for +most Unix platforms, Mac PCs, and Windows PCs. +CFITSIO users may also be interested in the FTOOLS package of programs +that can be used to manipulate and analyze FITS format files. +Fv and FTOOLS are available from their respective Web sites at: +- + http://fv.gsfc.nasa.gov + http://heasarc.gsfc.nasa.gov/ftools +- + +**C. Acknowledgements + +The development of the powerful features in CFITSIO was made +possible through collaborations with many people or organizations from +around the world. The following in particular have made especially +significant contributions: + +Programmers from the Integral Science Data Center, Switzerland (namely, +Jurek Borkowski, Bruce O'Neel, and Don Jennings), designed the concept +for the plug-in I/O drivers that was introduced with CFITSIO 2.0. The +use of `drivers' greatly simplified the low-level I/O, which in turn +made other new features in CFITSIO (e.g., support for compressed FITS +files and support for IRAF format image files) much easier to +implement. Jurek Borkowski wrote the Shared Memory driver, and Bruce +O'Neel wrote the drivers for accessing FITS files over the network +using the FTP, HTTP, and ROOT protocols. + +The ISDC also provided the template parsing routines (written by Jurek +Borkowski) and the hierarchical grouping routines (written by Don +Jennings). The ISDC DAL (Data Access Layer) routines are layered on +top of CFITSIO and make extensive use of these features. + +Uwe Lammers (XMM/ESA/ESTEC, The Netherlands) designed the +high-performance lexical parsing algorithm that is used to do +on-the-fly filtering of FITS tables. This algorithm essentially +pre-compiles the user-supplied selection expression into a form that +can be rapidly evaluated for each row. Peter Wilson (RSTX, NASA/GSFC) +then wrote the parsing routines used by CFITSIO based on Lammers' +design, combined with other techniques such as the CFITSIO iterator +routine to further enhance the data processing throughput. This effort +also benefited from a much earlier lexical parsing routine that was +developed by Kent Blackburn (NASA/GSFC). More recently, Craig Markwardt +(NASA/GSFC) implemented additional functions (median, average, stddev) +and other enhancements to the lexical parser. + +The CFITSIO iterator function is loosely based on similar ideas +developed for the XMM Data Access Layer. + +Peter Wilson (RSTX, NASA/GSFC) wrote the complete set of +Fortran-callable wrappers for all the CFITSIO routines, which in turn +rely on the CFORTRAN macro developed by Burkhard Burow. + +The syntax used by CFITSIO for filtering or binning input FITS files is +based on ideas developed for the AXAF Science Center Data Model by +Jonathan McDowell, Antonella Fruscione, Aneta Siemiginowska and Bill +Joye. See http://heasarc.gsfc.nasa.gov/docs/journal/axaf7.html for +further description of the AXAF Data Model. + +The file decompression code were taken directly from the gzip (GNU zip) +program developed by Jean-loup Gailly and others. + +The new compressed image data format (where the image is tiled and +the compressed byte stream from each tile is stored in a binary table) +was implemented in collaboration with Richard White (STScI), Perry +Greenfield (STScI) and Doug Tody (NOAO). + +Doug Mink (SAO) provided the routines for converting IRAF format +images into FITS format. + +In addition, many other people have made valuable contributions to the +development of CFITSIO. These include (with apologies to others that may +have inadvertently been omitted): + +Steve Allen, Carl Akerlof, Keith Arnaud, Morten Krabbe Barfoed, Kent +Blackburn, G Bodammer, Romke Bontekoe, Lucio Chiappetti, Keith Costorf, +Robin Corbet, John Davis, Richard Fink, Ning Gan, Emily Greene, Gretchen +Green, Joe Harrington, Cheng Ho, Phil Hodge, Jim Ingham, Yoshitaka +Ishisaki, Diab Jerius, Mark Levine, Todd Karakaskian, Edward King, +Scott Koch, Claire Larkin, Rob Managan, Eric Mandel, Richard Mathar, +John Mattox, Carsten Meyer, Emi Miyata, Stefan Mochnacki, Mike Noble, +Oliver Oberdorf, Clive Page, Arvind Parmar, Jeff Pedelty, Tim Pearson, +Philippe Prugniel, Maren Purves, Scott Randall, Chris Rogers, Arnold Rots, +Barry Schlesinger, Robin Stebbins, Andrew Szymkowiak, Allyn Tennant, +Peter Teuben, James Theiler, Doug Tody, Shiro Ueno, Steve Walton, Archie +Warnock, Alan Watson, Dan Whipple, Wim Wimmers, Peter Young, Jianjun Xu, +and Nelson Zarate. + +**D. Legal Stuff + +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. +(However, see the restriction on the use of the gzip compression code, +below). + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER." + +The file compress.c contains (slightly modified) source code that +originally came from gzip-1.2.4, copyright (C) 1992-1993 by Jean-loup +Gailly. This gzip code is distributed under the GNU General Public +License and thus requires that any software that uses the CFITSIO +library (which in turn uses the gzip code) must conform to the +provisions in the GNU General Public License. A copy of the GNU +license is included at the beginning of compress.c file. + +An alternate version of the compress.c file (called +compress\_alternate.c) is provided for users who want to use the CFITSIO +library but are unwilling or unable to publicly release their software +under the terms of the GNU General Public License. This alternate +version contains non-functional stubs for the file compression and +uncompression routines used by CFITSIO. Replace the file `compress.c' +with `compress\_alternate.c' before compiling the CFITSIO library. This +will produce a version of CFITSIO which does not support reading or +writing compressed FITS files but is otherwise identical to the +standard version. + +*II. Creating the CFITSIO Library + +**A. Building the Library + +The CFITSIO code is contained in about 40 C source files (*.c) and header +files (*.h). On VAX/VMS systems 2 assembly-code files (vmsieeed.mar and +vmsieeer.mar) are also needed. + +CFITSIO has currently been tested on the following platforms: +- + OPERATING SYSTEM COMPILER + Sun OS gcc and cc (3.0.1) + Sun Solaris gcc and cc + Silicon Graphics IRIX gcc and cc + Silicon Graphics IRIX64 MIPS + Dec Alpha OSF/1 gcc and cc + DECstation Ultrix gcc + Dec Alpha OpenVMS cc + DEC VAX/VMS gcc and cc + HP-UX gcc + IBM AIX gcc + Linux gcc + MkLinux DR3 + Windows 95/98/NT Borland C++ V4.5 + Windows 95/98/NT/ME/XP Microsoft/Compaq Visual C++ v5.0, v6.0 + Windows 95/98/NT Cygwin gcc + MacOS 7.1 or greater Metrowerks 10.+ + MacOS-X 10.1 or greater cc (gcc) +- +CFITSIO will probably run on most other Unix platforms. Cray +supercomputers are currently not supported. + +***1. Unix Systems + +The CFITSIO library is built on Unix systems by typing: +- + > ./configure [--prefix=/target/installation/path] + > make (or 'make shared') + > make install (this step is optional) +- +at the operating system prompt. The configure command customizes the +Makefile for the particular system, then the `make' command compiles the +source files and builds the library. Type `./configure' and not simply +`configure' to ensure that the configure script in the current directory +is run and not some other system-wide configure script. The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, +- + > ./configure --prefix=/usr1/local +- +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include files to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +The 'make shared' option builds a shared or dynamic version of the +CFITSIO library. When using the shared library the executable code is +not copied into your program at link time and instead the program +locates the necessary library code at run time, normally through +LD\_LIBRARY\_PATH or some other method. The advantages of using a shared +library are: +- + 1. Less disk space if you build more than 1 program + 2. Less memory if more than one copy of a program using the shared + library is running at the same time since the system is smart + enough to share copies of the shared library at run time. + 3. Possibly easier maintenance since a new version of the shared + library can be installed without relinking all the software + that uses it (as long as the subroutine names and calling + sequences remain unchanged). + 4. No run-time penalty. +- +The disadvantages are: +- + 1. More hassle at runtime. You have to either build the programs + specially or have LD_LIBRARY_PATH set right. + 2. There may be a slight start up penalty, depending on where you are + reading the shared library and the program from and if your CPU is + either really slow or really heavily loaded. +- + +On Mac OS X platforms the 'make shared' command works like on other +UNIX platforms, but a .dylib file will be created instead of .so. If +installed in a nonstandard location, add its location to the +DYLD\_LIBRARY\_PATH environment variable so that the library can be found +at run time. + +On HP/UX systems, the environment variable CFLAGS should be set +to -Ae before running configure to enable "extended ANSI" features. + +By default, a set of Fortran-callable wrapper routines are +also built and included in the CFITSIO library. If these wrapper +routines are not needed (i.e., the CFITSIO library will not +be linked to any Fortran applications which call FITSIO subroutines) +then they may be omitted from the build by typing 'make all-nofitsio' +instead of simply typing 'make'. This will reduce the size +of the CFITSIO library slightly. + +Most 32-bit operating systems have only supported disk files up to 2.1GB +(2**31 bytes) in size. Starting with version 2.1 of CFITSIO, FITS files +larger than this limit (up to 6 terabytes) can be read and written on +platforms that support large files (e.g., at least some LINUX platforms +and Solaris). To enable this +feature, CFITSIO must be compiled with the '-D\_LARGEFILE\_SOURCE' and +`-D\_FILE\_OFFSET\_BITS=64' +compiler flags. Some platforms may also require the `-D\_LARGE\_FILES' +compiler flag. It appears that in most cases it is not necessary to +also include these compiler flags when compiling programs that link to +the CFITSIO library. See the `CFITSIO Size Limitations' +section in Chapter 4 for further details. + +It may not be possible to staticly link programs that use CFITSIO on +some platforms (namely, on Solaris 2.6) due to the network drivers +(which provide FTP and HTTP access to FITS files). It is possible to +make both a dynamic and a static version of the CFITSIO library, but +network file access will not be possible using the static version. + +***2. VMS + +On VAX/VMS and ALPHA/VMS systems the make\_gfloat.com command file may +be executed to build the cfitsio.olb object library using the default +G-floating point option for double variables. The make\_dfloat.com and +make\_ieee.com files may be used instead to build the library with the +other floating point options. Note that the getcwd function that is +used in the group.c module may require that programs using CFITSIO be +linked with the ALPHA\$LIBRARY:VAXCRTL.OLB library. See the example +link line in the next section of this document. + +***3. Windows PCs + +A precompiled DLL version of CFITSIO is available for IBM-PC users of +the Borland or Microsoft Visual C++ compilers in the files +cfitsiodll\_2xxx\_borland.zip and cfitsiodll\_2xxx\_vcc.zip, where +'2xxx' represents the current release number. These zip archives also +contains other files and instructions on how to use the CFITSIO DLL +library. + +The CFITSIO library may also be built from the source code using the +makefile.bc or makefile.vcc files. Finally, the makepc.bat file gives +an example of building CFITSIO with the Borland C++ v4.5 compiler +using older DOS commands. + +***4. Macintosh PCs + +When building on Mac OS-X, users should follow the Unix instructions, +above. + +The classic MacOS version (OS 9 or earlier) of the CFITSIO library can +be built by (1) un binhex and unstuff cfitsio\_mac.sit.hqx, (2) put +CFitsioPPC.mcp in the cfitsio directory, and (3) load CFitsioPPC.mcp +into CodeWarrior Pro 5 and make. This builds the CFITSIO library for +PPC. There are also targets for both the test program and the speed +test program. + +To use the MacOS port you can add Cfitsio PPC.lib to your CodeWarrior +Pro 5 project. Note that this only has been tested for the PPC and +probably won't work on 68k Macs. + + +**B. Testing the Library + +The CFITSIO library should be tested by building and running +the testprog.c program that is included with the release. +On Unix systems, type: +- + % make testprog + % testprog > testprog.lis + % diff testprog.lis testprog.out + % cmp testprog.fit testprog.std +- + On VMS systems, +(assuming cc is the name of the C compiler command), type: +- + $ cc testprog.c + $ link testprog, cfitsio/lib, alpha$library:vaxcrtl/lib + $ run testprog +- +The test program should produce a FITS file called `testprog.fit' +that is identical to the `testprog.std' FITS file included with this +release. The diagnostic messages (which were piped to the file +testprog.lis in the Unix example) should be identical to the listing +contained in the file testprog.out. The 'diff' and 'cmp' commands +shown above should not report any differences in the files. (There +may be some minor format differences, such as the presence or +absence of leading zeros, or 3 digit exponents in numbers, +which can be ignored). + +The Fortran wrappers in CFITSIO may be tested with the testf77 +program on Unix systems with: +- + % f77 -o testf77 testf77.f -L. -lcfitsio -lnsl -lsocket + or + % f77 -f -o testf77 testf77.f -L. -lcfitsio (under SUN O/S) + or + % f77 -o testf77 testf77.f -Wl,-L. -lcfitsio -lm -lnsl -lsocket (HP/UX) + + % testf77 > testf77.lis + % diff testf77.lis testf77.out + % cmp testf77.fit testf77.std +- +On machines running SUN O/S, Fortran programs must be compiled with the +'-f' option to force double precision variables to be aligned on 8-byte +boundarys to make the fortran-declared variables compatible with C. A +similar compiler option may be required on other platforms. Failing to +use this option may cause the program to crash on FITSIO routines that +read or write double precision variables. + +Also note that on some systems, the output listing of the testf77 +program may differ slightly from the testf77.std template, if leading +zeros are not printed by default before the decimal point when using F +format. + +A few other utility programs are included with CFITSIO; the first four +of this programs can be compiled an linked by typing `make +program\_name' where `program\_name' is the actual name of the program: +- + speed - measures the maximum throughput (in MB per second) + for writing and reading FITS files with CFITSIO. + + listhead - lists all the header keywords in any FITS file + + fitscopy - copies any FITS file (especially useful in conjunction + with the CFITSIO's extended input filename syntax). + + cookbook - a sample program that performs common read and + write operations on a FITS file. + + iter_a, iter_b, iter_c - examples of the CFITSIO iterator routine +- + +**C. Linking Programs with CFITSIO + +When linking applications software with the CFITSIO library, several +system libraries usually need to be specified on the link command +line. On Unix systems, the most reliable way to determine what +libraries are required is to type 'make testprog' and see what +libraries the configure script has added. The typical libraries that +need to be added are -lm (the math library) and -lnsl and -lsocket +(needed only for FTP and HTTP file access). These latter 2 libraries +are not needed on VMS and Windows platforms, because FTP file access is +not currently supported on those platforms. + +Note that when upgrading to a newer version of CFITSIO it is usually +necessary to recompile, as well as relink, the programs that use CFITSIO, +because the definitions in fitsio.h often change. + +**D. Getting Started with CFITSIO + +In order to effectively use the CFITSIO library it is recommended that +new users begin by reading the ``CFITSIO Quick Start Guide''. It +contains all the basic information needed to write programs that +perform most types of operations on FITS files. The set of example +FITS utility programs that are available from the CFITSIO web site are +also very useful for learning how to use CFITSIO. To learn even more +about the capabilities of the CFITSIO library the following steps are +recommended: + +1. Read the following short `FITS Primer' chapter for an overview of +the structure of FITS files. + +2. Review the Programming Guidelines in Chapter 4 to become familiar +with the conventions used by the CFITSIO interface. + +3. Refer to the cookbook.c, listhead.c, and fitscopy.c programs that +are included with this release for examples of routines that perform +various common FITS file operations. Type 'make program\_name' to +compile and link these programs on Unix systems. + +4. Write a simple program to read or write a FITS file using the Basic +Interface routines described in Chapter 5. + +5. Scan through the more specialized routines that are described in +the following chapters to become familiar with the functionality that +they provide. + +**E. Example Program + +The following listing shows an example of how to use the CFITSIO +routines in a C program. Refer to the cookbook.c program that is +included with the CFITSIO distribution for other example routines. + +This program creates a new FITS file, containing a FITS image. An +`EXPOSURE' keyword is written to the header, then the image data are +written to the FITS file before closing the FITS file. +- +#include "fitsio.h" /* required by every program that uses CFITSIO */ +main() +{ + fitsfile *fptr; /* pointer to the FITS file; defined in fitsio.h */ + int status, ii, jj; + long fpixel = 1, naxis = 2, nelements, exposure; + long naxes[2] = { 300, 200 }; /* image is 300 pixels wide by 200 rows */ + short array[200][300]; + + status = 0; /* initialize status before calling fitsio routines */ + fits_create_file(&fptr, "testfile.fits", &status); /* create new file */ + + /* Create the primary array image (16-bit short integer pixels */ + fits_create_img(fptr, SHORT_IMG, naxis, naxes, &status); + + /* Write a keyword; must pass the ADDRESS of the value */ + exposure = 1500.; + fits_update_key(fptr, TLONG, "EXPOSURE", &exposure, + "Total Exposure Time", &status); + + /* Initialize the values in the image with a linear ramp function */ + for (jj = 0; jj < naxes[1]; jj++) + for (ii = 0; ii < naxes[0]; ii++) + array[jj][ii] = ii + jj; + + nelements = naxes[0] * naxes[1]; /* number of pixels to write */ + + /* Write the array of integers to the image */ + fits_write_img(fptr, TSHORT, fpixel, nelements, array[0], &status); + + fits_close_file(fptr, &status); /* close the file */ + + fits_report_error(stderr, status); /* print out any error messages */ + return( status ); +} +- + +*III. A FITS Primer + +This section gives a brief overview of the structure of FITS files. +Users should refer to the documentation available from the NOST, as +described in the introduction, for more detailed information on FITS +formats. + +FITS was first developed in the late 1970's as a standard data +interchange format between various astronomical observatories. Since +then FITS has become the standard data format supported by most +astronomical data analysis software packages. + +A FITS file consists of one or more Header + Data Units (HDUs), where +the first HDU is called the `Primary HDU', or `Primary Array'. The +primary array contains an N-dimensional array of pixels, such as a 1-D +spectrum, a 2-D image, or a 3-D data cube. Five different primary +data types are supported: Unsigned 8-bit bytes, 16 and 32-bit signed +integers, and 32 and 64-bit floating point reals. FITS also has a +convention for storing 16 and 32-bit unsigned integers (see the later +section entitled `Unsigned Integers' for more details). The primary HDU +may also consist of only a header with a null array containing no +data pixels. + +Any number of additional HDUs may follow the primary array; these +additional HDUs are called FITS `extensions'. There are currently 3 +types of extensions defined by the FITS standard: + +\begin{itemize} +\item + Image Extension - a N-dimensional array of pixels, like in a primary array +\item + ASCII Table Extension - rows and columns of data in ASCII character format +\item + Binary Table Extension - rows and columns of data in binary representation +\end{itemize} + +In each case the HDU consists of an ASCII Header Unit followed by an optional +Data Unit. For historical reasons, each Header or Data unit must be an +exact multiple of 2880 8-bit bytes long. Any unused space is padded +with fill characters (ASCII blanks or zeros). + +Each Header Unit consists of any number of 80-character keyword records +or `card images' which have the +general form: +- + KEYNAME = value / comment string + NULLKEY = / comment: This keyword has no value +- +The keyword names may be up to 8 characters long and can only contain +uppercase letters, the digits 0-9, the hyphen, and the underscore +character. The keyword name is (usually) followed by an equals sign and +a space character (= ) in columns 9 - 10 of the record, followed by the +value of the keyword which may be either an integer, a floating point +number, a character string (enclosed in single quotes), or a boolean +value (the letter T or F). A keyword may also have a null or undefined +value if there is no specified value string, as in the second example, above + +The last keyword in the header is always the `END' keyword which has no +value or comment fields. There are many rules governing the exact +format of a keyword record (see the NOST FITS Standard) so it is better +to rely on standard interface software like CFITSIO to correctly +construct or to parse the keyword records rather than try to deal +directly with the raw FITS formats. + +Each Header Unit begins with a series of required keywords which depend +on the type of HDU. These required keywords specify the size and +format of the following Data Unit. The header may contain other +optional keywords to describe other aspects of the data, such as the +units or scaling values. Other COMMENT or HISTORY keywords are also +frequently added to further document the data file. + +The optional Data Unit immediately follows the last 2880-byte block in +the Header Unit. Some HDUs do not have a Data Unit and only consist of +the Header Unit. + +If there is more than one HDU in the FITS file, then the Header Unit of +the next HDU immediately follows the last 2880-byte block of the +previous Data Unit (or Header Unit if there is no Data Unit). + +The main required keywords in FITS primary arrays or image extensions are: +\begin{itemize} +\item +BITPIX -- defines the data type of the array: 8, 16, 32, -32, -64 for +unsigned 8--bit byte, 16--bit signed integer, 32--bit signed integer, +32--bit IEEE floating point, and 64--bit IEEE double precision floating +point, respectively. +\item +NAXIS -- the number of dimensions in the array, usually 0, 1, 2, 3, or 4. +\item +NAXISn -- (n ranges from 1 to NAXIS) defines the size of each dimension. +\end{itemize} + +FITS tables start with the keyword XTENSION = `TABLE' (for ASCII +tables) or XTENSION = `BINTABLE' (for binary tables) and have the +following main keywords: +\begin{itemize} +\item +TFIELDS -- number of fields or columns in the table +\item +NAXIS2 -- number of rows in the table +\item +TTYPEn -- for each column (n ranges from 1 to TFIELDS) gives the +name of the column +\item +TFORMn -- the data type of the column +\item +TUNITn -- the physical units of the column (optional) +\end{itemize} + +Users should refer to the FITS Support Office at {\tt http://fits.gsfc.nasa.gov} +for futher information about the FITS format and related software +packages. + + +*IV. Programming Guidelines + +**A. CFITSIO Definitions + +Any program that uses the CFITSIO interface must include the fitsio.h +header file with the statement +- + #include "fitsio.h" +- +This header file contains the prototypes for all the CFITSIO user +interface routines as well as the definitions of various constants used +in the interface. It also defines a C structure of type `fitsfile' +that is used by CFITSIO to store the relevant parameters that define +the format of a particular FITS file. Application programs must define +a pointer to this structure for each FITS file that is to be opened. +This structure is initialized (i.e., memory is allocated for the +structure) when the FITS file is first opened or created with the +fits\_open\_file or fits\_create\_file routines. This fitsfile pointer +is then passed as the first argument to every other CFITSIO routine +that operates on the FITS file. Application programs must not directly +read or write elements in this fitsfile structure because the +definition of the structure may change in future versions of CFITSIO. + +A number of symbolic constants are also defined in fitsio.h for the +convenience of application programmers. Use of these symbolic +constants rather than the actual numeric value will help to make the +source code more readable and easier for others to understand. +- +String Lengths, for use when allocating character arrays: + + #define FLEN_FILENAME 1025 /* max length of a filename */ + #define FLEN_KEYWORD 72 /* max length of a keyword */ + #define FLEN_CARD 81 /* max length of a FITS header card */ + #define FLEN_VALUE 71 /* max length of a keyword value string */ + #define FLEN_COMMENT 73 /* max length of a keyword comment string */ + #define FLEN_ERRMSG 81 /* max length of a CFITSIO error message */ + #define FLEN_STATUS 31 /* max length of a CFITSIO status text string */ + + Note that FLEN_KEYWORD is longer than the nominal 8-character keyword + name length because the HIERARCH convention supports longer keyword names. + +Access modes when opening a FITS file: + + #define READONLY 0 + #define READWRITE 1 + +BITPIX data type code values for FITS images: + + #define BYTE_IMG 8 /* 8-bit unsigned integers */ + #define SHORT_IMG 16 /* 16-bit signed integers */ + #define LONG_IMG 32 /* 32-bit signed integers */ + #define FLOAT_IMG -32 /* 32-bit single precision floating point */ + #define DOUBLE_IMG -64 /* 64-bit double precision floating point */ + + The following 4 data type codes are also supported by CFITSIO: + #define LONGLONG_IMG 64 /* 64-bit long signed integers */ + #define SBYTE_IMG 10 /* 8-bit signed integers, equivalent to */ + /* BITPIX = 8, BSCALE = 1, BZERO = -128 */ + #define USHORT_IMG 20 /* 16-bit unsigned integers, equivalent to */ + /* BITPIX = 16, BSCALE = 1, BZERO = 32768 */ + #define ULONG_IMG 40 /* 32-bit unsigned integers, equivalent to */ + /* BITPIX = 32, BSCALE = 1, BZERO = 2147483648 */ + +Codes for the data type of binary table columns and/or for the +data type of variables when reading or writing keywords or data: + + DATATYPE TFORM CODE + #define TBIT 1 /* 'X' */ + #define TBYTE 11 /* 8-bit unsigned byte, 'B' */ + #define TLOGICAL 14 /* logicals (int for keywords */ + /* and char for table cols 'L' */ + #define TSTRING 16 /* ASCII string, 'A' */ + #define TSHORT 21 /* signed short, 'I' */ + #define TINT32BIT 41 /* signed 32-bit int, 'J' */ + #define TLONG 41 /* signed long, */ + #define TFLOAT 42 /* single precision float, 'E' */ + #define TDOUBLE 82 /* double precision float, 'D' */ + #define TCOMPLEX 83 /* complex (pair of floats) 'C' */ + #define TDBLCOMPLEX 163 /* double complex (2 doubles) 'M' */ + + The following data type codes are also supported by CFITSIO: + #define TINT 31 /* int */ + #define TSBYTE 12 /* 8-bit signed byte, 'S' */ + #define TUINT 30 /* unsigned int 'V' */ + #define TUSHORT 20 /* unsigned short 'U' */ + #define TULONG 40 /* unsigned long */ + #define TLONGLONG 81 /* 64-bit long signed integer 'K' */ + +HDU type code values (value returned when moving to new HDU): + + #define IMAGE_HDU 0 /* Primary Array or IMAGE HDU */ + #define ASCII_TBL 1 /* ASCII table HDU */ + #define BINARY_TBL 2 /* Binary table HDU */ + #define ANY_HDU -1 /* matches any type of HDU */ + +Column name and string matching case-sensitivity: + + #define CASESEN 1 /* do case-sensitive string match */ + #define CASEINSEN 0 /* do case-insensitive string match */ + +Logical states (if TRUE and FALSE are not already defined): + + #define TRUE 1 + #define FALSE 0 + +Values to represent undefined floating point numbers: + + #define FLOATNULLVALUE -9.11912E-36F + #define DOUBLENULLVALUE -9.1191291391491E-36 + +Image compression algorithm definitions + + #define RICE_1 11 + #define GZIP_1 21 + #define PLIO_1 31 +- + +**B. Current Header Data Unit (CHDU) + +The concept of the Current Header and Data Unit, or CHDU, is +fundamental to the use of the CFITSIO library. A simple FITS image may +only contain a single Header and Data unit (HDU), but in general FITS +files can contain multiple Header Data Units (also known as +`extensions'), concatenated one after the other in the file. The user +can specify which HDU should be initially opened at run time by giving +the HDU name or number after the root file name. For example, +'myfile.fits[4]' opens the 5th HDU in the file (note that the numbering +starts with 0), and 'myfile.fits[EVENTS] opens the HDU with the name +'EVENTS' (as defined by the EXTNAME or HDUNAME keywords). If no HDU is +specified then CFITSIO opens the first HDU (the primary array) by +default. The CFITSIO routines which read and write data only operate +within the opened HDU, Other CFITSIO routines are provided to move to +and open any other existing HDU within the FITS file or to append or +insert new HDUs in the FITS file. + +**C. Function Names and Variable Datatypes + +Most of the CFITSIO routines have both a short name as well as a +longer descriptive name. The short name is only 5 or 6 characters long +and is similar to the subroutine name in the Fortran-77 version of +FITSIO. The longer name is more descriptive and it is recommended that +it be used instead of the short name to more clearly document the +source code. + +Many of the CFITSIO routines come in families which differ only in the +data type of the associated parameter(s). The data type of these +routines is indicated by the suffix of the routine name. The short +routine names have a 1 or 2 character suffix (e.g., 'j' in 'ffpkyj') +while the long routine names have a 4 character or longer suffix +as shown in the following table: +- + Long Short Data + Names Names Type + ----- ----- ---- + _bit x bit + _byt b unsigned byte + _sbyt sb signed byte + _sht i short integer + _lng j long integer + _lnglng jj 8-byte LONGLONG integer (see note below) + _usht ui unsigned short integer + _ulng uj unsigned long integer + _uint uk unsigned int integer + _int k int integer + _flt e real exponential floating point (float) + _fixflt f real fixed-decimal format floating point (float) + _dbl d double precision real floating-point (double) + _fixdbl g double precision fixed-format floating point (double) + _cmp c complex reals (pairs of float values) + _fixcmp fc complex reals, fixed-format floating point + _dblcmp m double precision complex (pairs of double values) + _fixdblcmp fm double precision complex, fixed-format floating point + _log l logical (int) + _str s character string +- + +The logical data type corresponds to `int' for logical keyword values, +and `byte' for logical binary table columns. In other words, the value +when writing a logical keyword must be stored in an `int' variable, and +must be stored in a `char' array when reading or writing to `L' columns +in a binary table. Inplicit data type conversion is not supported for +logical table columns, but is for keywords, so a logical keyword may be +read and cast to any numerical data type; a returned value = 0 +indicates false, and any other value = true. + +The `int' data type may be 2 bytes long on some IBM PC compatible +systems and is usually 4 bytes long on most other systems. Some 64-bit +machines, however, like the Dec Alpha/OSF, define the `short', `int', +and `long' integer data types to be 2, 4, and 8 bytes long, +respectively. The FITS standard only supports 2 and 4 byte integer +data types, so CFITSIO internally converts between 4 and 8 bytes when +reading or writing `long' integers on Alpha/OSF systems. + +The 8-byte 'LONGLONG' integer data type is supported on most platforms. +CFITSIO defines the LONGLONG data type to be equivalent to 'long long' +on most Unix platforms and on Mac OS-X. Since most Windows compilers don't +support the 'long long' data type, LONGLONG is defined instead to be +equivalent to '\_\_int64'. If the compiler does not support a 8-byte +integer data type then LONGLONG is defined to be equivalent to 'long'. +Note that the C format specifier to print out these long integer values +is "\%lld" on most unix machines, except on OSF platforms where "\%ld" +must be used. On Windows platform that have the \_\_int64 data type, +the format specifier is "\%INT64d". + +When dealing with the FITS byte data type it is important to remember +that the raw values (before any scaling by the BSCALE and BZERO, or +TSCALn and TZEROn keyword values) in byte arrays (BITPIX = 8) or byte +columns (TFORMn = 'B') are interpreted as unsigned bytes with values +ranging from 0 to 255. Some C compilers define a 'char' variable as +signed, so it is important to explicitly declare a numeric char +variable as 'unsigned char' to avoid any ambiguity + +One feature of the CFITSIO routines is that they can operate on a `X' +(bit) column in a binary table as though it were a `B' (byte) column. +For example a `11X' data type column can be interpreted the same as a +`2B' column (i.e., 2 unsigned 8-bit bytes). In some instances, it can +be more efficient to read and write whole bytes at a time, rather than +reading or writing each individual bit. + +The complex and double precision complex data types are not directly +supported in ANSI C so these data types should be interpreted as pairs +of float or double values, respectively, where the first value in each +pair is the real part, and the second is the imaginary part. + +**D. Support for Unsigned Integers and Signed Bytes + +Although FITS does not directly support unsigned integers as one of its +fundamental data types, FITS can still be used to efficiently store +unsigned integer data values in images and binary tables. The +convention used in FITS files is to store the unsigned integers as +signed integers with an associated offset (specified by the BZERO or +TZEROn keyword). For example, to store unsigned 16-bit integer values +in a FITS image the image would be defined as a signed 16-bit integer +(with BITPIX keyword = SHORT\_IMG = 16) with the keywords BSCALE = 1.0 +and BZERO = 32768. Thus the unsigned values of 0, 32768, and 65535, +for example, are physically stored in the FITS image as -32768, 0, and +32767, respectively; CFITSIO automatically adds the BZERO offset to +these values when they are read. Similarly, in the case of unsigned +32-bit integers the BITPIX keyword would be equal to LONG\_IMG = 32 and +BZERO would be equal to 2147483648 (i.e. 2 raised to the 31st power). + +The CFITSIO interface routines will efficiently and transparently apply +the appropriate offset in these cases so in general application +programs do not need to be concerned with how the unsigned values are +actually stored in the FITS file. As a convenience for users, CFITSIO +has several predefined constants for the value of BITPIX (USHORT\_IMG, +ULONG\_IMG) and for the TFORMn value in the case of binary tables (`U' +and `V') which programmers can use when creating FITS files containing +unsigned integer values. The following code fragment illustrates how +to write a FITS 1-D primary array of unsigned 16-bit integers: +- + unsigned short uarray[100]; + int naxis, status; + long naxes[10], group, firstelem, nelements; + ... + status = 0; + naxis = 1; + naxes[0] = 100; + fits_create_img(fptr, USHORT_IMG, naxis, naxes, &status); + + firstelem = 1; + nelements = 100; + fits_write_img(fptr, TUSHORT, firstelem, nelements, + uarray, &status); + ... +- +In the above example, the 2nd parameter in fits\_create\_img tells +CFITSIO to write the header keywords appropriate for an array of 16-bit +unsigned integers (i.e., BITPIX = 16 and BZERO = 32768). Then the +fits\_write\_img routine writes the array of unsigned short integers +(uarray) into the primary array of the FITS file. Similarly, a 32-bit +unsigned integer image may be created by setting the second parameter +in fits\_create\_img equal to `ULONG\_IMG' and by calling the +fits\_write\_img routine with the second parameter = TULONG to write +the array of unsigned long image pixel values. + +An analogous set of routines are available for reading or writing unsigned +integer values and signed byte values in a FITS binary table extension. +When specifying the TFORMn keyword value which defines the format of a +column, CFITSIO recognized 3 additional data type codes besides those +already defined in the FITS standard: `U' meaning a 16-bit unsigned +integer column, `V' for a 32-bit unsigned integer column, and 'S' +for a signed byte column. These non-standard data type codes are not +actually written into the FITS file but instead are just used internally +within CFITSIO. The following code fragment illustrates how to use +these features: +- + unsigned short uarray[100]; + unsigned int varray[100]; + + int colnum, tfields, status; + long nrows, firstrow, firstelem, nelements, pcount; + + char extname[] = "Test_table"; /* extension name */ + + /* define the name, data type, and physical units for the 2 columns */ + char *ttype[] = { "Col_1", "Col_2", "Col_3" }; + char *tform[] = { "1U", "1V", "1S"}; /* special CFITSIO codes */ + char *tunit[] = { " ", " ", " " }; + ... + + /* write the header keywords */ + status = 0; + nrows = 1; + tfields = 3 + pcount = 0; + fits_create_tbl(fptr, BINARY_TBL, nrows, tfields, ttype, tform, + tunit, extname, &status); + + /* write the unsigned shorts to the 1st column */ + colnum = 1; + firstrow = 1; + firstelem = 1; + nelements = 100; + fits_write_col(fptr, TUSHORT, colnum, firstrow, firstelem, + nelements, uarray, &status); + + /* now write the unsigned longs to the 2nd column */ + colnum = 2; + fits_write_col(fptr, TUINT, colnum, firstrow, firstelem, + nelements, varray, &status); + ... +- +Note that the non-standard TFORM values for the 3 columns, `U' and `V', +tell CFITSIO to write the keywords appropriate for unsigned 16-bit and +unsigned 32-bit integers, respectively (i.e., TFORMn = '1I' and TZEROn += 32678 for unsigned 16-bit integers, and TFORMn = '1J' and TZEROn = +2147483648 for unsigned 32-bit integers). The 'S' TFORMn value tells +CFITSIO to write the keywords appropriate for a signed 8-bit byte column +with TFORMn = '1B' and TZEROn = -128. The calls to fits\_write\_col +then write the arrays of unsigned integer values to the columns. + +**E. Dealing with Character Strings + +The character string values in a FITS header or in an ASCII column in a +FITS table extension are generally padded out with non-significant +space characters (ASCII 32) to fill up the header record or the column +width. When reading a FITS string value, the CFITSIO routines will +strip off these non-significant trailing spaces and will return a +null-terminated string value containing only the significant +characters. Leading spaces in a FITS string are considered +significant. If the string contains all blanks, then CFITSIO will +return a single blank character, i.e, the first blank is considered to +be significant, since it distinguishes the string from a null or +undefined string, but the remaining trailing spaces are not +significant. + +Similarly, when writing string values to a FITS file the +CFITSIO routines expect to get a null-terminated string as input; +CFITSIO will pad the string with blanks if necessary when writing it +to the FITS file. + +When calling CFITSIO routines that return a character string it is +vital that the size of the char array be large enough to hold the +entire string of characters, otherwise CFITSIO will overwrite whatever +memory locations follow the char array, possibly causing the program to +execute incorrectly. This type of error can be difficult to debug, so +programmers should always ensure that the char arrays are allocated +enough space to hold the longest possible string, {\bf including} the +terminating NULL character. The fitsio.h file contains the following +defined constants which programmers are strongly encouraged to use +whenever they are allocating space for char arrays: +- +#define FLEN_FILENAME 1025 /* max length of a filename */ +#define FLEN_KEYWORD 72 /* max length of a keyword */ +#define FLEN_CARD 81 /* length of a FITS header card */ +#define FLEN_VALUE 71 /* max length of a keyword value string */ +#define FLEN_COMMENT 73 /* max length of a keyword comment string */ +#define FLEN_ERRMSG 81 /* max length of a CFITSIO error message */ +#define FLEN_STATUS 31 /* max length of a CFITSIO status text string */ +- +For example, when declaring a char array to hold the value string +of FITS keyword, use the following statement: +- + char value[FLEN_VALUE]; +- +Note that FLEN\_KEYWORD is longer than needed for the nominal 8-character +keyword name because the HIERARCH convention supports longer keyword names. + +**F. Implicit Data Type Conversion + +The CFITSIO routines that read and write numerical data can perform +implicit data type conversion. This means that the data type of the +variable or array in the program does not need to be the same as the +data type of the value in the FITS file. Data type conversion is +supported for numerical and string data types (if the string contains a +valid number enclosed in quotes) when reading a FITS header keyword +value and for numeric values when reading or writing values in the +primary array or a table column. CFITSIO returns status = +NUM\_OVERFLOW if the converted data value exceeds the range of the +output data type. Implicit data type conversion is not supported +within binary tables for string, logical, complex, or double complex +data types. + +In addition, any table column may be read as if it contained string values. +In the case of numeric columns the returned string will be formatted +using the TDISPn display format if it exists. + +**G. Data Scaling + +When reading numerical data values in the primary array or a +table column, the values will be scaled automatically by the BSCALE and +BZERO (or TSCALn and TZEROn) header values if they are +present in the header. The scaled data that is returned to the reading +program will have +- + output value = (FITS value) * BSCALE + BZERO +- +(a corresponding formula using TSCALn and TZEROn is used when reading +from table columns). In the case of integer output values the floating +point scaled value is truncated to an integer (not rounded to the +nearest integer). The fits\_set\_bscale and fits\_set\_tscale routines +(described in the `Advanced' chapter) may be used to override the +scaling parameters defined in the header (e.g., to turn off the scaling +so that the program can read the raw unscaled values from the FITS +file). + +When writing numerical data to the primary array or to a table column +the data values will generally be automatically inversely scaled by the +value of the BSCALE and BZERO (or TSCALn and TZEROn) keyword values if +they they exist in the header. These keywords must have been written +to the header before any data is written for them to have any immediate +effect. One may also use the fits\_set\_bscale and fits\_set\_tscale +routines to define or override the scaling keywords in the header +(e.g., to turn off the scaling so that the program can write the raw +unscaled values into the FITS file). If scaling is performed, the +inverse scaled output value that is written into the FITS file will +have +- + FITS value = ((input value) - BZERO) / BSCALE +- +(a corresponding formula using TSCALn and TZEROn is used when +writing to table columns). Rounding to the nearest integer, rather +than truncation, is performed when writing integer data types to the +FITS file. + +**H. Support for IEEE Special Values + +The ANSI/IEEE-754 floating-point number standard defines certain +special values that are used to represent such quantities as +Not-a-Number (NaN), denormalized, underflow, overflow, and infinity. +(See the Appendix in the NOST FITS standard or the NOST FITS User's +Guide for a list of these values). The CFITSIO routines that read +floating point data in FITS files recognize these IEEE special values +and by default interpret the overflow and infinity values as being +equivalent to a NaN, and convert the underflow and denormalized values +into zeros. In some cases programmers may want access to the raw IEEE +values, without any modification by CFITSIO. This can be done by +calling the fits\_read\_img or fits\_read\_col routines while +specifying 0.0 as the value of the NULLVAL parameter. This will force +CFITSIO to simply pass the IEEE values through to the application +program without any modification. This is not fully supported on +VAX/VMS machines, however, where there is no easy way to bypass the +default interpretation of the IEEE special values. + +**I. Error Status Values and the Error Message Stack + +Nearly all the CFITSIO routines return an error status value +in 2 ways: as the value of the last parameter in the function call, +and as the returned value of the function itself. This provides +some flexibility in the way programmers can test if an error +occurred, as illustrated in the following 2 code fragments: +- + if ( fits_write_record(fptr, card, &status) ) + printf(" Error occurred while writing keyword."); + +or, + + fits_write_record(fptr, card, &status); + if ( status ) + printf(" Error occurred while writing keyword."); +- +A listing of all the CFITSIO status code values is given at the end of +this document. Programmers are encouraged to use the symbolic +mnemonics (defined in fitsio.h) rather than the actual integer status +values to improve the readability of their code. + +The CFITSIO library uses an `inherited status' convention for the +status parameter which means that if a routine is called with a +positive input value of the status parameter as input, then the routine +will exit immediately without changing the value of the status +parameter. Thus, if one passes the status value returned from each +CFITSIO routine as input to the next CFITSIO routine, then whenever an +error is detected all further CFITSIO processing will cease. This +convention can simplify the error checking in application programs +because it is not necessary to check the value of the status parameter +after every single CFITSIO routine call. If a program contains a +sequence of several CFITSIO calls, one can just check the status value +after the last call. Since the returned status values are generally +distinctive, it should be possible to determine which routine +originally returned the error status. + +CFITSIO also maintains an internal stack of error messages +(80-character maximum length) which in many cases provide a more +detailed explanation of the cause of the error than is provided by the +error status number alone. It is recommended that the error message +stack be printed out whenever a program detects a CFITSIO error. The +function fits\_report\_error will print out the entire error message +stack, or alternatively one may call fits\_read\_errmsg to get the +error messages one at a time. + +**J. Variable-Length Arrays in Binary Tables + +CFITSIO provides easy-to-use support for reading and writing data in +variable length fields of a binary table. The variable length columns +have TFORMn keyword values of the form `1Pt(len)' where `t' is the +data type code (e.g., I, J, E, D, etc.) and `len' is an integer +specifying the maximum length of the vector in the table. If the value +of `len' is not specified when the table is created (e.g., if the TFORM +keyword value is simply specified as '1PE' instead of '1PE(400) ), then +CFITSIO will automatically scan the table when it is closed to +determine the maximum length of the vector and will append this value +to the TFORMn value. + +The same routines that read and write data in an ordinary fixed length +binary table extension are also used for variable length fields, +however, the routine parameters take on a slightly different +interpretation as described below. + +All the data in a variable length field is written into an area called +the `heap' which follows the main fixed-length FITS binary table. The +size of the heap, in bytes, is specified by the PCOUNT keyword in the +FITS header. When creating a new binary table, the initial value of +PCOUNT should usually be set to zero. CFITSIO will recompute the size +of the heap as the data is written and will automatically update the +PCOUNT keyword value when the table is closed. When writing variable +length data to a table, CFITSIO will automatically extend the size +of the heap area if necessary, so that any following HDUs do not +get overwritten. + +By default the heap data area starts immediately after the last row of +the fixed-length table. This default starting location may be +overridden by the THEAP keyword, but this is not recommended. +If additional rows of data are added to the table, CFITSIO will +automatically shift the the heap down to make room for the new +rows, but it is obviously be more efficient to initially +create the table with the necessary number of blank rows, so that +the heap does not needed to be constantly moved. + +When writing to a variable length field the entire array of values for +a given row of the table must be written with a single call to +fits\_write\_col. The total length of the array is given by nelements ++ firstelem - 1. Additional elements cannot be appended to an existing +vector at a later time since any attempt to do so will simply overwrite +all the previously written data. Note also that the new data will be +written to a new area of the heap and the heap space used by the +previous write cannot be reclaimed. For this reason each row of a +variable length field should only be written once. An exception to +this general rule occurs when setting elements of an array as +undefined. One must first write a dummy value into the array with +fits\_write\_col, and then call fits\_write\_col\_nul to flag the +desired elements as undefined. (Do not use the fits\_write\_colnull +routines with variable length fields). Note that the rows of a table, +whether fixed or variable length, do not have to be written +consecutively and may be written in any order. + +When writing to a variable length ASCII character field (e.g., TFORM = +'1PA') only a single character string can be written. The `firstelem' +and `nelements' parameter values in the fits\_write\_col routine are +ignored and the number of characters to write is simply determined by +the length of the input null-terminated character string. + +The fits\_write\_descript routine is useful in situations where +multiple rows of a variable length column have the identical array of +values. One can simply write the array once for the first row, and +then use fits\_write\_descript to write the same descriptor values into +the other rows; all the rows will then point to the same storage +location thus saving disk space. + +When reading from a variable length array field one can only read as +many elements as actually exist in that row of the table; reading does +not automatically continue with the next row of the table as occurs +when reading an ordinary fixed length table field. Attempts to read +more than this will cause an error status to be returned. One can +determine the number of elements in each row of a variable column with +the fits\_read\_descript routine. + +**K. Multiple Access to the Same FITS File + +CFITSIO supports simultaneous read and write access to multiple HDUs in +the same FITS file. Thus, one can open the same FITS file twice within +a single program and move to 2 different HDUs in the file, and then +read and write data or keywords to the 2 extensions just as if one were +accessing 2 completely separate FITS files. Since in general it is +not possible to physically open the same file twice and then expect to +be able to simultaneously (or in alternating succession) write to 2 +different locations in the file, CFITSIO recognizes when the file to be +opened (in the call to fits\_open\_file) has already been opened and +instead of actually opening the file again, just logically links the +new file to the old file. (This only applies if the file is opened +more than once within the same program, and does not prevent the same +file from being simultaneously opened by more than one program). Then +before CFITSIO reads or writes to either (logical) file, it makes sure +that any modifications made to the other file have been completely +flushed from the internal buffers to the file. Thus, in principle, one +could open a file twice, in one case pointing to the first extension +and in the other pointing to the 2nd extension and then write data to +both extensions, in any order, without danger of corrupting the file, +There may be some efficiency penalties in doing this however, since +CFITSIO has to flush all the internal buffers related to one file +before switching to the other, so it would still be prudent to +minimize the number of times one switches back and forth between doing +I/O to different HDUs in the same file. + +**L. When the Final Size of the FITS HDU is Unknown + +It is not required to know the total size of a FITS data array or table +before beginning to write the data to the FITS file. In the case of +the primary array or an image extension, one should initially create +the array with the size of the highest dimension (largest NAXISn +keyword) set to a dummy value, such as 1. Then after all the data have +been written and the true dimensions are known, then the NAXISn value +should be updated using the fits\_update\_key routine before moving to +another extension or closing the FITS file. + +When writing to FITS tables, CFITSIO automatically keeps track of the +highest row number that is written to, and will increase the size of +the table if necessary. CFITSIO will also automatically insert space +in the FITS file if necessary, to ensure that the data 'heap', if it +exists, and/or any additional HDUs that follow the table do not get +overwritten as new rows are written to the table. + +As a general rule it is best to specify the initial number of rows = 0 +when the table is created, then let CFITSIO keep track of the number of +rows that are actually written. The application program should not +manually update the number of rows in the table (as given by the NAXIS2 +keyword) since CFITSIO does this automatically. If a table is +initially created with more than zero rows, then this will usually be +considered as the minimum size of the table, even if fewer rows are +actually written to the table. Thus, if a table is initially created +with NAXIS2 = 20, and CFITSIO only writes 10 rows of data before +closing the table, then NAXIS2 will remain equal to 20. If however, 30 +rows of data are written to this table, then NAXIS2 will be increased +from 20 to 30. The one exception to this automatic updating of the +NAXIS2 keyword is if the application program directly modifies the +value of NAXIS2 (up or down) itself just before closing the table. In this +case, CFITSIO does not update NAXIS2 again, since it assumes that the +application program must have had a good reason for changing the value +directly. This is not recommended, however, and is only provided for +backward compatibility with software that initially creates a table +with a large number of rows, than decreases the NAXIS2 value to the +actual smaller value just before closing the table. + +**M. CFITSIO Size Limitations + +CFITSIO places very few restrictions on the size of FITS files that it +reads or writes. There are a few limits, however, that may affect +some extreme cases: + +1. The maximum number of FITS files that may be simultaneously opened +by CFITSIO is set by NMAXFILES as defined in fitsio2.h. It is currently +set = 300 by default. CFITSIO will allocate about 80 * NMAXFILES bytes +of memory for internal use. Note that the underlying C compiler or +operating system, may have a smaller limit on the number of opened files. +The C symbolic constant FOPEN\_MAX is intended to define the maximum +number of files that may open at once (including any other text or +binary files that may be open, not just FITS files). On some systems it +has been found that gcc supports a maximum of 255 opened files. + +Note that opening and operating on many FITS files simultaneously in +parallel may be less efficient than operating on smaller groups of files +in series. CFITSIO only has NIOBUF number of internal buffers (set = 40 +by default) that are used for temporary storage of the most recent data +records that have been read or written in the FITS files. If the number +of opened files is greater than NIOBUF, then CFITSIO may waste more time +flushing and re-reading or re-writing the same records in the FITS files. + +2. By default, CFITSIO can handle FITS files up to 2.1 GB in size (2**31 +bytes). This file size limit is often imposed by 32-bit operating +systems. More recently, as 64-bit operating systems become more common, an +industry-wide standard (at least on Unix systems) has been developed to +support larger sized files (see http://ftp.sas.com/standards/large.file/). +Starting with version 2.1 of CFITSIO, larger FITS files up to 6 terabytes +in size may be read and written on supported platforms. In order +to support these larger files, CFITSIO must be compiled with the +'-D\_LARGEFILE\_SOURCE' and `-D\_FILE\_OFFSET\_BITS=64' compiler flags. +Some platforms may also require the `-D\_LARGE\_FILES' compiler flag. + This causes the compiler to allocate 8-bytes instead of +4-bytes for the `off\_t' data type that is used to store file offset +positions. It appears that in most cases it is not necessary to +also include these compiler flags when compiling programs that link to +the CFITSIO library. + +If CFITSIO is compiled with the -D\_LARGEFILE\_SOURCE +and -D\_FILE\_OFFSET\_BITS=64 flags on a +platform that supports large files, then it can read and write FITS +files that contain up to 2**31 2880-byte FITS records, or approximately +6 terabytes in size. It is still required that the value of the NAXISn +and PCOUNT keywords in each extension be within the range of a signed +4-byte integer (max value = 2,147,483,648). Thus, each dimension of an +image (given by the NAXISn keywords), the total width of a table +(NAXIS1 keyword), the number of rows in a table (NAXIS2 keyword), and +the total size of the variable-length array heap in binary tables +(PCOUNT keyword) must be less than this limit. + +Currently, support for large files within CFITSIO has been tested +on the Linux, Solaris, and IBM AIX operating systems. + +*V. Basic CFITSIO Interface Routines + +This chapter describes the basic routines in the CFITSIO user interface +that provide all the functions normally needed to read and write most +FITS files. It is recommended that these routines be used for most +applications and that the more advanced routines described in the +next chapter only be used in special circumstances when necessary. + +The following conventions are used in this chapter in the description +of each function: + +1. Most functions have 2 names: a long descriptive name and a short +concise name. Both names are listed on the first line of the following +descriptions, separated by a slash (/) character. Programmers may use +either name in their programs but the long names are recommended to +help document the code and make it easier to read. + +2. A right arrow symbol ($>$) is used in the function descriptions to +separate the input parameters from the output parameters in the +definition of each routine. This symbol is not actually part of the C +calling sequence. + +3. The function parameters are defined in more detail in the +alphabetical listing in Appendix B. + +4. The first argument in almost all the functions is a pointer to a +structure of type `fitsfile'. Memory for this structure is allocated +by CFITSIO when the FITS file is first opened or created and is freed +when the FITS file is closed. + +5. The last argument in almost all the functions is the error status +parameter. It must be equal to 0 on input, otherwise the function will +immediately exit without doing anything. A non-zero output value +indicates that an error occurred in the function. In most cases the +status value is also returned as the value of the function itself. + +**A. CFITSIO Error Status Routines + +>1 Return a descriptive text string (30 char max.) corresponding to +> a CFITSIO error status code.\label{ffgerr} +- + void fits_get_errstatus / ffgerr (int status, > char *err_text) +- +>2 Return the top (oldest) 80-character error message from the + internal CFITSIO stack of error messages and shift any remaining + messages on the stack up one level. Call this routine + repeatedly to get each message in sequence. The function returns + a value = 0 and a null error message when the error stack is empty. +>\label{ffgmsg} +- + int fits_read_errmsg / ffgmsg (char *err_msg) +- +>3 Print out the error message corresponding to the input status + value and all the error messages on the CFITSIO stack to the specified + file stream (normally to stdout or stderr). If the input + status value = 0 then this routine does nothing. +>\label{ffrprt} +- + void fits_report_error / ffrprt (FILE *stream, > status) +- +>4 The fits\_write\_errmark routine puts an invisible marker on the + CFITSIO error stack. The fits\_clear\_errmark routine can then be + used to delete any more recent error messages on the stack, back to + the position of the marker. This preserves any older error messages + on the stack. The fits\_clear\_errmsg routine simply clears all the + messages (and marks) from the stack. These routines are called + without any arguments. +>\label{ffpmrk} \label{ffcmsg} +- + void fits_write_errmark / ffpmrk (void) + void fits_clear_errmark / ffcmrk (void) + void fits_clear_errmsg / ffcmsg (void) +- + +**B. FITS File Access Routines + +>1 Open an existing data file. \label{ffopen} + +- +int fits_open_file / ffopen + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_diskfile / ffdkopen + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_data / ffdopn + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_table / fftopn + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_image / ffiopn + (fitsfile **fptr, char *filename, int iomode, > int *status) +- + +The iomode parameter determines the read/write access allowed in the +file and can have values of READONLY (0) or READWRITE (1). The filename +parameter gives the name of the file to be opened, followed by an +optional argument giving the name or index number of the extension +within the FITS file that should be moved to and opened (e.g., +\verb-myfile.fits+3- or \verb-myfile.fits[3]- moves to the 3rd extension within +the file, and \verb-myfile.fits[events]- moves to the extension with the +keyword EXTNAME = 'EVENTS'). + +The fits\_open\_diskfile routine is similar to the fits\_open\_file routine +except that it does not support the extended filename syntax in the input +file name. This routine simply tries to open the specified input file +on magnetic disk. This routine is mainly for use in cases where the +filename (or directory path) contains square or curly bracket characters +that would confuse the extended filename parser. + +The fits\_open\_data routine is similar to the fits\_open\_file routine +except that it will move to the first HDU containing significant data, +if a HDU name or number to open was not explicitly specified as +part of the filename. In this case, it will look for the first +IMAGE HDU with NAXIS > 0, or the first table that does not contain the +strings `GTI' (Good Time Interval extension) or `OBSTABLE' in the +EXTNAME keyword value. + +The fits\_open\_table and fits\_open\_image routines are similar to +fits\_open\_data except they will move to the first significant table +HDU or image HDU in the file, respectively, if a HDU name or +number is not specified as part of the filename. + +IRAF images (.imh format files) and raw binary data arrays may also be +opened with READONLY access. CFITSIO will automatically test if the +input file is an IRAF image, and if, so will convert it on the fly into +a virtual FITS image before it is opened by the application program. +If the input file is a raw binary data array of numbers, then the data type +and dimensions of the array must be specified in square brackets +following the name of the file (e.g. 'rawfile.dat[i512,512]' opens a +512 x 512 short integer image). See the `Extended File Name Syntax' +chapter for more details on how to specify the raw file name. The raw +file is converted on the fly into a virtual FITS image in memory that +is then opened by the application program with READONLY access. + +Programs can read the input file from the 'stdin' file stream if a dash +character ('-') is given as the filename. Files can also be opened over +the network using FTP or HTTP protocols by supplying the appropriate URL +as the filename. + +The input file can be modified in various ways to create a virtual file +(usually stored in memory) that is then opened by the application +program by supplying a filtering or binning specifier in square brackets +following the filename. Some of the more common filtering methods are +illustrated in the following paragraphs, but users should refer to the +'Extended File Name Syntax' chapter for a complete description of +the full file filtering syntax. + +When opening an image, a rectangular subset of the physical image may be +opened by listing the first and last pixel in each dimension (and +optional pixel skipping factor): +- +myimage.fits[101:200,301:400] +- +will create and open a 100x100 pixel virtual image of that section of +the physical image, and \verb+myimage.fits[*,-*]+ opens a virtual image +that is the same size as the physical image but has been flipped in +the vertical direction. + +When opening a table, the filtering syntax can be used to add or delete +columns or keywords in the virtual table: +\verb-myfile.fits[events][col !time; PI = PHA*1.2]- opens a virtual table in which the TIME column +has been deleted and a new PI column has been added with a value 1.2 +times that of the PHA column. Similarly, one can filter a table to keep +only those rows that satisfy a selection criterion: +\verb-myfile.fits[events][pha > 50]- creates and opens a virtual table +containing only those rows with a PHA value greater than 50. A large +number of boolean and mathematical operators can be used in the +selection expression. One can also filter table rows using 'Good Time +Interval' extensions, and spatial region filters as in +\verb-myfile.fits[events][gtifilter()]- and +\verb-myfile.fits[events][regfilter( "stars.rng")]-. + +Finally, table columns may be binned or histogrammed to generate a +virtual image. For example, \verb-myfile.fits[events][bin (X,Y)=4]- will +result in a 2-dimensional image calculated by binning the X and Y +columns in the event table with a bin size of 4 in each dimension. The +TLMINn and TLMAXn keywords will be used by default to determine the +range of the image. + +A single program can open the same FITS file more than once and then +treat the resulting fitsfile pointers as though they were completely +independent FITS files. Using this facility, a program can open a FITS +file twice, move to 2 different extensions within the file, and then +> read and write data in those extensions in any order. + +>2 Create and open a new empty output FITS file. \label{ffinit} + +- +int fits_create_file / ffinit + (fitsfile **fptr, char *filename, > int *status) + +int fits_create_diskfile / ffdkinit + (fitsfile **fptr, char *filename, > int *status) +- + +An error will be returned if the specified file already exists, unless +the filename is prefixed with an exclamation point (!). In that case +CFITSIO will overwrite (delete) any existing file with the same name. +Note that the exclamation point is a special UNIX character so if +it is used on the command line it must be preceded by a backslash to +force the UNIX shell to accept the character as part of the filename. + +The output file will be written to the 'stdout' file stream if a dash +character ('-') or the string 'stdout' is given as the filename. Similarly, +'-.gz' or 'stdout.gz' will cause the file to be gzip compressed before +it is written out to the stdout stream. + +Optionally, the name of a template file that is used to define the +structure of the new file may be specified in parentheses following the +output file name. The template file may be another FITS file, in which +case the new file, at the time it is opened, will be an exact copy of +the template file except that the data structures (images and tables) +will be filled with zeros. Alternatively, the template file may be an +ASCII format text file containing directives that define the keywords to be +created in each HDU of the file. See the 'Extended File Name Syntax' + section for a complete description of the template file syntax. + +The fits\_create\_diskfile routine is similar to the fits\_create\_file routine +except that it does not support the extended filename syntax in the input +file name. This routine simply tries to create the specified file +on magnetic disk. This routine is mainly for use in cases where the +filename (or directory path) contains square or curly bracket characters +> that would confuse the extended filename parser. + + +>3 Close a previously opened FITS file. The first routine simply +closes the file, whereas the second one also DELETES THE FILE, which +can be useful in cases where a FITS file has been partially created, +but then an error occurs which prevents it from being completed. +> \label{ffclos} \label{ffdelt} +- + int fits_close_file / ffclos (fitsfile *fptr, > int *status) + + int fits_delete_file / ffdelt (fitsfile *fptr, > int *status) +- +>4 Return the name, I/O mode (READONLY or READWRITE), and/or the file +type (e.g. 'file://', 'ftp://') of the opened FITS file. \label{ffflnm} +> \label{ffflmd} \label{ffurlt} +- + int fits_file_name / ffflnm (fitsfile *fptr, > char *filename, int *status) + + int fits_file_mode / ffflmd (fitsfile *fptr, > int *iomode, int *status) + + int fits_url_type / ffurlt (fitsfile *fptr, > char *urltype, int *status) +- +**C. HDU Access Routines + +The following functions perform operations on Header-Data Units (HDUs) +as a whole. + +>1 Move to a different HDU in the file. The first routine moves to a + specified absolute HDU number (starting with 1 for the primary + array) in the FITS file, and the second routine moves a relative + number HDUs forward or backward from the current HDU. A null + pointer may be given for the hdutype parameter if it's value is not + needed. The third routine moves to the (first) HDU which has the + specified extension type and EXTNAME and EXTVER keyword values (or + HDUNAME and HDUVER keywords). The hdutype parameter may have a + value of IMAGE\_HDU, ASCII\_TBL, BINARY\_TBL, or ANY\_HDU where + ANY\_HDU means that only the extname and extver values will be used + to locate the correct extension. If the input value of extver is 0 + then the EXTVER keyword is ignored and the first HDU with a + matching EXTNAME (or HDUNAME) keyword will be found. If no + matching HDU is found in the file then the current HDU will remain + unchanged and a status = BAD\_HDU\_NUM will be returned. +> \label{ffmahd} \label{ffmrhd} \label{ffmnhd} +- + int fits_movabs_hdu / ffmahd + (fitsfile *fptr, int hdunum, > int *hdutype, int *status) + + int fits_movrel_hdu / ffmrhd + (fitsfile *fptr, int nmove, > int *hdutype, int *status) + + int fits_movnam_hdu / ffmnhd + (fitsfile *fptr, int hdutype, char *extname, int extver, > int *status) +- +>2 Return the total number of HDUs in the FITS file. +> The current HDU remains unchanged. \label{ffthdu} +- + int fits_get_num_hdus / ffthdu + (fitsfile *fptr, > int *hdunum, int *status) +- +>3 Return the number of the current HDU (CHDU) in the FITS file (where + the primary array = 1). This function returns the HDU number +> rather than a status value. \label{ffghdn} +- + int fits_get_hdu_num / ffghdn + (fitsfile *fptr, > int *hdunum) +- +>4 Return the type of the current HDU in the FITS file. The possible +> values for hdutype are: IMAGE\_HDU, ASCII\_TBL, or BINARY\_TBL. \label{ffghdt} +- + int fits_get_hdu_type / ffghdt + (fitsfile *fptr, > int *hdutype, int *status) +- +>5 Copy all or part of the HDUs in the FITS file associated with infptr + and append them to the end of the FITS file associated with + outfptr. If 'previous' is true (not 0), then any HDUs preceding + the current HDU in the input file will be copied to the output + file. Similarly, 'current' and 'following' determine whether the + current HDU, and/or any following HDUs in the input file will be + copied to the output file. Thus, if all 3 parameters are true, then the + entire input file will be copied. On exit, the current HDU in + the input file will be unchanged, and the last HDU in the output +> file will be the current HDU. \label{ffcpfl} +- + int fits_copy_file / ffcpfl + (fitsfile *infptr, fitsfile *outfptr, int previous, int current, + int following, > int *status) +- +>6 Copy the current HDU from the FITS file associated with infptr and append it + to the end of the FITS file associated with outfptr. Space may be +> reserved for MOREKEYS additional keywords in the output header. \label{ffcopy} +- + int fits_copy_hdu / ffcopy + (fitsfile *infptr, fitsfile *outfptr, int morekeys, > int *status) +- +>7 Copy the header (and not the data) from the CHDU associated with infptr + to the CHDU associated with outfptr. If the current output HDU + is not completely empty, then the CHDU will be closed and a new + HDU will be appended to the output file. An empty output data unit +> will be created with all values initially = 0). \label{ffcphd} +- + int fits_copy_header / ffcphd + (fitsfile *infptr, fitsfile *outfptr, > int *status) +- +>8 Delete the CHDU in the FITS file. Any following HDUs will be shifted + forward in the file, to fill in the gap created by the deleted + HDU. In the case of deleting the primary array (the first HDU in + the file) then the current primary array will be replace by a null + primary array containing the minimum set of required keywords and + no data. If there are more extensions in the file following the + one that is deleted, then the the CHDU will be redefined to point + to the following extension. If there are no following extensions + then the CHDU will be redefined to point to the previous HDU. The + output hdutype parameter returns the type of the new CHDU. A null + pointer may be given for +> hdutype if the returned value is not needed. \label{ffdhdu} +- + int fits_delete_hdu / ffdhdu + (fitsfile *fptr, > int *hdutype, int *status) +- +**D. Header Keyword Read/Write Routines + +These routines read or write keywords in the Current Header Unit +(CHU). Wild card characters (*, ?, or \#) may be used when specifying +the name of the keyword to be read: a '?' will match any single +character at that position in the keyword name and a '*' will match any +length (including zero) string of characters. The '\#' character will +match any consecutive string of decimal digits (0 - 9). When a wild +card is used the routine will only search for a match from the current +header position to the end of the header and will not resume the search +from the top of the header back to the original header position as is +done when no wildcards are included in the keyword name. The +fits\_read\_record routine may be used to set the starting position +when doing wild card searchs. A status value of KEY\_NO\_EXIST is +returned if the specified keyword to be read is not found in the +header. + +***1. Keyword Reading Routines + +>1 Return the number of existing keywords (not counting the + END keyword) and the amount of space currently available for more + keywords. It returns morekeys = -1 if the header has not yet been + closed. Note that CFITSIO will dynamically add space if required + when writing new keywords to a header so in practice there is no + limit to the number of keywords that can be added to a header. A + null pointer may be entered for the morekeys parameter if it's +> value is not needed. \label{ffghsp} +- + int fits_get_hdrspace / ffghsp + (fitsfile *fptr, > int *keysexist, int *morekeys, int *status) +- +>2 Return the specified keyword. In the first routine, + the datatype parameter specifies the desired returned data type of the + keyword value and can have one of the following symbolic constant + values: TSTRING, TLOGICAL (== int), TBYTE, TSHORT, TUSHORT, TINT, + TUINT, TLONG, TULONG, TFLOAT, TDOUBLE, TCOMPLEX, and TDBLCOMPLEX. + Within the context of this routine, TSTRING corresponds to a + 'char*' data type, i.e., a pointer to a character array. Data type + conversion will be performed for numeric values if the keyword + value does not have the same data type. If the value of the keyword + is undefined (i.e., the value field is blank) then an error status + = VALUE\_UNDEFINED will be returned. + + The second routine returns the keyword value as a character string + (a literal copy of what is in the value field) regardless of the + intrinsic data type of the keyword. The third routine returns + the entire 80-character header record of the keyword. + + If a NULL comment pointer is supplied then the comment string +> will not be returned. \label{ffgky} \label{ffgkey} \label{ffgcrd} +- + int fits_read_key / ffgky + (fitsfile *fptr, int datatype, char *keyname, > DTYPE *value, + char *comment, int *status) + + int fits_read_keyword / ffgkey + (fitsfile *fptr, char *keyname, > char *value, char *comment, + int *status) + + int fits_read_card / ffgcrd + (fitsfile *fptr, char *keyname, > char *card, int *status) +- +>3 Return the nth header record in the CHU. The first keyword + in the header is at keynum = 1; if keynum = 0 then these routines + simply reset the internal CFITSIO pointer to the beginning of the header + so that subsequent keyword operations will start at the top of the + header (e.g., prior to searching for keywords using wild cards in + the keyword name). The first routine returns the entire + 80-character header record, while the second routine parses the + record and returns the name, value, and comment fields as separate + character strings. If a NULL comment pointer is given on input, + then the comment string will not be +> returned. \label{ffgrec} \label{ffgkyn} +- + int fits_read_record / ffgrec + (fitsfile *fptr, int keynum, > char *card, int *status) + + int fits_read_keyn / ffgkyn + (fitsfile *fptr, int keynum, > char *keyname, char *value, + char *comment, int *status) +- +>4 Return the next keyword whose name matches one of the strings in + 'inclist' but does not match any of the strings in 'exclist'. + The strings in inclist and exclist may contain wild card characters + (*, ?, and \#) as described at the beginning of this section. + This routine searches from the current header position to the + end of the header, only, and does not continue the search from + the top of the header back to the original position. The current + header position may be reset with the ffgrec routine. Note + that nexc may be set = 0 if there are no keywords to be excluded. + This routine returns status = KEY\_NO\_EXIST if a matching +> keyword is not found. \label{ffgnxk} +- + int fits_find_nextkey / ffgnxk + (fitsfile *fptr, char **inclist, int ninc, char **exclist, + int nexc, > char *card, int *status) +- +>5 Return the physical units string from an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are enclosed in square brackets in the + beginning of the keyword comment field. A null string is returned +> if no units are defined for the keyword. \label{ffgunt} +- + VELOCITY= 12.3 / [km/s] orbital speed + + int fits_read_key_unit / ffgunt + (fitsfile *fptr, char *keyname, > char *unit, int *status) +- +>6 Concatenate the header keywords in the CHDU into a single long + string of characters. This provides a convenient way of passing + all or part of the header information in a FITS HDU to other subroutines. + Each 80-character fixed-length keyword record is appended to the + output character string, in order, with no intervening separator or + terminating characters. The last header record is terminated with + a NULL character. This routine allocates memory for the returned + character array, so the calling program must free the memory when + finished. + + Selected keywords may be excluded from the returned character string. + If the second parameter (nocomments) is TRUE (nonzero) then any + COMMENT, HISTORY, or blank keywords in the header will not be copied + to the output string. + + The 'exclist' parameter may be used to supply a list of keywords + that are to be excluded from the output character string. Wild card + characters (*, ?, and \#) may be used in the excluded keyword names. + If no additional keywords are to be excluded, then set nexc = 0 and +> specify NULL for the the **header parameter. \label{ffhdr2str} +- + int fits_hdr2str + (fitsfile *fptr, int nocomments, char **exclist, int nexc, + > char **header, int *nkeys, int *status) +- + +***2. Keyword Writing Routines + +>1 Write a keyword of the appropriate data type into the + CHU. The first routine simply appends a new keyword whereas the + second routine will update the value and comment fields of the + keyword if it already exists, otherwise it appends a new + keyword. Note that the address to the value, and not the value + itself, must be entered. The datatype parameter specifies the + data type of the keyword value with one of the following values: + TSTRING, TLOGICAL (== int), TBYTE, TSHORT, TUSHORT, TINT, TUINT, + TLONG, TULONG, TFLOAT, TDOUBLE. Within the context of this + routine, TSTRING corresponds to a 'char*' data type, i.e., a pointer + to a character array. A null pointer may be entered for the + comment parameter in which case the keyword comment +> field will be unmodified or left blank. \label{ffpky} \label{ffuky} +- + int fits_write_key / ffpky + (fitsfile *fptr, int datatype, char *keyname, DTYPE *value, + char *comment, > int *status) + + int fits_update_key / ffuky + (fitsfile *fptr, int datatype, char *keyname, DTYPE *value, + char *comment, > int *status) +- +>2 Write a keyword with a null or undefined value (i.e., the + value field in the keyword is left blank). The first routine + simply appends a new keyword whereas the second routine will update + the value and comment fields of the keyword if it already exists, + otherwise it appends a new keyword. A null pointer may be + entered for the comment parameter in which case the keyword + comment +> field will be unmodified or left blank. \label{ffpkyu} \label{ffukyu} +- + int fits_write_key_null / ffpkyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) + + int fits_update_key_null / ffukyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) +- +>3 Write (append) a COMMENT or HISTORY keyword to the CHU. The comment or + history string will be continued over multiple keywords if it is longer +> than 70 characters. \label{ffpcom} \label{ffphis} +- + int fits_write_comment / ffpcom + (fitsfile *fptr, char *comment, > int *status) + + int fits_write_history / ffphis + (fitsfile *fptr, char *history, > int *status) +- +>4 Write the DATE keyword to the CHU. The keyword value will contain + the current system date as a character string in 'yyyy-mm-ddThh:mm:ss' + format. If a DATE keyword already exists in the header, then this + routine will simply update the keyword value with the current date. +> \label{ffpdat} +- + int fits_write_date / ffpdat + (fitsfile *fptr, > int *status) +- +>5 Write a user specified keyword record into the CHU. This is + a low--level routine which can be used to write any arbitrary + record into the header. The record must conform to the all +> the FITS format requirements. \label{ffprec} +- + int fits_write_record / ffprec + (fitsfile *fptr, char *card, > int *status) +- +>6 Update an 80-character record in the CHU. If a keyword with the input + name already exists, then it is overwritten by the value of card. This + could modify the keyword name as well as the value and comment fields. + If the keyword doesn't already exist then a new keyword card is appended +> to the header. \label{ffucrd} +- + int fits_update_card / ffucrd + (fitsfile *fptr, char *keyname, char *card, > int *status) +- + +>>7 Modify (overwrite) the comment field of an existing keyword. \label{ffmcom} +- + int fits_modify_comment / ffmcom + (fitsfile *fptr, char *keyname, char *comment, > int *status) +- + +>8 Write the physical units string into an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are enclosed in square brackets in the +> beginning of the keyword comment field. \label{ffpunt} +- + VELOCITY= 12.3 / [km/s] orbital speed + + int fits_write_key_unit / ffpunt + (fitsfile *fptr, char *keyname, char *unit, > int *status) +- +>9 Rename an existing keyword, preserving the current value +> and comment fields. \label{ffmnam} +- + int fits_modify_name / ffmnam + (fitsfile *fptr, char *oldname, char *newname, > int *status) +- +>10 Delete a keyword record. The space occupied by + the keyword is reclaimed by moving all the following header records up + one row in the header. The first routine deletes a keyword at a + specified position in the header (the first keyword is at position 1), + whereas the second routine deletes a specifically named keyword. + Wild card characters may be used when specifying the name of the keyword +> to be deleted. \label{ffdrec} \label{ffdkey} +- + int fits_delete_record / ffdrec + (fitsfile *fptr, int keynum, > int *status) + + int fits_delete_key / ffdkey + (fitsfile *fptr, char *keyname, > int *status) +- +**E. Primary Array or IMAGE Extension I/O Routines + +These routines read or write data values in the primary data array (i.e., +the first HDU in a FITS file) or an IMAGE extension. There are also +routines to get information about the data type and size of the image. +Users should also read the following chapter on the CFITSIO iterator +function which provides a more `object oriented' method of reading and +writing images. The iterator function is a little more complicated to +use, but the advantages are that it usually takes less code to perform +the same operation, and the resulting program oftens runs faster because +the FITS files are read and written using the most efficient block size. + +C programmers should note that the ordering of arrays in FITS files, and +hence in all the CFITSIO calls, is more similar to the dimensionality +of arrays in Fortran rather than C. For instance if a FITS image has +NAXIS1 = 100 and NAXIS2 = 50, then a 2-D array just large enough to hold +the image should be declared as array[50][100] and not as array[100][50]. + +The `datatype' parameter specifies the data type of the `nulval' and +`array' pointers and can have one of the following values: TBYTE, +TSBYTE, TSHORT, TUSHORT, TINT, TUINT, TLONG, TLONGLONG, TULONG, TFLOAT, +TDOUBLE. Automatic data type conversion is performed if the data type +of the FITS array (as defined by the BITPIX keyword) differs from that +specified by 'datatype'. The data values are also automatically scaled +by the BSCALE and BZERO keyword values as they are being read or written +in the FITS array. + +>1 Get the data type or equivalent data type of the image. The + first routine returns the physical data type of the FITS image, as + given by the BITPIX keyword, with allowed values of BYTE\_IMG (8), + SHORT\_IMG (16), LONG\_IMG (32), FLOAT\_IMG (-32), and DOUBLE\_IMG + (-64). The second routine is similar, except that if the image pixel + values are scaled, with non-default values for the BZERO and BSCALE + keywords, then the routine will return the 'equivalent' data type + that is needed to store the scaled values. For example, if BITPIX + = 16 and BSCALE = 0.1 then the equivalent data type is FLOAT\_IMG. + Similarly if BITPIX = 16, BSCALE = 1, and BZERO = 32768, then the + the pixel values span the range of an unsigned short integer and +> the returned data type will be USHORT\_IMG. \label{ffgidt} +- + int fits_get_img_type / ffgidt + (fitsfile *fptr, > int *bitpix, int *status) + + int fits_get_img_equivtype / ffgiet + (fitsfile *fptr, > int *bitpix, int *status) +- +>2 Get the number of dimensions, and/or the size of + each dimension in the image . The number of axes in the image is + given by naxis, and the size of each dimension is given by the + naxes array (a maximum of maxdim dimensions will be returned). +> \label{ffgidm} \label{ffgisz} \label{ffgipr} +- + int fits_get_img_dim / ffgidm + (fitsfile *fptr, > int *naxis, int *status) + + int fits_get_img_size / ffgisz + (fitsfile *fptr, int maxdim, > long *naxes, int *status) + + int fits_get_img_param / ffgipr + (fitsfile *fptr, int maxdim, > int *bitpix, int *naxis, long *naxes, + int *status) +- +>3 Create a new primary array or IMAGE extension with a specified + data type and size. If the FITS file is currently empty then a + primary array is created, otherwise a new IMAGE extension is +> appended to the file. \label{ffcrim} +- + int fits_create_img / ffcrim + ( fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) +- +>4 Write a rectangular subimage (or the whole image) to the FITS data + array. The fpixel and lpixel arrays give the coordinates of the + first (lower left corner) and last (upper right corner) pixels in +> FITS image to be written to. \label{ffpss} +- + int fits_write_subset / ffpss + (fitsfile *fptr, int datatype, long *fpixel, long *lpixel, + DTYPE *array, > int *status) +- +>5 Write pixels into the FITS data array. 'fpixel' is an array of + length NAXIS which gives the coordinate of the starting pixel to be + written to, such that fpixel[0] is in the range 1 to NAXIS1, + fpixel[1] is in the range 1 to NAXIS2, etc. The first routine + simply writes the array of pixels to the FITS file (doing data type + conversion if necessary) whereas the second routine will substitute + the appropriate FITS null value for any elements which are equal to + the input value of nulval (note that this parameter gives the + address of the null value, not the null value itself). For integer + FITS arrays, the FITS null value is defined by the BLANK keyword (an + error is returned if the BLANK keyword doesn't exist). For floating + point FITS arrays the special IEEE NaN (Not-a-Number) value will be + written into the FITS file. If a null pointer is entered for + nulval, then the null value is ignored and this routine behaves +> the same as fits\_write\_pix. \label{ffppx} \label{ffppxn} +- + int fits_write_pix / ffppx + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + DTYPE *array, int *status); + + int fits_write_pixnull / ffppxn + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + DTYPE *array, DTYPE *nulval, > int *status); +- +>6 Set FITS data array elements equal to the appropriate null pixel + value. For integer FITS arrays, the FITS null value is defined by + the BLANK keyword (an error is returned if the BLANK keyword + doesn't exist). For floating point FITS arrays the special IEEE NaN + (Not-a-Number) value will be written into the FITS file. Note that + 'firstelem' is a scalar giving the offset to the first pixel to be +> written in the equivalent 1-dimensional array of image pixels. \label{ffpprn} +- + int fits_write_null_img / ffpprn + (fitsfile *fptr, long firstelem, long nelements, > int *status) +- +>7 Read a rectangular subimage (or the whole image) from the FITS + data array. The fpixel and lpixel arrays give the coordinates of + the first (lower left corner) and last (upper right corner) pixels + to be read from the FITS image. Undefined FITS array elements will + be returned with a value = *nullval, (note that this parameter + gives the address of the null value, not the null value itself) + unless nulval = 0 or *nulval = 0, in which case no checks for +> undefined pixels will be performed. \label{ffgsv} +- + int fits_read_subset / ffgsv + (fitsfile *fptr, int datatype, long *fpixel, long *lpixel, long *inc, + DTYPE *nulval, > DTYPE *array, int *anynul, int *status) +- +>8 Read pixels from the FITS data array. 'fpixel' is the starting + pixel location and is an array of length NAXIS such that fpixel[0] + is in the range 1 to NAXIS1, fpixel[1] is in the range 1 to NAXIS2, + etc. The nelements parameter specifies the number of pixels to + read. If fpixel is set to the first pixel, and nelements is set + equal to the NAXIS1 value, then this routine would read the first + row of the image. Alternatively, if nelements is set equal to + NAXIS1 * NAXIS2 then it would read an entire 2D image, or the first + plane of a 3-D datacube. + + The first routine will return any undefined pixels in the FITS array + equal to the value of *nullval (note that this parameter gives the + address of the null value, not the null value itself) unless nulval + = 0 or *nulval = 0, in which case no checks for undefined pixels + will be performed. The second routine is similar except that any + undefined pixels will have the corresponding nullarray element set +> equal to TRUE (= 1). \label{ffgpxv} \label{ffgpxf} +- + int fits_read_pix / ffgpxv + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + DTYPE *nulval, > DTYPE *array, int *anynul, int *status) + + int fits_read_pixnull / ffgpxf + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + > DTYPE *array, char *nullarray, int *anynul, int *status) +- +**F. Image Compression + +CFITSIO now transparently supports 2 types of image compression: + +1) The entire FITS file may be externally compressed with the gzip or +Unix compress algorithm, producing a *.gz or *.Z file, respectively. +When reading compressed files of this type, CFITSIO first uncompresses +the entire file into memory before performing the requested read +operations. Output files can be directly written in the gzip +compressed format if the user-specified filename ends with `.gz'. In +this case, CFITSIO initially writes the uncompressed file in memory and +then compresses it and writes it to disk when the FITS file is closed, +thus saving user disk space. Read and write access to these compressed +FITS files is generally quite fast; the main limitation is that there +must be enough available memory (or swap space) to hold the entire +uncompressed FITS file. + +2) CFITSIO also supports a newer image compression format in which the +image is divided into a grid of rectangular tiles, and each tile of +pixels is individually compressed. The compressed tiles are stored in +rows of a variable length array column in a FITS binary table, but +CFITSIO recognizes that the binary table extension contains an image +and treats it as if it were an IMAGE extension. This tile-compressed +format is especially well suited for compressing very large images +because a) the FITS header keywords remain uncompressed for rapid read +access, and because b) it is possible to extract and uncompress +sections of the image without having to uncompress the entire image. +This format is also much more effective in compressing floating point +images (using a lossy compression algorithm) than simply compressing +the image using gzip or compress. + +A detailed description of this format is available at: +- +http://heasarc.gsfc.nasa.gov/docs/software/fitsio/ + compression/compress_image.html +- + +The N-dimensional FITS image can be divided into any +desired rectangular grid of compression tiles. By default the tiles +are chosen to correspond to the rows of the image, each containing +NAXIS1 pixels. For example, a 800 x 800 x 4 pixel data cube would be +divided in to 3200 tiles containing 800 pixels each by default. +Alternatively, this data cube could be divided into 256 tiles that are each +100 X 100 X 1 pixels in size, or 4 tiles containing 800 x 800 X 1 +pixels, or a single tile containing the entire data cube. Note that +the image dimensions are not required to be an integer multiple of the +tile dimensions, so, for example, this data cube could also be divided +into 250 X 200 pixel tiles, in which case the last tile in each row +would only contain 50 X 200 pixels. + +Currently, 3 image compression algorithms are supported: Rice, GZIP, +and PLIO. Rice and GZIP are general purpose algorithms that can be +used to compress almost any image. The PLIO algorithm, on the other +hand, is more specialized and was developed for use in IRAF to store +pixel data quality masks. It is designed to only work on images +containing positive integers with values up to about 2**24. Other +image compression algorithms may be supported in the future. + +The 3 supported image compression algorithms are all 'loss-less' when +applied to integer FITS images; the pixel values are preserved exactly +with no loss of information during the compression and uncompression +process. Floating point FITS images (which have BITPIX = -32 or -64) +are first quantized into scaled integer pixel values before being +compressed. This technique produces much higher compression factors +than simply using GZIP to compress the image, but it also means that +the original floating value pixel values may not be precisely returned +when the image is uncompressed. When done properly, this only discards +the 'noise' from the floating point values without losing any +significant information. The amount of noise that is discarded can be +controlled by the 'noise\_bits' compression parameter. + +No special action is required to read tile-compressed images because +all the CFITSIO routines that read normal uncompressed FITS images can +also read images in the tile-compressed format; CFITSIO essentially +treats the binary table that contains the compressed tiles as if +it were an IMAGE extension. + +When creating (writing) a new image with CFITSIO, a normal uncompressed +FITS primary array or IMAGE extension will be written unless the +tile-compressed format has been specified in 1 of 2 possible ways: + +1) At run time, when specifying the name of the output FITS file to be +created at run time, the user can indicate that images should be +written in tile-compressed format by enclosing the compression +parameters in square brackets following the root disk file name. The +`imcopy' example program that included with the CFITSIO distribution +can be used for this purpose to compress or uncompress images. Here +are some examples of the extended file name syntax for specifying +tile-compressed output images: +- + myfile.fit[compress] - use the default compression algorithm (Rice) + and the default tile size (row by row) + + myfile.fit[compress GZIP] - use the specified compression algorithm; + myfile.fit[compress Rice] only the first letter of the algorithm + myfile.fit[compress PLIO] name is required. + + myfile.fit[compress R 100,100] - use Rice compression and + 100 x 100 pixel tile size + + myfile.fit[compress R 100,100;2] - as above, and also use noisebits = 2 +- + +2) Before calling the CFITSIO routine to write the image header +keywords (e.g., fits\_create\_image) the programmer can call the +routines described below to specify the compression algorithm and the +tiling pattern that is to be used. There are 3 routines for specifying +the various compression parameters and 3 corresponding routines to +return the current values of the parameters: +\label{ffsetcomp} \label{ffgetcomp} +- + int fits_set_compression_type(fitsfile *fptr, int comptype, int *status) + int fits_set_tile_dim(fitsfile *fptr, int ndim, long *tilesize, int *status) + int fits_set_noise_bits(fitsfile *fptr, int noisebits, int *status) + + int fits_get_compression_type(fitsfile *fptr, int *comptype, int *status) + int fits_get_tile_dim(fitsfile *fptr, int ndim, long *tilesize, int *status) + int fits_get_noise_bits(fitsfile *fptr, int *noisebits, int *status) +- +3 symbolic constants are defined for use as the value of the +`comptype' parameter: GZIP\_1, RICE\_1, or PLIO\_1. Entering NULL for +comptype will turn off the tile-compression and cause normal FITS +images to be written. + +The 'noisebits' parameter is only used when compressing floating point +images. The default value is 4. Decreasing the value of noisebits +will improve the overall compression efficiency at the expense of +losing more information. + +A small example program called 'imcopy' is included with CFITSIO that +can be used to compress (or uncompress) any FITS image. This +program can be used to experiment with the various compression options +on existing FITS images as shown in these examples: +- +1) imcopy infile.fit 'outfile.fit[compress]' + + This will use the default compression algorithm (Rice) and the + default tile size (row by row) + +2) imcopy infile.fit 'outfile.fit[compress GZIP]' + + This will use the GZIP compression algorithm and the default + tile size (row by row). The allowed compression algorithms are + Rice, GZIP, and PLIO. Only the first letter of the algorithm + name needs to be specified. + +3) imcopy infile.fit 'outfile.fit[compress G 100,100]' + + This will use the GZIP compression algorithm and 100 X 100 pixel + tiles. + +4) imcopy infile.fit 'outfile.fit[compress R 100,100; 4]' + + This will use the Rice compression algorithm, 100 X 100 pixel + tiles, and noise_bits = 4 (assuming the input image has a + floating point data type). Decreasing the value of noisebits + will improve the overall compression efficiency at the expense + of losing more information. + +5) imcopy infile.fit outfile.fit + + If the input file is in tile-compressed format, then it will be + uncompressed to the output file. Otherwise, it simply copies + the input image to the output image. + +6) imcopy 'infile.fit[1001:1500,2001:2500]' outfile.fit + + This extracts a 500 X 500 pixel section of the much larger + input image (which may be in tile-compressed format). The + output is a normal uncompressed FITS image. + +7) imcopy 'infile.fit[1001:1500,2001:2500]' outfile.fit.gz + + Same as above, except the output file is externally compressed + using the gzip algorithm. + +- +**G. ASCII and Binary Table Routines + +These routines perform read and write operations on columns of data in +FITS ASCII or Binary tables. Note that in the following discussions, +the first row and column in a table is at position 1 not 0. + +Users should also read the following chapter on the CFITSIO iterator +function which provides a more `object oriented' method of reading and +writing table columns. The iterator function is a little more +complicated to use, but the advantages are that it usually takes less +code to perform the same operation, and the resulting program oftens +runs faster because the FITS files are read and written using the most +efficient block size. + +***1. Create New Table + +>1 Create a new ASCII or bintable table extension. If + the FITS file is currently empty then a dummy primary array will be + created before appending the table extension to it. The tbltype + parameter defines the type of table and can have values of + ASCII\_TBL or BINARY\_TBL. The naxis2 parameter gives the initial + number of rows to be created in the table, and should normally be + set = 0. CFITSIO will automatically increase the size of the table + as additional rows are written. A non-zero number of rows may be + specified to reserve space for that many rows, even if a fewer + number of rows will be written. The tunit and extname parameters + are optional and a null pointer may be given if they are not + defined. The FITS Standard recommends that only letters, digits, + and the underscore character be used in column names (the ttype + parameter) with no embedded spaces. Trailing blank characters are + not significant. It is recommended that all the column names in a + given table be unique within the first 8 characters, and strongly + recommended that the names be +> unique within the first 16 characters. \label{ffcrtb} +- + int fits_create_tbl / ffcrtb + (fitsfile *fptr, int tbltype, long naxis2, int tfields, char *ttype[], + char *tform[], char *tunit[], char *extname, int *status) +- +***2. Column Information Routines + +>1 Get the number of rows or columns in the current FITS table. + The number of rows is given by the NAXIS2 keyword and the + number of columns is given by the TFIELDS keyword in the header +> of the table. \label{ffgnrw} +- + int fits_get_num_rows / ffgnrw + (fitsfile *fptr, > long *nrows, int *status); + + int fits_get_num_cols / ffgncl + (fitsfile *fptr, > int *ncols, int *status); +- + +>2 Get the table column number (and name) of the column whose name +matches an input template name. If casesen = CASESEN then the column +name match will be case-sensitive, whereas if casesen = CASEINSEN then +the case will be ignored. As a general rule, the column names should +be treated as case INsensitive. + +The input column name template may be either the exact name of the +column to be searched for, or it may contain wild card characters (*, +?, or \#), or it may contain the integer number of the desired column +(with the first column = 1). The `*' wild card character matches any +sequence of characters (including zero characters) and the `?' +character matches any single character. The \# wildcard will match any +consecutive string of decimal digits (0-9). If more than one column +name in the table matches the template string, then the first match is +returned and the status value will be set to COL\_NOT\_UNIQUE as a +warning that a unique match was not found. To find the other cases +that match the template, call the routine again leaving the input +status value equal to COL\_NOT\_UNIQUE and the next matching name will +then be returned. Repeat this process until a status = +COL\_NOT\_FOUND is returned. + +The FITS Standard recommends that only letters, digits, and the +underscore character be used in column names (with no embedded +spaces). Trailing blank characters are not significant. It is +recommended that all the column names in a given table be unique within +the first 8 characters, and strongly recommended that the names be +> unique within the first 16 characters. \label{ffgcno} \label{ffgcnn} +- + int fits_get_colnum / ffgcno + (fitsfile *fptr, int casesen, char *templt, > int *colnum, + int *status) + + int fits_get_colname / ffgcnn + (fitsfile *fptr, int casesen, char *templt, > char *colname, + int *colnum, int *status) +- +>3 Return the data type, vector repeat value, and the width in bytes + of a column in an ASCII or binary table. Allowed values for the + data type in ASCII tables are: TSTRING, TSHORT, TLONG, TFLOAT, and + TDOUBLE. Binary tables also support these types: TLOGICAL, TBIT, + TBYTE, TCOMPLEX and TDBLCOMPLEX. The negative of the data type code + value is returned if it is a variable length array column. Note + that in the case of a 'J' 32-bit integer binary table column, this + routine will return data type = TINT32BIT (which in fact is + equivalent to TLONG). With most current C compilers, a value in a + 'J' column has the same size as an 'int' variable, and may not be + equivalent to a 'long' variable, which is 64-bits long on an + increasing number of compilers. + + The 'repeat' parameter returns the vector repeat count on the binary + table TFORMn keyword value. (ASCII table columns always have repeat + = 1). The 'width' parameter returns the width in bytes of a single + column element (e.g., a '10D' binary table column will have width = + 8, an ASCII table 'F12.2' column will have width = 12, and a binary + table'60A' character string column will have width = 60); Note that + this routine supports the local convention for specifying arrays of + fixed length strings within a binary table character column using + the syntax TFORM = 'rAw' where 'r' is the total number of characters + (= the width of the column) and 'w' is the width of a unit string + within the column. Thus if the column has TFORM = '60A12' then this + means that each row of the table contains 5 12-character substrings + within the 60-character field, and thus in this case this routine will + return typecode = TSTRING, repeat = 60, and width = 12. The number + of substings in any binary table character string field can be + calculated by (repeat/width). A null pointer may be given for any of + the output parameters that are not needed. + + The second routine, fit\_get\_eqcoltype is similar except that in + the case of scaled integer columns it returns the 'equivalent' data + type that is needed to store the scaled values, and not necessarily + the physical data type of the unscaled values as stored in the FITS + table. For example if a '1I' column in a binary table has TSCALn = + 1 and TZEROn = 32768, then this column effectively contains unsigned + short integer values, and thus the returned value of typecode will + be TUSHORT, not TSHORT. Similarly, if a column has TTYPEn = '1I' + and TSCALn = 0.12, then the returned typecode +> will be TFLOAT. \label{ffgtcl} +- + int fits_get_coltype / ffgtcl + (fitsfile *fptr, int colnum, > int *typecode, long *repeat, + long *width, int *status) + + int fits_get_eqcoltype / ffeqty + (fitsfile *fptr, int colnum, > int *typecode, long *repeat, + long *width, int *status) +- +>4 Return the display width of a column. This is the length + of the string that will be returned by the fits\_read\_col routine + when reading the column as a formatted string. The display width is + determined by the TDISPn keyword, if present, otherwise by the data +> type of the column. \label{ffgcdw} +- + int fits_get_col_display_width / ffgcdw + (fitsfile *fptr, int colnum, > int *dispwidth, int *status) +- + +>5 Return the number of and size of the dimensions of a table column in + a binary table. Normally this information is given by the TDIMn keyword, + but if this keyword is not present then this routine returns naxis = 1 +> and naxes[0] equal to the repeat count in the TFORM keyword. \label{ffgtdm} +- + int fits_read_tdim / ffgtdm + (fitsfile *fptr, int colnum, int maxdim, > int *naxis, + long *naxes, int *status) +- +>6 Decode the input TDIMn keyword string (e.g. '(100,200)') and return the + number of and size of the dimensions of a binary table column. If the input + tdimstr character string is null, then this routine returns naxis = 1 + and naxes[0] equal to the repeat count in the TFORM keyword. This routine +> is called by fits\_read\_tdim. \label{ffdtdm} +- + int fits_decode_tdim / ffdtdm + (fitsfile *fptr, char *tdimstr, int colnum, int maxdim, > int *naxis, + long *naxes, int *status) +- +>7 Write a TDIMn keyword whose value has the form '(l,m,n...)' + where l, m, n... are the dimensions of a multidimension array +> column in a binary table. \label{ffptdm} +- + int fits_write_tdim / ffptdm + (fitsfile *fptr, int colnum, int naxis, long *naxes, > int *status) +- + +***3. Routines to Edit Rows or Columns + +>1 Insert or delete rows in an ASCII or binary table. When inserting rows + all the rows following row FROW are shifted down by NROWS rows; if + FROW = 0 then the blank rows are inserted at the beginning of the + table. The first delete routine deletes NROWS consecutive rows + starting with row FIRSTROW. The second delete routine takes an + input string that lists the rows or row ranges (e.g., + '5-10,12,20-30'), whereas the third delete routine takes an input + integer array that specifies each individual row to be deleted. In + both latter cases, the input list of rows to delete must be sorted + in ascending order. These routines update the NAXIS2 keyword to + reflect the new number of rows in the +> table. \label{ffirow} \label{ffdrow} \label{ffdrws} \label{ffdrrg} +- + int fits_insert_rows / ffirow + (fitsfile *fptr, long firstrow, long nrows, > int *status) + + int fits_delete_rows / ffdrow + (fitsfile *fptr, long firstrow, long nrows, > int *status) + + int fits_delete_rowrange / ffdrrg + (fitsfile *fptr, char *rangelist, > int *status) + + int fits_delete_rowlist / ffdrws + (fitsfile *fptr, long *rowlist, long nrows, > int *status) +- +>2 Insert or delete column(s) in an ASCII or binary + table. When inserting, COLNUM specifies the column number that the + (first) new column should occupy in the table. NCOLS specifies how + many columns are to be inserted. Any existing columns from this + position and higher are shifted over to allow room for the new + column(s). The index number on all the following keywords will be + incremented or decremented if necessary to reflect the new position + of the column(s) in the table: TBCOLn, TFORMn, TTYPEn, TUNITn, + TNULLn, TSCALn, TZEROn, TDISPn, TDIMn, TLMINn, TLMAXn, TDMINn, + TDMAXn, TCTYPn, TCRPXn, TCRVLn, TCDLTn, TCROTn, +> and TCUNIn. \label{fficol} \label{fficls} \label{ffdcol} +- + int fits_insert_col / fficol + (fitsfile *fptr, int colnum, char *ttype, char *tform, + > int *status) + + int fits_insert_cols / fficls + (fitsfile *fptr, int colnum, int ncols, char **ttype, + char **tform, > int *status) + + int fits_delete_col / ffdcol(fitsfile *fptr, int colnum, > int *status) +- +>3 Copy a column from one HDU to another (or to the same HDU). If + create\_col = TRUE, then a new column will be inserted in the output + table, at position `outcolumn', otherwise the existing output column will + be overwritten (in which case it must have a compatible data type). + If outcolnum is greater than the number of column in the table, then + the new column will be appended to the end of the table. + Note that the first column in a table is at colnum = 1. + The standard indexed keywords that related to the column (e.g., TDISPn, +> TUNITn, TCRPXn, TCDLTn, etc.) will also be copied. \label{ffcpcl} +- + int fits_copy_col / ffcpcl + (fitsfile *infptr, fitsfile *outfptr, int incolnum, int outcolnum, + int create_col, > int *status); +- +>4 Modify the vector length of a binary table column (e.g., + change a column from TFORMn = '1E' to '20E'). The vector +> length may be increased or decreased from the current value. \label{ffmvec} +- + int fits_modify_vector_len / ffmvec + (fitsfile *fptr, int colnum, long newveclen, > int *status) +- +***4. Read and Write Column Data Routines + +The following routines write or read data values in the current ASCII +or binary table extension. If a write operation extends beyond the +current size of the table, then the number of rows in the table will +automatically be increased and the NAXIS2 keyword value will be +updated. Attempts to read beyond the end of the table will result in +an error. + +Automatic data type conversion is performed for numerical data types +(only) if the data type of the column (defined by the TFORMn keyword) +differs from the data type of the calling routine. ASCII and binary +tables support the following data type values: TSTRING, TBYTE, TSBYTE, TSHORT, +TUSHORT, TINT, TUINT, TLONG, TLONGLONG, TULONG, TFLOAT, or TDOUBLE. +Binary tables also support TLOGICAL (internally mapped to the `char' +data type), TCOMPLEX, and TDBLCOMPLEX. + +Note that within the context of these routines, the TSTRING data type +corresponds to a C 'char**' data type, i.e., a pointer to an array of +pointers to an array of characters. This is different from the keyword +reading and writing routines where TSTRING corresponds to a C 'char*' +data type, i.e., a single pointer to an array of characters. When +reading strings from a table, the char arrays obviously must have been +allocated long enough to hold the whole FITS table string. + +Numerical data values are automatically scaled by the TSCALn and TZEROn +keyword values (if they exist). + +In the case of binary tables with vector elements, the 'felem' +parameter defines the starting element (beginning with 1, not 0) within +the cell (a cell is defined as the intersection of a row and a column +and may contain a single value or a vector of values). The felem +parameter is ignored when dealing with ASCII tables. Similarly, in the +case of binary tables the 'nelements' parameter specifies the total +number of vector values to be read or written (continuing on subsequent +rows if required) and not the number of table cells. + +>>1 Write elements into an ASCII or binary table column. + The first routine simply writes the array of values to the FITS file + (doing data type conversion if necessary) whereas the second routine + will substitute the appropriate FITS null value for all elements + which are equal to the input value of nulval (note that this + parameter gives the address of nulval, not the null value + itself). For integer columns the FITS null value is defined by the + TNULLn keyword (an error is returned if the keyword doesn't exist). + For floating point columns the special IEEE NaN (Not-a-Number) + value will be written into the FITS file. If a null pointer is + entered for nulval, then the null value is ignored and this routine + behaves the same as the first routine. The second routine must not + be used to write to variable length array columns. The third routine + simply writes undefined pixel values to the column. + \label{ffpcl} \label{ffpcn} \label{ffpclu} +- + int fits_write_col / ffpcl + (fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelements, DTYPE *array, > int *status) + + int fits_write_colnull / ffpcn + (fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelements, DTYPE *array, DTYPE *nulval, + > int *status) + + int fits_write_col_null / ffpclu + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, > int *status) +- +>2 Read elements from an ASCII or binary table column. The data type + parameter specifies the data type of the `nulval' and `array' pointers; + Undefined array elements will be returned with a value = *nullval, + (note that this parameter gives the address of the null value, not the + null value itself) unless nulval = 0 or *nulval = 0, in which case + no checking for undefined pixels will be performed. The second + routine is similar except that any undefined pixels will have the + corresponding nullarray element set equal to TRUE (= 1). + + Any column, regardless of it's intrinsic data type, may be read as a + string. It should be noted however that reading a numeric column + as a string is 10 - 100 times slower than reading the same column + as a number due to the large overhead in constructing the formatted + strings. The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + data type of the column. The length of the returned strings (not + including the null terminating character) can be determined with + the fits\_get\_col\_display\_width routine. The following TDISPn + display formats are currently supported: +- + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +- + where w is the width in characters of the displayed values, m is the minimum + number of digits displayed, and d is the number of digits to the right of the + decimal. The .m field is optional. +> \label{ffgcv} \label{ffgcf} +- + int fits_read_col / ffgcv + (fitsfile *fptr, int datatype, int colnum, long firstrow, long firstelem, + long nelements, DTYPE *nulval, DTYPE *array, int *anynul, int *status) + + int fits_read_colnull / ffgcf + (fitsfile *fptr, int datatype, int colnum, long firstrow, long firstelem, + long nelements, DTYPE *array, char *nullarray, int *anynul, int *status) +- + +***5. Row Selection and Calculator Routines + +These routines all parse and evaluate an input string containing a user +defined arithmetic expression. The first 3 routines select rows in a +FITS table, based on whether the expression evaluates to true (not +equal to zero) or false (zero). The other routines evaluate the +expression and calculate a value for each row of the table. The +allowed expression syntax is described in the row filter section in the +`Extended File Name Syntax' chapter of this document. The expression +may also be written to a text file, and the name of the file, prepended +with a '@' character may be supplied for the 'expr' parameter (e.g. +'@filename.txt'). The expression in the file can be arbitrarily +complex and extend over multiple lines of the file. Lines that begin +with 2 slash characters ('//') will be ignored and may be used to add +comments to the file. + +>1 Evaluate a boolean expression over the indicated rows, returning an +> array of flags indicating which rows evaluated to TRUE/FALSE \label{fffrow} +- + int fits_find_rows / fffrow + (fitsfile *fptr, char *expr, long firstrow, long nrows, + > long *n_good_rows, char *row_status, int *status) +- +>>2 Find the first row which satisfies the input boolean expression \label{ffffrw} +- + int fits_find_first_row / ffffrw + (fitsfile *fptr, char *expr, > long *rownum, int *status) +- +>3 Evaluate an expression on all rows of a table. If the input and output +files are not the same, copy the TRUE rows to the output file. If the +>files are the same, delete the FALSE rows (preserve the TRUE rows). \label{ffsrow} +- + int fits_select_rows / ffsrow + (fitsfile *infptr, fitsfile *outfptr, char *expr, > int *status ) +- +>4 Calculate an expression for the indicated rows of a table, returning +the results, cast as datatype (TSHORT, TDOUBLE, etc), in array. If +nulval==NULL, UNDEFs will be zeroed out. For vector results, the number +of elements returned may be less than nelements if nelements is not an +even multiple of the result dimension. Call fits\_test\_expr to obtain +>the dimensions of the results. \label{ffcrow} +- + int fits_calc_rows / ffcrow + (fitsfile *fptr, int datatype, char *expr, long firstrow, + long nelements, void *nulval, > void *array, int *anynul, int *status) +- +>5 Evaluate an expression and write the result either to a column (if +the expression is a function of other columns in the table) or to a +keyword (if the expression evaluates to a constant and is not a +function of other columns in the table). In the former case, the +parName parameter is the name of the column (which may or may not already +exist) into which to write the results, and parInfo contains an +optional TFORM keyword value if a new column is being created. If a +TFORM value is not specified then a default format will be used, +depending on the expression. If the expression evaluates to a constant, +then the result will be written to the keyword name given by the +parName parameter, and the parInfo parameter may be used to supply an +optional comment for the keyword. If the keyword does not already +exist, then the name of the keyword must be preceded with a '\#' character, +otherwise the result will be written to a column with that name. +> \label{ffcalc} +- + int fits_calculator / ffcalc + (fitsfile *infptr, char *expr, fitsfile *outfptr, char *parName, + char *parInfo, > int *status) +- +>6 This calculator routine is similar to the previous routine, except +that the expression is only evaluated over the specified +row ranges. nranges specifies the number of row ranges, and firstrow +and lastrow give the starting and ending row number of each range. +> \label{ffcalcrng} +- + int fits_calculator_rng / ffcalc_rng + (fitsfile *infptr, char *expr, fitsfile *outfptr, char *parName, + char *parInfo, int nranges, long *firstrow, long *lastrow + > int *status) +- + +>>7 Evaluate the given expression and return information on the result. \label{fftexp} +- + int fits_test_expr / fftexp + (fitsfile *fptr, char *expr, > int *datatype, long *nelem, int *naxis, + long *naxes, int *status) +- + + +**H. Utility Routines + +***1. File Checksum Routines + +The following routines either compute or validate the checksums for the +CHDU. The DATASUM keyword is used to store the numerical value of the +32-bit, 1's complement checksum for the data unit alone. If there is +no data unit then the value is set to zero. The numerical value is +stored as an ASCII string of digits, enclosed in quotes, because the +value may be too large to represent as a 32-bit signed integer. The +CHECKSUM keyword is used to store the ASCII encoded COMPLEMENT of the +checksum for the entire HDU. Storing the complement, rather than the +actual checksum, forces the checksum for the whole HDU to equal zero. +If the file has been modified since the checksums were computed, then +the HDU checksum will usually not equal zero. These checksum keyword +conventions are based on a paper by Rob Seaman published in the +proceedings of the ADASS IV conference in Baltimore in November 1994 +and a later revision in June 1995. See Appendix B for the definition +of the parameters used in these routines. + +>1 Compute and write the DATASUM and CHECKSUM keyword values for the CHDU + into the current header. If the keywords already exist, their values + will be updated only if necessary (i.e., if the file + has been modified since the original keyword +> values were computed). \label{ffpcks} +- + int fits_write_chksum / ffpcks + (fitsfile *fptr, > int *status) +- +>2 Update the CHECKSUM keyword value in the CHDU, assuming that the + DATASUM keyword exists and already has the correct value. This routine + calculates the new checksum for the current header unit, adds it to the + data unit checksum, encodes the value into an ASCII string, and writes +> the string to the CHECKSUM keyword. \label{ffupck} +- + int fits_update_chksum / ffupck + (fitsfile *fptr, > int *status) +- +>3 Verify the CHDU by computing the checksums and comparing + them with the keywords. The data unit is verified correctly + if the computed checksum equals the value of the DATASUM + keyword. The checksum for the entire HDU (header plus data unit) is + correct if it equals zero. The output DATAOK and HDUOK parameters + in this routine are integers which will have a value = 1 + if the data or HDU is verified correctly, a value = 0 + if the DATASUM or CHECKSUM keyword is not present, or value = -1 +> if the computed checksum is not correct. \label{ffvcks} +- + int fits_verify_chksum / ffvcks + (fitsfile *fptr, > int *dataok, int *hduok, int *status) +- +>4 Compute and return the checksum values for the CHDU + without creating or modifying the + CHECKSUM and DATASUM keywords. This routine is used internally by +> ffvcks, but may be useful in other situations as well. \label{ffgcks} +- + int fits_get_chksum/ /ffgcks + (fitsfile *fptr, > unsigned long *datasum, unsigned long *hdusum, + int *status) +- +>5 Encode a checksum value + into a 16-character string. If complm is non-zero (true) then the 32-bit +> sum value will be complemented before encoding. \label{ffesum} +- + int fits_encode_chksum / ffesum + (unsigned long sum, int complm, > char *ascii); +- +>6 Decode a 16-character checksum string into a unsigned long value. + If is non-zero (true). then the 32-bit sum value will be complemented + after decoding. The checksum value is also returned as the +> value of the function. \label{ffdsum} +- + unsigned long fits_decode_chksum / ffdsum + (char *ascii, int complm, > unsigned long *sum); +- + +***2. Date and Time Utility Routines + +The following routines help to construct or parse the FITS date/time +strings. Starting in the year 2000, the FITS DATE keyword values (and +the values of other `DATE-' keywords) must have the form 'YYYY-MM-DD' +(date only) or 'YYYY-MM-DDThh:mm:ss.ddd...' (date and time) where the +number of decimal places in the seconds value is optional. These times +are in UTC. The older 'dd/mm/yy' date format may not be used for dates +after 01 January 2000. See Appendix B for the definition of the +parameters used in these routines. + +>1 Get the current system date. C already provides standard + library routines for getting the current date and time, + but this routine is provided for compatibility with + the Fortran FITSIO library. The returned year has 4 digits +> (1999, 2000, etc.) \label{ffgsdt} +- + int fits_get_system_date/ffgsdt + ( > int *day, int *month, int *year, int *status ) +- + +>2 Get the current system date and time string ('YYYY-MM-DDThh:mm:ss'). +The time will be in UTC/GMT if available, as indicated by a returned timeref +value = 0. If the returned value of timeref = 1 then this indicates that +it was not possible to convert the local time to UTC, and thus the local +>time was returned. +- + int fits_get_system_time/ffgstm + (> char *datestr, int *timeref, int *status) +- + +>3 Construct a date string from the input date values. If the year +is between 1900 and 1998, inclusive, then the returned date string will +have the old FITS format ('dd/mm/yy'), otherwise the date string will +have the new FITS format ('YYYY-MM-DD'). Use fits\_time2str instead +> to always return a date string using the new FITS format. \label{ffdt2s} +- + int fits_date2str/ffdt2s + (int year, int month, int day, > char *datestr, int *status) +- + +>4 Construct a new-format date + time string ('YYYY-MM-DDThh:mm:ss.ddd...'). + If the year, month, and day values all = 0 then only the time is encoded + with format 'hh:mm:ss.ddd...'. The decimals parameter specifies how many + decimal places of fractional seconds to include in the string. If `decimals' +> is negative, then only the date will be return ('YYYY-MM-DD'). +- + int fits_time2str/fftm2s + (int year, int month, int day, int hour, int minute, double second, + int decimals, > char *datestr, int *status) +- + +>5 Return the date as read from the input string, where the string may be +in either the old ('dd/mm/yy') or new ('YYYY-MM-DDThh:mm:ss' or +'YYYY-MM-DD') FITS format. Null pointers may be supplied for any +> unwanted output date parameters. +- + int fits_str2date/ffs2dt + (char *datestr, > int *year, int *month, int *day, int *status) +- + +>6 Return the date and time as read from the input string, where the +string may be in either the old or new FITS format. The returned hours, +minutes, and seconds values will be set to zero if the input string +does not include the time ('dd/mm/yy' or 'YYYY-MM-DD') . Similarly, +the returned year, month, and date values will be set to zero if the +date is not included in the input string ('hh:mm:ss.ddd...'). Null +pointers may be supplied for any unwanted output date and time +>parameters. +- + int fits_str2time/ffs2tm + (char *datestr, > int *year, int *month, int *day, int *hour, + int *minute, double *second, int *status) +- + +***3. General Utility Routines + +The following utility routines may be useful for certain applications. + +>1 Return the revision number of the CFITSIO library. + The revision number will be incremented with each new +> release of CFITSIO. \label{ffvers} +- + float fits_get_version / ffvers ( > float *version) +- +>2 Write an 80-character message to the CFITSIO error stack. Application + programs should not normally write to the stack, but there may be +> some situations where this is desirable. \label{ffpmsg} +- + void fits_write_errmsg / ffpmsg (char *err_msg) +- +>>3 Convert a character string to uppercase (operates in place). \label{ffupch} +- + void fits_uppercase / ffupch (char *string) +- +>4 Compare the input template string against the reference string + to see if they match. The template string may contain wildcard + characters: '*' will match any sequence of characters (including + zero characters) and '\%' will match any single character in the + reference string. If casesen = CASESEN = TRUE then the match will be + case sensitive, otherwise the case of the letters will be ignored + if casesen = CASEINSEN = FALSE. The returned MATCH parameter will be + TRUE if the 2 strings match, and EXACT will be TRUE if the match is + exact (i.e., if no wildcard characters were used in the match). +> Both strings must be 68 characters or less in length. \label{ffcmps} +- + void fits_compare_str / ffcmps + (char *templt, char *string, int casesen, > int *match, int *exact) +- +>5 Split a string containing a list of names (typically file names or column + names) into individual name tokens by a sequence of calls to + fits\_split\_names. The names in the list must be delimited by a comma + and/or spaces. This routine ignores spaces and commas that occur + within parentheses, brackets, or curly brackets. It also strips any + leading and trailing blanks from the returned name. + + This routine is similar to the ANSI C 'strtok' function: + + The first call to fits\_split\_names has a non-null input string. + It finds the first name in the string and terminates it by overwriting + the next character of the string with a null terminator and returns a + pointer to the name. Each subsequent call, indicated by a NULL value + of the input string, returns the next name, searching from just past + the end of the previous name. It returns NULL when no further names +> are found. \label{splitnames} +- + char *fits_split_names(char *namelist) +- + The following example shows how a string would be split into 3 names: +- + myfile[1][bin (x,y)=4], file2.fits file3.fits + ^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^ ^^^^^^^^^^ + 1st name 2nd name 3rd name +- +>6 Test that the keyword name contains only legal characters (A-Z,0-9, + hyphen, and underscore) or that the keyword record contains only legal +> printable ASCII characters \label{fftkey} \label{fftrec} +- + int fits_test_keyword / fftkey (char *keyname, > int *status) + + int fits_test_record / fftrec (char *card, > int *status) +- +>7 Test whether the current header contains any NULL (ASCII 0) characters. + These characters are illegal in the header, but they will go undetected + by most of the CFITSIO keyword header routines, because the null is + interpreted as the normal end-of-string terminator. This routine returns + the position of the first null character in the header, or zero if there + are no nulls. For example a returned value of 110 would indicate that + the first NULL is located in the 30th character of the second keyword + in the header (recall that each header record is 80 characters long). + Note that this is one of the few CFITSIO routines in which the returned + value is not necessarily equal to the status value). +> \label{ffnchk} +- + int fits_null_check / ffnchk (char *card, > int *status) +- +>8 Parse a header keyword record and return the name of the keyword, + and the length of the name. + The keyword name normally occupies the first 8 characters of the + record, except under the HIERARCH convention where the name can +> be up to 70 characters in length. \label{ffgknm} +- + int fits_get_keyname / ffgknm + (char *card, > char *keyname, int *keylength, int *status) +- +>9 Parse a header keyword record, returning the value (as + a literal character string) and comment strings. If the keyword has no + value (columns 9-10 not equal to '= '), then a null value string is + returned and the comment string is set equal to column 9 - 80 of the +> input string. \label{ffpsvc} +- + int fits_parse_value / ffpsvc + (char *card, > char *value, char *comment, int *status) +- +>10 Construct an array indexed keyword name (ROOT + nnn). + This routine appends the sequence number to the root string to create +> a keyword name (e.g., 'NAXIS' + 2 = 'NAXIS2') \label{ffkeyn} +- + int fits_make_keyn / ffkeyn + (char *keyroot, int value, > char *keyname, int *status) +- +>11 Construct a sequence keyword name (n + ROOT). + This routine concatenates the sequence number to the front of the +> root string to create a keyword name (e.g., 1 + 'CTYP' = '1CTYP') \label{ffnkey} +- + int fits_make_nkey / ffnkey + (int value, char *keyroot, > char *keyname, int *status) +- +>12 Determine the data type of a keyword value string. This routine + parses the keyword value string to determine its data type. + Returns 'C', 'L', 'I', 'F' or 'X', for character string, logical, +> integer, floating point, or complex, respectively. \label{ffdtyp} +- + int fits_get_keytype / ffdtyp + (char *value, > char *dtype, int *status) +- +>13 Return the class of an input header record. The record is classified + into one of the following categories (the class values are + defined in fitsio.h). Note that this is one of the few CFITSIO +> routines that does not return a status value. \label{ffgkcl} +- + Class Value Keywords + TYP_STRUC_KEY 10 SIMPLE, BITPIX, NAXIS, NAXISn, EXTEND, BLOCKED, + GROUPS, PCOUNT, GCOUNT, END + XTENSION, TFIELDS, TTYPEn, TBCOLn, TFORMn, THEAP, + and the first 4 COMMENT keywords in the primary array + that define the FITS format. + TYP_CMPRS_KEY 20 The experimental keywords used in the compressed + image format ZIMAGE, ZCMPTYPE, ZNAMEn, ZVALn, + ZTILEn, ZBITPIX, ZNAXISn, ZSCALE, ZZERO, ZBLANK + TYP_SCAL_KEY 30 BSCALE, BZERO, TSCALn, TZEROn + TYP_NULL_KEY 40 BLANK, TNULLn + TYP_DIM_KEY 50 TDIMn + TYP_RANG_KEY 60 TLMINn, TLMAXn, TDMINn, TDMAXn, DATAMIN, DATAMAX + TYP_UNIT_KEY 70 BUNIT, TUNITn + TYP_DISP_KEY 80 TDISPn + TYP_HDUID_KEY 90 EXTNAME, EXTVER, EXTLEVEL, HDUNAME, HDUVER, HDULEVEL + TYP_CKSUM_KEY 100 CHECKSUM, DATASUM + TYP_WCS_KEY 110 CTYPEn, CUNITn, CRVALn, CRPIXn, CROTAn, CDELTn + CDj_is, PVj_ms, LONPOLEs, LATPOLEs + TCTYPn, TCTYns, TCUNIn, TCUNns, TCRVLn, TCRVns, TCRPXn, + TCRPks, TCDn_k, TCn_ks, TPVn_m, TPn_ms, TCDLTn, TCROTn + jCTYPn, jCTYns, jCUNIn, jCUNns, jCRVLn, jCRVns, iCRPXn, + iCRPns, jiCDn, jiCDns, jPVn_m, jPn_ms, jCDLTn, jCROTn + (i,j,m,n are integers, s is any letter) + TYP_REFSYS_KEY 120 EQUINOXs, EPOCH, MJD-OBSs, RADECSYS, RADESYSs + TYP_COMM_KEY 130 COMMENT, HISTORY, (blank keyword) + TYP_CONT_KEY 140 CONTINUE + TYP_USER_KEY 150 all other keywords + + int fits_get_keyclass / ffgkcl (char *card) +- +>14 Parse the 'TFORM' binary table column format string. + This routine parses the input TFORM character string and returns the + integer data type code, the repeat count of the field, and, in the case + of character string fields, the length of the unit string. See Appendix + B for the allowed values for the returned typecode parameter. A +> null pointer may be given for any output parameters that are not needed. \label{ffbnfm} +- + int fits_binary_tform / ffbnfm + (char *tform, > int *typecode, long *repeat, long *width, + int *status) +- +>15 Parse the 'TFORM' keyword value that defines the column format in + an ASCII table. This routine parses the input TFORM character + string and returns the data type code, the width of the column, + and (if it is a floating point column) the number of decimal places + to the right of the decimal point. The returned data type codes are + the same as for the binary table, with the following + additional rules: integer columns that are between 1 and 4 characters + wide are defined to be short integers (code = TSHORT). Wider integer + columns are defined to be regular integers (code = TLONG). Similarly, + Fixed decimal point columns (with TFORM = 'Fw.d') are defined to + be single precision reals (code = TFLOAT) if w is between 1 and 7 characters + wide, inclusive. Wider 'F' columns will return a double precision + data code (= TDOUBLE). 'Ew.d' format columns will have datacode = TFLOAT, + and 'Dw.d' format columns will have datacode = TDOUBLE. A null +> pointer may be given for any output parameters that are not needed. \label{ffasfm} +- + int fits_ascii_tform / ffasfm + (char *tform, > int *typecode, long *width, int *decimals, + int *status) +- +>16 Calculate the starting column positions and total ASCII table width + based on the input array of ASCII table TFORM values. The SPACE input + parameter defines how many blank spaces to leave between each column + (it is recommended to have one space between columns for better human +> readability). \label{ffgabc} +- + int fits_get_tbcol / ffgabc + (int tfields, char **tform, int space, > long *rowlen, + long *tbcol, int *status) +- +>17 Parse a template header record and return a formatted 80-character string + suitable for appending to (or deleting from) a FITS header file. + This routine is useful for parsing lines from an ASCII template file + and reformatting them into legal FITS header records. The formatted + string may then be passed to the fits\_write\_record, ffmcrd, or + fits\_delete\_key routines +> to append or modify a FITS header record. \label{ffgthd} +- + int fits_parse_template / ffgthd + (char *templt, > char *card, int *keytype, int *status) +- + The input templt character string generally should contain 3 tokens: + (1) the KEYNAME, (2) the VALUE, and (3) the COMMENT string. The + TEMPLATE string must adhere to the following format: + +>- The KEYNAME token must begin in columns 1-8 and be a maximum of 8 + characters long. A legal FITS keyword name may only + contain the characters A-Z, 0-9, and '-' (minus sign) and + underscore. This routine will automatically convert any lowercase + characters to uppercase in the output string. If the first 8 characters + of the template line are + blank then the remainder of the line is considered to be a FITS comment +> (with a blank keyword name). + +>- The VALUE token must be separated from the KEYNAME token by one or more + spaces and/or an '=' character. The data type of the VALUE token + (numeric, logical, or character string) is automatically determined + and the output CARD string is formatted accordingly. The value + token may be forced to be interpreted as a string (e.g. if it is a +> string of numeric digits) by enclosing it in single quotes. + +>- The COMMENT token is optional, but if present must be separated from +> the VALUE token by at least one blank space and a '/' character. + +>- One exception to the above rules is that if the first non-blank + character in the first 8 characters of the template string is a + minus sign ('-') followed + by a single token, or a single token followed by an equal sign, + then it is interpreted as the name of a keyword which is to be +> deleted from the FITS header. + +>- The second exception is that if the template string starts with + a minus sign and is followed by 2 tokens (without an equals sign between + them) then the second token + is interpreted as the new name for the keyword specified by + first token. In this case the old keyword name (first token) + is returned in characters 1-8 of the returned CARD string, and + the new keyword name (the second token) is returned in characters + 41-48 of the returned CARD string. These old and new names + may then be passed to the ffmnam routine which will change +> the keyword name. + + The keytype output parameter indicates how the returned CARD string + should be interpreted: +- + keytype interpretation + ------- ------------------------------------------------- + -2 Rename the keyword with name = the first 8 characters of CARD + to the new name given in characters 41 - 48 of CARD. + + -1 delete the keyword with this name from the FITS header. + + 0 append the CARD string to the FITS header if the + keyword does not already exist, otherwise update + the keyword value and/or comment field if is already exists. + + 1 This is a HISTORY or COMMENT keyword; append it to the header + + 2 END record; do not explicitly write it to the FITS file. +- + EXAMPLES: The following lines illustrate valid input template strings: +- + INTVAL 7 / This is an integer keyword + RVAL 34.6 / This is a floating point keyword + EVAL=-12.45E-03 / This is a floating point keyword in exponential notation + lval F / This is a boolean keyword + This is a comment keyword with a blank keyword name + SVAL1 = 'Hello world' / this is a string keyword + SVAL2 '123.5' this is also a string keyword + sval3 123+ / this is also a string keyword with the value '123+ ' + # the following template line deletes the DATE keyword + - DATE + # the following template line modifies the NAME keyword to OBJECT + - NAME OBJECT +- +>18 Parse the input string containing a list of rows or row ranges, and + return integer arrays containing the first and last row in each + range. For example, if rowlist = "3-5, 6, 8-9" then it will + return numranges = 3, rangemin = 3, 6, 8 and rangemax = 5, 6, 9. + At most, 'maxranges' number of ranges will be returned. 'maxrows' + is the maximum number of rows in the table; any rows or ranges + larger than this will be ignored. The rows must be specified in + increasing order, and the ranges must not overlap. A minus sign + may be use to specify all the rows to the upper or lower bound, so + "50-" means all the rows from 50 to the end of the table, and "-" + means all the rows in the table, from 1 - maxrows. +> \label{ffrwrg} +- + int fits_parse_range / ffrwrg(char *rowlist, long maxrows, int maxranges, > + int *numranges, long *rangemin, long *rangemax, int *status) +- +>19 Check that the Header fill bytes (if any) are all blank. These are the bytes + that may follow END keyword and before the beginning of data unit, + or the end of the HDU if there is no data unit. +> \label{ffchfl} +- + int ffchfl(fitsfile *fptr, > int *status) +- +>20 Check that the Data fill bytes (if any) are all zero (for IMAGE or + BINARY Table HDU) or all blanks (for ASCII table HDU). These file + bytes may be located after the last valid data byte in the HDU and + before the physical end of the HDU. +> \label{ffcdfl} +- + int ffcdfl(fitsfile *fptr, > int *status) +- + +*VII. The CFITSIO Iterator Function + +The fits\_iterate\_data function in CFITSIO provides a unique method of +executing an arbitrary user-supplied `work' function that operates on +rows of data in FITS tables or on pixels in FITS images. Rather than +explicitly reading and writing the FITS images or columns of data, one +instead calls the CFITSIO iterator routine, passing to it the name of +the user's work function that is to be executed along with a list of +all the table columns or image arrays that are to be passed to the work +function. The CFITSIO iterator function then does all the work of +allocating memory for the arrays, reading the input data from the FITS +file, passing them to the work function, and then writing any output +data back to the FITS file after the work function exits. Because +it is often more efficient to process only a subset of the total table +rows at one time, the iterator function can determine the optimum +amount of data to pass in each iteration and repeatly call the work +function until the entire table been processed. + +For many applications this single CFITSIO iterator function can +effectively replace all the other CFITSIO routines for reading or +writing data in FITS images or tables. Using the iterator has several +important advantages over the traditional method of reading and writing +FITS data files: + +\begin{itemize} +\item +It cleanly separates the data I/O from the routine that operates on +the data. This leads to a more modular and `object oriented' +programming style. + +\item +It simplifies the application program by eliminating the need to allocate +memory for the data arrays and eliminates most of the calls to the CFITSIO +routines that explicitly read and write the data. + +\item +It ensures that the data are processed as efficiently as possible. +This is especially important when processing tabular data since +the iterator function will calculate the most efficient number +of rows in the table to be passed at one time to the user's work +function on each iteration. + +\item +Makes it possible for larger projects to develop a library of work +functions that all have a uniform calling sequence and are all +independent of the details of the FITS file format. + +\end{itemize} + +There are basically 2 steps in using the CFITSIO iterator function. +The first step is to design the work function itself which must have a +prescribed set of input parameters. One of these parameters is a +structure containing pointers to the arrays of data; the work function +can perform any desired operations on these arrays and does not need to +worry about how the input data were read from the file or how the +output data get written back to the file. + +The second step is to design the driver routine that opens all the +necessary FITS files and initializes the input parameters to the +iterator function. The driver program calls the CFITSIO iterator +function which then reads the data and passes it to the user's work +function. + +The following 2 sections describe these steps in more detail. There +are also several example programs included with the CFITSIO +distribution which illustrate how to use the iterator function. + +**A The Iterator Work Function + +The user-supplied iterator work function must have the following set of +input parameters (the function can be given any desired name): + +- + int user_fn( long totaln, long offset, long firstn, long nvalues, + int narrays, iteratorCol *data, void *userPointer ) +- + +\begin{itemize} + +\item + totaln -- the total number of table rows or image pixels + that will be passed to the work function + during 1 or more iterations. + +\item + offset -- the offset applied to the first table row or image + pixel to be passed to the work function. In other + words, this is the number of rows or pixels that + are skipped over before starting the iterations. If + offset = 0, then all the table rows or image pixels + will be passed to the work function. + +\item + firstn -- the number of the first table row or image pixel + (starting with 1) that is being passed in this + particular call to the work function. + +\item + nvalues -- the number of table rows or image pixels that are + being passed in this particular call to the work + function. nvalues will always be less than or + equal to totaln and will have the same value on + each iteration, except possibly on the last + call which may have a smaller value. + +\item + narrays -- the number of arrays of data that are being passed + to the work function. There is one array for each + image or table column. + +\item + *data -- array of structures, one for each + column or image. Each structure contains a pointer + to the array of data as well as other descriptive + parameters about that array. + +\item + *userPointer -- a user supplied pointer that can be used + to pass ancillary information from the driver function + to the work function. + This pointer is passed to the CFITSIO iterator function + which then passes it on to the + work function without any modification. + It may point to a single number, to an array of values, + to a structure containing an arbitrary set of parameters + of different types, + or it may be a null pointer if it is not needed. + The work function must cast this pointer to the + appropriate data type before using it it. +\end{itemize} + +The totaln, offset, narrays, data, and userPointer parameters are +guaranteed to have the same value on each iteration. Only firstn, +nvalues, and the arrays of data pointed to by the data structures may +change on each iterative call to the work function. + +Note that the iterator treats an image as a long 1-D array of pixels +regardless of it's intrinsic dimensionality. The total number of +pixels is just the product of the size of each dimension, and the order +of the pixels is the same as the order that they are stored in the FITS +file. If the work function needs to know the number and size of the +image dimensions then these parameters can be passed via the +userPointer structure. + +The iteratorCol structure is currently defined as follows: +- +typedef struct /* structure for the iterator function column information */ +{ + /* structure elements required as input to fits_iterate_data: */ + + fitsfile *fptr; /* pointer to the HDU containing the column or image */ + int colnum; /* column number in the table; ignored for images */ + char colname[70]; /* name (TTYPEn) of the column; null for images */ + int datatype; /* output data type (converted if necessary) */ + int iotype; /* type: InputCol, InputOutputCol, or OutputCol */ + + /* output structure elements that may be useful for the work function: */ + + void *array; /* pointer to the array (and the null value) */ + long repeat; /* binary table vector repeat value; set */ + /* equal to 1 for images */ + long tlmin; /* legal minimum data value, if any */ + long tlmax; /* legal maximum data value, if any */ + char unit[70]; /* physical unit string (BUNIT or TUNITn) */ + char tdisp[70]; /* suggested display format; null if none */ + +} iteratorCol; +- + +Instead of directly reading or writing the elements in this structure, +it is recommended that programmers use the access functions that are +provided for this purpose. + +The first five elements in this structure must be initially defined by +the driver routine before calling the iterator routine. The CFITSIO +iterator routine uses this information to determine what column or +array to pass to the work function, and whether the array is to be +input to the work function, output from the work function, or both. +The CFITSIO iterator function fills in the values of the remaining +structure elements before passing it to the work function. + +The array structure element is a pointer to the actual data array and +it must be cast to the correct data type before it is used. The +`repeat' structure element give the number of data values in each row +of the table, so that the total number of data values in the array is +given by repeat * nvalues. In the case of image arrays and ASCII +tables, repeat will always be equal to 1. When the data type is a +character string, the array pointer is actually a pointer to an array +of string pointers (i.e., char **array). The other output structure +elements are provided for convenience in case that information is +needed within the work function. Any other information may be passed +from the driver routine to the work function via the userPointer +parameter. + +Upon completion, the work routine must return an integer status value, +with 0 indicating success and any other value indicating an error which +will cause the iterator function to immediately exit at that point. Return status +values in the range 1 -- 1000 should be avoided since these are +reserved for use by CFITSIO. A return status value of -1 may be used to +force the CFITSIO iterator function to stop at that point and return +control to the driver routine after writing any output arrays to the +FITS file. CFITSIO does not considered this to be an error condition, +so any further processing by the application program will continue normally. + +**B The Iterator Driver Function + +The iterator driver function must open the necessary FITS files and +position them to the correct HDU. It must also initialize the following +parameters in the iteratorCol structure (defined above) for each +column or image before calling the CFITSIO iterator function. +Several `constructor' routines are provided in CFITSIO for this +purpose. + +\begin{itemize} +\item + *fptr -- The fitsfile pointer to the table or image. +\item +colnum -- the number of the column in the table. This value is ignored + in the case of images. If colnum equals 0, then the column name + will be used to identify the column to be passed to the + work function. + +\item +colname -- the name (TTYPEn keyword) of the column. This is + only required if colnum = 0 and is ignored for images. +\item +datatype -- The desired data type of the array to be passed to the + work function. For numerical data the data type does + not need to be the same as the actual data type in the + FITS file, in which case CFITSIO will do the conversion. + Allowed values are: TSTRING, TLOGICAL, TBYTE, TSBYTE, TSHORT, TUSHORT, + TINT, TLONG, TULONG, TFLOAT, TDOUBLE. If the input + value of data type equals 0, then the existing + data type of the column or image will be used without + any conversion. + +\item +iotype -- defines whether the data array is to be input to the + work function (i.e, read from the FITS file), or output + from the work function (i.e., written to the FITS file) or + both. Allowed values are InputCol, OutputCol, or InputOutputCol. + Variable-length array columns are supported as InputCol or + InputOutputCol types, but may not be used for an OutputCol type. +\end{itemize} + +After the driver routine has initialized all these parameters, it +can then call the CFITSIO iterator function: + +- + int fits_iterate_data(int narrays, iteratorCol *data, long offset, + long nPerLoop, int (*workFn)( ), void *userPointer, int *status); +- + +\begin{itemize} +\item + + narrays -- the number of columns or images that are to be passed + to the work function. +\item + *data -- pointer to array of structures containing information + about each column or image. + +\item + offset -- if positive, this number of rows at the + beginning of the table (or pixels in the image) + will be skipped and will not be passed to the work + function. + +\item + nPerLoop - specifies the number of table rows (or number of + image pixels) that are to be passed to the work + function on each iteration. If nPerLoop = 0 + then CFITSIO will calculate the optimum number + for greatest efficiency. + If nPerLoop is negative, then all the rows + or pixels will be passed at one time, and the work + function will only be called once. If any variable + length arrays are being processed, then the nPerLoop + value is ignored, and the iterator will always process + one row of the table at a time. + +\item + *workFn - the name (actually the address) of the work function + that is to be called by fits\_iterate\_data. + +\item + *userPointer - this is a user supplied pointer that can be used + to pass ancillary information from the driver routine + to the work function. It may point to a single number, + an array, or to a structure containing an arbitrary set + of parameters. + +\item + *status - The CFITSIO error status. Should = 0 on input; + a non-zero output value indicates an error. +\end{itemize} + +When fits\_iterate\_data is called it first allocates memory to hold +all the requested columns of data or image pixel arrays. It then reads +the input data from the FITS tables or images into the arrays then +passes the structure with pointers to these data arrays to the work +function. After the work function returns, the iterator function +writes any output columns of data or images back to the FITS files. It +then repeats this process for any remaining sets of rows or image +pixels until it has processed the entire table or image or until the +work function returns a non-zero status value. The iterator then frees +the memory that it initially allocated and returns control to the +driver routine that called it. + +**C. Guidelines for Using the Iterator Function + +The totaln, offset, firstn, and nvalues parameters that are passed to +the work function are useful for determining how much of the data has +been processed and how much remains left to do. On the very first call +to the work function firstn will be equal to offset + 1; the work +function may need to perform various initialization tasks before +starting to process the data. Similarly, firstn + nvalues - 1 will be +equal to totaln on the last iteration, at which point the work function +may need to perform some clean up operations before exiting for the +last time. The work function can also force an early termination of +the iterations by returning a status value = -1. + +The narrays and iteratorCol.datatype arguments allow the work function +to double check that the number of input arrays and their data types +have the expected values. The iteratorCol.fptr and iteratorCol.colnum +structure elements can be used if the work function needs to read or +write the values of other keywords in the FITS file associated with +the array. This should generally only be done during the +initialization step or during the clean up step after the last set of +data has been processed. Extra FITS file I/O during the main +processing loop of the work function can seriously degrade the speed of +the program. + +If variable-length array columns are being processed, then the iterator +will operate on one row of the table at a time. In this case the +the repeat element in the interatorCol structure will be set equal to +the number of elements in the current row that is being processed. + +One important feature of the iterator is that the first element in each +array that is passed to the work function gives the value that is used +to represent null or undefined values in the array. The real data then +begins with the second element of the array (i.e., array[1], not +array[0]). If the first array element is equal to zero, then this +indicates that all the array elements have defined values and there are +no undefined values. If array[0] is not equal to zero, then this +indicates that some of the data values are undefined and this value +(array[0]) is used to represent them. In the case of output arrays +(i.e., those arrays that will be written back to the FITS file by the +iterator function after the work function exits) the work function must +set the first array element to the desired null value if necessary, +otherwise the first element should be set to zero to indicate that +there are no null values in the output array. CFITSIO defines 2 +values, FLOATNULLVALUE and DOUBLENULLVALUE, that can be used as default +null values for float and double data types, respectively. In the case +of character string data types, a null string is always used to +represent undefined strings. + +In some applications it may be necessary to recursively call the iterator +function. An example of this is given by one of the example programs +that is distributed with CFITSIO: it first calls a work function that +writes out a 2D histogram image. That work function in turn calls +another work function that reads the `X' and `Y' columns in a table to +calculate the value of each 2D histogram image pixel. Graphically, the +program structure can be described as: +- + driver --> iterator --> work1_fn --> iterator --> work2_fn +- + +Finally, it should be noted that the table columns or image arrays that +are passed to the work function do not all have to come from the same +FITS file and instead may come from any combination of sources as long +as they have the same length. The length of the first table column or +image array is used by the iterator if they do not all have the same +length. + +**D. Complete List of Iterator Routines + +All of the iterator routines are listed below. Most of these routines +do not have a corresponding short function name. + +>1 Iterator `constructor' functions that set + the value of elements in the iteratorCol structure + that define the columns or arrays. These set the fitsfile + pointer, column name, column number, datatype, and iotype, + respectively. The last 2 routines allow all the parameters + to be set with one function call (one supplies the column +> name, the other the column number). \label{ffiterset} + +- + int fits_iter_set_file(iteratorCol *col, fitsfile *fptr); + + int fits_iter_set_colname(iteratorCol *col, char *colname); + + int fits_iter_set_colnum(iteratorCol *col, int colnum); + + int fits_iter_set_datatype(iteratorCol *col, int datatype); + + int fits_iter_set_iotype(iteratorCol *col, int iotype); + + int fits_iter_set_by_name(iteratorCol *col, fitsfile *fptr, + char *colname, int datatype, int iotype); + + int fits_iter_set_by_num(iteratorCol *col, fitsfile *fptr, + int colnum, int datatype, int iotype); +- +>2 Iterator `accessor' functions that return the value of the + element in the iteratorCol structure +> that describes a particular data column or array \label{ffiterget} +- + fitsfile * fits_iter_get_file(iteratorCol *col); + + char * fits_iter_get_colname(iteratorCol *col); + + int fits_iter_get_colnum(iteratorCol *col); + + int fits_iter_get_datatype(iteratorCol *col); + + int fits_iter_get_iotype(iteratorCol *col); + + void * fits_iter_get_array(iteratorCol *col); + + long fits_iter_get_tlmin(iteratorCol *col); + + long fits_iter_get_tlmax(iteratorCol *col); + + long fits_iter_get_repeat(iteratorCol *col); + + char * fits_iter_get_tunit(iteratorCol *col); + + char * fits_iter_get_tdisp(iteratorCol *col); +- +>>3 The CFITSIO iterator function \label{ffiter} +- + int fits_iterate_data(int narrays, iteratorCol *data, long offset, + long nPerLoop, + int (*workFn)( long totaln, long offset, long firstn, + long nvalues, int narrays, iteratorCol *data, + void *userPointer), + void *userPointer, + int *status); +- + +*IX. Celestial Coordinate System Routines + +The FITS community has adopted a set of keyword conventions that define +the transformations needed to convert between pixel locations in an +image and the corresponding celestial coordinates on the sky, or more +generally, that define world coordinates that are to be associated with +any pixel location in an n-dimensional FITS array. CFITSIO is distributed +with a couple of self-contained World Coordinate System (WCS) routines, +however, these routines DO NOT support all the latest WCS conventions, +so it is STRONGLY RECOMMENDED that software developers use a more robust +external WCS library. Several recommended libraries are: + +- + WCSLIB - supported by Mark Calabretta + WCSTools - supported by Doug Mink + AST library - developed by the U.K. Starlink project +- + +More information about the WCS keyword conventions and links to all of +these WCS libraries can be found on the FITS Support Office web site at +http://fits.gsfc.nasa.gov under the WCS link. + +The functions provided in these external WCS libraries will need +access to the WCS information contained in the FITS file headers. +One convenient way to pass this information to the extermal library is +to use the fits\_hdr2str routine in CFITSIO (defined below) to copy the +header keywords into one long string, and then pass this string to an +interface routine in the external library that will extract +the necessary WCS information (e.g., see the astFitsChan and astPutCards +routines in the Starlink AST library). + +>1 Concatenate the header keywords in the CHDU into a single long + string of characters. Each 80-character fixed-length keyword + record is appended to the output character string, in order, with + no intervening separator or terminating characters. The last header + record is terminated with a NULL character. This routine allocates + memory for the returned character array, so the calling program must + free the memory when finished. + + Selected keywords may be excluded from the returned character string. + If the second parameter (nocomments) is TRUE (nonzero) then any + COMMENT, HISTORY, or blank keywords in the header will not be copied + to the output string. + + The 'exclist' parameter may be used to supply a list of keywords + that are to be excluded from the output character string. Wild card + characters (*, ?, and \#) may be used in the excluded keyword names. + If no additional keywords are to be excluded, then set nexc = 0 and +> specify NULL for the the **header parameter. \label{hdr2str} +- + int fits_hdr2str + (fitsfile *fptr, int nocomments, char **exclist, int nexc, + > char **header, int *nkeys, int *status) +- + +**A. Self-contained WCS Routines + +The following routines DO NOT support the more recent WCS conventions +that have been approved as part of the FITS standard. Consequently, +the following routines ARE NOW DEPRECATED. It is STRONGLY RECOMMENDED +that software developers not use these routines, and instead use an +external WCS library, as described in the previous section. + +These routines are included mainly for backward compatibility with +existing software. They support the following standard map +projections: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, and -AIT (these are the +legal values for the coordtype parameter). These routines are based +on similar functions in Classic AIPS. All the angular quantities are +given in units of degrees. + +>1 Get the values of the basic set of standard FITS celestial coordinate + system keywords from the header of a FITS image (i.e., the primary + array or an IMAGE extension). These values may then be passed to + the fits\_pix\_to\_world and fits\_world\_to\_pix routines that + perform the coordinate transformations. If any or all of the WCS + keywords are not present, then default values will be returned. If + the first coordinate axis is the declination-like coordinate, then + this routine will swap them so that the longitudinal-like coordinate + is returned as the first axis. + + If the file uses the newer 'CDj\_i' WCS transformation matrix + keywords instead of old style 'CDELTn' and 'CROTA2' keywords, then + this routine will calculate and return the values of the equivalent + old-style keywords. Note that the conversion from the new-style + keywords to the old-style values is sometimes only an + approximation, so if the approximation is larger than an internally + defined threshold level, then CFITSIO will still return the + approximate WCS keyword values, but will also return with status = + APPROX\_WCS\_KEY, to warn the calling program that approximations + have been made. It is then up to the calling program to decide + whether the approximations are sufficiently accurate for the + particular application, or whether more precise WCS transformations +> must be performed using new-style WCS keywords directly. \label{ffgics} +- + int fits_read_img_coord / ffgics + (fitsfile *fptr, > double *xrefval, double *yrefval, + double *xrefpix, double *yrefpix, double *xinc, double *yinc, + double *rot, char *coordtype, int *status) +- +>2 Get the values of the standard FITS celestial coordinate system + keywords from the header of a FITS table where the X and Y (or RA + and DEC) coordinates are stored in 2 separate columns of the table + (as in the Event List table format that is often used by high energy + astrophysics missions). These values may then be passed to the + fits\_pix\_to\_world and fits\_world\_to\_pix routines that perform +> the coordinate transformations. \label{ffgtcs} +- + int fits_read_tbl_coord / ffgtcs + (fitsfile *fptr, int xcol, int ycol, > double *xrefval, + double *yrefval, double *xrefpix, double *yrefpix, double *xinc, + double *yinc, double *rot, char *coordtype, int *status) +- +>3 Calculate the celestial coordinate corresponding to the input +> X and Y pixel location in the image. \label{ffwldp} +- + int fits_pix_to_world / ffwldp + (double xpix, double ypix, double xrefval, double yrefval, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *coordtype, > double *xpos, double *ypos, + int *status) +- +>4 Calculate the X and Y pixel location corresponding to the input +> celestial coordinate in the image. \label{ffxypx} +- + int fits_world_to_pix / ffxypx + (double xpos, double ypos, double xrefval, double yrefval, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *coordtype, > double *xpix, double *ypix, + int *status) +- + + +*VIII Hierarchical Grouping Routines + +These functions allow for the creation and manipulation of FITS HDU +Groups, as defined in "A Hierarchical Grouping Convention for FITS" by +Jennings, Pence, Folk and Schlesinger ( http: +//adfwww.gsfc.nasa.gov/other/convert/group.html ). A group is a +collection of HDUs whose association is defined by a {\it grouping +table}. HDUs which are part of a group are referred to as {\it member +HDUs} or simply as {\it members}. Grouping table member HDUs may +themselves be grouping tables, thus allowing for the construction of +open-ended hierarchies of HDUs. + +Grouping tables contain one row for each member HDU. The grouping table +columns provide identification information that allows applications to +reference or "point to" the member HDUs. Member HDUs are expected, but +not required, to contain a set of GRPIDn/GRPLCn keywords in their +headers for each grouping table that they are referenced by. In this +sense, the GRPIDn/GRPLCn keywords "link" the member HDU back to its +Grouping table. Note that a member HDU need not reside in the same FITS +file as its grouping table, and that a given HDU may be referenced by +up to 999 grouping tables simultaneously. + +Grouping tables are implemented as FITS binary tables with up to six +pre-defined column TTYPEn values: 'MEMBER\_XTENSION', 'MEMBER\_NAME', +'MEMBER\_VERSION', 'MEMBER\_POSITION', 'MEMBER\_URI\_TYPE' and 'MEMBER\_LOCATION'. +The first three columns allow member HDUs to be identified by reference to +their XTENSION, EXTNAME and EXTVER keyword values. The fourth column allows +member HDUs to be identified by HDU position within their FITS file. +The last two columns identify the FITS file in which the member HDU resides, +if different from the grouping table FITS file. + +Additional user defined "auxiliary" columns may also be included with any +grouping table. When a grouping table is copied or modified the presence of +auxiliary columns is always taken into account by the grouping support +functions; however, the grouping support functions cannot directly +make use of this data. + +If a grouping table column is defined but the corresponding member HDU +information is unavailable then a null value of the appropriate data type +is inserted in the column field. Integer columns (MEMBER\_POSITION, +MEMBER\_VERSION) are defined with a TNULLn value of zero (0). Character field +columns (MEMBER\_XTENSION, MEMBER\_NAME, MEMBER\_URI\_TYPE, MEMBER\_LOCATION) +utilize an ASCII null character to denote a null field value. + +The grouping support functions belong to two basic categories: those that +work with grouping table HDUs (ffgt**) and those that work with member HDUs +(ffgm**). Two functions, fits\_copy\_group() and fits\_remove\_group(), have the +option to recursively copy/delete entire groups. Care should be taken when +employing these functions in recursive mode as poorly defined groups could +cause unpredictable results. The problem of a grouping table directly or +indirectly referencing itself (thus creating an infinite loop) is protected +against; in fact, neither function will attempt to copy or delete an HDU +twice. + +**A. Grouping Table Routines + +>1 Create (append) a grouping table at the end of the current FITS file + pointed to by fptr. The grpname parameter provides the grouping table + name (GRPNAME keyword value) and may be set to NULL if no group name + is to be specified. The grouptype parameter specifies the desired + structure of the grouping table and may take on the values: + GT\_ID\_ALL\_URI (all columns created), GT\_ID\_REF (ID by reference columns), + GT\_ID\_POS (ID by position columns), GT\_ID\_ALL (ID by reference and + position columns), GT\_ID\_REF\_URI (ID by reference and FITS file URI +> columns), and GT\_ID\_POS\_URI (ID by position and FITS file URI columns). \label{ffgtcr} +- + int fits_create_group / ffgtcr + (fitsfile *fptr, char *grpname, int grouptype, > int *status) +- +>2 Create (insert) a grouping table just after the CHDU of the current FITS + file pointed to by fptr. All HDUs below the the insertion point will be + shifted downwards to make room for the new HDU. The grpname parameter + provides the grouping table name (GRPNAME keyword value) and may be set to + NULL if no group name is to be specified. The grouptype parameter specifies + the desired structure of the grouping table and may take on the values: + GT\_ID\_ALL\_URI (all columns created), GT\_ID\_REF (ID by reference columns), + GT\_ID\_POS (ID by position columns), GT\_ID\_ALL (ID by reference and + position columns), GT\_ID\_REF\_URI (ID by reference and FITS file URI +> columns), and GT\_ID\_POS\_URI (ID by position and FITS file URI columns) \label{ffgtis}. +- + int fits_insert_group / ffgtis + (fitsfile *fptr, char *grpname, int grouptype, > int *status) +- +>3 Change the structure of an existing grouping table pointed to by + gfptr. The grouptype parameter (see fits\_create\_group() for valid + parameter values) specifies the new structure of the grouping table. This + function only adds or removes grouping table columns, it does not add + or delete group members (i.e., table rows). If the grouping table already + has the desired structure then no operations are performed and function + simply returns with a (0) success status code. If the requested structure + change creates new grouping table columns, then the column values for all + existing members will be filled with the null values appropriate to the +> column type. \label{ffgtch} +- + int fits_change_group / ffgtch + (fitsfile *gfptr, int grouptype, > int *status) +- +>4 Remove the group defined by the grouping table pointed to by gfptr, and + optionally all the group member HDUs. The rmopt parameter specifies the + action to be taken for + all members of the group defined by the grouping table. Valid values are: + OPT\_RM\_GPT (delete only the grouping table) and OPT\_RM\_ALL (recursively + delete all HDUs that belong to the group). Any groups containing the + grouping table gfptr as a member are updated, and if rmopt == OPT\_RM\_GPT + all members have their GRPIDn and GRPLCn keywords updated accordingly. + If rmopt == OPT\_RM\_ALL, then other groups that contain the deleted members +> of gfptr are updated to reflect the deletion accordingly. \label{ffgtrm} +- + int fits_remove_group / ffgtrm + (fitsfile *gfptr, int rmopt, > int *status) +- +>5 Copy (append) the group defined by the grouping table pointed to by infptr, + and optionally all group member HDUs, to the FITS file pointed to by + outfptr. The cpopt parameter specifies the action to be taken for all + members of the group infptr. Valid values are: OPT\_GCP\_GPT (copy only + the grouping table) and OPT\_GCP\_ALL (recursively copy ALL the HDUs that + belong to the group defined by infptr). If the cpopt == OPT\_GCP\_GPT then + the members of infptr have their GRPIDn and GRPLCn keywords updated to + reflect the existence of the new grouping table outfptr, since they now + belong to the new group. If cpopt == OPT\_GCP\_ALL then the new + grouping table outfptr only contains pointers to the copied member HDUs + and not the original member HDUs of infptr. Note that, when + cpopt == OPT\_GCP\_ALL, all members of the group defined by infptr will be + copied to a single FITS file pointed to by outfptr regardless of their +> file distribution in the original group. \label{ffgtcp} +- + int fits_copy_group / ffgtcp + (fitsfile *infptr, fitsfile *outfptr, int cpopt, > int *status) +- +>6 Merge the two groups defined by the grouping table HDUs infptr and outfptr + by combining their members into a single grouping table. All member HDUs + (rows) are copied from infptr to outfptr. If mgopt == OPT\_MRG\_COPY then + infptr continues to exist unaltered after the merge. If the mgopt == + OPT\_MRG\_MOV then infptr is deleted after the merge. In both cases, +> the GRPIDn and GRPLCn keywords of the member HDUs are updated accordingly. \label{ffgtmg} +- + int fits_merge_groups / ffgtmg + (fitsfile *infptr, fitsfile *outfptr, int mgopt, > int *status) +- +>7 "Compact" the group defined by grouping table pointed to by gfptr. The + compaction is achieved by merging (via fits\_merge\_groups()) all direct + member HDUs of gfptr that are themselves grouping tables. The cmopt + parameter defines whether the merged grouping table HDUs remain after + merging (cmopt == OPT\_CMT\_MBR) or if they are deleted after merging + (cmopt == OPT\_CMT\_MBR\_DEL). If the grouping table contains no direct + member HDUs that are themselves grouping tables then this function + does nothing. Note that this function is not recursive, i.e., only the +> direct member HDUs of gfptr are considered for merging. \label{ffgtcm} +- + int fits_compact_group / ffgtcm + (fitsfile *gfptr, int cmopt, > int *status) +- +>8 Verify the integrity of the grouping table pointed to by gfptr to make + sure that all group members are accessible and that all links to other + grouping tables are valid. The firstfailed parameter returns the member + ID (row number) of the first member HDU to fail verification (if positive + value) or the first group link to fail (if negative value). If gfptr is +> successfully verified then firstfailed contains a return value of 0. \label{ffgtvf} +- + int fits_verify_group / ffgtvf + (fitsfile *gfptr, > long *firstfailed, int *status) +- +>9 Open a grouping table that contains the member HDU pointed to by mfptr. + The grouping table to open is defined by the grpid parameter, which + contains the keyword index value of the GRPIDn/GRPLCn keyword(s) that + link the member HDU mfptr to the grouping table. If the grouping table + resides in a file other than the member HDUs file then an attempt is + first made to open the file readwrite, and failing that readonly. A + pointer to the opened grouping table HDU is returned in gfptr. + + Note that it is possible, although unlikely and undesirable, for the + GRPIDn/GRPLCn keywords in a member HDU header to be non-continuous, e.g., + GRPID1, GRPID2, GRPID5, GRPID6. In such cases, the grpid index value + specified in the function call shall identify the (grpid)th GRPID value. + In the above example, if grpid == 3, then the group specified by GRPID5 +> would be opened. \label{ffgtop} +- + int fits_open_group / ffgtop + (fitsfile *mfptr, int group, > fitsfile **gfptr, int *status) +- +>10 Add a member HDU to an existing grouping table pointed to by gfptr. + The member HDU may either be pointed to mfptr (which must be positioned + to the member HDU) or, if mfptr == NULL, identified by the hdupos parameter + (the HDU position number, Primary array == 1) if both the grouping table + and the member HDU reside in the same FITS file. The new member HDU shall + have the appropriate GRPIDn and GRPLCn keywords created in its header. + Note that if the member HDU is already a member of the group then it will +> not be added a second time. \label{ffgtam} +- + int fits_add_group_member / ffgtam + (fitsfile *gfptr, fitsfile *mfptr, int hdupos, > int *status) +- + +**B. Group Member Routines + +>1 Return the number of member HDUs in a grouping table gfptr. The number + member HDUs is just the NAXIS2 value (number of rows) of the grouping +> table. \label{ffgtnm} +- + int fits_get_num_members / ffgtnm + (fitsfile *gfptr, > long *nmembers, int *status) +- +>2 Return the number of groups to which the HDU pointed to by mfptr is + linked, as defined by the number of GRPIDn/GRPLCn keyword records that + appear in its header. Note that each time this function is called, the + indices of the GRPIDn/GRPLCn keywords are checked to make sure they + are continuous (ie no gaps) and are re-enumerated to eliminate gaps if +> found. \label{ffgmng} +- + int fits_get_num_groups / ffgmng + (fitsfile *mfptr, > long *nmembers, int *status) +- +>3 Open a member of the grouping table pointed to by gfptr. The member to + open is identified by its row number within the grouping table as given + by the parameter 'member' (first member == 1) . A fitsfile pointer to + the opened member HDU is returned as mfptr. Note that if the member HDU + resides in a FITS file different from the grouping table HDU then the +> member file is first opened readwrite and, failing this, opened readonly. \label{ffgmop} +- + int fits_open_member / ffgmop + (fitsfile *gfptr, long member, > fitsfile **mfptr, int *status) +- +>4 Copy (append) a member HDU of the grouping table pointed to by gfptr. + The member HDU is identified by its row number within the grouping table + as given by the parameter 'member' (first member == 1). The copy of the + group member HDU will be appended to the FITS file pointed to by mfptr, + and upon return mfptr shall point to the copied member HDU. The cpopt + parameter may take on the following values: OPT\_MCP\_ADD which adds a new + entry in gfptr for the copied member HDU, OPT\_MCP\_NADD which does not add + an entry in gfptr for the copied member, and OPT\_MCP\_REPL which replaces +> the original member entry with the copied member entry. \label{ffgmcp} +- + int fits_copy_member / ffgmcp + (fitsfile *gfptr, fitsfile *mfptr, long member, int cpopt, > int *status) +- +>5 Transfer a group member HDU from the grouping table pointed to by + infptr to the grouping table pointed to by outfptr. The member HDU to + transfer is identified by its row number within infptr as specified by + the parameter 'member' (first member == 1). If tfopt == OPT\_MCP\_ADD then + the member HDU is made + a member of outfptr and remains a member of infptr. If tfopt == OPT\_MCP\_MOV +> then the member HDU is deleted from infptr after the transfer to outfptr. \label{ffgmtf} +- + int fits_transfer_member / ffgmtf + (fitsfile *infptr, fitsfile *outfptr, long member, int tfopt, + > int *status) +- +>6 Remove a member HDU from the grouping table pointed to by gfptr. The + member HDU to be deleted is identified by its row number in the grouping + table as specified by the parameter 'member' (first member == 1). The rmopt + parameter may take on the following values: OPT\_RM\_ENTRY which + removes the member HDU entry from the grouping table and updates the + member's GRPIDn/GRPLCn keywords, and OPT\_RM\_MBR which removes the member +> HDU entry from the grouping table and deletes the member HDU itself. \label{ffgmrm} +- + int fits_remove_member / ffgmrm + (fitsfile *fptr, long member, int rmopt, > int *status) +- + +*IX Specialized CFITSIO Interface Routines + +The basic interface routines described previously are recommended +for most uses, but the routines described in this chapter +are also available if necessary. Some of these routines perform more +specialized function that cannot easily be done with the basic +interface routines while others duplicate the functionality of the +basic routines but have a slightly different calling sequence. +See Appendix B for the definition of each function parameter. + +**A. FITS File Access Routines + +>1 Open an existing FITS file residing in core computer memory. This +routine is analogous to fits\_open\_file. The 'filename' is +currently ignored by this routine and may be any arbitrary string. In +general, the application must have preallocated an initial block of +memory to hold the FITS file prior to calling this routine: 'memptr' +points to the starting address and 'memsize' gives the initial size of +the block of memory. 'mem\_realloc' is a pointer to an optional +function that CFITSIO can call to allocate additional memory, if needed +(only if mode = READWRITE), and is modeled after the standard C +'realloc' function; a null pointer may be given if the initial +allocation of memory is all that will be required (e.g., if the file is +opened with mode = READONLY). The 'deltasize' parameter may be used to +suggest a minimum amount of additional memory that should be allocated +during each call to the memory reallocation function. By default, +CFITSIO will reallocate enough additional space to hold the entire +currently defined FITS file (as given by the NAXISn keywords) or 1 FITS +block (= 2880 bytes), which ever is larger. Values of deltasize less +than 2880 will be ignored. Since the memory reallocation operation can +be computationally expensive, allocating a larger initial block of +memory, and/or specifying a larger deltasize value may help to reduce +the number of reallocation calls and make the application program run +> faster. \label{ffomem} +- + int fits_open_memfile / ffomem + (fitsfile **fptr, const char *filename, int mode, void **memptr, + size_t *memsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), int *status) +- +>2 Create a new FITS file residing in core computer memory. This +routine is analogous to fits\_create\_file. In general, the +application must have preallocated an initial block of memory to hold +the FITS file prior to calling this routine: 'memptr' points to the +starting address and 'memsize' gives the initial size of the block of +memory. 'mem\_realloc' is a pointer to an optional function that +CFITSIO can call to allocate additional memory, if needed, and is +modeled after the standard C 'realloc' function; a null pointer may be +given if the initial allocation of memory is all that will be +required. The 'deltasize' parameter may be used to suggest a minimum +amount of additional memory that should be allocated during each call +to the memory reallocation function. By default, CFITSIO will +reallocate enough additional space to hold 1 FITS block (= 2880 bytes) +and values of deltasize less than 2880 will be ignored. Since the +memory reallocation operation can be computationally expensive, +allocating a larger initial block of memory, and/or specifying a larger +deltasize value may help to reduce the number of reallocation calls +and make the application program run +> faster. \label{ffimem} +- + int fits_create_memfile / ffimem + (fitsfile **fptr, void **memptr, + size_t *memsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), int *status) +- +>3 Reopen a FITS file that was previously opened with + fits\_open\_file or fits\_create\_file. The new fitsfile + pointer may then be treated as a separate file, and one may + simultaneously read or write to 2 (or more) different extensions in + the same file. The fits\_open\_file routine (above) automatically + detects cases where a previously opened file is being opened again, + and then internally call fits\_reopen\_file, so programs should rarely + need to explicitly call this routine. +>\label{ffreopen} +- + int fits_reopen_file / ffreopen + (fitsfile *openfptr, fitsfile **newfptr, > int *status) +- + +>4 Create a new FITS file, using a template file to define its + initial size and structure. The template may be another FITS HDU + or an ASCII template file. If the input template file name pointer + is null, then this routine behaves the same as fits\_create\_file. + The currently supported format of the ASCII template file is described + under the fits\_parse\_template routine (in the general Utilities + section) +>\label{fftplt} +- + int fits_create_template / fftplt + (fitsfile **fptr, char *filename, char *tpltfile > int *status) +- + +>5 Parse the input filename or URL into its component parts: the file +type (file://, ftp://, http://, etc), the base input file name, the +name of the output file that the input file is to be copied to prior +to opening, the HDU or extension specification, the filtering +specifier, the binning specifier, and the column specifier. Null +strings will be returned for any components that are not present +> in the input file name. \label{ffiurl} +- + int fits_parse_input_url / ffiurl + (char *filename, > char *filetype, char *infile, char *outfile, char + *extspec, char *filter, char *binspec, char *colspec, int *status) +- +>6 Parse the input filename and return the HDU number that would be +moved to if the file were opened with fits\_open\_file. The returned +HDU number begins with 1 for the primary array, so for example, if the +input filename = `myfile.fits[2]' then hdunum = 3 will be returned. +CFITSIO does not open the file to check if the extension actually +exists if an extension number is specified. If an extension name is +included in the file name specification (e.g. `myfile.fits[EVENTS]' +then this routine will have to open the FITS file and look for the +position of the named extension, then close file again. This is not +possible if the file is being read from the stdin stream, and an error +will be returned in this case. If the filename does not specify an +explicit extension (e.g. 'myfile.fits') then hdunum = -99 will be +returned, which is functionally equivalent to hdunum = 1. This routine +is mainly used for backward compatibility in the ftools software +package and is not recommended for general use. It is generally better +and more efficient to first open the FITS file with fits\_open\_file, +then use fits\_get\_hdu\_num to determine which HDU in the file has +been opened, rather than calling fits\_parse\_input\_url followed by a +call to fits\_open\_file. +> \label{ffextn} +- + int fits_parse_extnum / ffextn + (char *filename, > int *hdunum, int *status) +- +>7 Parse the input file name and return the root file name. The root +name includes the file type if specified, (e.g. 'ftp://' or 'http://') +and the full path name, to the extent that it is specified in the input +filename. It does not include the HDU name or number, or any filtering +specifications. +> \label{ffrtnm} +- + int fits_parse_rootname / ffrtnm + (char *filename, > char *rootname, int *status); +- +>8 Test if the input file or a compressed version of the file (with +a .gz, .Z, .z, or .zip extension) exists on disk. The returned value of +the 'exists' parameter will have 1 of the 4 following values: +- + 2: the file does not exist, but a compressed version does exist + 1: the disk file does exist + 0: neither the file nor a compressed version of the file exist + -1: the input file name is not a disk file (could be a ftp, http, + smem, or mem file, or a file piped in on the STDIN stream) +- + +> \label{ffexist} +- + int fits_file_exists / ffexist + (char *filename, > int *exists, int *status); +- +>9 Flush any internal buffers of data to the output FITS file. These + routines rarely need to be called, but can be useful in cases where + other processes need to access the same FITS file in real time, + either on disk or in memory. These routines also help to ensure + that if the application program subsequently aborts then the FITS + file will have been closed properly. The first routine, + fits\_flush\_file is more rigorous and completely closes, then + reopens, the current HDU, before flushing the internal buffers, thus + ensuring that the output FITS file is identical to what would be + produced if the FITS was closed at that point (i.e., with a call to + fits\_close\_file). The second routine, fits\_flush\_buffer simply + flushes the internal CFITSIO buffers of data to the output FITS + file, without updating and closing the current HDU. This is much + faster, but there may be circumstances where the flushed file does + not completely reflect the final state of the file as it will exist + when the file is actually closed. + + A typical use of these routines would be to flush the state of a + FITS table to disk after each row of the table is written. It is + recommend that fits\_flush\_file be called after the first row is + written, then fits\_flush\_buffer may be called after each + subsequent row is written. Note that this latter routine will not + automatically update the NAXIS2 keyword which records the number of + rows of data in the table, so this keyword must be explicitly + updated by the application program after each row is written. +> \label{ffflus} +- + int fits_flush_file / ffflus + (fitsfile *fptr, > int *status) + + int fits_flush_buffer / ffflsh + (fitsfile *fptr, 0, > int *status) + + (Note: The second argument must be 0). +- + +**B. HDU Access Routines + +>1 Get the byte offsets in the FITS file to the start of the header + and the start and end of the data in the CHDU. The difference + between headstart and dataend equals the size of the CHDU. If the + CHDU is the last HDU in the file, then dataend is also equal to the + size of the entire FITS file. Null pointers may be input for any + of the address parameters if their values are not needed. The + fits\_get\_hduaddr routine is obsolete and should no longer be + used. The newer fits\_get\_hduoff routine uses the 'off\_t' + data type which can support offsets in large files greater than +> 2.1GB in size. \label{ffghad} +- + int fits_get_hduoff / ffghof + (fitsfile *fptr, > off_t *headstart, off_t *datastart, off_t *dataend, + int *status) + + int fits_get_hduaddr / ffghad (OBSOLETE routine) + (fitsfile *fptr, > long *headstart, long *datastart, long *dataend, + int *status) +- +>2 Create (append) a new empty HDU at the end of the FITS file. + This is now the CHDU but it is completely empty and has + no header keywords. It is recommended that fits\_create\_img or +> fits\_create\_tbl be used instead of this routine. \label{ffcrhd} +- + int fits_create_hdu / ffcrhd + (fitsfile *fptr, > int *status) +- +>3 Insert a new IMAGE extension immediately following the CHDU, or + insert a new Primary Array at the beginning of the file. Any + following extensions in the file will be shifted down to make room + for the new extension. If the CHDU is the last HDU in the file + then the new image extension will simply be appended to the end of + the file. One can force a new primary array to be inserted at the + beginning of the FITS file by setting status = PREPEND\_PRIMARY prior + to calling the routine. In this case the old primary array will be + converted to an IMAGE extension. The new extension (or primary + array) will become the CHDU. Refer to Chapter 9 for a list of +> pre-defined bitpix values. \label{ffiimg} +- + int fits_insert_img / ffiimg + (fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) +- +>4 Insert a new ASCII or binary table extension immediately following the CHDU. + Any following extensions will be shifted down to make room for the + new extension. If there are no other following extensions then the + new table extension will simply be appended to the end of the + file. If the FITS file is currently empty then this routine will + create a dummy primary array before appending the table to it. The + new extension will become the CHDU. The tunit and extname + parameters are optional and a null pointer may be given if they are + not defined. When inserting an ASCII table with + fits\_insert\_atbl, a null pointer may given for the *tbcol + parameter in which case each column of the table will be separated + by a single space character. Similarly, if the input value of + rowlen is 0, then CFITSIO will calculate the default rowlength + based on the tbcol and ttype values. When inserting a binary table + with fits\_insert\_btbl, if there are following extensions in the + file and if the table contains variable length array columns then + pcount must specify the expected final size of the data heap, +> otherwise pcount must = 0. \label{ffitab} \label{ffibin} +- + int fits_insert_atbl / ffitab + (fitsfile *fptr, long rowlen, long nrows, int tfields, char *ttype[], + long *tbcol, char *tform[], char *tunit[], char *extname, > int *status) + + int fits_insert_btbl / ffibin + (fitsfile *fptr, long nrows, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, > int *status) +- +>5 Modify the size, dimensions, and/or data type of the current + primary array or image extension. If the new image, as specified + by the input arguments, is larger than the current existing image + in the FITS file then zero fill data will be inserted at the end + of the current image and any following extensions will be moved + further back in the file. Similarly, if the new image is + smaller than the current image then any following extensions + will be shifted up towards the beginning of the FITS file + and the image data will be truncated to the new size. + This routine rewrites the BITPIX, NAXIS, and NAXISn keywords +> with the appropriate values for the new image. \label{ffrsim} +- + int fits_resize_img / ffrsim + (fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) +- +>6 Copy the data (and not the header) from the CHDU associated with infptr + to the CHDU associated with outfptr. This will overwrite any data + previously in the output CHDU. This low level routine is used by + fits\_copy\_hdu, but it may also be useful in certain application programs + that want to copy the data from one FITS file to another but also + want to modify the header keywords. The required FITS header keywords + which define the structure of the HDU must be written to the +> output CHDU before calling this routine. \label{ffcpdt} +- + int fits_copy_data / ffcpdt + (fitsfile *infptr, fitsfile *outfptr, > int *status) +- +>7 This routine forces CFITSIO to rescan the current header keywords that + define the structure of the HDU (such as the NAXIS and BITPIX + keywords) so that it reinitializes the internal buffers that + describe the HDU structure. This routine is useful for + reinitializing the structure of an HDU if any of the required + keywords (e.g., NAXISn) have been modified. In practice it should + rarely be necessary to call this routine because CFITSIO +> internally calls it in most situations. \label{ffrdef} +- + int fits_set_hdustruc / ffrdef + (fitsfile *fptr, > int *status) (DEPRECATED) +- +**C. Specialized Header Keyword Routines + +***1. Header Information Routines + +>1 Reserve space in the CHU for MOREKEYS more header keywords. + This routine may be called to allocate space for additional keywords + at the time the header is created (prior to writing any data). + CFITSIO can dynamically add more space to the header when needed, + however it is more efficient to preallocate the required space +> if the size is known in advance. \label{ffhdef} +- + int fits_set_hdrsize / ffhdef + (fitsfile *fptr, int morekeys, > int *status) +- +>2 Return the number of keywords in the header (not counting the END + keyword) and the current position + in the header. The position is the number of the keyword record that + will be read next (or one greater than the position of the last keyword + that was read). A value of 1 is returned if the pointer is +> positioned at the beginning of the header. \label{ffghps} +- + int fits_get_hdrpos / ffghps + (fitsfile *fptr, > int *keysexist, int *keynum, int *status) +- + +***2. Read and Write the Required Keywords + +>1 Write the primary header or IMAGE extension keywords into the CHU. + The simpler fits\_write\_imghdr routine is equivalent to calling + fits\_write\_grphdr with the default values of simple = TRUE, pcount + = 0, gcount = 1, and extend = TRUE. The PCOUNT, GCOUNT and EXTEND + keywords are not required in the primary header and are only written + if pcount is not equal to zero, gcount is not equal to zero or one, + and if extend is TRUE, respectively. When writing to an IMAGE + extension, the SIMPLE and EXTEND parameters are ignored. It is + recommended that fits\_create\_image or fits\_create\_tbl be used + instead of these routines to write the +> required header keywords. \label{ffphpr} \label{ffphps} +- + int fits_write_imghdr / ffphps + (fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) + + int fits_write_grphdr / ffphpr + (fitsfile *fptr, int simple, int bitpix, int naxis, long *naxes, + long pcount, long gcount, int extend, > int *status) +- +>2 Write the ASCII table header keywords into the CHU. The optional + TUNITn and EXTNAME keywords are written only if the input pointers + are not null. A null pointer may given for the + *tbcol parameter in which case a single space will be inserted + between each column of the table. Similarly, if rowlen is + given = 0, then CFITSIO will calculate the default rowlength based on +> the tbcol and ttype values. \label{ffphtb} +- + int fits_write_atblhdr / ffphtb + (fitsfile *fptr, long rowlen, long nrows, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, char *extname, > int *status) +- +>3 Write the binary table header keywords into the CHU. The optional + TUNITn and EXTNAME keywords are written only if the input pointers + are not null. The pcount parameter, which specifies the + size of the variable length array heap, should initially = 0; + CFITSIO will automatically update the PCOUNT keyword value if any + variable length array data is written to the heap. The TFORM keyword + value for variable length vector columns should have the form 'Pt(len)' + or '1Pt(len)' where `t' is the data type code letter (A,I,J,E,D, etc.) + and `len' is an integer specifying the maximum length of the vectors + in that column (len must be greater than or equal to the longest + vector in the column). If `len' is not specified when the table is + created (e.g., the input TFORMn value is just '1Pt') then CFITSIO will + scan the column when the table is first closed and will append the + maximum length to the TFORM keyword value. Note that if the table + is subsequently modified to increase the maximum length of the vectors + then the modifying program is responsible for also updating the TFORM +> keyword value. \label{ffphbn} +- + int fits_write_btblhdr / ffphbn + (fitsfile *fptr, long nrows, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, > int *status) +- +>4 Read the required keywords from the CHDU (image or table). When + reading from an IMAGE extension the SIMPLE and EXTEND parameters are + ignored. A null pointer may be supplied for any of the returned +> parameters that are not needed. \label{ffghpr} \label{ffghtb} \label{ffghbn} +- + int fits_read_imghdr / ffghpr + (fitsfile *fptr, int maxdim, > int *simple, int *bitpix, int *naxis, + long *naxes, long *pcount, long *gcount, int *extend, int *status) + + int fits_read_atblhdr / ffghtb + (fitsfile *fptr,int maxdim, > long *rowlen, long *nrows, + int *tfields, char **ttype, long *tbcol, char **tform, char **tunit, + char *extname, int *status) + + int fits_read_btblhdr / ffghbn + (fitsfile *fptr, int maxdim, > long *nrows, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + long *pcount, int *status) +- +***3. Write Keyword Routines + +These routines simply append a new keyword to the header and do not +check to see if a keyword with the same name already exists. In +general it is preferable to use the fits\_update\_key routine to ensure +that the same keyword is not written more than once to the header. See +Appendix B for the definition of the parameters used in these +routines. + + +>1 Write (append) a new keyword of the appropriate data type into the CHU. + A null pointer may be entered for the comment parameter, which + will cause the comment field of the keyword to be left blank. The + flt, dbl, cmp, and dblcmp versions of this routine have the added + feature that if the 'decimals' parameter is negative, then the 'G' + display format rather then the 'E' format will be used when + constructing the keyword value, taking the absolute value of + 'decimals' for the precision. This will suppress trailing zeros, + and will use a fixed format rather than an exponential format, +> depending on the magnitude of the value. \label{ffpkyx} +- + int fits_write_key_str / ffpkys + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status) + + int fits_write_key_[log, lng] / ffpky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_write_key_[flt, dbl, fixflg, fixdbl] / ffpky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_write_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffpk[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +- +>2 Write (append) a string valued keyword into the CHU which may be longer + than 68 characters in length. This uses the Long String Keyword + convention that is described in the`Local FITS Conventions' section + in Chapter 4. Since this uses a non-standard FITS convention to + encode the long keyword string, programs which use this routine + should also call the fits\_write\_key\_longwarn routine to add some + COMMENT keywords to warn users of the FITS file that this + convention is being used. The fits\_write\_key\_longwarn routine + also writes a keyword called LONGSTRN to record the version of the + longstring convention that has been used, in case a new convention + is adopted at some point in the future. If the LONGSTRN keyword + is already present in the header, then fits\_write\_key\_longwarn + will +> simply return without doing anything. \label{ffpkls} \label{ffplsw} +- + int fits_write_key_longstr / ffpkls + (fitsfile *fptr, char *keyname, char *longstr, char *comment, + > int *status) + + int fits_write_key_longwarn / ffplsw + (fitsfile *fptr, > int *status) +- +>3 Write (append) a numbered sequence of keywords into the CHU. The + starting index number (nstart) must be greater than 0. One may + append the same comment to every keyword (and eliminate the need + to have an array of identical comment strings, one for each keyword) by + including the ampersand character as the last non-blank character in the + (first) COMMENTS string parameter. This same string + will then be used for the comment field in all the keywords. + One may also enter a null pointer for the comment parameter to +> leave the comment field of the keyword blank. \label{ffpknx} +- + int fits_write_keys_str / ffpkns + (fitsfile *fptr, char *keyroot, int nstart, int nkeys, + char **value, char **comment, > int *status) + + int fits_write_keys_[log, lng] / ffpkn[lj] + (fitsfile *fptr, char *keyroot, int nstart, int nkeys, + DTYPE *numval, char **comment, int *status) + + int fits_write_keys_[flt, dbl, fixflg, fixdbl] / ffpkne[edfg] + (fitsfile *fptr, char *keyroot, int nstart, int nkey, + DTYPE *numval, int decimals, char **comment, > int *status) +- +>4 Copy an indexed keyword from one HDU to another, modifying + the index number of the keyword name in the process. For example, + this routine could read the TLMIN3 keyword from the input HDU + (by giving keyroot = `TLMIN' and innum = 3) and write it to the + output HDU with the keyword name TLMIN4 (by setting outnum = 4). + If the input keyword does not exist, then this routine simply +> returns without indicating an error. \label{ffcpky} +- + int fits_copy_key / ffcpky + (fitsfile *infptr, fitsfile *outfptr, int innum, int outnum, + char *keyroot, > int *status) +- +>5 Write (append) a `triple precision' keyword into the CHU in F28.16 format. + The floating point keyword value is constructed by concatenating the + input integer value with the input double precision fraction value + (which must have a value between 0.0 and 1.0). The ffgkyt routine should + be used to read this keyword value, because the other keyword reading +> routines will not preserve the full precision of the value. \label{ffpkyt} +- + int fits_write_key_triple / ffpkyt + (fitsfile *fptr, char *keyname, long intval, double frac, + char *comment, > int *status) +- +>6 Write keywords to the CHDU that are defined in an ASCII template file. + The format of the template file is described under the fits\_parse\_template +> routine. \label{ffpktp} +- + int fits_write_key_template / ffpktp + (fitsfile *fptr, const char *filename, > int *status) +- +***4. Insert Keyword Routines + +These insert routines are somewhat less efficient than the `update' or +`write' keyword routines because the following keywords in the header +must be shifted down to make room for the inserted keyword. See +Appendix B for the definition of the parameters used in these +routines. + +>1 Insert a new keyword record into the CHU at the specified position + (i.e., immediately preceding the (keynum)th keyword in the header.) +> \label{ffirec} +- + int fits_insert_record / ffirec + (fitsfile *fptr, int keynum, char *card, > int *status) +- +>2 Insert a new keyword into the CHU. The new keyword is inserted + immediately following the last keyword that has been read from the + header. The `longstr' version has the same functionality as the + `str' version except that it also supports the local long string + keyword convention for strings longer than 68 characters. A null + pointer may be entered for the comment parameter which will cause + the comment field to be left blank. The flt, dbl, cmp, and dblcmp + versions of this routine have the added + feature that if the 'decimals' parameter is negative, then the 'G' + display format rather then the 'E' format will be used when + constructing the keyword value, taking the absolute value of + 'decimals' for the precision. This will suppress trailing zeros, + and will use a fixed format rather than an exponential format, +> depending on the magnitude of the value. \label{ffikyx} +- + int fits_insert_card / ffikey + (fitsfile *fptr, char *card, > &status) + + int fits_insert_key_[str, longstr] / ffi[kys, kls] + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status) + + int fits_insert_key_[log, lng] / ffiky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_insert_key_[flt, fixflt, dbl, fixdbl] / ffiky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_insert_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffik[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +- +>3 Insert a new keyword with an undefined, or null, value into the CHU. +> The value string of the keyword is left blank in this case. \label{ffikyu} +- + int fits_insert_key_null / ffikyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) +- + +***5. Read Keyword Routines + +Wild card characters may be used when specifying the name of the +keyword to be read. + +>1 Read a keyword value (with the appropriate data type) and comment from + the CHU. If a NULL comment pointer is given on input, then the comment + string will not be returned. If the value of the keyword is not defined + (i.e., the value field is blank) then an error status = VALUE\_UNDEFINED + will be returned and the input value will not be changed (except that + ffgkys will reset the value to a null string). +> \label{ffgkyx} \label{ffgkls} +- + int fits_read_key_str / ffgkys + (fitsfile *fptr, char *keyname, > char *value, char *comment, + int *status); + + NOTE: after calling the following routine, programs must explicitly free + the memory allocated for 'longstr' after it is no longer needed. + + int fits_read_key_longstr / ffgkls + (fitsfile *fptr, char *keyname, > char **longstr, char *comment, + int *status) + + int fits_read_key_[log, lng, flt, dbl, cmp, dblcmp] / ffgky[ljedcm] + (fitsfile *fptr, char *keyname, > DTYPE *numval, char *comment, + int *status) + +- +>2 Read a sequence of indexed keyword values (e.g., NAXIS1, NAXIS2, ...). + The input starting index number (nstart) must be greater than 0. + If the value of any of the keywords is not defined (i.e., the value + field is blank) then an error status = VALUE\_UNDEFINED will be + returned and the input value for the undefined keyword(s) will not + be changed. These routines do not support wild card characters in + the root name. If there are no indexed keywords in the header with + the input root name then these routines do not return a non-zero +> status value and instead simply return nfound = 0. \label{ffgknx} +- + int fits_read_keys_str / ffgkns + (fitsfile *fptr, char *keyname, int nstart, int nkeys, + > char **value, int *nfound, int *status) + + int fits_read_keys_[log, lng, flt, dbl] / ffgkn[ljed] + (fitsfile *fptr, char *keyname, int nstart, int nkeys, + > DTYPE *numval, int *nfound, int *status) +- +>3 Read the value of a floating point keyword, returning the integer and + fractional parts of the value in separate routine arguments. + This routine may be used to read any keyword but is especially + useful for reading the 'triple precision' keywords written by ffpkyt. +> \label{ffgkyt} +- + int fits_read_key_triple / ffgkyt + (fitsfile *fptr, char *keyname, > long *intval, double *frac, + char *comment, int *status) +- +***6. Modify Keyword Routines + +These routines modify the value of an existing keyword. An error is +returned if the keyword does not exist. Wild card characters may be +used when specifying the name of the keyword to be modified. See +Appendix B for the definition of the parameters used in these +routines. + +>>1 Modify (overwrite) the nth 80-character header record in the CHU. \label{ffmrec} +- + int fits_modify_record / ffmrec + (fitsfile *fptr, int keynum, char *card, > int *status) +- +>2 Modify (overwrite) the 80-character header record for the named keyword + in the CHU. This can be used to overwrite the name of the keyword as +> well as its value and comment fields. \label{ffmcrd} +- + int fits_modify_card / ffmcrd + (fitsfile *fptr, char *keyname, char *card, > int *status) +- +>5 Modify the value and comment fields of an existing keyword in the CHU. + The `longstr' version has the same functionality as the `str' + version except that it also supports the local long string keyword + convention for strings longer than 68 characters. Optionally, one + may modify only the value field and leave the comment field + unchanged by setting the input COMMENT parameter equal to the + ampersand character (\&) or by entering a null pointer for the + comment parameter. The flt, dbl, cmp, and dblcmp versions of this + routine have the added feature that if the 'decimals' parameter is + negative, then the 'G' display format rather then the 'E' format + will be used when constructing the keyword value, taking the + absolute value of 'decimals' for the precision. This will suppress + trailing zeros, and will use a fixed format rather than an + exponential format, +> depending on the magnitude of the value. \label{ffmkyx} +- + int fits_modify_key_[str, longstr] / ffm[kys, kls] + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status); + + int fits_modify_key_[log, lng] / ffmky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_modify_key_[flt, dbl, fixflt, fixdbl] / ffmky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_modify_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffmk[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +- +>6 Modify the value of an existing keyword to be undefined, or null. + The value string of the keyword is set to blank. + Optionally, one may leave the comment field unchanged by setting the + input COMMENT parameter equal to +> the ampersand character (\&) or by entering a null pointer. \label{ffmkyu} +- + int fits_modify_key_null / ffmkyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) +- +***7. Update Keyword Routines + +>1 These update routines modify the value, and optionally the comment field, + of the keyword if it already exists, otherwise the new keyword is + appended to the header. A separate routine is provided for each + keyword data type. The `longstr' version has the same functionality + as the `str' version except that it also supports the local long + string keyword convention for strings longer than 68 characters. A + null pointer may be entered for the comment parameter which will + leave the comment field unchanged or blank. The flt, dbl, cmp, and + dblcmp versions of this routine have the added feature that if the + 'decimals' parameter is negative, then the 'G' display format + rather then the 'E' format will be used when constructing the + keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a fixed + format rather than an exponential format, +> depending on the magnitude of the value. \label{ffukyx} +- + int fits_update_key_[str, longstr] / ffu[kys, kls] + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status) + + int fits_update_key_[log, lng] / ffuky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_update_key_[flt, dbl, fixflt, fixdbl] / ffuky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_update_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffuk[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +- + +**D. Define Data Scaling and Undefined Pixel Parameters + +These routines set or modify the internal parameters used by CFITSIO +to either scale the data or to represent undefined pixels. Generally +CFITSIO will scale the data according to the values of the BSCALE and +BZERO (or TSCALn and TZEROn) keywords, however these routines may be +used to override the keyword values. This may be useful when one wants +to read or write the raw unscaled values in the FITS file. Similarly, +CFITSIO generally uses the value of the BLANK or TNULLn keyword to +signify an undefined pixel, but these routines may be used to override +this value. These routines do not create or modify the corresponding +header keyword values. See Appendix B for the definition of the +parameters used in these routines. + +>1 Reset the scaling factors in the primary array or image extension; does + not change the BSCALE and BZERO keyword values and only affects the + automatic scaling performed when the data elements are written/read + to/from the FITS file. When reading from a FITS file the returned + data value = (the value given in the FITS array) * BSCALE + BZERO. + The inverse formula is used when writing data values to the FITS +> file. \label{ffpscl} +- + int fits_set_bscale / ffpscl + (fitsfile *fptr, double scale, double zero, > int *status) +- +>2 Reset the scaling parameters for a table column; does not change + the TSCALn or TZEROn keyword values and only affects the automatic + scaling performed when the data elements are written/read to/from + the FITS file. When reading from a FITS file the returned data + value = (the value given in the FITS array) * TSCAL + TZERO. The + inverse formula is used when writing data values to the FITS file. +> \label{fftscl} +- + int fits_set_tscale / fftscl + (fitsfile *fptr, int colnum, double scale, double zero, + > int *status) +- +>3 Define the integer value to be used to signify undefined pixels in the + primary array or image extension. This is only used if BITPIX = 8, 16, + or 32. This does not create or change the value of the BLANK keyword in +> the header. \label{ffpnul} +- + int fits_set_imgnull / ffpnul + (fitsfile *fptr, long nulval, > int *status) +- +>4 Define the string to be used to signify undefined pixels in + a column in an ASCII table. This does not create or change the value +> of the TNULLn keyword. \label{ffsnul} +- + int fits_set_atblnull / ffsnul + (fitsfile *fptr, int colnum, char *nulstr, > int *status) +- +>5 Define the value to be used to signify undefined pixels in + an integer column in a binary table (where TFORMn = 'B', 'I', or 'J'). + This does not create or change the value of the TNULLn keyword. +> \label{fftnul} +- + int fits_set_btblnull / fftnul + (fitsfile *fptr, int colnum, long nulval, > int *status) +- + +**E. Specialized FITS Primary Array or IMAGE Extension I/O Routines + +These routines read or write data values in the primary data array +(i.e., the first HDU in the FITS file) or an IMAGE extension. +Automatic data type conversion is performed for if the data type of the +FITS array (as defined by the BITPIX keyword) differs from the data +type of the array in the calling routine. The data values are +automatically scaled by the BSCALE and BZERO header values as they are +being written or read from the FITS array. Unlike the basic routines +described in the previous chapter, most of these routines specifically +support the FITS random groups format. See Appendix B for the +definition of the parameters used in these routines. + +The more primitive reading and writing routines (i. e., ffppr\_, +ffppn\_, ffppn, ffgpv\_, or ffgpf\_) simply treat the primary array as +a long 1-dimensional array of pixels, ignoring the intrinsic +dimensionality of the array. When dealing with a 2D image, for +example, the application program must calculate the pixel offset in the +1-D array that corresponds to any particular X, Y coordinate in the +image. C programmers should note that the ordering of arrays in FITS +files, and hence in all the CFITSIO calls, is more similar to the +dimensionality of arrays in Fortran rather than C. For instance if a +FITS image has NAXIS1 = 100 and NAXIS2 = 50, then a 2-D array just +large enough to hold the image should be declared as array[50][100] and +not as array[100][50]. + +For convenience, higher-level routines are also provided to specificly +deal with 2D images (ffp2d\_ and ffg2d\_) and 3D data cubes (ffp3d\_ +and ffg3d\_). The dimensionality of the FITS image is passed by the +naxis1, naxis2, and naxis3 parameters and the declared dimensions of +the program array are passed in the dim1 and dim2 parameters. Note +that the dimensions of the program array may be larger than the +dimensions of the FITS array. For example if a FITS image with NAXIS1 += NAXIS2 = 400 is read into a program array which is dimensioned as 512 +x 512 pixels, then the image will just fill the lower left corner of +the array with pixels in the range 1 - 400 in the X an Y directions. +This has the effect of taking a contiguous set of pixel value in the +FITS array and writing them to a non-contiguous array in program memory +(i.e., there are now some blank pixels around the edge of the image in +the program array). + +The most general set of routines (ffpss\_, ffgsv\_, and ffgsf\_) may be +used to transfer a rectangular subset of the pixels in a FITS +N-dimensional image to or from an array which has been declared in the +calling program. The fpixel and lpixel parameters are integer arrays +which specify the starting and ending pixel coordinate in each dimension +(starting with 1, not 0) of the FITS image that is to be read or +written. It is important to note that these are the starting and +ending pixels in the FITS image, not in the declared array in the +program. The array parameter in these routines is treated simply as a +large one-dimensional array of the appropriate data type containing the +pixel values; The pixel values in the FITS array are read/written +from/to this program array in strict sequence without any gaps; it is +up to the calling routine to correctly interpret the dimensionality of +this array. The two FITS reading routines (ffgsv\_ and ffgsf\_ ) also +have an `inc' parameter which defines the data sampling interval in +each dimension of the FITS array. For example, if inc[0]=2 and +inc[1]=3 when reading a 2-dimensional FITS image, then only every other +pixel in the first dimension and every 3rd pixel in the second +dimension will be returned to the 'array' parameter. + +Two types of routines are provided to read the data array which differ in +the way undefined pixels are handled. The first type of routines (e.g., +ffgpv\_) simply return an array of data elements in which undefined +pixels are set equal to a value specified by the user in the `nulval' +parameter. An additional feature of these routines is that if the user +sets nulval = 0, then no checks for undefined pixels will be performed, +thus reducing the amount of CPU processing. The second type of routines +(e.g., ffgpf\_) returns the data element array and, in addition, a char +array that indicates whether the value of the corresponding data pixel +is undefined (= 1) or defined (= 0). The latter type of routines may +be more convenient to use in some circumstances, however, it requires +an additional array of logical values which can be unwieldy when working +with large data arrays. + +>1 Write elements into the FITS data array. +> \label{ffppr} \label{ffpprx} \label{ffppn} \label{ffppnx} +- + int fits_write_img / ffppr + (fitsfile *fptr, int datatype, long firstelem, long nelements, + DTYPE *array, int *status); + + int fits_write_img_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffppr[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + DTYPE *array, > int *status); + + int fits_write_imgnull / ffppn + (fitsfile *fptr, int datatype, long firstelem, long nelements, + DTYPE *array, DTYPE *nulval, > int *status); + + int fits_write_imgnull_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffppn[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, + long nelements, DTYPE *array, DTYPE nulval, > int *status); +- +>>2 Set data array elements as undefined. \label{ffppru} +- + int fits_write_img_null / ffppru + (fitsfile *fptr, long group, long firstelem, long nelements, + > int *status) +- +>3 Write values into group parameters. This routine only applies + to the `Random Grouped' FITS format which has been used for + applications in radio interferometry, but is officially deprecated +> for future use. \label{ffpgpx} +- + int fits_write_grppar_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffpgp[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + > DTYPE *array, int *status) +- +>>4 Write a 2-D or 3-D image into the data array. \label{ffp2dx} \label{ffp3dx} +- + int fits_write_2d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffp2d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long dim1, long naxis1, + long naxis2, DTYPE *array, > int *status) + + int fits_write_3d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffp3d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long dim1, long dim2, + long naxis1, long naxis2, long naxis3, DTYPE *array, > int *status) +- +>>5 Write an arbitrary data subsection into the data array. \label{ffpssx} +- + int fits_write_subset_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffpss[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, DTYPE *array, > int *status) +- +>6 Read elements from the FITS data array. +> \label{ffgpv} \label{ffgpvx} \label{ffgpf} \label{ffgpfx} +- + int fits_read_img / ffgpv + (fitsfile *fptr, int datatype, long firstelem, long nelements, + DTYPE *nulval, > DTYPE *array, int *anynul, int *status) + + int fits_read_img_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgpv[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + DTYPE nulval, > DTYPE *array, int *anynul, int *status) + + int fits_read_imgnull / ffgpf + (fitsfile *fptr, int datatype, long firstelem, long nelements, + > DTYPE *array, char *nullarray, int *anynul, int *status) + + int fits_read_imgnull_[byt, sht, usht, int, uint, lng, ulng, flt, dbl] / + ffgpf[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + > DTYPE *array, char *nullarray, int *anynul, int *status) +- +>7 Read values from group parameters. This routine only applies + to the `Random Grouped' FITS format which has been used for + applications in radio interferometry, but is officially deprecated +> for future use. \label{ffggpx} +- + int fits_read_grppar_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffggp[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + > DTYPE *array, int *status) +- +>8 Read 2-D or 3-D image from the data array. Undefined + pixels in the array will be set equal to the value of 'nulval', + unless nulval=0 in which case no testing for undefined pixels will +> be performed. \label{ffg2dx} \label{ffg3dx} +- + int fits_read_2d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffg2d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, DTYPE nulval, long dim1, long naxis1, + long naxis2, > DTYPE *array, int *anynul, int *status) + + int fits_read_3d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffg3d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, DTYPE nulval, long dim1, + long dim2, long naxis1, long naxis2, long naxis3, + > DTYPE *array, int *anynul, int *status) +- +>9 Read an arbitrary data subsection from the data array. +> \label{ffgsvx} \label{ffgsfx} +- + int fits_read_subset_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsv[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int group, int naxis, long *naxes, + long *fpixel, long *lpixel, long *inc, DTYPE nulval, + > DTYPE *array, int *anynul, int *status) + + int fits_read_subsetnull_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsf[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int group, int naxis, long *naxes, + long *fpixel, long *lpixel, long *inc, > DTYPE *array, + char *nullarray, int *anynul, int *status) +- + +**F. Specialized FITS ASCII and Binary Table Routines + +***1. General Column Routines + +>1 Get information about an existing ASCII or binary table column. A null + pointer may be given for any of the output parameters that are not + needed. DATATYPE is a character string which returns the data type + of the column as defined by the TFORMn keyword (e.g., 'I', 'J','E', + 'D', etc.). In the case of an ASCII character column, typecode + will have a value of the form 'An' where 'n' is an integer + expressing the width of the field in characters. For example, if + TFORM = '160A8' then ffgbcl will return typechar='A8' and + repeat=20. All the returned parameters are scalar quantities. +> \label{ffgacl} \label{ffgbcl} +- + int fits_get_acolparms / ffgacl + (fitsfile *fptr, int colnum, > char *ttype, long *tbcol, + char *tunit, char *tform, double *scale, double *zero, + char *nulstr, char *tdisp, int *status) + + int fits_get_bcolparms / ffgbcl + (fitsfile *fptr, int colnum, > char *ttype, char *tunit, + char *typechar, long *repeat, double *scale, double *zero, + long *nulval, char *tdisp, int *status) +- +>2 Return optimal number of rows to read or write at one time for + maximum I/O efficiency. Refer to the + ``Optimizing Code'' section in Chapter 5 for more discussion on how +> to use this routine. \label{ffgrsz} +- + int fits_get_rowsize / ffgrsz + (fitsfile *fptr, long *nrows, *status) +- +>3 Define the zero indexed byte offset of the 'heap' measured from + the start of the binary table data. By default the heap is assumed + to start immediately following the regular table data, i.e., at + location NAXIS1 x NAXIS2. This routine is only relevant for + binary tables which contain variable length array columns (with + TFORMn = 'Pt'). This routine also automatically writes + the value of theap to a keyword in the extension header. This + routine must be called after the required keywords have been + written (with ffphbn) +> but before any data is written to the table. \label{ffpthp} +- + int fits_write_theap / ffpthp + (fitsfile *fptr, long theap, > int *status) +- +>4 Test the contents of the binary table variable array heap, returning + the size of the heap, the number of unused bytes that are not currently + pointed to by any of the descriptors, and the number of bytes which are + pointed to by multiple descriptors. It also returns valid = FALSE if + any of the descriptors point to invalid addresses out of range of the +> heap. \label{fftheap} +- + int fits_test_heap / fftheap + (fitsfile *fptr, > long *heapsize, long *unused, long *overlap, + int *validheap, int *status) +- +>5 Re-pack the vectors in the binary table variable array heap to recover + any unused space. Normally, when a vector in a variable length + array column is rewritten the previously written array remains in + the heap as wasted unused space. This routine will repack the + arrays that are still in use, thus eliminating any bytes in the + heap that are no longer in use. Note that if several vectors point + to the same bytes in the heap, then this routine will make + duplicate copies of the bytes for each vector, which will actually +> expand the size of the heap. \label{ffcmph} +- + int fits_compress_heap / ffcmph + (fitsfile *fptr, > int *status) +- + +***2. Low-Level Table Access Routines + +The following 2 routines provide low-level access to the data in ASCII +or binary tables and are mainly useful as an efficient way to copy all +or part of a table from one location to another. These routines simply +read or write the specified number of consecutive bytes in an ASCII or +binary table, without regard for column boundaries or the row length in +the table. These routines do not perform any machine dependent data +conversion or byte swapping. See Appendix B for the definition of the +parameters used in these routines. + +>1 Read or write a consecutive array of bytes from an ASCII or binary +> table \label{ffgtbb} \label{ffptbb} +- + int fits_read_tblbytes / ffgtbb + (fitsfile *fptr, long firstrow, long firstchar, long nchars, + > unsigned char *values, int *status) + + int fits_write_tblbytes / ffptbb + (fitsfile *fptr, long firstrow, long firstchar, long nchars, + unsigned char *values, > int *status) +- + +***3. Write Column Data Routines + +>1 Write elements into an ASCII or binary table column (in the CDU). + The data type of the array is implied by the suffix of the +> routine name. \label{ffpcls} +- + int fits_write_col_str / ffpcls + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, char **array, > int *status) + + int fits_write_col_[log,byt,sht,usht,int,uint,lng,ulng,lnglng,flt,dbl,cmp,dblcmp] / + ffpcl[l,b,i,ui,k,uk,j,uj,jj,e,d,c,m] + (fitsfile *fptr, int colnum, long firstrow, + long firstelem, long nelements, DTYPE *array, > int *status) +- +>2 Write elements into an ASCII or binary table column + substituting the appropriate FITS null value for any elements that + are equal to the nulval parameter. This routines must not be used to +> write to variable length array columns. \label{ffpcnx} +- + int fits_write_colnull_[log, byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffpcn[l,b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, DTYPE *array, DTYPE nulval, > int *status) +- +>3 Write string elements into a binary table column (in the CDU) + substituting the FITS null value for any elements that + are equal to the nulstr string. This routine must NOT be +> used to write to variable length array columns. \label{ffpcns} +- + int fits_write_colnull_str / ffpcns + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, char **array, char *nulstr, > int *status) +- +>4 Write bit values into a binary byte ('B') or bit ('X') table column (in + the CDU). Larray is an array of characters corresponding to the + sequence of bits to be written. If an element of larray is true + (not equal to zero) then the corresponding bit in the FITS table is + set to 1, otherwise the bit is set to 0. The 'X' column in a FITS + table is always padded out to a multiple of 8 bits where the bit + array starts with the most significant bit of the byte and works + down towards the 1's bit. For example, a '4X' array, with the + first bit = 1 and the remaining 3 bits = 0 is equivalent to the 8-bit + unsigned byte decimal value of 128 ('1000 0000B'). In the case of + 'X' columns, CFITSIO can write to all 8 bits of each byte whether + they are formally valid or not. Thus if the column is defined as + '4X', and one calls ffpclx with firstbit=1 and nbits=8, then all + 8 bits will be written into the first byte (as opposed to writing + the first 4 bits into the first row and then the next 4 bits into + the next row), even though the last 4 bits of each byte are formally + not defined and should all be set = 0. It should also be noted that + it is more efficient to write 'X' columns an entire byte at a time, + instead of bit by bit. Any of the CFITSIO routines that write to + columns (e.g. fits\_write\_col\_byt) may be used for this purpose. + These routines will interpret 'X' columns as though they were 'B' + columns (e.g., '1X' through '8X' is equivalent +> to '1B', and '9X' through '16X' is equivalent to '2B'). \label{ffpclx} +- + int fits_write_col_bit / ffpclx + (fitsfile *fptr, int colnum, long firstrow, long firstbit, + long nbits, char *larray, > int *status) +- +>5 Write the descriptor for a variable length column in a binary table. + This routine can be used in conjunction with ffgdes to enable + 2 or more arrays to point to the same storage location to save +> storage space if the arrays are identical. \label{ffpdes} +- + int fits_write_descript / ffpdes + (fitsfile *fptr, int colnum, long rownum, long repeat, + long offset, > int *status) +- +***4. Read Column Data Routines + +Two types of routines are provided to get the column data which differ +in the way undefined pixels are handled. The first set of routines +(ffgcv) simply return an array of data elements in which undefined +pixels are set equal to a value specified by the user in the 'nullval' +parameter. If nullval = 0, then no checks for undefined pixels will be +performed, thus increasing the speed of the program. The second set of +routines (ffgcf) returns the data element array and in addition a +logical array of flags which defines whether the corresponding data +pixel is undefined. See Appendix B for the definition of the +parameters used in these routines. + + Any column, regardless of it's intrinsic data type, may be read as a + string. It should be noted however that reading a numeric column as + a string is 10 - 100 times slower than reading the same column as a number + due to the large overhead in constructing the formatted strings. + The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + data type of the column. The length of the returned strings (not + including the null terminating character) can be determined with + the fits\_get\_col\_display\_width routine. The following TDISPn + display formats are currently supported: +- + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +- + where w is the width in characters of the displayed values, m is + the minimum number of digits displayed, and d is the number of + digits to the right of the decimal. The .m field is optional. + +>1 Read elements from an ASCII or binary table column (in the CDU). These + routines return the values of the table column array elements. Undefined + array elements will be returned with a value = nulval, unless nulval = 0 + (or = ' ' for ffgcvs) in which case no checking for undefined values will + be performed. The ANYF parameter is set to true if any of the returned +> elements are undefined. \label{ffgcvx} +- + int fits_read_col_str / ffgcvs + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, char *nulstr, > char **array, int *anynul, + int *status) + + int fits_read_col_[log,byt,sht,usht,int,uint,lng,ulng, lnglng, flt, dbl, cmp, dblcmp] / + ffgcv[l,b,i,ui,k,uk,j,uj,jj,e,d,c,m] + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, DTYPE nulval, > DTYPE *array, int *anynul, + int *status) +- +>2 Read elements and null flags from an ASCII or binary table column (in the + CHDU). These routines return the values of the table column array elements. + Any undefined array elements will have the corresponding nullarray element + set equal to TRUE. The anynul parameter is set to true if any of the +> returned elements are undefined. \label{ffgcfx} +- + int fits_read_colnull_str / ffgcfs + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, > char **array, char *nullarray, int *anynul, + int *status) + + int fits_read_colnull_[log,byt,sht,usht,int,uint,lng,ulng,lnglng,flt,dbl,cmp,dblcmp] / + ffgcf[l,b,i,ui,k,uk,j,uj,jj,e,d,c,m] + (fitsfile *fptr, int colnum, long firstrow, + long firstelem, long nelements, > DTYPE *array, + char *nullarray, int *anynul, int *status) +- +>3 Read an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Undefined pixels + in the array will be set equal to the value of 'nulval', + unless nulval=0 in which case no testing for undefined pixels will + be performed. The first and last rows in the table to be read + are specified by fpixel(naxis+1) and lpixel(naxis+1), and hence + are treated as the next higher dimension of the FITS N-dimensional + array. The INC parameter specifies the sampling interval in +> each dimension between the data elements that will be returned. \label{ffgsvx2} +- + int fits_read_subset_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsv[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int colnum, int naxis, long *naxes, long *fpixel, + long *lpixel, long *inc, DTYPE nulval, > DTYPE *array, int *anynul, + int *status) +- +>4 Read an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Any Undefined + pixels in the array will have the corresponding 'nullarray' + element set equal to TRUE. The first and last rows in the table + to be read are specified by fpixel(naxis+1) and lpixel(naxis+1), + and hence are treated as the next higher dimension of the FITS + N-dimensional array. The INC parameter specifies the sampling + interval in each dimension between the data elements that will be +> returned. \label{ffgsfx2} +- + int fits_read_subsetnull_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsf[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int colnum, int naxis, long *naxes, + long *fpixel, long *lpixel, long *inc, > DTYPE *array, + char *nullarray, int *anynul, int *status) +- +>5 Read bit values from a byte ('B') or bit (`X`) table column (in the + CDU). Larray is an array of logical values corresponding to the + sequence of bits to be read. If larray is true then the + corresponding bit was set to 1, otherwise the bit was set to 0. + The 'X' column in a FITS table is always padded out to a multiple + of 8 bits where the bit array starts with the most significant bit + of the byte and works down towards the 1's bit. For example, a + '4X' array, with the first bit = 1 and the remaining 3 bits = 0 is + equivalent to the 8-bit unsigned byte value of 128. + Note that in the case of 'X' columns, CFITSIO can read all 8 bits + of each byte whether they are formally valid or not. Thus if the + column is defined as '4X', and one calls ffgcx with firstbit=1 and + nbits=8, then all 8 bits will be read from the first byte (as + opposed to reading the first 4 bits from the first row and then the + first 4 bits from the next row), even though the last 4 bits of + each byte are formally not defined. It should also be noted that + it is more efficient to read 'X' columns an entire byte at a time, + instead of bit by bit. Any of the CFITSIO routines that read + columns (e.g. fits\_read\_col\_byt) may be used for this + purpose. These routines will interpret 'X' columns as though they + were 'B' columns (e.g., '8X' is equivalent to '1B', and '16X' is +> equivalent to '2B'). \label{ffgcx} +- + int fits_read_col_bit / ffgcx + (fitsfile *fptr, int colnum, long firstrow, long firstbit, + long nbits, > char *larray, int *status) +- +>6 Read any consecutive set of bits from an 'X' or 'B' column and + interpret them as an unsigned n-bit integer. nbits must be less + than 16 or 32 in ffgcxui and ffgcxuk, respectively. If nrows + is greater than 1, then the same set of bits will be read from + each row, starting with firstrow. The bits are numbered with + 1 = the most significant bit of the first element of the column. +> \label{ffgcxui} +- + int fits_read_col_bit_[usht, uint] / ffgcx[ui,uk] + (fitsfile *fptr, int colnum, long firstrow, long, nrows, + long firstbit, long nbits, > DTYPE *array, int *status) +- +>7 Return the descriptor for a variable length column in a binary table. + The descriptor consists of 2 integer parameters: the number of elements + in the array and the starting offset relative to the start of the heap. + The first routine returns a single descriptor whereas the second routine + returns the descriptors for a range of rows in the table. +> \label{ffgdes} +- + int fits_read_descript / ffgdes + (fitsfile *fptr, int colnum, long rownum, > long *repeat, + long *offset, int *status) + + int fits_read_descripts / ffgdess + (fitsfile *fptr, int colnum, long firstrow, long nrows > long *repeat, + long *offset, int *status) +- + +*X. Extended File Name Syntax + +**A. Overview + +CFITSIO supports an extended syntax when specifying the name of the +data file to be opened or created that includes the following +features: + +\begin{itemize} +\item +CFITSIO can read IRAF format images which have header file names that +end with the '.imh' extension, as well as reading and writing FITS +files, This feature is implemented in CFITSIO by first converting the +IRAF image into a temporary FITS format file in memory, then opening +the FITS file. Any of the usual CFITSIO routines then may be used to +read the image header or data. Similarly, raw binary data arrays can +be read by converting them on the fly into virtual FITS images. + +\item +FITS files on the internet can be read (and sometimes written) using the FTP, +HTTP, or ROOT protocols. + +\item +FITS files can be piped between tasks on the stdin and stdout streams. + +\item +FITS files can be read and written in shared memory. This can +potentially achieve better data I/O performance compared to reading and +writing the same FITS files on magnetic disk. + +\item +Compressed FITS files in gzip or Unix COMPRESS format can be directly read. + +\item +Output FITS files can be written directly in compressed gzip format, +thus saving disk space. + +\item +FITS table columns can be created, modified, or deleted 'on-the-fly' as +the table is opened by CFITSIO. This creates a virtual FITS file containing +the modifications that is then opened by the application program. + +\item +Table rows may be selected, or filtered out, on the fly when the table +is opened by CFITSIO, based on an user-specified expression. +Only rows for which the expression evaluates to 'TRUE' are retained +in the copy of the table that is opened by the application program. + +\item +Histogram images may be created on the fly by binning the values in +table columns, resulting in a virtual N-dimensional FITS image. The +application program then only sees the FITS image (in the primary +array) instead of the original FITS table. +\end{itemize} + +The latter 3 table filtering features in particular add very powerful +data processing capabilities directly into CFITSIO, and hence into +every task that uses CFITSIO to read or write FITS files. For example, +these features transform a very simple program that just copies an +input FITS file to a new output file (like the `fitscopy' program that +is distributed with CFITSIO) into a multipurpose FITS file processing +tool. By appending fairly simple qualifiers onto the name of the input +FITS file, the user can perform quite complex table editing operations +(e.g., create new columns, or filter out rows in a table) or create +FITS images by binning or histogramming the values in table columns. +In addition, these functions have been coded using new state-of-the art +algorithms that are, in some cases, 10 - 100 times faster than previous +widely used implementations. + +Before describing the complete syntax for the extended FITS file names +in the next section, here are a few examples of FITS file names that +give a quick overview of the allowed syntax: + +\begin{itemize} +\item +{\tt myfile.fits}: the simplest case of a FITS file on disk in the current +directory. + +\item +{\tt myfile.imh}: opens an IRAF format image file and converts it on the +fly into a temporary FITS format image in memory which can then be read with +any other CFITSIO routine. + +\item +{\tt rawfile.dat[i512,512]}: opens a raw binary data array (a 512 x 512 +short integer array in this case) and converts it on the fly into a +temporary FITS format image in memory which can then be read with any +other CFITSIO routine. + +\item +{\tt myfile.fits.gz}: if this is the name of a new output file, the '.gz' +suffix will cause it to be compressed in gzip format when it is written to +disk. + +\item +{\tt myfile.fits.gz[events, 2]}: opens and uncompresses the gzipped file +myfile.fits then moves to the extension with the keywords EXTNAME += 'EVENTS' and EXTVER = 2. + +\item +{\tt -}: a dash (minus sign) signifies that the input file is to be read +from the stdin file stream, or that the output file is to be written to +the stdout stream. + +\item +{\tt ftp://legacy.gsfc.nasa.gov/test/vela.fits}: FITS files in any ftp +archive site on the internet may be directly opened with read-only +access. + +\item +{\tt http://legacy.gsfc.nasa.gov/software/test.fits}: any valid URL to a +FITS file on the Web may be opened with read-only access. + +\item +{\tt root://legacy.gsfc.nasa.gov/test/vela.fits}: similar to ftp access +except that it provides write as well as read access to the files +across the network. This uses the root protocol developed at CERN. + +\item +{\tt shmem://h2[events]}: opens the FITS file in a shared memory segment and +moves to the EVENTS extension. + +\item +{\tt mem://}: creates a scratch output file in core computer memory. The +resulting 'file' will disappear when the program exits, so this +is mainly useful for testing purposes when one does not want a +permanent copy of the output file. + +\item +{\tt myfile.fits[3; Images(10)]}: opens a copy of the image contained in the +10th row of the 'Images' column in the binary table in the 3th extension +of the FITS file. The virtual file that is opened by the application just +contains this single image in the primary array. + +\item +{\tt myfile.fits[1:512:2, 1:512:2]}: opens a section of the input image +ranging from the 1st to the 512th pixel in X and Y, and selects every +second pixel in both dimensions, resulting in a 256 x 256 pixel input image +in this case. + +\item +{\tt myfile.fits[EVENTS][col Rad = sqrt(X**2 + Y**2)]}: creates and opens +a virtual file on the fly that is identical to +myfile.fits except that it will contain a new column in the EVENTS +extension called 'Rad' whose value is computed using the indicated +expression which is a function of the values in the X and Y columns. + +\item +{\tt myfile.fits[EVENTS][PHA > 5]}: creates and opens a virtual FITS +files that is identical to 'myfile.fits' except that the EVENTS table +will only contain the rows that have values of the PHA column greater +than 5. In general, any arbitrary boolean expression using a C or +Fortran-like syntax, which may combine AND and OR operators, +may be used to select rows from a table. + +\item +{\tt myfile.fits[EVENTS][bin (X,Y)=1,2048,4]}: creates a temporary FITS +primary array image which is computed on the fly by binning (i.e, +computing the 2-dimensional histogram) of the values in the X and Y +columns of the EVENTS extension. In this case the X and Y coordinates +range from 1 to 2048 and the image pixel size is 4 units in both +dimensions, so the resulting image is 512 x 512 pixels in size. + +\item +The final example combines many of these feature into one complex +expression (it is broken into several lines for clarity): +- + ftp://legacy.gsfc.nasa.gov/data/sample.fits.gz[EVENTS] + [col phacorr = pha * 1.1 - 0.3][phacorr >= 5.0 && phacorr <= 14.0] + [bin (X,Y)=32] +- +In this case, CFITSIO (1) copies and uncompresses the FITS file from +the ftp site on the legacy machine, (2) moves to the 'EVENTS' +extension, (3) calculates a new column called 'phacorr', (4) selects +the rows in the table that have phacorr in the range 5 to 14, and +finally (5) bins the remaining rows on the X and Y column coordinates, +using a pixel size = 32 to create a 2D image. All this processing is +completely transparent to the application program, which simply sees +the final 2-D image in the primary array of the opened file. +\end{itemize} + +The full extended CFITSIO FITS file name can contain several different +components depending on the context. These components are described in +the following sections: +- +When creating a new file: + filetype://BaseFilename(templateName)[compress] + +When opening an existing primary array or image HDU: + filetype://BaseFilename(outName)[HDUlocation][ImageSection] + +When opening an existing table HDU: + filetype://BaseFilename(outName)[HDUlocation][colFilter][rowFilter][binSpec] +- +The filetype, BaseFilename, outName, HDUlocation, and ImageSection +components, if present, must be given in that order, but the colFilter, +rowFilter, and binSpec specifiers may follow in any order. Regardless +of the order, however, the colFilter specifier, if present, will be +processed first by CFITSIO, followed by the rowFilter specifier, and +finally by the binSpec specifier. + +**A. Filetype + +The type of file determines the medium on which the file is located +(e.g., disk or network) and, hence, which internal device driver is used by +CFITSIO to read and/or write the file. Currently supported types are +- + file:// - file on local magnetic disk (default) + ftp:// - a readonly file accessed with the anonymous FTP protocol. + It also supports ftp://username:password@hostname/... + for accessing password-protected ftp sites. + http:// - a readonly file accessed with the HTTP protocol. It + does not support username:password like the ftp driver. + Proxy HTTP survers are supported using the http_proxy + environment variable. + root:// - uses the CERN root protocol for writing as well as + reading files over the network. + shmem:// - opens or creates a file which persists in the computer's + shared memory. + mem:// - opens a temporary file in core memory. The file + disappears when the program exits so this is mainly + useful for test purposes when a permanent output file + is not desired. +- +If the filetype is not specified, then type file:// is assumed. +The double slashes '//' are optional and may be omitted in most cases. + +***1. Notes about HTTP proxy servers + +A proxy HTTP server may be used by defining the address (URL) and port +number of the proxy server with the http\_proxy environment variable. +For example +- + setenv http_proxy http://heasarc.gsfc.nasa.gov:3128 +- +will cause CFITSIO to use port 3128 on the heasarc proxy server whenever +reading a FITS file with HTTP. + +***2. Notes about the root filetype + +The original rootd server can be obtained from: +\verb-ftp://root.cern.ch/root/rootd.tar.gz- +but, for it to work correctly with CFITSIO one has to use a modified +version which supports a command to return the length of the file. +This modified version is available in rootd subdirectory +in the CFITSIO ftp area at +- + ftp://legacy.gsfc.nasa.gov/software/fitsio/c/root/rootd.tar.gz. +- + +This small server is started either by inetd when a client requests a +connection to a rootd server or by hand (i.e. from the command line). +The rootd server works with the ROOT TNetFile class. It allows remote +access to ROOT database files in either read or write mode. By default +TNetFile assumes port 432 (which requires rootd to be started as root). +To run rootd via inetd add the following line to /etc/services: +- + rootd 432/tcp +- +and to /etc/inetd.conf, add the following line: +- + rootd stream tcp nowait root /user/rdm/root/bin/rootd rootd -i +- +Force inetd to reread its conf file with \verb+kill -HUP +. +You can also start rootd by hand running directly under your private +account (no root system privileges needed). For example to start +rootd listening on port 5151 just type: \verb+rootd -p 5151+ +Notice that no \& is needed. Rootd will go into background by itself. +- + Rootd arguments: + -i says we were started by inetd + -p port# specifies a different port to listen on + -d level level of debug info written to syslog + 0 = no debug (default) + 1 = minimum + 2 = medium + 3 = maximum +- +Rootd can also be configured for anonymous usage (like anonymous ftp). +To setup rootd to accept anonymous logins do the following (while being +logged in as root): +- + - Add the following line to /etc/passwd: + + rootd:*:71:72:Anonymous rootd:/var/spool/rootd:/bin/false + + where you may modify the uid, gid (71, 72) and the home directory + to suite your system. + + - Add the following line to /etc/group: + + rootd:*:72:rootd + + where the gid must match the gid in /etc/passwd. + + - Create the directories: + + mkdir /var/spool/rootd + mkdir /var/spool/rootd/tmp + chmod 777 /var/spool/rootd/tmp + + Where /var/spool/rootd must match the rootd home directory as + specified in the rootd /etc/passwd entry. + + - To make writeable directories for anonymous do, for example: + + mkdir /var/spool/rootd/pub + chown rootd:rootd /var/spool/rootd/pub +- +That's all. Several additional remarks: you can login to an anonymous +server either with the names "anonymous" or "rootd". The password should +be of type user@host.do.main. Only the @ is enforced for the time +being. In anonymous mode the top of the file tree is set to the rootd +home directory, therefore only files below the home directory can be +accessed. Anonymous mode only works when the server is started via +inetd. + +***3. Notes about the shmem filetype: + +Shared memory files are currently supported on most Unix platforms, +where the shared memory segments are managed by the operating system +kernel and `live' independently of processes. They are not deleted (by +default) when the process which created them terminates, although they +will disappear if the system is rebooted. Applications can create +shared memory files in CFITSIO by calling: +- + fit_create_file(&fitsfileptr, "shmem://h2", &status); +- +where the root `file' names are currently restricted to be 'h0', 'h1', +'h2', 'h3', etc., up to a maximum number defined by the the value of +SHARED\_MAXSEG (equal to 16 by default). This is a prototype +implementation of the shared memory interface and a more robust +interface, which will have fewer restrictions on the number of files +and on their names, may be developed in the future. + +When opening an already existing FITS file in shared memory one calls +the usual CFITSIO routine: +- + fits_open_file(&fitsfileptr, "shmem://h7", mode, &status) +- +The file mode can be READWRITE or READONLY just as with disk files. +More than one process can operate on READONLY mode files at the same +time. CFITSIO supports proper file locking (both in READONLY and +READWRITE modes), so calls to fits\_open\_file may be locked out until +another other process closes the file. + +When an application is finished accessing a FITS file in a shared +memory segment, it may close it (and the file will remain in the +system) with fits\_close\_file, or delete it with fits\_delete\_file. +Physical deletion is postponed until the last process calls +ffclos/ffdelt. fits\_delete\_file tries to obtain a READWRITE lock on +the file to be deleted, thus it can be blocked if the object was not +opened in READWRITE mode. + +A shared memory management utility program called `smem', is included +with the CFITSIO distribution. It can be built by typing `make smem'; +then type `smem -h' to get a list of valid options. Executing smem +without any options causes it to list all the shared memory segments +currently residing in the system and managed by the shared memory +driver. To get a list of all the shared memory objects, run the system +utility program `ipcs [-a]'. + +**B. Base Filename + +The base filename is the name of the file optionally including the +director/subdirectory path, and in the case of `ftp', `http', and `root' +filetypes, the machine identifier. Examples: +- + myfile.fits + !data.fits + /data/myfile.fits + fits.gsfc.nasa.gov/ftp/sampledata/myfile.fits.gz +- + +When creating a new output file on magnetic disk (of type file://) if +the base filename begins with an exclamation point (!) then any +existing file with that same basename will be deleted prior to creating +the new FITS file. Otherwise if the file to be created already exists, +then CFITSIO will return an error and will not overwrite the existing +file. Note that the exclamation point, '!', is a special UNIX +character, so if it is used on the command line rather than entered at +a task prompt, it must be preceded by a backslash to force the UNIX +shell to pass it verbatim to the application program. + +If the output disk file name ends with the suffix '.gz', then CFITSIO +will compress the file using the gzip compression algorithm before +writing it to disk. This can reduce the amount of disk space used by +the file. Note that this feature requires that the uncompressed file +be constructed in memory before it is compressed and written to disk, +so it can fail if there is insufficient available memory. + +An input FITS file may be compressed with the gzip or Unix compress +algorithms, in which case CFITSIO will uncompress the file on the fly +into a temporary file (in memory or on disk). Compressed files may +only be opened with read-only permission. When specifying the name of +a compressed FITS file it is not necessary to append the file suffix +(e.g., `.gz' or `.Z'). If CFITSIO cannot find the input file name +without the suffix, then it will automatically search for a compressed +file with the same root name. In the case of reading ftp and http type +files, CFITSIO generally looks for a compressed version of the file +first, before trying to open the uncompressed file. By default, +CFITSIO copies (and uncompressed if necessary) the ftp or http FITS +file into memory on the local machine before opening it. This will +fail if the local machine does not have enough memory to hold the whole +FITS file, so in this case, the output filename specifier (see the next +section) can be used to further control how CFITSIO reads ftp and http +files. + +If the input file is an IRAF image file (*.imh file) then CFITSIO will +automatically convert it on the fly into a virtual FITS image before it +is opened by the application program. IRAF images can only be opened +with READONLY file access. + +Similarly, if the input file is a raw binary data array, then CFITSIO +will convert it on the fly into a virtual FITS image with the basic set +of required header keywords before it is opened by the application +program (with READONLY access). In this case the data type and +dimensions of the image must be specified in square brackets following +the filename (e.g. rawfile.dat[ib512,512]). The first character (case +insensitive) defines the data type of the array: +- + b 8-bit unsigned byte + i 16-bit signed integer + u 16-bit unsigned integer + j 32-bit signed integer + r or f 32-bit floating point + d 64-bit floating point +- +An optional second character specifies the byte order of the array +values: b or B indicates big endian (as in FITS files and the native +format of SUN UNIX workstations and Mac PCs) and l or L indicates +little endian (native format of DEC OSF workstations and IBM PCs). If +this character is omitted then the array is assumed to have the native +byte order of the local machine. These data type characters are then +followed by a series of one or more integer values separated by commas +which define the size of each dimension of the raw array. Arrays with +up to 5 dimensions are currently supported. Finally, a byte offset to +the position of the first pixel in the data file may be specified by +separating it with a ':' from the last dimension value. If omitted, it +is assumed that the offset = 0. This parameter may be used to skip +over any header information in the file that precedes the binary data. +Further examples: +- + raw.dat[b10000] 1-dimensional 10000 pixel byte array + raw.dat[rb400,400,12] 3-dimensional floating point big-endian array + img.fits[ib512,512:2880] reads the 512 x 512 short integer array in + a FITS file, skipping over the 2880 byte header +- + +One special case of input file is where the filename = `-' (a dash or +minus sign) or 'stdin' or 'stdout', which signifies that the input file +is to be read from the stdin stream, or written to the stdout stream if +a new output file is being created. In the case of reading from stdin, +CFITSIO first copies the whole stream into a temporary FITS file (in +memory or on disk), and subsequent reading of the FITS file occurs in +this copy. When writing to stdout, CFITSIO first constructs the whole +file in memory (since random access is required), then flushes it out +to the stdout stream when the file is closed. In addition, if the +output filename = '-.gz' or 'stdout.gz' then it will be gzip compressed +before being written to stdout. + +This ability to read and write on the stdin and stdout steams allows +FITS files to be piped between tasks in memory rather than having to +create temporary intermediate FITS files on disk. For example if task1 +creates an output FITS file, and task2 reads an input FITS file, the +FITS file may be piped between the 2 tasks by specifying +- + task1 - | task2 - +- +where the vertical bar is the Unix piping symbol. This assumes that the 2 +tasks read the name of the FITS file off of the command line. + +**C. Output File Name when Opening an Existing File + +An optional output filename may be specified in parentheses immediately +following the base file name to be opened. This is mainly useful in +those cases where CFITSIO creates a temporary copy of the input FITS +file before it is opened and passed to the application program. This +happens by default when opening a network FTP or HTTP-type file, when +reading a compressed FITS file on a local disk, when reading from the +stdin stream, or when a column filter, row filter, or binning specifier +is included as part of the input file specification. By default this +temporary file is created in memory. If there is not enough memory to +create the file copy, then CFITSIO will exit with an error. In these +cases one can force a permanent file to be created on disk, instead of +a temporary file in memory, by supplying the name in parentheses +immediately following the base file name. The output filename can +include the '!' clobber flag. + +Thus, if the input filename to CFITSIO is: +\verb+file1.fits.gz(file2.fits)+ +then CFITSIO will uncompress `file1.fits.gz' into the local disk file +`file2.fits' before opening it. CFITSIO does not automatically delete +the output file, so it will still exist after the application program +exits. + +The output filename "mem://" is also allowed, which will write the +output file into memory, and also allow write access to the file. This +'file' will disappear when it is closed, but this may be useful for +some applications which only need to modify a temporary copy of the file. + +In some cases, several different temporary FITS files will be created +in sequence, for instance, if one opens a remote file using FTP, then +filters rows in a binary table extension, then create an image by +binning a pair of columns. In this case, the remote file will be +copied to a temporary local file, then a second temporary file will be +created containing the filtered rows of the table, and finally a third +temporary file containing the binned image will be created. In cases +like this where multiple files are created, the outfile specifier will +be interpreted the name of the final file as described below, in descending +priority: + +\begin{itemize} +\item +as the name of the final image file if an image within a single binary +table cell is opened or if an image is created by binning a table column. +\item +as the name of the file containing the filtered table if a column filter +and/or a row filter are specified. +\item +as the name of the local copy of the remote FTP or HTTP file. +\item +as the name of the uncompressed version of the FITS file, if a +compressed FITS file on local disk has been opened. +\item +otherwise, the output filename is ignored. +\end{itemize} + +The output file specifier is useful when reading FTP or HTTP-type +FITS files since it can be used to create a local disk copy of the file +that can be reused in the future. If the output file name = `*' then a +local file with the same name as the network file will be created. +Note that CFITSIO will behave differently depending on whether the +remote file is compressed or not as shown by the following examples: +\begin{itemize} +\item +\verb+ftp://remote.machine/tmp/myfile.fits.gz(*)+ - the remote compressed +file is copied to the local compressed file `myfile.fits.gz', which +is then uncompressed in local memory before being opened and passed +to the application program. + +\item +\verb+ftp://remote.machine/tmp/myfile.fits.gz(myfile.fits)+ - the +remote compressed file is copied and uncompressed into the local file +`myfile.fits'. This example requires less local memory than the +previous example since the file is uncompressed on disk instead of in +memory. + +\item +\verb+ftp://remote.machine/tmp/myfile.fits(myfile.fits.gz)+ - this will +usually produce an error since CFITSIO itself cannot compress files. +\end{itemize} + +The exact behavior of CFITSIO in the latter case depends on the type of +ftp server running on the remote machine and how it is configured. In +some cases, if the file `myfile.fits.gz' exists on the remote machine, +then the server will copy it to the local machine. In other cases the +ftp server will automatically create and transmit a compressed version +of the file if only the uncompressed version exists. This can get +rather confusing, so users should use a certain amount of caution when +using the output file specifier with FTP or HTTP file types, to make +sure they get the behavior that they expect. + +**D. Template File Name when Creating a New File + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described in the following Template Files chapter. + +**E. Image Tile-Compression Specification + +When specifying the name of the output FITS file to be created, the +user can indicate that images should be written in tile-compressed +format (see section 5.5, ``Primary Array or IMAGE Extension I/O +Routines'') by enclosing the compression parameters in square brackets +following the root disk file name. Here are some examples of the +syntax for specifying tile-compressed output images: +- + myfile.fit[compress] - use Rice algorithm and default tile size + + myfile.fit[compress GZIP] - use the specified compression algorithm; + myfile.fit[compress Rice] only the first letter of the algorithm + myfile.fit[compress PLIO] name is required. + + myfile.fit[compress Rice 100,100] - use 100 x 100 pixel tile size + myfile.fit[compress Rice 100,100;2] - as above, and use noisebits = 2 +- + +**F. HDU Location Specification + +The optional HDU location specifier defines which HDU (Header-Data +Unit, also known as an `extension') within the FITS file to initially +open. It must immediately follow the base file name (or the output +file name if present). If it is not specified then the first HDU (the +primary array) is opened. The HDU location specifier is required if +the colFilter, rowFilter, or binSpec specifiers are present, because +the primary array is not a valid HDU for these operations. The HDU may +be specified either by absolute position number, starting with 0 for +the primary array, or by reference to the HDU name, and optionally, the +version number and the HDU type of the desired extension. The location +of an image within a single cell of a binary table may also be +specified, as described below. + +The absolute position of the extension is specified either by enclosed +the number in square brackets (e.g., `[1]' = the first extension +following the primary array) or by preceded the number with a plus sign +(`+1'). To specify the HDU by name, give the name of the desired HDU +(the value of the EXTNAME or HDUNAME keyword) and optionally the +extension version number (value of the EXTVER keyword) and the +extension type (value of the XTENSION keyword: IMAGE, ASCII or TABLE, +or BINTABLE), separated by commas and all enclosed in square brackets. +If the value of EXTVER and XTENSION are not specified, then the first +extension with the correct value of EXTNAME is opened. The extension +name and type are not case sensitive, and the extension type may be +abbreviated to a single letter (e.g., I = IMAGE extension or primary +array, A or T = ASCII table extension, and B = binary table BINTABLE +extension). If the HDU location specifier is equal to `[PRIMARY]' or +`[P]', then the primary array (the first HDU) will be opened. + +FITS images are most commonly stored in the primary array or an image +extension, but images can also be stored as a vector in a single cell +of a binary table (i.e. each row of the vector column contains a +different image). Such an image can be opened with CFITSIO by +specifying the desired column name and the row number after the binary +table HDU specifier as shown in the following examples. The column name +is separated from the HDU specifier by a semicolon and the row number +is enclosed in parentheses. In this case CFITSIO copies the image from +the table cell into a temporary primary array before it is opened. The +application program then just sees the image in the primary array, +without any extensions. The particular row to be opened may be +specified either by giving an absolute integer row number (starting +with 1 for the first row), or by specifying a boolean expression that +evaluates to TRUE for the desired row. The first row that satisfies +the expression will be used. The row selection expression has the same +syntax as described in the Row Filter Specifier section, below. + + Examples: +- + myfile.fits[3] - open the 3rd HDU following the primary array + myfile.fits+3 - same as above, but using the FTOOLS-style notation + myfile.fits[EVENTS] - open the extension that has EXTNAME = 'EVENTS' + myfile.fits[EVENTS, 2] - same as above, but also requires EXTVER = 2 + myfile.fits[events,2,b] - same, but also requires XTENSION = 'BINTABLE' + myfile.fits[3; images(17)] - opens the image in row 17 of the 'images' + column in the 3rd extension of the file. + myfile.fits[3; images(exposure > 100)] - as above, but opens the image + in the first row that has an 'exposure' column value + greater than 100. +- + +**G. Image Section + +A virtual file containing a rectangular subsection of an image can be +extracted and opened by specifying the range of pixels (start:end) +along each axis to be extracted from the original image. One can also +specify an optional pixel increment (start:end:step) for each axis of +the input image. A pixel step = 1 will be assumed if it is not +specified. If the start pixel is larger then the end pixel, then the +image will be flipped (producing a mirror image) along that dimension. +An asterisk, '*', may be used to specify the entire range of an axis, +and '-*' will flip the entire axis. The input image can be in the +primary array, in an image extension, or contained in a vector cell of +a binary table. In the later 2 cases the extension name or number must +be specified before the image section specifier. + + Examples: +- + myfile.fits[1:512:2, 2:512:2] - open a 256x256 pixel image + consisting of the odd numbered columns (1st axis) and + the even numbered rows (2nd axis) of the image in the + primary array of the file. + + myfile.fits[*, 512:256] - open an image consisting of all the columns + in the input image, but only rows 256 through 512. + The image will be flipped along the 2nd axis since + the starting pixel is greater than the ending pixel. + + myfile.fits[*:2, 512:256:2] - same as above but keeping only + every other row and column in the input image. + + myfile.fits[-*, *] - copy the entire image, flipping it along + the first axis. + + myfile.fits[3][1:256,1:256] - opens a subsection of the image that + is in the 3rd extension of the file. + + myfile.fits[4; images(12)][1:10,1:10] - open an image consisting + of the first 10 pixels in both dimensions. The original + image resides in the 12th row of the 'images' vector + column in the table in the 4th extension of the file. +- + +When CFITSIO opens an image section it first creates a temporary file +containing the image section plus a copy of any other HDUs in the +file. This temporary file is then opened by the application program, +so it is not possible to write to or modify the input file when +specifying an image section. Note that CFITSIO automatically updates +the world coordinate system keywords in the header of the image +section, if they exist, so that the coordinate associated with each +pixel in the image section will be computed correctly. + +**H. Column and Keyword Filtering Specification + +The optional column/keyword filtering specifier is used to modify the +column structure and/or the header keywords in the HDU that was +selected with the previous HDU location specifier. This filtering +specifier must be enclosed in square brackets and can be distinguished +from a general row filter specifier (described below) by the fact that +it begins with the string 'col ' and is not immediately followed by an +equals sign. The original file is not changed by this filtering +operation, and instead the modifications are made on a copy of the +input FITS file (usually in memory), which also contains a copy of all +the other HDUs in the file. This temporary file is passed to the +application program and will persist only until the file is closed or +until the program exits, unless the outfile specifier (see above) is +also supplied. + +The column/keyword filter can be used to perform the following +operations. More than one operation may be specified by separating +them with semi-colons. + +\begin{itemize} + +\item +Copy only a specified list of columns columns to the filtered input file. +The list of column name should be separated by semi-colons. Wild card +characters may be used in the column names to match multiple columns. +If the expression contains both a list of columns to be included and +columns to be deleted, then all the columns in the original table +except the explicitly deleted columns will appear in the filtered +table (i.e., there is no need to explicitly list the columns to +be included if any columns are being deleted). + +\item +Delete a column or keyword by listing the name preceded by a minus sign +or an exclamation mark (!), e.g., '-TIME' will delete the TIME column +if it exists, otherwise the TIME keyword. An error is returned if +neither a column nor keyword with this name exists. Note that the +exclamation point, '!', is a special UNIX character, so if it is used +on the command line rather than entered at a task prompt, it must be +preceded by a backslash to force the UNIX shell to ignore it. + +\item +Rename an existing column or keyword with the syntax 'NewName == +OldName'. An error is returned if neither a column nor keyword with +this name exists. + +\item +Append a new column or keyword to the table. To create a column, +give the new name, optionally followed by the data type in parentheses, +followed by a single equals sign and an expression to be used to +compute the value (e.g., 'newcol(1J) = 0' will create a new 32-bit +integer column called 'newcol' filled with zeros). The data type is +specified using the same syntax that is allowed for the value of the +FITS TFORMn keyword (e.g., 'I', 'J', 'E', 'D', etc. for binary tables, +and 'I8', F12.3', 'E20.12', etc. for ASCII tables). If the data type is +not specified then an appropriate data type will be chosen depending on +the form of the expression (may be a character string, logical, bit, long +integer, or double column). An appropriate vector count (in the case +of binary tables) will also be added if not explicitly specified. + +When creating a new keyword, the keyword name must be preceded by a +pound sign '\#', and the expression must evaluate to a scalar +(i.e., cannot have a column name in the expression). The comment +string for the keyword may be specified in parentheses immediately +following the keyword name (instead of supplying a data type as in +the case of creating a new column). + +\item +Recompute (overwrite) the values in an existing column or keyword by +giving the name followed by an equals sign and an arithmetic +expression. +\end{itemize} + +The expression that is used when appending or recomputing columns or +keywords can be arbitrarily complex and may be a function of other +header keyword values and other columns (in the same row). The full +syntax and available functions for the expression are described below +in the row filter specification section. + + +For complex or commonly used operations, one can also place the +operations into an external text file and import it into the column +filter using the syntax '[col @filename.txt]'. The operations can +extend over multiple lines of the file, but multiple operations must +still be separated by semicolons. Any lines in the external text file +that begin with 2 slash characters ('//') will be ignored and may be +used to add comments into the file. + +Examples: +- + [col Time;rate] - only the Time and rate columns will + appear in the filtered input file. + + [col Time;*raw] - include the Time column and any other + columns whose name ends with 'raw'. + + [col -TIME; Good == STATUS] - deletes the TIME column and + renames the status column to 'Good' + + [col PI=PHA * 1.1 + 0.2] - creates new PI column from PHA values + + [col rate = rate/exposure] - recomputes the rate column by dividing + it by the EXPOSURE keyword value. +- + +**I. Row Filtering Specification + + When entering the name of a FITS table that is to be opened by a + program, an optional row filter may be specified to select a subset + of the rows in the table. A temporary new FITS file is created on + the fly which contains only those rows for which the row filter + expression evaluates to true. (The primary array and any other + extensions in the input file are also copied to the temporary + file). The original FITS file is closed and the new virtual file + is opened by the application program. The row filter expression is + enclosed in square brackets following the file name and extension + name (e.g., 'file.fits[events][GRADE==50]' selects only those rows + where the GRADE column value equals 50). When dealing with tables + where each row has an associated time and/or 2D spatial position, + the row filter expression can also be used to select rows based on + the times in a Good Time Intervals (GTI) extension, or on spatial + position as given in a SAO-style region file. + +***1. General Syntax + + The row filtering expression can be an arbitrarily complex series + of operations performed on constants, keyword values, and column + data taken from the specified FITS TABLE extension. The expression + must evaluate to a boolean value for each row of the table, where + a value of FALSE means that the row will be excluded. + + For complex or commonly used filters, one can place the expression + into a text file and import it into the row filter using the syntax + '[@filename.txt]'. The expression can be arbitrarily complex and + extend over multiple lines of the file. Any lines in the external + text file that begin with 2 slash characters ('//') will be ignored + and may be used to add comments into the file. + + Keyword and column data are referenced by name. Any string of + characters not surrounded by quotes (ie, a constant string) or + followed by an open parentheses (ie, a function name) will be + initially interpreted as a column name and its contents for the + current row inserted into the expression. If no such column exists, + a keyword of that name will be searched for and its value used, if + found. To force the name to be interpreted as a keyword (in case + there is both a column and keyword with the same name), precede the + keyword name with a single pound sign, '\#', as in '\#NAXIS2'. Due to + the generalities of FITS column and keyword names, if the column or + keyword name contains a space or a character which might appear as + an arithmetic term then inclose the name in '\$' characters as in + \$MAX PHA\$ or \#\$MAX-PHA\$. Names are case insensitive. + + To access a table entry in a row other than the current one, follow + the column's name with a row offset within curly braces. For + example, 'PHA\{-3\}' will evaluate to the value of column PHA, 3 rows + above the row currently being processed. One cannot specify an + absolute row number, only a relative offset. Rows that fall outside + the table will be treated as undefined, or NULLs. + + Boolean operators can be used in the expression in either their + Fortran or C forms. The following boolean operators are available: +- + "equal" .eq. .EQ. == "not equal" .ne. .NE. != + "less than" .lt. .LT. < "less than/equal" .le. .LE. <= =< + "greater than" .gt. .GT. > "greater than/equal" .ge. .GE. >= => + "or" .or. .OR. || "and" .and. .AND. && + "negation" .not. .NOT. ! "approx. equal(1e-7)" ~ +- + +Note that the exclamation +point, '!', is a special UNIX character, so if it is used on the +command line rather than entered at a task prompt, it must be preceded +by a backslash to force the UNIX shell to ignore it. + + The expression may also include arithmetic operators and functions. + Trigonometric functions use radians, not degrees. The following + arithmetic operators and functions can be used in the expression + (function names are case insensitive). A null value will be returned + in case of illegal operations such as divide by zero, sqrt(negative) + log(negative), log10(negative), arccos(.gt. 1), arcsin(.gt. 1). + +- + "addition" + "subtraction" - + "multiplication" * "division" / + "negation" - "exponentiation" ** ^ + "absolute value" abs(x) "cosine" cos(x) + "sine" sin(x) "tangent" tan(x) + "arc cosine" arccos(x) "arc sine" arcsin(x) + "arc tangent" arctan(x) "arc tangent" arctan2(x,y) + "hyperbolic cos" cosh(x) "hyperbolic sin" sinh(x) + "hyperbolic tan" tanh(x) "round to nearest int" round(x) + "round down to int" floor(x) "round up to int" ceil(x) + "exponential" exp(x) "square root" sqrt(x) + "natural log" log(x) "common log" log10(x) + "modulus" i % j "random # [0.0,1.0)" random() + "minimum" min(x,y) "maximum" max(x,y) + "cumulative sum" accum(x) "sequential difference" seqdiff(x) + "if-then-else" b?x:y +- + + An alternate syntax for the min and max functions has only a single + argument which should be a vector value (see below). The result + will be the minimum/maximum element contained within the vector. + + The accum(x) function forms the cumulative sum of x, element by element. + Vector columns are supported simply by performing the summation process + through all the values. Null values are treated as 0. The seqdiff(x) + function forms the sequential difference of x, element by element. + The first value of seqdiff is the first value of x. A single null + value in x causes a pair of nulls in the output. The seqdiff and + accum functions are functional inverses, i.e., seqdiff(accum(x)) == x + as long as no null values are present. + + The following type casting operators are available, where the + inclosing parentheses are required and taken from the C language + usage. Also, the integer to real casts values to double precision: +- + "real to integer" (int) x (INT) x + "integer to real" (float) i (FLOAT) i +- + + In addition, several constants are built in for use in numerical + expressions: + +- + #pi 3.1415... #e 2.7182... + #deg #pi/180 #row current row number + #null undefined value #snull undefined string +- + + A string constant must be enclosed in quotes as in 'Crab'. The + "null" constants are useful for conditionally setting table values + to a NULL, or undefined, value (eg., "col1==-99 ? \#NULL : col1"). + + There is also a function for testing if two values are close to + each other, i.e., if they are "near" each other to within a user + specified tolerance. The arguments, value\_1 and value\_2 can be + integer or real and represent the two values who's proximity is + being tested to be within the specified tolerance, also an integer + or real: +- + near(value_1, value_2, tolerance) +- + When a NULL, or undefined, value is encountered in the FITS table, + the expression will evaluate to NULL unless the undefined value is + not actually required for evaluation, e.g. "TRUE .or. NULL" + evaluates to TRUE. The following two functions allow some NULL + detection and handling: +- + "a null value?" ISNULL(x) + "define a value for null" DEFNULL(x,y) +- + The former + returns a boolean value of TRUE if the argument x is NULL. The + later "defines" a value to be substituted for NULL values; it + returns the value of x if x is not NULL, otherwise it returns the + value of y. + + + +***2. Bit Masks + + Bit masks can be used to select out rows from bit columns (TFORMn = + \#X) in FITS files. To represent the mask, binary, octal, and hex + formats are allowed: + +- + binary: b0110xx1010000101xxxx0001 + octal: o720x1 -> (b111010000xxx001) + hex: h0FxD -> (b00001111xxxx1101) +- + + In all the representations, an x or X is allowed in the mask as a + wild card. Note that the x represents a different number of wild + card bits in each representation. All representations are case + insensitive. + + To construct the boolean expression using the mask as the boolean + equal operator described above on a bit table column. For example, + if you had a 7 bit column named flags in a FITS table and wanted + all rows having the bit pattern 0010011, the selection expression + would be: + +- + flags == b0010011 + or + flags .eq. b10011 +- + + It is also possible to test if a range of bits is less than, less + than equal, greater than and greater than equal to a particular + boolean value: + +- + flags <= bxxx010xx + flags .gt. bxxx100xx + flags .le. b1xxxxxxx +- + + Notice the use of the x bit value to limit the range of bits being + compared. + + It is not necessary to specify the leading (most significant) zero + (0) bits in the mask, as shown in the second expression above. + + Bit wise AND, OR and NOT operations are also possible on two or + more bit fields using the '\&'(AND), '$|$'(OR), and the '!'(NOT) + operators. All of these operators result in a bit field which can + then be used with the equal operator. For example: + +- + (!flags) == b1101100 + (flags & b1000001) == bx000001 +- + + Bit fields can be appended as well using the '+' operator. Strings + can be concatenated this way, too. + +***3. Vector Columns + + Vector columns can also be used in building the expression. No + special syntax is required if one wants to operate on all elements + of the vector. Simply use the column name as for a scalar column. + Vector columns can be freely intermixed with scalar columns or + constants in virtually all expressions. The result will be of the + same dimension as the vector. Two vectors in an expression, though, + need to have the same number of elements and have the same + dimensions. The only places a vector column cannot be used (for + now, anyway) are the SAO region functions and the NEAR boolean + function. + + Arithmetic and logical operations are all performed on an element by + element basis. Comparing two vector columns, eg "COL1 == COL2", + thus results in another vector of boolean values indicating which + elements of the two vectors are equal. + + Eight functions are available that operate on a vector and return a + scalar result: +- + "minimum" MIN(V) "maximum" MAX(V) + "average" AVERAGE(V) "median" MEDIAN(V) + "sumation" SUM(V) "standard deviation" STDDEV(V) + "# of values" NELEM(V) "# of non-null values" NVALID(V) +- + where V represents the name of a vector column or a manually + constructed vector using curly brackets as described below. The + first 6 of these functions ignore any null values in the vector when + computing the result. + + The SUM function literally sums all the elements in x, returning a + scalar value. If V is a boolean vector, SUM returns the number + of TRUE elements. The NELEM function returns the number of elements + in vector V whereas NVALID return the number of non-null elements in + the vector. (NELEM also operates on bit and string columns, + returning their column widths.) As an example, to test whether all + elements of two vectors satisfy a given logical comparison, one can + use the expression +- + SUM( COL1 > COL2 ) == NELEM( COL1 ) +- + + which will return TRUE if all elements of COL1 are greater than + their corresponding elements in COL2. + + To specify a single element of a vector, give the column name + followed by a comma-separated list of coordinates enclosed in + square brackets. For example, if a vector column named PHAS exists + in the table as a one dimensional, 256 component list of numbers + from which you wanted to select the 57th component for use in the + expression, then PHAS[57] would do the trick. Higher dimensional + arrays of data may appear in a column. But in order to interpret + them, the TDIMn keyword must appear in the header. Assuming that a + (4,4,4,4) array is packed into each row of a column named ARRAY4D, + the (1,2,3,4) component element of each row is accessed by + ARRAY4D[1,2,3,4]. Arrays up to dimension 5 are currently + supported. Each vector index can itself be an expression, although + it must evaluate to an integer value within the bounds of the + vector. Vector columns which contain spaces or arithmetic operators + must have their names enclosed in "\$" characters as with + \$ARRAY-4D\$[1,2,3,4]. + + A more C-like syntax for specifying vector indices is also + available. The element used in the preceding example alternatively + could be specified with the syntax ARRAY4D[4][3][2][1]. Note the + reverse order of indices (as in C), as well as the fact that the + values are still ones-based (as in Fortran -- adopted to avoid + ambiguity for 1D vectors). With this syntax, one does not need to + specify all of the indices. To extract a 3D slice of this 4D + array, use ARRAY4D[4]. + + Variable-length vector columns are not supported. + + Vectors can be manually constructed within the expression using a + comma-separated list of elements surrounded by curly braces ('\{\}'). + For example, '\{1,3,6,1\}' is a 4-element vector containing the values + 1, 3, 6, and 1. The vector can contain only boolean, integer, and + real values (or expressions). The elements will be promoted to the + highest data type present. Any elements which are themselves + vectors, will be expanded out with each of its elements becoming an + element in the constructed vector. + +***4. Good Time Interval Filtering + + A common filtering method involves selecting rows which have a time + value which lies within what is called a Good Time Interval or GTI. + The time intervals are defined in a separate FITS table extension + which contains 2 columns giving the start and stop time of each + good interval. The filtering operation accepts only those rows of + the input table which have an associated time which falls within + one of the time intervals defined in the GTI extension. A high + level function, gtifilter(a,b,c,d), is available which evaluates + each row of the input table and returns TRUE or FALSE depending + whether the row is inside or outside the good time interval. The + syntax is +- + gtifilter( [ "gtifile" [, expr [, "STARTCOL", "STOPCOL" ] ] ] ) + or + gtifilter( [ 'gtifile' [, expr [, 'STARTCOL', 'STOPCOL' ] ] ] ) +- + where each "[]" demarks optional parameters. Note that the quotes + around the gtifile and START/STOP column are required. Either single + or double quotes may be used. In cases where this expression is + entered on the Unix command line, enclose the entire expression in + double quotes, and then use single quotes within the expression to + enclose the 'gtifile' and other terms. It is also usually possible + to do the reverse, and enclose the whole expression in single quotes + and then use double quotes within the expression. The gtifile, + if specified, can be blank ("") which will mean to use the first + extension with the name "*GTI*" in the current file, a plain + extension specifier (eg, "+2", "[2]", or "[STDGTI]") which will be + used to select an extension in the current file, or a regular + filename with or without an extension specifier which in the latter + case will mean to use the first extension with an extension name + "*GTI*". Expr can be any arithmetic expression, including simply + the time column name. A vector time expression will produce a + vector boolean result. STARTCOL and STOPCOL are the names of the + START/STOP columns in the GTI extension. If one of them is + specified, they both must be. + + In its simplest form, no parameters need to be provided -- default + values will be used. The expression "gtifilter()" is equivalent to +- + gtifilter( "", TIME, "*START*", "*STOP*" ) +- + This will search the current file for a GTI extension, filter the + TIME column in the current table, using START/STOP times taken from + columns in the GTI extension with names containing the strings + "START" and "STOP". The wildcards ('*') allow slight variations in + naming conventions such as "TSTART" or "STARTTIME". The same + default values apply for unspecified parameters when the first one + or two parameters are specified. The function automatically + searches for TIMEZERO/I/F keywords in the current and GTI + extensions, applying a relative time offset, if necessary. + +***5. Spatial Region Filtering + + Another common filtering method selects rows based on whether the + spatial position associated with each row is located within a given + 2-dimensional region. The syntax for this high-level filter is +- + regfilter( "regfilename" [ , Xexpr, Yexpr [ , "wcs cols" ] ] ) +- + where each "[]" demarks optional parameters. The region file name + is required and must be enclosed in quotes. The remaining + parameters are optional. The region file is an ASCII text file + which contains a list of one or more geometric shapes (circle, + ellipse, box, etc.) which defines a region on the celestial sphere + or an area within a particular 2D image. The region file is + typically generated using an image display program such as fv/POW + (distribute by the HEASARC), or ds9 (distributed by the Smithsonian + Astrophysical Observatory). Users should refer to the documentation + provided with these programs for more details on the syntax used in + the region files. + + In its simpliest form, (e.g., regfilter("region.reg") ) the + coordinates in the default 'X' and 'Y' columns will be used to + determine if each row is inside or outside the area specified in + the region file. Alternate position column names, or expressions, + may be entered if needed, as in +- + regfilter("region.reg", XPOS, YPOS) +- + Region filtering can be applied most unambiguously if the positions + in the region file and in the table to be filtered are both give in + terms of absolute celestial coordinate units. In this case the + locations and sizes of the geometric shapes in the region file are + specified in angular units on the sky (e.g., positions given in + R.A. and Dec. and sizes in arcseconds or arcminutes). Similarly, + each row of the filtered table will have a celestial coordinate + associated with it. This association is usually implemented using + a set of so-called 'World Coordinate System' (or WCS) FITS keywords + that define the coordinate transformation that must be applied to + the values in the 'X' and 'Y' columns to calculate the coordinate. + + Alternatively, one can perform spatial filtering using unitless + 'pixel' coordinates for the regions and row positions. In this + case the user must be careful to ensure that the positions in the 2 + files are self-consistent. A typical problem is that the region + file may be generated using a binned image, but the unbinned + coordinates are given in the event table. The ROSAT events files, + for example, have X and Y pixel coordinates that range from 1 - + 15360. These coordinates are typically binned by a factor of 32 to + produce a 480x480 pixel image. If one then uses a region file + generated from this image (in image pixel units) to filter the + ROSAT events file, then the X and Y column values must be converted + to corresponding pixel units as in: +- + regfilter("rosat.reg", X/32.+.5, Y/32.+.5) +- + Note that this binning conversion is not necessary if the region + file is specified using celestial coordinate units instead of pixel + units because CFITSIO is then able to directly compare the + celestial coordinate of each row in the table with the celestial + coordinates in the region file without having to know anything + about how the image may have been binned. + + The last "wcs cols" parameter should rarely be needed. If supplied, + this string contains the names of the 2 columns (space or comma + separated) which have the associated WCS keywords. If not supplied, + the filter will scan the X and Y expressions for column names. + If only one is found in each expression, those columns will be + used, otherwise an error will be returned. + + These region shapes are supported (names are case insensitive): +- + Point ( X1, Y1 ) <- One pixel square region + Line ( X1, Y1, X2, Y2 ) <- One pixel wide region + Polygon ( X1, Y1, X2, Y2, ... ) <- Rest are interiors with + Rectangle ( X1, Y1, X2, Y2, A ) | boundaries considered + Box ( Xc, Yc, Wdth, Hght, A ) V within the region + Diamond ( Xc, Yc, Wdth, Hght, A ) + Circle ( Xc, Yc, R ) + Annulus ( Xc, Yc, Rin, Rout ) + Ellipse ( Xc, Yc, Rx, Ry, A ) + Elliptannulus ( Xc, Yc, Rinx, Riny, Routx, Routy, Ain, Aout ) + Sector ( Xc, Yc, Amin, Amax ) +- + where (Xc,Yc) is the coordinate of the shape's center; (X\#,Y\#) are + the coordinates of the shape's edges; Rxxx are the shapes' various + Radii or semimajor/minor axes; and Axxx are the angles of rotation + (or bounding angles for Sector) in degrees. For rotated shapes, the + rotation angle can be left off, indicating no rotation. Common + alternate names for the regions can also be used: rotbox = box; + rotrectangle = rectangle; (rot)rhombus = (rot)diamond; and pie + = sector. When a shape's name is preceded by a minus sign, '-', + the defined region is instead the area *outside* its boundary (ie, + the region is inverted). All the shapes within a single region + file are OR'd together to create the region, and the order is + significant. The overall way of looking at region files is that if + the first region is an excluded region then a dummy included region + of the whole detector is inserted in the front. Then each region + specification as it is processed overrides any selections inside of + that region specified by previous regions. Another way of thinking + about this is that if a previous excluded region is completely + inside of a subsequent included region the excluded region is + ignored. + + The positional coordinates may be given either in pixel units, + decimal degrees or hh:mm:ss.s, dd:mm:ss.s units. The shape sizes + may be given in pixels, degrees, arcminutes, or arcseconds. Look + at examples of region file produced by fv/POW or ds9 for further + details of the region file format. + + There are three functions that are primarily for use with SAO region + files and the FSAOI task, but they can be used directly. They + return a boolean true or false depending on whether a two + dimensional point is in the region or not: +- + "point in a circular region" + circle(xcntr,ycntr,radius,Xcolumn,Ycolumn) + + "point in an elliptical region" + ellipse(xcntr,ycntr,xhlf_wdth,yhlf_wdth,rotation,Xcolumn,Ycolumn) + + "point in a rectangular region" + box(xcntr,ycntr,xfll_wdth,yfll_wdth,rotation,Xcolumn,Ycolumn) + + where + (xcntr,ycntr) are the (x,y) position of the center of the region + (xhlf_wdth,yhlf_wdth) are the (x,y) half widths of the region + (xfll_wdth,yfll_wdth) are the (x,y) full widths of the region + (radius) is half the diameter of the circle + (rotation) is the angle(degrees) that the region is rotated with + respect to (xcntr,ycntr) + (Xcoord,Ycoord) are the (x,y) coordinates to test, usually column + names + NOTE: each parameter can itself be an expression, not merely a + column name or constant. +- + +***5. Example Row Filters +- + [ binary && mag <= 5.0] - Extract all binary stars brighter + than fifth magnitude (note that + the initial space is necessary to + prevent it from being treated as a + binning specification) + + [#row >= 125 && #row <= 175] - Extract row numbers 125 through 175 + + [IMAGE[4,5] .gt. 100] - Extract all rows that have the + (4,5) component of the IMAGE column + greater than 100 + + [abs(sin(theta * #deg)) < 0.5] - Extract all rows having the + absolute value of the sine of theta + less than a half where the angles + are tabulated in degrees + + [SUM( SPEC > 3*BACKGRND )>=1] - Extract all rows containing a + spectrum, held in vector column + SPEC, with at least one value 3 + times greater than the background + level held in a keyword, BACKGRND + + [VCOL=={1,4,2}] - Extract all rows whose vector column + VCOL contains the 3-elements 1, 4, and + 2. + + [@rowFilter.txt] - Extract rows using the expression + contained within the text file + rowFilter.txt + + [gtifilter()] - Search the current file for a GTI + extension, filter the TIME + column in the current table, using + START/STOP times taken from + columns in the GTI extension + + [regfilter("pow.reg")] - Extract rows which have a coordinate + (as given in the X and Y columns) + within the spatial region specified + in the pow.reg region file. + + [regfilter("pow.reg", Xs, Ys)] - Same as above, except that the + Xs and Ys columns will be used to + determine the coordinate of each + row in the table. +- + +**J. Binning or Histogramming Specification + +The optional binning specifier is enclosed in square brackets and can +be distinguished from a general row filter specification by the fact +that it begins with the keyword 'bin' not immediately followed by an +equals sign. When binning is specified, a temporary N-dimensional FITS +primary array is created by computing the histogram of the values in +the specified columns of a FITS table extension. After the histogram +is computed the input FITS file containing the table is then closed and +the temporary FITS primary array is opened and passed to the +application program. Thus, the application program never sees the +original FITS table and only sees the image in the new temporary file +(which has no additional extensions). Obviously, the application +program must be expecting to open a FITS image and not a FITS table in +this case. + +The data type of the FITS histogram image may be specified by appending +'b' (for 8-bit byte), 'i' (for 16-bit integers), 'j' (for 32-bit +integer), 'r' (for 32-bit floating points), or 'd' (for 64-bit double +precision floating point) to the 'bin' keyword (e.g. '[binr X]' +creates a real floating point image). If the data type is not +explicitly specified then a 32-bit integer image will be created by +default, unless the weighting option is also specified in which case +the image will have a 32-bit floating point data type by default. + +The histogram image may have from 1 to 4 dimensions (axes), depending +on the number of columns that are specified. The general form of the +binning specification is: +- + [bin{bijrd} Xcol=min:max:binsize, Ycol= ..., Zcol=..., Tcol=...; weight] +- +in which up to 4 columns, each corresponding to an axis of the image, +are listed. The column names are case insensitive, and the column +number may be given instead of the name, preceded by a pound sign +(e.g., [bin \#4=1:512]). If the column name is not specified, then +CFITSIO will first try to use the 'preferred column' as specified by +the CPREF keyword if it exists (e.g., 'CPREF = 'DETX,DETY'), otherwise +column names 'X', 'Y', 'Z', and 'T' will be assumed for each of the 4 +axes, respectively. In cases where the column name could be confused +with an arithmetic expression, enclose the column name in parentheses to +force the name to be interpreted literally. + +Each column name may be followed by an equals sign and then the lower +and upper range of the histogram, and the size of the histogram bins, +separated by colons. Spaces are allowed before and after the equals +sign but not within the 'min:max:binsize' string. The min, max and +binsize values may be integer or floating point numbers, or they may be +the names of keywords in the header of the table. If the latter, then +the value of that keyword is substituted into the expression. + +Default values for the min, max and binsize quantities will be +used if not explicitly given in the binning expression as shown +in these examples: +- + [bin x = :512:2] - use default minimum value + [bin x = 1::2] - use default maximum value + [bin x = 1:512] - use default bin size + [bin x = 1:] - use default maximum value and bin size + [bin x = :512] - use default minimum value and bin size + [bin x = 2] - use default minimum and maximum values + [bin x] - use default minimum, maximum and bin size + [bin 4] - default 2-D image, bin size = 4 in both axes + [bin] - default 2-D image +- +CFITSIO will use the value of the TLMINn, TLMAXn, and TDBINn keywords, +if they exist, for the default min, max, and binsize, respectively. If +they do not exist then CFITSIO will use the actual minimum and maximum +values in the column for the histogram min and max values. The default +binsize will be set to 1, or (max - min) / 10., whichever is smaller, +so that the histogram will have at least 10 bins along each axis. + +A shortcut notation is allowed if all the columns/axes have the same +binning specification. In this case all the column names may be listed +within parentheses, followed by the (single) binning specification, as +in: +- + [bin (X,Y)=1:512:2] + [bin (X,Y) = 5] +- + +The optional weighting factor is the last item in the binning specifier +and, if present, is separated from the list of columns by a +semi-colon. As the histogram is accumulated, this weight is used to +incremented the value of the appropriated bin in the histogram. If the +weighting factor is not specified, then the default weight = 1 is +assumed. The weighting factor may be a constant integer or floating +point number, or the name of a keyword containing the weighting value. +Or the weighting factor may be the name of a table column in which case +the value in that column, on a row by row basis, will be used. + +In some cases, the column or keyword may give the reciprocal of the +actual weight value that is needed. In this case, precede the weight +keyword or column name by a slash '/' to tell CFITSIO to use the +reciprocal of the value when constructing the histogram. + +For complex or commonly used histograms, one can also place its +description into a text file and import it into the binning +specification using the syntax [bin @filename.txt]. The file's +contents can extend over multiple lines, although it must still +conform to the no-spaces rule for the min:max:binsize syntax and each +axis specification must still be comma-separated. Any lines in the +external text file that begin with 2 slash characters ('//') will be +ignored and may be used to add comments into the file. + + Examples: + +- + [bini detx, dety] - 2-D, 16-bit integer histogram + of DETX and DETY columns, using + default values for the histogram + range and binsize + + [bin (detx, dety)=16; /exposure] - 2-D, 32-bit real histogram of DETX + and DETY columns with a bin size = 16 + in both axes. The histogram values + are divided by the EXPOSURE keyword + value. + + [bin time=TSTART:TSTOP:0.1] - 1-D lightcurve, range determined by + the TSTART and TSTOP keywords, + with 0.1 unit size bins. + + [bin pha, time=8000.:8100.:0.1] - 2-D image using default binning + of the PHA column for the X axis, + and 1000 bins in the range + 8000. to 8100. for the Y axis. + + [bin @binFilter.txt] - Use the contents of the text file + binFilter.txt for the binning + specifications. + +- +*X. Template Files + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described in the following sections. + +**A Detailed Template Line Format + +The format of each ASCII template line closely follows the format of a +FITS keyword record: +- + KEYWORD = KEYVALUE / COMMENT +- +except that free format may be used (e.g., the equals sign may appear +at any position in the line) and TAB characters are allowed and are +treated the same as space characters. The KEYVALUE and COMMENT fields +are optional. The equals sign character is also optional, but it is +recommended that it be included for clarity. Any template line that +begins with the pound '\#' character is ignored by the template parser +and may be use to insert comments into the template file itself. + +The KEYWORD name field is limited to 8 characters in length and only +the letters A-Z, digits 0-9, and the hyphen and underscore characters +may be used, without any embedded spaces. Lowercase letters in the +template keyword name will be converted to uppercase. Leading spaces +in the template line preceding the keyword name are generally ignored, +except if the first 8 characters of a template line are all blank, then +the entire line is treated as a FITS comment keyword (with a blank +keyword name) and is copied verbatim into the FITS header. + +The KEYVALUE field may have any allowed FITS data type: character +string, logical, integer, real, complex integer, or complex real. The +character string values need not be enclosed in single quote characters +unless they are necessary to distinguish the string from a different +data type (e.g. 2.0 is a real but '2.0' is a string). The keyword has +an undefined (null) value if the template record only contains blanks +following the "=" or between the "=" and the "/" comment field +delimiter. + +String keyword values longer than 68 characters (the maximum length +that will fit in a single FITS keyword record) are permitted using the +CFITSIO long string convention. They can either be specified as a +single long line in the template, or by using multiple lines where the +continuing lines contain the 'CONTINUE' keyword, as in this example: +- + LONGKEY = 'This is a long string value that is contin&' + CONTINUE 'ued over 2 records' / comment field goes here +- +The format of template lines with CONTINUE keyword is very strict: 3 +spaces must follow CONTINUE and the rest of the line is copied verbatim +to the FITS file. + +The start of the optional COMMENT field must be preceded by "/", which +is used to separate it from the keyword value field. Exceptions are if +the KEYWORD name field contains COMMENT, HISTORY, CONTINUE, or if the +first 8 characters of the template line are blanks. + +More than one Header-Data Unit (HDU) may be defined in the template +file. The start of an HDU definition is denoted with a SIMPLE or +XTENSION template line: + +1) SIMPLE begins a Primary HDU definition. SIMPLE may only appear as +the first keyword in the template file. If the template file begins +with XTENSION instead of SIMPLE, then a default empty Primary HDU is +created, and the template is then assumed to define the keywords +starting with the first extension following the Primary HDU. + +2) XTENSION marks the beginning of a new extension HDU definition. The +previous HDU will be closed at this point and processing of the next +extension begins. + +**B Auto-indexing of Keywords + +If a template keyword name ends with a "\#" character, it is said to be +'auto-indexed'. Each "\#" character will be replaced by the current +integer index value, which gets reset = 1 at the start of each new HDU +in the file (or 7 in the special case of a GROUP definition). The +FIRST indexed keyword in each template HDU definition is used as the +'incrementor'; each subsequent occurrence of this SAME keyword will +cause the index value to be incremented. This behavior can be rather +subtle, as illustrated in the following examples in which the TTYPE +keyword is the incrementor in both cases: +- + TTYPE# = TIME + TFORM# = 1D + TTYPE# = RATE + TFORM# = 1E +- +will create TTYPE1, TFORM1, TTYPE2, and TFORM2 keywords. But if the +template looks like, +- + TTYPE# = TIME + TTYPE# = RATE + TFORM# = 1D + TFORM# = 1E +- +this results in a FITS files with TTYPE1, TTYPE2, TFORM2, and TFORM2, +which is probably not what was intended! + +**C Template Parser Directives + +In addition to the template lines which define individual keywords, the +template parser recognizes 3 special directives which are each preceded +by the backslash character: \verb+ \include, \group+, and \verb+ \end+. + +The 'include' directive must be followed by a filename. It forces the +parser to temporarily stop reading the current template file and begin +reading the include file. Once the parser reaches the end of the +include file it continues parsing the current template file. Include +files can be nested, and HDU definitions can span multiple template +files. + +The start of a GROUP definition is denoted with the 'group' directive, +and the end of a GROUP definition is denoted with the 'end' directive. +Each GROUP contains 0 or more member blocks (HDUs or GROUPs). Member +blocks of type GROUP can contain their own member blocks. The GROUP +definition itself occupies one FITS file HDU of special type (GROUP +HDU), so if a template specifies 1 group with 1 member HDU like: +- +\group +grpdescr = 'demo' +xtension bintable +# this bintable has 0 cols, 0 rows +\end +- +then the parser creates a FITS file with 3 HDUs : +- +1) dummy PHDU +2) GROUP HDU (has 1 member, which is bintable in HDU number 3) +3) bintable (member of GROUP in HDU number 2) +- +Technically speaking, the GROUP HDU is a BINTABLE with 6 columns. Applications +can define additional columns in a GROUP HDU using TFORMn and TTYPEn +(where n is 7, 8, ....) keywords or their auto-indexing equivalents. + +For a more complicated example of a template file using the group directives, +look at the sample.tpl file that is included in the CFITSIO distribution. + +**D Formal Template Syntax + +The template syntax can formally be defined as follows: +- + TEMPLATE = BLOCK [ BLOCK ... ] + + BLOCK = { HDU | GROUP } + + GROUP = \GROUP [ BLOCK ... ] \END + + HDU = XTENSION [ LINE ... ] { XTENSION | \GROUP | \END | EOF } + + LINE = [ KEYWORD [ = ] ] [ VALUE ] [ / COMMENT ] + + X ... - X can be present 1 or more times + { X | Y } - X or Y + [ X ] - X is optional +- + +At the topmost level, the template defines 1 or more template blocks. Blocks +can be either HDU (Header Data Unit) or a GROUP. For each block the parser +creates 1 (or more for GROUPs) FITS file HDUs. + + +**E Errors + +In general the fits\_execute\_template() function tries to be as atomic +as possible, so either everything is done or nothing is done. If an +error occurs during parsing of the template, fits\_execute\_template() +will (try to) delete the top level BLOCK (with all its children if any) +in which the error occurred, then it will stop reading the template file +and it will return with an error. + +**F Examples + +1. This template file will create a 200 x 300 pixel image, with 4-byte +integer pixel values, in the primary HDU: +- + SIMPLE = T + BITPIX = 32 + NAXIS = 2 / number of dimensions + NAXIS1 = 100 / length of first axis + NAXIS2 = 200 / length of second axis + OBJECT = NGC 253 / name of observed object +- +The allowed values of BITPIX are 8, 16, 32, -32, or -64, +representing, respectively, 8-bit integer, 16-bit integer, 32-bit +integer, 32-bit floating point, or 64 bit floating point pixels. + +2. To create a FITS table, the template first needs to include +XTENSION = TABLE or BINTABLE to define whether it is an ASCII or binary +table, and NAXIS2 to define the number of rows in the table. Two +template lines are then needed to define the name (TTYPEn) and FITS data +format (TFORMn) of the columns, as in this example: +- + xtension = bintable + naxis2 = 40 + ttype# = Name + tform# = 10a + ttype# = Npoints + tform# = j + ttype# = Rate + tunit# = counts/s + tform# = e +- +The above example defines a null primary array followed by a 40-row +binary table extension with 3 columns called 'Name', 'Npoints', and +'Rate', with data formats of '10A' (ASCII character string), '1J' +(integer) and '1E' (floating point), respectively. Note that the other +required FITS keywords (BITPIX, NAXIS, NAXIS1, PCOUNT, GCOUNT, TFIELDS, +and END) do not need to be explicitly defined in the template because +their values can be inferred from the other keywords in the template. +This example also illustrates that the templates are generally +case-insensitive (the keyword names and TFORMn values are converted to +upper-case in the FITS file) and that string keyword values generally +do not need to be enclosed in quotes. + +*XI. Local FITS Conventions + +CFITSIO supports several local FITS conventions which are not +defined in the official NOST FITS standard and which are not +necessarily recognized or supported by other FITS software packages. +Programmers should be cautious about using these features, especially +if the FITS files that are produced are expected to be processed by +other software systems which do not use the CFITSIO interface. + +**A. 64-Bit Long Integers + +CFITSIO can read and write FITS images or table columns containing +64-bit integer data values. This data type is not recognized in the +official FITS Standard definition document, but it is likely that FITS +will eventually support this data type, especially as computers that +run 64-bit operating systems become more common. Support for reading +and writing 64-bit integers in CFITSIO can be controlled with the +\#define statement at the beginning of the fitsio2.h file by setting +SUPPORT\_64BIT\_INTEGERS to 1 (enable) or 0 (disable). + +Under the convention used by CFITSIO, FITS 64-bit images have BITPIX = +64, and the 64-bit binary table columns have TFORMn = 'K'. The use of +these data types on platforms where the size of a 'long' (or 'longlong') +integer = 8 bytes is rather intuitive. CFITSIO will write 64-bit +'long' variable values to the FITS file and read them back into 'long' +variables just as one would expect. CFITSIO also supports implicit +data type conversion between 64-bit integer images and columns and any +other supported data type, although some loss of numerical precision or +numerical overflow is likely in this case. + +The situation is more difficult on 32-bit computing platforms that do +not support an intrinsic 64-bit integer data type. In this case it is +not possible to return the full 64 precision of the FITS data values when +reading the values into a program variable. CFITSIO will still +convert the 64-bit integer values into any other supported data type; +the 64-bit double data type is probably the most useful in this case. +It only provides about 52-bits of precision in the mantissa, however, +so some lose of precision is possible. + +**B. Long String Keyword Values. + +The length of a standard FITS string keyword is limited to 68 +characters because it must fit entirely within a single FITS header +keyword record. In some instances it is necessary to encode strings +longer than this limit, so CFITSIO supports a local convention in which +the string value is continued over multiple keywords. This +continuation convention uses an ampersand character at the end of each +substring to indicate that it is continued on the next keyword, and the +continuation keywords all have the name CONTINUE without an equal sign +in column 9. The string value may be continued in this way over as many +additional CONTINUE keywords as is required. The following lines +illustrate this continuation convention which is used in the value of +the STRKEY keyword: +- +LONGSTRN= 'OGIP 1.0' / The OGIP Long String Convention may be used. +STRKEY = 'This is a very long string keyword&' / Optional Comment +CONTINUE ' value that is continued over 3 keywords in the & ' +CONTINUE 'FITS header.' / This is another optional comment. +- +It is recommended that the LONGSTRN keyword, as shown here, always be +included in any HDU that uses this longstring convention as a warning +to any software that must read the keywords. A routine called fits\_write\_key\_longwarn +has been provided in CFITSIO to write this keyword if it does not +already exist. + +This long string convention is supported by the following CFITSIO +routines: +- + fits_write_key_longstr - write a long string keyword value + fits_insert_key_longstr - insert a long string keyword value + fits_modify_key_longstr - modify a long string keyword value + fits_update_key_longstr - modify a long string keyword value + fits_read_key_longstr - read a long string keyword value + fits_delete_key - delete a keyword +- +The fits\_read\_key\_longstr routine is unique among all the CFITSIO +routines in that it internally allocates memory for the long string +value; all the other CFITSIO routines that deal with arrays require +that the calling program pre-allocate adequate space to hold the array +of data. Consequently, programs which use the fits\_read\_key\_longstr +routine must be careful to free the allocated memory for the string +when it is no longer needed. + +The following 2 routines also have limited support for this long string +convention, +- + fits_modify_key_str - modify an existing string keyword value + fits_update_key_str - update a string keyword value +- +in that they will correctly overwrite an existing long string value, +but the new string value is limited to a maximum of 68 characters in +length. + +The more commonly used CFITSIO routines to write string valued keywords +(fits\_update\_key and fits\_write\_key) do not support this long +string convention and only support strings up to 68 characters in +length. This has been done deliberately to prevent programs from +inadvertently writing keywords using this non-standard convention +without the explicit intent of the programmer or user. The +fits\_write\_key\_longstr routine must be called instead to write long +strings. This routine can also be used to write ordinary string values +less than 68 characters in length. + +**C. Arrays of Fixed-Length Strings in Binary Tables + +The definition of the FITS binary table extension format does not +provide a simple way to specify that a character column contains an +array of fixed-length strings. To support this feature, CFITSIO uses a +local convention for the format of the TFORMn keyword value of the form +'rAw' where 'r' is an integer specifying the total width in characters +of the column, and 'w' is an integer specifying the (fixed) length of +an individual unit string within the vector. For example, TFORM1 = +'120A10' would indicate that the binary table column is 120 characters +wide and consists of 12 10-character length strings. This convention +is recognized by the CFITSIO routines that read or write strings in +binary tables. The Binary Table definition document specifies that +other optional characters may follow the data type code in the TFORM +keyword, so this local convention is in compliance with the +FITS standard although other FITS readers may not +recognize this convention. + +The Binary Table definition document that was approved by the IAU in +1994 contains an appendix describing an alternate convention for +specifying arrays of fixed or variable length strings in a binary table +character column (with the form 'rA:SSTRw/nnn)'. This appendix was not +officially voted on by the IAU and hence is still provisional. CFITSIO +does not currently support this proposal. + +**D. Keyword Units Strings + +One limitation of the current FITS Standard is that it does not define +a specific convention for recording the physical units of a keyword +value. The TUNITn keyword can be used to specify the physical units of +the values in a table column, but there is no analogous convention for +keyword values. The comment field of the keyword is often used for +this purpose, but the units are usually not specified in a well defined +format that FITS readers can easily recognize and extract. + +To solve this problem, CFITSIO uses a local convention in which the +keyword units are enclosed in square brackets as the first token in the +keyword comment field; more specifically, the opening square bracket +immediately follows the slash '/' comment field delimiter and a single +space character. The following examples illustrate keywords that use +this convention: + +- +EXPOSURE= 1800.0 / [s] elapsed exposure time +V_HELIO = 16.23 / [km s**(-1)] heliocentric velocity +LAMBDA = 5400. / [angstrom] central wavelength +FLUX = 4.9033487787637465E-30 / [J/cm**2/s] average flux +- + +In general, the units named in the IAU(1988) Style Guide are +recommended, with the main exception that the preferred unit for angle +is 'deg' for degrees. + +The fits\_read\_key\_unit and fits\_write\_key\_unit routines in +CFITSIO read and write, respectively, the keyword unit strings in an +existing keyword. + +**E. HIERARCH Convention for Extended Keyword Names + +CFITSIO supports the HIERARCH keyword convention which allows keyword +names that are longer then 8 characters and may contain the full range +of printable ASCII text characters. This convention +was developed at the European Southern Observatory (ESO) to support +hierarchical FITS keyword such as: +- +HIERARCH ESO INS FOCU POS = -0.00002500 / Focus position +- +Basically, this convention uses the FITS keyword 'HIERARCH' to indicate +that this convention is being used, then the actual keyword name +({\tt'ESO INS FOCU POS'} in this example) begins in column 10 and can +contain any printable ASCII text characters, including spaces. The +equals sign marks the end of the keyword name and is followed by the +usual value and comment fields just as in standard FITS keywords. +Further details of this convention are described at +http://arcdev.hq.eso.org/dicb/dicd/dic-1-1.4.html (search for +HIERARCH). + +This convention allows a much broader range of keyword names +than is allowed by the FITS Standard. Here are more examples +of such keywords: +- +HIERARCH LongKeyword = 47.5 / Keyword has > 8 characters, and mixed case +HIERARCH XTE$TEMP = 98.6 / Keyword contains the '$' character +HIERARCH Earth is a star = F / Keyword contains embedded spaces +- +CFITSIO will transparently read and write these keywords, so application +programs do not in general need to know anything about the specific +implementation details of the HIERARCH convention. In particular, +application programs do not need to specify the `HIERARCH' part of the +keyword name when reading or writing keywords (although it +may be included if desired). When writing a keyword, CFITSIO first +checks to see if the keyword name is legal as a standard FITS keyword +(no more than 8 characters long and containing only letters, digits, or +a minus sign or underscore). If so it writes it as a standard FITS +keyword, otherwise it uses the hierarch convention to write the +keyword. The maximum keyword name length is 67 characters, which +leaves only 1 space for the value field. A more practical limit is +about 40 characters, which leaves enough room for most keyword values. +CFITSIO returns an error if there is not enough room for both the +keyword name and the keyword value on the 80-character card, except for +string-valued keywords which are simply truncated so that the closing +quote character falls in column 80. In the current implementation, +CFITSIO preserves the case of the letters when writing the keyword +name, but it is case-insensitive when reading or searching for a +keyword. The current implementation allows any ASCII text character +(ASCII 32 to ASCII 126) in the keyword name except for the '=' +character. A space is also required on either side of the equal sign. + +**F. Tile-Compressed Image Format + +CFITSIO supports a convention for compressing n-dimensional images and +storing the resulting byte stream in a variable-length column in a FITS +binary table. The general principle used in this convention is to +first divide the n-dimensional image into a rectangular grid of +subimages or `tiles'. Each tile is then compressed as a continuous +block of data, and the resulting compressed byte stream is stored in a +row of a variable length column in a FITS binary table. By dividing the +image into tiles it is generally possible to extract and uncompress +subsections of the image without having to uncompress the whole image. +The default tiling pattern treats each row of a 2-dimensional image (or +higher dimensional cube) as a tile, such that each tile contains NAXIS1 +pixels. Any other rectangular tiling pattern may also be defined. In +the case of relatively small images it may be sufficient to compress +the entire image as a single tile, resulting in an output binary table +with 1 row. In the case of 3-dimensional data cubes, it may be +advantageous to treat each plane of the cube as a separate tile if +application software typically needs to access the cube on a plane by +plane basis. + +See section 5.6 ``Image Compression'' +for more information on using this tile-compressed image format. + +*XII. Optimizing Programs + +CFITSIO has been carefully designed to obtain the highest possible +speed when reading and writing FITS files. In order to achieve the +best performance, however, application programmers must be careful to +call the CFITSIO routines appropriately and in an efficient sequence; +inappropriate usage of CFITSIO routines can greatly slow down the +execution speed of a program. + +The maximum possible I/O speed of CFITSIO depends of course on the type +of computer system that it is running on. As a rough guide, the +current generation of workstations can achieve speeds of 2 -- 10 MB/s +when reading or writing FITS images and similar, or slightly slower +speeds with FITS binary tables. Reading of FITS files can occur at +even higher rates (30MB/s or more) if the FITS file is still cached in +system memory following a previous read or write operation on the same +file. To more accurately predict the best performance that is possible +on any particular system, a diagnostic program called ``speed.c'' is +included with the CFITSIO distribution which can be run to +approximately measure the maximum possible speed of writing and reading +a test FITS file. + +The following 2 sections provide some background on how CFITSIO +internally manages the data I/O and describes some strategies that may +be used to optimize the processing speed of software that uses +CFITSIO. + +**A. How CFITSIO Manages Data I/O + +Many CFITSIO operations involve transferring only a small number of +bytes to or from the FITS file (e.g, reading a keyword, or writing a +row in a table); it would be very inefficient to physically read or +write such small blocks of data directly in the FITS file on disk, +therefore CFITSIO maintains a set of internal Input--Output (IO) +buffers in RAM memory that each contain one FITS block (2880 bytes) of +data. Whenever CFITSIO needs to access data in the FITS file, it first +transfers the FITS block containing those bytes into one of the IO +buffers in memory. The next time CFITSIO needs to access bytes in the +same block it can then go to the fast IO buffer rather than using a +much slower system disk access routine. The number of available IO +buffers is determined by the NIOBUF parameter (in fitsio2.h) and is +currently set to 40 by default. + +Whenever CFITSIO reads or writes data it first checks to see if that +block of the FITS file is already loaded into one of the IO buffers. +If not, and if there is an empty IO buffer available, then it will load +that block into the IO buffer (when reading a FITS file) or will +initialize a new block (when writing to a FITS file). If all the IO +buffers are already full, it must decide which one to reuse (generally +the one that has been accessed least recently), and flush the contents +back to disk if it has been modified before loading the new block. + +The one major exception to the above process occurs whenever a large +contiguous set of bytes are accessed, as might occur when reading or +writing a FITS image. In this case CFITSIO bypasses the internal IO +buffers and simply reads or writes the desired bytes directly in the +disk file with a single call to a low-level file read or write +routine. The minimum threshold for the number of bytes to read or +write this way is set by the MINDIRECT parameter and is currently set +to 3 FITS blocks = 8640 bytes. This is the most efficient way to read +or write large chunks of data and can achieve IO transfer rates of +5 -- 10MB/s or greater. Note that this fast direct IO process is not +applicable when accessing columns of data in a FITS table because the +bytes are generally not contiguous since they are interleaved by the +other columns of data in the table. This explains why the speed for +accessing FITS tables is generally slower than accessing +FITS images. + +Given this background information, the general strategy for efficiently +accessing FITS files should be apparent: when dealing with FITS +images, read or write large chunks of data at a time so that the direct +IO mechanism will be invoked; when accessing FITS headers or FITS +tables, on the other hand, once a particular FITS block has been +loading into one of the IO buffers, try to access all the needed +information in that block before it gets flushed out of the IO buffer. +It is important to avoid the situation where the same FITS block is +being read then flushed from a IO buffer multiple times. + +The following section gives more specific suggestions for optimizing +the use of CFITSIO. + +**B. Optimization Strategies + +1. When dealing with a FITS primary array or IMAGE extension, it is +more efficient to read or write large chunks of the image at a time +(at least 3 FITS blocks = 8640 bytes) so that the direct IO mechanism +will be used as described in the previous section. Smaller chunks of +data are read or written via the IO buffers, which is somewhat less +efficient because of the extra copy operation and additional +bookkeeping steps that are required. In principle it is more efficient +to read or write as big an array of image pixels at one time as +possible, however, if the array becomes so large that the operating +system cannot store it all in RAM, then the performance may be degraded +because of the increased swapping of virtual memory to disk. + +2. When dealing with FITS tables, the most important efficiency factor +in the software design is to read or write the data in the FITS file in +a single pass through the file. An example of poor program design +would be to read a large, 3-column table by sequentially reading the +entire first column, then going back to read the 2nd column, and +finally the 3rd column; this obviously requires 3 passes through the +file which could triple the execution time of an IO limited program. +For small tables this is not important, but when reading multi-megabyte +sized tables these inefficiencies can become significant. The more +efficient procedure in this case is to read or write only as many rows +of the table as will fit into the available internal IO buffers, then +access all the necessary columns of data within that range of rows. +Then after the program is completely finished with the data in those +rows it can move on to the next range of rows that will fit in the +buffers, continuing in this way until the entire file has been +processed. By using this procedure of accessing all the columns of a +table in parallel rather than sequentially, each block of the FITS file +will only be read or written once. + +The optimal number of rows to read or write at one time in a given +table depends on the width of the table row, on the number of IO +buffers that have been allocated in CFITSIO, and also on the number of +other FITS files that are open at the same time (since one IO buffer is +always reserved for each open FITS file). The CFITSIO Iterator routine +will automatically use the optimal-sized buffer, but there is also a +CFITSIO routine that will return the optimal number of rows for a given +table: fits\_get\_rowsize. It is not critical to use exactly the +value of nrows returned by this routine, as long as one does not exceed +it. Using a very small value however can also lead to poor performance +because of the overhead from the larger number of subroutine calls. + +The optimal number of rows returned by fits\_get\_rowsize is valid only +as long as the application program is only reading or writing data in +the specified table. Any other calls to access data in the table +header or in any other FITS file would cause additional blocks of data +to be loaded into the IO buffers displacing data from the original +table, and should be avoided during the critical period while the table +is being read or written. + +Occasionally it is necessary to simultaneously access more than one +FITS table, for example when transferring values from an input table to +an output table. In cases like this, one should call +fits\_get\_rowsize to get the optimal number of rows for each table +separately, than reduce the number of rows proportionally. For +example, if the optimal number of rows in the input table is 3600 and +is 1400 in the output table, then these values should be cut in half to +1800 and 700, respectively, if both tables are going to be accessed at +the same time. + +3. Use the CFITSIO Iterator routine. This routine provides a +more `object oriented' way of reading and writing FITS files +which automatically uses the most appropriate data buffer size +to achieve the maximum I/O throughput. + +4. Use binary table extensions rather than ASCII table +extensions for better efficiency when dealing with tabular data. The +I/O to ASCII tables is slower because of the overhead in formatting or +parsing the ASCII data fields and because ASCII tables are about twice +as large as binary tables with the same information content. + +5. Design software so that it reads the FITS header keywords in the +same order in which they occur in the file. When reading keywords, +CFITSIO searches forward starting from the position of the last keyword +that was read. If it reaches the end of the header without finding the +keyword, it then goes back to the start of the header and continues the +search down to the position where it started. In practice, as long as +the entire FITS header can fit at one time in the available internal IO +buffers, then the header keyword access will be very fast and it makes +little difference which order they are accessed. + +6. Avoid the use of scaling (by using the BSCALE and BZERO or TSCAL and +TZERO keywords) in FITS files since the scaling operations add to the +processing time needed to read or write the data. In some cases it may +be more efficient to temporarily turn off the scaling (using fits\_set\_bscale or +fits\_set\_tscale) and then read or write the raw unscaled values in the FITS +file. + +7. Avoid using the `implicit data type conversion' capability in +CFITSIO. For instance, when reading a FITS image with BITPIX = -32 +(32-bit floating point pixels), read the data into a single precision +floating point data array in the program. Forcing CFITSIO to convert +the data to a different data type can slow the program. + +8. Where feasible, design FITS binary tables using vector column +elements so that the data are written as a contiguous set of bytes, +rather than as single elements in multiple rows. For example, it is +faster to access the data in a table that contains a single row +and 2 columns with TFORM keywords equal to '10000E' and '10000J', than +it is to access the same amount of data in a table with 10000 rows +which has columns with the TFORM keywords equal to '1E' and '1J'. In +the former case the 10000 floating point values in the first column are +all written in a contiguous block of the file which can be read or +written quickly, whereas in the second case each floating point value +in the first column is interleaved with the integer value in the second +column of the same row so CFITSIO has to explicitly move to the +position of each element to be read or written. + +9. Avoid the use of variable length vector columns in binary tables, +since any reading or writing of these data requires that CFITSIO first +look up or compute the starting address of each row of data in the +heap. + +10. When copying data from one FITS table to another, it is faster to +transfer the raw bytes instead of reading then writing each column of +the table. The CFITSIO routines fits\_read\_tblbytes and +fits\_write\_tblbytes will perform low-level reads or writes of any +contiguous range of bytes in a table extension. These routines can be +used to read or write a whole row (or multiple rows for even greater +efficiency) of a table with a single function call. These routines +are fast because they bypass all the usual data scaling, error checking +and machine dependent data conversion that is normally done by CFITSIO, +and they allow the program to write the data to the output file in +exactly the same byte order. For these same reasons, these routines +can corrupt the FITS data file if used incorrectly because no +validation or machine dependent conversion is performed by these +routines. These routines are only recommended for optimizing critical +pieces of code and should only be used by programmers who thoroughly +understand the internal format of the FITS tables they are reading or +writing. + +11. Another strategy for improving the speed of writing a FITS table, +similar to the previous one, is to directly construct the entire byte +stream for a whole table row (or multiple rows) within the application +program and then write it to the FITS file with +fits\_write\_tblbytes. This avoids all the overhead normally present +in the column-oriented CFITSIO write routines. This technique should +only be used for critical applications because it makes the code more +difficult to understand and maintain, and it makes the code more system +dependent (e.g., do the bytes need to be swapped before writing to the +FITS file?). + +12. Finally, external factors such as the type of magnetic disk +controller (SCSI or IDE), the size of the disk cache, the average seek +speed of the disk, the amount of disk fragmentation, and the amount of +RAM available on the system can all have a significant impact on +overall I/O efficiency. For critical applications, a system +administrator should review the proposed system hardware to identify any +potential I/O bottlenecks. + + +\appendix +*1 Index of Routines +\begin{tabular}{lr} +fits\_add\_group\_member & \pageref{ffgtam} \\ +fits\_ascii\_tform & \pageref{ffasfm} \\ +fits\_binary\_tform & \pageref{ffbnfm} \\ +fits\_calculator & \pageref{ffcalc} \\ +fits\_calculator\_rng & \pageref{ffcalcrng} \\ +fits\_calc\_rows & \pageref{ffcrow} \\ +fits\_change\_group & \pageref{ffgtch} \\ +fits\_clear\_errmark & \pageref{ffpmrk} \\ +fits\_clear\_errmsg & \pageref{ffcmsg} \\ +fits\_close\_file & \pageref{ffclos} \\ +fits\_compact\_group & \pageref{ffgtcm} \\ +fits\_compare\_str & \pageref{ffcmps} \\ +fits\_compress\_heap & \pageref{ffcmph} \\ +fits\_copy\_col & \pageref{ffcpcl} \\ +fits\_copy\_data & \pageref{ffcpdt} \\ +fits\_copy\_file & \pageref{ffcpfl} \\ +fits\_copy\_group & \pageref{ffgtcp} \\ +fits\_copy\_hdu & \pageref{ffcopy} \\ +fits\_copy\_header & \pageref{ffcphd} \\ +fits\_copy\_key & \pageref{ffcpky} \\ +fits\_copy\_member & \pageref{ffgmcp} \\ +fits\_create\_diskfile & \pageref{ffinit} \\ +fits\_create\_file & \pageref{ffinit} \\ +fits\_create\_group & \pageref{ffgtcr} \\ +fits\_create\_hdu & \pageref{ffcrhd} \\ +fits\_create\_img & \pageref{ffcrim} \\ +fits\_create\_memfile & \pageref{ffimem} \\ +fits\_create\_tbl & \pageref{ffcrtb} \\ +fits\_create\_template & \pageref{fftplt} \\ +fits\_date2str & \pageref{ffdt2s} \\ +fits\_decode\_chksum & \pageref{ffdsum} \\ +fits\_decode\_tdim & \pageref{ffdtdm} \\ + +\end{tabular} +\begin{tabular}{lr} +fits\_delete\_col & \pageref{ffdcol} \\ +fits\_delete\_file & \pageref{ffdelt} \\ +fits\_delete\_hdu & \pageref{ffdhdu} \\ +fits\_delete\_key & \pageref{ffdkey} \\ +fits\_delete\_record & \pageref{ffdrec} \\ +fits\_delete\_rowlist & \pageref{ffdrws} \\ +fits\_delete\_rowrange & \pageref{ffdrrg} \\ +fits\_delete\_rows & \pageref{ffdrow} \\ +fits\_encode\_chksum & \pageref{ffesum} \\ +fits\_file\_exists & \pageref{ffexist} \\ +fits\_file\_mode & \pageref{ffflmd} \\ +fits\_file\_name & \pageref{ffflnm} \\ +fits\_find\_first\_row & \pageref{ffffrw} \\ +fits\_find\_nextkey & \pageref{ffgnxk} \\ +fits\_find\_rows & \pageref{fffrow} \\ +fits\_flush\_buffer & \pageref{ffflus} \\ +fits\_flush\_file & \pageref{ffflus} \\ +fits\_get\_acolparms & \pageref{ffgacl} \\ +fits\_get\_bcolparms & \pageref{ffgbcl} \\ +fits\_get\_chksum & \pageref{ffgcks} \\ +fits\_get\_col\_display\_width & \pageref{ffgcdw} \\ +fits\_get\_colname & \pageref{ffgcnn} \\ +fits\_get\_colnum & \pageref{ffgcno} \\ +fits\_get\_coltype & \pageref{ffgtcl} \\ +fits\_get\_compression\_type & \pageref{ffgetcomp} \\ +fits\_get\_eqcoltype & \pageref{ffgtcl} \\ +fits\_get\_errstatus & \pageref{ffgerr} \\ +fits\_get\_hdrpos & \pageref{ffghps} \\ +fits\_get\_hdrspace & \pageref{ffghsp} \\ +fits\_get\_hdu\_num & \pageref{ffghdn} \\ +fits\_get\_hdu\_type & \pageref{ffghdt} \\ +fits\_get\_hduaddr & \pageref{ffghad} \\ +\end{tabular} +\begin{tabular}{lr} +fits\_get\_hduoff & \pageref{ffghad} \\ +fits\_get\_img\_dim & \pageref{ffgidm} \\ +fits\_get\_img\_equivtype & \pageref{ffgidt} \\ +fits\_get\_img\_param & \pageref{ffgipr} \\ +fits\_get\_img\_size & \pageref{ffgisz} \\ +fits\_get\_img\_type & \pageref{ffgidt} \\ +fits\_get\_keyclass & \pageref{ffgkcl} \\ +fits\_get\_keyname & \pageref{ffgknm} \\ +fits\_get\_keytype & \pageref{ffdtyp} \\ +fits\_get\_noise\_bits & \pageref{ffgetcomp} \\ +fits\_get\_num\_cols & \pageref{ffgnrw} \\ +fits\_get\_num\_groups & \pageref{ffgmng} \\ +fits\_get\_num\_hdus & \pageref{ffthdu} \\ +fits\_get\_num\_members & \pageref{ffgtnm} \\ +fits\_get\_num\_rows & \pageref{ffgnrw} \\ +fits\_get\_rowsize & \pageref{ffgrsz} \\ +fits\_get\_system\_time & \pageref{ffdt2s} \\ +fits\_get\_tile\_dim & \pageref{ffgetcomp} \\ +fits\_get\_tbcol & \pageref{ffgabc} \\ +fits\_get\_version & \pageref{ffvers} \\ +fits\_hdr2str & \pageref{ffhdr2str}, \pageref{hdr2str} \\ +fits\_insert\_atbl & \pageref{ffitab} \\ +fits\_insert\_btbl & \pageref{ffibin} \\ +fits\_insert\_col & \pageref{fficol} \\ +fits\_insert\_cols & \pageref{fficls} \\ +fits\_insert\_group & \pageref{ffgtis} \\ +fits\_insert\_img & \pageref{ffiimg} \\ +fits\_insert\_key\_null & \pageref{ffikyu} \\ +fits\_insert\_key\_TYP & \pageref{ffikyx} \\ +fits\_insert\_record & \pageref{ffirec} \\ +fits\_insert\_rows & \pageref{ffirow} \\ +fits\_iterate\_data & \pageref{ffiter} \\ +\end{tabular} +\newpage +\begin{tabular}{lr} +fits\_make\_keyn & \pageref{ffkeyn} \\ +fits\_make\_nkey & \pageref{ffnkey} \\ +fits\_merge\_groups & \pageref{ffgtmg} \\ +fits\_modify\_card & \pageref{ffmcrd} \\ +fits\_modify\_comment & \pageref{ffmcom} \\ +fits\_modify\_key\_null & \pageref{ffmkyu} \\ +fits\_modify\_key\_TYP & \pageref{ffmkyx} \\ +fits\_modify\_name & \pageref{ffmnam} \\ +fits\_modify\_record & \pageref{ffmrec} \\ +fits\_modify\_vector\_len & \pageref{ffmvec} \\ +fits\_movabs\_hdu & \pageref{ffmahd} \\ +fits\_movnam\_hdu & \pageref{ffmnhd} \\ +fits\_movrel\_hdu & \pageref{ffmrhd} \\ +fits\_null\_check & \pageref{ffnchk} \\ +fits\_open\_data & \pageref{ffopen} \\ +fits\_open\_diskfile & \pageref{ffopen} \\ +fits\_open\_file & \pageref{ffopen} \\ +fits\_open\_image & \pageref{ffopen} \\ +fits\_open\_table & \pageref{ffopen} \\ +fits\_open\_group & \pageref{ffgtop} \\ +fits\_open\_member & \pageref{ffgmop} \\ +fits\_open\_memfile & \pageref{ffomem} \\ +fits\_parse\_extnum & \pageref{ffextn} \\ +fits\_parse\_input\_url & \pageref{ffiurl} \\ +fits\_parse\_range & \pageref{ffrwrg} \\ +fits\_parse\_rootname & \pageref{ffrtnm} \\ +fits\_parse\_template & \pageref{ffgthd} \\ +fits\_parse\_value & \pageref{ffpsvc} \\ +fits\_pix\_to\_world & \pageref{ffwldp} \\ +fits\_read\_2d\_TYP & \pageref{ffg2dx} \\ +fits\_read\_3d\_TYP & \pageref{ffg3dx} \\ +fits\_read\_atblhdr & \pageref{ffghtb} \\ +fits\_read\_btblhdr & \pageref{ffghbn} \\ +fits\_read\_card & \pageref{ffgcrd} \\ +fits\_read\_col & \pageref{ffgcv} \\ +fits\_read\_col\_bit\_ & \pageref{ffgcx} \\ +fits\_read\_col\_TYP & \pageref{ffgcvx} \\ +fits\_read\_colnull & \pageref{ffgcf} \\ +fits\_read\_colnull\_TYP & \pageref{ffgcfx} \\ +fits\_read\_descript & \pageref{ffgdes} \\ +fits\_read\_descripts & \pageref{ffgdes} \\ +fits\_read\_errmsg & \pageref{ffgmsg} \\ +fits\_read\_grppar\_TYP & \pageref{ffggpx} \\ +fits\_read\_img & \pageref{ffgpv} \\ +fits\_read\_img\_coord & \pageref{ffgics} \\ +fits\_read\_img\_TYP & \pageref{ffgpvx} \\ +fits\_read\_imghdr & \pageref{ffghpr} \\ + +\end{tabular} +\begin{tabular}{lr} +fits\_read\_imgnull & \pageref{ffgpf} \\ +fits\_read\_imgnull\_TYP & \pageref{ffgpfx} \\ +fits\_read\_key & \pageref{ffgky} \\ +fits\_read\_key\_longstr & \pageref{ffgkls} \\ +fits\_read\_key\_triple & \pageref{ffgkyt} \\ +fits\_read\_key\_unit & \pageref{ffgunt} \\ +fits\_read\_key\_TYP & \pageref{ffgkyx} \\ +fits\_read\_keyn & \pageref{ffgkyn} \\ +fits\_read\_keys\_TYP & \pageref{ffgknx} \\ +fits\_read\_keyword & \pageref{ffgkey} \\ +fits\_read\_pix & \pageref{ffgpxv} \\ +fits\_read\_pixnull & \pageref{ffgpxf} \\ +fits\_read\_record & \pageref{ffgrec} \\ +fits\_read\_subset\_TYP & \pageref{ffgsvx} \pageref{ffgsvx2}\\ +fits\_read\_subsetnull\_TYP & \pageref{ffgsfx} \pageref{ffgsfx2} \\ +fits\_read\_tbl\_coord & \pageref{ffgtcs} \\ +fits\_read\_tblbytes & \pageref{ffgtbb} \\ +fits\_read\_tdim & \pageref{ffgtdm} \\ +fits\_remove\_group & \pageref{ffgtrm} \\ +fits\_remove\_member & \pageref{ffgmrm} \\ +fits\_reopen\_file & \pageref{ffreopen} \\ +fits\_report\_error & \pageref{ffrprt} \\ +fits\_resize\_img & \pageref{ffrsim} \\ +fits\_select\_rows & \pageref{ffsrow} \\ +fits\_set\_atblnull & \pageref{ffsnul} \\ +fits\_set\_bscale & \pageref{ffpscl} \\ +fits\_set\_btblnull & \pageref{fftnul} \\ +fits\_set\_compression\_type & \pageref{ffsetcomp} \\ +fits\_set\_hdrsize & \pageref{ffhdef} \\ +fits\_set\_hdustruc & \pageref{ffrdef} \\ +fits\_set\_imgnull & \pageref{ffpnul} \\ +fits\_set\_noise\_bits & \pageref{ffsetcomp} \\ +fits\_set\_tile\_dim & \pageref{ffsetcomp} \\ +fits\_set\_tscale & \pageref{fftscl} \\ +fits\_split\_names & \pageref{splitnames} \\ +fits\_str2date & \pageref{ffdt2s} \\ +fits\_str2time & \pageref{ffdt2s} \\ +fits\_test\_expr & \pageref{fftexp} \\ +fits\_test\_heap & \pageref{fftheap} \\ +fits\_test\_keyword & \pageref{fftkey} \\ +fits\_test\_record & \pageref{fftrec} \\ +fits\_time2str & \pageref{ffdt2s} \\ +fits\_transfer\_member & \pageref{ffgmtf} \\ +fits\_update\_card & \pageref{ffucrd} \\ +fits\_update\_chksum & \pageref{ffupck} \\ +fits\_update\_key & \pageref{ffuky} \\ +fits\_update\_key\_null & \pageref{ffukyu} \\ +fits\_update\_key\_TYP & \pageref{ffukyx} \\ +\end{tabular} +\begin{tabular}{lr} + +fits\_uppercase & \pageref{ffupch} \\ +fits\_url\_type & \pageref{ffurlt} \\ +fits\_verify\_chksum & \pageref{ffvcks} \\ +fits\_verify\_group & \pageref{ffgtvf} \\ +fits\_world\_to\_pix & \pageref{ffxypx} \\ +fits\_write\_2d\_TYP & \pageref{ffp2dx} \\ +fits\_write\_3d\_TYP & \pageref{ffp3dx} \\ +fits\_write\_atblhdr & \pageref{ffphtb} \\ +fits\_write\_btblhdr & \pageref{ffphbn} \\ +fits\_write\_chksum & \pageref{ffpcks} \\ +fits\_write\_col & \pageref{ffpcl} \\ +fits\_write\_col\_bit & \pageref{ffpclx} \\ +fits\_write\_col\_TYP & \pageref{ffpcls} \\ +fits\_write\_col\_null & \pageref{ffpclu} \\ +fits\_write\_colnull & \pageref{ffpcn} \\ +fits\_write\_colnull\_TYP & \pageref{ffpcnx} \\ +fits\_write\_comment & \pageref{ffpcom} \\ +fits\_write\_date & \pageref{ffpdat} \\ +fits\_write\_descript & \pageref{ffpdes} \\ +fits\_write\_errmark & \pageref{ffpmrk} \\ +fits\_write\_errmsg & \pageref{ffpmsg} \\ +fits\_write\_grphdr & \pageref{ffphpr} \\ +fits\_write\_grppar\_TYP & \pageref{ffpgpx} \\ +fits\_write\_history & \pageref{ffphis} \\ +fits\_write\_img & \pageref{ffppr} \\ +fits\_write\_img\_null & \pageref{ffppru} \\ +fits\_write\_img\_TYP & \pageref{ffpprx} \\ +fits\_write\_imghdr & \pageref{ffphps} \\ +fits\_write\_imgnull & \pageref{ffppn} \\ +fits\_write\_imgnull\_TYP & \pageref{ffppnx} \\ +fits\_write\_key & \pageref{ffpky} \\ +fits\_write\_key\_longstr & \pageref{ffpkls} \\ +fits\_write\_key\_longwarn & \pageref{ffplsw} \\ +fits\_write\_key\_null & \pageref{ffpkyu} \\ +fits\_write\_key\_template & \pageref{ffpktp} \\ +fits\_write\_key\_triple & \pageref{ffpkyt} \\ +fits\_write\_key\_unit & \pageref{ffpunt} \\ +fits\_write\_key\_TYP & \pageref{ffpkyx} \\ +fits\_write\_keys\_TYP & \pageref{ffpknx} \\ +fits\_write\_null\_img & \pageref{ffpprn} \\ +fits\_write\_pix & \pageref{ffppx} \\ +fits\_write\_pixnull & \pageref{ffppxn} \\ +fits\_write\_record & \pageref{ffprec} \\ +fits\_write\_subset & \pageref{ffpss} \\ +fits\_write\_subset\_TYP & \pageref{ffpssx} \\ +fits\_write\_tblbytes & \pageref{ffptbb} \\ +fits\_write\_tdim & \pageref{ffptdm} \\ +fits\_write\_theap & \pageref{ffpthp} \\ +\end{tabular} +\newpage + +\begin{tabular}{lr} +ffasfm & \pageref{ffasfm} \\ +ffbnfm & \pageref{ffbnfm} \\ +ffcalc & \pageref{ffcalc} \\ +ffcalc\_rng & \pageref{ffcalcrng} \\ +ffclos & \pageref{ffclos} \\ +ffcmph & \pageref{ffcmph} \\ +ffcmps & \pageref{ffcmps} \\ +ffcmrk & \pageref{ffpmrk} \\ +ffcmsg & \pageref{ffcmsg} \\ +ffcopy & \pageref{ffcopy} \\ +ffcpcl & \pageref{ffcpcl} \\ +ffcpdt & \pageref{ffcpdt} \\ +ffcpfl & \pageref{ffcpfl} \\ +ffcphd & \pageref{ffcphd} \\ +ffcpky & \pageref{ffcpky} \\ +ffcrhd & \pageref{ffcrhd} \\ +ffcrim & \pageref{ffcrim} \\ +ffcrow & \pageref{ffcrow} \\ +ffcrtb & \pageref{ffcrtb} \\ +ffdcol & \pageref{ffdcol} \\ +ffdelt & \pageref{ffdelt} \\ +ffdhdu & \pageref{ffdhdu} \\ +ffdkey & \pageref{ffdkey} \\ +ffdkinit & \pageref{ffinit} \\ +ffdkopen & \pageref{ffopen} \\ +ffdopn & \pageref{ffopen} \\ +ffdrec & \pageref{ffdrec} \\ +ffdrow & \pageref{ffdrow} \\ +ffdrrg & \pageref{ffdrrg} \\ +ffdrws & \pageref{ffdrws} \\ +ffdsum & \pageref{ffdsum} \\ +ffdt2s & \pageref{ffdt2s} \\ +ffdtdm & \pageref{ffdtdm} \\ +ffdtyp & \pageref{ffdtyp} \\ +ffeqty & \pageref{ffgtcl} \\ +ffesum & \pageref{ffesum} \\ +ffexest & \pageref{ffexist} \\ +ffextn & \pageref{ffextn} \\ +ffffrw & \pageref{ffffrw} \\ +ffflmd & \pageref{ffflmd} \\ +ffflnm & \pageref{ffflnm} \\ +ffflsh & \pageref{ffflus} \\ +ffflus & \pageref{ffflus} \\ +fffrow & \pageref{fffrow} \\ +ffg2d\_ & \pageref{ffg2dx} \\ +ffg3d\_ & \pageref{ffg3dx} \\ +ffgabc & \pageref{ffgabc} \\ +\end{tabular} +\begin{tabular}{lr} +ffgacl & \pageref{ffgacl} \\ +ffgbcl & \pageref{ffgbcl} \\ +ffgcdw & \pageref{ffgcdw} \\ +ffgcf & \pageref{ffgcf} \\ +ffgcf\_ & \pageref{ffgcfx} \\ +ffgcks & \pageref{ffgcks} \\ +ffgcnn & \pageref{ffgcnn} \\ +ffgcno & \pageref{ffgcno} \\ +ffgcrd & \pageref{ffgcrd} \\ +ffgcv & \pageref{ffgcv} \\ +ffgcv\_ & \pageref{ffgcvx} \\ +ffgcx & \pageref{ffgcx} \\ +ffgdes & \pageref{ffgdes} \\ +ffgdess & \pageref{ffgdes} \\ +ffgerr & \pageref{ffgerr} \\ +ffggp\_ & \pageref{ffggpx} \\ +ffghad & \pageref{ffghad} \\ +ffghbn & \pageref{ffghbn} \\ +ffghdn & \pageref{ffghdn} \\ +ffghdt & \pageref{ffghdt} \\ +ffghof & \pageref{ffghad} \\ +ffghpr & \pageref{ffghpr} \\ +ffghps & \pageref{ffghps} \\ +ffghsp & \pageref{ffghsp} \\ +ffghtb & \pageref{ffghtb} \\ +ffgics & \pageref{ffgics} \\ +ffgidm & \pageref{ffgidm} \\ +ffgidt & \pageref{ffgidt} \\ +ffgiet & \pageref{ffgidt} \\ +ffgipr & \pageref{ffgipr} \\ +ffgisz & \pageref{ffgisz} \\ +ffgkcl & \pageref{ffgkcl} \\ +ffgkey & \pageref{ffgkey} \\ +ffgkls & \pageref{ffgkls} \\ +ffgkn\_ & \pageref{ffgknx} \\ +ffgknm & \pageref{ffgknm} \\ +ffgky & \pageref{ffgky} \\ +ffgkyn & \pageref{ffgkyn} \\ +ffgkyt & \pageref{ffgkyt} \\ +ffgky\_ & \pageref{ffgkyx} \\ +ffgmcp & \pageref{ffgmcp} \\ +ffgmng & \pageref{ffgmng} \\ +ffgmop & \pageref{ffgmop} \\ +ffgmrm & \pageref{ffgmrm} \\ +ffgmsg & \pageref{ffgmsg} \\ +ffgmtf & \pageref{ffgmtf} \\ +ffgncl & \pageref{ffgnrw} \\ + +\end{tabular} +\begin{tabular}{lr} +ffgnrw & \pageref{ffgnrw} \\ +ffgnxk & \pageref{ffgnxk} \\ +ffgpf & \pageref{ffgpf} \\ +ffgpf\_ & \pageref{ffgpfx} \\ +ffgpv & \pageref{ffgpv} \\ +ffgpv\_ & \pageref{ffgpvx} \\ +ffgpxv & \pageref{ffgpxv} \\ +ffgpxf & \pageref{ffgpxf} \\ +ffgrec & \pageref{ffgrec} \\ +ffgrsz & \pageref{ffgrsz} \\ +ffgsdt & \pageref{ffdt2s} \\ +ffgsf\_ & \pageref{ffgsfx} \pageref{ffgsfx2} \\ +ffgstm & \pageref{ffdt2s} \\ +ffgsv\_ & \pageref{ffgsvx} \pageref{ffgsvx2}\\ +ffgtam & \pageref{ffgtam} \\ +ffgtbb & \pageref{ffgtbb} \\ +ffgtch & \pageref{ffgtch} \\ +ffgtcl & \pageref{ffgtcl} \\ +ffgtcm & \pageref{ffgtcm} \\ +ffgtcp & \pageref{ffgtcp} \\ +ffgtcr & \pageref{ffgtcr} \\ +ffgtcs & \pageref{ffgtcs} \\ +ffgtdm & \pageref{ffgtdm} \\ +ffgthd & \pageref{ffgthd} \\ +ffgtis & \pageref{ffgtis} \\ +ffgtmg & \pageref{ffgtmg} \\ +ffgtnm & \pageref{ffgtnm} \\ +ffgtop & \pageref{ffgtop} \\ +ffgtrm & \pageref{ffgtrm} \\ +ffgtvf & \pageref{ffgtvf} \\ +ffgunt & \pageref{ffgunt} \\ +ffhdef & \pageref{ffhdef} \\ +ffibin & \pageref{ffibin} \\ +fficls & \pageref{fficls} \\ +fficol & \pageref{fficol} \\ +ffiimg & \pageref{ffiimg} \\ +ffikls & \pageref{ffikyx} \\ +ffikyu & \pageref{ffikyu} \\ +ffiky\_ & \pageref{ffikyx} \\ +ffimem & \pageref{ffimem} \\ +ffinit & \pageref{ffinit} \\ +ffiopn & \pageref{ffopen} \\ +ffirec & \pageref{ffirec} \\ +ffirow & \pageref{ffirow} \\ +ffitab & \pageref{ffitab} \\ +ffiter & \pageref{ffiter} \\ +ffiurl & \pageref{ffiurl} \\ + +\end{tabular} +\begin{tabular}{lr} +ffkeyn & \pageref{ffkeyn} \\ +ffmahd & \pageref{ffmahd} \\ +ffmcom & \pageref{ffmcom} \\ +ffmcrd & \pageref{ffmcrd} \\ +ffmkls & \pageref{ffmkyx} \\ +ffmkyu & \pageref{ffmkyu} \\ +ffmky\_ & \pageref{ffmkyx} \\ +ffmnam & \pageref{ffmnam} \\ +ffmnhd & \pageref{ffmnhd} \\ +ffmrec & \pageref{ffmrec} \\ +ffmrhd & \pageref{ffmrhd} \\ +ffmvec & \pageref{ffmvec} \\ +ffnchk & \pageref{ffnchk} \\ +ffnkey & \pageref{ffnkey} \\ +ffomem & \pageref{ffomem} \\ +ffopen & \pageref{ffopen} \\ +ffp2d\_ & \pageref{ffp2dx} \\ +ffp3d\_ & \pageref{ffp3dx} \\ +ffpcks & \pageref{ffpcks} \\ +ffpcl & \pageref{ffpcl} \\ +ffpcls & \pageref{ffpcls} \\ +ffpcl\_ & \pageref{ffpclx} \\ +ffpclu & \pageref{ffpclu} \\ +ffpcn & \pageref{ffpcn} \\ +ffpcn\_ & \pageref{ffpcnx} \\ +ffpcom & \pageref{ffpcom} \\ +ffpdat & \pageref{ffpdat} \\ +ffpdes & \pageref{ffpdes} \\ +ffpgp\_ & \pageref{ffpgpx} \\ +ffphbn & \pageref{ffphbn} \\ +ffphis & \pageref{ffphis} \\ +ffphpr & \pageref{ffphpr} \\ +ffphps & \pageref{ffphps} \\ +ffphtb & \pageref{ffphtb} \\ +ffpkls & \pageref{ffpkls} \\ +ffpkn\_ & \pageref{ffpknx} \\ +ffpktp & \pageref{ffpktp} \\ +ffpky & \pageref{ffpky} \\ +ffpkyt & \pageref{ffpkyt} \\ +ffpkyu & \pageref{ffpkyu} \\ +ffpky\_ & \pageref{ffpkyx} \\ +ffplsw & \pageref{ffplsw} \\ +ffpmrk & \pageref{ffpmrk} \\ +ffpmsg & \pageref{ffpmsg} \\ +ffpnul & \pageref{ffpnul} \\ +ffppn & \pageref{ffppn} \\ +ffppn\_ & \pageref{ffppnx} \\ + +\end{tabular} +\begin{tabular}{lr} +ffppr & \pageref{ffppr} \\ +ffpprn & \pageref{ffpprn} \\ +ffppru & \pageref{ffppru} \\ +ffppr\_ & \pageref{ffpprx} \\ +ffppx & \pageref{ffppx} \\ +ffppxn & \pageref{ffppxn} \\ +ffprec & \pageref{ffprec} \\ +ffpscl & \pageref{ffpscl} \\ +ffpss & \pageref{ffpss} \\ +ffpss\_ & \pageref{ffpssx} \\ +ffpsvc & \pageref{ffpsvc} \\ +ffptbb & \pageref{ffptbb} \\ +ffptdm & \pageref{ffptdm} \\ +ffpthp & \pageref{ffpthp} \\ +ffpunt & \pageref{ffpunt} \\ +ffrdef & \pageref{ffrdef} \\ +ffreopen & \pageref{ffreopen} \\ +ffrprt & \pageref{ffrprt} \\ +ffrsim & \pageref{ffrsim} \\ +ffrtnm & \pageref{ffrtnm} \\ +ffrwrg & \pageref{ffrwrg} \\ +ffs2dt & \pageref{ffdt2s} \\ +ffs2tm & \pageref{ffdt2s} \\ +ffsnul & \pageref{ffsnul} \\ +ffsrow & \pageref{ffsrow} \\ +fftexp & \pageref{fftexp} \\ +ffthdu & \pageref{ffthdu} \\ +fftheap & \pageref{fftheap} \\ +fftkey & \pageref{fftkey} \\ +fftm2s & \pageref{ffdt2s} \\ +fftnul & \pageref{fftnul} \\ +fftopn & \pageref{ffopen} \\ +fftplt & \pageref{fftplt} \\ +fftrec & \pageref{fftrec} \\ +fftscl & \pageref{fftscl} \\ +ffucrd & \pageref{ffucrd} \\ +ffukls & \pageref{ffukyx} \\ +ffuky & \pageref{ffuky} \\ +ffukyu & \pageref{ffukyu} \\ +ffuky\_ & \pageref{ffukyx} \\ +ffupch & \pageref{ffupch} \\ +ffupck & \pageref{ffupck} \\ +ffurlt & \pageref{ffurlt} \\ +ffvcks & \pageref{ffvcks} \\ +ffvers & \pageref{ffvers} \\ +ffwldp & \pageref{ffwldp} \\ +ffxypx & \pageref{ffxypx} \\ +\end{tabular} + + + +*2 Parameter Definitions +- +anynul - set to TRUE (=1) if any returned values are undefined, else FALSE +array - array of numerical data values to read or write +ascii - encoded checksum string +binspec - the input table binning specifier +bitpix - bits per pixel. The following symbolic mnemonics are predefined: + BYTE_IMG = 8 (unsigned char) + SHORT_IMG = 16 (signed short integer) + LONG_IMG = 32 (signed long integer) + LONGLONG_IMG = 64 (signed long 64-bit integer) + FLOAT_IMG = -32 (float) + DOUBLE_IMG = -64 (double). + The LONGLONG_IMG type is experimental and is not officially + recognized in the FITS Standard document. + Two additional values, USHORT_IMG and ULONG_IMG are also available + for creating unsigned integer images. These are equivalent to + creating a signed integer image with BZERO offset keyword values + of 32768 or 2147483648, respectively, which is the convention that + FITS uses to store unsigned integers. +card - header record to be read or written (80 char max, null-terminated) +casesen - CASESEN (=1) for case-sensitive string matching, else CASEINSEN (=0) +cmopt - grouping table "compact" option parameter. Allowed values are: + OPT_CMT_MBR and OPT_CMT_MBR_DEL. +colname - name of the column (null-terminated) +colnum - column number (first column = 1) +colspec - the input file column specification; used to delete, create, or rename + table columns +comment - the keyword comment field (72 char max, null-terminated) +complm - should the checksum be complemented? +comptype - compression algorithm to use: GZIP_1, RICE_1, or PLIO_1 +coordtype- type of coordinate projection (-SIN, -TAN, -ARC, -NCP, + -GLS, -MER, or -AIT) +cpopt - grouping table copy option parameter. Allowed values are: + OPT_GCP_GPT, OPT_GCP_MBR, OPT_GCP_ALL, OPT_MCP_ADD, OPT_MCP_NADD, + OPT_MCP_REPL, amd OPT_MCP_MOV. +create_col- If TRUE, then insert a new column in the table, otherwise + overwrite the existing column. +current - if TRUE, then the current HDU will be copied +dataok - was the data unit verification successful (=1) or + not (= -1). Equals zero if the DATASUM keyword is not present. +datasum - 32-bit 1's complement checksum for the data unit +dataend - address (in bytes) of the end of the HDU +datastart- address (in bytes) of the start of the data unit +datatype - specifies the data type of the value. Allowed value are: TSTRING, + TLOGICAL, TBYTE, TSBYTE, TSHORT, TUSHORT, TINT, TUINT, TLONG, TULONG, + TFLOAT, TDOUBLE, TCOMPLEX, and TDBLCOMPLEX +datestr - FITS date/time string: 'YYYY-MM-DDThh:mm:ss.ddd', 'YYYY-MM-dd', + or 'dd/mm/yy' +day - calendar day (UTC) (1-31) +decimals - number of decimal places to be displayed +deltasize - increment for allocating more memory +dim1 - declared size of the first dimension of the image or cube array +dim2 - declared size of the second dimension of the data cube array +dispwidth - display width of a column = length of string that will be read +dtype - data type of the keyword ('C', 'L', 'I', 'F' or 'X') + C = character string + L = logical + I = integer + F = floating point number + X = complex, e.g., "(1.23, -4.56)" +err_msg - error message on the internal stack (80 chars max) +err_text - error message string corresponding to error number (30 chars max) +exact - TRUE (=1) if the strings match exactly; + FALSE (=0) if wildcards are used +exclist - array of pointers to keyword names to be excluded from search +exists - flag indicating whether the file or compressed file exists on disk +expr - boolean or arithmetic expression +extend - TRUE (=1) if FITS file may have extensions, else FALSE (=0) +extname - value of the EXTNAME keyword (null-terminated) +extspec - the extension or HDU specifier; a number or name, version, and type +extver - value of the EXTVER keyword = integer version number +filename - full name of the FITS file, including optional HDU and filtering specs +filetype - type of file (file://, ftp://, http://, etc.) +filter - the input file filtering specifier +firstchar- starting byte in the row (first byte of row = 1) +firstfailed - member HDU ID (if positive) or grouping table GRPIDn index + value (if negative) that failed grouping table verification. +firstelem- first element in a vector (ignored for ASCII tables) +firstrow - starting row number (first row of table = 1) +following- if TRUE, any HDUs following the current HDU will be copied +fpixel - coordinate of the first pixel to be read or written in the + FITS array. The array must be of length NAXIS and have values such + that fpixel[0] is in the range 1 to NAXIS1, fpixel[1] is in the + range 1 to NAXIS2, etc. +fptr - pointer to a 'fitsfile' structure describing the FITS file. +frac - factional part of the keyword value +gcount - number of groups in the primary array (usually = 1) +gfptr - fitsfile* pointer to a grouping table HDU. +group - GRPIDn/GRPLCn index value identifying a grouping table HDU, or + data group number (=0 for non-grouped data) +grouptype - Grouping table parameter that specifies the columns to be + created in a grouping table HDU. Allowed values are: GT_ID_ALL_URI, + GT_ID_REF, GT_ID_POS, GT_ID_ALL, GT_ID_REF_URI, and GT_ID_POS_URI. +grpname - value to use for the GRPNAME keyword value. +hdunum - sequence number of the HDU (Primary array = 1) +hduok - was the HDU verification successful (=1) or + not (= -1). Equals zero if the CHECKSUM keyword is not present. +hdusum - 32 bit 1's complement checksum for the entire CHDU +hdutype - type of HDU: IMAGE_HDU (=0), ASCII_TBL (=1), or BINARY_TBL (=2) +header - returned character string containing all the keyword records +headstart- starting address (in bytes) of the CHDU +heapsize - size of the binary table heap, in bytes +history - the HISTORY keyword comment string (70 char max, null-terminated) +hour - hour within day (UTC) (0 - 23) +inc - sampling interval for pixels in each FITS dimension +inclist - array of pointers to matching keyword names +incolnum - input column number; range = 1 to TFIELDS +infile - the input filename, including path if specified +infptr - pointer to a 'fitsfile' structure describing the input FITS file. +intval - integer part of the keyword value +iomode - file access mode: either READONLY (=0) or READWRITE (=1) +keyname - name of a keyword (8 char max, null-terminated) +keynum - position of keyword in header (1st keyword = 1) +keyroot - root string for the keyword name (5 char max, null-terminated) +keysexist- number of existing keyword records in the CHU +keytype - header record type: -1=delete; 0=append or replace; + 1=append; 2=this is the END keyword +longstr - arbitrarily long string keyword value (null-terminated) +lpixel - coordinate of the last pixel to be read or written in the + FITS array. The array must be of length NAXIS and have values such + that lpixel[0] is in the range 1 to NAXIS1, lpixel[1] is in the + range 1 to NAXIS2, etc. +match - TRUE (=1) if the 2 strings match, else FALSE (=0) +maxdim - maximum number of values to return +member - row number of a grouping table member HDU. +memptr - pointer to the a FITS file in memory +mem_realloc - pointer to a function for reallocating more memory +memsize - size of the memory block allocated for the FITS file +mfptr - fitsfile* pointer to a grouping table member HDU. +mgopt - grouping table merge option parameter. Allowed values are: + OPT_MRG_COPY, and OPT_MRG_MOV. +minute - minute within hour (UTC) (0 - 59) +month - calendar month (UTC) (1 - 12) +morekeys - space in the header for this many more keywords +n_good_rows - number of rows evaluating to TRUE +namelist - string containing a comma or space delimited list of names +naxes - size of each dimension in the FITS array +naxis - number of dimensions in the FITS array +naxis1 - length of the X/first axis of the FITS array +naxis2 - length of the Y/second axis of the FITS array +naxis3 - length of the Z/third axis of the FITS array +nchars - number of characters to read or write +nelements- number of data elements to read or write +newfptr - returned pointer to the reopened file +newveclen- new value for the column vector repeat parameter +nexc - number of names in the exclusion list (may = 0) +nfound - number of keywords found (highest keyword number) +nkeys - number of keywords in the sequence +ninc - number of names in the inclusion list +nmembers - Number of grouping table members (NAXIS2 value). +nmove - number of HDUs to move (+ or -), relative to current position +nocomments - if equal to TRUE, then no commentary keywords will be copied +noisebits- number of bits to ignore when compressing floating point images +nrows - number of rows in the table +nstart - first integer value +nullarray- set to TRUE (=1) if corresponding data element is undefined +nulval - numerical value to represent undefined pixels +nulstr - character string used to represent undefined values in ASCII table +numval - numerical data value, of the appropriate data type +offset - byte offset in the heap to the first element of the vector +openfptr - pointer to a currently open FITS file +overlap - number of bytes in the binary table heap pointed to by more than 1 + descriptor +outcolnum- output column number; range = 1 to TFIELDS + 1 +outfile - and optional output filename; the input file will be copied to this prior + to opening the file +outfptr - pointer to a 'fitsfile' structure describing the output FITS file. +pcount - value of the PCOUNT keyword = size of binary table heap +previous - if TRUE, any previous HDUs in the input file will be copied. +repeat - length of column vector (e.g. 12J); == 1 for ASCII table +rmopt - grouping table remove option parameter. Allowed values are: + OPT_RM_GPT, OPT_RM_ENTRY, OPT_RM_MBR, and OPT_RM_ALL. +rootname - root filename, minus any extension or filtering specifications +rot - celestial coordinate rotation angle (degrees) +rowlen - length of a table row, in characters or bytes +rowlist - sorted list of row numbers to be deleted from the table +rownum - number of the row (first row = 1) +rowrange - list of rows or row ranges: '3,6-8,12,56-80' or '500-' +row_status - array of True/False results for each row that was evaluated +scale - linear scaling factor; true value = (FITS value) * scale + zero +second - second within minute (0 - 60.9999999999) (leap second!) +simple - TRUE (=1) if FITS file conforms to the Standard, else FALSE (=0) +space - number of blank spaces to leave between ASCII table columns +status - returned error status code (0 = OK) +sum - 32 bit unsigned checksum value +tbcol - byte position in row to start of column (1st col has tbcol = 1) +tdisp - Fortran style display format for the table column +tdimstr - the value of the TDIMn keyword +templt - template string used in comparison (null-terminated) +tfields - number of fields (columns) in the table +tfopt - grouping table member transfer option parameter. Allowed values are: + OPT_MCP_ADD, and OPT_MCP_MOV. +tform - format of the column (null-terminated); allowed values are: + ASCII tables: Iw, Aw, Fww.dd, Eww.dd, or Dww.dd + Binary tables: rL, rX, rB, rI, rJ, rA, rAw, rE, rD, rC, rM + where 'w'=width of the field, 'd'=no. of decimals, 'r'=repeat count. + Variable length array columns are denoted by a '1P' before the data type + character (e.g., '1PJ'). When creating a binary table, 2 addition tform + data type codes are recognized by CFITSIO: 'rU' and 'rV' for unsigned + 16-bit and unsigned 32-bit integer, respectively. + +theap - zero indexed byte offset of starting address of the heap + relative to the beginning of the binary table data +tilesize - array of length NAXIS that specifies the dimensions of + the image compression tiles +ttype - label or name for table column (null-terminated) +tunit - physical unit for table column (null-terminated) +typechar - symbolic code of the table column data type +typecode - data type code of the table column. The negative of + the value indicates a variable length array column. + Datatype typecode Mnemonic + bit, X 1 TBIT + byte, B 11 TBYTE + logical, L 14 TLOGICAL + ASCII character, A 16 TSTRING + short integer, I 21 TSHORT + integer, J 41 TINT32BIT + long long integer, K 81 TLONGLONG + real, E 42 TFLOAT + double precision, D 82 TDOUBLE + complex, C 83 TCOMPLEX + double complex, M 163 TDBLCOMPLEX + The TLONGLONG column type is experimental and is not + recognized in the official FITS Standard document +unit - the physical unit string (e.g., 'km/s') for a keyword +unused - number of unused bytes in the binary table heap +urltype - the file type of the FITS file (file://, ftp://, mem://, etc.) +validheap- returned value = FALSE if any of the variable length array + address are outside the valid range of addresses in the heap +value - the keyword value string (70 char max, null-terminated) +version - current version number of the CFITSIO library +width - width of the character string field +xcol - number of the column containing the X coordinate values +xinc - X axis coordinate increment at reference pixel (deg) +xpix - X axis pixel location +xpos - X axis celestial coordinate (usually RA) (deg) +xrefpix - X axis reference pixel array location +xrefval - X axis coordinate value at the reference pixel (deg) +ycol - number of the column containing the X coordinate values +year - calendar year (e.g. 1999, 2000, etc) +yinc - Y axis coordinate increment at reference pixel (deg) +ypix - y axis pixel location +ypos - y axis celestial coordinate (usually DEC) (deg) +yrefpix - Y axis reference pixel array location +yrefval - Y axis coordinate value at the reference pixel (deg) +zero - scaling offset; true value = (FITS value) * scale + zero +- + +*3 CFITSIO Error Status Codes + +The following table lists all the error status codes used by CFITSIO. +Programmers are encouraged to use the symbolic mnemonics (defined in +the file fitsio.h) rather than the actual integer status values to +improve the readability of their code. +- + Symbolic Const Value Meaning + -------------- ----- ----------------------------------------- + 0 OK, no error + SAME_FILE 101 input and output files are the same + TOO_MANY_FILES 103 tried to open too many FITS files at once + FILE_NOT_OPENED 104 could not open the named file + FILE_NOT_CREATED 105 could not create the named file + WRITE_ERROR 106 error writing to FITS file + END_OF_FILE 107 tried to move past end of file + READ_ERROR 108 error reading from FITS file + FILE_NOT_CLOSED 110 could not close the file + ARRAY_TOO_BIG 111 array dimensions exceed internal limit + READONLY_FILE 112 Cannot write to readonly file + MEMORY_ALLOCATION 113 Could not allocate memory + BAD_FILEPTR 114 invalid fitsfile pointer + NULL_INPUT_PTR 115 NULL input pointer to routine + SEEK_ERROR 116 error seeking position in file + + BAD_URL_PREFIX 121 invalid URL prefix on file name + TOO_MANY_DRIVERS 122 tried to register too many IO drivers + DRIVER_INIT_FAILED 123 driver initialization failed + NO_MATCHING_DRIVER 124 matching driver is not registered + URL_PARSE_ERROR 125 failed to parse input file URL + RANGE_PARSE_ERROR 126 parse error in range list + + SHARED_BADARG 151 bad argument in shared memory driver + SHARED_NULPTR 152 null pointer passed as an argument + SHARED_TABFULL 153 no more free shared memory handles + SHARED_NOTINIT 154 shared memory driver is not initialized + SHARED_IPCERR 155 IPC error returned by a system call + SHARED_NOMEM 156 no memory in shared memory driver + SHARED_AGAIN 157 resource deadlock would occur + SHARED_NOFILE 158 attempt to open/create lock file failed + SHARED_NORESIZE 159 shared memory block cannot be resized at the moment + + HEADER_NOT_EMPTY 201 header already contains keywords + KEY_NO_EXIST 202 keyword not found in header + KEY_OUT_BOUNDS 203 keyword record number is out of bounds + VALUE_UNDEFINED 204 keyword value field is blank + NO_QUOTE 205 string is missing the closing quote + BAD_KEYCHAR 207 illegal character in keyword name or card + BAD_ORDER 208 required keywords out of order + NOT_POS_INT 209 keyword value is not a positive integer + NO_END 210 couldn't find END keyword + BAD_BITPIX 211 illegal BITPIX keyword value + BAD_NAXIS 212 illegal NAXIS keyword value + BAD_NAXES 213 illegal NAXISn keyword value + BAD_PCOUNT 214 illegal PCOUNT keyword value + BAD_GCOUNT 215 illegal GCOUNT keyword value + BAD_TFIELDS 216 illegal TFIELDS keyword value + NEG_WIDTH 217 negative table row size + NEG_ROWS 218 negative number of rows in table + COL_NOT_FOUND 219 column with this name not found in table + BAD_SIMPLE 220 illegal value of SIMPLE keyword + NO_SIMPLE 221 Primary array doesn't start with SIMPLE + NO_BITPIX 222 Second keyword not BITPIX + NO_NAXIS 223 Third keyword not NAXIS + NO_NAXES 224 Couldn't find all the NAXISn keywords + NO_XTENSION 225 HDU doesn't start with XTENSION keyword + NOT_ATABLE 226 the CHDU is not an ASCII table extension + NOT_BTABLE 227 the CHDU is not a binary table extension + NO_PCOUNT 228 couldn't find PCOUNT keyword + NO_GCOUNT 229 couldn't find GCOUNT keyword + NO_TFIELDS 230 couldn't find TFIELDS keyword + NO_TBCOL 231 couldn't find TBCOLn keyword + NO_TFORM 232 couldn't find TFORMn keyword + NOT_IMAGE 233 the CHDU is not an IMAGE extension + BAD_TBCOL 234 TBCOLn keyword value < 0 or > rowlength + NOT_TABLE 235 the CHDU is not a table + COL_TOO_WIDE 236 column is too wide to fit in table + COL_NOT_UNIQUE 237 more than 1 column name matches template + BAD_ROW_WIDTH 241 sum of column widths not = NAXIS1 + UNKNOWN_EXT 251 unrecognizable FITS extension type + UNKNOWN_REC 252 unknown record; 1st keyword not SIMPLE or XTENSION + END_JUNK 253 END keyword is not blank + BAD_HEADER_FILL 254 Header fill area contains non-blank chars + BAD_DATA_FILL 255 Illegal data fill bytes (not zero or blank) + BAD_TFORM 261 illegal TFORM format code + BAD_TFORM_DTYPE 262 unrecognizable TFORM data type code + BAD_TDIM 263 illegal TDIMn keyword value + BAD_HEAP_PTR 264 invalid BINTABLE heap pointer is out of range + + BAD_HDU_NUM 301 HDU number < 1 + BAD_COL_NUM 302 column number < 1 or > tfields + NEG_FILE_POS 304 tried to move to negative byte location in file + NEG_BYTES 306 tried to read or write negative number of bytes + BAD_ROW_NUM 307 illegal starting row number in table + BAD_ELEM_NUM 308 illegal starting element number in vector + NOT_ASCII_COL 309 this is not an ASCII string column + NOT_LOGICAL_COL 310 this is not a logical data type column + BAD_ATABLE_FORMAT 311 ASCII table column has wrong format + BAD_BTABLE_FORMAT 312 Binary table column has wrong format + NO_NULL 314 null value has not been defined + NOT_VARI_LEN 317 this is not a variable length column + BAD_DIMEN 320 illegal number of dimensions in array + BAD_PIX_NUM 321 first pixel number greater than last pixel + ZERO_SCALE 322 illegal BSCALE or TSCALn keyword = 0 + NEG_AXIS 323 illegal axis length < 1 + + NOT_GROUP_TABLE 340 Grouping function error + HDU_ALREADY_MEMBER 341 + MEMBER_NOT_FOUND 342 + GROUP_NOT_FOUND 343 + BAD_GROUP_ID 344 + TOO_MANY_HDUS_TRACKED 345 + HDU_ALREADY_TRACKED 346 + BAD_OPTION 347 + IDENTICAL_POINTERS 348 + BAD_GROUP_ATTACH 349 + BAD_GROUP_DETACH 350 + + NGP_NO_MEMORY 360 malloc failed + NGP_READ_ERR 361 read error from file + NGP_NUL_PTR 362 null pointer passed as an argument. + Passing null pointer as a name of + template file raises this error + NGP_EMPTY_CURLINE 363 line read seems to be empty (used + internally) + NGP_UNREAD_QUEUE_FULL 364 cannot unread more then 1 line (or single + line twice) + NGP_INC_NESTING 365 too deep include file nesting (infinite + loop, template includes itself ?) + NGP_ERR_FOPEN 366 fopen() failed, cannot open template file + NGP_EOF 367 end of file encountered and not expected + NGP_BAD_ARG 368 bad arguments passed. Usually means + internal parser error. Should not happen + NGP_TOKEN_NOT_EXPECT 369 token not expected here + + BAD_I2C 401 bad int to formatted string conversion + BAD_F2C 402 bad float to formatted string conversion + BAD_INTKEY 403 can't interpret keyword value as integer + BAD_LOGICALKEY 404 can't interpret keyword value as logical + BAD_FLOATKEY 405 can't interpret keyword value as float + BAD_DOUBLEKEY 406 can't interpret keyword value as double + BAD_C2I 407 bad formatted string to int conversion + BAD_C2F 408 bad formatted string to float conversion + BAD_C2D 409 bad formatted string to double conversion + BAD_DATATYPE 410 illegal datatype code value + BAD_DECIM 411 bad number of decimal places specified + NUM_OVERFLOW 412 overflow during data type conversion + DATA_COMPRESSION_ERR 413 error compressing image + DATA_DECOMPRESSION_ERR 414 error uncompressing image + + BAD_DATE 420 error in date or time conversion + + PARSE_SYNTAX_ERR 431 syntax error in parser expression + PARSE_BAD_TYPE 432 expression did not evaluate to desired type + PARSE_LRG_VECTOR 433 vector result too large to return in array + PARSE_NO_OUTPUT 434 data parser failed not sent an out column + PARSE_BAD_COL 435 bad data encounter while parsing column + PARSE_BAD_OUTPUT 436 Output file not of proper type + + ANGLE_TOO_BIG 501 celestial angle too large for projection + BAD_WCS_VAL 502 bad celestial coordinate or pixel value + WCS_ERROR 503 error in celestial coordinate calculation + BAD_WCS_PROJ 504 unsupported type of celestial projection + NO_WCS_KEY 505 celestial coordinate keywords not found + APPROX_WCS_KEY 506 approximate wcs keyword values were returned +- +\end{document} + diff --git a/pkg/tbtables/cfitsio/cfitsio.ps b/pkg/tbtables/cfitsio/cfitsio.ps new file mode 100644 index 00000000..53d0810c --- /dev/null +++ b/pkg/tbtables/cfitsio/cfitsio.ps @@ -0,0 +1,12896 @@ +%!PS-Adobe-2.0 +%%Creator: dvips(k) 5.86 Copyright 1999 Radical Eye Software +%%Title: cfitsio.dvi +%%Pages: 168 +%%PageOrder: Ascend +%%BoundingBox: 0 0 612 792 +%%EndComments +%DVIPSWebPage: (www.radicaleye.com) +%DVIPSCommandLine: dvips -N0 cfitsio +%DVIPSParameters: dpi=600, compressed +%DVIPSSource: TeX output 2004.12.02:1427 +%%BeginProcSet: texc.pro +%! +/TeXDict 300 dict def TeXDict begin/N{def}def/B{bind def}N/S{exch}N/X{S +N}B/A{dup}B/TR{translate}N/isls false N/vsize 11 72 mul N/hsize 8.5 72 +mul N/landplus90{false}def/@rigin{isls{[0 landplus90{1 -1}{-1 1}ifelse 0 +0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{ +landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize +mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[ +matrix currentmatrix{A A round sub abs 0.00001 lt{round}if}forall round +exch round exch]setmatrix}N/@landscape{/isls true N}B/@manualfeed{ +statusdict/manualfeed true put}B/@copies{/#copies X}B/FMat[1 0 0 -1 0 0] +N/FBB[0 0 0 0]N/nn 0 N/IEn 0 N/ctr 0 N/df-tail{/nn 8 dict N nn begin +/FontType 3 N/FontMatrix fntrx N/FontBBox FBB N string/base X array +/BitMaps X/BuildChar{CharBuilder}N/Encoding IEn N end A{/foo setfont}2 +array copy cvx N load 0 nn put/ctr 0 N[}B/sf 0 N/df{/sf 1 N/fntrx FMat N +df-tail}B/dfs{div/sf X/fntrx[sf 0 0 sf neg 0 0]N df-tail}B/E{pop nn A +definefont setfont}B/Cw{Cd A length 5 sub get}B/Ch{Cd A length 4 sub get +}B/Cx{128 Cd A length 3 sub get sub}B/Cy{Cd A length 2 sub get 127 sub} +B/Cdx{Cd A length 1 sub get}B/Ci{Cd A type/stringtype ne{ctr get/ctr ctr +1 add N}if}B/id 0 N/rw 0 N/rc 0 N/gp 0 N/cp 0 N/G 0 N/CharBuilder{save 3 +1 roll S A/base get 2 index get S/BitMaps get S get/Cd X pop/ctr 0 N Cdx +0 Cx Cy Ch sub Cx Cw add Cy setcachedevice Cw Ch true[1 0 0 -1 -.1 Cx +sub Cy .1 sub]/id Ci N/rw Cw 7 add 8 idiv string N/rc 0 N/gp 0 N/cp 0 N{ +rc 0 ne{rc 1 sub/rc X rw}{G}ifelse}imagemask restore}B/G{{id gp get/gp +gp 1 add N A 18 mod S 18 idiv pl S get exec}loop}B/adv{cp add/cp X}B +/chg{rw cp id gp 4 index getinterval putinterval A gp add/gp X adv}B/nd{ +/cp 0 N rw exit}B/lsh{rw cp 2 copy get A 0 eq{pop 1}{A 255 eq{pop 254}{ +A A add 255 and S 1 and or}ifelse}ifelse put 1 adv}B/rsh{rw cp 2 copy +get A 0 eq{pop 128}{A 255 eq{pop 127}{A 2 idiv S 128 and or}ifelse} +ifelse put 1 adv}B/clr{rw cp 2 index string putinterval adv}B/set{rw cp +fillstr 0 4 index getinterval putinterval adv}B/fillstr 18 string 0 1 17 +{2 copy 255 put pop}for N/pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add +chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{ +1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]A{bind pop} +forall N/D{/cc X A type/stringtype ne{]}if nn/base get cc ctr put nn +/BitMaps get S ctr S sf 1 ne{A A length 1 sub A 2 index S get sf div put +}if put/ctr ctr 1 add N}B/I{cc 1 add D}B/bop{userdict/bop-hook known{ +bop-hook}if/SI save N @rigin 0 0 moveto/V matrix currentmatrix A 1 get A +mul exch 0 get A mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N/eop{ +SI restore userdict/eop-hook known{eop-hook}if showpage}N/@start{ +userdict/start-hook known{start-hook}if pop/VResolution X/Resolution X +1000 div/DVImag X/IEn 256 array N 2 string 0 1 255{IEn S A 360 add 36 4 +index cvrs cvn put}for pop 65781.76 div/vsize X 65781.76 div/hsize X}N +/p{show}N/RMat[1 0 0 -1 0 0]N/BDot 260 string N/Rx 0 N/Ry 0 N/V{}B/RV/v{ +/Ry X/Rx X V}B statusdict begin/product where{pop false[(Display)(NeXT) +(LaserWriter 16/600)]{A length product length le{A length product exch 0 +exch getinterval eq{pop true exit}if}{pop}ifelse}forall}{false}ifelse +end{{gsave TR -.1 .1 TR 1 1 scale Rx Ry false RMat{BDot}imagemask +grestore}}{{gsave TR -.1 .1 TR Rx Ry scale 1 1 false RMat{BDot} +imagemask grestore}}ifelse B/QV{gsave newpath transform round exch round +exch itransform moveto Rx 0 rlineto 0 Ry neg rlineto Rx neg 0 rlineto +fill grestore}B/a{moveto}B/delta 0 N/tail{A/delta X 0 rmoveto}B/M{S p +delta add tail}B/b{S p tail}B/c{-4 M}B/d{-3 M}B/e{-2 M}B/f{-1 M}B/g{0 M} +B/h{1 M}B/i{2 M}B/j{3 M}B/k{4 M}B/w{0 rmoveto}B/l{p -4 w}B/m{p -3 w}B/n{ +p -2 w}B/o{p -1 w}B/q{p 1 w}B/r{p 2 w}B/s{p 3 w}B/t{p 4 w}B/x{0 S +rmoveto}B/y{3 2 roll p a}B/bos{/SS save N}B/eos{SS restore}B end + +%%EndProcSet +TeXDict begin 40258431 52099146 1000 600 600 (cfitsio.dvi) +@start +%DVIPSBitmapFont: Fa cmti10 10.95 17 +/Fa 17 118 df<49B712C018F818FE903B0003FE0003FF9438007F804BEC1FC0F00FE0F0 +07F014074BEC03F8F001FCA2140F4BEC00FEA3141F4B15FFA3143F5DA3027F5D5DA219FE +14FF92C81203A34917FC4A1507A219F813034A150F19F0A20107EE1FE05CF03FC0A2010F +EE7F804A16006060011F4B5A4A4A5A4D5AA2013F4B5A4AEC3FC04DC7FC017F15FEEE03FC +4AEB0FF001FFEC7FE0B8128004FCC8FC16E0403E7BBD45>68 D<49B648B6FC495DA2D900 +0390C7000313004B5D4B5DA2180714074B5DA2180F140F4B5DA2181F141F4B5DA2183F14 +3F4B5DA2187F147F4B5DA218FF91B8FC96C7FCA292C712015B4A5DA2170313034A5DA217 +0713074A5DA2170F130F4A5DA2171F131F4A5DA2173F133F4A5DA2017F157FA24A5D496C +4A7EB66CB67EA3483E7BBD44>72 D<001FB500F090B512F0485DA226003FF0C7380FFC00 +4AEC03F04A5D715A017F1503A24A5DA201FF150795C7FC91C8FCA2485E170E5BA2000316 +1E171C5BA20007163C17385BA2000F167817705BA2001F16F05F5BA2003F1501A2495DA2 +007F1503A2495DA2160794C8FC48C8FC5E160E161E6C151C163C5E5E5E6C6C13014B5A00 +1F4A5A6C6C011FC9FC6D133E6C6C13F83903FC07F0C6B512C0013F90CAFCEB07F83C406F +BD44>85 D<147E49B47E903907C1C38090391F80EFC090383F00FF017E137F4914804848 +133F485AA248481400120F5B001F5C157E485AA215FE007F5C90C7FCA21401485C5AA214 +03EDF0385AA21407EDE078020F1370127C021F13F0007E013F13E0003E137FECF3E1261F +01E313C03A0F8781E3803A03FF00FF00D800FC133E252977A72E>97 +DI101 D103 D<1478EB01FCA21303A314F8EB00E01400AD137C48B4FC38038F80EA0707000E +13C0121E121CEA3C0F1238A2EA781F00701380A2EAF03F140012005B137E13FE5BA21201 +5BA212035B1438120713E0000F1378EBC070A214F0EB80E0A2EB81C01383148038078700 +EA03FEEA00F8163E79BC1C>105 D108 DIII<903903E001F890390F +F807FE903A1E7C1E0F80903A1C3E3C07C0013C137801389038E003E0EB783F017001C013 +F0ED80019038F07F0001E015F8147E1603000113FEA2C75AA20101140717F05CA2010314 +0F17E05CA20107EC1FC0A24A1480163F010F15005E167E5E131F4B5A6E485A4B5A90393F +B80F80DA9C1FC7FCEC0FFCEC03E049C9FCA2137EA213FEA25BA21201A25BA21203A2387F +FFE0B5FCA22D3A80A72E>I114 DII<137C48B4 +141C26038F80137EEA0707000E7F001E15FE121CD83C0F5C12381501EA781F007001805B +A2D8F03F1303140000005D5B017E1307A201FE5C5B150F1201495CA2151F0003EDC1C049 +1481A2153F1683EE0380A2ED7F07000102FF13005C01F8EBDF0F00009038079F0E90397C +0F0F1C90391FFC07F8903907F001F02A2979A731>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fb cmmi10 10.95 1 +/Fb 1 63 df<126012F8B4FCEA7FC0EA1FF0EA07FCEA01FF38007FC0EB1FF0EB07FCEB01 +FF9038007FC0EC1FF0EC07FCEC01FF9138007FC0ED1FF0ED07FCED01FF9238007FC0EE1F +F0EE07FCEE01FF9338007FC0EF1FF0EF07F8EF01FCA2EF07F8EF1FF0EF7FC0933801FF00 +EE07FCEE1FF0EE7FC04B48C7FCED07FCED1FF0ED7FC04A48C8FCEC07FCEC1FF0EC7FC049 +48C9FCEB07FCEB1FF0EB7FC04848CAFCEA07FCEA1FF0EA7FC048CBFC12FC1270363678B1 +47>62 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fc cmsy10 10.95 4 +/Fc 4 107 df15 +D<153FEC03FFEC0FE0EC3F80EC7E00495A5C495AA2495AB3AA130F5C131F495A91C7FC13 +FEEA03F8EA7FE048C8FCEA7FE0EA03F8EA00FE133F806D7E130F801307B3AA6D7EA26D7E +80EB007EEC3F80EC0FE0EC03FFEC003F205B7AC32D>102 D<12FCEAFFC0EA07F0EA01FC +EA007E6D7E131F6D7EA26D7EB3AA801303806D7E1300147FEC1FC0EC07FEEC00FFEC07FE +EC1FC0EC7F0014FC1301495A5C13075CB3AA495AA2495A133F017EC7FC485AEA07F0EAFF +C000FCC8FC205B7AC32D>I<126012F0B3B3B3B3B11260045B76C319>106 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fd cmbx12 12 58 +/Fd 58 122 df12 D45 DI48 DIII<163FA25E +5E5D5DA25D5D5D5DA25D92B5FCEC01F7EC03E7140715C7EC0F87EC1F07143E147E147C14 +F8EB01F0EB03E0130714C0EB0F80EB1F00133E5BA25B485A485A485A120F5B48C7FC123E +5A12FCB91280A5C8000F90C7FCAC027FB61280A531417DC038>I<0007150301E0143F01 +FFEB07FF91B6FC5E5E5E5E5E16804BC7FC5D15E092C8FC01C0C9FCAAEC3FF001C1B5FC01 +C714C001DF14F09039FFE03FFC9138000FFE01FC6D7E01F06D13804915C0497F6C4815E0 +C8FC6F13F0A317F8A4EA0F80EA3FE0487E12FF7FA317F05B5D6C4815E05B007EC74813C0 +123E003F4A1380D81FC0491300D80FF0495AD807FEEBFFFC6CB612F0C65D013F1480010F +01FCC7FC010113C02D427BC038>I<4AB47E021F13F0027F13FC49B6FC01079038807F80 +90390FFC001FD93FF014C04948137F4948EBFFE048495A5A1400485A120FA248486D13C0 +EE7F80EE1E00003F92C7FCA25B127FA2EC07FC91381FFF8000FF017F13E091B512F89039 +F9F01FFC9039FBC007FE9039FF8003FF17804A6C13C05B6F13E0A24915F0A317F85BA412 +7FA5123FA217F07F121FA2000F4A13E0A26C6C15C06D4913806C018014006C6D485A6C90 +38E01FFC6DB55A011F5C010714C0010191C7FC9038003FF02D427BC038>I<121E121F13 +FC90B712FEA45A17FC17F817F017E017C0A2481680007EC8EA3F00007C157E5E00785D15 +014B5A00F84A5A484A5A5E151FC848C7FC157E5DA24A5A14035D14074A5AA2141F5D143F +A2147F5D14FFA25BA35B92C8FCA35BA55BAA6D5A6D5A6D5A2F447AC238>III +I65 DIII< +BA12F8A485D8001F90C71201EF003F180F180318011800A2197E193EA3191EA21778A285 +A405F890C7FCA316011603161F92B5FCA5ED001F160316011600A2F101E01778A2F103C0 +A494C7FC1907A21A80A2190FA2191FA2193FF17F0061601807181F4DB5FCBBFC61A44344 +7DC34A>II +III75 DIII80 D82 DI<003FBA12E0A59026FE000FEB8003D87FE09338003FF049171F90C71607A2 +007E1803007C1801A300781800A400F819F8481978A5C81700B3B3A20107B8FCA545437C +C24E>IIII<903801FFE0011F13FE017F6D +7E48B612E03A03FE007FF84848EB1FFC6D6D7E486C6D7EA26F7FA36F7F6C5A6C5AEA00F0 +90C7FCA40203B5FC91B6FC1307013F13F19038FFFC01000313E0000F1380381FFE00485A +5B127F5B12FF5BA35DA26D5B6C6C5B4B13F0D83FFE013EEBFFC03A1FFF80FC7F0007EBFF +F86CECE01FC66CEB8007D90FFCC9FC322F7DAD36>97 DIIIIIII<137C48B4FC4813804813C0A24813E0A56C +13C0A26C13806C1300EA007C90C7FCAAEB7FC0EA7FFFA512037EB3AFB6FCA518467CC520 +>I +107 DI<90277F8007FEEC0FFC +B590263FFFC090387FFF8092B5D8F001B512E002816E4880913D87F01FFC0FE03FF8913D +8FC00FFE1F801FFC0003D99F009026FF3E007F6C019E6D013C130F02BC5D02F86D496D7E +A24A5D4A5DA34A5DB3A7B60081B60003B512FEA5572D7CAC5E>I<90397F8007FEB59038 +3FFF8092B512E0028114F8913987F03FFC91388F801F000390399F000FFE6C139E14BC02 +F86D7E5CA25CA35CB3A7B60083B512FEA5372D7CAC3E>II<90397FC00FF8B590B57E02C314E002CF14F89139DFC03F +FC9139FF001FFE000301FCEB07FF6C496D13804A15C04A6D13E05C7013F0A2EF7FF8A4EF +3FFCACEF7FF8A318F017FFA24C13E06E15C06E5B6E4913806E4913006E495A9139DFC07F +FC02CFB512F002C314C002C091C7FCED1FF092C9FCADB67EA536407DAC3E>II<90387F807FB53881FFE002 +8313F0028F13F8ED8FFC91389F1FFE000313BE6C13BC14F8A214F0ED0FFC9138E007F8ED +01E092C7FCA35CB3A5B612E0A5272D7DAC2E>I<90391FFC038090B51287000314FF120F +381FF003383FC00049133F48C7121F127E00FE140FA215077EA27F01E090C7FC13FE387F +FFF014FF6C14C015F06C14FC6C800003806C15806C7E010F14C0EB003F020313E0140000 +F0143FA26C141F150FA27EA26C15C06C141FA26DEB3F8001E0EB7F009038F803FE90B55A +00FC5CD8F03F13E026E007FEC7FC232F7CAD2C>II< +D97FC049B4FCB50103B5FCA50003EC000F6C81B3A85EA25EA25E7E6E491380017FD901F7 +13FE9138F807E76DB512C7010F1407010313FE9026007FF0EBFC00372E7CAC3E>I +IIII +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fe cmtt10 10.95 93 +/Fe 93 127 df<121C127FEAFF80B3EA7F00B2123EC7FCA8121C127FA2EAFF80A3EA7F00 +A2121C09396DB830>33 D<00101304007C131F00FEEB3F80A26C137FA248133FB2007E14 +00007C7F003C131E00101304191C75B830>I<903907C007C0A2496C487EA8011F131FA2 +02C05BA3007FB7FCA2B81280A36C16006C5D3A007F807F80A2020090C7FCA9495BA2003F +90B512FE4881B81280A36C1600A22701FC01FCC7FCA300031303A201F85BA76C486C5AA2 +29387DB730>I<1438147C14FCA4EB03FF011F13E090B512FC4880000780481580261FFE +FD13C09039F0FC3FE0D83FC0131FD87F80EB0FF001001307007E15F800FE14035A1507A3 +6CEC03F0A2007F91C7FC138013C0EA3FF0EA1FFE13FF6C13FF6C14E0000114F86C6C7F01 +1F7F01037F0100148002FD13C09138FC7FE0151FED0FF015070018EC03F8127E1501B4FC +A35AA26CEC03F07E01801307ED0FE0D83FC0131F01F0EB7FC0D81FFEB512806CB612006C +5C6C5CC614F0013F13C0D907FEC7FCEB00FCA5147C143825477BBE30>II +II<141E147F14FF5BEB03 +FEEB07FCEB0FF0EB1FE0EB3FC0EB7F80EBFF00485A5B12035B485A120F5BA2485AA2123F +5BA2127F90C7FCA412FEAD127FA47F123FA27F121FA26C7EA27F12076C7E7F12017F6C7E +EB7F80EB3FC0EB1FE0EB0FF0EB07FCEB03FEEB01FF7F147F141E184771BE30>I<127812 +FE7E7F6C7E6C7EEA0FF06C7E6C7E6C7E6C7EEB7F80133F14C0131FEB0FE014F01307A2EB +03F8A214FC1301A214FE1300A4147FAD14FEA4130114FCA2130314F8A2EB07F0A2130F14 +E0EB1FC0133F1480137FEBFF00485A485A485A485AEA3FE0485A485A90C7FC5A12781847 +78BE30>I<14E0497E497EA60038EC0380007EEC0FC0D8FF83EB3FE001C3137F9038F3F9 +FF267FFBFB13C06CB61280000FECFE00000314F86C5C6C6C13C0011F90C7FC017F13C048 +B512F04880000F14FE003FECFF80267FFBFB13C026FFF3F913E09038C3F87F0183133FD8 +7E03EB0FC00038EC0380000091C7FCA66D5A6D5A23277AAE30>I<143EA2147FAF007FB7 +FCA2B81280A36C1600A2C76CC8FCAF143EA229297DAF30>II<007FB612F0A2B712F8A36C15F0A225077B9E30>I<120F +EA3FC0EA7FE0A2EAFFF0A4EA7FE0A2EA3FC0EA0F000C0C6E8B30>I<16F01501ED03F8A2 +1507A2ED0FF0A2ED1FE0A2ED3FC0A2ED7F80A2EDFF00A24A5AA25D1403A24A5AA24A5AA2 +4A5AA24A5AA24A5AA24AC7FCA2495AA25C1303A2495AA2495AA2495AA2495AA2495AA249 +C8FCA2485AA25B1203A2485AA2485AA2485AA2485AA2485AA248C9FCA25AA2127CA22547 +7BBE30>I<14FE903807FFC0497F013F13F8497F90B57E48EB83FF4848C6138049137F48 +48EB3FC04848EB1FE049130F001F15F0491307A24848EB03F8A290C712014815FCA400FE +EC00FEAD6C14016C15FCA36D1303003F15F8A26D1307001F15F0A26D130F6C6CEB1FE0A2 +6C6CEB3FC06C6CEB7F806D13FF2601FF8313006CEBFFFE6D5B6D5B010F13E06D5BD900FE +C7FC273A7CB830>IIIII<000FB6128048 +15C05AA316800180C8FCAEEB83FF019F13C090B512F015FC8181D9FE0313809039F0007F +C049133F0180EB1FE06CC7120F000E15F0C81207A216F81503A31218127EA2B4FC150716 +F048140F6C15E06C141F6DEB3FC06D137F3A3FE001FF80261FFC0F13006CB55A6C5C6C5C +6C14E06C6C1380D90FFCC7FC25397BB730>II<127CB712FC16FEA416FC48C7EA +0FF816F0ED1FE0007CEC3FC0C8EA7F80EDFF00A24A5A4A5A5D14075D140F5D4A5AA24A5A +A24AC7FCA25C5C13015CA213035CA213075CA4495AA6131F5CA96D5A6DC8FC273A7CB830 +>I<49B4FC011F13F0017F13FC90B57E0003ECFF804815C048010113E03A1FF8003FF049 +131FD83FC0EB07F8A24848EB03FC90C71201A56D1303003F15F86D13076C6CEB0FF06C6C +EB1FE0D807FCEB7FC03A03FF83FF806C90B512006C6C13FC011F13F0497F90B512FE4880 +2607FE0013C0D80FF8EB3FE0D81FE0EB0FF04848EB07F8491303007F15FC90C712014815 +FE481400A66C14016C15FC6D1303003F15F86D1307D81FF0EB1FF06D133F3A0FFF01FFE0 +6C90B512C06C1580C6ECFE006D5B011F13F0010190C7FC273A7CB830>I<49B4FC010F13 +E0013F13F890B57E4880488048010113803A0FFC007FC0D81FF0EB3FE04848131F49EB0F +F048481307A290C7EA03F85A4815FC1501A416FEA37E7E6D1303A26C6C13076C6C130F6D +133FD80FFC13FF6CB6FC7E6C14FE6C14F9013FEBE1FC010F138190380060011400ED03F8 +A2150716F0150F000F15E0486C131F486CEB3FC0157FEDFF804A1300EC07FE391FF01FFC +90B55A6C5C6C5C6C1480C649C7FCEB3FF0273A7CB830>I<120FEA3FC0EA7FE0A2EAFFF0 +A4EA7FE0A2EA3FC0EA0F00C7FCAF120FEA3FC0EA7FE0A2EAFFF0A4EA7FE0A2EA3FC0EA0F +000C276EA630>II<16F01503ED07F8151F157FEDFFF0 +14034A13C0021F138091383FFE00ECFFF8495B010713C0495BD93FFEC7FC495A3801FFF0 +485B000F13804890C8FCEA7FFC5BEAFFE05B7FEA7FF87FEA1FFF6C7F000313E06C7F3800 +7FFC6D7E90380FFF806D7F010113F06D7FEC3FFE91381FFF80020713C06E13F01400ED7F +F8151F1507ED03F01500252F7BB230>I<007FB7FCA2B81280A36C16006C5DCBFCA7003F +B612FE4881B81280A36C1600A229157DA530>I<1278127EB4FC13C07FEA7FF813FEEA1F +FF6C13C000037F6C13F86C6C7EEB1FFF6D7F010313E06D7F9038007FFC6E7E91380FFF80 +6E13C0020113F080ED3FF8151F153FEDFFF05C020713C04A138091383FFE004A5A903801 +FFF0495B010F13804990C7FCEB7FFC48485A4813E0000F5B4890C8FCEA7FFE13F8EAFFE0 +5B90C9FC127E1278252F7BB230>III<147F4A7EA2497FA4497F14F7A401077F14E3A301 +0F7FA314C1A2011F7FA490383F80FEA590387F007FA4498049133F90B6FCA34881A39038 +FC001F00038149130FA4000781491307A2D87FFFEB7FFFB56CB51280A46C496C13002939 +7DB830>I<007FB512F0B612FE6F7E82826C813A03F8001FF815076F7E1501A26F7EA615 +015EA24B5A1507ED1FF0ED7FE090B65A5E4BC7FC6F7E16E0829039F8000FF8ED03FC6F7E +1500167FA3EE3F80A6167F1700A25E4B5A1503ED1FFC007FB6FCB75A5E16C05E6C02FCC7 +FC29387EB730>I<91387F803C903903FFF03E49EBFC7E011F13FE49EBFFFE5B9038FFE0 +7F48EB801F3903FE000F484813075B48481303A2484813015B123F491300A2127F90C8FC +167C16005A5AAC7E7EA2167C6D14FE123FA27F121F6D13016C6C14FCA26C6CEB03F86D13 +076C6CEB0FF03901FF801F6C9038E07FE06DB512C06D14806D1400010713FC6D13F09038 +007FC0273A7CB830>I<003FB512E04814FCB67E6F7E6C816C813A03F8007FF0ED1FF815 +0F6F7E6F7E15016F7EA2EE7F80A2163F17C0161FA4EE0FE0AC161F17C0A3163F1780A216 +7F17005E4B5A15034B5A150F4B5AED7FF0003FB65A485DB75A93C7FC6C14FC6C14E02B38 +7FB730>I<007FB7FCB81280A47ED803F8C7123FA8EE1F0093C7FCA4157C15FEA490B5FC +A6EBF800A4157C92C8FCA5EE07C0EE0FE0A9007FB7FCB8FCA46C16C02B387EB730>I<00 +3FB712804816C0B8FCA27E7ED801FCC7121FA8EE0F8093C7FCA5153E157FA490B6FCA690 +38FC007FA4153E92C8FCAE383FFFF8487FB5FCA27E6C5B2A387EB730>I<02FF13F00103 +EBC0F8010F13F1013F13FD4913FF90B6FC4813C1EC007F4848133F4848131F49130F485A +491307121F5B123F491303A2127F90C7FC6F5A92C8FC5A5AA892B5FC4A14805CA26C7F6C +6D1400ED03F8A27F003F1407A27F121F6D130F120F7F6C6C131FA2D803FE133F6C6C137F +ECC1FF6C90B5FC7F6D13FB010F13F30103EBC1F0010090C8FC293A7DB830>I<3B3FFF80 +0FFFE0486D4813F0B56C4813F8A26C496C13F06C496C13E0D803F8C7EAFE00B290B6FCA6 +01F8C7FCB3A23B3FFF800FFFE0486D4813F0B56C4813F8A26C496C13F06C496C13E02D38 +7FB730>I<007FB6FCB71280A46C1500260007F0C7FCB3B3A8007FB6FCB71280A46C1500 +213879B730>I<49B512F04914F85BA27F6D14F090C7EAFE00B3B3123C127EB4FCA24A5A +1403EB8007397FF01FF86CB55A5D6C5C00075C000149C7FC38003FF025397AB730>II<383FFFF8487FB57EA26C5B6C5BD801FCC9FCB3B0EE0F80EE1FC0A9003FB7FC5AB8 +FCA27E6C16802A387EB730>III<90383FFFE048B512FC000714FF4815804815C04815 +E0EBF80001E0133FD87F80EB0FF0A290C71207A44815F8481403B3A96C1407A26C15F0A3 +6D130FA26D131F6C6CEB3FE001F813FF90B6FC6C15C06C15806C1500000114FCD8003F13 +E0253A7BB830>I<007FB512F0B612FE6F7E16E0826C813903F8003FED0FFCED03FE1501 +6F7EA2821780163FA6167F17005EA24B5A1503ED0FFCED3FF890B6FC5E5E16804BC7FC15 +F001F8C9FCB0387FFFC0B57EA46C5B29387EB730>I<90383FFFE048B512FC000714FF48 +15804815C04815E0EBF80001E0133F4848EB1FF049130F90C71207A44815F8481403B3A8 +147E14FE6CEBFF076C15F0EC7F87A2EC3FC7018013CF9038C01FFFD83FE014E0EBF80F90 +B6FC6C15C06C15806C1500000114FCD8003F7FEB00016E7EA21680157F16C0153F16E015 +1F16F0150FED07E025467BB830>I<003FB57E4814F0B612FC15FF6C816C812603F8017F +9138003FF0151F6F7E15071503821501A515035E1507150F4B5A153F4AB45A90B65A5E93 +C7FC5D8182D9F8007FED3FE0151F150F821507A817F8EEF1FCA53A3FFF8003FB4801C0EB +FFF8B56C7E17F06C496C13E06C49EB7FC0C9EA1F002E397FB730>I<90390FF803C0D97F +FF13E048B512C74814F74814FF5A381FF80F383FE001497E4848137F90C7123F5A48141F +A2150FA37EED07C06C91C7FC7F7FEA3FF0EA1FFEEBFFF06C13FF6C14E0000114F86C8001 +1F13FF01031480D9003F13C014019138007FE0151FED0FF0A2ED07F8A2007C140312FEA5 +6C140716F07F6DEB0FE06D131F01F8EB3FC001FF13FF91B51280160000FD5CD8FC7F13F8 +D8F81F5BD878011380253A7BB830>I<003FB712C04816E0B8FCA43AFE003F800FA8007C +ED07C0C791C7FCB3B1011FB5FC4980A46D91C7FC2B387EB730>I<3B7FFFC007FFFCB56C +4813FEA46C496C13FCD803F8C7EA3F80B3B16D147F00011600A36C6C14FE6D13016D5CEC +800390393FE00FF890391FF83FF06DB55A6D5C6D5C6D91C7FC9038007FFCEC1FF02F3980 +B730>III<3A3FFF01FF +F84801837F02C77FA202835B6C01015B3A01FC007F806D91C7FC00005C6D5BEB7F01EC81 +FCEB3F8314C3011F5B14E7010F5B14FF6D5BA26D5BA26D5BA26D90C8FCA4497FA2497FA2 +815B81EB0FE781EB1FC381EB3F8181EB7F0081497F49800001143F49800003141F498000 +07140FD87FFEEB7FFFB590B5128080A25C6C486D130029387DB730>II<001FB612 +FC4815FE5AA490C7EA03FCED07F816F0150FED1FE016C0153FED7F80003E1500C85A4A5A +5D14034A5A5D140F4A5A5D143F4A5A92C7FC5C495A5C1303495A5C130F495A5C133F495A +91C8FC5B4848147C4914FE1203485A5B120F485A5B123F485A90B6FCB7FCA46C15FC2738 +7CB730>I<007FB5FCB61280A4150048C8FCB3B3B3A5B6FC1580A46C140019476DBE30>I< +127CA212FEA27EA26C7EA26C7EA26C7EA26C7EA26C7EA26C7EA212017FA26C7EA26D7EA2 +6D7EA26D7EA26D7EA26D7EA26D7EA2130180A26D7EA26E7EA26E7EA26E7EA26E7EA26E7E +A26E7EA2140181A26E7EA2ED7F80A2ED3FC0A2ED1FE0A2ED0FF0A2ED07F8A21503A2ED01 +F0150025477BBE30>I<007FB5FCB61280A47EC7123FB3B3B3A5007FB5FCB6FCA46C1400 +19477DBE30>I<1307EB1FC0EB7FF0497E000313FE000FEBFF80003F14E0D87FFD13F039 +FFF07FF8EBC01FEB800F38FE0003007CEB01F00010EB00401D0E77B730>I<007FB612F0 +A2B712F8A36C15F0A225077B7D30>I97 +DII<913801FFE04A7F5C +A28080EC0007AAEB03FE90381FFF874913E790B6FC5A5A481303380FFC00D81FF0133F49 +131F485A150F4848130790C7FCA25AA25AA87E6C140FA27F003F141F6D133F6C7E6D137F +390FF801FF2607FE07EBFFC06CB712E06C16F06C14F76D01C713E0011F010313C0D907FC +C8FC2C397DB730>I<49B4FC010713E0011F13F8017F7F90B57E488048018113803A07FC +007FC04848133FD81FE0EB1FE0150F484814F0491307127F90C7FCED03F85A5AB7FCA516 +F048C9FC7E7EA27F003FEC01F06DEB03F86C7E6C7E6D1307D807FEEB1FF03A03FFC07FE0 +6C90B5FC6C15C0013F14806DEBFE00010713F8010013C0252A7CA830>IIII< +14E0EB03F8A2497EA36D5AA2EB00E091C8FCA9381FFFF8487F5AA27E7EEA0001B3A9003F +B612C04815E0B7FCA27E6C15C023397AB830>III<387FFFF8B57EA47EEA0001B3B3A8007FB612F0B712F8A46C15F025387BB7 +30>I<02FC137E3B7FC3FF01FF80D8FFEF01877F90B500CF7F15DF92B57E6C010F138726 +07FE07EB03F801FC13FE9039F803FC01A201F013F8A301E013F0B3A23C7FFE0FFF07FF80 +B548018F13C0A46C486C01071380322881A730>II< +49B4FC010F13E0013F13F8497F90B57E0003ECFF8014013A07FC007FC04848EB3FE0D81F +E0EB0FF0A24848EB07F8491303007F15FC90C71201A300FEEC00FEA86C14016C15FCA26D +1303003F15F86D13076D130F6C6CEB1FF06C6CEB3FE06D137F3A07FF01FFC06C90B51280 +6C15006C6C13FC6D5B010F13E0010190C7FC272A7CA830>II<49B413F8010FEBC1FC013F13F14913FD48B6FC5A4813 +81390FFC007F49131F4848130F491307485A491303127F90C7FC15015A5AA77E7E15037F +A26C6C1307150F6C6C131F6C6C133F01FC137F3907FF01FF6C90B5FC6C14FD6C14F9013F +13F1010F13C1903803FE0190C7FCAD92B512F84A14FCA46E14F82E3C7DA730>II<90381FFC1E48B5129F000714FF5A5A5A387FF007EB800100FEC7FC4880A46C143E +007F91C7FC13E06CB4FC6C13FC6CEBFF806C14E0000114F86C6C7F01037F9038000FFF02 +001380007C147F00FEEC1FC0A2150F7EA27F151F6DEB3F806D137F9039FC03FF0090B6FC +5D5D00FC14F0D8F83F13C026780FFEC7FC222A79A830>III<3B3F +FFC07FFF80486DB512C0B515E0A26C16C06C496C13803B01F80003F000A26D130700005D +A26D130F017E5CA2017F131F6D5CA2EC803F011F91C7FCA26E5A010F137EA2ECE0FE0107 +5BA214F101035BA3903801FBF0A314FF6D5BA36E5A6E5A2B277EA630>I<3B3FFFC01FFF +E0486D4813F0B515F8A26C16F06C496C13E0D807E0C7EA3F00A26D5C0003157EA56D14FE +00015DEC0F80EC1FC0EC3FE0A33A00FC7FF1F8A2147DA2ECFDF9017C5C14F8A3017E13FB +A290393FF07FE0A3ECE03FA2011F5C90390F800F802D277FA630>I<3A3FFF81FFFC4801 +C37FB580A26C5D6C01815BC648C66CC7FC137FEC80FE90383F81FC90381FC3F8EB0FE3EC +E7F06DB45A6D5B7F6D5B92C8FC147E147F5C497F81903803F7E0EB07E790380FE3F0ECC1 +F890381F81FC90383F80FE90387F007E017E137F01FE6D7E48486D7E267FFF80B5FCB500 +C1148014E3A214C16C0180140029277DA630>I<3B3FFFC07FFF80486DB512C0B515E0A2 +6C16C06C496C13803B01FC0003F000A2000014076D5C137E150F017F5C7F151FD91F805B +A214C0010F49C7FCA214E00107137EA2EB03F0157C15FCEB01F85DA2EB00F9ECFDF0147D +147FA26E5AA36E5AA35DA2143F92C8FCA25C147EA2000F13FE486C5AEA3FC1EBC3F81387 +EB8FF0EBFFE06C5B5C6C90C9FC6C5AEA01F02B3C7EA630>I<001FB612FC4815FE5AA316 +FC90C7EA0FF8ED1FF0ED3FE0ED7FC0EDFF80003E491300C7485A4A5A4A5A4A5A4A5A4A5A +4A5A4990C7FC495A495A495A495A495A495A4948133E4890C7127F485A485A485A485A48 +5A48B7FCB8FCA46C15FE28277DA630>II< +127CA212FEB3B3B3AD127CA207476CBE30>II<017C13 +3848B4137C48EB80FE4813C14813C348EBEFFC397FEFFFF0D8FF8713E0010713C0486C13 +80D87C0113003838007C1F0C78B730>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Ff cmbx12 14.4 62 +/Ff 62 123 df<922601FFFC903801FFE0033F9026FF801F13F84AB6D8E07F13FE020F03 +F9B6FC023FD9C00FB500C0138091277FFC0003D9FE0113C0902601FFE049495A49494949 +4813E04990C714F049484A13E0495A19C0495A7413C0017F17804A6E6E1380719138007E +007192C7FCAEBCFCA526007FF8C7000301C0C8FCB3B3A7007FB5D8F803B612F0A553547D +D34E>11 DI<151E153E157E15FCEC01F8EC07F0EC0FE0EC1FC01580143FEC7F00 +14FE1301495A5C1307495AA2495A133F5C137FA2495AA24890C7FCA25A5BA21207A2485A +A3121F5BA3123FA25BA3127FA55B12FFB3A3127F7FA5123FA37FA2121FA37F120FA36C7E +A21203A27F7EA26C7FA26D7EA2133F80131F6D7EA26D7E1303806D7E1300147FEC3F8014 +1F15C0EC0FE0EC07F0EC01F8EC00FC157E153E151E1F7973D934>40 +D<127012F8127C127E7EEA1FC06C7E6C7E12037F6C7E6C7E7F6D7E133F806D7EA26D7E80 +130780A26D7EA26D7EA215807FA215C0A2EC7FE0A315F0143FA315F8A2141FA315FCA514 +0F15FEB3A315FC141FA515F8A3143FA215F0A3147F15E0A3ECFFC0A21580A25B1500A249 +5AA2495AA25C130F5C495AA2495A5C137F49C7FC5B485A485A5B1207485A485A48C8FC12 +7E127C5A12701F7979D934>I45 DII<913803FFC0023F13 +FC91B6FC010315C0010F018113F0903A1FFC003FF849486D7E49486D7E49486D7E48496D +138048496D13C0A24817E04890C813F0A34817F8A24817FC49157FA3007F17FEA600FF17 +FFB3A5007F17FEA6003F17FCA26D15FFA26C17F8A36C17F0A26C6D4913E0A26C6D4913C0 +6C17806E5B6C6D4913006D6C495AD91FFCEB3FF8903A0FFF81FFF06D90B55A01011580D9 +003F01FCC7FC020313C0384F7BCD43>I<157815FC14031407141F14FF130F0007B5FCB6 +FCA2147F13F0EAF800C7FCB3B3B3A6007FB712FEA52F4E76CD43>II<91380FFFC091B512FC0107ECFF80011F15E090263FF8077F9026FF8001 +13FC4848C76C7ED803F86E7E491680D807FC8048B416C080486D15E0A4805CA36C17C06C +5B6C90C75AD801FC1680C9FC4C13005FA24C5A4B5B4B5B4B13C04B5BDBFFFEC7FC91B512 +F816E016FCEEFF80DA000713E0030113F89238007FFE707E7013807013C018E07013F0A2 +18F8A27013FCA218FEA2EA03E0EA0FF8487E487E487EB57EA318FCA25E18F891C7FC6C17 +F0495C6C4816E001F04A13C06C484A1380D80FF84A13006CB44A5A6CD9F0075BC690B612 +F06D5D011F1580010302FCC7FCD9001F1380374F7ACD43>I<177C17FEA2160116031607 +160FA2161F163F167FA216FF5D5DA25D5DED1FBFED3F3F153E157C15FCEC01F815F0EC03 +E01407EC0FC01580EC1F005C147E147C5C1301495A495A5C495A131F49C7FC133E5B13FC +485A5B485A1207485A485A90C8FC123E127E5ABA12C0A5C96C48C7FCAF020FB712C0A53A +4F7CCE43>III<121F7F7FEBFF8091B81280A45A19 +00606060A2606060485F0180C86CC7FC007EC95A4C5A007C4B5A5F4C5A160F4C5A484B5A +4C5A94C8FC16FEC812014B5A5E4B5A150F4B5AA24B5AA24B5A15FFA24A90C9FCA25C5D14 +07A2140FA25D141FA2143FA4147F5DA314FFA55BAC6D5BA2EC3FC06E5A395279D043>I< +913807FFC0027F13FC0103B67E010F15E090261FFC0113F8903A3FE0003FFCD97F80EB0F +FE49C76C7E48488048486E1380000717C04980120F18E0177FA2121F7FA27F7F6E14FF02 +E015C014F802FE4913806C7FDBC00313009238F007FE6C02F85B9238FE1FF86C9138FFBF +F06CEDFFE017806C4BC7FC6D806D81010F15E06D81010115FC010781011F81491680EBFF +E748018115C048D9007F14E04848011F14F048487F48481303030014F8484880161F4848 +020713FC1601824848157F173FA2171FA2170FA218F8A27F007F17F06D151FA26C6CED3F +E0001F17C06D157F6C6CEDFF806C6C6C010313006C01E0EB0FFE6C01FCEBFFFC6C6CB612 +F06D5D010F1580010102FCC7FCD9000F13C0364F7ACD43>I<91380FFF8091B512F80103 +14FE010F6E7E4901037F90267FF8007F4948EB3FF048496D7E484980486F7E4849808248 +17805A91C714C05A7013E0A218F0B5FCA318F8A618FCA46C5DA37EA25E6C7F6C5DA26C5D +6C7F6C6D137B6C6D13F390387FF803011FB512E36D14C30103028313F89039007FFE03EC +00401500A218F05EA3D801F816E0487E486C16C0487E486D491380A218005E5F4C5A91C7 +FC6C484A5A494A5A49495B6C48495BD803FC010F5B9027FF807FFEC7FC6C90B55A6C6C14 +F06D14C0010F49C8FC010013F0364F7ACD43>I<171F4D7E4D7EA24D7EA34C7FA24C7FA3 +4C7FA34C7FA24C7FA34C8083047F80167E8304FE804C7E03018116F8830303814C7E0307 +8116E083030F814C7E031F81168083033F8293C77E4B82157E8403FE824B800201835D84 +0203834B800207835D844AB87EA24A83A3DA3F80C88092C97E4A84A2027E8202FE844A82 +010185A24A820103854A82010785A24A82010F855C011F717FEBFFFCB600F8020FB712E0 +A55B547BD366>65 DI<9326 +01FFFCEC01C0047FD9FFC013030307B600F81307033F03FE131F92B8EA803F0203DAE003 +EBC07F020F01FCC7383FF0FF023F01E0EC0FF94A01800203B5FC494848C9FC4901F88249 +49824949824949824949824990CA7E494883A2484983485B1B7F485B481A3FA24849181F +A3485B1B0FA25AA298C7FC5CA2B5FCAE7EA280A2F307C07EA36C7FA21B0F6C6D1980A26C +1A1F6C7F1C006C6D606C6D187EA26D6C606D6D4C5A6D6D16036D6D4C5A6D6D4C5A6D01FC +4C5A6D6DEE7F806D6C6C6C4BC7FC6E01E0EC07FE020F01FEEC1FF80203903AFFE001FFF0 +020091B612C0033F93C8FC030715FCDB007F14E0040101FCC9FC525479D261>IIII<932601FFFCEC01C0047FD9FFC013030307B600F81307033F03FE131F92B8 +EA803F0203DAE003EBC07F020F01FCC7383FF0FF023F01E0EC0FF94A01800203B5FC4948 +48C9FC4901F8824949824949824949824949824990CA7E494883A2484983485B1B7F485B +481A3FA24849181FA3485B1B0FA25AA298C8FC5CA2B5FCAE6C057FB712E0A280A36C94C7 +003FEBC000A36C7FA36C7FA27E6C7FA26C7F6C7FA26D7E6D7F6D7F6D6D5E6D7F6D01FC93 +B5FC6D13FF6D6C6D5C6E01F0EC07FB020F01FEEC1FF10203903AFFF001FFE0020091B6EA +C07F033FEE001F030703FC1307DB007F02E01301040149CAFC5B5479D26A>III75 DIII<93380FFFC00303B6FC031F15E092B712FC +0203D9FC0013FF020F01C0010F13C0023F90C7000313F0DA7FFC02007F494848ED7FFE49 +01E0ED1FFF49496F7F49496F7F4990C96C7F49854948707F4948707FA24849717E48864A +83481B804A83481BC0A2481BE04A83A2481BF0A348497113F8A5B51AFCAF6C1BF86E5FA4 +6C1BF0A26E5F6C1BE0A36C6D4D13C0A26C6D4D1380A26C1B006C6D4D5A6E5E6C626D6C4C +5B6D6D4B5B6D6D4B5B6D6D4B5B6D6D4B5B6D6D4B90C7FC6D6D4B5A6D01FF02035B023F01 +E0011F13F0020F01FC90B512C0020390B7C8FC020016FC031F15E0030392C9FCDB001F13 +E0565479D265>II82 +D<91260FFF80130791B500F85B010702FF5B011FEDC03F49EDF07F9026FFFC006D5A4801 +E0EB0FFD4801800101B5FC4848C87E48488149150F001F824981123F4981007F82A28412 +FF84A27FA26D82A27F7F6D93C7FC14C06C13F014FF15F86CECFF8016FC6CEDFFC017F06C +16FC6C16FF6C17C06C836C836D826D82010F821303010082021F16801400030F15C0ED00 +7F040714E01600173F050F13F08383A200788200F882A3187FA27EA219E07EA26CEFFFC0 +A27F6D4B13806D17006D5D01FC4B5A01FF4B5A02C04A5A02F8EC7FF0903B1FFFC003FFE0 +486C90B65AD8FC0393C7FC48C66C14FC48010F14F048D9007F90C8FC3C5479D24B>I<00 +3FBC1280A59126C0003F9038C0007F49C71607D87FF8060113C001E08449197F49193F90 +C8171FA2007E1A0FA3007C1A07A500FC1BE0481A03A6C994C7FCB3B3AC91B912F0A55351 +7BD05E>IIII97 DI<913801FFF8021FEBFF8091B612F0010315FC01 +0F9038C00FFE903A1FFE0001FFD97FFC491380D9FFF05B4817C048495B5C5A485BA2486F +138091C7FC486F1300705A4892C8FC5BA312FFAD127F7FA27EA2EF03E06C7F17076C6D15 +C07E6E140F6CEE1F806C6DEC3F006C6D147ED97FFE5C6D6CEB03F8010F9038E01FF00103 +90B55A01001580023F49C7FC020113E033387CB63C>I<4DB47E0407B5FCA5EE001F1707 +B3A4913801FFE0021F13FC91B6FC010315C7010F9038E03FE74990380007F7D97FFC0101 +B5FC49487F4849143F484980485B83485B5A91C8FC5AA3485AA412FFAC127FA36C7EA37E +A26C7F5F6C6D5C7E6C6D5C6C6D49B5FC6D6C4914E0D93FFED90FEFEBFF80903A0FFFC07F +CF6D90B5128F0101ECFE0FD9003F13F8020301C049C7FC41547CD24B>I<913803FFC002 +3F13FC49B6FC010715C04901817F903A3FFC007FF849486D7E49486D7E4849130F48496D +7E48178048497F18C0488191C7FC4817E0A248815B18F0A212FFA490B8FCA318E049CAFC +A6127FA27F7EA218E06CEE01F06E14037E6C6DEC07E0A26C6DEC0FC06C6D141F6C6DEC3F +806D6CECFF00D91FFEEB03FE903A0FFFC03FF8010390B55A010015C0021F49C7FC020113 +F034387CB63D>IIII<137F497E000313E0487FA2487FA76C5BA26C5BC613806DC7FC90C8FC +ADEB3FF0B5FCA512017EB3B3A6B612E0A51B547BD325>I107 DIII<913801FFE0021F13FE +91B612C0010315F0010F9038807FFC903A1FFC000FFED97FF86D6C7E49486D7F48496D7F +48496D7F4A147F48834890C86C7EA24883A248486F7EA3007F1880A400FF18C0AC007F18 +80A3003F18006D5DA26C5FA26C5F6E147F6C5F6C6D4A5A6C6D495B6C6D495B6D6C495BD9 +3FFE011F90C7FC903A0FFF807FFC6D90B55A010015C0023F91C8FC020113E03A387CB643 +>I<903A3FF001FFE0B5010F13FE033FEBFFC092B612F002F301017F913AF7F8007FFE00 +03D9FFE0EB1FFFC602806D7F92C76C7F4A824A6E7F4A6E7FA2717FA285187F85A4721380 +AC1A0060A36118FFA2615F616E4A5BA26E4A5B6E4A5B6F495B6F4990C7FC03F0EBFFFC91 +26FBFE075B02F8B612E06F1480031F01FCC8FC030313C092CBFCB1B612F8A5414D7BB54B +>I<90397FE003FEB590380FFF80033F13E04B13F09238FE1FF89139E1F83FFC0003D9E3 +E013FEC6ECC07FECE78014EF150014EE02FEEB3FFC5CEE1FF8EE0FF04A90C7FCA55CB3AA +B612FCA52F367CB537>114 D<903903FFF00F013FEBFE1F90B7FC120348EB003FD80FF8 +1307D81FE0130148487F4980127F90C87EA24881A27FA27F01F091C7FC13FCEBFFC06C13 +FF15F86C14FF16C06C15F06C816C816C81C681013F1580010F15C01300020714E0EC003F +030713F015010078EC007F00F8153F161F7E160FA27E17E07E6D141F17C07F6DEC3F8001 +F8EC7F0001FEEB01FE9039FFC00FFC6DB55AD8FC1F14E0D8F807148048C601F8C7FC2C38 +7CB635>I<143EA6147EA414FEA21301A313031307A2130F131F133F13FF5A000F90B6FC +B8FCA426003FFEC8FCB3A9EE07C0AB011FEC0F8080A26DEC1F0015806DEBC03E6DEBF0FC +6DEBFFF86D6C5B021F5B020313802A4D7ECB34>IIII<007FB500F090387FFFFEA5C66C48C7000F90C7FC6D6CEC07F86D6D5C +6D6D495A6D4B5A6F495A6D6D91C8FC6D6D137E6D6D5B91387FFE014C5A6E6C485A6EEB8F +E06EEBCFC06EEBFF806E91C9FCA26E5B6E5B6F7E6F7EA26F7F834B7F4B7F92B5FCDA01FD +7F03F87F4A486C7E4A486C7E020F7FDA1FC0804A486C7F4A486C7F02FE6D7F4A6D7F495A +49486D7F01076F7E49486E7E49486E7FEBFFF0B500FE49B612C0A542357EB447>II<001FB8FC1880A3912680007F130001FCC7B5FC01F0495B495D49 +495B495B4B5B48C75C5D4B5B5F003E4A90C7FC92B5FC4A5B5E4A5B5CC7485B5E4A5B5C4A +5B93C8FC91B5FC495B5D4949EB0F805B495B5D495B49151F4949140092C7FC495A485E48 +5B5C485E485B4A5C48495B4815074849495A91C712FFB8FCA37E31357CB43C>I +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fg cmbx12 20.74 23 +/Fg 23 121 df48 DI<9238 +0FFFE04AB67E020F15F0027F15FE49B87E4917E0010F17F8013F8349D9C01F14FF9027FF +FC0001814801E06D6C80480180021F804890C86C8048486F8048486F8001FF6F804801C0 +6E8002F081486D18806E816E18C0B5821BE06E81A37214F0A56C5BA36C5B6C5B6C5B0003 +13C0C690C9FC90CA15E060A34E14C0A21B80601B0060626295B55A5F624D5C624D5C4D91 +C7FC614D5B4D13F04D5B6194B55A4C49C8FC4C5B4C5B4C13E04C5B604C90C9FCEE7FFC4C +5A4B5B4B5B4B0180EC0FF04B90C8FC4B5A4B5A4B48ED1FE0EDFFE04A5B4A5B4A90C9FC4A +48163F4A5ADA3FF017C05D4A48167F4A5A4990CA12FFD903FC160749BAFC5B4919805B5B +90BBFC5A5A5A5A481A005A5ABCFCA462A44C7176F061>I<923801FFFE033FEBFFF84AB7 +FC020F16E0023F16F84A16FE49B97E49DA003F80010F01F0010714F04901800101804948 +C880D97FF86F7F02E081496C834801FC6F148014FF486E6E14C08181481AE081A96C5C1B +C06C4A5C6C5C6D90C815806D5AD90FF85D90CA150062606295B55A4D5C624D5C4D5C4D91 +C7FC4D13FC4D5B4CB512E0047F1480037FB548C8FC92B612F818C018F8F0FF806F15F092 +C7003F13FC050713FF050114C071807213F8727F727F867214801BC07214E01BF0A27214 +F81BFCA37214FEA31BFFEBFF80000313E0487F001F13FC487FA2487FA2B67EA31BFEA360 +1BFCA292C8FC6C1AF84A5D4A18F06C494B14E05C6C01C04B14C06C90C915804E14006C6D +4B5B6C01F092B55A6C01FC4A5C27007FFFC001075C6D01FE013F14C0010F90B85A6D4DC7 +FC010117F8D9003F16E0020F93C8FC020015F0030749C9FC507378F061>II<0170187001FEEF01F86D6C160F02F8167FDAFF80 +EC07FF03FE49B5FC92B85A6262A26297C7FC61616119E061614EC8FC18F86018C095C9FC +17F817C0020701F8CAFC91CDFCB0923801FFFC031FEBFFE092B612FC020315FF020F16C0 +4A16F0027FD9003F7FDAFFF0010F13FE038001037F4AC76C8002F86E804A6F7F4A6F7F4A +834A6F7F91C980137E017C707F90CAFC1B80A21BC0A2841BE0A51BF0A313FE3803FF8000 +0F7F4813F0487F5A80B5FCA41BE0A44E14C05C7E4A18805C4A5D6C90C9150001E0606C6C +5E6D606C6C4C5B7F000794B55A6C6C6C4A5C6C6D4A5C6E4A5C26007FF8021F49C7FC6DB4 +027F5B6DD9F007B55A6D90B712E0010317806D4CC8FC6D6C15F8021F15C002034AC9FCDA +003F13804C7376F061>I<94381FFF800403B512F8043F14FE4BB77E030782031F16F003 +7F8292B5D8FC017F02039139C0001FFE4A49C7EA07FF021F01F8804A496E13804A01C014 +0F91B548023F13C04991C85A494992B5FC49494A14E0495B495E5D5B495BA290B55A5A5D +487114C0A24891C91480731300735A48F00FF896C8FC485BA45AA44849903803FFE0041F +13FE047FEBFFC04BB612F84B81030F15FFB590261FF8038092273FE0007F13E00480011F +7F4BC76C7F03FE6E7F4B6E7FDAFDF86E7FDAFFF017804B6E14C01BE05D7313F05D1BF8A2 +92C914FC85A21BFE5CA31BFFA26C5BA87EA4807EA21BFE7EA37E1BFC6E5E6C1AF8A27E6F +17F06C95B512E06D7F1BC06D6D4A14806D4C1400816D6D4A5B6D6D4A5B6D01FF4A13F001 +006E017F5B6ED9F007B55A6E90B7C7FC020F5E020316F86E16E0DA003F1580030702FCC8 +FCDB007F1380507378F061>II<93B57E031F14FC92B77E020316F0020F16FC023F16FF4A8349B5D8 +800314E04901F8C7003F7F4901C0020F7F4990C800037FD91FFC6F7F49486F6C7E137F4A +7013804948827313C05A4A821BE05AA285487FA38080806E5E8003C017C08103F85D03FE +17806F6C5C6C6F160004F05C04FC4A5A6C6F5D706C13FFDDE0015B6CDCF8035BDDFC0F13 +C06DDBFF1F5B6D93B5C7FC19FC6D17F06D5F6D17806D17E06D836D6C16FC6E16FF020F83 +6E17E06E83020F83023F8391B97E4984010701F0178049D9C07F16C0013FD9801F16E049 +EB00074948010116F048497F4849023F15F84849140F4A6E15FC48160148496E6C14FE4A +151F488391C9120348050014FF193F49838500FF84854983A28586A3861BFEA27FA2007F +1AFC7F1A7F1BF86C7FF2FFF06C7F6E4C13E06C6D4C13C06C6D5E6E4C13806C6D4C13006C +6D6CED7FFE6C02E04A485A013F01FC020F13F06D9026FFC001B55A010791B712806D95C7 +FC010017FC021F16F002071680DA007F02FCC8FC030191C9FC507378F061>I<93B5FC03 +1F14F092B612FE02076F7E021F16E04A16F891B87E49DAF00713FF0107DA0001804901FC +6D6C7F49496E7F49496E7F49496E7F90B5486E7F484A8048854891C86C7FA2487114805C +481AC0A2487213E0A2484918F0A31BF8A2B5FCA27313FCA51BFEA71BFF61A27EA396B6FC +7EA2806C5FA27E606C7F607E6C6E5C6CEF1FBF6D6DEC3F3F6D6D147F6D6D14FE6D6DEB01 +FC6D01FE130701019039FFC01FF86D91B500F014FE023F15C06E15800203ECFE00DA007F +13F8030713C092C9FC4F13FCA41BF8A31BF0D91FF093B5FCEB7FFC496C18E0487F486E17 +C06048801B804E1400A26260624E5B4B5C626C91C8485B4A4B5B4A92B55A6C01F04A91C7 +FC02804A5B6C01E0020F5B6D6C023F13F002FE91B55A90273FFFE00F5C6D90B7C8FC0107 +16FC6D16F0010016C0023F92C9FC020714F09126007FFECAFC507378F061>I65 DI<96267FFFE01670063FB6ED01F80503B700F01403053F04FC14074CB96C130F040706 +E0131F043F72133F93BA00FC137F0303DC00076D13FF030F03C09039003FFF814B02FCC8 +000713C3037F02E0030113F792B600806F6CB5FC02034ACA121F4A02F8834A02E0834A4A +1701027F4A8391B548CC7E494A85495C4C854988494A85494A85495C8A4991CDFC90B548 +86A2484A1B7FA2481E3F5D481E1F5D5A1F0FA2485CA3481E075DA2F703F0489BC7FCA45D +A2B6FCB27EA281A47EA2F703F06FF307F87EA36C80A21F0F7E6F1CF07E6F1B1F7E20E06C +6E1B3F816DF57FC06D80F7FF806D806D6E4F13006D6E616D525A826D6E4F5A6D6E4F5A6E +6D6C4E5A021F6EF0FFE06E6E4D5B6E02F84D5B6E02FE050F90C7FC02006E6CEE3FFE6F02 +F0EEFFFC031F02FE03035B6FDAFFC0021F13E0030303FF0103B55A030093B7C8FC043F18 +FC040718F0040118C0DC003F94C9FC050316F8DD003F1580DE007F01F0CAFC757A75F78C +>I<92383FFFF80207B612E0027F15FC49B87E010717E0011F83499026F0007F13FC4948 +C7000F7F90B502036D7E486E6D806F6D80727F486E6E7F8486727FA28684A26C5C72806C +5C6D90C8FC6D5AEB0FF8EB03E090CAFCA70507B6FC041FB7FC0303B8FC157F0203B9FC02 +1FECFE0391B612800103ECF800010F14C04991C7FC017F13FC90B512F04814C0485C4891 +C8FC485B5A485B5C5A5CA2B5FC5CA360A36E5DA26C5F6E5D187E6C6D846E4A48806C6D4A +4814FC6C6ED90FF0ECFFFC6C02E090263FE07F14FE00019139FC03FFC06C91B6487E013F +4B487E010F4B1307010303F01301D9003F0280D9003F13FC020101F8CBFC57507ACE5E> +97 D<97380FFFE00607B6FCA8F00003190086B3AD93383FFF800307B512F8033F14FF4A +B712C0020716F0021F16FC027F9039FE007FFE91B500F0EB0FFF01030280010190B5FC49 +49C87E49498149498149498149498190B548814884484A8192CAFC5AA2485BA25A5C5AA3 +5A5CA4B5FCAF7EA4807EA37EA2807EA26C7F616C6E5D6C606C80616D6D5D6D6D5D6D6D92 +B67E6D6D4A15FC010301FF0207EDFFFE6D02C0EB3FFE6D6C9039FC01FFF86E90B65A020F +16C002031600DA007F14FC030F14E09226007FFEC749C7FC5F797AF76C>100 +D<93387FFF80030FB512FC037FECFF804AB712E0020716F8021F16FE027FD9F8077F49B5 +D8C000804991C7003F13E04901FC020F7F49496E7F49498049496E7F49496E7F90B55A48 +727E92C914804884485B1BC048841BE0485BA27313F05AA25C5AA21BF885A2B5FCA391BA +FCA41BF002F8CCFCA67EA3807EA47E806CF103F0F207F86C7F1A0F6C6E17F06C191F6F17 +E06C6E163F6D6DEE7FC06D6D16FF6D6D4B13806D6D4B13006D6D6CEC0FFE6D02E0EC3FFC +6D02F8ECFFF86D9126FFC00F5B023F91B65A020F178002034CC7FC020016F8031F15E003 +0392C8FCDB000F13E04D507BCE58>I<903801FFFCB6FCA8C67E131F7FB3AD95380FFFE0 +95B512FE05036E7E050F15E0053F15F84D81932701FFF01F7F4CD900077FDC07FC6D80DC +0FF06D80DC1FC07F4C48824CC8FC047E6F7F5EEDFDF85E03FF707F5EA25EA25EA293C9FC +A45DB3B3A6B8D8E003B81280A8617879F76C>104 DI<902601FFF891380F +FFE0B692B512FE05036E7E050F15E0053F15F84D81932701FFF01F7F4CD900077FDC07FC +6D80C66CDA0FF06D80011FDA1FC07F6D4A48824CC8FC047E6F7F5EEDF9F85E03FB707F5E +15FF5EA25EA293C9FCA45DB3B3A6B8D8E003B81280A8614E79CD6C>110 +D<902601FFFCEC7FFEB6020FB512F0057F14FE4CB712C0040716F0041F82047F16FE93B5 +C66C7F92B500F0010F14C0C66C0380010380011F4AC76C806D4A6E8004F06F7F4C6F7F4C +6F7F4C8193C915804B7014C0861DE0A27414F0A27414F8A47513FCA57513FEAF5113FCA5 +98B512F8A31DF0621DE0621DC0621D806F5E701800704B5B505B704B5B7092B55A04FC4A +5C704A5C706C010F5C05E0013F49C7FC9227FE7FFC01B55A70B712F0040F16C0040393C8 +FC040015F8053F14C0050301F0C9FC94CCFCB3A6B812E0A85F6F7ACD6C>112 +D<902601FFF8EB07FEB691383FFFC094B512F00403804C14FE4C8093261FFC3F13809326 +3FE07F13C0DC7F80B5FCC66C5D011FDAFE0114E06DEBF9FC16F815FB16F016E015FF16C0 +7114C05E72138095381FFE0093C76C5AF001E095C8FCA25DA65DB3B3A2B812F8A8434E7A +CD4F>114 D<15FFA75CA55CA45CA25CA25CA25CA25C91B5FCA25B5B5B131F5B90B9FC12 +0FBAFCA6D8000791C9FCB3B3A3F01FE0AE183F7014C07F187F7014806D16FF826D4B1300 +6E6D485AEEFE0F6E90B55A020F5D6E5D020115C06E6C5C031F49C7FC030113F03B6E7CEC +4B>116 D<007FB7023FB612F0A8D8000302C0020191C7FC6D6E9138007FF0705E6D4E5A +6E6D4A5B6E6D4A90C8FC6E6D5C704A5A6E4C5A6E6E5C6E6E495A6E6E495A7113FF6E6E48 +5B6F4A5B6F6D4890C9FC6F01FE5B71485A6FEC9FF86F14BF6FECFFF06F5D616F5D7091CA +FC705B828470808270807080854C805E4C80854C804C81EE7FE7DCFFE3804B01C1804B01 +80804D804B487F4B486D7F031F6E7F4B486D7F4B48824B487F4C6D804A496D804A90C880 +4A844A48814A486F7F4A486F7F4B6F7F4A48844A486F80010F01F881B76C91B712FEA85F +4D7DCC66>120 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fh cmsl10 10.95 39 +/Fh 39 91 df<1530157015E0EC03C0EC0780EC0F00141E5C147C5C5C495A1303495A5C +130F49C7FCA2133E137E137C13FC5B1201A2485AA25B1207A2485AA3485AA448C8FCA45A +127EA512FE5AA95AA87EA2127CA5123C123EA2121EA2121F7EA26C7EA26C7EA26C7E1200 +13707FA213181C5A74C323>40 D<497E806D7E1470147880A280A280A2EC0780A215C014 +03A215E0A3EC01F0A615F8AF140315F0A5140715E0A4140F15C0A3141F1580A3EC3F00A2 +143E147EA2147C14FC5C13015C13035C13075C495AA249C7FC131E133E5B13785B485A48 +5A12075B000EC8FC5A5A12F05A1D5A7FC323>I<007FB5FCA2B512FEA418067C961E>45 +D<121EEA3F80EA7FC012FFA41380EA7F00123C0A0A788919>I<1703EF0780170FA2EF1F +00A2173EA25FA25FA24C5AA24C5AA24C5AA24C5AA24CC7FCA2163E167E167C5EA24B5AA2 +4B5AA24B5AA24B5AA24BC8FCA2153EA25DA25DA24A5AA24A5AA24A5AA24A5AA24AC9FCA2 +143EA25CA25CA2495AA2495AA2495AA2495A131F91CAFC133EA25BA25BA2485AA2485AA2 +485AA2485AA248CBFCA2123EA25AA25AA21270315B7FC32D>II<157015F01401 +1407143F903803FFE0137FEBFFCFEBF80F1300141F15C0A5143F1580A5147F1500A55C5C +A513015CA513035CA513075CA5130F5CA3131F497EB612F8A31D3D78BC2D>III<161C163C167CA216FCED01F815031507150FA2151DED3BF0 +157315E315C31401EC038391380707E0140E141CA2143814709138E00FC0EB01C0148013 +03EB0700130E49EB1F805B133013705B485A4848EB3F0090C7FC5A120E5A5A48147E1260 +B8FCA3C73801FE00A25DA41403A25DA314074A7E0107B512F8A3283E7BBD2D>I<010614 +03D90780131F90390FF801FE91B512FC16F816F016E0168049EBFE0015F890381C7FC091 +C8FCA3133C1338A513781370A2EC1FE0ECFFF8903873E03E9038FF001F01FCEB0F804914 +C049EB07E04914F049130390C7FC16F8A61507A21206EA3F80487EA2150F00FF15F0A249 +14E090C7121F00FC15C000F0143F00701580ED7F0012786C14FE4A5A6C495A390F800FE0 +3907E03FC06CB5C7FCC613FCEB1FE0283F7ABC2D>IIIII<17E016011603831607A2160FA2161F83163FA2167F167716F7EEE7FCED01E316 +C3150316831507EE03FEED0F01150E151E151C153C03387FED7800157015F05D4A488017 +7F4A5AA24AC7FCA2020E81173F5C021FB6FC5CA20270C7EA3FE0171F5CA2495AA2494881 +170F49C8FCA2130EA24982013C1507A2137CD801FE4B7E2607FF80EC3FFEB500F00107B5 +12FC19F85E3E417DC044>65 D<013FB7FC18E018FC903B007FE00007FE6E48903801FF80 +9438007FC05DF03FE0F01FF0A3027F16F892C8FCA54A16F04A153F19E0187F19C0F0FF80 +01014B13004A4A5A4D5AEF1FF04D5ADC03FFC7FC49B612F8EFFF8002F8C7EA3FE0EF0FF0 +EF07FC717E010715014A81711380A319C0130F5CA5011F4B13805C19005F601707013F4B +5A4A4A5A4D5A4D5A017F913801FF8001FF020F90C7FCB812FC17F094C8FC3D3E7DBD40> +II<013FB7FC18E018F8903B007FF0 +000FFE6E48EB01FF9438007FC04B6E7E180F85727E727E147F4B6E7EA2727EA302FF1780 +92C9FCA54918C05CA41A8013034A5DA41A0013074A5DA261A24E5A130F4A5E180F61181F +61011F4C5A5C4E5A4EC7FC4D5A4D5A013F4B5A4A4A5AEF3FE0EF7F80017F4A48C8FC01FF +EC1FFCB812F0178004FCC9FC423E7DBD45>I<013FB812F8A39026007FF0C7127F6E4814 +0F18034B14011800A31978147F4B1570A502FF147092C7FCA3190017F0495D4A1301A216 +07161F91B6FC495DA29138FC003F160F1607160301075D5CA219E0180119C0010FEC0700 +4A90C712031980A218071900011F5E5C181EA2183E183C013F167C4A15FC4D5A1707017F +151F01FF4AB45AB9FCA2603D3E7DBD3E>I<013FB812E0A3903A007FF000016E48EB003F +180F4B14071803A31801147F4B15C0A514FF92C71270A395C7FC17F0495D5C1601160316 +07161F49B65AA39138FC003F160F160701075D4A1303A5010F4AC8FC5C93C9FCA4131F5C +A5133F5CA3137FEBFFF0B612F8A33B3E7DBD3B>I<4BB46C1370031F01F013F0037F9038 +FC01E0913A03FF807E03913A0FF8000F83DA1FE0EB07C7DA7F80EB01EF4AC812FFD903FE +16C04948157F4948153F495A4948151F495A4948168091C9120F5A485AA2485A000F1800 +4982121FA248485EA295C7FC485AA412FF5BA6043FB512E05BA29339001FFC00715AA260 +7F127FA2171F123F6D5EA2121F7F000F163F6C7E6C6C4B5A7F6C6C15FF6C6DEB01EFD93F +C0EB07C7D91FF0EB1F87D907FE9038FE03800101B5EAF8016D6C01E0C8FCDA07FEC9FC3C +4276BF47>I<013FB5D8F807B6FC04F015FEA29026007FF0C7380FFE006E486E5AA24B5D +A4180F147F4B5DA4181F14FF92C85BA4183F5B4A5EA491B8FC5B6102FCC8127FA318FF13 +074A93C7FCA45F130F4A5DA41703131F4A5DA41707133F4A5DA3017F150F496C4A7EB6D8 +E01FB512FC6115C0483E7DBD44>I<011FB512FC5BA29039003FF8006E5AA25DA5143F5D +A5147F5DA514FF92C7FCA55B5CA513035CA513075CA5130F5CA5131F5CA3133F497E007F +B512F0A2B6FC263E7EBD21>I<013FB500F8010FB5FC4C5BA29026007FF0C7000313E06E +486E130019FC4B15F04E5A4E5A4E5A061EC7FC027F5D4B5C4D5A4D5AEF07804DC8FC02FF +141E92C7127C5FEE01E04C5A4C5A49021FC9FC4A5B5E4C7E5D03077F01035B9139FC1F3F +E0153C4B6C7E15F09139FFE00FF84913C092380007FC5C4A6D7E5C707E130F4A6D7F8417 +7F717EA2011F6F7E5C717EA2717EA2013F6F7E5C84A2017F83496C4A13E0B600E0017F13 +FFA24B90B6FC483E7DBD47>75 D<013FB512FEA25E9026007FF8C8FCEC3FE0A25DA5147F +5DA514FF92C9FCA55B5CA513035CA513075CA21838A21870130F5CA218E0A3011F15014A +15C01703A21707EF0F80013F151F4A143F177FEFFF00017F140301FF143FB9FC5FA2353E +7DBD39>I<90263FFFF093381FFFF85013F0629026007FF8EFF000023F4D5AA2023B9338 +01DFC0A2DA39FCED039FA2F1073F14790271040E5BEC70FE191C19381A7F02F01670DAE0 +7F94C7FC19E0A2F001C06201016D6C495A02C05FF00700A2180E6F6C14010103161C0280 +03385BA218706F7EF0E00313070200DA01C05BA2923907F00380A294380700075B010E90 +2603F80E5C5FA25F190F011E6D6C5A011C605FA2EEFDC0DB00FF141F013C5D013860013C +92C7FC017C5C01FE027E143F2607FF80017C4A7EB500FC037FB512E004785E4A1338553E +7CBD53>I<90263FFFE0023FB5FC6F16FEA29026003FF8020313C0021F030013004A6C15 +7C023B163C6F15381439810238167802787FDA707F157082153F82031F15F002F07FDAE0 +0F5D8215078203031401010180DAC0015D82811780047F1303010315C04A013F5C17E016 +1F17F0040F1307010715F891C7000791C7FC17FC160317FE04015B4915FF010E6E130E18 +8E177F18CEEF3FDE011E16FE011C6F5AA2170FA21707133C01386F5A133C017C150113FE +2607FF801400B512FC18705C483E7DBD44>I<923803FF80031F13F09238FE01FE913903 +F0003FDA0FC0EB1FC0DA3F80EB07E0027EC76C7E49486E7E49488149486E7E4948157F49 +5A013F17804948ED3FC049C9FCA24848EE1FE012035B000718F05B120FA2485A19F8123F +5BA2127FA219F04848163FA5F07FE0A35BF0FFC0A219805F19007F4D5A127F4D5A60003F +160F6D5E001F4C5A4D5A6C6C4B5A95C7FC6C6C15FE00034B5A6C6C4A5A6C6C4A5A017FEC +1FC06D6C495AD90FE001FEC8FC903903F807F80100B512C0DA0FFCC9FC3D4276BF47>I< +013FB612FEEFFFE018F8903B007FF0000FFC6E48EB01FF7113804BEC7FC0183F19E0F01F +F0A2147F5D19F8A402FFED3FF092C8FCA219E0A2F07FC05B4AEDFF8019004D5A4D5AEF0F +F80103ED3FE04A903801FF8091B648C7FC17F002FCCAFCA213075CA5130F5CA5131F5CA5 +133F5CA3137F497EB612E0A25D3D3E7DBD3E>I<013FB612F017FF18E0903B007FF0003F +F86E48EB07FCEF01FE4B6D7EF07F8019C0183F19E0147F4B15F0A502FFED7FE092C8FCA2 +19C0F0FF80A2494B13004A5D4D5AEF0FF04D5AEF7F800103DA07FEC7FC91B612F0178091 +39FC0007E0EE03F8EE00FC0107814A147F717EA284A2130F5CA484011F157F5CA4190201 +3F17075CA2F0F00F017F170E496C143FB600E0011F131C94380FF83C4B01071378CA3801 +FFE09438003F8040407DBD43>82 D<9238FF80070207EBE00F021FEBF81E91387F00FE02 +FCEB1F3ED903F0EB0FFE49481307494813034AEB01FC49C7FC491400133E137E177C4915 +78A57F1770A26D1500808080EB7FFEECFFE06D13FEEDFFC06D14F06D14FC010380010080 +143F02031480DA003F13C015031500EE7FE0163F161FA2160F121CA31607160F003C16C0 +A31780003E151F1700007E5D007F153E6D5C16FC01E0495AD87DF0495AD8FCFCEB0FC03A +F87F803F8027F01FFFFEC7FCD8E00713F839C0007FC030427BBF33>I<0007B912F0A33C +0FFE000FF8003F01F0160F01C04A13034848160190C7FC121EF000E048141F5E1238A212 +781270153F5E5AA3C81600157F5EA515FF93C9FCA55C5DA514035DA514075DA5140F5DA3 +141FEC7FFC0003B7FCA33C3D76BC42>IIII<010FB500F090B512F85B5FD9003F9026 +80003F1300DA0FFEC7EA1FF84BEC0FE00207168096C7FC6E6C141E181C6E6C143C606E6D +5B4D5ADB7FC05B4D5A92383FE0074DC8FC92381FF01E171C6F6C5A5F923807FCF0EEFDE0 +6FB45A5F6F90C9FCA26F7FA2707EA216FF4B7FED03DF9238079FF0ED0F1F92380E0FF815 +1C92383C07FC15784B6C7EEC01E04B6C7EEC038002076D7F4AC7FC021E6E7E5C02386E7E +5C02F06E7E495A49486E7E130749486E7E497E017F4B7E2603FFF091383FFF80007F01FC +49B512FEB55CA2453E7EBD44>II<010FB712FEA39239C00007FCD91FFCC7EA0FF814 +F04AEC1FF00280EC3FE091C8EA7FC0013EEDFF80A2013C4A13004C5A494A5A4C5A13704C +5A4C5A494A5A4C5AA290C74890C7FC4B5A4B5A4B5AA24B5A4B5A4B5A4B5AA24A90C8FC4A +5A4A5A4A5AA24A5A4A5A4A48EB01C04A5AEF03804990C7FC495A495A494814071800495A +49485C495A495A171E4890C8123E485A4848157E484815FE4C5A484814074848141F4848 +EB01FFB8FC5FA2373E7BBD38>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fi cmbx10 10.95 50 +/Fi 50 123 df12 +D45 D48 +D<140F143F5C495A130F48B5FCB6FCA313F7EAFE071200B3B3A8007FB612F0A5243C78BB +34>I<903803FF80013F13F890B512FE00036E7E4881260FF80F7F261FC0037F4848C67F +486C6D7E6D6D7E487E6D6D7EA26F1380A46C5A6C5A6C5A0007C7FCC8FC4B1300A25E153F +5E4B5AA24B5A5E4A5B4A5B4A48C7FC5D4A5AEC1FE04A5A4A5A9139FF000F80EB01FC495A +4948EB1F00495AEB1F8049C7FC017E5C5B48B7FC485D5A5A5A5A5AB7FC5EA4293C7BBB34 +>I<903801FFE0010F13FE013F6D7E90B612E04801817F3A03FC007FF8D807F06D7E82D8 +0FFC131F6D80121F7FA56C5A5E6C48133FD801F05CC8FC4B5A5E4B5A4A5B020F5B902607 +FFFEC7FC15F815FEEDFFC0D9000113F06E6C7E6F7E6F7E6F7E1780A26F13C0A217E0EA0F +C0487E487E487E487EA317C0A25D491580127F49491300D83FC0495A6C6C495A3A0FFE01 +FFF86CB65A6C5DC61580013F49C7FC010313E02B3D7CBB34>II<00071538D80FE0EB01F801FE133F90B6FC5E5E5E +5E93C7FC5D15F85D15C04AC8FC0180C9FCA9ECFFC0018713FC019F13FF90B67E020113E0 +9039F8007FF0496D7E01C06D7E5B6CC77FC8120F82A31780A21207EA1FC0487E487E12FF +7FA21700A25B4B5A6C5A01805C6CC7123F6D495AD81FE0495A260FFC075B6CB65A6C92C7 +FCC614FC013F13F0010790C8FC293D7BBB34>II<121F7F13F890B712F0A45A17E017C0178017005E5E5A007EC7EA01F8 +4B5A007C4A5A4B5A4B5A93C7FC485C157E5DC7485A4A5AA24A5A140F5D141F143F5D147F +A214FF92C8FC5BA25BA3495AA3130FA5131FAA6D5A6D5A6D5A2C3F7ABD34>II<903801FFE0010F13FC013F13FF90B612C04801E07F489038003FF048 +486D7E000F6E7E485A6F7E123F48488081178012FFA217C0A517E0A4007F5CA4003F5C6C +7E5D6C7E00075C3903FF80FB6C13FF6C6C13F36D13C3010F018313C090380008031400A2 +4B1380EA03F0487E486C1500487E4B5AA25E151F4B5A495C6C48EBFFE049485B2607FC0F +5B6CB6C7FC6C14FC6C14F06D13C0D90FFEC8FC2B3D7CBB34>I<16FCA24B7EA24B7EA34B +7FA24B7FA34B7FA24B7FA34B7F157C03FC7FEDF87FA2020180EDF03F0203804B7E020781 +15C082020F814B7E021F811500824A81023E7F027E81027C7FA202FC814A147F49B77EA3 +4982A2D907E0C7001F7F4A80010F835C83011F8391C87E4983133E83017E83017C81B500 +FC91B612FCA5463F7CBE4F>65 DI<922607FFC0130E92B500FC131E020702FF133E023FEDC07E91 +B7EAE1FE01039138803FFB499039F80003FF4901C01300013F90C8127F4948151FD9FFF8 +150F48491507485B4A1503481701485B18004890CAFC197E5A5B193E127FA349170012FF +AC127F7F193EA2123FA27F6C187E197C6C7F19FC6C6D16F86C6D150119F06C6D15036C6D +ED07E0D97FFEED0FC06D6CED3F80010F01C0ECFF006D01F8EB03FE6D9039FF801FFC0100 +91B55A023F15E002071580020002FCC7FC030713C03F407ABE4C>II +II<922607FFC0130E92B500FC131E020702FF133E023FEDC07E91B7EAE1 +FE01039138803FFB499039F80003FF4901C01300013F90C8127F4948151FD9FFF8150F48 +491507485B4A1503481701485B18004890CAFC197E5A5B193E127FA34994C7FC12FFAB04 +07B612FC127F7FA3003F92C7383FFE00A27F7EA26C7FA26C7F6C7FA26C7F6C7FD97FFE15 +7F6D6C7E010F01E014FF6D01F813036D9038FF801F010091B512F3023F15C00207ED803E +02009138FE000E030701E090C7FC46407ABE52>III +76 D78 DII82 D<903A03FFC001C0011FEBF803 +017FEBFE0748B6128F4815DF48010013FFD80FF8130F48481303497F4848EB007F127F49 +143F161F12FF160FA27F1607A27F7F01FC91C7FCEBFF806C13F8ECFFC06C14FCEDFF806C +15E016F86C816C816C816C16806C6C15C07F010715E0EB007F020714F0EC003F15030300 +13F8167F163F127800F8151FA2160FA27EA217F07E161F6C16E06D143F01E015C001F8EC +7F8001FEEB01FF9026FFE00713004890B55A486C14F8D8F81F5CD8F00314C027E0003FFE +C7FC2D407ABE3A>I<003FB912FCA5903BFE003FFE003FD87FF0EE0FFE01C01603491601 +90C71500197E127EA2007C183EA400FC183F48181FA5C81600B3AF010FB712F8A5403D7C +BC49>I<903807FFC0013F13F848B6FC48812607FE037F260FF8007F6DEB3FF0486C806F +7EA36F7EA26C5A6C5AEA01E0C8FC153F91B5FC130F137F3901FFFE0F4813E0000F138038 +1FFE00485A5B485A12FF5BA4151F7F007F143F6D90387BFF806C6C01FB13FE391FFF07F3 +6CEBFFE100031480C6EC003FD91FF890C7FC2F2B7DA933>97 D<13FFB5FCA512077EAFED +FFE0020713FC021FEBFF80027F80DAFF8113F09139FC003FF802F06D7E4A6D7E4A13074A +80701380A218C082A318E0AA18C0A25E1880A218005E6E5C6E495A6E495A02FCEB7FF090 +3AFCFF01FFE0496CB55AD9F01F91C7FCD9E00713FCC7000113C033407DBE3A>IIIII<903A03FF8007F0013F9038F83FF8499038FC +FFFC48B712FE48018313F93A07FC007FC34848EB3FE1001FEDF1FC4990381FF0F8170000 +3F81A7001F5DA26D133F000F5D6C6C495A3A03FF83FF8091B5C7FC4814FC01BF5BD80F03 +138090CAFCA2487EA27F13F06CB6FC16F016FC6C15FF17806C16C06C16E01207001F16F0 +393FE000034848EB003F49EC1FF800FF150F90C81207A56C6CEC0FF06D141F003F16E001 +F0147FD81FFC903801FFC02707FF800F13006C90B55AC615F8013F14E0010101FCC7FC2F +3D7DA834>I<13FFB5FCA512077EAFED1FF8EDFFFE02036D7E4A80DA0FE07F91381F007F +023C805C4A6D7E5CA25CA35CB3A4B5D8FE0FB512E0A5333F7CBE3A>II<13FFB5FCA512077EB3B3AFB512FCA5163F7CBE1D>108 D<01FFD91FF8ECFFC0B590 +B5010713F80203DAC01F13FE4A6E487FDA0FE09026F07F077F91261F003FEBF801000701 +3EDAF9F0806C0178ECFBC04A6DB4486C7FA24A92C7FC4A5CA34A5CB3A4B5D8FE07B5D8F0 +3FEBFF80A551297CA858>I<01FFEB1FF8B5EBFFFE02036D7E4A80DA0FE07F91381F007F +0007013C806C5B4A6D7E5CA25CA35CB3A4B5D8FE0FB512E0A533297CA83A>II<01FFEBFFE0B5000713FC021FEBFF80027F80 +DAFF8113F09139FC007FF8000701F06D7E6C496D7E4A130F4A6D7E1880A27013C0A38218 +E0AA4C13C0A318805E18005E6E5C6E495A6E495A02FCEBFFF0DAFF035B92B55A029F91C7 +FC028713FC028113C00280C9FCACB512FEA5333B7DA83A>I<3901FE01FE00FF903807FF +804A13E04A13F0EC3F1F91387C3FF8000713F8000313F0EBFFE0A29138C01FF0ED0FE091 +388007C092C7FCA391C8FCB3A2B6FCA525297DA82B>114 D<90383FFC1E48B512BE0007 +14FE5A381FF00F383F800148C7FC007E147EA200FE143EA27E7F6D90C7FC13F8EBFFE06C +13FF15C06C14F06C806C806C806C80C61580131F1300020713C014000078147F00F8143F +151F7EA27E16806C143F6D140001E013FF9038F803FE90B55A15F0D8F87F13C026E00FFE +C7FC222B7DA929>IIII120 DI<003FB612F8A4D9F80113F001C014E0495A494813C04A +1380007E15005C4A5A007C5C147F4A5A495B5DC65A495B495BA249EB007C495A5C137F49 +4813FC484913F85C5A48EBC00114804814034813004848130749131F007FECFFF0B7FCA4 +26287DA72E>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fj cmr10 10.95 92 +/Fj 92 124 df<4AB4EB0FE0021F9038E03FFC913A7F00F8FC1ED901FC90383FF03FD907 +F090397FE07F80494801FF13FF4948485BD93F805C137F0200ED7F00EF003E01FE6D91C7 +FC82ADB97EA3C648C76CC8FCB3AE486C4A7E007FD9FC3FEBFF80A339407FBF35>11 +DIII<121EEA7F80EAFFC0A9EA7F80ACEA3F00AC +121EAB120CC7FCA8121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A4179C019>33 +D<001E130F397F803FC000FF137F01C013E0A201E013F0A3007F133F391E600F30000013 +00A401E01370491360A3000114E04913C00003130101001380481303000EEB070048130E +0018130C0038131C003013181C1C7DBE2D>I<4B6C130C4B6C131EA20307143EA24C133C +A2030F147CA293C71278A24B14F8A2031E5CA2033E1301A2033C5CA3037C1303A203785C +A203F81307A24B5CA20201140F007FBAFCBB1280A26C1900C72707C0003EC8FC4B133CA3 +020F147CA292C71278A24A14F8A2021E5CA3023E1301007FBAFCBB1280A26C1900C727F8 +0007C0C8FC4A5CA20101140FA24A91C9FCA301035CA24A131EA20107143EA24A133CA201 +0F147CA291C71278A34914F8A2011E5CA2013E1301A2013C5CA201186D5A41517BBE4C> +I<14E0A4EB07FC90383FFF8090B512E03901F8E3F03903E0E0FCD807C0133CD80F807FD8 +1F007F003E80003C1580007C140316C00078141F00F8143F157FA47EED3F806CEC0E0092 +C7FC127F138013C0EA3FF013FEEA1FFF6C13FC6C13FF6C14C06C806C6C13F8011F7F1303 +01007FECE7FF14E102E01380157F153FED1FC0A2003E140F127FD8FF801307A5130000FC +158000F0140F1270007815005D6C141E153E6C5C6C5C3907C0E1F03903F8EFE0C6B51280 +D93FFEC7FCEB0FF8EB00E0A422497BC32D>I<013F1603D9FFC04B7E2601E0E0150F2607 +C070151F48486C4BC7FC023E157E48486C15FE48D90FC0EB03FC003ED90EF0EB0FF8DA0F +3F13FD007E903A070FFFF1F0007C0200EB03E0160000FC6D6C495A170F604DC8FC5F173E +5F17FC5F4C5A1603007CD907005B4C5A007E150F003E495C020E49C9FC003F5D6C49133E +260F803C5B023813FC6C6C485B3A01E0E001F03800FFC090273F0003E0133F90C70007EC +FFC09339C001E0E0923A0F8007C070031F49487E0400143C033E90381F001C037E497F03 +7C133E4B150F0201027E7F4B137C4A5A020702FCEB03805D4A5A141F92C7FC143E147E14 +7C5CA2495A0103037CEB07005C4948147E010F033E5B4A160E49C8123F496F5B013E9238 +0F803C49173801FC6F6C5A49923801E0E0496FB45A0160043FC7FC41497BC34C>II<121EEA7F8012FF13C0A213E0A3127FEA1E601200A413E013C0A312 +011380120313005A120E5A1218123812300B1C79BE19>I<1430147014E0EB01C0EB0380 +1307EB0F00131E133E133C5B13F85B12015B1203A2485AA2120F5BA2121F90C7FCA25AA3 +123E127EA6127C12FCB2127C127EA6123E123FA37EA27F120FA27F1207A26C7EA212017F +12007F13787F133E131E7FEB07801303EB01C0EB00E014701430145A77C323>I<12C07E +12707E7E121E7E6C7E7F12036C7E7F12007F1378137CA27FA2133F7FA21480130FA214C0 +A3130714E0A6130314F0B214E01307A614C0130FA31480A2131F1400A25B133EA25BA213 +7813F85B12015B485A12075B48C7FC121E121C5A5A5A5A145A7BC323>II<1506150FB3A9 +007FB912E0BA12F0A26C18E0C8000FC9FCB3A915063C3C7BB447>I<121EEA7F8012FF13 +C0A213E0A3127FEA1E601200A413E013C0A312011380120313005A120E5A121812381230 +0B1C798919>II<121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A0A +798919>IIIIII<150E151E153EA2157EA215FE1401A21403 +EC077E1406140E141CA214381470A214E0EB01C0A2EB0380EB0700A2130E5BA25B5BA25B +5B1201485A90C7FC5A120E120C121C5AA25A5AB8FCA3C8EAFE00AC4A7E49B6FCA3283E7E +BD2D>I<00061403D80780131F01F813FE90B5FC5D5D5D15C092C7FC14FCEB3FE090C9FC +ACEB01FE90380FFF8090383E03E090387001F8496C7E49137E497F90C713800006141FC8 +13C0A216E0150FA316F0A3120C127F7F12FFA416E090C7121F12FC007015C012780038EC +3F80123C6CEC7F00001F14FE6C6C485A6C6C485A3903F80FE0C6B55A013F90C7FCEB07F8 +243F7CBC2D>II<1238123C123F90 +B612FCA316F85A16F016E00078C712010070EC03C0ED078016005D48141E151C153C5DC8 +127015F04A5A5D14034A5A92C7FC5C141EA25CA2147C147814F8A213015C1303A31307A3 +130F5CA2131FA6133FAA6D5A0107C8FC26407BBD2D>III< +121EEA7F80A2EAFFC0A4EA7F80A2EA1E00C7FCB3121EEA7F80A2EAFFC0A4EA7F80A2EA1E +000A2779A619>I<121EEA7F80A2EAFFC0A4EA7F80A2EA1E00C7FCB3121E127FEAFF80A2 +13C0A4127F121E1200A412011380A3120313005A1206120E120C121C5A1230A20A3979A6 +19>I<007FB912E0BA12F0A26C18E0CDFCAE007FB912E0BA12F0A26C18E03C167BA147> +61 DIII<15074B7EA34B7EA34B7EA34B7EA34B7E15E7A2913801C7FC15C3A291380381 +FEA34AC67EA3020E6D7EA34A6D7EA34A6D7EA34A6D7EA34A6D7EA349486D7E91B6FCA249 +819138800001A249C87EA24982010E157FA2011E82011C153FA2013C820138151FA20178 +82170F13FC00034C7ED80FFF4B7EB500F0010FB512F8A33D417DC044>IIIIIIIII<011FB512FCA3D9000713006E5A1401B3B3A6123FEA7F80EAFFC0A44A5A +1380D87F005B007C130700385C003C495A6C495A6C495A2603E07EC7FC3800FFF8EB3FC0 +26407CBD2F>IIIIIIIIII<003FB91280A3903AF0007FE001018090393FC0003F48C7ED1FC0007E17 +07127C00781703A300701701A548EF00E0A5C81600B3B14B7E4B7E0107B612FEA33B3D7D +BC42>IIII<007FB5D8C003B512E0A3C649C7EBFC00D93FF8EC3FE0 +6D48EC1F806D6C92C7FC171E6D6C141C6D6C143C5F6D6C14706D6D13F04C5ADA7FC05B02 +3F13036F485ADA1FF090C8FC020F5BEDF81E913807FC1C163C6E6C5A913801FF7016F06E +5B6F5AA26F7E6F7EA28282153FED3BFEED71FF15F103E07F913801C07F0203804B6C7EEC +07004A6D7E020E6D7E5C023C6D7E02386D7E14784A6D7E4A6D7F130149486E7E4A6E7E13 +0749C86C7E496F7E497ED9FFC04A7E00076DEC7FFFB500FC0103B512FEA33F3E7EBD44> +II<003FB712F8A391C7EA1FF013F8 +01E0EC3FE00180EC7FC090C8FC003EEDFF80A2003C4A1300007C4A5A12784B5A4B5AA200 +704A5AA24B5A4B5AA2C8485A4A90C7FCA24A5A4A5AA24A5AA24A5A4A5AA24A5A4A5AA249 +90C8FCA2495A4948141CA2495A495AA2495A495A173C495AA24890C8FC485A1778485A48 +4815F8A24848140116034848140F4848143FED01FFB8FCA32E3E7BBD38>II<486C13C00003130101001380481303000EEB +070048130E0018130C0038131C003013180070133800601330A300E01370481360A400CF +EB678039FFC07FE001E013F0A3007F133FA2003F131F01C013E0390F0007801C1C73BE2D +>II96 DII<49B4FC010F13E090383F00F8017C131E4848131F4848137F0007ECFF80485A5B12 +1FA24848EB7F00151C007F91C7FCA290C9FC5AAB6C7EA3003FEC01C07F001F140316806C +6C13076C6C14000003140E6C6C131E6C6C137890383F01F090380FFFC0D901FEC7FC222A +7DA828>IIII<167C903903F801FF903A1FFF078F8090397E0FDE +1F9038F803F83803F001A23B07E000FC0600000F6EC7FC49137E001F147FA8000F147E6D +13FE00075C6C6C485AA23901F803E03903FE0FC026071FFFC8FCEB03F80006CAFC120EA3 +120FA27F7F6CB512E015FE6C6E7E6C15E06C810003813A0FC0001FFC48C7EA01FE003E14 +0048157E825A82A46C5D007C153E007E157E6C5D6C6C495A6C6C495AD803F0EB0FC0D800 +FE017FC7FC90383FFFFC010313C0293D7EA82D>III<1478EB01 +FEA2EB03FFA4EB01FEA2EB00781400AC147FEB7FFFA313017F147FB3B3A5123E127F38FF +807E14FEA214FCEB81F8EA7F01387C03F0381E07C0380FFF803801FC00185185BD1C>I< +EA01FC12FFA3120712031201B292B51280A392383FFC0016E0168093C7FC153C5D5D4A5A +EC07C04A5A4AC8FC143E147F4A7E13FD9038FFDFC0EC9FE0140F496C7E01FC7F496C7E14 +01816E7E81826F7E151F826F7EA282486C14FEB539F07FFFE0A32B3F7EBE30>II<2701F801FE14FF00FF9027 +07FFC00313E0913B1E07E00F03F0913B7803F03C01F80007903BE001F87000FC2603F9C0 +6D487F000101805C01FBD900FF147F91C75B13FF4992C7FCA2495CB3A6486C496CECFF80 +B5D8F87FD9FC3F13FEA347287DA74C>I<3901F801FE00FF903807FFC091381E07E09138 +7803F000079038E001F82603F9C07F0001138001FB6D7E91C7FC13FF5BA25BB3A6486C49 +7EB5D8F87F13FCA32E287DA733>I<14FF010713E090381F81F890387E007E01F8131F48 +48EB0F804848EB07C04848EB03E0000F15F04848EB01F8A2003F15FCA248C812FEA44815 +FFA96C15FEA36C6CEB01FCA3001F15F86C6CEB03F0A26C6CEB07E06C6CEB0FC06C6CEB1F +80D8007EEB7E0090383F81FC90380FFFF0010090C7FC282A7EA82D>I<3901FC03FC00FF +90381FFF8091387C0FE09039FDE003F03A07FFC001FC6C496C7E6C90C7127F49EC3F805B +EE1FC017E0A2EE0FF0A3EE07F8AAEE0FF0A4EE1FE0A2EE3FC06D1580EE7F007F6E13FE91 +38C001F89039FDE007F09039FC780FC0DA3FFFC7FCEC07F891C9FCAD487EB512F8A32D3A +7EA733>I<02FF131C0107EBC03C90381F80F090397F00387C01FC131CD803F8130E4848 +EB0FFC150748481303121F485A1501485AA448C7FCAA6C7EA36C7EA2001F14036C7E1507 +6C6C130F6C7E6C6C133DD8007E137990383F81F190380FFFC1903801FE0190C7FCAD4B7E +92B512F8A32D3A7DA730>I<3901F807E000FFEB1FF8EC787CECE1FE3807F9C100031381 +EA01FB1401EC00FC01FF1330491300A35BB3A5487EB512FEA31F287EA724>I<90383FC0 +603901FFF8E03807C03F381F000F003E1307003C1303127C0078130112F81400A27E7E7E +6D1300EA7FF8EBFFC06C13F86C13FE6C7F6C1480000114C0D8003F13E0010313F0EB001F +EC0FF800E01303A214017E1400A27E15F07E14016C14E06CEB03C0903880078039F3E01F +0038E0FFFC38C01FE01D2A7DA824>I<131CA6133CA4137CA213FCA2120112031207001F +B512C0B6FCA2D801FCC7FCB3A215E0A912009038FE01C0A2EB7F03013F138090381F8700 +EB07FEEB01F81B397EB723>IIII +II<001F +B61280A2EBE0000180140049485A001E495A121C4A5A003C495A141F00385C4A5A147F5D +4AC7FCC6485AA2495A495A130F5C495A90393FC00380A2EB7F80EBFF005A5B4848130712 +07491400485A48485BA248485B4848137F00FF495A90B6FCA221277EA628>II E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fk cmr12 14.4 16 +/Fk 16 116 df<120FEA3FC0EA7FE0EAFFF0A6EA7FE0EA3FC0EA0F000C0C768B21>46 +D48 D50 D<160F5EA25E5EA25E5DA25D5DA25D151E151C153C5D157015F04A5A5D14035D4A5A +5C140E5C143C14385C14F05C495A13035C130749C7FC130E131E5B133813785B5B120148 +5A5B120748C8FC120E121E5A123812785AB912F0A4C8000190C7FCAF4B7F4B7F020FB612 +E0A434507DCF3B>52 D<000316C001C0140301F8141F903AFFC003FF8091B612005E5E5E +16E016804BC7FC019F13F8018113800180C9FCB0EC0FF0ECFFFE01836D7E903987F01FE0 +90399F0007F801BE6D7E01F86D7E496D7E49EC7F805BEE3FC04915E0C9121F17F0A317F8 +160FA317FCA5120EEA3F80487E12FF7FA217F85B161F5B48C813F012700078ED3FE0A26C +16C0167F6CEDFF80001F16006C6C495A6C6C13036C6CEB07F8D801F8EB1FF06CB4EB7FE0 +6DB51280011F49C7FC010713F8010013C02E517ACE3B>I68 +D86 D98 DI101 D<1378EA01FE487E487FA66C90C7FC6C5AEA007890C8FCB0 +EB7F80B5FCA41203C6FC137FB3B3A43801FFE0B61280A419507CCF21>105 +D<01FFD907FEEC03FFB590261FFFC0010F13E0037F01F0013F13F8912701F80FFC9038FC +07FE913D03C003FE01E001FF000390260700019038038000C6010E6D6C48C76C7E6D48DA +7F8E6E7E4A159CA24ADA3FF86E7E02605D14E04A5DA34A5DB3AD2601FFE0DAFFF0EC7FF8 +B6D8C07F9026FFE03FB512F0A45C347CB363>109 D<01FFEB07FCB590383FFF8092B512 +E0913901F00FF8913903C007FC000349C66C7EC6010E13016D486D7E5C143002706E7E14 +6014E05CA35CB3AD2601FFE0903801FFE0B600C0B612C0A43A347CB341>II<01FFEB1F80B5EB7FF0913801FFF8913803E1FC91380783FE0003EB0F +07C6131EEB7F1C1438143091387003FC91386000F0160014E05CA45CB3AA8048487EB612 +F0A427347DB32E>114 DI E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fl cmbx12 17.28 20 +/Fl 20 117 df65 +D<4DB5ED03C0057F02F014070407B600FE140F047FDBFFC0131F4BB800F0133F030F05FC +137F033F9127F8007FFE13FF92B6C73807FF814A02F0020113C3020702C09138007FE74A +91C9001FB5FC023F01FC16074A01F08291B54882490280824991CB7E4949844949844949 +8449865D49498490B5FC484A84A2484A84A24891CD127FA25A4A1A3F5AA348491A1FA448 +99C7FCA25CA3B5FCB07EA380A27EA2F50FC0A26C7FA37E6E1A1F6C1D80A26C801D3F6C6E +1A00A26C6E616D1BFE6D7F6F4E5A7F6D6D4E5A6D6D4E5A6D6D4E5A6D6E171F6D02E04D5A +6E6DEFFF806E01FC4C90C7FC020F01FFEE07FE6E02C0ED1FF8020102F8ED7FF06E02FF91 +3803FFE0033F02F8013F1380030F91B648C8FC030117F86F6C16E004071680DC007F02F8 +C9FC050191CAFC626677E375>67 D70 D73 D80 D83 D<001FBEFCA64849C79126E0000F148002E0180091C8171F498601F8 +1A0349864986A2491B7FA2491B3F007F1DC090C9181FA4007E1C0FA600FE1DE0481C07A5 +CA95C7FCB3B3B3A3021FBAFCA663617AE070>I<913803FFFE027FEBFFF00103B612FE01 +0F6F7E4916E090273FFE001F7FD97FE001077FD9FFF801017F486D6D7F717E486D6E7F85 +717FA2717FA36C496E7FA26C5B6D5AEB1FC090C9FCA74BB6FC157F0207B7FC147F49B612 +07010F14C0013FEBFE004913F048B512C04891C7FC485B4813F85A5C485B5A5CA2B55AA4 +5FA25F806C5E806C047D7F6EEB01F96C6DD903F1EBFF806C01FED90FE114FF6C9027FFC0 +7FC01580000191B5487E6C6C4B7E011F02FC130F010302F001011400D9001F90CBFC4943 +7CC14E>97 D<92380FFFF04AB67E020F15F0023F15FC91B77E01039039FE001FFF4901F8 +010113804901E0010713C04901804913E0017F90C7FC49484A13F0A2485B485B5A5C5A71 +13E0485B7113C048701380943800FE0095C7FC485BA4B5FCAE7EA280A27EA2806C18FCA2 +6C6D150119F87E6C6D15036EED07F06C18E06C6D150F6D6DEC1FC06D01E0EC7F806D6DEC +FF00010701FCEB03FE6D9039FFC03FFC010091B512F0023F5D020F1580020102FCC7FCDA +000F13C03E437BC148>99 D<92380FFFC04AB512FC020FECFF80023F15E091B712F80103 +D9FE037F499039F0007FFF011F01C0011F7F49496D7F4990C76C7F49486E7F4849804884 +4A804884485B727E5A5C48717EA35A5C721380A2B5FCA391B9FCA41A0002C0CBFCA67EA3 +80A27EA27E6E160FF11F806C183F6C7FF17F006C7F6C6D16FE6C17016D6C4B5A6D6D4A5A +6D01E04A5A6D6DEC3FE0010301FC49B45A6D9026FFC01F90C7FC6D6C90B55A021F15F802 +0715E0020092C8FC030713F041437CC14A>101 DII105 +D<903807FF80B6FCA6C6FC7F7FB3B3B3B3ADB712E0A623647BE32C>108 +D<902607FF80D91FFFEEFFF8B691B500F00207EBFF80040702FC023F14E0041F02FF91B6 +12F84C6F488193267FE07F6D4801037F922781FE001F9027E00FF0007FC6DA83F86D9026 +F01FC06D7F6DD987F06D4A487F6DD98FC0DBF87EC7804C6D027C80039FC76E488203BEEE +FDF003BC6E4A8003FC04FF834B5FA24B5FA24B94C8FCA44B5EB3B2B7D8F007B7D8803FB6 +12FCA67E417BC087>I<902607FF80EB1FFFB691B512F0040714FC041F14FF4C8193267F +E07F7F922781FE001F7FC6DA83F86D7F6DD987F07F6DD98FC0814C7F039FC78015BE03BC +8003FC825DA25DA25DA45DB3B2B7D8F007B71280A651417BC05A>I<923807FFE092B6FC +020715E0021F15F8027F15FE494848C66C6C7E010701F0010F13E04901C001037F49496D +7F4990C87F49486F7E49486F7E48496F13804819C04A814819E048496F13F0A24819F8A3 +48496F13FCA34819FEA4B518FFAD6C19FEA46C6D4B13FCA36C19F8A26C6D4B13F0A26C19 +E06C6D4B13C0A26C6D4B13806C6D4B13006D6C4B5A6D6D495B6D6D495B010701F0010F13 +E06D01FE017F5B010090B7C7FC023F15FC020715E0020092C8FC030713E048437CC151> +I114 D<913A3FFF8007800107B5EAF81F011FEC +FE7F017F91B5FC48B8FC48EBE0014890C7121FD80FFC1407D81FF0801600485A007F167F +49153FA212FF171FA27F7F7F6D92C7FC13FF14E014FF6C14F8EDFFC06C15FC16FF6C16C0 +6C16F06C826C826C826C82013F1680010F16C01303D9007F15E0020315F0EC001F150004 +1F13F81607007C150100FC81177F6C163FA2171F7EA26D16F0A27F173F6D16E06D157F6D +16C001FEEDFF806D0203130002C0EB0FFE02FCEB7FFC01DFB65A010F5DD8FE0315C026F8 +007F49C7FC48010F13E035437BC140>II E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fm cmbx12 24.88 41 +/Fm 41 123 df[<96380FFFFE060FB612E04DB712FC051F16FF94B912C0040784041F18 +F8047F9126FC001F7F4BB6008001017F030702F8C8EA3FFF4B02E0030F7F033F02804B7F +4B49C9127F92B54893B57E4A02F05D4A4A4B804A4A5D4A4A84634A91C9FC4A5BA24A5B51 +80755C91B5FC5EA3755CA2755C755C755CE23FFEC8FCF40FF899CAFCAF083FB612FCBFFC +A9C702FCC912038787B3B3B3B2003FB800F0013FB812F0A9>116 +144 123 271 129 12 D[33 70 111 270 65 39 +D[158 +145 120 272 175 65 D[143 142 120 +269 165 I[<0803B500C0EE01F00703B600FEEE03F8077FDBFFE015070607B800FC150F +063F05FF151F4DBA00E0143F050F07F8147F053F07FE14FF94BC5B04039326F8000FECC0 +03040F4BC86CEBF007043F03C0030F6D5A93B648C900036D5A4B03F09339007FFF3F0307 +03C0051F90B5FC4B92CB7E033F02FC18034B02F08492B648844A0380193F4A92CD7E4A4A +864A4A864A02F0864A4A864A8991B65A494B874992CF7E4C885B494A885E498B494A88A2 +495C8D90B65A8D5A5E48217FA24892D1FC223FA25A5DA248211FA3485CFA0FF09FC7FCA2 +5AA45DA3B6FCB27EA381A47EA46C80FA07F0FA0FF87EA2817EA36C6F1D1F23F07E827E22 +3F6D6E1EE0A26D6E1D7F23C06D6E1DFF7F705213806D806D55130070646D6F646D6F515A +6E6E1B1F6E6E515A6E6E515A6E6E1BFF6E6E505B6E6E505B6E6F4F5B6E03E04F90C7FC6F +6EF13FFE6F02FC4F5A030F02FF4E485A6F03C005075B030103F0051F5B6F03FE057F1380 +043FDAFFE00303B5C8FC040F03FE033F13FC0403DBFFF80107B55A040093B812E0053F1A +80050F4FC9FC050119F8DD003F18C0060795CAFCDE007F16F0070393CBFCDF000314C0> +141 146 115 271 168 I[156 142 120 269 178 I[138 141 120 268 +153 I[127 141 120 +268 146 I[<0803B500C0EE01F00703B600FE4C7E077FDBFFE015070607B800FC150F06 +3F05FF151F4DBA00E0143F050F07F8147F053F07FE14FF94BC5B04039326F8000FECC003 +040F4BC86CEBF007043F03C0030F6D5A93B648C900036D5A4B03F09339007FFF3F030703 +C0051F90B5FC4B92CB7E033F02FC18034B02F08492B648844A0380193F4A92CD7E4A4A86 +4A4A864A02F0864A4A864A8991B65A494B874992CF7E4C885B494A885E498B494A88A249 +5C8D90B65A8D5A5E48217FA24892D1FC223FA25A5DA248211FA3485C7C5A9FC9FCA25AA4 +5DA3B6FCB27EA381A20A0FBB12F8A27EA46C80A36C98C96C02F8C7FCA2817EA36C81A27E +827E827FA26D80A26D806D80A26D806D80A26D816D816E806E806E806E6E97B6FC6E806E +806E03C0606E816F02F8606F02FE60030F6E606F03E0173F030103F85F6F03FF933801FF +FC043F03E00307497E040F03FF033F497E040304FC0107B5EAE00F040093B8487E053FF2 +0001050F07FCEB007F050107F0141FDD003F06C01407060795C81201DE007F04F8ED0070 +0703048093C8FCDF000302E0CDFC>157 146 115 271 183 I[165 +142 120 269 182 I[74 +142 122 269 87 I[121 142 120 269 140 +76 D[165 142 120 269 182 78 D[<97B512F0077FECFFE00607B712FE067FEEFFE0 +0503B912FC051FF0FF80057F19E00403BB12FC040F9226E0007F14FF043F02FCC7000315 +C04C02E0DA007F804BB60080031F14F8030702FCC9000314FE4B4A70804B02E0706C8003 +7F0280051F14E092B6CB6C804A4A72804A4A72804A02F00600804A4A737F4A4A73804A8B +4A4A738091B6CD6C80494A7480A2494A7480494A7480498C4C86498D4C87498D494A7580 +A290B68B4C87488EA24892CF6C80A3488E4B88A2488EA3484A761580A34823C0A5484A76 +15E0A7B621F0B36C23E0A26F64A56C23C0A46F646C2380A36C23006F64A26C6AA270636C +6AA26C6A70636C6A70636D69A26D6E98B65AA26D6E505DA26D6E5092C7FC6D6870626D6E +505C6D686D6F4F5C6E6E4F5C6E6E4F5CA26E6E96B65A6E6E4E92C8FC6E6E4E5C020102FF +060F14F86E6F4D5C6F6E4D5C6F02F094B65A030F6E4C92C9FC6F02FE04075C03016E6C03 +1F14F86F03F092B65A043F02FE020715C0040FDAFFF090B7CAFC040392B812FC04001AF0 +051F198005074ECBFCDD007F17E0060F94CCFCDE007F15E0070002F0CDFC>148 +146 115 271 175 I[137 142 120 269 159 I[163 144 120 269 173 82 D[<93260FFFF8163E4BB600E0153F031F03 +FE5D037FDBFFC05C0203B800F05B020F05FC5B4A05FF5B027FF0C00F91B526FE000FECF0 +1F010302C0D9007F6D5A4991C800076D5A4901FC030090B6FC4901F0163F4949160F4901 +808290B5170192CBFC4849844849181F87484984A2484984874886A248498588A24887A3 +88A2B58680A36E85A280A26E8580A2818103F0725A6C6E96C7FC15FE8116E06C15FEEEFF +E017FF6C17F0F0FF806C18F8F1FFC06C19FCF2FF806C1AE01BF86C1AFE6C747E6D1AE088 +6D866D866D1AFF6D876D87010087806E86020F86020386020086153F030F851501DB001F +19801601DC000F18C0EF007F060717E0F0003F070316F0F1003F1A0F080315F81A00871B +1F877514FCA287007F86486C85A288A388A36D86A31EF87FA37F1EF0A26D626D1CE0A27F +6D5013C0A26E1B806E96B5FC6E1B0002F8606E4E5B6E626E6C5F03E04D5B03F84D5B03FE +057F5BDBFFC093B55A04F803035C496CD9FF80021F91C7FCD9FC1F02FF49B55AD9F80792 +B75A496C19F049C66149011F18804901074DC8FC90C817F848031F16C048030003FCC9FC +007C04011480>102 146 115 271 129 I[<000FC312F8A6488EA304C0C7001F4AC71201 +03F8C8F0000F03C01C0192C9737E02FC1E1F4A1E0702E08A4A8A4A8A4890CA757EA24920 +3F49201FA349200FA2492007A4492003007F8EA4498CA848487A1380A6CC99C7FCB3B3B3 +B3AA030FBD12FCA9>145 140 120 267 162 I[162 +144 120 269 179 I<93B512FC037FECFFF00207B8FC023F17E091B912F84918FE010772 +7E499126C0007F14E04901E0C7000F80496D020380496D020014FE6F6F7F90B570806F6F +8085486E6F807380A27380A28885886C5CA26D4982886D5B6D5B010713C0010190CAFC90 +CCFCA90603B7FC050FB8FC0403B9FC167F0307BAFC153F4AB7EA807F020FEDE000023F02 +FCC7FC91B612E0010392C8FC4914FC011F14F04914C0495C90B548C9FC485C485C485C48 +5C5A5D485CA24891CAFCA3B6FC5CA397B6FCA461806C60F107EF6C6E150F6F16CF6C183F +6FDB7F8F806C6EDBFF0F14E06C02FCDA03FE15FE6C6E91260FFC0791B5FC6C6E6CD93FF8 +17806C923AF803FFF003013F91B6487E010FEF8000010394C77E010004FC141F021F03F0 +140702010380DA007F1400DA000701F8CDFC695F79DD71>97 D[113 144 121 270 +129 I<94387FFFF0041FB612E093B712FE0307707E031F17F092B97E4A18FE020784021F +9126F8000F14804A0280010014C04A49C74814E049B500F85C494A17F0494A5C495C494A +4A14F84991C8FC5D495B90B5FC5D5A485C7314F05A4B6F14E05A7314C0487214804B9338 +3FFE00F20FF84896C8FCA4485CA5B6FCB07EA281A37EA36C80A37E6F18FE6CF201FFA26C +6E5F1CFE6C801B076C6EEF0FFC6D7F70EE1FF86DF13FF06D6E167F6D6EEEFFE06D02F84B +13C06D6E5D6D02FF030F13806D03C0023F1300023F02F0903801FFFC6E9126FF801F5B02 +0792B65A6E18C0020060033F4CC7FC030716F8030016C0041F4AC8FCDC007F13C0585F78 +DD67>I[113 144 +120 270 129 I<94387FFFC0040FB6FC93B712E0030716FC031F16FF037F17C04AB912F0 +0207DAF80380021F912680003F13FE4A49C7000F7F4A01F802038049B5486E804902C06E +6C7F494A6F7F4991C9FC49727F4949707F4B84498490B548707F5A4B198048855D481CC0 +86481CE05D5A871DF05AA25D5AA21DF887A2B6FCA392BBFCA51DF00380CDFCA77EA4817E +A37EA2817EA26CF307F06FF00FF87E816C1B1F6F19F06C1B3F6D6DF07FE06D7FF4FFC06D +6E4C13806D6E5E6D02F04C13006D6EEE1FFE6D6E4C5A6D6C01FFEEFFF86E02E002035B6E +02FC021F5B02079126FFC003B55A6E92B7C7FC020060033F17F8030F17E003011780DB00 +3F03FCC8FC040315C0DC000F01F8C9FC5D5F7ADD6A>I[<95383FFF80050FB512F094B612 +FE040781041F16C0047F824BB87E0307DAF8077F031FDAC00F7F4B49C6487F4B495B92B5 +00F0814A4A5B4A5C4A93B612805F4A91C7FC5C5E5C5E5C731400A24C6E5B91B56F5BA273 +5B070313E00700138097C8FCB3A4BA12F8A9C702FCCBFCB3B3B3B3A2003FB9FCA9>81 +144 121 271 71 II[ +114 143 119 270 129 I[49 144 +119 271 65 I[ +50 143 119 270 65 108 DII<94381FFFF00407B612C004 +7F15FC0303B87E030F17E0037F17FC4ABAFC4A9126FC007F80020F02C0010714E04A49C8 +80027F01F8033F13FC91B5486F7F4902C003077F494A6F804991C96C8049497080494971 +7F49874949717FA290B548717F48884B83481D80A2481DC04B83481DE0A2481DF0A3484A +7114F8A4481DFCA5B61BFEAF6C1DFCA56C6E4D14F8A36C1DF0A36C1DE06F5F6C1DC0A26C +6E4D1480A26C1D006F5F6C646D6D4D5B6F94B5FC6D636D6D4C5C6D6E4B5C6D6E4B5C6D02 +F0031F5C6D6E4B91C7FC6D6C01FE92B512FC6ED9FFC001075C6E02FC017F5C020791B812 +C0020196C8FC6E6C17FC031F17F003031780DB007F03FCC9FC040715C0DC001F01F0CAFC +675F7ADD74>II114 D<92261FFFF814F80203B638C001FC023FEDFC0791B8121F010317FF +130F013F9038F8001F4990C8FCD9FFF8153F4801E0150F484915034849814890CAFC197F +4848173F191F485AA2007F180FA31907487EA27FA28002E0705A6E93C8FC14FC14FF15F0 +6CECFF8016FCEEFFF06CEEFF8018F06C17FE727E6C18E0856C18FC6C846C727E6C856D84 +011F846D841303010084023F83140F020183EC001FDB007F16801603DC000F15C0170018 +3F060F14E0007F1703486C82727E857F85857FA2857F1BC07FA27F1B806D5F7F1B006E5E +6E5F6E163F6E4C5A02FC4C5A6E03035B6E6C4A5B03F0023F5B03FF0107B55A01F991B7C7 +FCD9F07F16FCD9E01F16F0D9800716C0D9000193C8FC48D9003F14F8007C020349C9FC4B +5F78DD5C>I[72 +132 124 258 90 III<007FB86C49B712FEA9C792C9000F02C0C7FC6E6E +030101F0C8FC715F6E6E4B5B6E6E4B5B6E4E90C9FC6E6E5E71151F6E6E4B5A6E6E4B5A6E +4E5A6F6E495B72495B6F6E495B6F806F6E4990CAFC6F4C5A72495A6F6E495A6F6E495A6F +03815B705E7014C307E75B7091B5CBFC705D705D705D6282705D715C8386718071807180 +837180864D814D815F4D81874D814D81DDFFF3804C13E14C01C1804C0180814E6C804C6E +804C487F4C48824C486D804C486D804B496D804B497F73804B49834B90C86C804B486F80 +4B48814B486F804B48844C6F804A71804A496F804A49814A90CA814A487180023F728001 +0FB500E07080B8031FB812E0A9735C7CDB7B>120 D<007FB800C04AB71280A9D800034A +CA000791C7FC6D080013F0775A6D6E4E5AA26E6E6064836E4F90C8FC836E4F5A836E4F5A +A26E6E4C5AA26E6E5F1C3F6E6E5F1C7F836E4F5A846F4D5B846F4D90C9FCA26F6E4A5AA2 +6F6E5D1B0F846F4D5A846F4D5A846F4D5AA26F6E4A5AA2706E5C627002C091CAFC6219E0 +704B5A19F0704B5AA2706E485AA2706E485AA27002FE5B1A7F19FF704B5AA2715DA27192 +CBFCA2715CA2715CA3715CA2715CA2715CA2715CA2725BA27290CCFCA3725AA2725AA24E +5AA24E5AA261187FA24E5AA24D5B13FE2603FF804A90CDFC000F13E0486D4A5A487F486D +4A5AA260B56C141F4D5AA24D5A17FF604C5B4A4990CEFC6C5D4C5A6C49EB3FFC4A495A6C +4948485A9026FE80075B270FFFC03F5B6C90B6CFFC6C5D6C15F86C6C5C011F14C0010749 +D0FC9038007FE071857CDB7B>I<0003BC12F81CFCA51CF80480C7123F03F0C84814F048 +028018E04AC9B612C04A5D02F04B15804A19004E5C4A5D4A4B5C6391C9485C604993B65A +634D5D495D98C7FC4D5C4D5C000F5E62494B5C4D5C94B6FC624C5D4C92C8FC5EC95D4C5C +5E4C5C614C5C93B6FC4B5D614B92C9FC5D4B5C604B5C5D4B4AEC07FC6092B65A5C604A92 +C8EA0FF84A5C5C5F4A5C4A5C4A181F5F91B65A495D491AF094C9123F495C5B494A167F5E +494A16FF496090B65A4C5D484B5D484F13E04892C95A4B5E484A93B5FC481803484A151F +4B0203B6FC4891BAFCBDFCA21CC0A47E565C7ADB67>I E +%EndDVIPSBitmapFont +end +%%EndProlog +%%BeginSetup +%%Feature: *Resolution 600dpi +TeXDict begin + +%%EndSetup +%%Page: 1 1 +1 0 bop 240 1799 a Fm(CFITSIO)76 b(User's)g(Reference)i(Guide)727 +2258 y Fl(An)53 b(In)l(terface)f(to)i(FITS)g(F)-13 b(ormat)53 +b(Files)1263 2518 y(for)h(C)f(Programmers)1667 3013 y +Fk(V)-10 b(ersion)38 b(2.5)1727 3916 y Fj(HEASAR)m(C)1764 +4029 y(Co)s(de)30 b(662)1363 4142 y(Go)s(ddard)f(Space)i(Fligh)m(t)f +(Cen)m(ter)1522 4255 y(Green)m(b)s(elt,)g(MD)i(20771)1857 +4367 y(USA)1561 5239 y Fk(Decem)m(b)s(er)37 b(2004)p +eop +%%Page: 2 2 +2 1 bop 0 299 a Fj(ii)p eop +%%Page: 3 3 +3 2 bop 0 1267 a Fm(Con)-6 b(ten)g(ts)0 1858 y Fi(1)84 +b(In)m(tro)s(duction)3136 b(1)136 2020 y Fj(1.1)125 b(A)30 +b(Brief)g(Ov)m(erview)84 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(1)136 2182 +y(1.2)94 b(Sources)30 b(of)h(FITS)f(Soft)m(w)m(are)h(and)f(Information) +37 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(1)136 2344 y(1.3)94 +b(Ac)m(kno)m(wledgemen)m(ts)60 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(2)136 2506 +y(1.4)94 b(Legal)31 b(Stu\013)92 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 +b(3)0 2766 y Fi(2)119 b(Creating)34 b(the)h(CFITSIO)e(Library)2256 +b(5)136 2928 y Fj(2.1)94 b(Building)28 b(the)i(Library)57 +b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)131 b(5)345 3090 y(2.1.1)106 b(Unix)30 b(Systems)44 +b(.)h(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +f(.)131 b(5)345 3252 y(2.1.2)106 b(VMS)33 b(.)46 b(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 +b(7)345 3413 y(2.1.3)106 b(Windo)m(ws)30 b(PCs)g(.)45 +b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.) +131 b(7)345 3575 y(2.1.4)106 b(Macin)m(tosh)31 b(PCs)55 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)131 b(7)136 3737 y(2.2)94 b(T)-8 b(esting)31 b(the)f(Library)i(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +f(.)131 b(8)136 3899 y(2.3)94 b(Linking)29 b(Programs)h(with)f(CFITSIO) +45 b(.)g(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(9)136 +4061 y(2.4)94 b(Getting)31 b(Started)g(with)e(CFITSIO)60 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 +b(9)136 4223 y(2.5)94 b(Example)30 b(Program)86 b(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +f(.)85 b(10)0 4483 y Fi(3)119 b(A)35 b(FITS)f(Primer)2917 +b(13)0 4742 y(4)119 b(Programming)35 b(Guidelines)2482 +b(15)136 4904 y Fj(4.1)94 b(CFITSIO)29 b(De\014nitions)42 +b(.)j(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +f(.)85 b(15)136 5066 y(4.2)94 b(Curren)m(t)30 b(Header)h(Data)h(Unit)d +(\(CHDU\))87 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(17)136 5228 y(4.3)94 b(F)-8 b(unction)31 b(Names)f(and)g(V)-8 +b(ariable)30 b(Datat)m(yp)s(es)41 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(18)136 5390 y(4.4)94 b(Supp)s(ort)29 b(for)h(Unsigned)f(In)m(tegers)i +(and)f(Signed)f(Bytes)86 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(19)136 5552 +y(4.5)94 b(Dealing)31 b(with)e(Character)h(Strings)60 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(21)136 5714 y(4.6)94 b(Implicit)28 b(Data)k(T)m(yp)s(e)e(Con)m(v)m +(ersion)64 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(22)1912 5942 y(iii)p eop +%%Page: 4 4 +4 3 bop 0 299 a Fj(iv)3310 b Fh(CONTENTS)136 555 y Fj(4.7)94 +b(Data)32 b(Scaling)87 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(22)136 +720 y(4.8)94 b(Supp)s(ort)29 b(for)h(IEEE)g(Sp)s(ecial)e(V)-8 +b(alues)67 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(23)136 885 y(4.9)94 b(Error)30 b(Status)g(V)-8 b(alues)31 +b(and)e(the)i(Error)e(Message)j(Stac)m(k)44 b(.)i(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(23)136 1049 y(4.10)49 b(V)-8 b(ariable-Length)31 b(Arra)m(ys)f(in)f +(Binary)h(T)-8 b(ables)30 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(24)136 1214 y(4.11)49 b(Multiple)29 b(Access)i(to)g(the)g(Same)f +(FITS)g(File)f(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(25)136 1379 y(4.12)49 b(When)31 b(the)f(Final)f(Size)h(of)h(the)f +(FITS)g(HDU)h(is)e(Unkno)m(wn)34 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(26)136 +1543 y(4.13)49 b(CFITSIO)29 b(Size)h(Limitations)39 b(.)46 +b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(26)0 1817 y Fi(5)f(Basic)36 b(CFITSIO)d(In)m(terface)h(Routines)2074 +b(29)136 1982 y Fj(5.1)94 b(CFITSIO)29 b(Error)h(Status)g(Routines)88 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(29)136 +2146 y(5.2)94 b(FITS)30 b(File)g(Access)h(Routines)f(.)46 +b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(30)136 2311 y(5.3)94 b(HDU)32 b(Access)f(Routines)71 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)85 b(33)136 2476 y(5.4)94 b(Header)31 b(Keyw)m(ord)f(Read/W)-8 +b(rite)32 b(Routines)39 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(35)345 2640 y(5.4.1)106 b(Keyw)m(ord)30 b(Reading)g(Routines)64 +b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(35)345 +2805 y(5.4.2)106 b(Keyw)m(ord)30 b(W)-8 b(riting)30 b(Routines)85 +b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(37)136 +2970 y(5.5)94 b(Primary)29 b(Arra)m(y)i(or)f(IMA)m(GE)i(Extension)d +(I/O)h(Routines)53 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(39)136 3135 y(5.6)94 +b(Image)32 b(Compression)e(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(42)136 3299 +y(5.7)94 b(ASCI)s(I)29 b(and)h(Binary)g(T)-8 b(able)30 +b(Routines)84 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(45)345 3464 y(5.7.1)106 b(Create)32 b(New)e(T)-8 b(able)83 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(45)345 3629 y(5.7.2)106 b(Column)29 b(Information)g(Routines)h(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(46)345 3793 y(5.7.3)106 +b(Routines)30 b(to)h(Edit)e(Ro)m(ws)i(or)f(Columns)38 +b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(48)345 3958 y(5.7.4)106 +b(Read)31 b(and)f(W)-8 b(rite)30 b(Column)f(Data)j(Routines)65 +b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)f(.)85 b(50)345 4123 y(5.7.5)106 b(Ro)m(w)31 +b(Selection)f(and)g(Calculator)f(Routines)87 b(.)46 b(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(51)136 4287 y(5.8)94 b(Utilit)m(y)30 b(Routines)c(.)45 +b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)f(.)85 b(53)345 4452 y(5.8.1)106 b(File)30 b(Chec)m(ksum)g +(Routines)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(53)345 4617 y(5.8.2)106 b(Date)32 b(and)e(Time)f(Utilit)m(y)h +(Routines)89 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(54)345 +4781 y(5.8.3)106 b(General)31 b(Utilit)m(y)e(Routines)j(.)46 +b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(56)0 +5055 y Fi(6)119 b(The)35 b(CFITSIO)e(Iterator)g(F)-9 +b(unction)2154 b(63)136 5220 y Fj(6.1)94 b(The)30 b(Iterator)i(W)-8 +b(ork)31 b(F)-8 b(unction)44 b(.)h(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)f(.)85 b(64)136 5385 y(6.2)94 b(The)30 b(Iterator)i(Driv)m +(er)e(F)-8 b(unction)77 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)85 b(66)136 5549 y(6.3)94 b(Guidelines)28 +b(for)i(Using)g(the)g(Iterator)i(F)-8 b(unction)44 b(.)i(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)85 b(67)136 5714 y(6.4)94 b(Complete)31 b(List)e(of)i(Iterator)g +(Routines)61 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(68)p eop +%%Page: 5 5 +5 4 bop 0 299 a Fh(CONTENTS)3334 b Fj(v)0 555 y Fi(7)119 +b(Celestial)34 b(Co)s(ordinate)h(System)f(Routines)1882 +b(71)136 717 y Fj(7.1)125 b(Self-con)m(tained)30 b(W)m(CS)g(Routines)e +(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(72)0 978 y Fi(8)119 b(Hierarc)m(hical)36 b(Grouping)g(Routines)2163 +b(75)136 1140 y Fj(8.1)94 b(Grouping)29 b(T)-8 b(able)30 +b(Routines)86 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)f(.)85 b(76)136 1302 y(8.2)94 b(Group)30 b(Mem)m(b)s(er)g(Routines) +g(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(78)0 1563 y Fi(9)119 b(Sp)s(ecialized)36 b(CFITSIO)d(In)m(terface)h +(Routines)1777 b(81)136 1725 y Fj(9.1)94 b(FITS)30 b(File)g(Access)h +(Routines)f(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +f(.)85 b(81)136 1887 y(9.2)94 b(HDU)32 b(Access)f(Routines)71 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)85 b(84)136 2049 y(9.3)94 b(Sp)s(ecialized)29 b(Header)h(Keyw)m(ord) +h(Routines)73 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(86)345 2211 y(9.3.1)106 b(Header)31 b(Information)e(Routines)63 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(86)345 2373 +y(9.3.2)106 b(Read)31 b(and)f(W)-8 b(rite)30 b(the)h(Required)e(Keyw)m +(ords)51 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(86)345 2536 y(9.3.3)106 +b(W)-8 b(rite)31 b(Keyw)m(ord)f(Routines)25 b(.)46 b(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(88)345 2698 y(9.3.4)106 +b(Insert)30 b(Keyw)m(ord)g(Routines)88 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)f(.)85 b(90)345 2860 y(9.3.5)106 b(Read)31 +b(Keyw)m(ord)f(Routines)44 b(.)i(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)85 b(91)345 3022 y(9.3.6)106 b(Mo)s(dify)29 b(Keyw)m(ord)i +(Routines)k(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(92)345 3184 y(9.3.7)106 b(Up)s(date)31 b(Keyw)m(ord)f(Routines)25 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(93)136 +3346 y(9.4)94 b(De\014ne)31 b(Data)h(Scaling)d(and)h(Unde\014ned)f +(Pixel)g(P)m(arameters)43 b(.)j(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(94)136 3508 y(9.5)94 +b(Sp)s(ecialized)29 b(FITS)g(Primary)g(Arra)m(y)i(or)f(IMA)m(GE)h +(Extension)f(I/O)g(Routines)54 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.) +85 b(95)136 3670 y(9.6)94 b(Sp)s(ecialized)29 b(FITS)g(ASCI)s(I)g(and)h +(Binary)f(T)-8 b(able)30 b(Routines)86 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(99)345 +3832 y(9.6.1)106 b(General)31 b(Column)d(Routines)50 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(99)345 +3994 y(9.6.2)106 b(Lo)m(w-Lev)m(el)32 b(T)-8 b(able)30 +b(Access)h(Routines)39 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(100)345 4156 y(9.6.3)106 b(W)-8 b(rite)31 b(Column)e(Data)j(Routines) +51 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(100)345 +4318 y(9.6.4)106 b(Read)31 b(Column)d(Data)k(Routines)71 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(102)0 4579 +y Fi(10)67 b(Extended)35 b(File)f(Name)g(Syn)m(tax)2278 +b(105)136 4741 y Fj(10.1)49 b(Ov)m(erview)83 b(.)46 b(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)40 b(105)136 4903 y(10.2)49 b(Filet)m(yp)s(e)60 +b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(108)345 5066 +y(10.2.1)61 b(Notes)32 b(ab)s(out)e(HTTP)g(pro)m(xy)g(serv)m(ers)k(.)46 +b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(108)345 5228 y(10.2.2)61 +b(Notes)32 b(ab)s(out)e(the)h(ro)s(ot)f(\014let)m(yp)s(e)67 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(108)345 +5390 y(10.2.3)61 b(Notes)32 b(ab)s(out)e(the)h(shmem)e(\014let)m(yp)s +(e:)69 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(110)136 5552 +y(10.3)49 b(Base)32 b(Filename)88 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(111)136 5714 y(10.4)49 b(Output)30 b(File)f(Name)i(when)f(Op)s(ening) +e(an)i(Existing)f(File)79 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(113)p eop +%%Page: 6 6 +6 5 bop 0 299 a Fj(vi)3310 b Fh(CONTENTS)136 555 y Fj(10.5)49 +b(T)-8 b(emplate)31 b(File)f(Name)h(when)e(Creating)h(a)h(New)f(File)55 +b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)f(.)40 b(114)136 721 y(10.6)49 b(Image)32 +b(Tile-Compression)27 b(Sp)s(eci\014cation)89 b(.)45 +b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(114)136 887 y(10.7)49 +b(HDU)32 b(Lo)s(cation)e(Sp)s(eci\014cation)45 b(.)g(.)h(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(115)136 1053 +y(10.8)49 b(Image)32 b(Section)38 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(116)136 1219 y(10.9)49 b(Column)29 b(and)h(Keyw)m(ord)g(Filtering)e +(Sp)s(eci\014cation)89 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(117)136 +1385 y(10.10)t(Ro)m(w)31 b(Filtering)e(Sp)s(eci\014cation)80 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(118)345 1551 y(10.10.1)16 b(General)31 b(Syn)m(tax)44 +b(.)i(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.) +40 b(119)345 1718 y(10.10.2)16 b(Bit)31 b(Masks)43 b(.)j(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(121)345 1884 y(10.10.3)16 b(V)-8 b(ector)32 b(Columns)91 +b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(122)345 2050 y(10.10.4)16 b(Go)s(o)s(d)30 b(Time)g(In)m(terv)-5 +b(al)30 b(Filtering)59 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(123)345 2216 y(10.10.5)16 b(Spatial)29 b(Region)i(Filtering)56 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(124)345 2382 y(10.10.6)16 b(Example)30 b(Ro)m(w)h(Filters)f(.)45 +b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(126)136 2548 y(10.11)35 b(Binning)28 b(or)i(Histogramming)g(Sp)s +(eci\014cation)f(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(127)0 +2828 y Fi(11)32 b(T)-9 b(emplate)34 b(Files)2933 b(131)136 +2994 y Fj(11.1)49 b(Detailed)31 b(T)-8 b(emplate)30 b(Line)g(F)-8 +b(ormat)48 b(.)e(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(131)136 3160 y(11.2)49 b(Auto-indexing)29 b(of)i(Keyw)m(ords)73 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(132)136 3326 y(11.3)49 b(T)-8 b(emplate)31 b(P)m(arser)g(Directiv)m +(es)85 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(133)136 3492 y(11.4)49 b(F)-8 b(ormal)31 b(T)-8 b(emplate)31 +b(Syn)m(tax)j(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)40 b(133)136 3658 y(11.5)49 b(Errors)63 b(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(134)136 3824 y(11.6)49 +b(Examples)71 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(134)0 +4105 y Fi(12)67 b(Lo)s(cal)35 b(FITS)g(Con)m(v)m(en)m(tions)2462 +b(137)136 4271 y Fj(12.1)49 b(64-Bit)32 b(Long)f(In)m(tegers)61 +b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)40 b(137)136 4437 y(12.2)49 b(Long)31 b(String)e(Keyw)m(ord)h(V) +-8 b(alues.)64 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.) +40 b(138)136 4603 y(12.3)49 b(Arra)m(ys)31 b(of)f(Fixed-Length)h +(Strings)d(in)h(Binary)h(T)-8 b(ables)77 b(.)46 b(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(139)136 4769 y(12.4)49 b(Keyw)m(ord)31 b(Units)e(Strings)40 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)40 b(139)136 4935 y(12.5)49 b(HIERAR)m(CH)31 b(Con)m(v)m(en)m(tion)g +(for)f(Extended)g(Keyw)m(ord)g(Names)91 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(140)136 5101 +y(12.6)49 b(Tile-Compressed)29 b(Image)i(F)-8 b(ormat)52 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(140)0 5382 y Fi(13)67 b(Optimizing)34 b(Programs)2588 +b(143)136 5548 y Fj(13.1)49 b(Ho)m(w)32 b(CFITSIO)c(Manages)k(Data)g +(I/O)78 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(143)136 5714 y(13.2)49 b(Optimization)29 b(Strategies)76 +b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(144)p eop +%%Page: 7 7 +7 6 bop 0 299 a Fh(CONTENTS)3284 b Fj(vii)0 555 y Fi(A)57 +b(Index)35 b(of)g(Routines)2789 b(147)0 806 y(B)62 b(P)m(arameter)34 +b(De\014nitions)2598 b(151)0 1057 y(C)60 b(CFITSIO)33 +b(Error)i(Status)f(Co)s(des)2255 b(157)p eop +%%Page: 8 8 +8 7 bop 0 299 a Fj(viii)3258 b Fh(CONTENTS)p eop +%%Page: 1 9 +1 8 bop 0 1225 a Fg(Chapter)65 b(1)0 1687 y Fm(In)-6 +b(tro)6 b(duction)0 2216 y Ff(1.1)180 b(A)45 b(Brief)g(Ov)l(erview)0 +2495 y Fj(CFITSIO)38 b(is)h(a)h(mac)m(hine-indep)s(enden)m(t)e(library) +f(of)j(routines)e(for)i(reading)f(and)g(writing)e(data)k(\014les)d(in)h +(the)0 2608 y(FITS)c(\(Flexible)f(Image)i(T)-8 b(ransp)s(ort)34 +b(System\))h(data)h(format.)56 b(It)35 b(can)h(also)f(read)g(IRAF)h +(format)f(image)h(\014les)0 2721 y(and)g(ra)m(w)h(binary)e(data)i(arra) +m(ys)g(b)m(y)g(con)m(v)m(erting)h(them)e(on)h(the)g(\015y)f(in)m(to)h +(a)g(virtual)e(FITS)h(format)h(\014le.)59 b(This)0 2833 +y(library)30 b(is)i(written)g(in)f(ANSI)i(C)f(and)g(pro)m(vides)g(a)h +(p)s(o)m(w)m(erful)e(y)m(et)j(simple)d(in)m(terface)i(for)g(accessing)g +(FITS)f(\014les)0 2946 y(whic)m(h)j(will)f(run)h(on)h(most)h(commonly)f +(used)g(computers)g(and)g(w)m(orkstations.)59 b(CFITSIO)35 +b(supp)s(orts)f(all)i(the)0 3059 y(features)26 b(describ)s(ed)d(in)h +(the)h(o\016cial)g(NOST)f(de\014nition)f(of)j(the)f(FITS)g(format)h +(and)e(can)i(read)f(and)g(write)g(all)f(the)0 3172 y(curren)m(tly)d +(de\014ned)f(t)m(yp)s(es)i(of)g(extensions,)h(including)18 +b(ASCI)s(I)j(tables)g(\(T)-8 b(ABLE\),)23 b(Binary)e(tables)h(\(BINT)-8 +b(ABLE\))0 3285 y(and)27 b(IMA)m(GE)h(extensions.)39 +b(The)27 b(CFITSIO)f(routines)g(insulate)g(the)h(programmer)g(from)g +(ha)m(ving)f(to)i(deal)f(with)0 3398 y(the)e(complicated)f(formatting)h +(details)e(in)g(the)i(FITS)f(\014le,)h(ho)m(w)m(ev)m(er,)j(it)c(is)f +(assumed)h(that)h(users)f(ha)m(v)m(e)i(a)f(general)0 +3511 y(kno)m(wledge)30 b(ab)s(out)g(the)h(structure)f(and)g(usage)h(of) +f(FITS)g(\014les.)0 3671 y(CFITSIO)k(also)i(con)m(tains)h(a)f(set)h(of) +f(F)-8 b(ortran)36 b(callable)f(wrapp)s(er)g(routines)f(whic)m(h)h +(allo)m(w)h(F)-8 b(ortran)36 b(programs)0 3784 y(to)31 +b(call)e(the)h(CFITSIO)e(routines.)40 b(See)30 b(the)g(companion)f +(\\FITSIO)g(User's)h(Guide")f(for)h(the)g(de\014nition)e(of)i(the)0 +3897 y(F)-8 b(ortran)39 b(subroutine)c(calling)i(sequences.)63 +b(These)38 b(wrapp)s(ers)e(replace)i(the)g(older)f(F)-8 +b(ortran)39 b(FITSIO)d(library)0 4010 y(whic)m(h)29 b(is)h(no)g(longer) +g(supp)s(orted.)0 4170 y(The)20 b(CFITSIO)f(pac)m(k)-5 +b(age)23 b(w)m(as)e(initially)d(dev)m(elop)s(ed)i(b)m(y)g(the)h(HEASAR) +m(C)g(\(High)g(Energy)f(Astroph)m(ysics)g(Science)0 4283 +y(Arc)m(hiv)m(e)34 b(Researc)m(h)h(Cen)m(ter\))f(at)h(the)f(NASA)g(Go)s +(ddard)e(Space)j(Fligh)m(t)e(Cen)m(ter)h(to)h(con)m(v)m(ert)g(v)-5 +b(arious)33 b(existing)0 4396 y(and)25 b(newly)g(acquired)g +(astronomical)h(data)g(sets)h(in)m(to)f(FITS)f(format)h(and)f(to)i +(further)e(analyze)h(data)h(already)e(in)0 4509 y(FITS)i(format.)41 +b(New)28 b(features)g(con)m(tin)m(ue)g(to)h(b)s(e)e(added)h(to)g +(CFITSIO)f(in)f(large)i(part)g(due)g(to)g(con)m(tributions)f(of)0 +4622 y(ideas)32 b(or)h(actual)g(co)s(de)g(from)f(users)g(of)h(the)g +(pac)m(k)-5 b(age.)49 b(The)33 b(In)m(tegral)g(Science)f(Data)i(Cen)m +(ter)f(in)f(Switzerland,)0 4734 y(and)h(the)g(XMM/ESTEC)h(pro)5 +b(ject)34 b(in)e(The)h(Netherlands)f(made)h(esp)s(ecially)f +(signi\014can)m(t)g(con)m(tributions)g(that)0 4847 y(resulted)d(in)g +(man)m(y)i(of)f(the)h(new)f(features)g(that)h(app)s(eared)f(in)f(v2.0)j +(of)e(CFITSIO.)0 5322 y Ff(1.2)135 b(Sources)45 b(of)g(FITS)f(Soft)l(w) +l(are)i(and)f(Information)0 5601 y Fj(The)22 b(latest)h(v)m(ersion)f +(of)h(the)f(CFITSIO)f(source)i(co)s(de,)h(do)s(cumen)m(tation,)h(and)c +(example)i(programs)f(are)h(a)m(v)-5 b(ailable)0 5714 +y(on)30 b(the)h(W)-8 b(orld-Wide)30 b(W)-8 b(eb)31 b(or)f(via)g(anon)m +(ymous)g(ftp)g(from:)1927 5942 y(1)p eop +%%Page: 2 10 +2 9 bop 0 299 a Fj(2)2452 b Fh(CHAPTER)30 b(1.)71 b(INTR)m(ODUCTION)382 +555 y Fe(http://heasarc.gsfc.nasa)o(.go)o(v/fi)o(tsio)382 +668 y(ftp://legacy.gsfc.nasa.g)o(ov/)o(soft)o(ware)o(/fi)o(tsio)o(/c)0 +902 y Fj(An)m(y)28 b(questions,)f(bug)g(rep)s(orts,)h(or)f(suggested)i +(enhancemen)m(ts)f(related)f(to)i(the)e(CFITSIO)f(pac)m(k)-5 +b(age)30 b(should)c(b)s(e)0 1015 y(sen)m(t)31 b(to)g(the)g(primary)d +(author:)382 1249 y Fe(Dr.)47 b(William)f(Pence)810 b(Telephone:)92 +b(\(301\))47 b(286-4599)382 1362 y(HEASARC,)e(Code)i(662)811 +b(E-mail:)45 b(pence@tetra.gsfc.nasa.gov)382 1475 y(NASA/Goddard)f +(Space)j(Flight)f(Center)382 1588 y(Greenbelt,)f(MD)i(20771,)f(USA)0 +1822 y Fj(This)39 b(User's)j(Guide)e(assumes)h(that)h(readers)f +(already)f(ha)m(v)m(e)j(a)f(general)f(understanding)d(of)k(the)f +(de\014nition)0 1935 y(and)31 b(structure)g(of)h(FITS)e(format)i +(\014les.)43 b(F)-8 b(urther)32 b(information)d(ab)s(out)j(FITS)f +(formats)g(is)g(a)m(v)-5 b(ailable)31 b(from)g(the)0 +2048 y(FITS)h(Supp)s(ort)f(O\016ce)i(at)g Fe(http://fits.gsfc.nasa.gov) +o Fj(.)42 b(In)32 b(particular,)g(the)h('NOST)f(FITS)g(Standard')0 +2161 y(giv)m(es)i(the)h(authoritativ)m(e)f(de\014nition)e(of)i(the)g +(FITS)g(data)h(format,)g(and)f(the)g(`FITS)g(User's)g(Guide')f(pro)m +(vides)0 2274 y(additional)28 b(historical)h(bac)m(kground)h(and)g +(practical)g(advice)g(on)g(using)f(FITS)h(\014les.)0 +2434 y(The)38 b(HEASAR)m(C)g(also)h(pro)m(vides)e(a)i(v)m(ery)g +(sophisticated)f(FITS)f(\014le)h(analysis)f(program)h(called)g(`Fv')h +(whic)m(h)0 2547 y(can)34 b(b)s(e)f(used)g(to)h(displa)m(y)e(and)h +(edit)g(the)h(con)m(ten)m(ts)i(of)e(an)m(y)g(FITS)f(\014le)f(as)i(w)m +(ell)f(as)h(construct)g(new)f(FITS)g(\014les)0 2660 y(from)j(scratc)m +(h.)61 b(The)36 b(displa)m(y)f(functions)g(in)g(Fv)i(allo)m(w)f(users)g +(to)i(in)m(teractiv)m(ely)e(adjust)g(the)h(brigh)m(tness)f(and)0 +2773 y(con)m(trast)i(of)f(images,)h(pan,)g(zo)s(om,)h(and)d(blink)e +(images,)39 b(and)d(measure)h(the)f(p)s(ositions)f(and)h(brigh)m +(tnesses)g(of)0 2886 y(ob)5 b(jects)33 b(within)d(images.)46 +b(FITS)31 b(tables)h(can)h(b)s(e)e(displa)m(y)m(ed)g(lik)m(e)h(a)g +(spread)g(sheet,)h(and)f(then)f(mo)s(di\014ed)f(using)0 +2999 y(p)s(o)m(w)m(erful)25 b(calculator)i(and)e(sorting)h(functions.) +38 b(Fv)27 b(is)e(freely)h(a)m(v)-5 b(ailable)26 b(for)g(most)h(Unix)e +(platforms,)i(Mac)g(PCs,)0 3112 y(and)34 b(Windo)m(ws)f(PCs.)52 +b(CFITSIO)33 b(users)h(ma)m(y)h(also)f(b)s(e)g(in)m(terested)h(in)e +(the)h(FTOOLS)f(pac)m(k)-5 b(age)37 b(of)d(programs)0 +3225 y(that)27 b(can)f(b)s(e)g(used)f(to)i(manipulate)e(and)g(analyze)i +(FITS)e(format)i(\014les.)38 b(Fv)27 b(and)e(FTOOLS)g(are)i(a)m(v)-5 +b(ailable)25 b(from)0 3337 y(their)k(resp)s(ectiv)m(e)i(W)-8 +b(eb)31 b(sites)f(at:)382 3572 y Fe(http://fv.gsfc.nasa.gov)382 +3685 y(http://heasarc.gsfc.nasa)o(.go)o(v/ft)o(ools)0 +4014 y Ff(1.3)135 b(Ac)l(kno)l(wledgemen)l(ts)0 4264 +y Fj(The)34 b(dev)m(elopmen)m(t)g(of)g(the)g(p)s(o)m(w)m(erful)f +(features)h(in)f(CFITSIO)g(w)m(as)h(made)g(p)s(ossible)e(through)h +(collab)s(orations)0 4377 y(with)d(man)m(y)h(p)s(eople)f(or)g +(organizations)h(from)g(around)f(the)h(w)m(orld.)41 b(The)30 +b(follo)m(wing)g(in)f(particular)h(ha)m(v)m(e)i(made)0 +4490 y(esp)s(ecially)d(signi\014can)m(t)g(con)m(tributions:)0 +4650 y(Programmers)c(from)h(the)f(In)m(tegral)h(Science)g(Data)h(Cen)m +(ter,)g(Switzerland)d(\(namely)-8 b(,)27 b(Jurek)d(Bork)m(o)m(wski,)k +(Bruce)0 4763 y(O'Neel,)33 b(and)f(Don)h(Jennings\),)e(designed)g(the)i +(concept)g(for)f(the)h(plug-in)d(I/O)i(driv)m(ers)f(that)i(w)m(as)g(in) +m(tro)s(duced)0 4876 y(with)h(CFITSIO)f(2.0.)56 b(The)34 +b(use)h(of)g(`driv)m(ers')f(greatly)h(simpli\014ed)d(the)j(lo)m(w-lev)m +(el)g(I/O,)g(whic)m(h)e(in)h(turn)g(made)0 4989 y(other)40 +b(new)f(features)i(in)d(CFITSIO)g(\(e.g.,)45 b(supp)s(ort)38 +b(for)h(compressed)h(FITS)f(\014les)g(and)g(supp)s(ort)f(for)i(IRAF)0 +5102 y(format)32 b(image)f(\014les\))g(m)m(uc)m(h)g(easier)h(to)g +(implemen)m(t.)42 b(Jurek)31 b(Bork)m(o)m(wski)g(wrote)h(the)g(Shared)e +(Memory)i(driv)m(er,)0 5215 y(and)23 b(Bruce)i(O'Neel)f(wrote)g(the)g +(driv)m(ers)f(for)g(accessing)i(FITS)e(\014les)g(o)m(v)m(er)i(the)f +(net)m(w)m(ork)h(using)d(the)j(FTP)-8 b(,)24 b(HTTP)-8 +b(,)0 5328 y(and)30 b(R)m(OOT)g(proto)s(cols.)0 5488 +y(The)45 b(ISDC)g(also)g(pro)m(vided)f(the)i(template)g(parsing)e +(routines)g(\(written)h(b)m(y)g(Jurek)g(Bork)m(o)m(wski\))h(and)f(the)0 +5601 y(hierarc)m(hical)36 b(grouping)f(routines)h(\(written)h(b)m(y)g +(Don)h(Jennings\).)59 b(The)37 b(ISDC)f(D)m(AL)i(\(Data)h(Access)f(La)m +(y)m(er\))0 5714 y(routines)29 b(are)i(la)m(y)m(ered)g(on)f(top)h(of)f +(CFITSIO)f(and)h(mak)m(e)h(extensiv)m(e)g(use)f(of)h(these)g(features.) +p eop +%%Page: 3 11 +3 10 bop 0 299 a Fh(1.4.)72 b(LEGAL)30 b(STUFF)2995 b +Fj(3)0 555 y(Uw)m(e)25 b(Lammers)e(\(XMM/ESA/ESTEC,)h(The)g +(Netherlands\))f(designed)g(the)h(high-p)s(erformance)e(lexical)h +(pars-)0 668 y(ing)41 b(algorithm)g(that)h(is)f(used)g(to)i(do)e +(on-the-\015y)h(\014ltering)e(of)i(FITS)f(tables.)75 +b(This)40 b(algorithm)h(essen)m(tially)0 781 y(pre-compiles)34 +b(the)i(user-supplied)c(selection)k(expression)e(in)m(to)i(a)g(form)g +(that)g(can)g(b)s(e)f(rapidly)e(ev)-5 b(aluated)36 b(for)0 +894 y(eac)m(h)31 b(ro)m(w.)40 b(P)m(eter)31 b(Wilson)d(\(RSTX,)h +(NASA/GSF)m(C\))i(then)e(wrote)h(the)g(parsing)e(routines)g(used)h(b)m +(y)g(CFITSIO)0 1007 y(based)i(on)f(Lammers')h(design,)f(com)m(bined)g +(with)g(other)h(tec)m(hniques)f(suc)m(h)h(as)g(the)g(CFITSIO)f +(iterator)h(routine)0 1120 y(to)h(further)e(enhance)h(the)h(data)g(pro) +s(cessing)e(throughput.)42 b(This)30 b(e\013ort)i(also)f(b)s +(ene\014ted)f(from)h(a)h(m)m(uc)m(h)f(earlier)0 1233 +y(lexical)22 b(parsing)h(routine)f(that)i(w)m(as)g(dev)m(elop)s(ed)f(b) +m(y)h(Ken)m(t)g(Blac)m(kburn)e(\(NASA/GSF)m(C\).)j(More)g(recen)m(tly) +-8 b(,)26 b(Craig)0 1346 y(Markw)m(ardt)j(\(NASA/GSF)m(C\))g(implemen)m +(ted)e(additional)f(functions)h(\(median,)h(a)m(v)m(erage,)k(stddev\))c +(and)g(other)0 1458 y(enhancemen)m(ts)j(to)g(the)g(lexical)e(parser.)0 +1619 y(The)40 b(CFITSIO)g(iterator)h(function)e(is)h(lo)s(osely)g +(based)h(on)f(similar)f(ideas)h(dev)m(elop)s(ed)g(for)h(the)g(XMM)g +(Data)0 1732 y(Access)31 b(La)m(y)m(er.)0 1892 y(P)m(eter)25 +b(Wilson)e(\(RSTX,)h(NASA/GSF)m(C\))h(wrote)g(the)f(complete)h(set)f +(of)h(F)-8 b(ortran-callable)24 b(wrapp)s(ers)e(for)i(all)f(the)0 +2005 y(CFITSIO)29 b(routines,)g(whic)m(h)g(in)g(turn)h(rely)f(on)i(the) +f(CF)m(OR)-8 b(TRAN)31 b(macro)g(dev)m(elop)s(ed)f(b)m(y)g(Burkhard)f +(Buro)m(w.)0 2165 y(The)h(syn)m(tax)i(used)e(b)m(y)h(CFITSIO)f(for)g +(\014ltering)g(or)h(binning)c(input)i(FITS)i(\014les)f(is)g(based)g(on) +h(ideas)g(dev)m(elop)s(ed)0 2278 y(for)41 b(the)g(AXAF)h(Science)f(Cen) +m(ter)h(Data)h(Mo)s(del)d(b)m(y)h(Jonathan)g(McDo)m(w)m(ell,)k(An)m +(tonella)c(F)-8 b(ruscione,)44 b(Aneta)0 2391 y(Siemigino)m(wsk)-5 +b(a)24 b(and)h(Bill)f(Jo)m(y)m(e.)41 b(See)26 b(h)m +(ttp://heasarc.gsfc.nasa.go)m(v/do)s(cs/journal/axaf7.h)m(t)q(ml)31 +b(for)25 b(further)0 2503 y(description)j(of)j(the)g(AXAF)g(Data)h(Mo)s +(del.)0 2664 y(The)j(\014le)f(decompression)g(co)s(de)h(w)m(ere)h(tak)m +(en)g(directly)e(from)g(the)i(gzip)e(\(GNU)i(zip\))f(program)g(dev)m +(elop)s(ed)f(b)m(y)0 2777 y(Jean-loup)29 b(Gailly)g(and)h(others.)0 +2937 y(The)e(new)h(compressed)g(image)g(data)h(format)f(\(where)g(the)g +(image)g(is)f(tiled)g(and)g(the)h(compressed)g(b)m(yte)h(stream)0 +3050 y(from)k(eac)m(h)i(tile)f(is)e(stored)i(in)f(a)h(binary)e(table\)) +j(w)m(as)f(implemen)m(ted)e(in)h(collab)s(oration)g(with)f(Ric)m(hard)h +(White)0 3163 y(\(STScI\),)c(P)m(erry)g(Green\014eld)g(\(STScI\))g(and) +f(Doug)i(T)-8 b(o)s(dy)30 b(\(NO)m(A)m(O\).)0 3323 y(Doug)h(Mink)f +(\(SA)m(O\))g(pro)m(vided)f(the)i(routines)e(for)h(con)m(v)m(erting)i +(IRAF)e(format)h(images)f(in)m(to)h(FITS)e(format.)0 +3483 y(In)e(addition,)g(man)m(y)h(other)g(p)s(eople)f(ha)m(v)m(e)i +(made)f(v)-5 b(aluable)27 b(con)m(tributions)f(to)j(the)f(dev)m +(elopmen)m(t)g(of)g(CFITSIO.)0 3596 y(These)i(include)e(\(with)i(ap)s +(ologies)g(to)h(others)f(that)h(ma)m(y)g(ha)m(v)m(e)h(inadv)m(erten)m +(tly)e(b)s(een)f(omitted\):)0 3756 y(Stev)m(e)g(Allen,)e(Carl)g(Ak)m +(erlof,)h(Keith)f(Arnaud,)h(Morten)g(Krabb)s(e)e(Barfo)s(ed,)j(Ken)m(t) +f(Blac)m(kburn,)g(G)g(Bo)s(dammer,)0 3869 y(Romk)m(e)h(Bon)m(tek)m(o)s +(e,)i(Lucio)c(Chiapp)s(etti,)f(Keith)h(Costorf,)h(Robin)f(Corb)s(et,)h +(John)e(Da)m(vis,)j(Ric)m(hard)e(Fink,)h(Ning)0 3982 +y(Gan,)j(Emily)d(Greene,)j(Gretc)m(hen)g(Green,)f(Jo)s(e)g(Harrington,) +g(Cheng)g(Ho,)h(Phil)d(Ho)s(dge,)i(Jim)f(Ingham,)h(Y)-8 +b(oshi-)0 4095 y(tak)j(a)44 b(Ishisaki,)g(Diab)f(Jerius,)h(Mark)g +(Levine,)h(T)-8 b(o)s(dd)42 b(Karak)-5 b(askian,)46 b(Edw)m(ard)c +(King,)j(Scott)f(Ko)s(c)m(h,)i(Claire)0 4208 y(Larkin,)c(Rob)f +(Managan,)j(Eric)c(Mandel,)j(Ric)m(hard)d(Mathar,)k(John)c(Matto)m(x,) +46 b(Carsten)41 b(Mey)m(er,)k(Emi)39 b(Miy-)0 4320 y(ata,)44 +b(Stefan)c(Mo)s(c)m(hnac)m(ki,)k(Mik)m(e)d(Noble,)h(Oliv)m(er)d(Ob)s +(erdorf,)i(Cliv)m(e)e(P)m(age,)45 b(Arvind)38 b(P)m(armar,)43 +b(Je\013)e(P)m(edelt)m(y)-8 b(,)0 4433 y(Tim)31 b(P)m(earson,)j +(Philipp)s(e)28 b(Prugniel,)j(Maren)h(Purv)m(es,)h(Scott)g(Randall,)f +(Chris)e(Rogers,)k(Arnold)c(Rots,)k(Barry)0 4546 y(Sc)m(hlesinger,)h +(Robin)f(Stebbins,)h(Andrew)f(Szymk)m(o)m(wiak,)j(Allyn)c(T)-8 +b(ennan)m(t,)37 b(P)m(eter)g(T)-8 b(eub)s(en,)35 b(James)h(Theiler,)0 +4659 y(Doug)c(T)-8 b(o)s(dy)g(,)32 b(Shiro)e(Ueno,)j(Stev)m(e)f(W)-8 +b(alton,)33 b(Arc)m(hie)f(W)-8 b(arno)s(c)m(k,)33 b(Alan)e(W)-8 +b(atson,)33 b(Dan)f(Whipple,)e(Wim)h(Wim-)0 4772 y(mers,)f(P)m(eter)i +(Y)-8 b(oung,)31 b(Jianjun)d(Xu,)i(and)g(Nelson)g(Zarate.)0 +5216 y Ff(1.4)135 b(Legal)46 b(Stu\013)0 5488 y Fj(Cop)m(yrigh)m(t)36 +b(\(Unpublished{all)d(righ)m(ts)j(reserv)m(ed)h(under)e(the)i(cop)m +(yrigh)m(t)g(la)m(ws)f(of)h(the)g(United)f(States\),)k(U.S.)0 +5601 y(Go)m(v)m(ernmen)m(t)30 b(as)g(represen)m(ted)e(b)m(y)h(the)g +(Administrator)e(of)i(the)g(National)f(Aeronautics)h(and)f(Space)h +(Adminis-)0 5714 y(tration.)41 b(No)31 b(cop)m(yrigh)m(t)f(is)g +(claimed)f(in)g(the)i(United)e(States)i(under)e(Title)h(17,)h(U.S.)f +(Co)s(de.)p eop +%%Page: 4 12 +4 11 bop 0 299 a Fj(4)2452 b Fh(CHAPTER)30 b(1.)71 b(INTR)m(ODUCTION)0 +555 y Fj(P)m(ermission)28 b(to)i(freely)e(use,)i(cop)m(y)-8 +b(,)31 b(mo)s(dify)-8 b(,)28 b(and)h(distribute)e(this)h(soft)m(w)m +(are)j(and)e(its)g(do)s(cumen)m(tation)g(without)0 668 +y(fee)g(is)e(hereb)m(y)h(gran)m(ted,)i(pro)m(vided)d(that)i(this)e(cop) +m(yrigh)m(t)i(notice)f(and)g(disclaimer)e(of)i(w)m(arran)m(t)m(y)i(app) +s(ears)d(in)g(all)0 781 y(copies.)41 b(\(Ho)m(w)m(ev)m(er,)33 +b(see)e(the)f(restriction)f(on)i(the)f(use)g(of)h(the)f(gzip)g +(compression)g(co)s(de,)h(b)s(elo)m(w\).)0 941 y(DISCLAIMER:)0 +1101 y(THE)i(SOFTW)-10 b(ARE)32 b(IS)g(PR)m(O)m(VIDED)i('AS)f(IS')g +(WITHOUT)f(ANY)i(W)-10 b(ARRANTY)33 b(OF)g(ANY)h(KIND,)f(EI-)0 +1214 y(THER)42 b(EXPRESSED,)f(IMPLIED,)i(OR)e(ST)-8 b(A)g(TUTOR)g(Y,)43 +b(INCLUDING,)f(BUT)h(NOT)e(LIMITED)h(TO,)0 1327 y(ANY)33 +b(W)-10 b(ARRANTY)33 b(THA)-8 b(T)32 b(THE)g(SOFTW)-10 +b(ARE)32 b(WILL)g(CONF)m(ORM)g(TO)g(SPECIFICA)-8 b(TIONS,)30 +b(ANY)0 1440 y(IMPLIED)38 b(W)-10 b(ARRANTIES)37 b(OF)h(MER)m(CHANT)-8 +b(ABILITY,)38 b(FITNESS)f(F)m(OR)h(A)g(P)-8 b(AR)g(TICULAR)38 +b(PUR-)0 1553 y(POSE,)24 b(AND)i(FREEDOM)f(FR)m(OM)h(INFRINGEMENT,)g +(AND)f(ANY)h(W)-10 b(ARRANTY)25 b(THA)-8 b(T)25 b(THE)g(DOC-)0 +1666 y(UMENT)-8 b(A)g(TION)31 b(WILL)f(CONF)m(ORM)h(TO)e(THE)h(SOFTW) +-10 b(ARE,)30 b(OR)g(ANY)h(W)-10 b(ARRANTY)31 b(THA)-8 +b(T)30 b(THE)0 1779 y(SOFTW)-10 b(ARE)31 b(WILL)h(BE)g(ERR)m(OR)g +(FREE.)g(IN)g(NO)f(EVENT)h(SHALL)f(NASA)h(BE)g(LIABLE)g(F)m(OR)g(ANY)0 +1892 y(D)m(AMA)m(GES,)26 b(INCLUDING,)e(BUT)f(NOT)g(LIMITED)h(TO,)f +(DIRECT,)g(INDIRECT,)g(SPECIAL)f(OR)h(CON-)0 2005 y(SEQUENTIAL)28 +b(D)m(AMA)m(GES,)k(ARISING)d(OUT)g(OF,)h(RESUL)-8 b(TING)29 +b(FR)m(OM,)h(OR)f(IN)h(ANY)g(W)-10 b(A)i(Y)30 b(CON-)0 +2118 y(NECTED)25 b(WITH)g(THIS)f(SOFTW)-10 b(ARE,)25 +b(WHETHER)g(OR)g(NOT)g(BASED)g(UPON)g(W)-10 b(ARRANTY,)26 +b(CON-)0 2230 y(TRA)m(CT,)d(TOR)-8 b(T)23 b(,)g(OR)g(OTHER)-10 +b(WISE,)22 b(WHETHER)i(OR)f(NOT)f(INJUR)-8 b(Y)24 b(W)-10 +b(AS)23 b(SUST)-8 b(AINED)23 b(BY)h(PER-)0 2343 y(SONS)h(OR)i(PR)m +(OPER)-8 b(TY)26 b(OR)g(OTHER)-10 b(WISE,)26 b(AND)h(WHETHER)g(OR)f +(NOT)g(LOSS)f(W)-10 b(AS)26 b(SUST)-8 b(AINED)0 2456 +y(FR)m(OM,)37 b(OR)e(AR)m(OSE)h(OUT)f(OF)h(THE)g(RESUL)-8 +b(TS)35 b(OF,)h(OR)f(USE)h(OF,)g(THE)g(SOFTW)-10 b(ARE)35 +b(OR)g(SER-)0 2569 y(VICES)29 b(PR)m(O)m(VIDED)j(HEREUNDER.")0 +2729 y(The)i(\014le)h(compress.c)g(con)m(tains)g(\(sligh)m(tly)f(mo)s +(di\014ed\))f(source)i(co)s(de)g(that)h(originally)c(came)k(from)f +(gzip-1.2.4,)0 2842 y(cop)m(yrigh)m(t)26 b(\(C\))g(1992-1993)k(b)m(y)c +(Jean-loup)f(Gailly)-8 b(.)38 b(This)24 b(gzip)h(co)s(de)h(is)f +(distributed)e(under)i(the)h(GNU)g(General)0 2955 y(Public)k(License)i +(and)f(th)m(us)h(requires)f(that)i(an)m(y)f(soft)m(w)m(are)i(that)f +(uses)f(the)g(CFITSIO)f(library)f(\(whic)m(h)h(in)g(turn)0 +3068 y(uses)e(the)g(gzip)g(co)s(de\))h(m)m(ust)f(conform)g(to)h(the)f +(pro)m(visions)e(in)h(the)i(GNU)g(General)f(Public)e(License.)40 +b(A)29 b(cop)m(y)h(of)0 3181 y(the)h(GNU)g(license)e(is)g(included)f +(at)j(the)g(b)s(eginning)c(of)k(compress.c)g(\014le.)0 +3341 y(An)h(alternate)i(v)m(ersion)e(of)h(the)g(compress.c)g(\014le)f +(\(called)g(compress)p 2381 3341 28 4 v 33 w(alternate.c\))i(is)e(pro)m +(vided)f(for)i(users)e(who)0 3454 y(w)m(an)m(t)24 b(to)g(use)e(the)i +(CFITSIO)d(library)g(but)h(are)h(un)m(willing)d(or)j(unable)e(to)j +(publicly)c(release)j(their)f(soft)m(w)m(are)i(under)0 +3567 y(the)i(terms)g(of)g(the)g(GNU)h(General)e(Public)f(License.)39 +b(This)24 b(alternate)i(v)m(ersion)g(con)m(tains)g(non-functional)e +(stubs)0 3680 y(for)g(the)h(\014le)e(compression)h(and)f(uncompression) +g(routines)g(used)h(b)m(y)g(CFITSIO.)f(Replace)i(the)f(\014le)g +(`compress.c')0 3793 y(with)32 b(`compress)p 600 3793 +V 33 w(alternate.c')j(b)s(efore)e(compiling)e(the)i(CFITSIO)f(library) +-8 b(.)48 b(This)31 b(will)g(pro)s(duce)h(a)i(v)m(ersion)f(of)0 +3906 y(CFITSIO)20 b(whic)m(h)h(do)s(es)g(not)h(supp)s(ort)e(reading)h +(or)h(writing)e(compressed)h(FITS)g(\014les)g(but)g(is)g(otherwise)g +(iden)m(tical)0 4019 y(to)31 b(the)g(standard)e(v)m(ersion.)p +eop +%%Page: 5 13 +5 12 bop 0 1225 a Fg(Chapter)65 b(2)0 1687 y Fm(Creating)77 +b(the)h(CFITSIO)e(Library)0 2216 y Ff(2.1)135 b(Building)45 +b(the)h(Library)0 2466 y Fj(The)h(CFITSIO)f(co)s(de)h(is)g(con)m +(tained)g(in)f(ab)s(out)h(40)h(C)f(source)h(\014les)e(\(*.c\))j(and)e +(header)g(\014les)f(\(*.h\).)93 b(On)0 2579 y(V)-10 b(AX/VMS)31 +b(systems)g(2)f(assem)m(bly-co)s(de)h(\014les)e(\(vmsieeed.mar)h(and)g +(vmsieeer.mar\))h(are)f(also)h(needed.)0 2739 y(CFITSIO)e(has)h(curren) +m(tly)f(b)s(een)h(tested)h(on)f(the)h(follo)m(wing)e(platforms:)95 +2959 y Fe(OPERATING)46 b(SYSTEM)523 b(COMPILER)143 3072 +y(Sun)47 b(OS)1002 b(gcc)47 b(and)g(cc)g(\(3.0.1\))143 +3185 y(Sun)g(Solaris)762 b(gcc)47 b(and)g(cc)143 3298 +y(Silicon)f(Graphics)g(IRIX)285 b(gcc)47 b(and)g(cc)143 +3411 y(Silicon)f(Graphics)g(IRIX64)189 b(MIPS)143 3523 +y(Dec)47 b(Alpha)f(OSF/1)572 b(gcc)47 b(and)g(cc)143 +3636 y(DECstation)93 b(Ultrix)428 b(gcc)143 3749 y(Dec)47 +b(Alpha)f(OpenVMS)476 b(cc)143 3862 y(DEC)47 b(VAX/VMS)762 +b(gcc)47 b(and)g(cc)143 3975 y(HP-UX)1049 b(gcc)143 4088 +y(IBM)47 b(AIX)954 b(gcc)143 4201 y(Linux)1049 b(gcc)143 +4314 y(MkLinux)953 b(DR3)143 4427 y(Windows)46 b(95/98/NT)523 +b(Borland)46 b(C++)h(V4.5)143 4540 y(Windows)f(95/98/NT/ME/XP)235 +b(Microsoft/Compaq)43 b(Visual)j(C++)h(v5.0,)g(v6.0)143 +4653 y(Windows)f(95/98/NT)523 b(Cygwin)46 b(gcc)143 4765 +y(MacOS)h(7.1)f(or)i(greater)332 b(Metrowerks)45 b(10.+)143 +4878 y(MacOS-X)h(10.1)h(or)g(greater)189 b(cc)47 b(\(gcc\))0 +5098 y Fj(CFITSIO)26 b(will)g(probably)g(run)g(on)i(most)g(other)h +(Unix)d(platforms.)39 b(Cra)m(y)28 b(sup)s(ercomputers)e(are)j(curren)m +(tly)e(not)0 5211 y(supp)s(orted.)0 5495 y Fd(2.1.1)112 +b(Unix)38 b(Systems)0 5714 y Fj(The)30 b(CFITSIO)f(library)f(is)h +(built)f(on)j(Unix)e(systems)h(b)m(y)g(t)m(yping:)1927 +5942 y(5)p eop +%%Page: 6 14 +6 13 bop 0 299 a Fj(6)1580 b Fh(CHAPTER)30 b(2.)112 b(CREA)-8 +b(TING)30 b(THE)g(CFITSIO)f(LIBRAR)-8 b(Y)48 555 y Fe(>)95 +b(./configure)45 b([--prefix=/target/insta)o(llat)o(ion)o(/pat)o(h])48 +668 y(>)95 b(make)476 b(\(or)95 b('make)46 b(shared'\))48 +781 y(>)95 b(make)47 b(install)93 b(\(this)46 b(step)h(is)g(optional\)) +0 1037 y Fj(at)24 b(the)g(op)s(erating)f(system)h(prompt.)38 +b(The)23 b(con\014gure)g(command)g(customizes)h(the)g(Mak)m(e\014le)g +(for)g(the)g(particular)0 1150 y(system,)g(then)d(the)g(`mak)m(e')i +(command)e(compiles)f(the)h(source)h(\014les)e(and)h(builds)d(the)j +(library)-8 b(.)36 b(T)m(yp)s(e)21 b(`./con\014gure')0 +1263 y(and)34 b(not)h(simply)d(`con\014gure')j(to)h(ensure)e(that)h +(the)g(con\014gure)g(script)e(in)h(the)h(curren)m(t)f(directory)g(is)g +(run)g(and)0 1375 y(not)29 b(some)g(other)g(system-wide)f(con\014gure)g +(script.)39 b(The)29 b(optional)f('pre\014x')g(argumen)m(t)h(to)g +(con\014gure)g(giv)m(es)g(the)0 1488 y(path)f(to)i(the)f(directory)f +(where)g(the)h(CFITSIO)f(library)e(and)i(include)f(\014les)g(should)g +(b)s(e)h(installed)f(via)h(the)h(later)0 1601 y('mak)m(e)j(install')c +(command.)41 b(F)-8 b(or)31 b(example,)143 1857 y Fe(>)48 +b(./configure)c(--prefix=/usr1/local)0 2113 y Fj(will)22 +b(cause)k(the)f('mak)m(e)h(install')d(command)i(to)h(cop)m(y)g(the)f +(CFITSIO)e(lib)s(c\014tsio)f(\014le)j(to)g(/usr1/lo)s(cal/lib)e(and)i +(the)0 2226 y(necessary)33 b(include)c(\014les)j(to)g(/usr1/lo)s +(cal/include)f(\(assuming)g(of)h(course)g(that)h(the)f(pro)s(cess)g +(has)g(p)s(ermission)0 2338 y(to)f(write)f(to)h(these)g(directories\).) +0 2499 y(The)d('mak)m(e)h(shared')f(option)g(builds)d(a)k(shared)e(or)i +(dynamic)e(v)m(ersion)h(of)g(the)h(CFITSIO)d(library)-8 +b(.)38 b(When)28 b(using)0 2612 y(the)f(shared)f(library)f(the)i +(executable)g(co)s(de)g(is)f(not)h(copied)f(in)m(to)h(y)m(our)g +(program)g(at)g(link)e(time)h(and)h(instead)f(the)0 2724 +y(program)h(lo)s(cates)h(the)g(necessary)g(library)d(co)s(de)j(at)g +(run)e(time,)i(normally)e(through)g(LD)p 3065 2724 28 +4 v 33 w(LIBRAR)-8 b(Y)p 3514 2724 V 34 w(P)g(A)g(TH)28 +b(or)0 2837 y(some)j(other)f(metho)s(d.)41 b(The)29 b(adv)-5 +b(an)m(tages)33 b(of)d(using)f(a)i(shared)e(library)f(are:)143 +3093 y Fe(1.)95 b(Less)47 b(disk)f(space)h(if)g(you)g(build)f(more)h +(than)f(1)i(program)143 3206 y(2.)95 b(Less)47 b(memory)f(if)h(more)g +(than)f(one)h(copy)g(of)g(a)g(program)f(using)h(the)g(shared)334 +3319 y(library)f(is)h(running)f(at)h(the)g(same)g(time)f(since)h(the)g +(system)f(is)h(smart)334 3432 y(enough)f(to)h(share)g(copies)f(of)h +(the)g(shared)f(library)g(at)h(run)g(time.)143 3545 y(3.)95 +b(Possibly)46 b(easier)g(maintenance)e(since)j(a)g(new)g(version)f(of)h +(the)g(shared)334 3658 y(library)f(can)h(be)g(installed)e(without)h +(relinking)f(all)i(the)g(software)334 3770 y(that)g(uses)f(it)i(\(as)e +(long)h(as)g(the)g(subroutine)e(names)i(and)f(calling)334 +3883 y(sequences)f(remain)h(unchanged\).)143 3996 y(4.)95 +b(No)47 b(run-time)f(penalty.)0 4252 y Fj(The)30 b(disadv)-5 +b(an)m(tages)31 b(are:)143 4508 y Fe(1.)47 b(More)g(hassle)f(at)h +(runtime.)94 b(You)46 b(have)h(to)g(either)f(build)h(the)g(programs)286 +4621 y(specially)f(or)h(have)f(LD_LIBRARY_PATH)e(set)j(right.)143 +4733 y(2.)g(There)g(may)g(be)g(a)g(slight)f(start)h(up)g(penalty,)e +(depending)h(on)h(where)f(you)h(are)286 4846 y(reading)f(the)h(shared)f +(library)g(and)h(the)g(program)f(from)g(and)h(if)g(your)g(CPU)g(is)286 +4959 y(either)f(really)h(slow)f(or)h(really)f(heavily)g(loaded.)0 +5215 y Fj(On)32 b(Mac)i(OS)e(X)i(platforms)e(the)h('mak)m(e)h(shared')f +(command)f(w)m(orks)h(lik)m(e)g(on)g(other)g(UNIX)g(platforms,)g(but)g +(a)0 5328 y(.dylib)d(\014le)h(will)e(b)s(e)i(created)i(instead)f(of)g +(.so.)46 b(If)31 b(installed)f(in)h(a)h(nonstandard)f(lo)s(cation,)h +(add)f(its)h(lo)s(cation)f(to)0 5441 y(the)g(D)m(YLD)p +422 5441 V 34 w(LIBRAR)-8 b(Y)p 872 5441 V 33 w(P)g(A)g(TH)31 +b(en)m(vironmen)m(t)f(v)-5 b(ariable)29 b(so)i(that)g(the)f(library)e +(can)j(b)s(e)f(found)f(at)i(run)e(time.)0 5601 y(On)h(HP/UX)i(systems,) +g(the)f(en)m(vironmen)m(t)g(v)-5 b(ariable)30 b(CFLA)m(GS)h(should)e(b) +s(e)i(set)g(to)h(-Ae)g(b)s(efore)f(running)d(con-)0 5714 +y(\014gure)i(to)h(enable)f("extended)h(ANSI")f(features.)p +eop +%%Page: 7 15 +7 14 bop 0 299 a Fh(2.1.)72 b(BUILDING)31 b(THE)f(LIBRAR)-8 +b(Y)2507 b Fj(7)0 555 y(By)31 b(default,)g(a)g(set)h(of)f(F)-8 +b(ortran-callable)31 b(wrapp)s(er)e(routines)h(are)h(also)g(built)e +(and)h(included)f(in)g(the)i(CFITSIO)0 668 y(library)-8 +b(.)68 b(If)40 b(these)g(wrapp)s(er)f(routines)g(are)h(not)h(needed)e +(\(i.e.,)44 b(the)c(CFITSIO)f(library)e(will)h(not)i(b)s(e)g(link)m(ed) +0 781 y(to)d(an)m(y)f(F)-8 b(ortran)37 b(applications)d(whic)m(h)h +(call)g(FITSIO)g(subroutines\))f(then)i(they)g(ma)m(y)h(b)s(e)e +(omitted)h(from)g(the)0 894 y(build)26 b(b)m(y)k(t)m(yping)f('mak)m(e)h +(all-no\014tsio')f(instead)f(of)i(simply)d(t)m(yping)i('mak)m(e'.)42 +b(This)27 b(will)g(reduce)i(the)h(size)f(of)h(the)0 1007 +y(CFITSIO)f(library)f(sligh)m(tly)-8 b(.)0 1167 y(Most)37 +b(32-bit)g(op)s(erating)f(systems)g(ha)m(v)m(e)i(only)d(supp)s(orted)g +(disk)g(\014les)g(up)g(to)i(2.1GB)i(\(2**31)g(b)m(ytes\))e(in)e(size.)0 +1280 y(Starting)c(with)f(v)m(ersion)h(2.1)h(of)g(CFITSIO,)e(FITS)h +(\014les)f(larger)h(than)g(this)g(limit)e(\(up)i(to)h(6)g(terab)m +(ytes\))h(can)f(b)s(e)0 1393 y(read)25 b(and)g(written)f(on)h +(platforms)f(that)h(supp)s(ort)f(large)h(\014les)f(\(e.g.,)k(at)e +(least)f(some)h(LINUX)f(platforms)f(and)h(So-)0 1506 +y(laris\).)36 b(T)-8 b(o)22 b(enable)e(this)g(feature,)j(CFITSIO)d(m)m +(ust)h(b)s(e)f(compiled)f(with)h(the)h('-D)p 2731 1506 +28 4 v 34 w(LAR)m(GEFILE)p 3298 1506 V 33 w(SOUR)m(CE')g(and)0 +1619 y(`-D)p 129 1619 V 34 w(FILE)p 374 1619 V 32 w(OFFSET)p +774 1619 V 32 w(BITS=64')g(compiler)e(\015ags.)37 b(Some)21 +b(platforms)e(ma)m(y)i(also)f(require)f(the)h(`-D)p 3380 +1619 V 34 w(LAR)m(GE)p 3736 1619 V 33 w(FILES')0 1732 +y(compiler)29 b(\015ag.)42 b(It)30 b(app)s(ears)g(that)h(in)e(most)i +(cases)g(it)g(is)e(not)i(necessary)g(to)g(also)f(include)f(these)i +(compiler)e(\015ags)0 1844 y(when)k(compiling)f(programs)h(that)i(link) +d(to)i(the)g(CFITSIO)f(library)-8 b(.)49 b(See)34 b(the)g(`CFITSIO)f +(Size)g(Limitations')0 1957 y(section)e(in)e(Chapter)g(4)i(for)f +(further)f(details.)0 2118 y(It)g(ma)m(y)h(not)f(b)s(e)f(p)s(ossible)f +(to)i(staticly)g(link)e(programs)i(that)g(use)g(CFITSIO)e(on)i(some)h +(platforms)d(\(namely)-8 b(,)30 b(on)0 2230 y(Solaris)k(2.6\))j(due)e +(to)i(the)e(net)m(w)m(ork)i(driv)m(ers)d(\(whic)m(h)h(pro)m(vide)g(FTP) +g(and)g(HTTP)g(access)i(to)g(FITS)e(\014les\).)56 b(It)0 +2343 y(is)32 b(p)s(ossible)e(to)k(mak)m(e)f(b)s(oth)g(a)g(dynamic)e +(and)h(a)i(static)f(v)m(ersion)f(of)h(the)g(CFITSIO)e(library)-8 +b(,)32 b(but)g(net)m(w)m(ork)i(\014le)0 2456 y(access)e(will)27 +b(not)k(b)s(e)f(p)s(ossible)e(using)h(the)h(static)h(v)m(ersion.)0 +2762 y Fd(2.1.2)112 b(VMS)0 2984 y Fj(On)28 b(V)-10 b(AX/VMS)31 +b(and)d(ALPHA/VMS)i(systems)f(the)h(mak)m(e)p 2100 2984 +V 34 w(g\015oat.com)h(command)e(\014le)f(ma)m(y)i(b)s(e)f(executed)h +(to)0 3097 y(build)j(the)k(c\014tsio.olb)e(ob)5 b(ject)37 +b(library)d(using)h(the)h(default)g(G-\015oating)g(p)s(oin)m(t)g +(option)f(for)h(double)f(v)-5 b(ariables.)0 3210 y(The)37 +b(mak)m(e)p 405 3210 V 33 w(d\015oat.com)i(and)d(mak)m(e)p +1279 3210 V 34 w(ieee.com)i(\014les)f(ma)m(y)g(b)s(e)g(used)f(instead)h +(to)h(build)c(the)j(library)e(with)h(the)0 3322 y(other)26 +b(\015oating)h(p)s(oin)m(t)e(options.)38 b(Note)28 b(that)f(the)f +(getcwd)h(function)e(that)i(is)e(used)g(in)g(the)i(group.c)f(mo)s(dule) +e(ma)m(y)0 3435 y(require)43 b(that)j(programs)e(using)f(CFITSIO)g(b)s +(e)h(link)m(ed)g(with)f(the)i(ALPHA$LIBRAR)-8 b(Y:V)e(AX)m(CR)i(TL.OLB) +0 3548 y(library)g(.)39 b(See)30 b(the)h(example)f(link)e(line)h(in)g +(the)i(next)f(section)h(of)f(this)g(do)s(cumen)m(t.)0 +3854 y Fd(2.1.3)112 b(Windo)m(ws)37 b(PCs)0 4076 y Fj(A)28 +b(precompiled)e(DLL)i(v)m(ersion)f(of)h(CFITSIO)e(is)h(a)m(v)-5 +b(ailable)28 b(for)f(IBM-PC)h(users)g(of)g(the)g(Borland)f(or)h +(Microsoft)0 4189 y(Visual)44 b(C++)g(compilers)g(in)g(the)i(\014les)e +(c\014tsio)s(dll)p 1802 4189 V 31 w(2xxx)p 2022 4189 +V 33 w(b)s(orland.zip)e(and)j(c\014tsio)s(dll)p 3078 +4189 V 30 w(2xxx)p 3297 4189 V 33 w(v)m(cc.zip,)50 b(where)0 +4302 y('2xxx')45 b(represen)m(ts)f(the)g(curren)m(t)g(release)h(n)m(um) +m(b)s(er.)81 b(These)44 b(zip)f(arc)m(hiv)m(es)h(also)h(con)m(tains)f +(other)g(\014les)g(and)0 4414 y(instructions)28 b(on)i(ho)m(w)h(to)g +(use)f(the)h(CFITSIO)d(DLL)j(library)-8 b(.)0 4575 y(The)28 +b(CFITSIO)g(library)e(ma)m(y)j(also)g(b)s(e)f(built)f(from)h(the)h +(source)g(co)s(de)g(using)f(the)h(mak)m(e\014le.b)s(c)f(or)h(mak)m +(e\014le.v)m(cc)0 4688 y(\014les.)54 b(Finally)-8 b(,)35 +b(the)g(mak)m(ep)s(c.bat)h(\014le)e(giv)m(es)i(an)f(example)g(of)g +(building)c(CFITSIO)j(with)f(the)j(Borland)e(C++)0 4800 +y(v4.5)d(compiler)e(using)g(older)h(DOS)g(commands.)0 +5106 y Fd(2.1.4)112 b(Macin)m(tosh)38 b(PCs)0 5328 y +Fj(When)30 b(building)d(on)j(Mac)h(OS-X,)g(users)e(should)g(follo)m(w)g +(the)i(Unix)e(instructions,)f(ab)s(o)m(v)m(e.)0 5488 +y(The)h(classic)f(MacOS)h(v)m(ersion)g(\(OS)g(9)g(or)g(earlier\))f(of)i +(the)f(CFITSIO)e(library)g(can)i(b)s(e)g(built)e(b)m(y)i(\(1\))h(un)e +(binhex)0 5601 y(and)e(unstu\013)g(c\014tsio)p 714 5601 +V 33 w(mac.sit.hqx,)i(\(2\))g(put)e(CFitsioPPC.mcp)f(in)h(the)h +(c\014tsio)g(directory)-8 b(,)28 b(and)e(\(3\))i(load)f(CFit-)0 +5714 y(sioPPC.mcp)i(in)m(to)i(Co)s(deW)-8 b(arrior)30 +b(Pro)g(5)h(and)f(mak)m(e.)42 b(This)29 b(builds)e(the)k(CFITSIO)e +(library)f(for)i(PPC.)g(There)p eop +%%Page: 8 16 +8 15 bop 0 299 a Fj(8)1580 b Fh(CHAPTER)30 b(2.)112 b(CREA)-8 +b(TING)30 b(THE)g(CFITSIO)f(LIBRAR)-8 b(Y)0 555 y Fj(are)31 +b(also)f(targets)i(for)e(b)s(oth)g(the)g(test)i(program)e(and)f(the)i +(sp)s(eed)e(test)j(program.)0 715 y(T)-8 b(o)27 b(use)f(the)h(MacOS)g +(p)s(ort)f(y)m(ou)h(can)g(add)f(C\014tsio)g(PPC.lib)e(to)j(y)m(our)g +(Co)s(deW)-8 b(arrior)26 b(Pro)g(5)h(pro)5 b(ject.)40 +b(Note)28 b(that)0 828 y(this)h(only)h(has)g(b)s(een)g(tested)h(for)f +(the)g(PPC)g(and)g(probably)e(w)m(on't)j(w)m(ork)g(on)f(68k)h(Macs.)0 +1162 y Ff(2.2)135 b(T)-11 b(esting)46 b(the)f(Library)0 +1412 y Fj(The)40 b(CFITSIO)e(library)g(should)g(b)s(e)h(tested)i(b)m(y) +f(building)c(and)j(running)f(the)i(testprog.c)h(program)f(that)h(is)0 +1525 y(included)28 b(with)h(the)h(release.)41 b(On)30 +b(Unix)f(systems,)i(t)m(yp)s(e:)191 1782 y Fe(\045)47 +b(make)g(testprog)191 1895 y(\045)g(testprog)f(>)h(testprog.lis)191 +2008 y(\045)g(diff)g(testprog.lis)d(testprog.out)191 +2121 y(\045)j(cmp)g(testprog.fit)e(testprog.std)0 2378 +y Fj(On)30 b(VMS)g(systems,)g(\(assuming)g(cc)h(is)e(the)i(name)f(of)h +(the)f(C)g(compiler)f(command\),)i(t)m(yp)s(e:)191 2636 +y Fe($)47 b(cc)h(testprog.c)191 2749 y($)f(link)g(testprog,)e +(cfitsio/lib,)g(alpha$library:vaxcrtl/l)o(ib)191 2862 +y($)i(run)g(testprog)0 3119 y Fj(The)42 b(test)h(program)f(should)e +(pro)s(duce)h(a)i(FITS)e(\014le)h(called)f(`testprog.\014t')j(that)f +(is)e(iden)m(tical)g(to)i(the)f(`test-)0 3232 y(prog.std')35 +b(FITS)e(\014le)h(included)d(with)i(this)g(release.)53 +b(The)34 b(diagnostic)g(messages)h(\(whic)m(h)f(w)m(ere)h(pip)s(ed)d +(to)j(the)0 3345 y(\014le)g(testprog.lis)h(in)f(the)i(Unix)e(example\)) +h(should)e(b)s(e)i(iden)m(tical)f(to)i(the)f(listing)e(con)m(tained)j +(in)e(the)h(\014le)g(test-)0 3458 y(prog.out.)63 b(The)37 +b('di\013)7 b(')37 b(and)g('cmp')h(commands)g(sho)m(wn)f(ab)s(o)m(v)m +(e)i(should)c(not)j(rep)s(ort)f(an)m(y)h(di\013erences)f(in)g(the)0 +3571 y(\014les.)64 b(\(There)38 b(ma)m(y)h(b)s(e)f(some)h(minor)e +(format)i(di\013erences,)h(suc)m(h)e(as)h(the)g(presence)f(or)h +(absence)g(of)f(leading)0 3684 y(zeros,)31 b(or)g(3)f(digit)g(exp)s +(onen)m(ts)g(in)f(n)m(um)m(b)s(ers,)g(whic)m(h)g(can)i(b)s(e)f +(ignored\).)0 3844 y(The)e(F)-8 b(ortran)30 b(wrapp)s(ers)d(in)g +(CFITSIO)g(ma)m(y)j(b)s(e)e(tested)h(with)f(the)h(testf77)h(program)f +(on)g(Unix)e(systems)i(with:)191 4101 y Fe(\045)47 b(f77)g(-o)g +(testf77)f(testf77.f)g(-L.)g(-lcfitsio)g(-lnsl)g(-lsocket)95 +4214 y(or)191 4327 y(\045)h(f77)g(-f)g(-o)h(testf77)d(testf77.f)h(-L.)h +(-lcfitsio)188 b(\(under)46 b(SUN)h(O/S\))95 4440 y(or)191 +4553 y(\045)g(f77)g(-o)g(testf77)f(testf77.f)g(-Wl,-L.)f(-lcfitsio)h +(-lm)h(-lnsl)f(-lsocket)f(\(HP/UX\))191 4779 y(\045)i(testf77)f(>)i +(testf77.lis)191 4892 y(\045)f(diff)g(testf77.lis)e(testf77.out)191 +5005 y(\045)i(cmp)g(testf77.fit)e(testf77.std)0 5262 +y Fj(On)31 b(mac)m(hines)g(running)f(SUN)h(O/S,)h(F)-8 +b(ortran)33 b(programs)e(m)m(ust)h(b)s(e)f(compiled)f(with)h(the)h('-f) +7 b(')32 b(option)g(to)g(force)0 5375 y(double)24 b(precision)g(v)-5 +b(ariables)24 b(to)i(b)s(e)f(aligned)f(on)i(8-b)m(yte)h(b)s(oundarys)c +(to)j(mak)m(e)h(the)e(fortran-declared)g(v)-5 b(ariables)0 +5488 y(compatible)32 b(with)f(C.)h(A)h(similar)d(compiler)h(option)h +(ma)m(y)h(b)s(e)f(required)f(on)h(other)h(platforms.)47 +b(F)-8 b(ailing)31 b(to)i(use)0 5601 y(this)25 b(option)g(ma)m(y)h +(cause)h(the)f(program)f(to)i(crash)e(on)h(FITSIO)f(routines)f(that)j +(read)f(or)f(write)g(double)g(precision)0 5714 y(v)-5 +b(ariables.)p eop +%%Page: 9 17 +9 16 bop 0 299 a Fh(2.3.)72 b(LINKING)30 b(PR)m(OGRAMS)h(WITH)f +(CFITSIO)1975 b Fj(9)0 555 y(Also)30 b(note)h(that)f(on)g(some)h +(systems,)f(the)h(output)e(listing)f(of)j(the)f(testf77)i(program)d(ma) +m(y)i(di\013er)e(sligh)m(tly)f(from)0 668 y(the)j(testf77.std)h +(template,)f(if)f(leading)f(zeros)i(are)g(not)g(prin)m(ted)e(b)m(y)i +(default)f(b)s(efore)g(the)h(decimal)e(p)s(oin)m(t)h(when)0 +781 y(using)f(F)i(format.)0 941 y(A)37 b(few)f(other)g(utilit)m(y)f +(programs)h(are)h(included)d(with)h(CFITSIO;)g(the)i(\014rst)e(four)h +(of)g(this)g(programs)g(can)h(b)s(e)0 1054 y(compiled)c(an)i(link)m(ed) +e(b)m(y)i(t)m(yping)f(`mak)m(e)i(program)p 1815 1054 +28 4 v 33 w(name')f(where)f(`program)p 2746 1054 V 33 +w(name')h(is)f(the)h(actual)g(name)g(of)0 1167 y(the)c(program:)191 +1467 y Fe(speed)46 b(-)i(measures)d(the)i(maximum)f(throughput)f(\(in)i +(MB)g(per)g(second\))668 1580 y(for)g(writing)f(and)h(reading)f(FITS)g +(files)h(with)f(CFITSIO.)191 1806 y(listhead)f(-)j(lists)e(all)h(the)g +(header)f(keywords)g(in)h(any)g(FITS)f(file)191 2032 +y(fitscopy)f(-)j(copies)e(any)h(FITS)g(file)f(\(especially)f(useful)h +(in)h(conjunction)811 2145 y(with)g(the)g(CFITSIO's)e(extended)h(input) +g(filename)g(syntax\).)191 2371 y(cookbook)f(-)j(a)f(sample)f(program)g +(that)h(performs)e(common)i(read)f(and)811 2483 y(write)h(operations)e +(on)i(a)g(FITS)g(file.)191 2709 y(iter_a,)f(iter_b,)g(iter_c)g(-)h +(examples)f(of)h(the)g(CFITSIO)f(iterator)f(routine)0 +3091 y Ff(2.3)135 b(Linking)45 b(Programs)h(with)f(CFITSIO)0 +3350 y Fj(When)25 b(linking)e(applications)h(soft)m(w)m(are)j(with)d +(the)i(CFITSIO)e(library)-8 b(,)25 b(sev)m(eral)h(system)g(libraries)d +(usually)g(need)0 3463 y(to)36 b(b)s(e)f(sp)s(eci\014ed)f(on)h(the)g +(link)f(command)h(line.)54 b(On)34 b(Unix)h(systems,)i(the)e(most)h +(reliable)d(w)m(a)m(y)k(to)f(determine)0 3576 y(what)26 +b(libraries)e(are)i(required)f(is)g(to)i(t)m(yp)s(e)f('mak)m(e)i +(testprog')f(and)f(see)h(what)f(libraries)e(the)i(con\014gure)g(script) +f(has)0 3689 y(added.)39 b(The)25 b(t)m(ypical)h(libraries)d(that)j +(need)g(to)g(b)s(e)g(added)f(are)h(-lm)g(\(the)g(math)g(library\))e +(and)h(-lnsl)f(and)i(-lso)s(c)m(k)m(et)0 3802 y(\(needed)k(only)f(for)h +(FTP)g(and)f(HTTP)g(\014le)g(access\).)43 b(These)30 +b(latter)g(2)g(libraries)d(are)k(not)f(needed)g(on)g(VMS)g(and)0 +3915 y(Windo)m(ws)f(platforms,)h(b)s(ecause)g(FTP)h(\014le)e(access)j +(is)d(not)i(curren)m(tly)e(supp)s(orted)g(on)h(those)h(platforms.)0 +4075 y(Note)i(that)g(when)e(upgrading)f(to)j(a)f(new)m(er)g(v)m(ersion) +f(of)h(CFITSIO)f(it)g(is)g(usually)f(necessary)i(to)h(recompile,)f(as)0 +4188 y(w)m(ell)d(as)i(relink,)e(the)h(programs)g(that)h(use)f(CFITSIO,) +f(b)s(ecause)i(the)f(de\014nitions)e(in)h(\014tsio.h)h(often)g(c)m +(hange.)0 4569 y Ff(2.4)135 b(Getting)46 b(Started)g(with)f(CFITSIO)0 +4829 y Fj(In)27 b(order)h(to)g(e\013ectiv)m(ely)h(use)f(the)g(CFITSIO)e +(library)g(it)h(is)g(recommended)h(that)g(new)f(users)h(b)s(egin)e(b)m +(y)i(reading)0 4942 y(the)g(\\CFITSIO)g(Quic)m(k)f(Start)h(Guide".)40 +b(It)28 b(con)m(tains)g(all)g(the)g(basic)g(information)e(needed)i(to)h +(write)e(programs)0 5055 y(that)d(p)s(erform)f(most)h(t)m(yp)s(es)g(of) +g(op)s(erations)f(on)h(FITS)f(\014les.)38 b(The)23 b(set)i(of)f +(example)f(FITS)h(utilit)m(y)e(programs)h(that)0 5168 +y(are)29 b(a)m(v)-5 b(ailable)28 b(from)g(the)g(CFITSIO)f(w)m(eb)i +(site)f(are)h(also)f(v)m(ery)h(useful)e(for)h(learning)f(ho)m(w)h(to)h +(use)f(CFITSIO.)f(T)-8 b(o)0 5281 y(learn)22 b(ev)m(en)h(more)g(ab)s +(out)f(the)h(capabilities)d(of)j(the)g(CFITSIO)e(library)f(the)j(follo) +m(wing)e(steps)h(are)h(recommended:)0 5441 y(1.)41 b(Read)31 +b(the)f(follo)m(wing)f(short)h(`FITS)g(Primer')f(c)m(hapter)i(for)f(an) +h(o)m(v)m(erview)g(of)f(the)h(structure)f(of)g(FITS)g(\014les.)0 +5601 y(2.)40 b(Review)27 b(the)g(Programming)f(Guidelines)f(in)h +(Chapter)g(4)i(to)g(b)s(ecome)f(familiar)e(with)h(the)i(con)m(v)m(en)m +(tions)g(used)0 5714 y(b)m(y)i(the)h(CFITSIO)e(in)m(terface.)p +eop +%%Page: 10 18 +10 17 bop 0 299 a Fj(10)1535 b Fh(CHAPTER)30 b(2.)112 +b(CREA)-8 b(TING)30 b(THE)g(CFITSIO)f(LIBRAR)-8 b(Y)0 +555 y Fj(3.)74 b(Refer)41 b(to)h(the)g(co)s(okb)s(o)s(ok.c,)j +(listhead.c,)f(and)c(\014tscop)m(y)-8 b(.c)43 b(programs)e(that)h(are)g +(included)c(with)i(this)h(re-)0 668 y(lease)g(for)f(examples)g(of)h +(routines)e(that)i(p)s(erform)e(v)-5 b(arious)40 b(common)h(FITS)f +(\014le)f(op)s(erations.)71 b(T)m(yp)s(e)40 b('mak)m(e)0 +781 y(program)p 339 781 28 4 v 33 w(name')30 b(to)h(compile)f(and)f +(link)g(these)i(programs)f(on)g(Unix)f(systems.)0 941 +y(4.)40 b(W)-8 b(rite)29 b(a)f(simple)e(program)i(to)g(read)g(or)g +(write)f(a)i(FITS)e(\014le)g(using)g(the)h(Basic)g(In)m(terface)h +(routines)e(describ)s(ed)0 1054 y(in)i(Chapter)h(5.)0 +1214 y(5.)79 b(Scan)43 b(through)f(the)h(more)g(sp)s(ecialized)f +(routines)f(that)j(are)f(describ)s(ed)e(in)h(the)h(follo)m(wing)f(c)m +(hapters)h(to)0 1327 y(b)s(ecome)31 b(familiar)d(with)h(the)i +(functionalit)m(y)d(that)j(they)g(pro)m(vide.)0 1660 +y Ff(2.5)135 b(Example)46 b(Program)0 1910 y Fj(The)c(follo)m(wing)g +(listing)f(sho)m(ws)h(an)h(example)g(of)g(ho)m(w)g(to)g(use)g(the)g +(CFITSIO)f(routines)f(in)h(a)h(C)g(program.)0 2023 y(Refer)26 +b(to)g(the)g(co)s(okb)s(o)s(ok.c)g(program)f(that)i(is)d(included)f +(with)h(the)i(CFITSIO)e(distribution)e(for)j(other)h(example)0 +2136 y(routines.)0 2296 y(This)37 b(program)i(creates)h(a)f(new)f(FITS) +g(\014le,)j(con)m(taining)d(a)h(FITS)f(image.)67 b(An)38 +b(`EXPOSURE')h(k)m(eyw)m(ord)g(is)0 2409 y(written)26 +b(to)h(the)f(header,)i(then)e(the)h(image)f(data)i(are)f(written)e(to)i +(the)g(FITS)f(\014le)f(b)s(efore)i(closing)e(the)i(FITS)f(\014le.)0 +2665 y Fe(#include)46 b("fitsio.h")92 b(/*)47 b(required)f(by)h(every)g +(program)e(that)i(uses)g(CFITSIO)93 b(*/)0 2778 y(main\(\))0 +2891 y({)191 3004 y(fitsfile)45 b(*fptr;)333 b(/*)47 +b(pointer)f(to)h(the)g(FITS)g(file;)f(defined)g(in)h(fitsio.h)f(*/)191 +3117 y(int)h(status,)f(ii,)h(jj;)191 3230 y(long)94 b(fpixel)46 +b(=)i(1,)f(naxis)f(=)i(2,)f(nelements,)e(exposure;)191 +3343 y(long)i(naxes[2])e(=)j({)f(300,)g(200)g(};)142 +b(/*)47 b(image)g(is)g(300)g(pixels)f(wide)h(by)g(200)g(rows)f(*/)191 +3456 y(short)g(array[200][300];)191 3681 y(status)g(=)h(0;)429 +b(/*)48 b(initialize)d(status)h(before)g(calling)g(fitsio)g(routines)f +(*/)191 3794 y(fits_create_file\(&fptr,)c("testfile.fits",)j +(&status\);)140 b(/*)48 b(create)e(new)h(file)f(*/)191 +4020 y(/*)h(Create)f(the)h(primary)f(array)g(image)h(\(16-bit)e(short)i +(integer)f(pixels)g(*/)191 4133 y(fits_create_img\(fptr,)c(SHORT_IMG,)j +(naxis,)h(naxes,)g(&status\);)191 4359 y(/*)h(Write)f(a)i(keyword;)d +(must)i(pass)g(the)g(ADDRESS)e(of)j(the)f(value)f(*/)191 +4472 y(exposure)f(=)j(1500.;)191 4585 y(fits_update_key\(fptr,)42 +b(TLONG,)k("EXPOSURE",)f(&exposure,)430 4698 y("Total)h(Exposure)f +(Time",)h(&status\);)191 4924 y(/*)h(Initialize)e(the)i(values)f(in)h +(the)g(image)g(with)f(a)i(linear)e(ramp)g(function)g(*/)191 +5036 y(for)h(\(jj)g(=)g(0;)g(jj)h(<)f(naxes[1];)e(jj++\))382 +5149 y(for)i(\(ii)g(=)g(0;)g(ii)g(<)h(naxes[0];)d(ii++\))573 +5262 y(array[jj][ii])f(=)j(ii)h(+)f(jj;)191 5488 y(nelements)e(=)j +(naxes[0])d(*)j(naxes[1];)474 b(/*)48 b(number)e(of)h(pixels)f(to)h +(write)g(*/)191 5714 y(/*)g(Write)f(the)h(array)g(of)g(integers)e(to)j +(the)f(image)f(*/)p eop +%%Page: 11 19 +11 18 bop 0 299 a Fh(2.5.)72 b(EXAMPLE)31 b(PR)m(OGRAM)2618 +b Fj(11)191 555 y Fe(fits_write_img\(fptr,)42 b(TSHORT,)k(fpixel,)g +(nelements,)f(array[0],)g(&status\);)191 781 y(fits_close_file\(fptr,)d +(&status\);)570 b(/*)47 b(close)g(the)g(file)f(*/)191 +1007 y(fits_report_error\(stderr)o(,)c(status\);)93 b(/*)47 +b(print)g(out)g(any)f(error)h(messages)e(*/)191 1120 +y(return\()h(status)g(\);)0 1233 y(})p eop +%%Page: 12 20 +12 19 bop 0 299 a Fj(12)1535 b Fh(CHAPTER)30 b(2.)112 +b(CREA)-8 b(TING)30 b(THE)g(CFITSIO)f(LIBRAR)-8 b(Y)p +eop +%%Page: 13 21 +13 20 bop 0 1225 a Fg(Chapter)65 b(3)0 1687 y Fm(A)78 +b(FITS)f(Primer)0 2180 y Fj(This)22 b(section)j(giv)m(es)f(a)h(brief)d +(o)m(v)m(erview)j(of)f(the)h(structure)e(of)i(FITS)e(\014les.)37 +b(Users)24 b(should)f(refer)g(to)i(the)g(do)s(cumen-)0 +2293 y(tation)i(a)m(v)-5 b(ailable)27 b(from)g(the)g(NOST,)f(as)i +(describ)s(ed)d(in)h(the)h(in)m(tro)s(duction,)f(for)h(more)g(detailed) +g(information)e(on)0 2406 y(FITS)30 b(formats.)0 2566 +y(FITS)e(w)m(as)h(\014rst)g(dev)m(elop)s(ed)f(in)f(the)i(late)h(1970's) +h(as)e(a)g(standard)f(data)i(in)m(terc)m(hange)f(format)g(b)s(et)m(w)m +(een)h(v)-5 b(arious)0 2679 y(astronomical)34 b(observ)-5 +b(atories.)51 b(Since)33 b(then)h(FITS)f(has)h(b)s(ecome)g(the)h +(standard)e(data)i(format)f(supp)s(orted)e(b)m(y)0 2791 +y(most)f(astronomical)f(data)h(analysis)e(soft)m(w)m(are)j(pac)m(k)-5 +b(ages.)0 2952 y(A)34 b(FITS)f(\014le)f(consists)h(of)h(one)g(or)g +(more)g(Header)g(+)f(Data)i(Units)e(\(HDUs\),)j(where)d(the)h(\014rst)f +(HDU)h(is)f(called)0 3065 y(the)k(`Primary)e(HDU',)j(or)f(`Primary)e +(Arra)m(y'.)60 b(The)36 b(primary)f(arra)m(y)i(con)m(tains)g(an)f +(N-dimensional)f(arra)m(y)i(of)0 3177 y(pixels,)26 b(suc)m(h)h(as)h(a)f +(1-D)h(sp)s(ectrum,)f(a)h(2-D)g(image,)h(or)e(a)g(3-D)i(data)f(cub)s +(e.)39 b(Fiv)m(e)27 b(di\013eren)m(t)g(primary)e(data)j(t)m(yp)s(es)0 +3290 y(are)e(supp)s(orted:)37 b(Unsigned)24 b(8-bit)i(b)m(ytes,)h(16)g +(and)e(32-bit)h(signed)e(in)m(tegers,)j(and)f(32)g(and)f(64-bit)h +(\015oating)g(p)s(oin)m(t)0 3403 y(reals.)40 b(FITS)29 +b(also)h(has)g(a)g(con)m(v)m(en)m(tion)i(for)d(storing)h(16)h(and)e +(32-bit)h(unsigned)e(in)m(tegers)j(\(see)g(the)f(later)g(section)0 +3516 y(en)m(titled)d(`Unsigned)g(In)m(tegers')i(for)e(more)h +(details\).)39 b(The)27 b(primary)f(HDU)j(ma)m(y)f(also)g(consist)f(of) +h(only)f(a)h(header)0 3629 y(with)h(a)i(n)m(ull)d(arra)m(y)j(con)m +(taining)f(no)g(data)h(pixels.)0 3789 y(An)m(y)i(n)m(um)m(b)s(er)e(of)h +(additional)f(HDUs)i(ma)m(y)g(follo)m(w)f(the)g(primary)f(arra)m(y;)j +(these)f(additional)e(HDUs)i(are)g(called)0 3902 y(FITS)d +(`extensions'.)40 b(There)30 b(are)h(curren)m(tly)e(3)i(t)m(yp)s(es)g +(of)f(extensions)g(de\014ned)f(b)m(y)h(the)h(FITS)f(standard:)136 +4171 y Fc(\017)46 b Fj(Image)31 b(Extension)f(-)h(a)f(N-dimensional)e +(arra)m(y)j(of)g(pixels,)e(lik)m(e)g(in)g(a)i(primary)d(arra)m(y)136 +4368 y Fc(\017)46 b Fj(ASCI)s(I)29 b(T)-8 b(able)30 b(Extension)g(-)g +(ro)m(ws)h(and)e(columns)g(of)i(data)g(in)e(ASCI)s(I)g(c)m(haracter)j +(format)136 4564 y Fc(\017)46 b Fj(Binary)30 b(T)-8 b(able)30 +b(Extension)f(-)i(ro)m(ws)f(and)g(columns)f(of)i(data)g(in)e(binary)f +(represen)m(tation)0 4833 y(In)33 b(eac)m(h)i(case)g(the)f(HDU)h +(consists)f(of)g(an)g(ASCI)s(I)e(Header)i(Unit)g(follo)m(w)m(ed)f(b)m +(y)h(an)g(optional)f(Data)i(Unit.)51 b(F)-8 b(or)0 4946 +y(historical)34 b(reasons,)j(eac)m(h)f(Header)g(or)g(Data)h(unit)d(m)m +(ust)h(b)s(e)g(an)g(exact)i(m)m(ultiple)c(of)j(2880)h(8-bit)e(b)m(ytes) +h(long.)0 5059 y(An)m(y)30 b(un)m(used)g(space)g(is)g(padded)f(with)g +(\014ll)f(c)m(haracters)k(\(ASCI)s(I)d(blanks)g(or)i(zeros\).)0 +5219 y(Eac)m(h)i(Header)f(Unit)g(consists)g(of)g(an)m(y)g(n)m(um)m(b)s +(er)f(of)i(80-c)m(haracter)i(k)m(eyw)m(ord)d(records)g(or)g(`card)h +(images')f(whic)m(h)0 5332 y(ha)m(v)m(e)g(the)e(general)h(form:)95 +5601 y Fe(KEYNAME)46 b(=)i(value)e(/)i(comment)d(string)95 +5714 y(NULLKEY)h(=)334 b(/)48 b(comment:)d(This)i(keyword)f(has)g(no)i +(value)1905 5942 y Fj(13)p eop +%%Page: 14 22 +14 21 bop 0 299 a Fj(14)2398 b Fh(CHAPTER)30 b(3.)112 +b(A)30 b(FITS)g(PRIMER)0 555 y Fj(The)35 b(k)m(eyw)m(ord)i(names)f(ma)m +(y)g(b)s(e)g(up)f(to)h(8)h(c)m(haracters)g(long)f(and)f(can)h(only)g +(con)m(tain)g(upp)s(ercase)f(letters,)j(the)0 668 y(digits)23 +b(0-9,)k(the)e(h)m(yphen,)g(and)f(the)h(underscore)e(c)m(haracter.)41 +b(The)24 b(k)m(eyw)m(ord)h(name)g(is)e(\(usually\))g(follo)m(w)m(ed)i +(b)m(y)f(an)0 781 y(equals)k(sign)g(and)g(a)g(space)i(c)m(haracter)g +(\(=)e(\))h(in)e(columns)h(9)h(-)f(10)i(of)f(the)f(record,)h(follo)m(w) +m(ed)g(b)m(y)f(the)h(v)-5 b(alue)28 b(of)h(the)0 894 +y(k)m(eyw)m(ord)34 b(whic)m(h)f(ma)m(y)h(b)s(e)f(either)g(an)h(in)m +(teger,)h(a)f(\015oating)f(p)s(oin)m(t)g(n)m(um)m(b)s(er,)h(a)g(c)m +(haracter)h(string)d(\(enclosed)i(in)0 1007 y(single)26 +b(quotes\),)k(or)e(a)g(b)s(o)s(olean)f(v)-5 b(alue)27 +b(\(the)h(letter)g(T)g(or)f(F\).)i(A)f(k)m(eyw)m(ord)g(ma)m(y)h(also)e +(ha)m(v)m(e)i(a)g(n)m(ull)c(or)j(unde\014ned)0 1120 y(v)-5 +b(alue)30 b(if)f(there)i(is)e(no)h(sp)s(eci\014ed)f(v)-5 +b(alue)30 b(string,)g(as)g(in)f(the)i(second)f(example,)h(ab)s(o)m(v)m +(e)0 1280 y(The)42 b(last)g(k)m(eyw)m(ord)h(in)e(the)i(header)f(is)f +(alw)m(a)m(ys)i(the)g(`END')g(k)m(eyw)m(ord)g(whic)m(h)e(has)h(no)h(v) +-5 b(alue)41 b(or)i(commen)m(t)0 1393 y(\014elds.)c(There)30 +b(are)h(man)m(y)f(rules)f(go)m(v)m(erning)i(the)f(exact)i(format)f(of)f +(a)h(k)m(eyw)m(ord)f(record)h(\(see)g(the)f(NOST)g(FITS)0 +1506 y(Standard\))c(so)i(it)e(is)h(b)s(etter)g(to)h(rely)e(on)h +(standard)g(in)m(terface)g(soft)m(w)m(are)i(lik)m(e)d(CFITSIO)g(to)i +(correctly)g(construct)0 1619 y(or)i(to)h(parse)g(the)f(k)m(eyw)m(ord)h +(records)f(rather)g(than)h(try)f(to)h(deal)f(directly)f(with)g(the)h +(ra)m(w)h(FITS)f(formats.)0 1779 y(Eac)m(h)37 b(Header)g(Unit)e(b)s +(egins)g(with)g(a)h(series)g(of)g(required)f(k)m(eyw)m(ords)h(whic)m(h) +f(dep)s(end)g(on)h(the)g(t)m(yp)s(e)h(of)f(HDU.)0 1892 +y(These)31 b(required)f(k)m(eyw)m(ords)i(sp)s(ecify)f(the)g(size)h(and) +f(format)h(of)g(the)g(follo)m(wing)e(Data)j(Unit.)44 +b(The)31 b(header)g(ma)m(y)0 2005 y(con)m(tain)g(other)g(optional)e(k)m +(eyw)m(ords)i(to)h(describ)s(e)d(other)h(asp)s(ects)h(of)g(the)g(data,) +g(suc)m(h)g(as)g(the)f(units)f(or)i(scaling)0 2118 y(v)-5 +b(alues.)43 b(Other)31 b(COMMENT)g(or)g(HISTOR)-8 b(Y)30 +b(k)m(eyw)m(ords)i(are)g(also)f(frequen)m(tly)g(added)f(to)i(further)e +(do)s(cumen)m(t)0 2230 y(the)h(data)g(\014le.)0 2391 +y(The)36 b(optional)f(Data)j(Unit)e(immediately)e(follo)m(ws)i(the)g +(last)g(2880-b)m(yte)j(blo)s(c)m(k)d(in)f(the)h(Header)h(Unit.)58 +b(Some)0 2503 y(HDUs)31 b(do)f(not)h(ha)m(v)m(e)g(a)g(Data)h(Unit)e +(and)g(only)f(consist)h(of)h(the)f(Header)h(Unit.)0 2664 +y(If)24 b(there)i(is)e(more)h(than)f(one)h(HDU)h(in)e(the)h(FITS)f +(\014le,)h(then)g(the)g(Header)h(Unit)e(of)h(the)g(next)g(HDU)h +(immediately)0 2777 y(follo)m(ws)e(the)g(last)h(2880-b)m(yte)i(blo)s(c) +m(k)d(of)h(the)f(previous)f(Data)k(Unit)c(\(or)i(Header)g(Unit)f(if)f +(there)i(is)f(no)g(Data)i(Unit\).)0 2937 y(The)k(main)f(required)g(k)m +(eyw)m(ords)h(in)f(FITS)h(primary)f(arra)m(ys)h(or)h(image)f +(extensions)g(are:)136 3172 y Fc(\017)46 b Fj(BITPIX)39 +b({)h(de\014nes)f(the)g(data)h(t)m(yp)s(e)g(of)f(the)h(arra)m(y:)59 +b(8,)42 b(16,)h(32,)g(-32,)g(-64)d(for)f(unsigned)f(8{bit)h(b)m(yte,) +227 3284 y(16{bit)h(signed)f(in)m(teger,)j(32{bit)f(signed)d(in)m +(teger,)43 b(32{bit)d(IEEE)f(\015oating)g(p)s(oin)m(t,)i(and)f(64{bit)g +(IEEE)227 3397 y(double)29 b(precision)g(\015oating)h(p)s(oin)m(t,)g +(resp)s(ectiv)m(ely)-8 b(.)136 3585 y Fc(\017)46 b Fj(NAXIS)30 +b({)h(the)g(n)m(um)m(b)s(er)e(of)h(dimensions)e(in)h(the)i(arra)m(y)-8 +b(,)31 b(usually)d(0,)j(1,)g(2,)g(3,)g(or)g(4.)136 3773 +y Fc(\017)46 b Fj(NAXISn)30 b({)h(\(n)f(ranges)g(from)g(1)h(to)g +(NAXIS\))g(de\014nes)e(the)i(size)f(of)h(eac)m(h)g(dimension.)0 +4008 y(FITS)e(tables)h(start)h(with)e(the)h(k)m(eyw)m(ord)g(XTENSION)g +(=)f(`T)-8 b(ABLE')31 b(\(for)f(ASCI)s(I)f(tables\))h(or)g(XTENSION)f +(=)0 4120 y(`BINT)-8 b(ABLE')32 b(\(for)e(binary)f(tables\))h(and)g(ha) +m(v)m(e)i(the)e(follo)m(wing)f(main)g(k)m(eyw)m(ords:)136 +4355 y Fc(\017)46 b Fj(TFIELDS)30 b({)h(n)m(um)m(b)s(er)e(of)h +(\014elds)f(or)i(columns)e(in)g(the)h(table)136 4543 +y Fc(\017)46 b Fj(NAXIS2)31 b({)g(n)m(um)m(b)s(er)e(of)h(ro)m(ws)h(in)e +(the)h(table)136 4731 y Fc(\017)46 b Fj(TTYPEn)29 b({)i(for)f(eac)m(h)i +(column)d(\(n)h(ranges)h(from)f(1)g(to)h(TFIELDS\))g(giv)m(es)f(the)h +(name)f(of)h(the)f(column)136 4918 y Fc(\017)46 b Fj(TF)m(ORMn)31 +b({)f(the)h(data)g(t)m(yp)s(e)f(of)h(the)g(column)136 +5106 y Fc(\017)46 b Fj(TUNITn)30 b({)g(the)h(ph)m(ysical)e(units)g(of)h +(the)h(column)e(\(optional\))0 5341 y(Users)e(should)e(refer)i(to)g +(the)h(FITS)e(Supp)s(ort)f(O\016ce)i(at)h Fe(http://fits.gsfc.nasa.go)o +(v)21 b Fj(for)27 b(futher)f(informa-)0 5454 y(tion)k(ab)s(out)g(the)h +(FITS)e(format)i(and)f(related)g(soft)m(w)m(are)i(pac)m(k)-5 +b(ages.)p eop +%%Page: 15 23 +15 22 bop 0 1225 a Fg(Chapter)65 b(4)0 1687 y Fm(Programming)77 +b(Guidelines)0 2216 y Ff(4.1)135 b(CFITSIO)44 b(De\014nitions)0 +2466 y Fj(An)m(y)30 b(program)g(that)h(uses)f(the)h(CFITSIO)d(in)m +(terface)j(m)m(ust)f(include)e(the)j(\014tsio.h)e(header)h(\014le)g +(with)f(the)h(state-)0 2579 y(men)m(t)95 2818 y Fe(#include)46 +b("fitsio.h")0 3057 y Fj(This)29 b(header)i(\014le)g(con)m(tains)g(the) +g(protot)m(yp)s(es)h(for)f(all)f(the)h(CFITSIO)f(user)g(in)m(terface)i +(routines)e(as)h(w)m(ell)f(as)i(the)0 3170 y(de\014nitions)e(of)i(v)-5 +b(arious)31 b(constan)m(ts)i(used)e(in)g(the)i(in)m(terface.)46 +b(It)32 b(also)g(de\014nes)f(a)i(C)f(structure)f(of)h(t)m(yp)s(e)h +(`\014ts\014le')0 3283 y(that)j(is)f(used)g(b)m(y)g(CFITSIO)f(to)j +(store)f(the)g(relev)-5 b(an)m(t)36 b(parameters)g(that)g(de\014ne)f +(the)h(format)g(of)g(a)g(particular)0 3396 y(FITS)c(\014le.)47 +b(Application)31 b(programs)i(m)m(ust)g(de\014ne)f(a)h(p)s(oin)m(ter)f +(to)h(this)f(structure)h(for)f(eac)m(h)i(FITS)e(\014le)g(that)i(is)0 +3508 y(to)i(b)s(e)f(op)s(ened.)56 b(This)34 b(structure)h(is)g +(initialized)d(\(i.e.,)38 b(memory)d(is)g(allo)s(cated)g(for)h(the)g +(structure\))f(when)g(the)0 3621 y(FITS)h(\014le)f(is)h(\014rst)f(op)s +(ened)h(or)g(created)i(with)d(the)h(\014ts)p 1949 3621 +28 4 v 33 w(op)s(en)p 2172 3621 V 32 w(\014le)f(or)i(\014ts)p +2596 3621 V 32 w(create)p 2864 3621 V 34 w(\014le)f(routines.)58 +b(This)34 b(\014ts\014le)0 3734 y(p)s(oin)m(ter)c(is)h(then)g(passed)g +(as)g(the)h(\014rst)e(argumen)m(t)i(to)g(ev)m(ery)g(other)g(CFITSIO)d +(routine)i(that)h(op)s(erates)g(on)f(the)0 3847 y(FITS)h(\014le.)47 +b(Application)31 b(programs)i(m)m(ust)g(not)g(directly)e(read)i(or)g +(write)f(elemen)m(ts)h(in)f(this)g(\014ts\014le)f(structure)0 +3960 y(b)s(ecause)f(the)h(de\014nition)d(of)j(the)f(structure)g(ma)m(y) +h(c)m(hange)g(in)f(future)f(v)m(ersions)h(of)g(CFITSIO.)0 +4120 y(A)45 b(n)m(um)m(b)s(er)e(of)i(sym)m(b)s(olic)e(constan)m(ts)j +(are)f(also)f(de\014ned)g(in)f(\014tsio.h)h(for)g(the)h(con)m(v)m +(enience)h(of)f(application)0 4233 y(programmers.)55 +b(Use)35 b(of)h(these)f(sym)m(b)s(olic)f(constan)m(ts)i(rather)f(than)g +(the)h(actual)f(n)m(umeric)f(v)-5 b(alue)35 b(will)d(help)i(to)0 +4346 y(mak)m(e)d(the)g(source)f(co)s(de)h(more)g(readable)e(and)h +(easier)h(for)f(others)g(to)h(understand.)0 4585 y Fe(String)46 +b(Lengths,)g(for)h(use)f(when)h(allocating)e(character)g(arrays:)95 +4811 y(#define)h(FLEN_FILENAME)e(1025)j(/*)g(max)g(length)f(of)h(a)h +(filename)857 b(*/)95 4924 y(#define)46 b(FLEN_KEYWORD)140 +b(72)95 b(/*)47 b(max)g(length)f(of)h(a)h(keyword)905 +b(*/)95 5036 y(#define)46 b(FLEN_CARD)284 b(81)95 b(/*)47 +b(max)g(length)f(of)h(a)h(FITS)f(header)f(card)476 b(*/)95 +5149 y(#define)46 b(FLEN_VALUE)236 b(71)95 b(/*)47 b(max)g(length)f(of) +h(a)h(keyword)e(value)g(string)285 b(*/)95 5262 y(#define)46 +b(FLEN_COMMENT)140 b(73)95 b(/*)47 b(max)g(length)f(of)h(a)h(keyword)e +(comment)g(string)189 b(*/)95 5375 y(#define)46 b(FLEN_ERRMSG)188 +b(81)95 b(/*)47 b(max)g(length)f(of)h(a)h(CFITSIO)e(error)g(message)237 +b(*/)95 5488 y(#define)46 b(FLEN_STATUS)188 b(31)95 b(/*)47 +b(max)g(length)f(of)h(a)h(CFITSIO)e(status)g(text)g(string)h(*/)95 +5714 y(Note)g(that)g(FLEN_KEYWORD)d(is)j(longer)f(than)h(the)g(nominal) +f(8-character)f(keyword)1905 5942 y Fj(15)p eop +%%Page: 16 24 +16 23 bop 0 299 a Fj(16)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)95 555 y Fe(name)47 +b(length)f(because)g(the)h(HIERARCH)e(convention)g(supports)h(longer)g +(keyword)g(names.)0 781 y(Access)g(modes)g(when)h(opening)f(a)h(FITS)g +(file:)95 1007 y(#define)f(READONLY)94 b(0)95 1120 y(#define)46 +b(READWRITE)g(1)0 1346 y(BITPIX)g(data)h(type)f(code)h(values)f(for)h +(FITS)g(images:)95 1571 y(#define)f(BYTE_IMG)284 b(8)96 +b(/*)f(8-bit)46 b(unsigned)f(integers)h(*/)95 1684 y(#define)g +(SHORT_IMG)189 b(16)95 b(/*)47 b(16-bit)141 b(signed)46 +b(integers)g(*/)95 1797 y(#define)g(LONG_IMG)237 b(32)95 +b(/*)47 b(32-bit)141 b(signed)46 b(integers)g(*/)95 1910 +y(#define)g(FLOAT_IMG)141 b(-32)95 b(/*)47 b(32-bit)f(single)g +(precision)f(floating)h(point)g(*/)95 2023 y(#define)g(DOUBLE_IMG)93 +b(-64)i(/*)47 b(64-bit)f(double)g(precision)f(floating)h(point)g(*/)95 +2249 y(The)h(following)f(4)h(data)g(type)f(codes)h(are)g(also)f +(supported)g(by)h(CFITSIO:)95 2362 y(#define)f(LONGLONG_IMG)f(64)i(/*)g +(64-bit)f(long)h(signed)f(integers)f(*/)95 2475 y(#define)h(SBYTE_IMG) +93 b(10)143 b(/*)95 b(8-bit)46 b(signed)g(integers,)g(equivalent)f(to)i +(*/)1241 2588 y(/*)95 b(BITPIX)46 b(=)h(8,)h(BSCALE)e(=)h(1,)g(BZERO)g +(=)g(-128)g(*/)95 2700 y(#define)f(USHORT_IMG)93 b(20)i(/*)47 +b(16-bit)f(unsigned)g(integers,)f(equivalent)g(to)i(*/)1241 +2813 y(/*)95 b(BITPIX)46 b(=)h(16,)g(BSCALE)f(=)i(1,)f(BZERO)f(=)i +(32768)e(*/)95 2926 y(#define)g(ULONG_IMG)141 b(40)95 +b(/*)47 b(32-bit)f(unsigned)g(integers,)f(equivalent)g(to)i(*/)1241 +3039 y(/*)95 b(BITPIX)46 b(=)h(32,)g(BSCALE)f(=)i(1,)f(BZERO)f(=)i +(2147483648)d(*/)0 3265 y(Codes)h(for)h(the)g(data)g(type)f(of)i +(binary)e(table)g(columns)g(and/or)g(for)h(the)0 3378 +y(data)g(type)f(of)h(variables)f(when)g(reading)g(or)h(writing)f +(keywords)g(or)h(data:)1432 3604 y(DATATYPE)714 b(TFORM)46 +b(CODE)95 3717 y(#define)g(TBIT)476 b(1)96 b(/*)1335 +b('X')47 b(*/)95 3830 y(#define)f(TBYTE)381 b(11)95 b(/*)47 +b(8-bit)f(unsigned)g(byte,)332 b('B')47 b(*/)95 3942 +y(#define)f(TLOGICAL)237 b(14)95 b(/*)47 b(logicals)e(\(int)i(for)g +(keywords)236 b(*/)1289 4055 y(/*)95 b(and)46 b(char)h(for)g(table)f +(cols)142 b('L')47 b(*/)95 4168 y(#define)f(TSTRING)285 +b(16)95 b(/*)47 b(ASCII)f(string,)666 b('A')47 b(*/)95 +4281 y(#define)f(TSHORT)333 b(21)95 b(/*)47 b(signed)f(short,)666 +b('I')47 b(*/)95 4394 y(#define)f(TINT32BIT)189 b(41)95 +b(/*)47 b(signed)f(32-bit)g(int,)428 b('J')47 b(*/)95 +4507 y(#define)f(TLONG)381 b(41)95 b(/*)47 b(signed)f(long,)905 +b(*/)95 4620 y(#define)46 b(TFLOAT)333 b(42)95 b(/*)47 +b(single)f(precision)f(float,)189 b('E')47 b(*/)95 4733 +y(#define)f(TDOUBLE)285 b(82)95 b(/*)47 b(double)f(precision)f(float,) +189 b('D')47 b(*/)95 4846 y(#define)f(TCOMPLEX)237 b(83)95 +b(/*)47 b(complex)f(\(pair)g(of)h(floats\))141 b('C')47 +b(*/)95 4959 y(#define)f(TDBLCOMPLEX)f(163)95 b(/*)47 +b(double)f(complex)g(\(2)h(doubles\))e('M')i(*/)95 5185 +y(The)g(following)f(data)g(type)h(codes)f(are)h(also)g(supported)e(by)i +(CFITSIO:)95 5297 y(#define)f(TINT)429 b(31)95 b(/*)47 +b(int)1335 b(*/)95 5410 y(#define)46 b(TSBYTE)333 b(12)95 +b(/*)47 b(8-bit)f(signed)g(byte,)428 b('S')47 b(*/)95 +5523 y(#define)f(TUINT)381 b(30)95 b(/*)47 b(unsigned)e(int)715 +b('V')47 b(*/)95 5636 y(#define)f(TUSHORT)285 b(20)95 +b(/*)47 b(unsigned)e(short)619 b('U')95 b(*/)p eop +%%Page: 17 25 +17 24 bop 0 299 a Fh(4.2.)72 b(CURRENT)30 b(HEADER)h(D)m(A)-8 +b(T)g(A)32 b(UNIT)e(\(CHDU\))1786 b Fj(17)95 555 y Fe(#define)46 +b(TULONG)333 b(40)95 b(/*)47 b(unsigned)e(long)858 b(*/)95 +668 y(#define)46 b(TLONGLONG)189 b(81)95 b(/*)47 b(64-bit)f(long)h +(signed)f(integer)f('K')i(*/)0 894 y(HDU)g(type)g(code)f(values)g +(\(value)g(returned)g(when)h(moving)f(to)h(new)g(HDU\):)95 +1120 y(#define)f(IMAGE_HDU)93 b(0)i(/*)48 b(Primary)d(Array)i(or)g +(IMAGE)f(HDU)h(*/)95 1233 y(#define)f(ASCII_TBL)93 b(1)i(/*)48 +b(ASCII)94 b(table)46 b(HDU)h(*/)95 1346 y(#define)f(BINARY_TBL)f(2)95 +b(/*)48 b(Binary)e(table)g(HDU)h(*/)95 1458 y(#define)f(ANY_HDU)142 +b(-1)94 b(/*)48 b(matches)d(any)i(type)g(of)g(HDU)g(*/)0 +1684 y(Column)f(name)h(and)g(string)f(matching)f(case-sensitivity:)95 +1910 y(#define)h(CASESEN)142 b(1)g(/*)48 b(do)f(case-sensitive)d +(string)i(match)g(*/)95 2023 y(#define)g(CASEINSEN)g(0)142 +b(/*)48 b(do)f(case-insensitive)c(string)j(match)h(*/)0 +2249 y(Logical)f(states)g(\(if)h(TRUE)f(and)h(FALSE)g(are)g(not)g +(already)e(defined\):)95 2475 y(#define)h(TRUE)h(1)95 +2588 y(#define)f(FALSE)h(0)0 2813 y(Values)f(to)h(represent)f +(undefined)f(floating)g(point)i(numbers:)95 3039 y(#define)f +(FLOATNULLVALUE)e(-9.11912E-36F)95 3152 y(#define)i(DOUBLENULLVALUE)e +(-9.1191291391491E-36)0 3378 y(Image)i(compression)f(algorithm)g +(definitions)95 3604 y(#define)h(RICE_1)285 b(11)95 3717 +y(#define)46 b(GZIP_1)285 b(21)95 3830 y(#define)46 b(PLIO_1)285 +b(31)0 4306 y Ff(4.2)135 b(Curren)l(t)46 b(Header)f(Data)h(Unit)g +(\(CHDU\))0 4585 y Fj(The)37 b(concept)h(of)g(the)f(Curren)m(t)g +(Header)g(and)g(Data)i(Unit,)g(or)e(CHDU,)h(is)e(fundamen)m(tal)h(to)h +(the)f(use)g(of)h(the)0 4698 y(CFITSIO)31 b(library)-8 +b(.)44 b(A)32 b(simple)f(FITS)g(image)i(ma)m(y)g(only)e(con)m(tain)i(a) +f(single)f(Header)i(and)f(Data)h(unit)e(\(HDU\),)0 4811 +y(but)39 b(in)f(general)i(FITS)f(\014les)g(can)h(con)m(tain)g(m)m +(ultiple)e(Header)i(Data)h(Units)e(\(also)h(kno)m(wn)f(as)h +(`extensions'\),)0 4924 y(concatenated)c(one)f(after)f(the)h(other)f +(in)f(the)h(\014le.)52 b(The)33 b(user)h(can)g(sp)s(ecify)f(whic)m(h)g +(HDU)i(should)d(b)s(e)h(initially)0 5036 y(op)s(ened)j(at)i(run)d(time) +i(b)m(y)g(giving)f(the)h(HDU)h(name)f(or)g(n)m(um)m(b)s(er)f(after)h +(the)g(ro)s(ot)h(\014le)e(name.)60 b(F)-8 b(or)38 b(example,)0 +5149 y('m)m(y\014le.\014ts[4]')h(op)s(ens)e(the)h(5th)h(HDU)g(in)e(the) +h(\014le)f(\(note)i(that)g(the)f(n)m(um)m(b)s(ering)e(starts)j(with)e +(0\),)k(and)c('m)m(y-)0 5262 y(\014le.\014ts[EVENTS])j(op)s(ens)g(the)h +(HDU)h(with)d(the)i(name)g('EVENTS')g(\(as)g(de\014ned)f(b)m(y)h(the)g +(EXTNAME)g(or)0 5375 y(HDUNAME)35 b(k)m(eyw)m(ords\).)50 +b(If)33 b(no)g(HDU)h(is)e(sp)s(eci\014ed)g(then)h(CFITSIO)e(op)s(ens)i +(the)g(\014rst)g(HDU)h(\(the)g(primary)0 5488 y(arra)m(y\))24 +b(b)m(y)e(default.)38 b(The)22 b(CFITSIO)f(routines)h(whic)m(h)g(read)g +(and)g(write)h(data)g(only)f(op)s(erate)h(within)e(the)i(op)s(ened)0 +5601 y(HDU,)32 b(Other)e(CFITSIO)f(routines)h(are)h(pro)m(vided)e(to)j +(mo)m(v)m(e)g(to)f(and)f(op)s(en)g(an)m(y)h(other)g(existing)f(HDU)h +(within)0 5714 y(the)g(FITS)e(\014le)h(or)g(to)h(app)s(end)e(or)h +(insert)f(new)h(HDUs)h(in)e(the)i(FITS)f(\014le.)p eop +%%Page: 18 26 +18 25 bop 0 299 a Fj(18)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)0 555 y Ff(4.3)135 b(F)-11 +b(unction)44 b(Names)i(and)f(V)-11 b(ariable)46 b(Datat)l(yp)t(es)0 +806 y Fj(Most)33 b(of)f(the)g(CFITSIO)f(routines)g(ha)m(v)m(e)i(b)s +(oth)e(a)i(short)e(name)h(as)h(w)m(ell)e(as)h(a)g(longer)g(descriptiv)m +(e)f(name.)45 b(The)0 919 y(short)32 b(name)g(is)f(only)g(5)i(or)f(6)g +(c)m(haracters)h(long)f(and)g(is)f(similar)e(to)k(the)f(subroutine)e +(name)i(in)f(the)h(F)-8 b(ortran-77)0 1032 y(v)m(ersion)37 +b(of)h(FITSIO.)f(The)h(longer)f(name)h(is)f(more)h(descriptiv)m(e)f +(and)g(it)g(is)g(recommended)h(that)g(it)g(b)s(e)f(used)0 +1145 y(instead)30 b(of)g(the)h(short)f(name)g(to)h(more)g(clearly)f(do) +s(cumen)m(t)g(the)g(source)h(co)s(de.)0 1305 y(Man)m(y)c(of)f(the)g +(CFITSIO)f(routines)g(come)i(in)d(families)g(whic)m(h)h(di\013er)g +(only)g(in)g(the)h(data)h(t)m(yp)s(e)f(of)g(the)g(asso)s(ciated)0 +1418 y(parameter\(s\).)45 b(The)31 b(data)h(t)m(yp)s(e)g(of)g(these)g +(routines)e(is)h(indicated)f(b)m(y)h(the)h(su\016x)e(of)i(the)g +(routine)e(name.)44 b(The)0 1530 y(short)27 b(routine)g(names)h(ha)m(v) +m(e)h(a)f(1)g(or)f(2)h(c)m(haracter)i(su\016x)c(\(e.g.,)31 +b('j')c(in)g('\013pkyj'\))h(while)d(the)j(long)f(routine)g(names)0 +1643 y(ha)m(v)m(e)32 b(a)e(4)h(c)m(haracter)h(or)e(longer)g(su\016x)g +(as)g(sho)m(wn)g(in)f(the)i(follo)m(wing)e(table:)191 +1905 y Fe(Long)285 b(Short)94 b(Data)191 2018 y(Names)237 +b(Names)94 b(Type)191 2131 y(-----)237 b(-----)94 b(----)191 +2244 y(_bit)381 b(x)190 b(bit)191 2357 y(_byt)381 b(b)190 +b(unsigned)46 b(byte)191 2469 y(_sbyt)333 b(sb)142 b(signed)46 +b(byte)191 2582 y(_sht)381 b(i)190 b(short)47 b(integer)191 +2695 y(_lng)381 b(j)190 b(long)47 b(integer)191 2808 +y(_lnglng)237 b(jj)142 b(8-byte)46 b(LONGLONG)g(integer)g(\(see)g(note) +h(below\))191 2921 y(_usht)333 b(ui)142 b(unsigned)46 +b(short)g(integer)191 3034 y(_ulng)333 b(uj)142 b(unsigned)46 +b(long)g(integer)191 3147 y(_uint)333 b(uk)142 b(unsigned)46 +b(int)h(integer)191 3260 y(_int)381 b(k)190 b(int)47 +b(integer)191 3373 y(_flt)381 b(e)190 b(real)47 b(exponential)e +(floating)g(point)i(\(float\))191 3486 y(_fixflt)237 +b(f)190 b(real)47 b(fixed-decimal)d(format)i(floating)g(point)g +(\(float\))191 3599 y(_dbl)381 b(d)190 b(double)46 b(precision)g(real)g +(floating-point)e(\(double\))191 3711 y(_fixdbl)237 b(g)190 +b(double)46 b(precision)g(fixed-format)e(floating)i(point)g(\(double\)) +191 3824 y(_cmp)381 b(c)190 b(complex)46 b(reals)g(\(pairs)h(of)g +(float)f(values\))191 3937 y(_fixcmp)237 b(fc)142 b(complex)46 +b(reals,)g(fixed-format)f(floating)g(point)191 4050 y(_dblcmp)237 +b(m)190 b(double)46 b(precision)g(complex)f(\(pairs)i(of)g(double)f +(values\))191 4163 y(_fixdblcmp)93 b(fm)142 b(double)46 +b(precision)g(complex,)f(fixed-format)g(floating)g(point)191 +4276 y(_log)381 b(l)190 b(logical)46 b(\(int\))191 4389 +y(_str)381 b(s)190 b(character)46 b(string)0 4650 y Fj(The)32 +b(logical)g(data)i(t)m(yp)s(e)f(corresp)s(onds)e(to)j(`in)m(t')e(for)h +(logical)f(k)m(eyw)m(ord)h(v)-5 b(alues,)33 b(and)f(`b)m(yte')i(for)f +(logical)f(binary)0 4763 y(table)39 b(columns.)66 b(In)39 +b(other)g(w)m(ords,)i(the)f(v)-5 b(alue)38 b(when)h(writing)e(a)j +(logical)e(k)m(eyw)m(ord)i(m)m(ust)f(b)s(e)g(stored)g(in)f(an)0 +4876 y(`in)m(t')g(v)-5 b(ariable,)38 b(and)g(m)m(ust)f(b)s(e)g(stored)h +(in)f(a)h(`c)m(har')h(arra)m(y)f(when)f(reading)g(or)g(writing)f(to)j +(`L')f(columns)e(in)h(a)0 4989 y(binary)e(table.)59 b(Inplicit)34 +b(data)j(t)m(yp)s(e)f(con)m(v)m(ersion)h(is)f(not)h(supp)s(orted)d(for) +i(logical)g(table)h(columns,)g(but)f(is)f(for)0 5102 +y(k)m(eyw)m(ords,)30 b(so)f(a)h(logical)e(k)m(eyw)m(ord)i(ma)m(y)f(b)s +(e)g(read)f(and)h(cast)h(to)g(an)m(y)f(n)m(umerical)f(data)h(t)m(yp)s +(e;)h(a)g(returned)d(v)-5 b(alue)0 5215 y(=)30 b(0)h(indicates)e +(false,)h(and)g(an)m(y)h(other)f(v)-5 b(alue)30 b(=)g(true.)0 +5375 y(The)37 b(`in)m(t')h(data)g(t)m(yp)s(e)g(ma)m(y)g(b)s(e)f(2)h(b)m +(ytes)h(long)e(on)g(some)h(IBM)h(PC)e(compatible)g(systems)g(and)g(is)g +(usually)f(4)0 5488 y(b)m(ytes)27 b(long)f(on)h(most)g(other)g +(systems.)39 b(Some)27 b(64-bit)g(mac)m(hines,)g(ho)m(w)m(ev)m(er,)i +(lik)m(e)d(the)h(Dec)h(Alpha/OSF,)e(de\014ne)0 5601 y(the)j(`short',)h +(`in)m(t',)g(and)e(`long')h(in)m(teger)h(data)g(t)m(yp)s(es)f(to)h(b)s +(e)e(2,)i(4,)g(and)f(8)g(b)m(ytes)h(long,)f(resp)s(ectiv)m(ely)-8 +b(.)40 b(The)29 b(FITS)0 5714 y(standard)j(only)g(supp)s(orts)g(2)h +(and)g(4)g(b)m(yte)h(in)m(teger)f(data)h(t)m(yp)s(es,)g(so)f(CFITSIO)f +(in)m(ternally)f(con)m(v)m(erts)j(b)s(et)m(w)m(een)p +eop +%%Page: 19 27 +19 26 bop 0 299 a Fh(4.4.)72 b(SUPPOR)-8 b(T)30 b(F)m(OR)g(UNSIGNED)h +(INTEGERS)f(AND)h(SIGNED)f(BYTES)942 b Fj(19)0 555 y(4)31 +b(and)f(8)g(b)m(ytes)h(when)f(reading)f(or)h(writing)f(`long')h(in)m +(tegers)h(on)f(Alpha/OSF)f(systems.)0 715 y(The)e(8-b)m(yte)i +('LONGLONG')f(in)m(teger)g(data)g(t)m(yp)s(e)g(is)e(supp)s(orted)g(on)i +(most)f(platforms.)39 b(CFITSIO)26 b(de\014nes)h(the)0 +828 y(LONGLONG)i(data)g(t)m(yp)s(e)g(to)h(b)s(e)e(equiv)-5 +b(alen)m(t)29 b(to)g('long)g(long')g(on)f(most)i(Unix)d(platforms)h +(and)g(on)h(Mac)h(OS-X.)0 941 y(Since)36 b(most)i(Windo)m(ws)e +(compilers)g(don't)h(supp)s(ort)e(the)j('long)f(long')g(data)g(t)m(yp)s +(e,)j(LONGLONG)d(is)f(de\014ned)0 1054 y(instead)e(to)h(b)s(e)f(equiv) +-5 b(alen)m(t)33 b(to)i(')p 1141 1054 28 4 v 1175 1054 +V 66 w(in)m(t64'.)54 b(If)34 b(the)g(compiler)f(do)s(es)h(not)h(supp)s +(ort)d(a)j(8-b)m(yte)h(in)m(teger)f(data)g(t)m(yp)s(e)0 +1167 y(then)d(LONGLONG)h(is)f(de\014ned)f(to)i(b)s(e)f(equiv)-5 +b(alen)m(t)33 b(to)g('long'.)48 b(Note)34 b(that)f(the)g(C)f(format)h +(sp)s(eci\014er)e(to)i(prin)m(t)0 1280 y(out)38 b(these)g(long)g(in)m +(teger)g(v)-5 b(alues)37 b(is)g("\045lld")g(on)h(most)g(unix)e(mac)m +(hines,)k(except)e(on)g(OSF)g(platforms)e(where)0 1393 +y("\045ld")d(m)m(ust)g(b)s(e)f(used.)49 b(On)32 b(Windo)m(ws)g +(platform)h(that)g(ha)m(v)m(e)i(the)p 2385 1393 V 2417 +1393 V 99 w(in)m(t64)e(data)h(t)m(yp)s(e,)h(the)e(format)h(sp)s +(eci\014er)0 1506 y(is)29 b("\045INT64d".)0 1666 y(When)23 +b(dealing)f(with)g(the)i(FITS)f(b)m(yte)h(data)g(t)m(yp)s(e)f(it)g(is)g +(imp)s(ortan)m(t)f(to)i(remem)m(b)s(er)f(that)h(the)g(ra)m(w)f(v)-5 +b(alues)23 b(\(b)s(efore)0 1779 y(an)m(y)i(scaling)e(b)m(y)h(the)h +(BSCALE)e(and)h(BZER)m(O,)g(or)h(TSCALn)d(and)i(TZER)m(On)f(k)m(eyw)m +(ord)i(v)-5 b(alues\))24 b(in)f(b)m(yte)i(arra)m(ys)0 +1892 y(\(BITPIX)37 b(=)f(8\))h(or)f(b)m(yte)i(columns)d(\(TF)m(ORMn)i +(=)f('B'\))h(are)g(in)m(terpreted)f(as)h(unsigned)d(b)m(ytes)j(with)f +(v)-5 b(alues)0 2005 y(ranging)33 b(from)h(0)g(to)h(255.)53 +b(Some)34 b(C)g(compilers)f(de\014ne)g(a)h('c)m(har')h(v)-5 +b(ariable)33 b(as)i(signed,)f(so)g(it)g(is)f(imp)s(ortan)m(t)g(to)0 +2118 y(explicitly)28 b(declare)i(a)h(n)m(umeric)e(c)m(har)i(v)-5 +b(ariable)29 b(as)i('unsigned)d(c)m(har')j(to)g(a)m(v)m(oid)g(an)m(y)g +(am)m(biguit)m(y)0 2278 y(One)22 b(feature)h(of)g(the)g(CFITSIO)e +(routines)h(is)f(that)j(they)f(can)g(op)s(erate)g(on)f(a)h(`X')h +(\(bit\))e(column)g(in)f(a)i(binary)e(table)0 2391 y(as)33 +b(though)f(it)g(w)m(ere)h(a)g(`B')g(\(b)m(yte\))h(column.)46 +b(F)-8 b(or)33 b(example)f(a)h(`11X')h(data)f(t)m(yp)s(e)g(column)e +(can)i(b)s(e)f(in)m(terpreted)0 2503 y(the)c(same)h(as)f(a)g(`2B')i +(column)d(\(i.e.,)i(2)f(unsigned)e(8-bit)i(b)m(ytes\).)41 +b(In)27 b(some)i(instances,)f(it)f(can)i(b)s(e)e(more)h(e\016cien)m(t)0 +2616 y(to)j(read)f(and)g(write)g(whole)f(b)m(ytes)i(at)g(a)g(time,)f +(rather)h(than)f(reading)f(or)i(writing)d(eac)m(h)k(individual)25 +b(bit.)0 2777 y(The)36 b(complex)h(and)f(double)g(precision)f(complex)i +(data)h(t)m(yp)s(es)f(are)g(not)g(directly)f(supp)s(orted)f(in)h(ANSI)g +(C)h(so)0 2889 y(these)g(data)g(t)m(yp)s(es)f(should)e(b)s(e)i(in)m +(terpreted)g(as)g(pairs)f(of)i(\015oat)g(or)f(double)f(v)-5 +b(alues,)37 b(resp)s(ectiv)m(ely)-8 b(,)38 b(where)e(the)0 +3002 y(\014rst)30 b(v)-5 b(alue)29 b(in)h(eac)m(h)h(pair)e(is)h(the)g +(real)g(part,)h(and)e(the)i(second)f(is)g(the)g(imaginary)f(part.)0 +3470 y Ff(4.4)135 b(Supp)t(ort)44 b(for)h(Unsigned)h(In)l(tegers)g(and) +f(Signed)g(Bytes)0 3747 y Fj(Although)32 b(FITS)g(do)s(es)g(not)h +(directly)f(supp)s(ort)f(unsigned)f(in)m(tegers)j(as)g(one)g(of)g(its)g +(fundamen)m(tal)e(data)j(t)m(yp)s(es,)0 3860 y(FITS)27 +b(can)h(still)e(b)s(e)h(used)g(to)i(e\016cien)m(tly)f(store)g(unsigned) +e(in)m(teger)i(data)h(v)-5 b(alues)27 b(in)g(images)h(and)f(binary)f +(tables.)0 3973 y(The)42 b(con)m(v)m(en)m(tion)i(used)e(in)f(FITS)h +(\014les)g(is)f(to)j(store)f(the)g(unsigned)d(in)m(tegers)j(as)g +(signed)f(in)m(tegers)h(with)e(an)0 4086 y(asso)s(ciated)33 +b(o\013set)g(\(sp)s(eci\014ed)e(b)m(y)h(the)g(BZER)m(O)g(or)g(TZER)m +(On)f(k)m(eyw)m(ord\).)47 b(F)-8 b(or)33 b(example,)f(to)h(store)g +(unsigned)0 4199 y(16-bit)f(in)m(teger)g(v)-5 b(alues)31 +b(in)f(a)i(FITS)f(image)h(the)f(image)h(w)m(ould)f(b)s(e)f(de\014ned)h +(as)h(a)g(signed)e(16-bit)i(in)m(teger)g(\(with)0 4312 +y(BITPIX)d(k)m(eyw)m(ord)g(=)g(SHOR)-8 b(T)p 1132 4312 +V 32 w(IMG)30 b(=)e(16\))j(with)c(the)j(k)m(eyw)m(ords)f(BSCALE)f(=)h +(1.0)h(and)f(BZER)m(O)g(=)f(32768.)0 4425 y(Th)m(us)34 +b(the)h(unsigned)e(v)-5 b(alues)34 b(of)h(0,)i(32768,)h(and)d(65535,)j +(for)d(example,)h(are)f(ph)m(ysically)e(stored)i(in)f(the)h(FITS)0 +4538 y(image)k(as)f(-32768,)43 b(0,)e(and)d(32767,)k(resp)s(ectiv)m +(ely;)g(CFITSIO)37 b(automatically)h(adds)f(the)i(BZER)m(O)f(o\013set)h +(to)0 4650 y(these)g(v)-5 b(alues)38 b(when)g(they)g(are)h(read.)65 +b(Similarly)-8 b(,)38 b(in)f(the)i(case)h(of)e(unsigned)f(32-bit)i(in)m +(tegers)f(the)h(BITPIX)0 4763 y(k)m(eyw)m(ord)c(w)m(ould)e(b)s(e)h +(equal)g(to)i(LONG)p 1392 4763 V 32 w(IMG)f(=)g(32)g(and)f(BZER)m(O)g +(w)m(ould)g(b)s(e)g(equal)g(to)h(2147483648)k(\(i.e.)54 +b(2)0 4876 y(raised)29 b(to)i(the)g(31st)g(p)s(o)m(w)m(er\).)0 +5036 y(The)j(CFITSIO)g(in)m(terface)h(routines)f(will)e(e\016cien)m +(tly)j(and)f(transparen)m(tly)h(apply)e(the)i(appropriate)f(o\013set)i +(in)0 5149 y(these)29 b(cases)h(so)f(in)f(general)h(application)e +(programs)i(do)g(not)g(need)f(to)i(b)s(e)e(concerned)h(with)f(ho)m(w)h +(the)g(unsigned)0 5262 y(v)-5 b(alues)43 b(are)i(actually)f(stored)g +(in)e(the)j(FITS)e(\014le.)81 b(As)44 b(a)g(con)m(v)m(enience)i(for)d +(users,)k(CFITSIO)c(has)h(sev)m(eral)0 5375 y(prede\014ned)19 +b(constan)m(ts)j(for)f(the)g(v)-5 b(alue)20 b(of)h(BITPIX)g(\(USHOR)-8 +b(T)p 2189 5375 V 33 w(IMG,)21 b(ULONG)p 2790 5375 V +33 w(IMG\))h(and)e(for)h(the)g(TF)m(ORMn)0 5488 y(v)-5 +b(alue)35 b(in)f(the)i(case)g(of)g(binary)e(tables)h(\(`U')i(and)e +(`V'\))h(whic)m(h)e(programmers)h(can)h(use)f(when)g(creating)h(FITS)0 +5601 y(\014les)i(con)m(taining)g(unsigned)f(in)m(teger)i(v)-5 +b(alues.)65 b(The)39 b(follo)m(wing)e(co)s(de)i(fragmen)m(t)g +(illustrates)e(ho)m(w)i(to)h(write)e(a)0 5714 y(FITS)30 +b(1-D)h(primary)e(arra)m(y)h(of)h(unsigned)d(16-bit)j(in)m(tegers:)p +eop +%%Page: 20 28 +20 27 bop 0 299 a Fj(20)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)286 555 y Fe(unsigned)46 +b(short)g(uarray[100];)286 668 y(int)h(naxis,)f(status;)286 +781 y(long)h(naxes[10],)e(group,)h(firstelem,)f(nelements;)334 +894 y(...)286 1007 y(status)h(=)i(0;)286 1120 y(naxis)f(=)g(1;)286 +1233 y(naxes[0])f(=)h(100;)286 1346 y(fits_create_img\(fptr,)42 +b(USHORT_IMG,)j(naxis,)h(naxes,)g(&status\);)286 1571 +y(firstelem)g(=)h(1;)286 1684 y(nelements)f(=)h(100;)286 +1797 y(fits_write_img\(fptr,)c(TUSHORT,)i(firstelem,)g(nelements,)1241 +1910 y(uarray,)h(&status\);)334 2023 y(...)0 2264 y Fj(In)40 +b(the)h(ab)s(o)m(v)m(e)i(example,)g(the)f(2nd)e(parameter)h(in)f +(\014ts)p 1998 2264 28 4 v 33 w(create)p 2267 2264 V +34 w(img)g(tells)g(CFITSIO)g(to)i(write)e(the)h(header)0 +2377 y(k)m(eyw)m(ords)34 b(appropriate)f(for)g(an)g(arra)m(y)i(of)e +(16-bit)h(unsigned)e(in)m(tegers)i(\(i.e.,)h(BITPIX)e(=)g(16)i(and)e +(BZER)m(O)g(=)0 2490 y(32768\).)41 b(Then)23 b(the)h(\014ts)p +834 2490 V 32 w(write)p 1069 2490 V 32 w(img)g(routine)f(writes)f(the)j +(arra)m(y)f(of)g(unsigned)e(short)h(in)m(tegers)h(\(uarra)m(y\))h(in)m +(to)f(the)0 2603 y(primary)f(arra)m(y)i(of)g(the)g(FITS)f(\014le.)38 +b(Similarly)-8 b(,)23 b(a)i(32-bit)h(unsigned)c(in)m(teger)j(image)h +(ma)m(y)f(b)s(e)f(created)i(b)m(y)f(setting)0 2716 y(the)34 +b(second)f(parameter)h(in)e(\014ts)p 1130 2716 V 33 w(create)p +1399 2716 V 34 w(img)h(equal)g(to)h(`ULONG)p 2330 2716 +V 33 w(IMG')g(and)f(b)m(y)h(calling)d(the)j(\014ts)p +3491 2716 V 33 w(write)p 3727 2716 V 32 w(img)0 2829 +y(routine)i(with)f(the)i(second)f(parameter)h(=)f(TULONG)h(to)g(write)f +(the)g(arra)m(y)h(of)g(unsigned)e(long)h(image)h(pixel)0 +2942 y(v)-5 b(alues.)0 3102 y(An)27 b(analogous)g(set)g(of)g(routines)f +(are)h(a)m(v)-5 b(ailable)27 b(for)f(reading)g(or)h(writing)e(unsigned) +g(in)m(teger)i(v)-5 b(alues)27 b(and)f(signed)0 3215 +y(b)m(yte)i(v)-5 b(alues)27 b(in)g(a)h(FITS)f(binary)f(table)i +(extension.)39 b(When)28 b(sp)s(ecifying)d(the)j(TF)m(ORMn)g(k)m(eyw)m +(ord)g(v)-5 b(alue)27 b(whic)m(h)0 3328 y(de\014nes)36 +b(the)h(format)g(of)g(a)h(column,)f(CFITSIO)e(recognized)j(3)f +(additional)e(data)i(t)m(yp)s(e)g(co)s(des)g(b)s(esides)e(those)0 +3440 y(already)29 b(de\014ned)g(in)f(the)i(FITS)f(standard:)40 +b(`U')30 b(meaning)f(a)h(16-bit)g(unsigned)e(in)m(teger)i(column,)f +(`V')h(for)g(a)g(32-)0 3553 y(bit)25 b(unsigned)e(in)m(teger)j(column,) +g(and)f('S')g(for)g(a)h(signed)f(b)m(yte)h(column.)38 +b(These)25 b(non-standard)g(data)h(t)m(yp)s(e)g(co)s(des)0 +3666 y(are)36 b(not)g(actually)g(written)f(in)m(to)g(the)h(FITS)g +(\014le)e(but)i(instead)f(are)h(just)f(used)g(in)m(ternally)f(within)f +(CFITSIO.)0 3779 y(The)d(follo)m(wing)f(co)s(de)h(fragmen)m(t)h +(illustrates)e(ho)m(w)h(to)h(use)f(these)h(features:)286 +4020 y Fe(unsigned)46 b(short)g(uarray[100];)286 4133 +y(unsigned)g(int)95 b(varray[100];)286 4359 y(int)47 +b(colnum,)f(tfields,)g(status;)286 4472 y(long)h(nrows,)f(firstrow,)f +(firstelem,)g(nelements,)g(pcount;)286 4698 y(char)i(extname[])e(=)j +("Test_table";)521 b(/*)47 b(extension)f(name)g(*/)286 +4924 y(/*)i(define)e(the)h(name,)f(data)h(type,)f(and)h(physical)e +(units)i(for)g(the)g(2)g(columns)f(*/)286 5036 y(char)h(*ttype[])f(=)h +({)g("Col_1",)f("Col_2",)g("Col_3")f(};)286 5149 y(char)i(*tform[])f(=) +h({)g("1U",)285 b("1V",)190 b("1S"};)94 b(/*)47 b(special)f(CFITSIO)g +(codes)g(*/)286 5262 y(char)h(*tunit[])f(=)h({)g(")h(",)381 +b(")48 b(",)190 b(")47 b(")h(};)334 5375 y(...)525 5601 +y(/*)f(write)g(the)f(header)h(keywords)e(*/)286 5714 +y(status)94 b(=)48 b(0;)p eop +%%Page: 21 29 +21 28 bop 0 299 a Fh(4.5.)72 b(DEALING)31 b(WITH)f(CHARA)m(CTER)g +(STRINGS)1816 b Fj(21)286 555 y Fe(nrows)142 b(=)48 b(1;)286 +668 y(tfields)e(=)i(3)286 781 y(pcount)94 b(=)48 b(0;)286 +894 y(fits_create_tbl\(fptr,)42 b(BINARY_TBL,)j(nrows,)h(tfields,)g +(ttype,)g(tform,)764 1007 y(tunit,)g(extname,)f(&status\);)525 +1233 y(/*)i(write)g(the)f(unsigned)g(shorts)g(to)h(the)g(1st)g(column)f +(*/)286 1346 y(colnum)190 b(=)47 b(1;)286 1458 y(firstrow)94 +b(=)47 b(1;)286 1571 y(firstelem)f(=)h(1;)286 1684 y(nelements)f(=)h +(100;)286 1797 y(fits_write_col\(fptr,)c(TUSHORT,)i(colnum,)h +(firstrow,)f(firstelem,)668 1910 y(nelements,)g(uarray,)h(&status\);) +525 2136 y(/*)h(now)g(write)f(the)h(unsigned)f(longs)g(to)h(the)g(2nd)g +(column)f(*/)286 2249 y(colnum)190 b(=)47 b(2;)286 2362 +y(fits_write_col\(fptr,)c(TUINT,)j(colnum,)g(firstrow,)f(firstelem,)668 +2475 y(nelements,)g(varray,)h(&status\);)334 2588 y(...)0 +2865 y Fj(Note)22 b(that)g(the)f(non-standard)f(TF)m(ORM)h(v)-5 +b(alues)20 b(for)h(the)g(3)g(columns,)h(`U')f(and)g(`V',)h(tell)e +(CFITSIO)f(to)j(write)e(the)0 2978 y(k)m(eyw)m(ords)27 +b(appropriate)e(for)h(unsigned)e(16-bit)j(and)e(unsigned)g(32-bit)h(in) +m(tegers,)i(resp)s(ectiv)m(ely)d(\(i.e.,)j(TF)m(ORMn)0 +3091 y(=)39 b('1I')i(and)e(TZER)m(On)f(=)h(32678)j(for)e(unsigned)d +(16-bit)j(in)m(tegers,)j(and)c(TF)m(ORMn)h(=)f('1J')h(and)f(TZER)m(On)0 +3204 y(=)c(2147483648)40 b(for)35 b(unsigned)e(32-bit)i(in)m(tegers\).) +56 b(The)35 b('S')g(TF)m(ORMn)g(v)-5 b(alue)35 b(tells)g(CFITSIO)e(to)j +(write)f(the)0 3317 y(k)m(eyw)m(ords)30 b(appropriate)f(for)h(a)g +(signed)f(8-bit)h(b)m(yte)g(column)f(with)f(TF)m(ORMn)i(=)g('1B')h(and) +e(TZER)m(On)g(=)g(-128.)0 3430 y(The)h(calls)f(to)j(\014ts)p +628 3430 28 4 v 32 w(write)p 863 3430 V 32 w(col)e(then)g(write)g(the)h +(arra)m(ys)f(of)h(unsigned)d(in)m(teger)j(v)-5 b(alues)30 +b(to)h(the)f(columns.)0 3784 y Ff(4.5)135 b(Dealing)47 +b(with)e(Character)h(Strings)0 4039 y Fj(The)36 b(c)m(haracter)j +(string)c(v)-5 b(alues)37 b(in)e(a)i(FITS)f(header)h(or)g(in)e(an)i +(ASCI)s(I)e(column)h(in)f(a)j(FITS)e(table)g(extension)0 +4152 y(are)j(generally)g(padded)f(out)h(with)f(non-signi\014can)m(t)g +(space)h(c)m(haracters)i(\(ASCI)s(I)d(32\))i(to)g(\014ll)d(up)h(the)h +(header)0 4264 y(record)33 b(or)h(the)f(column)g(width.)48 +b(When)33 b(reading)g(a)h(FITS)e(string)h(v)-5 b(alue,)34 +b(the)f(CFITSIO)f(routines)h(will)d(strip)0 4377 y(o\013)38 +b(these)f(non-signi\014can)m(t)f(trailing)f(spaces)i(and)g(will)d +(return)i(a)i(n)m(ull-terminated)d(string)h(v)-5 b(alue)36 +b(con)m(taining)0 4490 y(only)d(the)h(signi\014can)m(t)e(c)m +(haracters.)52 b(Leading)33 b(spaces)h(in)f(a)h(FITS)f(string)f(are)i +(considered)f(signi\014can)m(t.)50 b(If)33 b(the)0 4603 +y(string)h(con)m(tains)h(all)f(blanks,)h(then)f(CFITSIO)g(will)e +(return)i(a)h(single)e(blank)h(c)m(haracter,)k(i.e,)e(the)f(\014rst)f +(blank)0 4716 y(is)29 b(considered)f(to)j(b)s(e)e(signi\014can)m(t,)g +(since)g(it)g(distinguishes)e(the)j(string)e(from)i(a)g(n)m(ull)d(or)j +(unde\014ned)e(string,)h(but)0 4829 y(the)i(remaining)d(trailing)g +(spaces)j(are)g(not)g(signi\014can)m(t.)0 4989 y(Similarly)-8 +b(,)37 b(when)g(writing)f(string)h(v)-5 b(alues)37 b(to)i(a)g(FITS)e +(\014le)g(the)h(CFITSIO)f(routines)g(exp)s(ect)h(to)h(get)g(a)g(n)m +(ull-)0 5102 y(terminated)32 b(string)g(as)h(input;)f(CFITSIO)f(will)f +(pad)i(the)h(string)f(with)f(blanks)g(if)h(necessary)h(when)f(writing)e +(it)0 5215 y(to)h(the)g(FITS)e(\014le.)0 5375 y(When)j(calling)f +(CFITSIO)g(routines)h(that)h(return)e(a)i(c)m(haracter)h(string)e(it)g +(is)f(vital)h(that)h(the)g(size)f(of)h(the)g(c)m(har)0 +5488 y(arra)m(y)38 b(b)s(e)g(large)g(enough)f(to)i(hold)d(the)i(en)m +(tire)g(string)f(of)h(c)m(haracters,)k(otherwise)37 b(CFITSIO)f(will)f +(o)m(v)m(erwrite)0 5601 y(whatev)m(er)g(memory)e(lo)s(cations)g(follo)m +(w)g(the)h(c)m(har)h(arra)m(y)-8 b(,)35 b(p)s(ossibly)c(causing)i(the)h +(program)g(to)g(execute)h(incor-)0 5714 y(rectly)-8 b(.)41 +b(This)29 b(t)m(yp)s(e)h(of)h(error)f(can)h(b)s(e)f(di\016cult)e(to)j +(debug,)f(so)h(programmers)f(should)e(alw)m(a)m(ys)j(ensure)f(that)h +(the)p eop +%%Page: 22 30 +22 29 bop 0 299 a Fj(22)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)0 555 y Fj(c)m(har)27 +b(arra)m(ys)g(are)g(allo)s(cated)g(enough)f(space)i(to)f(hold)f(the)g +(longest)h(p)s(ossible)e(string,)h Fi(including)i Fj(the)f(terminat-)0 +668 y(ing)j(NULL)h(c)m(haracter.)45 b(The)30 b(\014tsio.h)g(\014le)h +(con)m(tains)g(the)g(follo)m(wing)f(de\014ned)g(constan)m(ts)i(whic)m +(h)e(programmers)0 781 y(are)h(strongly)f(encouraged)h(to)g(use)f +(whenev)m(er)g(they)h(are)f(allo)s(cating)g(space)h(for)f(c)m(har)h +(arra)m(ys:)0 1025 y Fe(#define)46 b(FLEN_FILENAME)e(1025)j(/*)g(max)g +(length)f(of)h(a)g(filename)f(*/)0 1138 y(#define)g(FLEN_KEYWORD)140 +b(72)95 b(/*)47 b(max)g(length)f(of)h(a)g(keyword)94 +b(*/)0 1251 y(#define)46 b(FLEN_CARD)284 b(81)95 b(/*)47 +b(length)f(of)h(a)h(FITS)e(header)g(card)h(*/)0 1364 +y(#define)f(FLEN_VALUE)236 b(71)95 b(/*)47 b(max)g(length)f(of)h(a)g +(keyword)f(value)h(string)f(*/)0 1477 y(#define)g(FLEN_COMMENT)140 +b(73)95 b(/*)47 b(max)g(length)f(of)h(a)g(keyword)f(comment)g(string)g +(*/)0 1590 y(#define)g(FLEN_ERRMSG)188 b(81)95 b(/*)47 +b(max)g(length)f(of)h(a)g(CFITSIO)f(error)h(message)e(*/)0 +1703 y(#define)h(FLEN_STATUS)188 b(31)95 b(/*)47 b(max)g(length)f(of)h +(a)g(CFITSIO)f(status)g(text)h(string)f(*/)0 1947 y Fj(F)-8 +b(or)23 b(example,)g(when)e(declaring)g(a)h(c)m(har)g(arra)m(y)h(to)f +(hold)f(the)h(v)-5 b(alue)21 b(string)g(of)h(FITS)f(k)m(eyw)m(ord,)k +(use)c(the)h(follo)m(wing)0 2060 y(statemen)m(t:)191 +2304 y Fe(char)47 b(value[FLEN_VALUE];)0 2548 y Fj(Note)41 +b(that)f(FLEN)p 686 2548 28 4 v 33 w(KEYW)m(ORD)g(is)e(longer)h(than)g +(needed)g(for)g(the)h(nominal)d(8-c)m(haracter)42 b(k)m(eyw)m(ord)e +(name)0 2661 y(b)s(ecause)30 b(the)h(HIERAR)m(CH)f(con)m(v)m(en)m(tion) +i(supp)s(orts)c(longer)i(k)m(eyw)m(ord)h(names.)0 2992 +y Ff(4.6)135 b(Implicit)46 b(Data)g(T)l(yp)t(e)f(Con)l(v)l(ersion)0 +3242 y Fj(The)29 b(CFITSIO)e(routines)h(that)i(read)f(and)f(write)h(n)m +(umerical)e(data)j(can)g(p)s(erform)d(implicit)f(data)k(t)m(yp)s(e)f +(con)m(v)m(er-)0 3355 y(sion.)38 b(This)24 b(means)i(that)g(the)g(data) +g(t)m(yp)s(e)g(of)g(the)g(v)-5 b(ariable)24 b(or)i(arra)m(y)g(in)e(the) +i(program)g(do)s(es)f(not)h(need)f(to)i(b)s(e)e(the)0 +3468 y(same)g(as)f(the)h(data)g(t)m(yp)s(e)g(of)f(the)h(v)-5 +b(alue)24 b(in)f(the)h(FITS)g(\014le.)38 b(Data)26 b(t)m(yp)s(e)f(con)m +(v)m(ersion)f(is)g(supp)s(orted)e(for)i(n)m(umerical)0 +3581 y(and)37 b(string)f(data)h(t)m(yp)s(es)h(\(if)e(the)h(string)f +(con)m(tains)i(a)f(v)-5 b(alid)36 b(n)m(um)m(b)s(er)g(enclosed)g(in)g +(quotes\))i(when)e(reading)h(a)0 3694 y(FITS)30 b(header)h(k)m(eyw)m +(ord)g(v)-5 b(alue)30 b(and)g(for)h(n)m(umeric)f(v)-5 +b(alues)30 b(when)g(reading)g(or)g(writing)f(v)-5 b(alues)30 +b(in)g(the)h(primary)0 3807 y(arra)m(y)24 b(or)g(a)h(table)e(column.)38 +b(CFITSIO)22 b(returns)h(status)h(=)f(NUM)p 2267 3807 +V 34 w(O)m(VERFLO)m(W)i(if)d(the)i(con)m(v)m(erted)i(data)e(v)-5 +b(alue)0 3920 y(exceeds)33 b(the)g(range)g(of)g(the)f(output)g(data)i +(t)m(yp)s(e.)47 b(Implicit)30 b(data)j(t)m(yp)s(e)g(con)m(v)m(ersion)g +(is)e(not)i(supp)s(orted)d(within)0 4032 y(binary)f(tables)h(for)g +(string,)f(logical,)i(complex,)f(or)g(double)f(complex)h(data)h(t)m(yp) +s(es.)0 4193 y(In)g(addition,)f(an)m(y)h(table)g(column)f(ma)m(y)i(b)s +(e)f(read)g(as)h(if)e(it)h(con)m(tained)g(string)f(v)-5 +b(alues.)43 b(In)31 b(the)g(case)i(of)e(n)m(umeric)0 +4306 y(columns)e(the)i(returned)e(string)g(will)f(b)s(e)i(formatted)h +(using)d(the)j(TDISPn)e(displa)m(y)g(format)h(if)g(it)g(exists.)0 +4637 y Ff(4.7)135 b(Data)46 b(Scaling)0 4887 y Fj(When)38 +b(reading)e(n)m(umerical)h(data)h(v)-5 b(alues)37 b(in)f(the)i(primary) +e(arra)m(y)i(or)g(a)g(table)g(column,)h(the)e(v)-5 b(alues)37 +b(will)f(b)s(e)0 5000 y(scaled)h(automatically)h(b)m(y)f(the)g(BSCALE)g +(and)g(BZER)m(O)g(\(or)h(TSCALn)e(and)h(TZER)m(On\))f(header)h(v)-5 +b(alues)37 b(if)0 5113 y(they)31 b(are)f(presen)m(t)h(in)e(the)h +(header.)41 b(The)30 b(scaled)g(data)h(that)g(is)e(returned)h(to)h(the) +f(reading)g(program)g(will)e(ha)m(v)m(e)382 5357 y Fe(output)46 +b(value)g(=)i(\(FITS)e(value\))g(*)i(BSCALE)e(+)h(BZERO)0 +5601 y Fj(\(a)30 b(corresp)s(onding)d(form)m(ula)h(using)g(TSCALn)f +(and)i(TZER)m(On)e(is)h(used)h(when)f(reading)g(from)h(table)g +(columns\).)0 5714 y(In)i(the)i(case)g(of)f(in)m(teger)g(output)g(v)-5 +b(alues)31 b(the)i(\015oating)f(p)s(oin)m(t)f(scaled)g(v)-5 +b(alue)32 b(is)f(truncated)h(to)h(an)f(in)m(teger)g(\(not)p +eop +%%Page: 23 31 +23 30 bop 0 299 a Fh(4.8.)72 b(SUPPOR)-8 b(T)30 b(F)m(OR)g(IEEE)g +(SPECIAL)f(V)-10 b(ALUES)1863 b Fj(23)0 555 y(rounded)35 +b(to)j(the)f(nearest)h(in)m(teger\).)61 b(The)36 b(\014ts)p +1673 555 28 4 v 32 w(set)p 1816 555 V 34 w(bscale)h(and)f(\014ts)p +2430 555 V 32 w(set)p 2573 555 V 34 w(tscale)h(routines)f(\(describ)s +(ed)f(in)h(the)0 668 y(`Adv)-5 b(anced')29 b(c)m(hapter\))h(ma)m(y)g(b) +s(e)e(used)h(to)g(o)m(v)m(erride)h(the)f(scaling)f(parameters)h +(de\014ned)f(in)g(the)h(header)g(\(e.g.,)i(to)0 781 y(turn)e(o\013)i +(the)g(scaling)e(so)i(that)g(the)f(program)g(can)h(read)f(the)h(ra)m(w) +f(unscaled)g(v)-5 b(alues)29 b(from)h(the)h(FITS)e(\014le\).)0 +941 y(When)44 b(writing)f(n)m(umerical)g(data)i(to)g(the)g(primary)e +(arra)m(y)i(or)f(to)h(a)g(table)g(column)e(the)i(data)g(v)-5 +b(alues)44 b(will)0 1054 y(generally)27 b(b)s(e)h(automatically)g(in)m +(v)m(ersely)g(scaled)g(b)m(y)g(the)g(v)-5 b(alue)28 b(of)g(the)h +(BSCALE)e(and)h(BZER)m(O)g(\(or)h(TSCALn)0 1167 y(and)35 +b(TZER)m(On\))f(k)m(eyw)m(ord)i(v)-5 b(alues)34 b(if)h(they)g(they)g +(exist)h(in)e(the)h(header.)55 b(These)35 b(k)m(eyw)m(ords)h(m)m(ust)f +(ha)m(v)m(e)i(b)s(een)0 1280 y(written)30 b(to)i(the)g(header)f(b)s +(efore)g(an)m(y)g(data)h(is)f(written)f(for)h(them)g(to)h(ha)m(v)m(e)h +(an)m(y)e(immediate)g(e\013ect.)45 b(One)30 b(ma)m(y)0 +1393 y(also)g(use)h(the)f(\014ts)p 623 1393 V 33 w(set)p +767 1393 V 33 w(bscale)h(and)e(\014ts)p 1367 1393 V 33 +w(set)p 1511 1393 V 33 w(tscale)i(routines)f(to)h(de\014ne)f(or)g(o)m +(v)m(erride)h(the)g(scaling)e(k)m(eyw)m(ords)i(in)0 1506 +y(the)e(header)g(\(e.g.,)i(to)e(turn)f(o\013)h(the)g(scaling)f(so)h +(that)h(the)f(program)f(can)h(write)f(the)h(ra)m(w)g(unscaled)f(v)-5 +b(alues)28 b(in)m(to)0 1619 y(the)e(FITS)g(\014le\).)39 +b(If)25 b(scaling)g(is)h(p)s(erformed,)f(the)i(in)m(v)m(erse)f(scaled)g +(output)f(v)-5 b(alue)26 b(that)h(is)e(written)g(in)m(to)h(the)h(FITS)0 +1732 y(\014le)i(will)f(ha)m(v)m(e)430 1992 y Fe(FITS)46 +b(value)h(=)g(\(\(input)f(value\))g(-)h(BZERO\))f(/)i(BSCALE)0 +2252 y Fj(\(a)39 b(corresp)s(onding)c(form)m(ula)i(using)g(TSCALn)f +(and)h(TZER)m(On)g(is)g(used)g(when)f(writing)g(to)j(table)f +(columns\).)0 2365 y(Rounding)33 b(to)j(the)g(nearest)g(in)m(teger,)h +(rather)e(than)g(truncation,)i(is)d(p)s(erformed)g(when)g(writing)f(in) +m(teger)j(data)0 2478 y(t)m(yp)s(es)30 b(to)i(the)e(FITS)g(\014le.)0 +2812 y Ff(4.8)135 b(Supp)t(ort)44 b(for)h(IEEE)h(Sp)t(ecial)f(V)-11 +b(alues)0 3062 y Fj(The)26 b(ANSI/IEEE-754)h(\015oating-p)s(oin)m(t)f +(n)m(um)m(b)s(er)f(standard)g(de\014nes)h(certain)g(sp)s(ecial)f(v)-5 +b(alues)25 b(that)i(are)g(used)e(to)0 3175 y(represen)m(t)j(suc)m(h)g +(quan)m(tities)f(as)h(Not-a-Num)m(b)s(er)h(\(NaN\),)h(denormalized,)d +(under\015o)m(w,)g(o)m(v)m(er\015o)m(w,)j(and)d(in\014nit)m(y)-8 +b(.)0 3288 y(\(See)29 b(the)f(App)s(endix)d(in)i(the)h(NOST)g(FITS)f +(standard)g(or)h(the)g(NOST)g(FITS)f(User's)h(Guide)f(for)h(a)g(list)f +(of)h(these)0 3401 y(v)-5 b(alues\).)54 b(The)34 b(CFITSIO)f(routines)h +(that)h(read)g(\015oating)f(p)s(oin)m(t)g(data)i(in)d(FITS)h(\014les)g +(recognize)h(these)h(IEEE)0 3514 y(sp)s(ecial)22 b(v)-5 +b(alues)24 b(and)f(b)m(y)g(default)g(in)m(terpret)h(the)g(o)m(v)m +(er\015o)m(w)h(and)e(in\014nit)m(y)e(v)-5 b(alues)24 +b(as)g(b)s(eing)e(equiv)-5 b(alen)m(t)23 b(to)i(a)f(NaN,)0 +3627 y(and)36 b(con)m(v)m(ert)i(the)e(under\015o)m(w)f(and)h +(denormalized)f(v)-5 b(alues)35 b(in)m(to)i(zeros.)59 +b(In)36 b(some)g(cases)i(programmers)d(ma)m(y)0 3740 +y(w)m(an)m(t)d(access)h(to)g(the)e(ra)m(w)h(IEEE)f(v)-5 +b(alues,)31 b(without)g(an)m(y)h(mo)s(di\014cation)e(b)m(y)h(CFITSIO.)f +(This)g(can)i(b)s(e)f(done)g(b)m(y)0 3853 y(calling)26 +b(the)j(\014ts)p 567 3853 V 32 w(read)p 771 3853 V 33 +w(img)e(or)h(\014ts)p 1209 3853 V 33 w(read)p 1414 3853 +V 32 w(col)g(routines)f(while)f(sp)s(ecifying)g(0.0)j(as)f(the)g(v)-5 +b(alue)28 b(of)g(the)g(NULL)-10 b(V)g(AL)0 3966 y(parameter.)59 +b(This)35 b(will)e(force)k(CFITSIO)e(to)i(simply)d(pass)i(the)h(IEEE)f +(v)-5 b(alues)35 b(through)h(to)h(the)g(application)0 +4079 y(program)31 b(without)f(an)m(y)i(mo)s(di\014cation.)42 +b(This)29 b(is)i(not)g(fully)e(supp)s(orted)h(on)h(V)-10 +b(AX/VMS)32 b(mac)m(hines,)f(ho)m(w)m(ev)m(er,)0 4192 +y(where)f(there)g(is)g(no)g(easy)h(w)m(a)m(y)g(to)h(b)m(ypass)e(the)g +(default)g(in)m(terpretation)f(of)i(the)g(IEEE)e(sp)s(ecial)g(v)-5 +b(alues.)0 4526 y Ff(4.9)135 b(Error)46 b(Status)f(V)-11 +b(alues)45 b(and)g(the)g(Error)g(Message)h(Stac)l(k)0 +4776 y Fj(Nearly)35 b(all)f(the)i(CFITSIO)e(routines)g(return)g(an)h +(error)g(status)h(v)-5 b(alue)34 b(in)g(2)i(w)m(a)m(ys:)51 +b(as)36 b(the)f(v)-5 b(alue)35 b(of)h(the)f(last)0 4889 +y(parameter)29 b(in)e(the)h(function)f(call,)i(and)f(as)g(the)h +(returned)e(v)-5 b(alue)28 b(of)g(the)h(function)e(itself.)39 +b(This)26 b(pro)m(vides)i(some)0 5002 y(\015exibilit)m(y)33 +b(in)h(the)i(w)m(a)m(y)h(programmers)e(can)h(test)h(if)e(an)g(error)h +(o)s(ccurred,)g(as)g(illustrated)e(in)g(the)i(follo)m(wing)f(2)0 +5115 y(co)s(de)c(fragmen)m(ts:)191 5375 y Fe(if)47 b(\()h +(fits_write_record\(fptr,)41 b(card,)46 b(&status\))g(\))430 +5488 y(printf\(")f(Error)h(occurred)g(while)g(writing)g(keyword."\);)0 +5714 y(or,)p eop +%%Page: 24 32 +24 31 bop 0 299 a Fj(24)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)191 668 y Fe(fits_write_record\(fptr,) +41 b(card,)47 b(&status\);)191 781 y(if)g(\()h(status)e(\))430 +894 y(printf\(")f(Error)h(occurred)g(while)g(writing)g(keyword."\);)0 +1109 y Fj(A)27 b(listing)e(of)j(all)e(the)h(CFITSIO)f(status)i(co)s(de) +f(v)-5 b(alues)27 b(is)f(giv)m(en)h(at)h(the)g(end)e(of)i(this)e(do)s +(cumen)m(t.)39 b(Programmers)0 1222 y(are)33 b(encouraged)g(to)g(use)f +(the)h(sym)m(b)s(olic)d(mnemonics)h(\(de\014ned)h(in)f(\014tsio.h\))h +(rather)g(than)g(the)h(actual)g(in)m(teger)0 1335 y(status)e(v)-5 +b(alues)29 b(to)j(impro)m(v)m(e)e(the)g(readabilit)m(y)f(of)i(their)e +(co)s(de.)0 1495 y(The)j(CFITSIO)f(library)e(uses)j(an)g(`inherited)f +(status')i(con)m(v)m(en)m(tion)g(for)f(the)h(status)f(parameter)h(whic) +m(h)e(means)0 1608 y(that)37 b(if)e(a)i(routine)e(is)h(called)f(with)g +(a)i(p)s(ositiv)m(e)e(input)g(v)-5 b(alue)36 b(of)g(the)h(status)f +(parameter)h(as)g(input,)f(then)g(the)0 1721 y(routine)i(will)d(exit)k +(immediately)e(without)g(c)m(hanging)i(the)f(v)-5 b(alue)38 +b(of)h(the)g(status)g(parameter.)65 b(Th)m(us,)40 b(if)e(one)0 +1834 y(passes)24 b(the)h(status)g(v)-5 b(alue)24 b(returned)g(from)g +(eac)m(h)i(CFITSIO)d(routine)g(as)i(input)e(to)i(the)g(next)g(CFITSIO)e +(routine,)0 1947 y(then)28 b(whenev)m(er)g(an)g(error)g(is)g(detected)h +(all)f(further)f(CFITSIO)f(pro)s(cessing)h(will)f(cease.)42 +b(This)26 b(con)m(v)m(en)m(tion)k(can)0 2060 y(simplify)f(the)k(error)f +(c)m(hec)m(king)i(in)d(application)g(programs)h(b)s(ecause)h(it)f(is)g +(not)h(necessary)g(to)g(c)m(hec)m(k)i(the)d(v)-5 b(alue)0 +2173 y(of)30 b(the)g(status)h(parameter)f(after)h(ev)m(ery)g(single)d +(CFITSIO)h(routine)g(call.)40 b(If)30 b(a)g(program)g(con)m(tains)g(a)h +(sequence)0 2285 y(of)d(sev)m(eral)h(CFITSIO)e(calls,)h(one)g(can)h +(just)e(c)m(hec)m(k)j(the)f(status)f(v)-5 b(alue)28 b(after)h(the)f +(last)g(call.)39 b(Since)28 b(the)g(returned)0 2398 y(status)33 +b(v)-5 b(alues)32 b(are)h(generally)f(distinctiv)m(e,)g(it)h(should)d +(b)s(e)j(p)s(ossible)d(to)j(determine)f(whic)m(h)g(routine)g +(originally)0 2511 y(returned)d(the)i(error)f(status.)0 +2671 y(CFITSIO)c(also)h(main)m(tains)g(an)g(in)m(ternal)f(stac)m(k)j +(of)f(error)f(messages)h(\(80-c)m(haracter)j(maxim)m(um)26 +b(length\))h(whic)m(h)0 2784 y(in)35 b(man)m(y)h(cases)h(pro)m(vide)e +(a)h(more)g(detailed)g(explanation)f(of)h(the)g(cause)h(of)f(the)g +(error)g(than)f(is)g(pro)m(vided)g(b)m(y)0 2897 y(the)40 +b(error)e(status)i(n)m(um)m(b)s(er)e(alone.)68 b(It)39 +b(is)g(recommended)g(that)g(the)h(error)f(message)h(stac)m(k)h(b)s(e)e +(prin)m(ted)f(out)0 3010 y(whenev)m(er)h(a)g(program)g(detects)h(a)f +(CFITSIO)e(error.)66 b(The)38 b(function)g(\014ts)p 2653 +3010 28 4 v 32 w(rep)s(ort)p 2931 3010 V 32 w(error)h(will)d(prin)m(t)i +(out)h(the)0 3123 y(en)m(tire)30 b(error)f(message)h(stac)m(k,)i(or)d +(alternativ)m(ely)h(one)g(ma)m(y)g(call)f(\014ts)p 2376 +3123 V 32 w(read)p 2580 3123 V 33 w(errmsg)g(to)h(get)h(the)f(error)f +(messages)0 3236 y(one)i(at)g(a)g(time.)0 3563 y Ff(4.10)136 +b(V)-11 b(ariable-Length)45 b(Arra)l(ys)g(in)g(Binary)g(T)-11 +b(ables)0 3813 y Fj(CFITSIO)33 b(pro)m(vides)h(easy-to-use)i(supp)s +(ort)d(for)i(reading)f(and)g(writing)f(data)i(in)f(v)-5 +b(ariable)33 b(length)h(\014elds)g(of)h(a)0 3926 y(binary)f(table.)55 +b(The)35 b(v)-5 b(ariable)34 b(length)g(columns)g(ha)m(v)m(e)j(TF)m +(ORMn)e(k)m(eyw)m(ord)h(v)-5 b(alues)34 b(of)i(the)f(form)g +(`1Pt\(len\)')0 4039 y(where)25 b(`t')i(is)d(the)i(data)g(t)m(yp)s(e)g +(co)s(de)g(\(e.g.,)j(I,)c(J,)h(E,)f(D,)i(etc.\))40 b(and)25 +b(`len')h(is)e(an)i(in)m(teger)g(sp)s(ecifying)d(the)j(maxim)m(um)0 +4152 y(length)g(of)h(the)h(v)m(ector)g(in)e(the)h(table.)39 +b(If)27 b(the)g(v)-5 b(alue)26 b(of)h(`len')g(is)f(not)h(sp)s +(eci\014ed)e(when)h(the)h(table)g(is)f(created)i(\(e.g.,)0 +4264 y(if)33 b(the)h(TF)m(ORM)h(k)m(eyw)m(ord)g(v)-5 +b(alue)33 b(is)g(simply)f(sp)s(eci\014ed)h(as)h('1PE')h(instead)e(of)h +('1PE\(400\))j(\),)f(then)d(CFITSIO)0 4377 y(will)27 +b(automatically)i(scan)g(the)h(table)f(when)g(it)g(is)f(closed)h(to)h +(determine)f(the)g(maxim)m(um)f(length)h(of)h(the)f(v)m(ector)0 +4490 y(and)h(will)d(app)s(end)i(this)g(v)-5 b(alue)30 +b(to)h(the)g(TF)m(ORMn)f(v)-5 b(alue.)0 4650 y(The)29 +b(same)h(routines)f(that)h(read)f(and)g(write)g(data)h(in)f(an)g +(ordinary)f(\014xed)h(length)g(binary)f(table)h(extension)h(are)0 +4763 y(also)40 b(used)e(for)i(v)-5 b(ariable)38 b(length)h(\014elds,)h +(ho)m(w)m(ev)m(er,)k(the)c(routine)e(parameters)i(tak)m(e)h(on)f(a)g +(sligh)m(tly)d(di\013eren)m(t)0 4876 y(in)m(terpretation)30 +b(as)g(describ)s(ed)f(b)s(elo)m(w.)0 5036 y(All)35 b(the)h(data)h(in)e +(a)i(v)-5 b(ariable)35 b(length)g(\014eld)g(is)g(written)h(in)m(to)g +(an)g(area)h(called)f(the)g(`heap')g(whic)m(h)f(follo)m(ws)h(the)0 +5149 y(main)30 b(\014xed-length)h(FITS)f(binary)g(table.)43 +b(The)31 b(size)g(of)g(the)h(heap,)f(in)f(b)m(ytes,)i(is)f(sp)s +(eci\014ed)e(b)m(y)i(the)h(PCOUNT)0 5262 y(k)m(eyw)m(ord)21 +b(in)e(the)i(FITS)f(header.)37 b(When)20 b(creating)h(a)g(new)f(binary) +f(table,)j(the)f(initial)d(v)-5 b(alue)20 b(of)g(PCOUNT)g(should)0 +5375 y(usually)25 b(b)s(e)j(set)g(to)g(zero.)41 b(CFITSIO)26 +b(will)f(recompute)j(the)g(size)f(of)h(the)g(heap)g(as)g(the)g(data)g +(is)f(written)f(and)i(will)0 5488 y(automatically)d(up)s(date)f(the)i +(PCOUNT)e(k)m(eyw)m(ord)h(v)-5 b(alue)25 b(when)f(the)h(table)g(is)f +(closed.)39 b(When)25 b(writing)e(v)-5 b(ariable)0 5601 +y(length)33 b(data)h(to)g(a)g(table,)h(CFITSIO)d(will)e(automatically)k +(extend)f(the)h(size)f(of)h(the)g(heap)f(area)h(if)f(necessary)-8 +b(,)0 5714 y(so)31 b(that)g(an)m(y)f(follo)m(wing)f(HDUs)i(do)f(not)h +(get)h(o)m(v)m(erwritten.)p eop +%%Page: 25 33 +25 32 bop 0 299 a Fh(4.11.)73 b(MUL)-8 b(TIPLE)30 b(A)m(CCESS)f(TO)g +(THE)i(SAME)f(FITS)f(FILE)1515 b Fj(25)0 555 y(By)30 +b(default)e(the)i(heap)f(data)i(area)f(starts)g(immediately)e(after)i +(the)f(last)h(ro)m(w)f(of)h(the)g(\014xed-length)e(table.)41 +b(This)0 668 y(default)26 b(starting)g(lo)s(cation)h(ma)m(y)g(b)s(e)f +(o)m(v)m(erridden)g(b)m(y)h(the)g(THEAP)f(k)m(eyw)m(ord,)i(but)f(this)e +(is)h(not)h(recommended.)0 781 y(If)34 b(additional)e(ro)m(ws)i(of)g +(data)h(are)g(added)e(to)i(the)f(table,)i(CFITSIO)c(will)g +(automatically)i(shift)e(the)j(the)f(heap)0 894 y(do)m(wn)g(to)i(mak)m +(e)f(ro)s(om)g(for)f(the)h(new)f(ro)m(ws,)i(but)e(it)h(is)e(ob)m +(viously)h(b)s(e)g(more)h(e\016cien)m(t)g(to)g(initially)c(create)37 +b(the)0 1007 y(table)30 b(with)e(the)i(necessary)g(n)m(um)m(b)s(er)f +(of)h(blank)e(ro)m(ws,)i(so)g(that)g(the)g(heap)g(do)s(es)f(not)h +(needed)g(to)g(b)s(e)f(constan)m(tly)0 1120 y(mo)m(v)m(ed.)0 +1280 y(When)g(writing)f(to)i(a)g(v)-5 b(ariable)29 b(length)g(\014eld)f +(the)i(en)m(tire)f(arra)m(y)h(of)g(v)-5 b(alues)29 b(for)h(a)g(giv)m +(en)f(ro)m(w)h(of)g(the)g(table)f(m)m(ust)0 1393 y(b)s(e)e(written)f +(with)h(a)h(single)e(call)g(to)j(\014ts)p 1363 1393 28 +4 v 32 w(write)p 1598 1393 V 32 w(col.)40 b(The)27 b(total)h(length)f +(of)h(the)g(arra)m(y)g(is)e(giv)m(en)i(b)m(y)f(nelemen)m(ts)g(+)0 +1506 y(\014rstelem)33 b(-)g(1.)51 b(Additional)31 b(elemen)m(ts)j +(cannot)g(b)s(e)f(app)s(ended)f(to)i(an)f(existing)g(v)m(ector)i(at)f +(a)g(later)f(time)h(since)0 1619 y(an)m(y)c(attempt)g(to)g(do)f(so)g +(will)e(simply)f(o)m(v)m(erwrite)k(all)e(the)i(previously)c(written)j +(data.)41 b(Note)30 b(also)f(that)h(the)f(new)0 1732 +y(data)c(will)d(b)s(e)i(written)g(to)h(a)g(new)f(area)i(of)f(the)f +(heap)h(and)f(the)h(heap)f(space)h(used)f(b)m(y)h(the)f(previous)g +(write)f(cannot)0 1844 y(b)s(e)32 b(reclaimed.)45 b(F)-8 +b(or)34 b(this)d(reason)h(eac)m(h)i(ro)m(w)f(of)f(a)h(v)-5 +b(ariable)31 b(length)h(\014eld)f(should)f(only)i(b)s(e)f(written)h +(once.)47 b(An)0 1957 y(exception)37 b(to)g(this)f(general)g(rule)f(o)s +(ccurs)i(when)e(setting)i(elemen)m(ts)g(of)g(an)f(arra)m(y)h(as)g +(unde\014ned.)57 b(One)36 b(m)m(ust)0 2070 y(\014rst)30 +b(write)g(a)i(dumm)m(y)d(v)-5 b(alue)31 b(in)m(to)g(the)g(arra)m(y)g +(with)f(\014ts)p 1977 2070 V 32 w(write)p 2212 2070 V +32 w(col,)i(and)e(then)h(call)f(\014ts)p 3086 2070 V +32 w(write)p 3321 2070 V 32 w(col)p 3464 2070 V 33 w(n)m(ul)g(to)i +(\015ag)0 2183 y(the)g(desired)e(elemen)m(ts)i(as)g(unde\014ned.)43 +b(\(Do)33 b(not)f(use)g(the)g(\014ts)p 2197 2183 V 32 +w(write)p 2432 2183 V 32 w(coln)m(ull)e(routines)g(with)h(v)-5 +b(ariable)31 b(length)0 2296 y(\014elds\).)45 b(Note)33 +b(that)g(the)f(ro)m(ws)h(of)f(a)g(table,)h(whether)f(\014xed)f(or)h(v) +-5 b(ariable)31 b(length,)i(do)f(not)g(ha)m(v)m(e)h(to)g(b)s(e)f +(written)0 2409 y(consecutiv)m(ely)f(and)e(ma)m(y)i(b)s(e)f(written)f +(in)h(an)m(y)g(order.)0 2569 y(When)40 b(writing)f(to)i(a)g(v)-5 +b(ariable)39 b(length)h(ASCI)s(I)f(c)m(haracter)j(\014eld)d(\(e.g.,)45 +b(TF)m(ORM)c(=)f('1P)-8 b(A'\))43 b(only)c(a)i(single)0 +2682 y(c)m(haracter)22 b(string)d(can)i(b)s(e)e(written.)37 +b(The)20 b(`\014rstelem')f(and)h(`nelemen)m(ts')h(parameter)f(v)-5 +b(alues)20 b(in)f(the)h(\014ts)p 3526 2682 V 33 w(write)p +3762 2682 V 32 w(col)0 2795 y(routine)34 b(are)i(ignored)e(and)g(the)i +(n)m(um)m(b)s(er)d(of)j(c)m(haracters)g(to)g(write)e(is)h(simply)d +(determined)i(b)m(y)h(the)g(length)g(of)0 2908 y(the)c(input)d(n)m +(ull-terminated)g(c)m(haracter)k(string.)0 3068 y(The)21 +b(\014ts)p 305 3068 V 33 w(write)p 541 3068 V 32 w(descript)f(routine)h +(is)f(useful)g(in)g(situations)h(where)g(m)m(ultiple)e(ro)m(ws)j(of)g +(a)g(v)-5 b(ariable)20 b(length)h(column)0 3181 y(ha)m(v)m(e)32 +b(the)e(iden)m(tical)f(arra)m(y)i(of)g(v)-5 b(alues.)40 +b(One)30 b(can)g(simply)e(write)i(the)g(arra)m(y)h(once)g(for)g(the)f +(\014rst)g(ro)m(w,)g(and)g(then)0 3294 y(use)c(\014ts)p +280 3294 V 32 w(write)p 515 3294 V 32 w(descript)f(to)h(write)f(the)h +(same)h(descriptor)d(v)-5 b(alues)26 b(in)m(to)g(the)g(other)g(ro)m +(ws;)h(all)e(the)h(ro)m(ws)g(will)d(then)0 3407 y(p)s(oin)m(t)29 +b(to)i(the)g(same)g(storage)h(lo)s(cation)e(th)m(us)g(sa)m(ving)g(disk) +f(space.)0 3567 y(When)35 b(reading)f(from)g(a)i(v)-5 +b(ariable)33 b(length)i(arra)m(y)g(\014eld)f(one)h(can)g(only)g(read)f +(as)i(man)m(y)f(elemen)m(ts)g(as)g(actually)0 3680 y(exist)h(in)e(that) +j(ro)m(w)e(of)h(the)g(table;)j(reading)c(do)s(es)h(not)g(automatically) +f(con)m(tin)m(ue)h(with)f(the)h(next)g(ro)m(w)g(of)g(the)0 +3793 y(table)28 b(as)g(o)s(ccurs)g(when)f(reading)g(an)h(ordinary)f +(\014xed)g(length)g(table)h(\014eld.)39 b(A)m(ttempts)29 +b(to)g(read)f(more)g(than)g(this)0 3906 y(will)h(cause)k(an)e(error)h +(status)g(to)g(b)s(e)f(returned.)44 b(One)32 b(can)g(determine)f(the)h +(n)m(um)m(b)s(er)e(of)i(elemen)m(ts)g(in)f(eac)m(h)i(ro)m(w)0 +4019 y(of)e(a)f(v)-5 b(ariable)29 b(column)h(with)f(the)h(\014ts)p +1329 4019 V 33 w(read)p 1534 4019 V 32 w(descript)g(routine.)0 +4432 y Ff(4.11)136 b(Multiple)45 b(Access)g(to)g(the)g(Same)h(FITS)d +(File)0 4698 y Fj(CFITSIO)35 b(supp)s(orts)g(sim)m(ultaneous)g(read)h +(and)g(write)g(access)h(to)h(m)m(ultiple)c(HDUs)j(in)e(the)i(same)g +(FITS)f(\014le.)0 4811 y(Th)m(us,)43 b(one)e(can)h(op)s(en)e(the)h +(same)h(FITS)e(\014le)g(t)m(wice)i(within)c(a)k(single)d(program)i(and) +g(mo)m(v)m(e)h(to)g(2)f(di\013eren)m(t)0 4924 y(HDUs)30 +b(in)e(the)i(\014le,)f(and)g(then)g(read)h(and)e(write)h(data)h(or)g(k) +m(eyw)m(ords)g(to)g(the)g(2)f(extensions)h(just)e(as)i(if)f(one)g(w)m +(ere)0 5036 y(accessing)e(2)g(completely)f(separate)h(FITS)f(\014les.) +38 b(Since)26 b(in)f(general)h(it)g(is)g(not)h(p)s(ossible)d(to)j(ph)m +(ysically)d(op)s(en)i(the)0 5149 y(same)36 b(\014le)f(t)m(wice)h(and)f +(then)g(exp)s(ect)h(to)g(b)s(e)f(able)g(to)i(sim)m(ultaneously)c(\(or)j +(in)e(alternating)h(succession\))h(write)0 5262 y(to)f(2)f(di\013eren)m +(t)g(lo)s(cations)g(in)e(the)j(\014le,)f(CFITSIO)f(recognizes)i(when)e +(the)h(\014le)f(to)i(b)s(e)f(op)s(ened)f(\(in)g(the)i(call)e(to)0 +5375 y(\014ts)p 127 5375 V 32 w(op)s(en)p 349 5375 V +33 w(\014le\))28 b(has)g(already)g(b)s(een)g(op)s(ened)g(and)g(instead) +g(of)h(actually)f(op)s(ening)f(the)i(\014le)f(again,)h(just)f +(logically)0 5488 y(links)g(the)j(new)f(\014le)g(to)h(the)g(old)e +(\014le.)41 b(\(This)29 b(only)h(applies)e(if)i(the)h(\014le)e(is)h(op) +s(ened)g(more)g(than)g(once)i(within)c(the)0 5601 y(same)g(program,)g +(and)f(do)s(es)h(not)f(prev)m(en)m(t)i(the)f(same)g(\014le)e(from)h(b)s +(eing)g(sim)m(ultaneously)e(op)s(ened)i(b)m(y)g(more)h(than)0 +5714 y(one)h(program\).)40 b(Then)28 b(b)s(efore)g(CFITSIO)f(reads)h +(or)h(writes)f(to)h(either)f(\(logical\))h(\014le,)f(it)g(mak)m(es)i +(sure)d(that)j(an)m(y)p eop +%%Page: 26 34 +26 33 bop 0 299 a Fj(26)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)0 555 y Fj(mo)s(di\014cations)e(made)h +(to)h(the)g(other)g(\014le)e(ha)m(v)m(e)j(b)s(een)e(completely)g +(\015ushed)e(from)i(the)h(in)m(ternal)e(bu\013ers)h(to)h(the)0 +668 y(\014le.)43 b(Th)m(us,)30 b(in)g(principle,)f(one)i(could)f(op)s +(en)h(a)h(\014le)e(t)m(wice,)i(in)e(one)i(case)g(p)s(oin)m(ting)e(to)i +(the)f(\014rst)g(extension)g(and)0 781 y(in)i(the)i(other)g(p)s(oin)m +(ting)d(to)k(the)e(2nd)g(extension)h(and)e(then)i(write)e(data)j(to)f +(b)s(oth)f(extensions,)h(in)e(an)m(y)i(order,)0 894 y(without)24 +b(danger)i(of)f(corrupting)g(the)g(\014le,)h(There)f(ma)m(y)h(b)s(e)f +(some)h(e\016ciency)f(p)s(enalties)f(in)g(doing)h(this)f(ho)m(w)m(ev)m +(er,)0 1007 y(since)j(CFITSIO)g(has)h(to)h(\015ush)d(all)h(the)h(in)m +(ternal)f(bu\013ers)g(related)h(to)h(one)f(\014le)f(b)s(efore)h(switc)m +(hing)e(to)j(the)f(other,)0 1120 y(so)i(it)g(w)m(ould)f(still)f(b)s(e)i +(pruden)m(t)f(to)i(minimize)d(the)i(n)m(um)m(b)s(er)f(of)i(times)e(one) +i(switc)m(hes)f(bac)m(k)h(and)e(forth)h(b)s(et)m(w)m(een)0 +1233 y(doing)f(I/O)i(to)g(di\013eren)m(t)f(HDUs)h(in)e(the)h(same)h +(\014le.)0 1571 y Ff(4.12)136 b(When)44 b(the)h(Final)h(Size)f(of)g +(the)g(FITS)f(HDU)h(is)g(Unkno)l(wn)0 1822 y Fj(It)27 +b(is)g(not)g(required)e(to)j(kno)m(w)f(the)h(total)g(size)f(of)g(a)h +(FITS)e(data)i(arra)m(y)g(or)f(table)g(b)s(efore)g(b)s(eginning)d(to)k +(write)f(the)0 1935 y(data)32 b(to)f(the)g(FITS)f(\014le.)42 +b(In)30 b(the)h(case)h(of)f(the)g(primary)e(arra)m(y)i(or)g(an)f(image) +i(extension,)e(one)i(should)c(initially)0 2047 y(create)j(the)e(arra)m +(y)h(with)d(the)j(size)f(of)g(the)g(highest)f(dimension)f(\(largest)j +(NAXISn)e(k)m(eyw)m(ord\))i(set)g(to)g(a)f(dumm)m(y)0 +2160 y(v)-5 b(alue,)25 b(suc)m(h)f(as)g(1.)39 b(Then)23 +b(after)i(all)e(the)i(data)f(ha)m(v)m(e)i(b)s(een)d(written)g(and)h +(the)g(true)g(dimensions)e(are)i(kno)m(wn,)h(then)0 2273 +y(the)33 b(NAXISn)f(v)-5 b(alue)32 b(should)f(b)s(e)h(up)s(dated)g +(using)f(the)i(\014ts)p 2069 2273 28 4 v 33 w(up)s(date)p +2378 2273 V 32 w(k)m(ey)g(routine)f(b)s(efore)h(mo)m(ving)f(to)i +(another)0 2386 y(extension)c(or)g(closing)g(the)g(FITS)g(\014le.)0 +2546 y(When)f(writing)e(to)i(FITS)g(tables,)g(CFITSIO)e(automatically)i +(k)m(eeps)h(trac)m(k)g(of)f(the)g(highest)g(ro)m(w)g(n)m(um)m(b)s(er)e +(that)0 2659 y(is)k(written)g(to,)i(and)e(will)e(increase)j(the)g(size) +g(of)g(the)g(table)f(if)g(necessary)-8 b(.)46 b(CFITSIO)30 +b(will)f(also)j(automatically)0 2772 y(insert)j(space)i(in)e(the)h +(FITS)f(\014le)h(if)f(necessary)-8 b(,)39 b(to)e(ensure)e(that)i(the)f +(data)h('heap',)h(if)d(it)h(exists,)h(and/or)g(an)m(y)0 +2885 y(additional)26 b(HDUs)j(that)g(follo)m(w)e(the)i(table)f(do)g +(not)h(get)g(o)m(v)m(erwritten)g(as)f(new)g(ro)m(ws)g(are)h(written)e +(to)i(the)g(table.)0 3045 y(As)37 b(a)h(general)f(rule)f(it)h(is)f(b)s +(est)h(to)h(sp)s(ecify)e(the)i(initial)c(n)m(um)m(b)s(er)i(of)i(ro)m +(ws)f(=)g(0)g(when)g(the)g(table)g(is)g(created,)0 3158 +y(then)h(let)g(CFITSIO)f(k)m(eep)i(trac)m(k)g(of)g(the)f(n)m(um)m(b)s +(er)f(of)i(ro)m(ws)f(that)h(are)f(actually)g(written.)64 +b(The)38 b(application)0 3271 y(program)e(should)e(not)j(man)m(ually)e +(up)s(date)g(the)i(n)m(um)m(b)s(er)e(of)h(ro)m(ws)g(in)f(the)i(table)f +(\(as)h(giv)m(en)f(b)m(y)g(the)h(NAXIS2)0 3384 y(k)m(eyw)m(ord\))j +(since)e(CFITSIO)f(do)s(es)i(this)f(automatically)-8 +b(.)66 b(If)38 b(a)i(table)e(is)g(initially)e(created)k(with)d(more)i +(than)0 3497 y(zero)i(ro)m(ws,)j(then)c(this)g(will)d(usually)i(b)s(e)h +(considered)f(as)i(the)g(minim)m(um)d(size)i(of)h(the)g(table,)i(ev)m +(en)e(if)f(few)m(er)0 3610 y(ro)m(ws)30 b(are)g(actually)f(written)g +(to)i(the)f(table.)40 b(Th)m(us,)30 b(if)e(a)j(table)e(is)g(initially)d +(created)31 b(with)e(NAXIS2)h(=)f(20,)j(and)0 3723 y(CFITSIO)f(only)h +(writes)f(10)j(ro)m(ws)e(of)h(data)g(b)s(efore)f(closing)g(the)h +(table,)g(then)f(NAXIS2)h(will)d(remain)h(equal)h(to)0 +3836 y(20.)50 b(If)33 b(ho)m(w)m(ev)m(er,)i(30)g(ro)m(ws)e(of)g(data)h +(are)g(written)e(to)i(this)e(table,)i(then)f(NAXIS2)h(will)c(b)s(e)j +(increased)f(from)h(20)0 3949 y(to)f(30.)44 b(The)31 +b(one)g(exception)h(to)g(this)e(automatic)i(up)s(dating)d(of)i(the)h +(NAXIS2)f(k)m(eyw)m(ord)h(is)e(if)g(the)i(application)0 +4061 y(program)c(directly)e(mo)s(di\014es)g(the)j(v)-5 +b(alue)27 b(of)h(NAXIS2)g(\(up)f(or)h(do)m(wn\))g(itself)f(just)g(b)s +(efore)h(closing)f(the)h(table.)40 b(In)0 4174 y(this)27 +b(case,)j(CFITSIO)d(do)s(es)h(not)h(up)s(date)e(NAXIS2)i(again,)g +(since)f(it)g(assumes)g(that)h(the)f(application)f(program)0 +4287 y(m)m(ust)32 b(ha)m(v)m(e)h(had)f(a)g(go)s(o)s(d)g(reason)h(for)f +(c)m(hanging)g(the)g(v)-5 b(alue)32 b(directly)-8 b(.)45 +b(This)30 b(is)h(not)i(recommended,)f(ho)m(w)m(ev)m(er,)0 +4400 y(and)j(is)g(only)g(pro)m(vided)g(for)g(bac)m(kw)m(ard)h +(compatibilit)m(y)e(with)h(soft)m(w)m(are)i(that)g(initially)32 +b(creates)37 b(a)f(table)g(with)0 4513 y(a)e(large)g(n)m(um)m(b)s(er)f +(of)h(ro)m(ws,)h(than)f(decreases)g(the)h(NAXIS2)f(v)-5 +b(alue)33 b(to)i(the)f(actual)g(smaller)f(v)-5 b(alue)33 +b(just)g(b)s(efore)0 4626 y(closing)c(the)i(table.)0 +4964 y Ff(4.13)136 b(CFITSIO)44 b(Size)h(Limitations)0 +5215 y Fj(CFITSIO)29 b(places)i(v)m(ery)g(few)g(restrictions)e(on)i +(the)g(size)f(of)h(FITS)f(\014les)g(that)h(it)g(reads)f(or)h(writes.)41 +b(There)30 b(are)i(a)0 5328 y(few)e(limits,)e(ho)m(w)m(ev)m(er,)k(that) +f(ma)m(y)g(a\013ect)h(some)f(extreme)g(cases:)0 5488 +y(1.)43 b(The)31 b(maxim)m(um)f(n)m(um)m(b)s(er)g(of)h(FITS)f(\014les)g +(that)i(ma)m(y)g(b)s(e)e(sim)m(ultaneously)f(op)s(ened)i(b)m(y)g +(CFITSIO)e(is)h(set)i(b)m(y)0 5601 y(NMAXFILES)i(as)g(de\014ned)f(in)g +(\014tsio2.h.)51 b(It)34 b(is)f(curren)m(tly)g(set)i(=)f(300)h(b)m(y)f +(default.)51 b(CFITSIO)32 b(will)f(allo)s(cate)0 5714 +y(ab)s(out)i(80)g(*)h(NMAXFILES)f(b)m(ytes)g(of)g(memory)g(for)g(in)m +(ternal)e(use.)48 b(Note)34 b(that)g(the)f(underlying)d(C)i(compiler)p +eop +%%Page: 27 35 +27 34 bop 0 299 a Fh(4.13.)73 b(CFITSIO)28 b(SIZE)h(LIMIT)-8 +b(A)g(TIONS)2300 b Fj(27)0 555 y(or)39 b(op)s(erating)g(system,)k(ma)m +(y)d(ha)m(v)m(e)g(a)g(smaller)e(limit)g(on)h(the)h(n)m(um)m(b)s(er)e +(of)i(op)s(ened)e(\014les.)67 b(The)39 b(C)h(sym)m(b)s(olic)0 +668 y(constan)m(t)31 b(F)m(OPEN)p 690 668 28 4 v 34 w(MAX)f(is)f(in)m +(tended)g(to)i(de\014ne)e(the)i(maxim)m(um)e(n)m(um)m(b)s(er)f(of)j +(\014les)e(that)h(ma)m(y)h(op)s(en)e(at)i(once)0 781 +y(\(including)d(an)m(y)j(other)g(text)h(or)f(binary)e(\014les)h(that)i +(ma)m(y)f(b)s(e)g(op)s(en,)f(not)h(just)g(FITS)f(\014les\).)42 +b(On)30 b(some)h(systems)0 894 y(it)f(has)g(b)s(een)g(found)f(that)i +(gcc)g(supp)s(orts)e(a)h(maxim)m(um)g(of)g(255)i(op)s(ened)e(\014les.)0 +1054 y(Note)d(that)e(op)s(ening)f(and)h(op)s(erating)g(on)g(man)m(y)g +(FITS)g(\014les)f(sim)m(ultaneously)f(in)h(parallel)f(ma)m(y)j(b)s(e)f +(less)f(e\016cien)m(t)0 1167 y(than)k(op)s(erating)g(on)g(smaller)f +(groups)h(of)h(\014les)e(in)g(series.)40 b(CFITSIO)27 +b(only)g(has)h(NIOBUF)h(n)m(um)m(b)s(er)f(of)g(in)m(ternal)0 +1280 y(bu\013ers)j(\(set)j(=)e(40)i(b)m(y)e(default\))h(that)g(are)g +(used)f(for)g(temp)s(orary)g(storage)i(of)f(the)g(most)g(recen)m(t)h +(data)f(records)0 1393 y(that)40 b(ha)m(v)m(e)g(b)s(een)e(read)h(or)g +(written)f(in)f(the)i(FITS)f(\014les.)66 b(If)38 b(the)h(n)m(um)m(b)s +(er)f(of)h(op)s(ened)f(\014les)g(is)g(greater)i(than)0 +1506 y(NIOBUF,)j(then)f(CFITSIO)e(ma)m(y)j(w)m(aste)h(more)e(time)g +(\015ushing)d(and)j(re-reading)g(or)g(re-writing)e(the)j(same)0 +1619 y(records)30 b(in)f(the)i(FITS)e(\014les.)0 1779 +y(2.)54 b(By)35 b(default,)g(CFITSIO)e(can)i(handle)f(FITS)g(\014les)f +(up)h(to)h(2.1)h(GB)g(in)d(size)i(\(2**31)i(b)m(ytes\).)54 +b(This)33 b(\014le)h(size)0 1892 y(limit)k(is)i(often)g(imp)s(osed)f(b) +m(y)h(32-bit)h(op)s(erating)e(systems.)71 b(More)41 b(recen)m(tly)-8 +b(,)44 b(as)d(64-bit)f(op)s(erating)g(systems)0 2005 +y(b)s(ecome)33 b(more)g(common,)g(an)g(industry-wide)c(standard)j(\(at) +i(least)e(on)h(Unix)e(systems\))i(has)g(b)s(een)f(dev)m(elop)s(ed)0 +2118 y(to)39 b(supp)s(ort)d(larger)h(sized)h(\014les)f(\(see)h(h)m +(ttp://ftp.sas.com/standards/large.\014le/\).)66 b(Starting)38 +b(with)e(v)m(ersion)0 2230 y(2.1)45 b(of)e(CFITSIO,)f(larger)h(FITS)g +(\014les)f(up)h(to)h(6)g(terab)m(ytes)h(in)d(size)h(ma)m(y)h(b)s(e)f +(read)g(and)g(written)g(on)g(sup-)0 2343 y(p)s(orted)f(platforms.)75 +b(In)42 b(order)g(to)h(supp)s(ort)e(these)h(larger)g(\014les,)j +(CFITSIO)c(m)m(ust)h(b)s(e)g(compiled)f(with)g(the)0 +2456 y('-D)p 129 2456 V 34 w(LAR)m(GEFILE)p 696 2456 +V 33 w(SOUR)m(CE')h(and)g(`-D)p 1491 2456 V 34 w(FILE)p +1736 2456 V 33 w(OFFSET)p 2137 2456 V 32 w(BITS=64')h(compiler)e +(\015ags.)78 b(Some)43 b(platforms)0 2569 y(ma)m(y)c(also)f(require)f +(the)h(`-D)p 1002 2569 V 34 w(LAR)m(GE)p 1358 2569 V +33 w(FILES')g(compiler)f(\015ag.)64 b(This)37 b(causes)h(the)h +(compiler)e(to)i(allo)s(cate)f(8-)0 2682 y(b)m(ytes)27 +b(instead)f(of)h(4-b)m(ytes)h(for)f(the)g(`o\013)p 1371 +2682 V 33 w(t')g(data)h(t)m(yp)s(e)f(that)g(is)f(used)g(to)h(store)h +(\014le)e(o\013set)h(p)s(ositions.)38 b(It)27 b(app)s(ears)0 +2795 y(that)i(in)d(most)j(cases)g(it)e(is)g(not)h(necessary)h(to)g +(also)f(include)d(these)k(compiler)d(\015ags)j(when)e(compiling)e +(programs)0 2908 y(that)31 b(link)d(to)j(the)g(CFITSIO)e(library)-8 +b(.)0 3068 y(If)21 b(CFITSIO)e(is)h(compiled)g(with)g(the)h(-D)p +1386 3068 V 33 w(LAR)m(GEFILE)p 1952 3068 V 34 w(SOUR)m(CE)f(and)g(-D)p +2654 3068 V 34 w(FILE)p 2899 3068 V 33 w(OFFSET)p 3300 +3068 V 32 w(BITS=64)h(\015ags)0 3181 y(on)36 b(a)g(platform)f(that)h +(supp)s(orts)e(large)i(\014les,)h(then)e(it)h(can)g(read)g(and)f(write) +g(FITS)g(\014les)g(that)h(con)m(tain)g(up)f(to)0 3294 +y(2**31)k(2880-b)m(yte)g(FITS)d(records,)j(or)d(appro)m(ximately)g(6)h +(terab)m(ytes)h(in)e(size.)59 b(It)37 b(is)f(still)f(required)f(that)k +(the)0 3407 y(v)-5 b(alue)29 b(of)g(the)g(NAXISn)f(and)h(PCOUNT)f(k)m +(eyw)m(ords)h(in)f(eac)m(h)i(extension)f(b)s(e)f(within)f(the)i(range)h +(of)f(a)g(signed)f(4-)0 3520 y(b)m(yte)d(in)m(teger)g(\(max)g(v)-5 +b(alue)25 b(=)f(2,147,483,648\).)44 b(Th)m(us,)25 b(eac)m(h)h +(dimension)c(of)j(an)f(image)h(\(giv)m(en)g(b)m(y)g(the)g(NAXISn)0 +3633 y(k)m(eyw)m(ords\),)32 b(the)f(total)h(width)d(of)i(a)g(table)g +(\(NAXIS1)h(k)m(eyw)m(ord\),)g(the)f(n)m(um)m(b)s(er)f(of)h(ro)m(ws)g +(in)e(a)i(table)g(\(NAXIS2)0 3745 y(k)m(eyw)m(ord\),)d(and)d(the)h +(total)h(size)f(of)g(the)g(v)-5 b(ariable-length)25 b(arra)m(y)h(heap)g +(in)f(binary)f(tables)i(\(PCOUNT)f(k)m(eyw)m(ord\))0 +3858 y(m)m(ust)30 b(b)s(e)g(less)g(than)g(this)f(limit.)0 +4019 y(Curren)m(tly)-8 b(,)30 b(supp)s(ort)f(for)i(large)g(\014les)f +(within)e(CFITSIO)h(has)i(b)s(een)f(tested)i(on)f(the)g(Lin)m(ux,)f +(Solaris,)f(and)h(IBM)0 4131 y(AIX)g(op)s(erating)g(systems.)p +eop +%%Page: 28 36 +28 35 bop 0 299 a Fj(28)1763 b Fh(CHAPTER)29 b(4.)112 +b(PR)m(OGRAMMING)32 b(GUIDELINES)p eop +%%Page: 29 37 +29 36 bop 0 1225 a Fg(Chapter)65 b(5)0 1687 y Fm(Basic)77 +b(CFITSIO)f(In)-6 b(terface)77 b(Routines)0 2180 y Fj(This)29 +b(c)m(hapter)j(describ)s(es)d(the)j(basic)e(routines)g(in)g(the)h +(CFITSIO)e(user)i(in)m(terface)g(that)h(pro)m(vide)e(all)g(the)i(func-) +0 2293 y(tions)i(normally)f(needed)i(to)g(read)g(and)f(write)g(most)i +(FITS)e(\014les.)53 b(It)35 b(is)f(recommended)g(that)i(these)f +(routines)0 2406 y(b)s(e)d(used)g(for)g(most)h(applications)e(and)h +(that)h(the)f(more)h(adv)-5 b(anced)33 b(routines)e(describ)s(ed)g(in)g +(the)i(next)f(c)m(hapter)0 2518 y(only)d(b)s(e)h(used)g(in)f(sp)s +(ecial)g(circumstances)h(when)f(necessary)-8 b(.)0 2679 +y(The)30 b(follo)m(wing)f(con)m(v)m(en)m(tions)i(are)g(used)e(in)h +(this)f(c)m(hapter)i(in)e(the)h(description)f(of)h(eac)m(h)i(function:) +0 2839 y(1.)39 b(Most)25 b(functions)d(ha)m(v)m(e)j(2)f(names:)37 +b(a)24 b(long)g(descriptiv)m(e)e(name)i(and)f(a)i(short)e(concise)h +(name.)38 b(Both)25 b(names)f(are)0 2952 y(listed)e(on)h(the)g(\014rst) +f(line)g(of)h(the)h(follo)m(wing)d(descriptions,)i(separated)g(b)m(y)h +(a)f(slash)f(\(/\))i(c)m(haracter.)40 b(Programmers)0 +3065 y(ma)m(y)27 b(use)g(either)f(name)h(in)e(their)h(programs)h(but)f +(the)h(long)f(names)h(are)g(recommended)f(to)i(help)d(do)s(cumen)m(t)i +(the)0 3177 y(co)s(de)k(and)e(mak)m(e)j(it)e(easier)g(to)h(read.)0 +3338 y(2.)42 b(A)30 b(righ)m(t)g(arro)m(w)h(sym)m(b)s(ol)e(\()p +Fb(>)p Fj(\))i(is)f(used)g(in)f(the)i(function)e(descriptions)f(to)k +(separate)f(the)g(input)e(parameters)0 3451 y(from)k(the)g(output)f +(parameters)i(in)e(the)h(de\014nition)e(of)i(eac)m(h)h(routine.)48 +b(This)31 b(sym)m(b)s(ol)h(is)g(not)h(actually)g(part)g(of)0 +3563 y(the)e(C)f(calling)e(sequence.)0 3724 y(3.)41 b(The)30 +b(function)f(parameters)i(are)g(de\014ned)e(in)g(more)h(detail)g(in)f +(the)h(alphab)s(etical)f(listing)f(in)h(App)s(endix)f(B.)0 +3884 y(4.)39 b(The)23 b(\014rst)g(argumen)m(t)g(in)g(almost)g(all)g +(the)g(functions)f(is)h(a)h(p)s(oin)m(ter)e(to)i(a)g(structure)f(of)h +(t)m(yp)s(e)g(`\014ts\014le'.)37 b(Memory)0 3997 y(for)26 +b(this)f(structure)g(is)g(allo)s(cated)h(b)m(y)g(CFITSIO)e(when)h(the)h +(FITS)g(\014le)f(is)g(\014rst)g(op)s(ened)g(or)h(created)h(and)e(is)g +(freed)0 4110 y(when)k(the)i(FITS)f(\014le)f(is)g(closed.)0 +4270 y(5.)53 b(The)34 b(last)g(argumen)m(t)g(in)f(almost)i(all)e(the)h +(functions)f(is)g(the)i(error)f(status)g(parameter.)53 +b(It)35 b(m)m(ust)f(b)s(e)f(equal)0 4383 y(to)k(0)g(on)f(input,)g +(otherwise)g(the)g(function)f(will)f(immediately)g(exit)i(without)g +(doing)f(an)m(ything.)58 b(A)36 b(non-zero)0 4496 y(output)27 +b(v)-5 b(alue)26 b(indicates)h(that)g(an)g(error)g(o)s(ccurred)g(in)f +(the)h(function.)38 b(In)27 b(most)g(cases)h(the)g(status)f(v)-5 +b(alue)27 b(is)f(also)0 4608 y(returned)j(as)i(the)f(v)-5 +b(alue)30 b(of)h(the)f(function)f(itself.)0 4935 y Ff(5.1)135 +b(CFITSIO)44 b(Error)h(Status)h(Routines)0 5168 y Fi(1)81 +b Fj(Return)27 b(a)j(descriptiv)m(e)d(text)j(string)d(\(30)j(c)m(har)f +(max.\))41 b(corresp)s(onding)27 b(to)i(a)g(CFITSIO)e(error)h(status)h +(co)s(de.)95 5385 y Fe(void)47 b(fits_get_errstatus)c(/)k(ffgerr)f +(\(int)h(status,)f(>)h(char)g(*err_text\))0 5601 y Fi(2)81 +b Fj(Return)35 b(the)h(top)g(\(oldest\))g(80-c)m(haracter)j(error)c +(message)i(from)e(the)h(in)m(ternal)f(CFITSIO)f(stac)m(k)j(of)f(error) +227 5714 y(messages)45 b(and)e(shift)g(an)m(y)h(remaining)e(messages)j +(on)f(the)g(stac)m(k)h(up)e(one)h(lev)m(el.)81 b(Call)42 +b(this)h(routine)1905 5942 y(29)p eop +%%Page: 30 38 +30 37 bop 0 299 a Fj(30)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(rep)s(eatedly)25 b(to)i(get)g(eac)m(h)g(message)f(in)f +(sequence.)39 b(The)26 b(function)e(returns)h(a)h(v)-5 +b(alue)25 b(=)g(0)h(and)g(a)g(n)m(ull)d(error)227 668 +y(message)32 b(when)d(the)i(error)f(stac)m(k)i(is)d(empt)m(y)-8 +b(.)95 923 y Fe(int)47 b(fits_read_errmsg)d(/)j(ffgmsg)f(\(char)h +(*err_msg\))0 1178 y Fi(3)81 b Fj(Prin)m(t)29 b(out)i(the)g(error)f +(message)i(corresp)s(onding)d(to)i(the)g(input)e(status)i(v)-5 +b(alue)30 b(and)g(all)g(the)h(error)f(messages)227 1291 +y(on)d(the)h(CFITSIO)e(stac)m(k)j(to)f(the)f(sp)s(eci\014ed)f(\014le)g +(stream)i(\(normally)e(to)i(stdout)f(or)g(stderr\).)40 +b(If)26 b(the)i(input)227 1404 y(status)j(v)-5 b(alue)30 +b(=)g(0)h(then)f(this)f(routine)g(do)s(es)h(nothing.)95 +1659 y Fe(void)47 b(fits_report_error)c(/)48 b(ffrprt)e(\(FILE)g +(*stream,)g(>)h(status\))0 1914 y Fi(4)81 b Fj(The)44 +b(\014ts)p 461 1914 28 4 v 32 w(write)p 696 1914 V 32 +w(errmark)g(routine)g(puts)g(an)h(in)m(visible)c(mark)m(er)k(on)g(the)g +(CFITSIO)e(error)h(stac)m(k.)85 b(The)227 2027 y(\014ts)p +354 2027 V 33 w(clear)p 574 2027 V 33 w(errmark)31 b(routine)h(can)h +(then)f(b)s(e)f(used)h(to)h(delete)g(an)m(y)g(more)f(recen)m(t)i(error) +e(messages)h(on)g(the)227 2140 y(stac)m(k,)42 b(bac)m(k)c(to)g(the)g(p) +s(osition)e(of)i(the)g(mark)m(er.)63 b(This)36 b(preserv)m(es)h(an)m(y) +h(older)f(error)g(messages)i(on)f(the)227 2253 y(stac)m(k.)77 +b(The)41 b(\014ts)p 855 2253 V 32 w(clear)p 1074 2253 +V 33 w(errmsg)g(routine)g(simply)e(clears)j(all)f(the)h(messages)g +(\(and)g(marks\))f(from)h(the)227 2365 y(stac)m(k.)g(These)31 +b(routines)e(are)i(called)e(without)h(an)m(y)g(argumen)m(ts.)95 +2620 y Fe(void)47 b(fits_write_errmark)c(/)k(ffpmrk)f(\(void\))95 +2733 y(void)h(fits_clear_errmark)c(/)k(ffcmrk)f(\(void\))95 +2846 y(void)h(fits_clear_errmsg)c(/)48 b(ffcmsg)e(\(void\))0 +3179 y Ff(5.2)135 b(FITS)44 b(File)i(Access)e(Routines)0 +3419 y Fi(1)81 b Fj(Op)s(en)29 b(an)h(existing)f(data)i(\014le.)227 +3663 y Fe(int)47 b(fits_open_file)d(/)k(ffopen)418 3776 +y(\(fitsfile)d(**fptr,)h(char)h(*filename,)e(int)i(iomode,)f(>)h(int)g +(*status\))227 4002 y(int)g(fits_open_diskfile)c(/)k(ffdkopen)418 +4115 y(\(fitsfile)e(**fptr,)h(char)h(*filename,)e(int)i(iomode,)f(>)h +(int)g(*status\))227 4340 y(int)g(fits_open_data)d(/)k(ffdopn)418 +4453 y(\(fitsfile)d(**fptr,)h(char)h(*filename,)e(int)i(iomode,)f(>)h +(int)g(*status\))227 4679 y(int)g(fits_open_table)d(/)j(fftopn)418 +4792 y(\(fitsfile)e(**fptr,)h(char)h(*filename,)e(int)i(iomode,)f(>)h +(int)g(*status\))227 5018 y(int)g(fits_open_image)d(/)j(ffiopn)418 +5131 y(\(fitsfile)e(**fptr,)h(char)h(*filename,)e(int)i(iomode,)f(>)h +(int)g(*status\))227 5375 y Fj(The)41 b(iomo)s(de)g(parameter)h +(determines)f(the)g(read/write)g(access)i(allo)m(w)m(ed)f(in)e(the)h +(\014le)g(and)g(can)h(ha)m(v)m(e)227 5488 y(v)-5 b(alues)31 +b(of)h(READONL)-8 b(Y)32 b(\(0\))g(or)g(READ)m(WRITE)g(\(1\).)44 +b(The)31 b(\014lename)g(parameter)h(giv)m(es)g(the)f(name)h(of)227 +5601 y(the)f(\014le)f(to)h(b)s(e)f(op)s(ened,)h(follo)m(w)m(ed)f(b)m(y) +h(an)f(optional)g(argumen)m(t)h(giving)f(the)h(name)f(or)h(index)e(n)m +(um)m(b)s(er)h(of)227 5714 y(the)d(extension)f(within)f(the)h(FITS)g +(\014le)g(that)h(should)e(b)s(e)h(mo)m(v)m(ed)i(to)f(and)f(op)s(ened)g +(\(e.g.,)k Fe(myfile.fits+3)p eop +%%Page: 31 39 +31 38 bop 0 299 a Fh(5.2.)72 b(FITS)30 b(FILE)g(A)m(CCESS)f(R)m +(OUTINES)2244 b Fj(31)227 555 y(or)36 b Fe(myfile.fits[3])d +Fj(mo)m(v)m(es)k(to)g(the)g(3rd)f(extension)f(within)f(the)j(\014le,)g +(and)e Fe(myfile.fits[events])227 668 y Fj(mo)m(v)m(es)d(to)f(the)g +(extension)f(with)f(the)h(k)m(eyw)m(ord)h(EXTNAME)g(=)f('EVENTS'\).)227 +816 y(The)37 b(\014ts)p 548 816 28 4 v 32 w(op)s(en)p +770 816 V 32 w(disk\014le)e(routine)h(is)g(similar)e(to)k(the)f(\014ts) +p 2241 816 V 33 w(op)s(en)p 2464 816 V 32 w(\014le)f(routine)g(except)i +(that)f(it)g(do)s(es)g(not)227 929 y(supp)s(ort)22 b(the)h(extended)h +(\014lename)e(syn)m(tax)i(in)e(the)i(input)d(\014le)i(name.)38 +b(This)22 b(routine)g(simply)f(tries)i(to)h(op)s(en)227 +1042 y(the)36 b(sp)s(eci\014ed)d(input)h(\014le)g(on)h(magnetic)h +(disk.)54 b(This)33 b(routine)h(is)h(mainly)e(for)i(use)g(in)f(cases)i +(where)f(the)227 1155 y(\014lename)e(\(or)i(directory)e(path\))h(con)m +(tains)g(square)g(or)g(curly)e(brac)m(k)m(et)k(c)m(haracters)f(that)f +(w)m(ould)f(confuse)227 1268 y(the)e(extended)f(\014lename)g(parser.) +227 1416 y(The)j(\014ts)p 544 1416 V 32 w(op)s(en)p 766 +1416 V 32 w(data)h(routine)d(is)h(similar)e(to)k(the)f(\014ts)p +2113 1416 V 32 w(op)s(en)p 2335 1416 V 33 w(\014le)e(routine)h(except)i +(that)f(it)g(will)d(mo)m(v)m(e)k(to)227 1529 y(the)23 +b(\014rst)f(HDU)h(con)m(taining)f(signi\014can)m(t)f(data,)k(if)d(a)h +(HDU)g(name)f(or)h(n)m(um)m(b)s(er)e(to)i(op)s(en)f(w)m(as)h(not)f +(explicitly)227 1642 y(sp)s(eci\014ed)36 b(as)h(part)h(of)f(the)h +(\014lename.)60 b(In)37 b(this)f(case,)k(it)d(will)e(lo)s(ok)i(for)g +(the)g(\014rst)g(IMA)m(GE)h(HDU)g(with)227 1755 y(NAXIS)e(>)f(0,)j(or)d +(the)h(\014rst)f(table)g(that)i(do)s(es)e(not)h(con)m(tain)g(the)g +(strings)e(`GTI')i(\(Go)s(o)s(d)g(Time)e(In)m(terv)-5 +b(al)227 1868 y(extension\))31 b(or)f(`OBST)-8 b(ABLE')31 +b(in)e(the)h(EXTNAME)h(k)m(eyw)m(ord)g(v)-5 b(alue.)227 +2016 y(The)25 b(\014ts)p 536 2016 V 32 w(op)s(en)p 758 +2016 V 32 w(table)g(and)f(\014ts)p 1305 2016 V 33 w(op)s(en)p +1528 2016 V 32 w(image)h(routines)f(are)h(similar)e(to)i(\014ts)p +2828 2016 V 33 w(op)s(en)p 3051 2016 V 32 w(data)h(except)f(they)h +(will)227 2129 y(mo)m(v)m(e)h(to)g(the)f(\014rst)f(signi\014can)m(t)f +(table)i(HDU)g(or)g(image)g(HDU)g(in)e(the)i(\014le,)g(resp)s(ectiv)m +(ely)-8 b(,)27 b(if)d(a)i(HDU)h(name)227 2242 y(or)k(n)m(um)m(b)s(er)e +(is)g(not)i(sp)s(eci\014ed)d(as)j(part)f(of)h(the)f(\014lename.)227 +2390 y(IRAF)c(images)f(\(.imh)g(format)h(\014les\))e(and)h(ra)m(w)h +(binary)d(data)k(arra)m(ys)e(ma)m(y)h(also)g(b)s(e)f(op)s(ened)f(with)g +(READ-)227 2503 y(ONL)-8 b(Y)37 b(access.)60 b(CFITSIO)35 +b(will)f(automatically)i(test)i(if)d(the)i(input)d(\014le)i(is)f(an)i +(IRAF)f(image,)j(and)d(if,)227 2616 y(so)c(will)d(con)m(v)m(ert)k(it)e +(on)g(the)h(\015y)f(in)m(to)h(a)g(virtual)d(FITS)i(image)h(b)s(efore)f +(it)g(is)g(op)s(ened)f(b)m(y)i(the)g(application)227 +2729 y(program.)64 b(If)37 b(the)h(input)f(\014le)g(is)g(a)h(ra)m(w)g +(binary)f(data)h(arra)m(y)h(of)f(n)m(um)m(b)s(ers,)h(then)e(the)i(data) +f(t)m(yp)s(e)h(and)227 2842 y(dimensions)34 b(of)i(the)g(arra)m(y)h(m)m +(ust)f(b)s(e)f(sp)s(eci\014ed)f(in)h(square)h(brac)m(k)m(ets)h(follo)m +(wing)e(the)h(name)g(of)h(the)f(\014le)227 2955 y(\(e.g.)56 +b('ra)m(w\014le.dat[i512,512]')38 b(op)s(ens)c(a)i(512)g(x)f(512)h +(short)e(in)m(teger)i(image\).)55 b(See)35 b(the)g(`Extended)g(File)227 +3068 y(Name)k(Syn)m(tax')g(c)m(hapter)g(for)e(more)i(details)e(on)h(ho) +m(w)g(to)h(sp)s(ecify)e(the)h(ra)m(w)h(\014le)e(name.)64 +b(The)38 b(ra)m(w)g(\014le)227 3181 y(is)j(con)m(v)m(erted)h(on)f(the)h +(\015y)f(in)m(to)g(a)g(virtual)f(FITS)g(image)i(in)e(memory)h(that)h +(is)e(then)h(op)s(ened)g(b)m(y)g(the)227 3294 y(application)29 +b(program)h(with)f(READONL)-8 b(Y)31 b(access.)227 3442 +y(Programs)g(can)g(read)f(the)h(input)d(\014le)i(from)g(the)h('stdin')e +(\014le)h(stream)h(if)e(a)i(dash)f(c)m(haracter)i(\('-'\))g(is)e(giv)m +(en)227 3555 y(as)f(the)f(\014lename.)39 b(Files)28 b(can)g(also)g(b)s +(e)g(op)s(ened)f(o)m(v)m(er)j(the)e(net)m(w)m(ork)h(using)e(FTP)h(or)g +(HTTP)g(proto)s(cols)g(b)m(y)227 3668 y(supplying)f(the)k(appropriate)e +(URL)i(as)f(the)h(\014lename.)227 3816 y(The)43 b(input)e(\014le)h(can) +i(b)s(e)f(mo)s(di\014ed)e(in)g(v)-5 b(arious)43 b(w)m(a)m(ys)h(to)g +(create)g(a)g(virtual)d(\014le)i(\(usually)e(stored)i(in)227 +3929 y(memory\))31 b(that)g(is)f(then)g(op)s(ened)f(b)m(y)i(the)f +(application)f(program)h(b)m(y)h(supplying)c(a)k(\014ltering)e(or)h +(binning)227 4042 y(sp)s(eci\014er)d(in)g(square)h(brac)m(k)m(ets)h +(follo)m(wing)e(the)h(\014lename.)39 b(Some)29 b(of)f(the)g(more)h +(common)f(\014ltering)f(meth-)227 4155 y(o)s(ds)32 b(are)h(illustrated) +e(in)g(the)i(follo)m(wing)f(paragraphs,)h(but)f(users)g(should)e(refer) +j(to)g(the)g('Extended)g(File)227 4268 y(Name)e(Syn)m(tax')g(c)m +(hapter)g(for)f(a)h(complete)g(description)d(of)j(the)f(full)f(\014le)g +(\014ltering)g(syn)m(tax.)227 4416 y(When)e(op)s(ening)e(an)i(image,)g +(a)h(rectangular)e(subset)g(of)h(the)g(ph)m(ysical)e(image)i(ma)m(y)h +(b)s(e)e(op)s(ened)f(b)m(y)i(listing)227 4529 y(the)k(\014rst)e(and)h +(last)g(pixel)f(in)g(eac)m(h)j(dimension)c(\(and)i(optional)f(pixel)g +(skipping)f(factor\):)227 4765 y Fe(myimage.fits[101:200,301:)o(400]) +227 5001 y Fj(will)f(create)k(and)e(op)s(en)f(a)i(100x100)i(pixel)c +(virtual)g(image)h(of)h(that)g(section)f(of)h(the)f(ph)m(ysical)f +(image,)j(and)227 5114 y Fe(myimage.fits[*,-*])d Fj(op)s(ens)k(a)h +(virtual)e(image)i(that)g(is)f(the)h(same)g(size)g(as)f(the)h(ph)m +(ysical)f(image)h(but)227 5227 y(has)d(b)s(een)g(\015ipp)s(ed)e(in)h +(the)h(v)m(ertical)h(direction.)227 5375 y(When)d(op)s(ening)f(a)h +(table,)h(the)f(\014ltering)e(syn)m(tax)j(can)f(b)s(e)f(used)h(to)g +(add)g(or)g(delete)g(columns)f(or)h(k)m(eyw)m(ords)227 +5488 y(in)f(the)h(virtual)f(table:)39 b Fe(myfile.fits[events][col)j +(!time;)k(PI)h(=)h(PHA*1.2])26 b Fj(op)s(ens)h(a)h(virtual)f(ta-)227 +5601 y(ble)k(in)f(whic)m(h)g(the)i(TIME)f(column)f(has)h(b)s(een)g +(deleted)g(and)g(a)g(new)g(PI)g(column)g(has)g(b)s(een)g(added)f(with) +227 5714 y(a)41 b(v)-5 b(alue)39 b(1.2)j(times)d(that)i(of)f(the)h(PHA) +f(column.)69 b(Similarly)-8 b(,)39 b(one)i(can)f(\014lter)g(a)g(table)g +(to)h(k)m(eep)g(only)p eop +%%Page: 32 40 +32 39 bop 0 299 a Fj(32)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(those)35 b(ro)m(ws)e(that)i(satisfy)e(a)h(selection)g +(criterion:)46 b Fe(myfile.fits[events][pha)c(>)47 b(50])33 +b Fj(creates)j(and)227 668 y(op)s(ens)31 b(a)g(virtual)f(table)h(con)m +(taining)g(only)f(those)i(ro)m(ws)f(with)f(a)h(PHA)h(v)-5 +b(alue)30 b(greater)j(than)e(50.)44 b(A)31 b(large)227 +781 y(n)m(um)m(b)s(er)d(of)h(b)s(o)s(olean)g(and)f(mathematical)i(op)s +(erators)f(can)g(b)s(e)g(used)f(in)g(the)h(selection)g(expression.)39 +b(One)227 894 y(can)25 b(also)f(\014lter)g(table)g(ro)m(ws)g(using)f +('Go)s(o)s(d)i(Time)e(In)m(terv)-5 b(al')25 b(extensions,)g(and)f +(spatial)f(region)h(\014lters)g(as)g(in)227 1007 y Fe +(myfile.fits[events][gtifi)o(lter)o(\(\)])14 b Fj(and)19 +b Fe(myfile.fits[events][regfil)o(ter)o(\()42 b("stars.rng"\)])p +Fj(.)227 1167 y(Finally)-8 b(,)31 b(table)g(columns)f(ma)m(y)i(b)s(e)f +(binned)e(or)i(histogrammed)g(to)h(generate)h(a)e(virtual)f(image.)44 +b(F)-8 b(or)32 b(ex-)227 1280 y(ample,)c Fe(myfile.fits[events][bin)41 +b(\(X,Y\)=4])26 b Fj(will)e(result)j(in)f(a)i(2-dimensional)d(image)j +(calculated)227 1393 y(b)m(y)35 b(binning)c(the)k(X)f(and)g(Y)h +(columns)e(in)g(the)i(ev)m(en)m(t)h(table)e(with)f(a)i(bin)e(size)h(of) +h(4)f(in)g(eac)m(h)h(dimension.)227 1506 y(The)30 b(TLMINn)g(and)f +(TLMAXn)h(k)m(eyw)m(ords)h(will)d(b)s(e)h(used)h(b)m(y)g(default)g(to)h +(determine)e(the)i(range)f(of)h(the)227 1619 y(image.)227 +1779 y(A)j(single)e(program)h(can)g(op)s(en)g(the)h(same)f(FITS)g +(\014le)f(more)i(than)f(once)h(and)f(then)g(treat)h(the)g(resulting)227 +1892 y(\014ts\014le)29 b(p)s(oin)m(ters)g(as)h(though)g(they)g(w)m(ere) +h(completely)f(indep)s(enden)m(t)e(FITS)h(\014les.)39 +b(Using)30 b(this)f(facilit)m(y)-8 b(,)30 b(a)227 2005 +y(program)i(can)f(op)s(en)g(a)h(FITS)f(\014le)f(t)m(wice,)j(mo)m(v)m(e) +g(to)f(2)g(di\013eren)m(t)f(extensions)g(within)e(the)i(\014le,)g(and)g +(then)227 2118 y(read)g(and)e(write)h(data)h(in)e(those)i(extensions)f +(in)f(an)m(y)i(order.)0 2397 y Fi(2)81 b Fj(Create)31 +b(and)f(op)s(en)f(a)i(new)f(empt)m(y)h(output)f(FITS)f(\014le.)227 +2677 y Fe(int)47 b(fits_create_file)d(/)j(ffinit)418 +2790 y(\(fitsfile)e(**fptr,)h(char)h(*filename,)e(>)i(int)g(*status\)) +227 3016 y(int)g(fits_create_diskfile)42 b(/)48 b(ffdkinit)418 +3129 y(\(fitsfile)d(**fptr,)h(char)h(*filename,)e(>)i(int)g(*status\)) +227 3409 y Fj(An)36 b(error)h(will)d(b)s(e)i(returned)f(if)g(the)i(sp)s +(eci\014ed)e(\014le)h(already)g(exists,)i(unless)d(the)i(\014lename)e +(is)h(pre\014xed)227 3522 y(with)29 b(an)h(exclamation)g(p)s(oin)m(t)f +(\(!\).)42 b(In)29 b(that)i(case)g(CFITSIO)d(will)g(o)m(v)m(erwrite)i +(\(delete\))h(an)m(y)g(existing)e(\014le)227 3635 y(with)35 +b(the)h(same)h(name.)57 b(Note)38 b(that)e(the)h(exclamation)f(p)s(oin) +m(t)f(is)g(a)i(sp)s(ecial)d(UNIX)i(c)m(haracter)i(so)e(if)f(it)227 +3748 y(is)d(used)f(on)h(the)h(command)f(line)f(it)h(m)m(ust)g(b)s(e)g +(preceded)g(b)m(y)g(a)g(bac)m(kslash)g(to)i(force)e(the)h(UNIX)g(shell) +d(to)227 3860 y(accept)i(the)f(c)m(haracter)h(as)e(part)g(of)h(the)g +(\014lename.)227 4021 y(The)26 b(output)h(\014le)f(will)e(b)s(e)i +(written)g(to)h(the)g('stdout')g(\014le)f(stream)h(if)f(a)h(dash)f(c)m +(haracter)i(\('-'\))g(or)f(the)g(string)227 4134 y('stdout')34 +b(is)e(giv)m(en)h(as)h(the)f(\014lename.)48 b(Similarly)-8 +b(,)31 b('-.gz')k(or)e('stdout.gz')i(will)c(cause)i(the)h(\014le)e(to)i +(b)s(e)e(gzip)227 4247 y(compressed)e(b)s(efore)g(it)g(is)g(written)f +(out)i(to)g(the)f(stdout)h(stream.)227 4407 y(Optionally)-8 +b(,)38 b(the)f(name)h(of)f(a)h(template)g(\014le)e(that)i(is)e(used)h +(to)h(de\014ne)f(the)g(structure)g(of)g(the)h(new)f(\014le)227 +4520 y(ma)m(y)i(b)s(e)f(sp)s(eci\014ed)e(in)h(paren)m(theses)i(follo)m +(wing)d(the)j(output)e(\014le)h(name.)64 b(The)38 b(template)g(\014le)g +(ma)m(y)h(b)s(e)227 4633 y(another)32 b(FITS)e(\014le,)h(in)f(whic)m(h) +g(case)j(the)e(new)g(\014le,)g(at)h(the)g(time)f(it)f(is)h(op)s(ened,)g +(will)d(b)s(e)j(an)g(exact)i(cop)m(y)227 4746 y(of)38 +b(the)g(template)h(\014le)e(except)h(that)h(the)f(data)g(structures)g +(\(images)g(and)f(tables\))h(will)d(b)s(e)j(\014lled)d(with)227 +4858 y(zeros.)41 b(Alternativ)m(ely)-8 b(,)29 b(the)g(template)h +(\014le)e(ma)m(y)h(b)s(e)f(an)h(ASCI)s(I)e(format)i(text)h(\014le)e +(con)m(taining)h(directiv)m(es)227 4971 y(that)g(de\014ne)e(the)h(k)m +(eyw)m(ords)g(to)g(b)s(e)g(created)h(in)d(eac)m(h)j(HDU)g(of)f(the)g +(\014le.)39 b(See)28 b(the)g('Extended)f(File)g(Name)227 +5084 y(Syn)m(tax')k(section)g(for)f(a)h(complete)f(description)f(of)h +(the)h(template)g(\014le)e(syn)m(tax.)227 5245 y(The)g(\014ts)p +540 5245 28 4 v 33 w(create)p 809 5245 V 34 w(disk\014le)e(routine)i +(is)g(similar)e(to)j(the)g(\014ts)p 2238 5245 V 32 w(create)p +2506 5245 V 34 w(\014le)f(routine)g(except)h(that)g(it)f(do)s(es)h(not) +227 5357 y(supp)s(ort)36 b(the)i(extended)g(\014lename)f(syn)m(tax)h +(in)f(the)h(input)e(\014le)h(name.)63 b(This)36 b(routine)h(simply)e +(tries)i(to)227 5470 y(create)f(the)e(sp)s(eci\014ed)e(\014le)h(on)g +(magnetic)i(disk.)49 b(This)32 b(routine)h(is)g(mainly)f(for)i(use)f +(in)g(cases)h(where)g(the)227 5583 y(\014lename)f(\(or)i(directory)e +(path\))h(con)m(tains)g(square)g(or)g(curly)e(brac)m(k)m(et)k(c)m +(haracters)f(that)f(w)m(ould)f(confuse)227 5696 y(the)e(extended)f +(\014lename)g(parser.)p eop +%%Page: 33 41 +33 40 bop 0 299 a Fh(5.3.)72 b(HDU)31 b(A)m(CCESS)e(R)m(OUTINES)2488 +b Fj(33)0 555 y Fi(3)81 b Fj(Close)27 b(a)g(previously)e(op)s(ened)i +(FITS)g(\014le.)39 b(The)27 b(\014rst)f(routine)h(simply)e(closes)i +(the)h(\014le,)f(whereas)g(the)h(second)227 668 y(one)41 +b(also)f(DELETES)f(THE)h(FILE,)g(whic)m(h)f(can)i(b)s(e)e(useful)g(in)g +(cases)i(where)e(a)i(FITS)e(\014le)h(has)g(b)s(een)227 +781 y(partially)29 b(created,)i(but)f(then)g(an)g(error)g(o)s(ccurs)g +(whic)m(h)g(prev)m(en)m(ts)g(it)g(from)g(b)s(eing)f(completed.)95 +1033 y Fe(int)47 b(fits_close_file)d(/)j(ffclos)g(\(fitsfile)e(*fptr,)h +(>)h(int)g(*status\))95 1258 y(int)g(fits_delete_file)d(/)j(ffdelt)f +(\(fitsfile)g(*fptr,)g(>)h(int)g(*status\))0 1510 y Fi(4)81 +b Fj(Return)21 b(the)i(name,)h(I/O)e(mo)s(de)g(\(READONL)-8 +b(Y)24 b(or)e(READ)m(WRITE\),)i(and/or)e(the)g(\014le)g(t)m(yp)s(e)g +(\(e.g.)40 b('\014le://',)227 1623 y('ftp://'\))32 b(of)f(the)f(op)s +(ened)g(FITS)g(\014le.)95 1875 y Fe(int)47 b(fits_file_name)d(/)k +(ffflnm)e(\(fitsfile)f(*fptr,)h(>)i(char)e(*filename,)f(int)i +(*status\))95 2100 y(int)g(fits_file_mode)d(/)k(ffflmd)e(\(fitsfile)f +(*fptr,)h(>)i(int)f(*iomode,)e(int)i(*status\))95 2326 +y(int)g(fits_url_type)e(/)i(ffurlt)f(\(fitsfile)f(*fptr,)h(>)i(char)f +(*urltype,)e(int)i(*status\))0 2659 y Ff(5.3)135 b(HDU)46 +b(Access)e(Routines)0 2909 y Fj(The)30 b(follo)m(wing)f(functions)g(p)s +(erform)g(op)s(erations)g(on)i(Header-Data)h(Units)e(\(HDUs\))i(as)e(a) +h(whole.)0 3161 y Fi(1)81 b Fj(Mo)m(v)m(e)44 b(to)g(a)f(di\013eren)m(t) +f(HDU)h(in)f(the)h(\014le.)76 b(The)43 b(\014rst)f(routine)f(mo)m(v)m +(es)j(to)g(a)f(sp)s(eci\014ed)e(absolute)h(HDU)227 3273 +y(n)m(um)m(b)s(er)g(\(starting)g(with)g(1)g(for)h(the)g(primary)d(arra) +m(y\))k(in)d(the)i(FITS)f(\014le,)j(and)d(the)g(second)h(routine)227 +3386 y(mo)m(v)m(es)35 b(a)e(relativ)m(e)g(n)m(um)m(b)s(er)f(HDUs)i +(forw)m(ard)e(or)h(bac)m(kw)m(ard)h(from)f(the)g(curren)m(t)g(HDU.)h(A) +f(n)m(ull)e(p)s(oin)m(ter)227 3499 y(ma)m(y)g(b)s(e)f(giv)m(en)g(for)g +(the)g(hdut)m(yp)s(e)f(parameter)i(if)e(it's)h(v)-5 b(alue)30 +b(is)f(not)i(needed.)40 b(The)30 b(third)e(routine)i(mo)m(v)m(es)227 +3612 y(to)39 b(the)g(\(\014rst\))f(HDU)i(whic)m(h)d(has)h(the)h(sp)s +(eci\014ed)d(extension)i(t)m(yp)s(e)h(and)f(EXTNAME)g(and)g(EXTVER)227 +3725 y(k)m(eyw)m(ord)26 b(v)-5 b(alues)25 b(\(or)h(HDUNAME)h(and)e +(HDUVER)h(k)m(eyw)m(ords\).)40 b(The)24 b(hdut)m(yp)s(e)h(parameter)h +(ma)m(y)g(ha)m(v)m(e)227 3838 y(a)d(v)-5 b(alue)21 b(of)h(IMA)m(GE)p +935 3838 28 4 v 34 w(HDU,)h(ASCI)s(I)p 1476 3838 V 31 +w(TBL,)f(BINAR)-8 b(Y)p 2101 3838 V 34 w(TBL,)22 b(or)g(ANY)p +2676 3838 V 34 w(HDU)g(where)g(ANY)p 3396 3838 V 33 w(HDU)h(means)227 +3951 y(that)33 b(only)f(the)g(extname)i(and)d(extv)m(er)j(v)-5 +b(alues)32 b(will)d(b)s(e)j(used)g(to)h(lo)s(cate)g(the)g(correct)g +(extension.)47 b(If)32 b(the)227 4064 y(input)h(v)-5 +b(alue)35 b(of)g(extv)m(er)h(is)e(0)i(then)e(the)i(EXTVER)e(k)m(eyw)m +(ord)i(is)e(ignored)g(and)h(the)g(\014rst)f(HDU)i(with)e(a)227 +4177 y(matc)m(hing)27 b(EXTNAME)h(\(or)f(HDUNAME\))i(k)m(eyw)m(ord)e +(will)d(b)s(e)j(found.)38 b(If)27 b(no)f(matc)m(hing)h(HDU)h(is)e +(found)227 4290 y(in)f(the)h(\014le)f(then)h(the)g(curren)m(t)g(HDU)g +(will)e(remain)h(unc)m(hanged)g(and)h(a)g(status)g(=)g(BAD)p +3246 4290 V 33 w(HDU)p 3484 4290 V 34 w(NUM)h(will)227 +4403 y(b)s(e)j(returned.)95 4654 y Fe(int)47 b(fits_movabs_hdu)d(/)j +(ffmahd)286 4767 y(\(fitsfile)f(*fptr,)g(int)h(hdunum,)e(>)j(int)f +(*hdutype,)e(int)i(*status\))95 4993 y(int)g(fits_movrel_hdu)d(/)j +(ffmrhd)286 5106 y(\(fitsfile)f(*fptr,)g(int)h(nmove,)f(>)h(int)g +(*hdutype,)e(int)i(*status\))95 5332 y(int)g(fits_movnam_hdu)d(/)j +(ffmnhd)286 5445 y(\(fitsfile)f(*fptr,)g(int)h(hdutype,)e(char)i +(*extname,)e(int)i(extver,)f(>)h(int)g(*status\))0 5696 +y Fi(2)81 b Fj(Return)29 b(the)i(total)g(n)m(um)m(b)s(er)e(of)i(HDUs)f +(in)g(the)g(FITS)g(\014le.)40 b(The)29 b(curren)m(t)i(HDU)g(remains)e +(unc)m(hanged.)p eop +%%Page: 34 42 +34 41 bop 0 299 a Fj(34)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)95 +555 y Fe(int)47 b(fits_get_num_hdus)c(/)48 b(ffthdu)286 +668 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*hdunum,)f(int)h(*status\))0 +922 y Fi(3)81 b Fj(Return)31 b(the)h(n)m(um)m(b)s(er)f(of)h(the)h +(curren)m(t)e(HDU)i(\(CHDU\))h(in)c(the)j(FITS)e(\014le)g(\(where)h +(the)g(primary)f(arra)m(y)h(=)227 1034 y(1\).)42 b(This)28 +b(function)h(returns)h(the)g(HDU)h(n)m(um)m(b)s(er)e(rather)h(than)h(a) +f(status)h(v)-5 b(alue.)95 1288 y Fe(int)47 b(fits_get_hdu_num)d(/)j +(ffghdn)286 1401 y(\(fitsfile)f(*fptr,)g(>)h(int)g(*hdunum\))0 +1654 y Fi(4)81 b Fj(Return)38 b(the)h(t)m(yp)s(e)h(of)f(the)h(curren)m +(t)f(HDU)h(in)e(the)h(FITS)g(\014le.)66 b(The)39 b(p)s(ossible)e(v)-5 +b(alues)38 b(for)h(hdut)m(yp)s(e)f(are:)227 1767 y(IMA)m(GE)p +546 1767 28 4 v 34 w(HDU,)31 b(ASCI)s(I)p 1095 1767 V +32 w(TBL,)f(or)g(BINAR)-8 b(Y)p 1840 1767 V 34 w(TBL.)95 +2021 y Fe(int)47 b(fits_get_hdu_type)c(/)48 b(ffghdt)286 +2133 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*hdutype,)e(int)i(*status\))0 +2387 y Fi(5)81 b Fj(Cop)m(y)24 b(all)f(or)h(part)g(of)g(the)g(HDUs)h +(in)e(the)h(FITS)g(\014le)f(asso)s(ciated)h(with)f(infptr)f(and)i(app)s +(end)e(them)i(to)h(the)g(end)227 2500 y(of)f(the)f(FITS)f(\014le)h +(asso)s(ciated)g(with)f(outfptr.)38 b(If)23 b('previous')f(is)g(true)h +(\(not)h(0\),)i(then)d(an)m(y)g(HDUs)h(preceding)227 +2613 y(the)35 b(curren)m(t)f(HDU)g(in)f(the)i(input)d(\014le)h(will)f +(b)s(e)h(copied)h(to)h(the)f(output)g(\014le.)51 b(Similarly)-8 +b(,)32 b('curren)m(t')j(and)227 2726 y('follo)m(wing')28 +b(determine)g(whether)g(the)h(curren)m(t)g(HDU,)g(and/or)g(an)m(y)g +(follo)m(wing)e(HDUs)j(in)d(the)i(input)e(\014le)227 +2838 y(will)g(b)s(e)i(copied)h(to)g(the)g(output)f(\014le.)40 +b(Th)m(us,)29 b(if)f(all)h(3)h(parameters)g(are)g(true,)g(then)g(the)f +(en)m(tire)h(input)e(\014le)227 2951 y(will)33 b(b)s(e)h(copied.)55 +b(On)35 b(exit,)h(the)g(curren)m(t)f(HDU)h(in)d(the)j(input)d(\014le)i +(will)d(b)s(e)j(unc)m(hanged,)h(and)f(the)g(last)227 +3064 y(HDU)c(in)e(the)i(output)f(\014le)f(will)f(b)s(e)i(the)g(curren)m +(t)h(HDU.)95 3318 y Fe(int)47 b(fits_copy_file)d(/)k(ffcpfl)286 +3431 y(\(fitsfile)e(*infptr,)f(fitsfile)h(*outfptr,)f(int)i(previous,)e +(int)i(current,)477 3544 y(int)g(following,)e(>)j(int)f(*status\))0 +3797 y Fi(6)81 b Fj(Cop)m(y)34 b(the)h(curren)m(t)f(HDU)h(from)f(the)g +(FITS)g(\014le)g(asso)s(ciated)g(with)g(infptr)e(and)i(app)s(end)e(it)i +(to)h(the)g(end)f(of)227 3910 y(the)39 b(FITS)e(\014le)g(asso)s(ciated) +i(with)e(outfptr.)64 b(Space)38 b(ma)m(y)h(b)s(e)e(reserv)m(ed)i(for)f +(MOREKEYS)f(additional)227 4023 y(k)m(eyw)m(ords)31 b(in)e(the)i +(output)f(header.)95 4276 y Fe(int)47 b(fits_copy_hdu)e(/)i(ffcopy)286 +4389 y(\(fitsfile)f(*infptr,)f(fitsfile)h(*outfptr,)f(int)i(morekeys,)e +(>)j(int)f(*status\))0 4642 y Fi(7)81 b Fj(Cop)m(y)43 +b(the)h(header)g(\(and)f(not)h(the)g(data\))h(from)e(the)h(CHDU)g(asso) +s(ciated)g(with)f(infptr)e(to)k(the)f(CHDU)227 4755 y(asso)s(ciated)27 +b(with)e(outfptr.)39 b(If)26 b(the)h(curren)m(t)f(output)g(HDU)h(is)f +(not)g(completely)g(empt)m(y)-8 b(,)29 b(then)d(the)h(CHDU)227 +4868 y(will)32 b(b)s(e)i(closed)g(and)g(a)h(new)f(HDU)h(will)d(b)s(e)i +(app)s(ended)e(to)j(the)g(output)f(\014le.)52 b(An)34 +b(empt)m(y)h(output)f(data)227 4981 y(unit)29 b(will)f(b)s(e)i(created) +h(with)e(all)g(v)-5 b(alues)30 b(initially)d(=)j(0\).)95 +5235 y Fe(int)47 b(fits_copy_header)d(/)j(ffcphd)286 +5348 y(\(fitsfile)f(*infptr,)f(fitsfile)h(*outfptr,)f(>)i(int)g +(*status\))0 5601 y Fi(8)81 b Fj(Delete)34 b(the)f(CHDU)h(in)e(the)h +(FITS)f(\014le.)49 b(An)m(y)33 b(follo)m(wing)f(HDUs)h(will)e(b)s(e)h +(shifted)g(forw)m(ard)h(in)f(the)h(\014le,)g(to)227 5714 +y(\014ll)j(in)g(the)h(gap)h(created)g(b)m(y)g(the)f(deleted)g(HDU.)i +(In)d(the)i(case)g(of)g(deleting)e(the)i(primary)d(arra)m(y)j(\(the)p +eop +%%Page: 35 43 +35 42 bop 0 299 a Fh(5.4.)72 b(HEADER)31 b(KEYW)m(ORD)g(READ/WRITE)g(R) +m(OUTINES)1495 b Fj(35)227 555 y(\014rst)30 b(HDU)h(in)e(the)i +(\014le\))f(then)g(the)h(curren)m(t)f(primary)e(arra)m(y)j(will)d(b)s +(e)i(replace)g(b)m(y)h(a)g(n)m(ull)d(primary)g(arra)m(y)227 +668 y(con)m(taining)j(the)h(minim)m(um)c(set)k(of)g(required)d(k)m(eyw) +m(ords)j(and)e(no)i(data.)44 b(If)31 b(there)g(are)h(more)f(extensions) +227 781 y(in)e(the)h(\014le)f(follo)m(wing)g(the)h(one)g(that)h(is)e +(deleted,)h(then)g(the)g(the)g(CHDU)h(will)c(b)s(e)j(rede\014ned)e(to)j +(p)s(oin)m(t)e(to)227 894 y(the)e(follo)m(wing)e(extension.)40 +b(If)26 b(there)h(are)g(no)g(follo)m(wing)e(extensions)h(then)h(the)g +(CHDU)g(will)d(b)s(e)i(rede\014ned)227 1007 y(to)36 b(p)s(oin)m(t)e(to) +h(the)g(previous)e(HDU.)j(The)e(output)h(hdut)m(yp)s(e)e(parameter)i +(returns)f(the)h(t)m(yp)s(e)g(of)f(the)h(new)227 1120 +y(CHDU.)c(A)g(n)m(ull)d(p)s(oin)m(ter)h(ma)m(y)i(b)s(e)f(giv)m(en)h +(for)f(hdut)m(yp)s(e)f(if)g(the)i(returned)e(v)-5 b(alue)30 +b(is)f(not)i(needed.)95 1401 y Fe(int)47 b(fits_delete_hdu)d(/)j +(ffdhdu)286 1514 y(\(fitsfile)f(*fptr,)g(>)h(int)g(*hdutype,)e(int)i +(*status\))0 1872 y Ff(5.4)135 b(Header)46 b(Keyw)l(ord)g(Read/W)-11 +b(rite)46 b(Routines)0 2128 y Fj(These)35 b(routines)f(read)g(or)h +(write)g(k)m(eyw)m(ords)g(in)f(the)h(Curren)m(t)f(Header)h(Unit)f +(\(CHU\).)i(Wild)e(card)g(c)m(haracters)0 2240 y(\(*,)28 +b(?,)g(or)e(#\))h(ma)m(y)g(b)s(e)f(used)g(when)f(sp)s(ecifying)g(the)i +(name)f(of)h(the)g(k)m(eyw)m(ord)g(to)g(b)s(e)f(read:)39 +b(a)27 b(')10 b(?')39 b(will)24 b(matc)m(h)k(an)m(y)0 +2353 y(single)33 b(c)m(haracter)i(at)g(that)f(p)s(osition)e(in)h(the)h +(k)m(eyw)m(ord)h(name)f(and)f(a)h('*')h(will)d(matc)m(h)i(an)m(y)h +(length)e(\(including)0 2466 y(zero\))d(string)e(of)h(c)m(haracters.)42 +b(The)28 b('#')h(c)m(haracter)i(will)26 b(matc)m(h)k(an)m(y)f +(consecutiv)m(e)h(string)e(of)h(decimal)f(digits)f(\(0)0 +2579 y(-)35 b(9\).)55 b(When)35 b(a)g(wild)e(card)i(is)f(used)g(the)h +(routine)f(will)e(only)i(searc)m(h)i(for)f(a)g(matc)m(h)h(from)e(the)h +(curren)m(t)g(header)0 2692 y(p)s(osition)25 b(to)j(the)f(end)f(of)h +(the)g(header)g(and)f(will)e(not)j(resume)g(the)g(searc)m(h)g(from)g +(the)g(top)g(of)g(the)g(header)g(bac)m(k)g(to)0 2805 +y(the)k(original)f(header)h(p)s(osition)e(as)j(is)e(done)h(when)f(no)h +(wildcards)e(are)j(included)c(in)i(the)h(k)m(eyw)m(ord)h(name.)43 +b(The)0 2918 y(\014ts)p 127 2918 28 4 v 32 w(read)p 331 +2918 V 33 w(record)32 b(routine)f(ma)m(y)h(b)s(e)g(used)f(to)h(set)h +(the)f(starting)g(p)s(osition)e(when)h(doing)g(wild)e(card)j(searc)m +(hs.)46 b(A)0 3031 y(status)29 b(v)-5 b(alue)29 b(of)g(KEY)p +809 3031 V 32 w(NO)p 980 3031 V 33 w(EXIST)f(is)g(returned)f(if)h(the)h +(sp)s(eci\014ed)e(k)m(eyw)m(ord)j(to)f(b)s(e)g(read)f(is)g(not)i(found) +d(in)h(the)0 3144 y(header.)0 3459 y Fd(5.4.1)112 b(Keyw)m(ord)38 +b(Reading)f(Routines)0 3684 y Fi(1)81 b Fj(Return)33 +b(the)h(n)m(um)m(b)s(er)e(of)i(existing)f(k)m(eyw)m(ords)i(\(not)f +(coun)m(ting)g(the)g(END)g(k)m(eyw)m(ord\))h(and)e(the)h(amoun)m(t)h +(of)227 3797 y(space)e(curren)m(tly)e(a)m(v)-5 b(ailable)31 +b(for)h(more)g(k)m(eyw)m(ords.)46 b(It)32 b(returns)e(morek)m(eys)j(=)f +(-1)g(if)f(the)h(header)g(has)g(not)227 3910 y(y)m(et)27 +b(b)s(een)d(closed.)39 b(Note)26 b(that)g(CFITSIO)d(will)g(dynamically) +g(add)h(space)i(if)e(required)f(when)h(writing)f(new)227 +4023 y(k)m(eyw)m(ords)32 b(to)g(a)f(header)g(so)h(in)e(practice)h +(there)h(is)e(no)h(limit)e(to)j(the)f(n)m(um)m(b)s(er)f(of)i(k)m(eyw)m +(ords)f(that)h(can)g(b)s(e)227 4136 y(added)e(to)h(a)f(header.)41 +b(A)30 b(n)m(ull)e(p)s(oin)m(ter)i(ma)m(y)g(b)s(e)g(en)m(tered)h(for)f +(the)g(morek)m(eys)h(parameter)g(if)e(it's)h(v)-5 b(alue)30 +b(is)227 4249 y(not)h(needed.)95 4530 y Fe(int)47 b(fits_get_hdrspace)c +(/)48 b(ffghsp)286 4642 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*keysexist,)e +(int)i(*morekeys,)e(int)i(*status\))0 4924 y Fi(2)81 +b Fj(Return)28 b(the)h(sp)s(eci\014ed)e(k)m(eyw)m(ord.)41 +b(In)29 b(the)g(\014rst)f(routine,)h(the)g(datat)m(yp)s(e)h(parameter)g +(sp)s(eci\014es)d(the)i(desired)227 5036 y(returned)e(data)h(t)m(yp)s +(e)g(of)g(the)g(k)m(eyw)m(ord)h(v)-5 b(alue)27 b(and)g(can)h(ha)m(v)m +(e)h(one)f(of)g(the)g(follo)m(wing)e(sym)m(b)s(olic)h(constan)m(t)227 +5149 y(v)-5 b(alues:)46 b(TSTRING,)33 b(TLOGICAL)f(\(==)h(in)m(t\),)i +(TBYTE,)e(TSHOR)-8 b(T,)33 b(TUSHOR)-8 b(T,)32 b(TINT,)h(TUINT,)227 +5262 y(TLONG,)39 b(TULONG,)f(TFLO)m(A)-8 b(T,)39 b(TDOUBLE,)g +(TCOMPLEX,)e(and)h(TDBLCOMPLEX.)h(Within)227 5375 y(the)c(con)m(text)h +(of)e(this)g(routine,)g(TSTRING)g(corresp)s(onds)e(to)j(a)g('c)m(har*') +h(data)f(t)m(yp)s(e,)h(i.e.,)f(a)g(p)s(oin)m(ter)e(to)227 +5488 y(a)e(c)m(haracter)i(arra)m(y)-8 b(.)43 b(Data)32 +b(t)m(yp)s(e)f(con)m(v)m(ersion)g(will)d(b)s(e)i(p)s(erformed)g(for)g +(n)m(umeric)g(v)-5 b(alues)30 b(if)g(the)g(k)m(eyw)m(ord)227 +5601 y(v)-5 b(alue)35 b(do)s(es)g(not)g(ha)m(v)m(e)h(the)f(same)h(data) +g(t)m(yp)s(e.)55 b(If)34 b(the)h(v)-5 b(alue)35 b(of)g(the)g(k)m(eyw)m +(ord)h(is)e(unde\014ned)f(\(i.e.,)k(the)227 5714 y(v)-5 +b(alue)30 b(\014eld)f(is)h(blank\))f(then)h(an)g(error)g(status)h(=)f +(V)-10 b(ALUE)p 2280 5714 V 33 w(UNDEFINED)31 b(will)d(b)s(e)i +(returned.)p eop +%%Page: 36 44 +36 43 bop 0 299 a Fj(36)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(The)36 b(second)g(routine)f(returns)g(the)h(k)m(eyw)m(ord)h(v) +-5 b(alue)35 b(as)h(a)h(c)m(haracter)h(string)d(\(a)h(literal)f(cop)m +(y)i(of)f(what)227 668 y(is)d(in)f(the)i(v)-5 b(alue)33 +b(\014eld\))f(regardless)h(of)g(the)h(in)m(trinsic)d(data)j(t)m(yp)s(e) +g(of)f(the)h(k)m(eyw)m(ord.)50 b(The)33 b(third)f(routine)227 +781 y(returns)d(the)i(en)m(tire)f(80-c)m(haracter)j(header)e(record)f +(of)g(the)h(k)m(eyw)m(ord.)227 927 y(If)f(a)h(NULL)f(commen)m(t)i(p)s +(oin)m(ter)d(is)g(supplied)f(then)i(the)g(commen)m(t)i(string)d(will)f +(not)i(b)s(e)g(returned.)95 1160 y Fe(int)47 b(fits_read_key)e(/)i +(ffgky)286 1273 y(\(fitsfile)f(*fptr,)g(int)h(datatype,)e(char)i +(*keyname,)e(>)i(DTYPE)g(*value,)334 1386 y(char)g(*comment,)e(int)i +(*status\))95 1612 y(int)g(fits_read_keyword)c(/)48 b(ffgkey)286 +1725 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(>)h(char)g(*value,)f +(char)g(*comment,)334 1838 y(int)h(*status\))95 2063 +y(int)g(fits_read_card)d(/)k(ffgcrd)286 2176 y(\(fitsfile)e(*fptr,)g +(char)g(*keyname,)g(>)h(char)g(*card,)f(int)h(*status\))0 +2410 y Fi(3)81 b Fj(Return)27 b(the)h(n)m(th)h(header)f(record)g(in)f +(the)h(CHU.)h(The)e(\014rst)h(k)m(eyw)m(ord)h(in)d(the)j(header)f(is)f +(at)i(k)m(eyn)m(um)f(=)g(1;)i(if)227 2523 y(k)m(eyn)m(um)g(=)f(0)i +(then)e(these)h(routines)f(simply)e(reset)k(the)f(in)m(ternal)e +(CFITSIO)g(p)s(oin)m(ter)h(to)i(the)f(b)s(eginning)227 +2635 y(of)f(the)g(header)g(so)g(that)g(subsequen)m(t)f(k)m(eyw)m(ord)h +(op)s(erations)g(will)d(start)j(at)h(the)f(top)g(of)f(the)h(header)g +(\(e.g.,)227 2748 y(prior)38 b(to)i(searc)m(hing)f(for)g(k)m(eyw)m +(ords)h(using)e(wild)e(cards)j(in)f(the)i(k)m(eyw)m(ord)g(name\).)68 +b(The)38 b(\014rst)h(routine)227 2861 y(returns)j(the)h(en)m(tire)g +(80-c)m(haracter)i(header)e(record,)j(while)41 b(the)i(second)g +(routine)f(parses)g(the)h(record)227 2974 y(and)35 b(returns)f(the)i +(name,)h(v)-5 b(alue,)36 b(and)f(commen)m(t)h(\014elds)e(as)i(separate) +g(c)m(haracter)h(strings.)54 b(If)35 b(a)h(NULL)227 3087 +y(commen)m(t)c(p)s(oin)m(ter)d(is)g(giv)m(en)i(on)f(input,)f(then)h +(the)g(commen)m(t)i(string)d(will)f(not)j(b)s(e)e(returned.)95 +3320 y Fe(int)47 b(fits_read_record)d(/)j(ffgrec)286 +3433 y(\(fitsfile)f(*fptr,)g(int)h(keynum,)e(>)j(char)f(*card,)f(int)h +(*status\))95 3659 y(int)g(fits_read_keyn)d(/)k(ffgkyn)286 +3772 y(\(fitsfile)e(*fptr,)g(int)h(keynum,)e(>)j(char)f(*keyname,)e +(char)h(*value,)334 3885 y(char)h(*comment,)e(int)i(*status\))0 +4118 y Fi(4)81 b Fj(Return)44 b(the)i(next)g(k)m(eyw)m(ord)g(whose)f +(name)h(matc)m(hes)g(one)g(of)g(the)f(strings)g(in)f('inclist')g(but)h +(do)s(es)g(not)227 4231 y(matc)m(h)31 b(an)m(y)g(of)g(the)f(strings)f +(in)g('exclist'.)41 b(The)30 b(strings)f(in)g(inclist)f(and)i(exclist)g +(ma)m(y)g(con)m(tain)h(wild)d(card)227 4344 y(c)m(haracters)34 +b(\(*,)f(?,)f(and)f(#\))h(as)g(describ)s(ed)e(at)j(the)f(b)s(eginning)d +(of)j(this)f(section.)45 b(This)30 b(routine)h(searc)m(hes)227 +4457 y(from)k(the)g(curren)m(t)g(header)g(p)s(osition)e(to)j(the)f(end) +f(of)h(the)h(header,)g(only)-8 b(,)36 b(and)e(do)s(es)h(not)g(con)m +(tin)m(ue)h(the)227 4570 y(searc)m(h)c(from)e(the)h(top)g(of)g(the)g +(header)g(bac)m(k)g(to)h(the)f(original)e(p)s(osition.)40 +b(The)31 b(curren)m(t)f(header)h(p)s(osition)227 4683 +y(ma)m(y)e(b)s(e)e(reset)h(with)f(the)h(\013grec)g(routine.)39 +b(Note)29 b(that)g(nexc)f(ma)m(y)g(b)s(e)f(set)h(=)g(0)g(if)f(there)h +(are)g(no)g(k)m(eyw)m(ords)227 4796 y(to)h(b)s(e)f(excluded.)38 +b(This)27 b(routine)g(returns)g(status)h(=)g(KEY)p 2268 +4796 28 4 v 32 w(NO)p 2439 4796 V 33 w(EXIST)f(if)g(a)i(matc)m(hing)f +(k)m(eyw)m(ord)h(is)e(not)227 4909 y(found.)95 5142 y +Fe(int)47 b(fits_find_nextkey)c(/)48 b(ffgnxk)286 5255 +y(\(fitsfile)e(*fptr,)g(char)g(**inclist,)f(int)i(ninc,)g(char)f +(**exclist,)334 5368 y(int)h(nexc,)f(>)i(char)e(*card,)h(int)94 +b(*status\))0 5601 y Fi(5)81 b Fj(Return)25 b(the)h(ph)m(ysical)e +(units)h(string)g(from)g(an)h(existing)f(k)m(eyw)m(ord.)39 +b(This)25 b(routine)g(uses)g(a)h(lo)s(cal)g(con)m(v)m(en)m(tion,)227 +5714 y(sho)m(wn)f(in)f(the)h(follo)m(wing)f(example,)i(in)e(whic)m(h)g +(the)i(k)m(eyw)m(ord)f(units)f(are)i(enclosed)f(in)f(square)h(brac)m(k) +m(ets)h(in)p eop +%%Page: 37 45 +37 44 bop 0 299 a Fh(5.4.)72 b(HEADER)31 b(KEYW)m(ORD)g(READ/WRITE)g(R) +m(OUTINES)1495 b Fj(37)227 555 y(the)30 b(b)s(eginning)d(of)j(the)g(k)m +(eyw)m(ord)g(commen)m(t)g(\014eld.)39 b(A)30 b(n)m(ull)e(string)g(is)h +(returned)f(if)h(no)g(units)f(are)i(de\014ned)227 668 +y(for)g(the)h(k)m(eyw)m(ord.)239 913 y Fe(VELOCITY=)809 +b(12.3)46 b(/)i([km/s])e(orbital)g(speed)95 1139 y(int)h +(fits_read_key_unit)c(/)48 b(ffgunt)286 1252 y(\(fitsfile)e(*fptr,)g +(char)g(*keyname,)g(>)h(char)g(*unit,)f(int)h(*status\))0 +1497 y Fi(6)81 b Fj(Concatenate)39 b(the)f(header)f(k)m(eyw)m(ords)h +(in)f(the)g(CHDU)h(in)m(to)g(a)g(single)e(long)h(string)g(of)h(c)m +(haracters.)64 b(This)227 1610 y(pro)m(vides)27 b(a)i(con)m(v)m(enien)m +(t)g(w)m(a)m(y)g(of)g(passing)e(all)g(or)h(part)g(of)g(the)h(header)f +(information)e(in)h(a)i(FITS)e(HDU)i(to)227 1723 y(other)i +(subroutines.)38 b(Eac)m(h)31 b(80-c)m(haracter)h(\014xed-length)e(k)m +(eyw)m(ord)g(record)g(is)f(app)s(ended)f(to)j(the)f(output)227 +1836 y(c)m(haracter)j(string,)e(in)f(order,)h(with)f(no)h(in)m(terv)m +(ening)g(separator)h(or)f(terminating)f(c)m(haracters.)45 +b(The)31 b(last)227 1949 y(header)i(record)g(is)f(terminated)h(with)f +(a)h(NULL)g(c)m(haracter.)50 b(This)32 b(routine)g(allo)s(cates)h +(memory)g(for)g(the)227 2062 y(returned)c(c)m(haracter)j(arra)m(y)-8 +b(,)32 b(so)f(the)f(calling)f(program)h(m)m(ust)g(free)h(the)g(memory)f +(when)f(\014nished.)227 2210 y(Selected)g(k)m(eyw)m(ords)f(ma)m(y)h(b)s +(e)e(excluded)g(from)h(the)g(returned)f(c)m(haracter)j(string.)39 +b(If)27 b(the)i(second)f(param-)227 2323 y(eter)h(\(no)s(commen)m(ts\)) +g(is)e(TR)m(UE)h(\(nonzero\))h(then)e(an)m(y)i(COMMENT,)f(HISTOR)-8 +b(Y,)27 b(or)h(blank)f(k)m(eyw)m(ords)227 2435 y(in)i(the)i(header)f +(will)e(not)i(b)s(e)g(copied)g(to)h(the)g(output)f(string.)227 +2583 y(The)25 b('exclist')h(parameter)g(ma)m(y)g(b)s(e)f(used)g(to)h +(supply)d(a)j(list)f(of)g(k)m(eyw)m(ords)h(that)h(are)f(to)g(b)s(e)f +(excluded)f(from)227 2696 y(the)29 b(output)g(c)m(haracter)h(string.)40 +b(Wild)27 b(card)i(c)m(haracters)h(\(*,)g(?,)f(and)g(#\))g(ma)m(y)g(b)s +(e)f(used)g(in)g(the)h(excluded)227 2809 y(k)m(eyw)m(ord)h(names.)41 +b(If)29 b(no)g(additional)f(k)m(eyw)m(ords)i(are)g(to)g(b)s(e)f +(excluded,)g(then)g(set)h(nexc)g(=)f(0)h(and)f(sp)s(ecify)227 +2922 y(NULL)i(for)f(the)g(the)h(**header)g(parameter.)95 +3167 y Fe(int)47 b(fits_hdr2str)286 3280 y(\(fitsfile)f(*fptr,)g(int)h +(nocomments,)d(char)j(**exclist,)e(int)i(nexc,)286 3393 +y(>)h(char)e(**header,)g(int)h(*nkeys,)e(int)i(*status\))0 +3681 y Fd(5.4.2)112 b(Keyw)m(ord)38 b(W)-9 b(riting)35 +b(Routines)0 3888 y Fi(1)81 b Fj(W)-8 b(rite)31 b(a)h(k)m(eyw)m(ord)g +(of)f(the)h(appropriate)e(data)i(t)m(yp)s(e)g(in)m(to)f(the)h(CHU.)f +(The)g(\014rst)g(routine)f(simply)f(app)s(ends)227 4001 +y(a)34 b(new)f(k)m(eyw)m(ord)h(whereas)f(the)g(second)h(routine)e(will) +f(up)s(date)h(the)i(v)-5 b(alue)32 b(and)h(commen)m(t)h(\014elds)e(of)i +(the)227 4114 y(k)m(eyw)m(ord)g(if)f(it)g(already)g(exists,)h +(otherwise)f(it)g(app)s(ends)f(a)i(new)f(k)m(eyw)m(ord.)51 +b(Note)35 b(that)f(the)g(address)e(to)227 4227 y(the)37 +b(v)-5 b(alue,)37 b(and)e(not)i(the)f(v)-5 b(alue)35 +b(itself,)i(m)m(ust)f(b)s(e)f(en)m(tered.)59 b(The)35 +b(datat)m(yp)s(e)i(parameter)g(sp)s(eci\014es)e(the)227 +4340 y(data)40 b(t)m(yp)s(e)f(of)g(the)g(k)m(eyw)m(ord)g(v)-5 +b(alue)39 b(with)e(one)i(of)g(the)g(follo)m(wing)f(v)-5 +b(alues:)57 b(TSTRING,)38 b(TLOGICAL)227 4452 y(\(==)e(in)m(t\),)i +(TBYTE,)f(TSHOR)-8 b(T,)35 b(TUSHOR)-8 b(T,)36 b(TINT,)g(TUINT,)g +(TLONG,)g(TULONG,)g(TFLO)m(A)-8 b(T,)227 4565 y(TDOUBLE.)24 +b(Within)e(the)h(con)m(text)i(of)f(this)e(routine,)i(TSTRING)f(corresp) +s(onds)f(to)i(a)g('c)m(har*')g(data)h(t)m(yp)s(e,)227 +4678 y(i.e.,)j(a)e(p)s(oin)m(ter)g(to)h(a)f(c)m(haracter)i(arra)m(y)-8 +b(.)40 b(A)27 b(n)m(ull)d(p)s(oin)m(ter)h(ma)m(y)i(b)s(e)f(en)m(tered)h +(for)f(the)g(commen)m(t)h(parameter)227 4791 y(in)i(whic)m(h)g(case)j +(the)e(k)m(eyw)m(ord)h(commen)m(t)h(\014eld)d(will)e(b)s(e)j(unmo)s +(di\014ed)d(or)k(left)f(blank.)95 5036 y Fe(int)47 b(fits_write_key)d +(/)k(ffpky)286 5149 y(\(fitsfile)e(*fptr,)g(int)h(datatype,)e(char)i +(*keyname,)e(DTYPE)h(*value,)477 5262 y(char)h(*comment,)e(>)j(int)f +(*status\))95 5488 y(int)g(fits_update_key)d(/)j(ffuky)286 +5601 y(\(fitsfile)f(*fptr,)g(int)h(datatype,)e(char)i(*keyname,)e +(DTYPE)h(*value,)477 5714 y(char)h(*comment,)e(>)j(int)f(*status\))p +eop +%%Page: 38 46 +38 45 bop 0 299 a Fj(38)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(2)81 b Fj(W)-8 b(rite)43 b(a)h(k)m(eyw)m(ord)f(with)f(a)i(n)m +(ull)d(or)i(unde\014ned)e(v)-5 b(alue)42 b(\(i.e.,)47 +b(the)d(v)-5 b(alue)42 b(\014eld)g(in)g(the)h(k)m(eyw)m(ord)h(is)e +(left)227 668 y(blank\).)69 b(The)40 b(\014rst)f(routine)g(simply)f +(app)s(ends)g(a)j(new)e(k)m(eyw)m(ord)i(whereas)f(the)g(second)g +(routine)g(will)227 781 y(up)s(date)27 b(the)h(v)-5 b(alue)28 +b(and)f(commen)m(t)i(\014elds)d(of)i(the)g(k)m(eyw)m(ord)g(if)f(it)g +(already)h(exists,)g(otherwise)f(it)h(app)s(ends)227 +894 y(a)h(new)g(k)m(eyw)m(ord.)40 b(A)29 b(n)m(ull)e(p)s(oin)m(ter)h +(ma)m(y)h(b)s(e)g(en)m(tered)g(for)g(the)g(commen)m(t)g(parameter)h(in) +d(whic)m(h)h(case)i(the)227 1007 y(k)m(eyw)m(ord)h(commen)m(t)h +(\014eld)c(will)g(b)s(e)i(unmo)s(di\014ed)d(or)k(left)f(blank.)95 +1261 y Fe(int)47 b(fits_write_key_null)c(/)k(ffpkyu)286 +1374 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(char)g(*comment,)g(>)h +(int)g(*status\))95 1599 y(int)g(fits_update_key_null)c(/)k(ffukyu)286 +1712 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(char)g(*comment,)g(>)h +(int)g(*status\))0 1966 y Fi(3)81 b Fj(W)-8 b(rite)39 +b(\(app)s(end\))f(a)h(COMMENT)g(or)g(HISTOR)-8 b(Y)38 +b(k)m(eyw)m(ord)i(to)f(the)g(CHU.)h(The)e(commen)m(t)i(or)f(history)227 +2079 y(string)30 b(will)d(b)s(e)j(con)m(tin)m(ued)g(o)m(v)m(er)i(m)m +(ultiple)c(k)m(eyw)m(ords)j(if)e(it)h(is)f(longer)h(than)g(70)i(c)m +(haracters.)95 2333 y Fe(int)47 b(fits_write_comment)c(/)48 +b(ffpcom)286 2446 y(\(fitsfile)e(*fptr,)g(char)g(*comment,)g(>)h(int)g +(*status\))95 2672 y(int)g(fits_write_history)c(/)48 +b(ffphis)286 2785 y(\(fitsfile)e(*fptr,)g(char)g(*history,)g(>)h(int)g +(*status\))0 3039 y Fi(4)81 b Fj(W)-8 b(rite)28 b(the)h(D)m(A)-8 +b(TE)29 b(k)m(eyw)m(ord)g(to)g(the)g(CHU.)f(The)g(k)m(eyw)m(ord)h(v)-5 +b(alue)28 b(will)d(con)m(tain)k(the)g(curren)m(t)f(system)g(date)227 +3152 y(as)k(a)g(c)m(haracter)h(string)d(in)g('yyyy-mm-ddThh:mm:ss')f +(format.)44 b(If)31 b(a)h(D)m(A)-8 b(TE)32 b(k)m(eyw)m(ord)g(already)f +(exists)227 3264 y(in)c(the)g(header,)i(then)e(this)f(routine)h(will)e +(simply)g(up)s(date)i(the)h(k)m(eyw)m(ord)g(v)-5 b(alue)27 +b(with)f(the)i(curren)m(t)g(date.)95 3518 y Fe(int)47 +b(fits_write_date)d(/)j(ffpdat)286 3631 y(\(fitsfile)f(*fptr,)g(>)h +(int)g(*status\))0 3885 y Fi(5)81 b Fj(W)-8 b(rite)33 +b(a)h(user)f(sp)s(eci\014ed)f(k)m(eyw)m(ord)i(record)f(in)m(to)g(the)h +(CHU.)g(This)d(is)i(a)h(lo)m(w{lev)m(el)f(routine)g(whic)m(h)f(can)i(b) +s(e)227 3998 y(used)f(to)h(write)e(an)m(y)i(arbitrary)e(record)h(in)m +(to)h(the)f(header.)50 b(The)32 b(record)i(m)m(ust)f(conform)g(to)h +(the)g(all)e(the)227 4111 y(FITS)e(format)h(requiremen)m(ts.)95 +4365 y Fe(int)47 b(fits_write_record)c(/)48 b(ffprec)286 +4478 y(\(fitsfile)e(*fptr,)g(char)g(*card,)g(>)i(int)f(*status\))0 +4732 y Fi(6)81 b Fj(Up)s(date)34 b(an)g(80-c)m(haracter)j(record)e(in)e +(the)h(CHU.)h(If)f(a)h(k)m(eyw)m(ord)f(with)g(the)g(input)f(name)h +(already)g(exists,)227 4845 y(then)f(it)g(is)f(o)m(v)m(erwritten)h(b)m +(y)g(the)g(v)-5 b(alue)33 b(of)g(card.)49 b(This)31 b(could)h(mo)s +(dify)f(the)j(k)m(eyw)m(ord)f(name)g(as)h(w)m(ell)e(as)227 +4958 y(the)e(v)-5 b(alue)29 b(and)f(commen)m(t)j(\014elds.)39 +b(If)29 b(the)g(k)m(eyw)m(ord)h(do)s(esn't)f(already)g(exist)g(then)h +(a)f(new)g(k)m(eyw)m(ord)h(card)227 5070 y(is)g(app)s(ended)e(to)j(the) +g(header.)95 5324 y Fe(int)47 b(fits_update_card)d(/)j(ffucrd)286 +5437 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(char)g(*card,)g(>)i +(int)f(*status\))0 5691 y Fi(7)81 b Fj(Mo)s(dify)29 b(\(o)m(v)m +(erwrite\))i(the)g(commen)m(t)g(\014eld)e(of)i(an)f(existing)f(k)m(eyw) +m(ord.)p eop +%%Page: 39 47 +39 46 bop 0 299 a Fh(5.5.)72 b(PRIMAR)-8 b(Y)31 b(ARRA)-8 +b(Y)31 b(OR)f(IMA)m(GE)h(EXTENSION)f(I/O)g(R)m(OUTINES)1011 +b Fj(39)95 555 y Fe(int)47 b(fits_modify_comment)c(/)k(ffmcom)286 +668 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(char)g(*comment,)g(>)h +(int)g(*status\))0 907 y Fi(8)81 b Fj(W)-8 b(rite)32 +b(the)g(ph)m(ysical)f(units)g(string)g(in)m(to)h(an)g(existing)f(k)m +(eyw)m(ord.)46 b(This)31 b(routine)g(uses)h(a)g(lo)s(cal)g(con)m(v)m +(en)m(tion,)227 1020 y(sho)m(wn)g(in)f(the)i(follo)m(wing)e(example,)i +(in)e(whic)m(h)g(the)i(k)m(eyw)m(ord)g(units)e(are)i(enclosed)f(in)f +(square)h(brac)m(k)m(ets)227 1133 y(in)d(the)i(b)s(eginning)d(of)i(the) +h(k)m(eyw)m(ord)g(commen)m(t)g(\014eld.)239 1372 y Fe(VELOCITY=)809 +b(12.3)46 b(/)i([km/s])e(orbital)g(speed)95 1598 y(int)h +(fits_write_key_unit)c(/)k(ffpunt)286 1711 y(\(fitsfile)f(*fptr,)g +(char)g(*keyname,)g(char)g(*unit,)g(>)i(int)f(*status\))0 +1950 y Fi(9)81 b Fj(Rename)30 b(an)h(existing)e(k)m(eyw)m(ord,)i +(preserving)e(the)h(curren)m(t)h(v)-5 b(alue)29 b(and)h(commen)m(t)i +(\014elds.)95 2189 y Fe(int)47 b(fits_modify_name)d(/)j(ffmnam)286 +2302 y(\(fitsfile)f(*fptr,)g(char)g(*oldname,)g(char)g(*newname,)g(>)h +(int)g(*status\))0 2541 y Fi(10)f Fj(Delete)36 b(a)f(k)m(eyw)m(ord)g +(record.)54 b(The)34 b(space)i(o)s(ccupied)d(b)m(y)i(the)g(k)m(eyw)m +(ord)g(is)f(reclaimed)g(b)m(y)g(mo)m(ving)h(all)f(the)227 +2654 y(follo)m(wing)d(header)i(records)f(up)g(one)h(ro)m(w)f(in)g(the)g +(header.)48 b(The)32 b(\014rst)g(routine)f(deletes)i(a)g(k)m(eyw)m(ord) +g(at)h(a)227 2767 y(sp)s(eci\014ed)22 b(p)s(osition)g(in)h(the)h +(header)f(\(the)i(\014rst)e(k)m(eyw)m(ord)h(is)f(at)h(p)s(osition)e +(1\),)k(whereas)e(the)g(second)g(routine)227 2880 y(deletes)29 +b(a)g(sp)s(eci\014cally)d(named)i(k)m(eyw)m(ord.)41 b(Wild)27 +b(card)h(c)m(haracters)i(ma)m(y)f(b)s(e)f(used)g(when)f(sp)s(ecifying)g +(the)227 2993 y(name)k(of)f(the)h(k)m(eyw)m(ord)g(to)g(b)s(e)e +(deleted.)95 3232 y Fe(int)47 b(fits_delete_record)c(/)48 +b(ffdrec)286 3345 y(\(fitsfile)e(*fptr,)g(int)142 b(keynum,)94 +b(>)47 b(int)g(*status\))95 3571 y(int)g(fits_delete_key)d(/)j(ffdkey) +286 3684 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(>)h(int)g +(*status\))0 4014 y Ff(5.5)135 b(Primary)46 b(Arra)l(y)f(or)g(IMA)l(GE) +f(Extension)i(I/O)f(Routines)0 4264 y Fj(These)22 b(routines)f(read)i +(or)f(write)g(data)h(v)-5 b(alues)22 b(in)f(the)h(primary)f(data)i +(arra)m(y)g(\(i.e.,)i(the)d(\014rst)g(HDU)h(in)e(a)i(FITS)e(\014le\))0 +4377 y(or)32 b(an)g(IMA)m(GE)h(extension.)46 b(There)31 +b(are)i(also)f(routines)f(to)i(get)g(information)d(ab)s(out)i(the)g +(data)h(t)m(yp)s(e)g(and)e(size)0 4490 y(of)c(the)g(image.)40 +b(Users)27 b(should)e(also)i(read)g(the)g(follo)m(wing)e(c)m(hapter)j +(on)f(the)g(CFITSIO)e(iterator)j(function)d(whic)m(h)0 +4603 y(pro)m(vides)32 b(a)i(more)f(`ob)5 b(ject)35 b(orien)m(ted')e +(metho)s(d)g(of)g(reading)f(and)h(writing)e(images.)50 +b(The)32 b(iterator)i(function)e(is)0 4716 y(a)f(little)f(more)h +(complicated)f(to)i(use,)f(but)f(the)h(adv)-5 b(an)m(tages)32 +b(are)f(that)h(it)e(usually)f(tak)m(es)j(less)e(co)s(de)h(to)g(p)s +(erform)0 4829 y(the)j(same)h(op)s(eration,)f(and)f(the)i(resulting)d +(program)h(oftens)i(runs)d(faster)i(b)s(ecause)g(the)h(FITS)e(\014les)g +(are)h(read)0 4942 y(and)c(written)f(using)g(the)i(most)f(e\016cien)m +(t)h(blo)s(c)m(k)f(size.)0 5102 y(C)25 b(programmers)h(should)e(note)i +(that)g(the)h(ordering)d(of)i(arra)m(ys)g(in)f(FITS)g(\014les,)h(and)f +(hence)h(in)f(all)f(the)i(CFITSIO)0 5215 y(calls,)38 +b(is)e(more)h(similar)e(to)i(the)h(dimensionalit)m(y)c(of)j(arra)m(ys)g +(in)f(F)-8 b(ortran)38 b(rather)f(than)f(C.)h(F)-8 b(or)38 +b(instance)f(if)f(a)0 5328 y(FITS)28 b(image)h(has)f(NAXIS1)h(=)f(100)i +(and)e(NAXIS2)h(=)f(50,)i(then)e(a)h(2-D)h(arra)m(y)f(just)f(large)h +(enough)f(to)i(hold)d(the)0 5441 y(image)k(should)d(b)s(e)i(declared)g +(as)g(arra)m(y[50][100])k(and)c(not)h(as)f(arra)m(y[100][50].)0 +5601 y(The)h(`datat)m(yp)s(e')h(parameter)g(sp)s(eci\014es)d(the)j +(data)g(t)m(yp)s(e)f(of)g(the)g(`n)m(ulv)-5 b(al')30 +b(and)h(`arra)m(y')h(p)s(oin)m(ters)e(and)g(can)i(ha)m(v)m(e)0 +5714 y(one)h(of)g(the)g(follo)m(wing)e(v)-5 b(alues:)45 +b(TBYTE,)33 b(TSBYTE,)f(TSHOR)-8 b(T,)32 b(TUSHOR)-8 +b(T,)32 b(TINT,)h(TUINT,)f(TLONG,)p eop +%%Page: 40 48 +40 47 bop 0 299 a Fj(40)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fj(TLONGLONG,)c(TULONG,)g(TFLO)m(A)-8 b(T,)27 b(TDOUBLE.)f +(Automatic)h(data)g(t)m(yp)s(e)g(con)m(v)m(ersion)f(is)f(p)s(erformed)g +(if)0 668 y(the)j(data)h(t)m(yp)s(e)f(of)f(the)i(FITS)e(arra)m(y)h +(\(as)g(de\014ned)f(b)m(y)h(the)g(BITPIX)f(k)m(eyw)m(ord\))i(di\013ers) +d(from)i(that)g(sp)s(eci\014ed)e(b)m(y)0 781 y('datat)m(yp)s(e'.)54 +b(The)34 b(data)h(v)-5 b(alues)34 b(are)g(also)h(automatically)f +(scaled)g(b)m(y)g(the)h(BSCALE)f(and)f(BZER)m(O)h(k)m(eyw)m(ord)0 +894 y(v)-5 b(alues)30 b(as)g(they)h(are)g(b)s(eing)e(read)h(or)g +(written)g(in)f(the)h(FITS)g(arra)m(y)-8 b(.)0 1147 y +Fi(1)81 b Fj(Get)39 b(the)f(data)h(t)m(yp)s(e)f(or)g(equiv)-5 +b(alen)m(t)37 b(data)i(t)m(yp)s(e)f(of)g(the)h(image.)64 +b(The)37 b(\014rst)g(routine)g(returns)g(the)h(ph)m(ys-)227 +1260 y(ical)j(data)g(t)m(yp)s(e)h(of)f(the)g(FITS)f(image,)k(as)e(giv)m +(en)f(b)m(y)g(the)g(BITPIX)g(k)m(eyw)m(ord,)j(with)c(allo)m(w)m(ed)h(v) +-5 b(alues)227 1373 y(of)44 b(BYTE)p 609 1373 28 4 v +33 w(IMG)g(\(8\),)k(SHOR)-8 b(T)p 1376 1373 V 32 w(IMG)44 +b(\(16\),)49 b(LONG)p 2140 1373 V 33 w(IMG)44 b(\(32\),)49 +b(FLO)m(A)-8 b(T)p 2948 1373 V 33 w(IMG)44 b(\(-32\),)49 +b(and)43 b(DOU-)227 1486 y(BLE)p 415 1486 V 33 w(IMG)f(\(-64\).)75 +b(The)40 b(second)i(routine)e(is)g(similar,)i(except)g(that)g(if)e(the) +h(image)h(pixel)d(v)-5 b(alues)41 b(are)227 1599 y(scaled,)28 +b(with)f(non-default)f(v)-5 b(alues)27 b(for)g(the)h(BZER)m(O)f(and)g +(BSCALE)g(k)m(eyw)m(ords,)h(then)f(the)h(routine)f(will)227 +1712 y(return)35 b(the)h('equiv)-5 b(alen)m(t')35 b(data)h(t)m(yp)s(e)g +(that)g(is)f(needed)g(to)i(store)f(the)g(scaled)f(v)-5 +b(alues.)56 b(F)-8 b(or)36 b(example,)h(if)227 1824 y(BITPIX)27 +b(=)f(16)i(and)e(BSCALE)h(=)f(0.1)i(then)f(the)g(equiv)-5 +b(alen)m(t)26 b(data)i(t)m(yp)s(e)f(is)f(FLO)m(A)-8 b(T)p +3196 1824 V 33 w(IMG.)28 b(Similarly)23 b(if)227 1937 +y(BITPIX)28 b(=)g(16,)i(BSCALE)d(=)h(1,)h(and)f(BZER)m(O)g(=)g(32768,)j +(then)d(the)g(the)h(pixel)d(v)-5 b(alues)28 b(span)f(the)i(range)227 +2050 y(of)i(an)f(unsigned)e(short)i(in)m(teger)h(and)f(the)h(returned)e +(data)i(t)m(yp)s(e)f(will)e(b)s(e)i(USHOR)-8 b(T)p 3168 +2050 V 32 w(IMG.)95 2303 y Fe(int)47 b(fits_get_img_type)c(/)48 +b(ffgidt)286 2416 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*bitpix,)f(int)h +(*status\))95 2642 y(int)g(fits_get_img_equivtype)42 +b(/)48 b(ffgiet)286 2755 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*bitpix,)f +(int)h(*status\))0 3008 y Fi(2)81 b Fj(Get)34 b(the)g(n)m(um)m(b)s(er)e +(of)i(dimensions,)e(and/or)i(the)g(size)f(of)h(eac)m(h)h(dimension)c +(in)h(the)i(image)g(.)50 b(The)33 b(n)m(um)m(b)s(er)227 +3121 y(of)h(axes)f(in)f(the)h(image)h(is)e(giv)m(en)h(b)m(y)g(naxis,)g +(and)g(the)g(size)g(of)g(eac)m(h)i(dimension)30 b(is)i(giv)m(en)h(b)m +(y)g(the)h(naxes)227 3234 y(arra)m(y)d(\(a)g(maxim)m(um)f(of)g(maxdim)f +(dimensions)f(will)f(b)s(e)j(returned\).)95 3487 y Fe(int)47 +b(fits_get_img_dim)d(/)j(ffgidm)286 3600 y(\(fitsfile)f(*fptr,)g(>)h +(int)g(*naxis,)f(int)h(*status\))95 3826 y(int)g(fits_get_img_size)c(/) +48 b(ffgisz)286 3939 y(\(fitsfile)e(*fptr,)g(int)h(maxdim,)e(>)j(long)f +(*naxes,)e(int)i(*status\))95 4164 y(int)g(fits_get_img_param)c(/)48 +b(ffgipr)286 4277 y(\(fitsfile)e(*fptr,)g(int)h(maxdim,)e(>)j(int)f +(*bitpix,)e(int)i(*naxis,)f(long)h(*naxes,)334 4390 y(int)g(*status\))0 +4643 y Fi(3)81 b Fj(Create)23 b(a)f(new)g(primary)e(arra)m(y)j(or)f +(IMA)m(GE)i(extension)d(with)g(a)i(sp)s(eci\014ed)e(data)i(t)m(yp)s(e)f +(and)g(size.)37 b(If)22 b(the)h(FITS)227 4756 y(\014le)29 +b(is)g(curren)m(tly)f(empt)m(y)i(then)g(a)g(primary)e(arra)m(y)i(is)f +(created,)i(otherwise)e(a)h(new)f(IMA)m(GE)i(extension)e(is)227 +4869 y(app)s(ended)g(to)i(the)g(\014le.)95 5122 y Fe(int)47 +b(fits_create_img)d(/)j(ffcrim)286 5235 y(\()h(fitsfile)d(*fptr,)h(int) +h(bitpix,)f(int)h(naxis,)f(long)h(*naxes,)f(>)h(int)g(*status\))0 +5488 y Fi(4)81 b Fj(W)-8 b(rite)39 b(a)g(rectangular)f(subimage)g(\(or) +h(the)g(whole)f(image\))h(to)g(the)g(FITS)f(data)h(arra)m(y)-8 +b(.)67 b(The)38 b(fpixel)f(and)227 5601 y(lpixel)27 b(arra)m(ys)j(giv)m +(e)g(the)g(co)s(ordinates)f(of)g(the)h(\014rst)f(\(lo)m(w)m(er)h(left)f +(corner\))h(and)f(last)g(\(upp)s(er)f(righ)m(t)h(corner\))227 +5714 y(pixels)g(in)g(FITS)h(image)g(to)h(b)s(e)f(written)f(to.)p +eop +%%Page: 41 49 +41 48 bop 0 299 a Fh(5.5.)72 b(PRIMAR)-8 b(Y)31 b(ARRA)-8 +b(Y)31 b(OR)f(IMA)m(GE)h(EXTENSION)f(I/O)g(R)m(OUTINES)1011 +b Fj(41)95 555 y Fe(int)47 b(fits_write_subset)c(/)48 +b(ffpss)286 668 y(\(fitsfile)e(*fptr,)g(int)h(datatype,)e(long)i +(*fpixel,)e(long)i(*lpixel,)334 781 y(DTYPE)f(*array,)g(>)i(int)f +(*status\))0 1018 y Fi(5)81 b Fj(W)-8 b(rite)38 b(pixels)f(in)m(to)h +(the)h(FITS)f(data)h(arra)m(y)-8 b(.)66 b('fpixel')37 +b(is)g(an)h(arra)m(y)h(of)g(length)f(NAXIS)g(whic)m(h)f(giv)m(es)i(the) +227 1131 y(co)s(ordinate)k(of)g(the)g(starting)f(pixel)f(to)j(b)s(e)e +(written)g(to,)k(suc)m(h)d(that)g(fpixel[0])f(is)g(in)f(the)i(range)g +(1)g(to)227 1244 y(NAXIS1,)30 b(fpixel[1])d(is)g(in)g(the)i(range)g(1)f +(to)h(NAXIS2,)h(etc.)41 b(The)28 b(\014rst)f(routine)h(simply)d(writes) +j(the)g(arra)m(y)227 1357 y(of)e(pixels)d(to)j(the)g(FITS)f(\014le)f +(\(doing)h(data)h(t)m(yp)s(e)g(con)m(v)m(ersion)f(if)g(necessary\))h +(whereas)f(the)g(second)h(routine)227 1470 y(will)f(substitute)i(the)h +(appropriate)f(FITS)g(n)m(ull)f(v)-5 b(alue)27 b(for)h(an)m(y)g(elemen) +m(ts)g(whic)m(h)f(are)h(equal)f(to)i(the)f(input)227 +1582 y(v)-5 b(alue)25 b(of)h(n)m(ulv)-5 b(al)23 b(\(note)j(that)g(this) +f(parameter)g(giv)m(es)h(the)g(address)e(of)h(the)h(n)m(ull)d(v)-5 +b(alue,)26 b(not)g(the)f(n)m(ull)e(v)-5 b(alue)227 1695 +y(itself)7 b(\).)45 b(F)-8 b(or)33 b(in)m(teger)f(FITS)f(arra)m(ys,)i +(the)g(FITS)e(n)m(ull)f(v)-5 b(alue)31 b(is)g(de\014ned)g(b)m(y)h(the)g +(BLANK)g(k)m(eyw)m(ord)h(\(an)227 1808 y(error)h(is)f(returned)h(if)f +(the)h(BLANK)h(k)m(eyw)m(ord)f(do)s(esn't)h(exist\).)52 +b(F)-8 b(or)35 b(\015oating)f(p)s(oin)m(t)g(FITS)f(arra)m(ys)i(the)227 +1921 y(sp)s(ecial)29 b(IEEE)h(NaN)h(\(Not-a-Num)m(b)s(er\))h(v)-5 +b(alue)30 b(will)e(b)s(e)h(written)h(in)m(to)g(the)h(FITS)e(\014le.)40 +b(If)30 b(a)h(n)m(ull)d(p)s(oin)m(ter)227 2034 y(is)40 +b(en)m(tered)h(for)f(n)m(ulv)-5 b(al,)42 b(then)e(the)g(n)m(ull)f(v)-5 +b(alue)40 b(is)f(ignored)h(and)f(this)h(routine)f(b)s(eha)m(v)m(es)i +(the)g(same)g(as)227 2147 y(\014ts)p 354 2147 28 4 v +33 w(write)p 590 2147 V 32 w(pix.)95 2384 y Fe(int)47 +b(fits_write_pix)d(/)k(ffppx)286 2497 y(\(fitsfile)e(*fptr,)g(int)h +(datatype,)e(long)i(*fpixel,)e(long)i(nelements,)334 +2610 y(DTYPE)f(*array,)g(int)h(*status\);)95 2836 y(int)g +(fits_write_pixnull)c(/)48 b(ffppxn)286 2949 y(\(fitsfile)e(*fptr,)g +(int)h(datatype,)e(long)i(*fpixel,)e(long)i(nelements,)334 +3061 y(DTYPE)f(*array,)g(DTYPE)h(*nulval,)e(>)j(int)f(*status\);)0 +3298 y Fi(6)81 b Fj(Set)24 b(FITS)g(data)i(arra)m(y)f(elemen)m(ts)g +(equal)f(to)h(the)g(appropriate)e(n)m(ull)g(pixel)g(v)-5 +b(alue.)38 b(F)-8 b(or)25 b(in)m(teger)g(FITS)f(arra)m(ys,)227 +3411 y(the)34 b(FITS)e(n)m(ull)f(v)-5 b(alue)33 b(is)f(de\014ned)g(b)m +(y)h(the)h(BLANK)f(k)m(eyw)m(ord)h(\(an)f(error)g(is)f(returned)g(if)g +(the)i(BLANK)227 3524 y(k)m(eyw)m(ord)23 b(do)s(esn't)g(exist\).)38 +b(F)-8 b(or)23 b(\015oating)f(p)s(oin)m(t)g(FITS)g(arra)m(ys)g(the)h +(sp)s(ecial)e(IEEE)h(NaN)h(\(Not-a-Num)m(b)s(er\))227 +3637 y(v)-5 b(alue)33 b(will)d(b)s(e)j(written)f(in)m(to)h(the)h(FITS)e +(\014le.)48 b(Note)34 b(that)g('\014rstelem')f(is)f(a)i(scalar)f +(giving)f(the)h(o\013set)h(to)227 3750 y(the)d(\014rst)e(pixel)g(to)i +(b)s(e)f(written)f(in)h(the)g(equiv)-5 b(alen)m(t)30 +b(1-dimensional)e(arra)m(y)j(of)g(image)f(pixels.)95 +3987 y Fe(int)47 b(fits_write_null_img)c(/)k(ffpprn)286 +4100 y(\(fitsfile)f(*fptr,)g(long)g(firstelem,)f(long)i(nelements,)e(>) +i(int)g(*status\))0 4337 y Fi(7)81 b Fj(Read)33 b(a)h(rectangular)g +(subimage)f(\(or)h(the)g(whole)f(image\))h(from)f(the)h(FITS)f(data)h +(arra)m(y)-8 b(.)52 b(The)33 b(fpixel)f(and)227 4450 +y(lpixel)27 b(arra)m(ys)j(giv)m(e)g(the)g(co)s(ordinates)f(of)g(the)h +(\014rst)f(\(lo)m(w)m(er)h(left)f(corner\))h(and)f(last)g(\(upp)s(er)f +(righ)m(t)h(corner\))227 4563 y(pixels)c(to)j(b)s(e)e(read)h(from)g +(the)g(FITS)f(image.)40 b(Unde\014ned)25 b(FITS)h(arra)m(y)i(elemen)m +(ts)f(will)d(b)s(e)i(returned)g(with)227 4675 y(a)k(v)-5 +b(alue)29 b(=)f(*n)m(ullv)-5 b(al,)28 b(\(note)i(that)g(this)e +(parameter)i(giv)m(es)f(the)h(address)e(of)h(the)h(n)m(ull)d(v)-5 +b(alue,)29 b(not)h(the)f(n)m(ull)227 4788 y(v)-5 b(alue)35 +b(itself)7 b(\))35 b(unless)f(n)m(ulv)-5 b(al)34 b(=)i(0)g(or)f(*n)m +(ulv)-5 b(al)35 b(=)g(0,)j(in)c(whic)m(h)g(case)j(no)f(c)m(hec)m(ks)h +(for)e(unde\014ned)f(pixels)227 4901 y(will)28 b(b)s(e)i(p)s(erformed.) +95 5138 y Fe(int)47 b(fits_read_subset)d(/)j(ffgsv)286 +5251 y(\(fitsfile)f(*fptr,)g(int)94 b(datatype,)46 b(long)g(*fpixel,)g +(long)g(*lpixel,)g(long)h(*inc,)334 5364 y(DTYPE)f(*nulval,)g(>)h +(DTYPE)g(*array,)f(int)h(*anynul,)e(int)i(*status\))0 +5601 y Fi(8)81 b Fj(Read)32 b(pixels)f(from)h(the)g(FITS)g(data)h(arra) +m(y)-8 b(.)48 b('fpixel')31 b(is)h(the)g(starting)g(pixel)f(lo)s +(cation)h(and)g(is)g(an)g(arra)m(y)h(of)227 5714 y(length)g(NAXIS)g +(suc)m(h)g(that)h(fpixel[0])e(is)g(in)g(the)i(range)f(1)h(to)g(NAXIS1,) +g(fpixel[1])e(is)h(in)f(the)h(range)h(1)f(to)p eop +%%Page: 42 50 +42 49 bop 0 299 a Fj(42)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(NAXIS2,)f(etc.)41 b(The)28 b(nelemen)m(ts)g(parameter)g(sp)s +(eci\014es)f(the)h(n)m(um)m(b)s(er)f(of)h(pixels)f(to)i(read.)39 +b(If)28 b(fpixel)e(is)h(set)227 668 y(to)36 b(the)f(\014rst)f(pixel,)h +(and)g(nelemen)m(ts)f(is)g(set)i(equal)f(to)g(the)g(NAXIS1)h(v)-5 +b(alue,)36 b(then)e(this)g(routine)g(w)m(ould)227 781 +y(read)28 b(the)g(\014rst)f(ro)m(w)h(of)g(the)h(image.)40 +b(Alternativ)m(ely)-8 b(,)28 b(if)f(nelemen)m(ts)h(is)f(set)h(equal)g +(to)g(NAXIS1)g(*)h(NAXIS2)227 894 y(then)h(it)g(w)m(ould)f(read)i(an)f +(en)m(tire)g(2D)h(image,)g(or)g(the)f(\014rst)g(plane)f(of)i(a)g(3-D)g +(datacub)s(e.)227 1063 y(The)39 b(\014rst)f(routine)g(will)f(return)g +(an)m(y)j(unde\014ned)d(pixels)g(in)h(the)h(FITS)f(arra)m(y)i(equal)e +(to)i(the)f(v)-5 b(alue)39 b(of)227 1176 y(*n)m(ullv)-5 +b(al)41 b(\(note)i(that)g(this)e(parameter)i(giv)m(es)g(the)f(address)g +(of)g(the)h(n)m(ull)d(v)-5 b(alue,)45 b(not)e(the)f(n)m(ull)e(v)-5 +b(alue)227 1289 y(itself)7 b(\))39 b(unless)f(n)m(ulv)-5 +b(al)37 b(=)i(0)h(or)f(*n)m(ulv)-5 b(al)38 b(=)h(0,)j(in)c(whic)m(h)g +(case)j(no)e(c)m(hec)m(ks)i(for)e(unde\014ned)e(pixels)h(will)227 +1402 y(b)s(e)c(p)s(erformed.)51 b(The)34 b(second)g(routine)g(is)f +(similar)f(except)j(that)g(an)m(y)g(unde\014ned)d(pixels)g(will)g(ha)m +(v)m(e)k(the)227 1515 y(corresp)s(onding)29 b(n)m(ullarra)m(y)f(elemen) +m(t)j(set)g(equal)f(to)h(TR)m(UE)g(\(=)f(1\).)95 1813 +y Fe(int)47 b(fits_read_pix)e(/)i(ffgpxv)286 1926 y(\(fitsfile)f +(*fptr,)g(int)94 b(datatype,)46 b(long)g(*fpixel,)g(long)g(nelements,) +334 2039 y(DTYPE)g(*nulval,)g(>)h(DTYPE)g(*array,)f(int)h(*anynul,)e +(int)i(*status\))95 2265 y(int)g(fits_read_pixnull)c(/)48 +b(ffgpxf)286 2378 y(\(fitsfile)e(*fptr,)g(int)94 b(datatype,)46 +b(long)g(*fpixel,)g(long)g(nelements,)334 2491 y(>)i(DTYPE)e(*array,)g +(char)g(*nullarray,)f(int)i(*anynul,)f(int)g(*status\))0 +2869 y Ff(5.6)135 b(Image)46 b(Compression)0 3129 y Fj(CFITSIO)29 +b(no)m(w)h(transparen)m(tly)g(supp)s(orts)e(2)j(t)m(yp)s(es)f(of)h +(image)g(compression:)0 3289 y(1\))j(The)f(en)m(tire)h(FITS)e(\014le)h +(ma)m(y)h(b)s(e)f(externally)g(compressed)g(with)f(the)i(gzip)f(or)g +(Unix)f(compress)i(algorithm,)0 3402 y(pro)s(ducing)22 +b(a)j(*.gz)h(or)f(*.Z)g(\014le,)g(resp)s(ectiv)m(ely)-8 +b(.)38 b(When)25 b(reading)e(compressed)i(\014les)e(of)i(this)e(t)m(yp) +s(e,)k(CFITSIO)c(\014rst)0 3515 y(uncompresses)j(the)i(en)m(tire)f +(\014le)f(in)m(to)h(memory)g(b)s(efore)g(p)s(erforming)e(the)i +(requested)g(read)g(op)s(erations.)39 b(Output)0 3628 +y(\014les)30 b(can)h(b)s(e)f(directly)f(written)h(in)f(the)i(gzip)f +(compressed)g(format)h(if)f(the)h(user-sp)s(eci\014ed)d(\014lename)i +(ends)g(with)0 3741 y(`.gz'.)42 b(In)29 b(this)f(case,)j(CFITSIO)d +(initially)e(writes)j(the)h(uncompressed)e(\014le)h(in)f(memory)i(and)f +(then)g(compresses)0 3853 y(it)k(and)f(writes)g(it)h(to)g(disk)f(when)g +(the)h(FITS)f(\014le)h(is)f(closed,)h(th)m(us)g(sa)m(ving)g(user)f +(disk)g(space.)49 b(Read)33 b(and)g(write)0 3966 y(access)c(to)g(these) +f(compressed)f(FITS)g(\014les)g(is)g(generally)g(quite)g(fast;)i(the)f +(main)e(limitation)g(is)h(that)h(there)g(m)m(ust)0 4079 +y(b)s(e)i(enough)g(a)m(v)-5 b(ailable)30 b(memory)g(\(or)h(sw)m(ap)f +(space\))h(to)g(hold)e(the)i(en)m(tire)f(uncompressed)f(FITS)h(\014le.) +0 4239 y(2\))36 b(CFITSIO)d(also)i(supp)s(orts)e(a)i(new)m(er)g(image)h +(compression)e(format)h(in)f(whic)m(h)f(the)i(image)h(is)e(divided)e +(in)m(to)0 4352 y(a)43 b(grid)e(of)h(rectangular)g(tiles,)j(and)c(eac)m +(h)j(tile)d(of)i(pixels)d(is)i(individually)36 b(compressed.)76 +b(The)42 b(compressed)0 4465 y(tiles)36 b(are)h(stored)g(in)e(ro)m(ws)i +(of)f(a)i(v)-5 b(ariable)35 b(length)h(arra)m(y)h(column)f(in)f(a)i +(FITS)f(binary)f(table,)j(but)e(CFITSIO)0 4578 y(recognizes)31 +b(that)f(the)g(binary)f(table)g(extension)h(con)m(tains)g(an)g(image)g +(and)g(treats)h(it)e(as)h(if)f(it)h(w)m(ere)g(an)g(IMA)m(GE)0 +4691 y(extension.)46 b(This)31 b(tile-compressed)g(format)i(is)e(esp)s +(ecially)g(w)m(ell)g(suited)g(for)h(compressing)g(v)m(ery)g(large)h +(images)0 4804 y(b)s(ecause)e(a\))h(the)g(FITS)e(header)h(k)m(eyw)m +(ords)h(remain)e(uncompressed)g(for)h(rapid)e(read)i(access,)i(and)e(b) +s(ecause)g(b\))0 4917 y(it)j(is)g(p)s(ossible)e(to)j(extract)i(and)d +(uncompress)f(sections)i(of)f(the)h(image)g(without)f(ha)m(ving)g(to)h +(uncompress)f(the)0 5030 y(en)m(tire)e(image.)45 b(This)30 +b(format)j(is)e(also)g(m)m(uc)m(h)h(more)g(e\013ectiv)m(e)i(in)d +(compressing)f(\015oating)i(p)s(oin)m(t)f(images)h(\(using)0 +5143 y(a)f(lossy)e(compression)h(algorithm\))g(than)g(simply)e +(compressing)h(the)i(image)f(using)f(gzip)h(or)g(compress.)0 +5303 y(A)g(detailed)g(description)e(of)j(this)e(format)i(is)e(a)m(v)-5 +b(ailable)30 b(at:)0 5601 y Fe(http://heasarc.gsfc.nasa)o(.gov)o(/doc)o +(s/s)o(oftw)o(are/)o(fit)o(sio/)334 5714 y(compression/compress_imag)o +(e.h)o(tml)p eop +%%Page: 43 51 +43 50 bop 0 299 a Fh(5.6.)72 b(IMA)m(GE)31 b(COMPRESSION)2567 +b Fj(43)0 555 y(The)36 b(N-dimensional)f(FITS)h(image)h(can)g(b)s(e)g +(divided)d(in)m(to)j(an)m(y)g(desired)e(rectangular)i(grid)f(of)h +(compression)0 668 y(tiles.)75 b(By)43 b(default)e(the)i(tiles)e(are)h +(c)m(hosen)h(to)g(corresp)s(ond)e(to)i(the)f(ro)m(ws)h(of)f(the)g +(image,)k(eac)m(h)d(con)m(taining)0 781 y(NAXIS1)36 b(pixels.)56 +b(F)-8 b(or)36 b(example,)h(a)g(800)g(x)f(800)h(x)f(4)g(pixel)e(data)j +(cub)s(e)e(w)m(ould)g(b)s(e)g(divided)e(in)i(to)h(3200)i(tiles)0 +894 y(con)m(taining)30 b(800)h(pixels)d(eac)m(h)k(b)m(y)e(default.)40 +b(Alternativ)m(ely)-8 b(,)30 b(this)f(data)i(cub)s(e)e(could)g(b)s(e)h +(divided)d(in)m(to)j(256)i(tiles)0 1007 y(that)c(are)g(eac)m(h)g(100)h +(X)e(100)i(X)e(1)h(pixels)d(in)h(size,)i(or)f(4)h(tiles)e(con)m +(taining)h(800)i(x)e(800)h(X)g(1)g(pixels,)e(or)h(a)h(single)e(tile)0 +1120 y(con)m(taining)j(the)h(en)m(tire)f(data)h(cub)s(e.)40 +b(Note)31 b(that)f(the)f(image)h(dimensions)d(are)j(not)f(required)f +(to)i(b)s(e)f(an)h(in)m(teger)0 1233 y(m)m(ultiple)j(of)j(the)g(tile)e +(dimensions,)h(so,)i(for)e(example,)i(this)e(data)h(cub)s(e)f(could)f +(also)i(b)s(e)f(divided)d(in)m(to)k(250)h(X)0 1346 y(200)32 +b(pixel)c(tiles,)i(in)f(whic)m(h)g(case)j(the)e(last)g(tile)g(in)f(eac) +m(h)j(ro)m(w)e(w)m(ould)f(only)h(con)m(tain)g(50)i(X)e(200)i(pixels.)0 +1506 y(Curren)m(tly)-8 b(,)29 b(3)i(image)f(compression)g(algorithms)f +(are)h(supp)s(orted:)39 b(Rice,)31 b(GZIP)-8 b(,)30 b(and)g(PLIO.)g +(Rice)g(and)f(GZIP)0 1619 y(are)34 b(general)f(purp)s(ose)f(algorithms) +g(that)i(can)g(b)s(e)f(used)g(to)h(compress)f(almost)h(an)m(y)f(image.) +51 b(The)32 b(PLIO)h(algo-)0 1732 y(rithm,)38 b(on)f(the)g(other)h +(hand,)g(is)e(more)i(sp)s(ecialized)d(and)i(w)m(as)h(dev)m(elop)s(ed)e +(for)h(use)g(in)f(IRAF)i(to)g(store)g(pixel)0 1844 y(data)31 +b(qualit)m(y)f(masks.)41 b(It)30 b(is)g(designed)f(to)i(only)f(w)m(ork) +g(on)h(images)f(con)m(taining)g(p)s(ositiv)m(e)g(in)m(tegers)g(with)g +(v)-5 b(alues)0 1957 y(up)29 b(to)i(ab)s(out)g(2**24.)42 +b(Other)30 b(image)h(compression)e(algorithms)h(ma)m(y)h(b)s(e)e(supp)s +(orted)g(in)g(the)h(future.)0 2118 y(The)41 b(3)g(supp)s(orted)f(image) +h(compression)f(algorithms)g(are)i(all)e('loss-less')h(when)f(applied)f +(to)j(in)m(teger)g(FITS)0 2230 y(images;)34 b(the)f(pixel)e(v)-5 +b(alues)31 b(are)i(preserv)m(ed)g(exactly)g(with)e(no)i(loss)e(of)i +(information)e(during)f(the)j(compression)0 2343 y(and)i(uncompression) +f(pro)s(cess.)57 b(Floating)36 b(p)s(oin)m(t)f(FITS)g(images)h(\(whic)m +(h)f(ha)m(v)m(e)i(BITPIX)f(=)f(-32)i(or)f(-64\))i(are)0 +2456 y(\014rst)33 b(quan)m(tized)h(in)m(to)g(scaled)g(in)m(teger)h +(pixel)d(v)-5 b(alues)33 b(b)s(efore)h(b)s(eing)f(compressed.)51 +b(This)32 b(tec)m(hnique)i(pro)s(duces)0 2569 y(m)m(uc)m(h)27 +b(higher)e(compression)h(factors)h(than)g(simply)d(using)h(GZIP)h(to)i +(compress)e(the)h(image,)h(but)e(it)g(also)h(means)0 +2682 y(that)46 b(the)f(original)f(\015oating)h(v)-5 b(alue)45 +b(pixel)e(v)-5 b(alues)45 b(ma)m(y)h(not)f(b)s(e)g(precisely)f +(returned)g(when)g(the)h(image)h(is)0 2795 y(uncompressed.)55 +b(When)35 b(done)h(prop)s(erly)-8 b(,)35 b(this)g(only)f(discards)g +(the)i('noise')g(from)f(the)h(\015oating)f(p)s(oin)m(t)g(v)-5 +b(alues)0 2908 y(without)25 b(losing)h(an)m(y)g(signi\014can)m(t)g +(information.)37 b(The)26 b(amoun)m(t)h(of)g(noise)f(that)h(is)e +(discarded)g(can)i(b)s(e)e(con)m(trolled)0 3021 y(b)m(y)30 +b(the)h('noise)p 511 3021 28 4 v 32 w(bits')f(compression)f(parameter.) +0 3181 y(No)42 b(sp)s(ecial)e(action)i(is)e(required)g(to)i(read)g +(tile-compressed)e(images)i(b)s(ecause)f(all)g(the)g(CFITSIO)f +(routines)0 3294 y(that)33 b(read)g(normal)f(uncompressed)g(FITS)g +(images)h(can)g(also)g(read)g(images)g(in)e(the)i(tile-compressed)f +(format;)0 3407 y(CFITSIO)39 b(essen)m(tially)h(treats)h(the)g(binary)e +(table)h(that)i(con)m(tains)f(the)f(compressed)h(tiles)e(as)i(if)f(it)g +(w)m(ere)h(an)0 3520 y(IMA)m(GE)31 b(extension.)0 3680 +y(When)d(creating)h(\(writing\))f(a)h(new)f(image)h(with)e(CFITSIO,)h +(a)h(normal)e(uncompressed)h(FITS)g(primary)e(arra)m(y)0 +3793 y(or)k(IMA)m(GE)h(extension)f(will)d(b)s(e)i(written)h(unless)e +(the)i(tile-compressed)f(format)i(has)f(b)s(een)f(sp)s(eci\014ed)f(in)h +(1)h(of)h(2)0 3906 y(p)s(ossible)d(w)m(a)m(ys:)0 4066 +y(1\))d(A)m(t)g(run)d(time,)j(when)e(sp)s(ecifying)f(the)i(name)g(of)g +(the)g(output)g(FITS)f(\014le)g(to)i(b)s(e)e(created)i(at)g(run)d +(time,)j(the)g(user)0 4179 y(can)j(indicate)g(that)g(images)h(should)d +(b)s(e)h(written)h(in)e(tile-compressed)i(format)g(b)m(y)g(enclosing)g +(the)g(compression)0 4292 y(parameters)23 b(in)e(square)h(brac)m(k)m +(ets)i(follo)m(wing)d(the)h(ro)s(ot)h(disk)e(\014le)g(name.)39 +b(The)21 b(`imcop)m(y')i(example)f(program)g(that)0 4405 +y(included)30 b(with)i(the)i(CFITSIO)d(distribution)f(can)j(b)s(e)g +(used)f(for)h(this)g(purp)s(ose)e(to)j(compress)f(or)g(uncompress)0 +4517 y(images.)58 b(Here)36 b(are)h(some)f(examples)g(of)g(the)g +(extended)g(\014le)f(name)h(syn)m(tax)h(for)f(sp)s(ecifying)e +(tile-compressed)0 4630 y(output)c(images:)191 4924 y +Fe(myfile.fit[compress])185 b(-)48 b(use)f(the)g(default)e(compression) +g(algorithm)g(\(Rice\))1432 5036 y(and)i(the)g(default)e(tile)i(size)g +(\(row)f(by)i(row\))191 5262 y(myfile.fit[compress)42 +b(GZIP])47 b(-)g(use)g(the)g(specified)e(compression)g(algorithm;)191 +5375 y(myfile.fit[compress)d(Rice])238 b(only)46 b(the)h(first)g +(letter)f(of)h(the)g(algorithm)191 5488 y(myfile.fit[compress)42 +b(PLIO])238 b(name)46 b(is)i(required.)191 5714 y(myfile.fit[compress) +42 b(R)48 b(100,100])141 b(-)47 b(use)g(Rice)g(compression)e(and)p +eop +%%Page: 44 52 +44 51 bop 0 299 a Fj(44)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)1861 +555 y Fe(100)47 b(x)h(100)f(pixel)f(tile)h(size)191 781 +y(myfile.fit[compress)42 b(R)48 b(100,100;2])d(-)i(as)h(above,)e(and)h +(also)f(use)h(noisebits)e(=)j(2)0 1031 y Fj(2\))29 b(Before)g(calling)d +(the)i(CFITSIO)e(routine)h(to)i(write)e(the)h(image)g(header)g(k)m(eyw) +m(ords)g(\(e.g.,)j(\014ts)p 3335 1031 28 4 v 32 w(create)p +3603 1031 V 34 w(image\))0 1144 y(the)37 b(programmer)g(can)g(call)g +(the)g(routines)f(describ)s(ed)f(b)s(elo)m(w)h(to)i(sp)s(ecify)e(the)h +(compression)f(algorithm)h(and)0 1257 y(the)d(tiling)e(pattern)i(that)h +(is)e(to)i(b)s(e)e(used.)51 b(There)34 b(are)h(3)f(routines)f(for)h(sp) +s(ecifying)e(the)i(v)-5 b(arious)33 b(compression)0 1370 +y(parameters)e(and)e(3)i(corresp)s(onding)e(routines)g(to)i(return)e +(the)i(curren)m(t)f(v)-5 b(alues)30 b(of)g(the)h(parameters:)95 +1619 y Fe(int)47 b(fits_set_compression_type\()o(fit)o(sfil)o(e)42 +b(*fptr,)k(int)h(comptype,)e(int)i(*status\))95 1732 +y(int)g(fits_set_tile_dim\(fitsfile)41 b(*fptr,)46 b(int)h(ndim,)f +(long)h(*tilesize,)e(int)i(*status\))95 1845 y(int)g +(fits_set_noise_bits\(fitsfi)o(le)41 b(*fptr,)47 b(int)f(noisebits,)f +(int)i(*status\))95 2071 y(int)g(fits_get_compression_type\()o(fit)o +(sfil)o(e)42 b(*fptr,)k(int)h(*comptype,)e(int)i(*status\))95 +2184 y(int)g(fits_get_tile_dim\(fitsfile)41 b(*fptr,)46 +b(int)h(ndim,)f(long)h(*tilesize,)e(int)i(*status\))95 +2297 y(int)g(fits_get_noise_bits\(fitsfi)o(le)41 b(*fptr,)47 +b(int)f(*noisebits,)f(int)i(*status\))0 2547 y Fj(3)24 +b(sym)m(b)s(olic)d(constan)m(ts)k(are)e(de\014ned)f(for)h(use)g(as)g +(the)h(v)-5 b(alue)22 b(of)i(the)f(`compt)m(yp)s(e')h(parameter:)38 +b(GZIP)p 3447 2547 V 32 w(1,)25 b(RICE)p 3802 2547 V +32 w(1,)0 2660 y(or)i(PLIO)p 336 2660 V 32 w(1.)39 b(En)m(tering)26 +b(NULL)h(for)f(compt)m(yp)s(e)h(will)d(turn)i(o\013)h(the)g +(tile-compression)e(and)h(cause)h(normal)f(FITS)0 2773 +y(images)k(to)i(b)s(e)d(written.)0 2933 y(The)h('noisebits')g +(parameter)i(is)e(only)g(used)g(when)g(compressing)g(\015oating)h(p)s +(oin)m(t)f(images.)43 b(The)30 b(default)g(v)-5 b(alue)0 +3046 y(is)24 b(4.)40 b(Decreasing)25 b(the)h(v)-5 b(alue)24 +b(of)h(noisebits)f(will)e(impro)m(v)m(e)j(the)h(o)m(v)m(erall)f +(compression)f(e\016ciency)h(at)h(the)f(exp)s(ense)0 +3159 y(of)31 b(losing)e(more)h(information.)0 3319 y(A)g(small)e +(example)h(program)g(called)g('imcop)m(y')g(is)g(included)e(with)h +(CFITSIO)g(that)i(can)f(b)s(e)g(used)g(to)h(compress)0 +3432 y(\(or)44 b(uncompress\))g(an)m(y)g(FITS)g(image.)82 +b(This)42 b(program)i(can)h(b)s(e)e(used)h(to)g(exp)s(erimen)m(t)g +(with)f(the)h(v)-5 b(arious)0 3545 y(compression)29 b(options)h(on)g +(existing)g(FITS)f(images)i(as)f(sho)m(wn)g(in)f(these)i(examples:)0 +3794 y Fe(1\))95 b(imcopy)46 b(infile.fit)f('outfile.fit[compress]')334 +4020 y(This)i(will)f(use)h(the)g(default)f(compression)f(algorithm)g +(\(Rice\))h(and)h(the)334 4133 y(default)f(tile)h(size)f(\(row)h(by)g +(row\))0 4359 y(2\))95 b(imcopy)46 b(infile.fit)f +('outfile.fit[compress)d(GZIP]')334 4585 y(This)47 b(will)f(use)h(the)g +(GZIP)g(compression)e(algorithm)g(and)i(the)g(default)334 +4698 y(tile)g(size)f(\(row)h(by)g(row\).)94 b(The)47 +b(allowed)f(compression)f(algorithms)g(are)334 4811 y(Rice,)h(GZIP,)h +(and)g(PLIO.)94 b(Only)46 b(the)h(first)g(letter)f(of)h(the)g +(algorithm)334 4924 y(name)g(needs)f(to)h(be)g(specified.)0 +5149 y(3\))95 b(imcopy)46 b(infile.fit)f('outfile.fit[compress)d(G)47 +b(100,100]')334 5375 y(This)g(will)f(use)h(the)g(GZIP)g(compression)e +(algorithm)g(and)i(100)g(X)g(100)g(pixel)334 5488 y(tiles.)0 +5714 y(4\))95 b(imcopy)46 b(infile.fit)f('outfile.fit[compress)d(R)47 +b(100,100;)f(4]')p eop +%%Page: 45 53 +45 52 bop 0 299 a Fh(5.7.)72 b(ASCI)s(I)29 b(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(R)m(OUTINES)1864 b Fj(45)334 +668 y Fe(This)47 b(will)f(use)h(the)g(Rice)g(compression)e(algorithm,)g +(100)h(X)i(100)f(pixel)334 781 y(tiles,)f(and)h(noise_bits)e(=)j(4)f +(\(assuming)e(the)i(input)g(image)f(has)h(a)334 894 y(floating)f(point) +g(data)h(type\).)93 b(Decreasing)45 b(the)i(value)g(of)g(noisebits)334 +1007 y(will)g(improve)f(the)g(overall)g(compression)f(efficiency)g(at)i +(the)g(expense)334 1120 y(of)g(losing)f(more)h(information.)0 +1346 y(5\))95 b(imcopy)46 b(infile.fit)f(outfile.fit)334 +1571 y(If)i(the)g(input)g(file)f(is)h(in)h(tile-compressed)43 +b(format,)j(then)h(it)g(will)f(be)334 1684 y(uncompressed)f(to)i(the)g +(output)f(file.)94 b(Otherwise,)45 b(it)i(simply)f(copies)334 +1797 y(the)h(input)f(image)h(to)g(the)g(output)f(image.)0 +2023 y(6\))95 b(imcopy)46 b('infile.fit[1001:1500,20)o(01:2)o(500])o(') +89 b(outfile.fit)334 2249 y(This)47 b(extracts)e(a)j(500)f(X)g(500)g +(pixel)f(section)g(of)h(the)g(much)g(larger)334 2362 +y(input)f(image)h(\(which)f(may)h(be)g(in)g(tile-compressed)d +(format\).)93 b(The)334 2475 y(output)46 b(is)h(a)h(normal)e +(uncompressed)e(FITS)j(image.)0 2700 y(7\))95 b(imcopy)46 +b('infile.fit[1001:1500,20)o(01:2)o(500])o(')89 b(outfile.fit.gz)334 +2926 y(Same)47 b(as)g(above,)f(except)g(the)h(output)f(file)h(is)g +(externally)e(compressed)334 3039 y(using)h(the)h(gzip)g(algorithm.)0 +3513 y Ff(5.7)135 b(ASCI)t(I)45 b(and)f(Binary)h(T)-11 +b(able)45 b(Routines)0 3768 y Fj(These)36 b(routines)f(p)s(erform)g +(read)i(and)e(write)h(op)s(erations)g(on)g(columns)f(of)i(data)g(in)e +(FITS)h(ASCI)s(I)e(or)j(Binary)0 3881 y(tables.)46 b(Note)33 +b(that)g(in)d(the)j(follo)m(wing)d(discussions,)g(the)i(\014rst)g(ro)m +(w)g(and)f(column)g(in)g(a)h(table)g(is)g(at)g(p)s(osition)f(1)0 +3994 y(not)g(0.)0 4154 y(Users)k(should)f(also)i(read)f(the)h(follo)m +(wing)e(c)m(hapter)j(on)e(the)h(CFITSIO)e(iterator)i(function)f(whic)m +(h)f(pro)m(vides)h(a)0 4267 y(more)j(`ob)5 b(ject)39 +b(orien)m(ted')f(metho)s(d)g(of)g(reading)f(and)h(writing)e(table)i +(columns.)62 b(The)37 b(iterator)i(function)d(is)i(a)0 +4380 y(little)c(more)i(complicated)f(to)h(use,)h(but)e(the)g(adv)-5 +b(an)m(tages)38 b(are)d(that)i(it)e(usually)e(tak)m(es)k(less)d(co)s +(de)i(to)g(p)s(erform)0 4493 y(the)e(same)h(op)s(eration,)f(and)f(the)i +(resulting)d(program)h(oftens)i(runs)d(faster)i(b)s(ecause)g(the)h +(FITS)e(\014les)g(are)h(read)0 4606 y(and)c(written)f(using)g(the)i +(most)f(e\016cien)m(t)h(blo)s(c)m(k)f(size.)0 4924 y +Fd(5.7.1)112 b(Create)38 b(New)f(T)-9 b(able)0 5149 y +Fi(1)81 b Fj(Create)40 b(a)f(new)g(ASCI)s(I)e(or)i(bin)m(table)f(table) +h(extension.)67 b(If)39 b(the)g(FITS)g(\014le)f(is)g(curren)m(tly)g +(empt)m(y)i(then)f(a)227 5262 y(dumm)m(y)25 b(primary)e(arra)m(y)j +(will)d(b)s(e)i(created)i(b)s(efore)e(app)s(ending)e(the)j(table)f +(extension)h(to)g(it.)39 b(The)25 b(tblt)m(yp)s(e)227 +5375 y(parameter)39 b(de\014nes)e(the)h(t)m(yp)s(e)h(of)f(table)g(and)f +(can)i(ha)m(v)m(e)g(v)-5 b(alues)38 b(of)g(ASCI)s(I)p +2924 5375 28 4 v 31 w(TBL)g(or)g(BINAR)-8 b(Y)p 3659 +5375 V 34 w(TBL.)227 5488 y(The)29 b(naxis2)f(parameter)i(giv)m(es)f +(the)h(initial)c(n)m(um)m(b)s(er)i(of)h(ro)m(ws)g(to)h(b)s(e)f(created) +h(in)e(the)h(table,)g(and)g(should)227 5601 y(normally)f(b)s(e)h(set)h +(=)g(0.)40 b(CFITSIO)29 b(will)e(automatically)i(increase)h(the)f(size) +h(of)g(the)g(table)f(as)h(additional)227 5714 y(ro)m(ws)d(are)g +(written.)39 b(A)27 b(non-zero)g(n)m(um)m(b)s(er)f(of)h(ro)m(ws)g(ma)m +(y)g(b)s(e)f(sp)s(eci\014ed)f(to)j(reserv)m(e)f(space)h(for)e(that)i +(man)m(y)p eop +%%Page: 46 54 +46 53 bop 0 299 a Fj(46)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(ro)m(ws,)41 b(ev)m(en)e(if)f(a)h(few)m(er)g(n)m(um)m(b)s(er)e +(of)i(ro)m(ws)f(will)e(b)s(e)i(written.)65 b(The)38 b(tunit)f(and)h +(extname)i(parameters)227 668 y(are)e(optional)e(and)h(a)h(n)m(ull)d(p) +s(oin)m(ter)h(ma)m(y)i(b)s(e)f(giv)m(en)g(if)g(they)g(are)h(not)f +(de\014ned.)61 b(The)37 b(FITS)f(Standard)227 781 y(recommends)29 +b(that)h(only)f(letters,)h(digits,)f(and)g(the)g(underscore)g(c)m +(haracter)i(b)s(e)e(used)g(in)f(column)g(names)227 894 +y(\(the)d(tt)m(yp)s(e)g(parameter\))g(with)d(no)i(em)m(b)s(edded)f +(spaces.)40 b(T)-8 b(railing)21 b(blank)i(c)m(haracters)j(are)e(not)h +(signi\014can)m(t.)227 1007 y(It)36 b(is)f(recommended)g(that)i(all)e +(the)h(column)e(names)i(in)e(a)j(giv)m(en)e(table)h(b)s(e)f(unique)f +(within)f(the)j(\014rst)g(8)227 1120 y(c)m(haracters,)25 +b(and)c(strongly)f(recommended)h(that)h(the)f(names)h(b)s(e)e(unique)g +(within)e(the)k(\014rst)e(16)i(c)m(haracters.)95 1478 +y Fe(int)47 b(fits_create_tbl)d(/)j(ffcrtb)286 1591 y(\(fitsfile)f +(*fptr,)g(int)h(tbltype,)e(long)i(naxis2,)f(int)h(tfields,)e(char)i +(*ttype[],)334 1704 y(char)g(*tform[],)e(char)i(*tunit[],)e(char)i +(*extname,)e(int)i(*status\))0 1992 y Fd(5.7.2)112 b(Column)37 +b(Information)f(Routines)0 2199 y Fi(1)81 b Fj(Get)30 +b(the)g(n)m(um)m(b)s(er)e(of)i(ro)m(ws)g(or)f(columns)f(in)h(the)h +(curren)m(t)f(FITS)g(table.)40 b(The)29 b(n)m(um)m(b)s(er)f(of)i(ro)m +(ws)g(is)e(giv)m(en)i(b)m(y)227 2312 y(the)k(NAXIS2)f(k)m(eyw)m(ord)h +(and)e(the)i(n)m(um)m(b)s(er)e(of)h(columns)f(is)g(giv)m(en)h(b)m(y)g +(the)h(TFIELDS)e(k)m(eyw)m(ord)i(in)e(the)227 2424 y(header)e(of)h(the) +g(table.)95 2670 y Fe(int)47 b(fits_get_num_rows)c(/)48 +b(ffgnrw)286 2783 y(\(fitsfile)e(*fptr,)g(>)h(long)g(*nrows,)f(int)h +(*status\);)95 3008 y(int)g(fits_get_num_cols)c(/)48 +b(ffgncl)286 3121 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*ncols,)f(int)h +(*status\);)0 3366 y Fi(2)81 b Fj(Get)25 b(the)f(table)h(column)e(n)m +(um)m(b)s(er)g(\(and)h(name\))h(of)f(the)h(column)e(whose)h(name)g +(matc)m(hes)i(an)e(input)f(template)227 3479 y(name.)48 +b(If)32 b(casesen)i(=)e(CASESEN)g(then)g(the)h(column)e(name)i(matc)m +(h)h(will)c(b)s(e)i(case-sensitiv)m(e,)i(whereas)227 +3592 y(if)26 b(casesen)i(=)e(CASEINSEN)g(then)h(the)g(case)h(will)c(b)s +(e)i(ignored.)39 b(As)27 b(a)g(general)g(rule,)f(the)h(column)f(names) +227 3705 y(should)j(b)s(e)g(treated)j(as)e(case)i(INsensitiv)m(e.)227 +3853 y(The)26 b(input)f(column)g(name)h(template)h(ma)m(y)g(b)s(e)f +(either)g(the)h(exact)h(name)e(of)h(the)f(column)f(to)j(b)s(e)d(searc)m +(hed)227 3966 y(for,)k(or)f(it)g(ma)m(y)h(con)m(tain)g(wild)d(card)i(c) +m(haracters)i(\(*,)g(?,)f(or)f(#\),)h(or)f(it)g(ma)m(y)h(con)m(tain)g +(the)f(in)m(teger)h(n)m(um)m(b)s(er)227 4079 y(of)k(the)f(desired)e +(column)h(\(with)g(the)i(\014rst)e(column)g(=)h(1\).)46 +b(The)32 b(`*')h(wild)d(card)i(c)m(haracter)h(matc)m(hes)h(an)m(y)227 +4192 y(sequence)h(of)g(c)m(haracters)h(\(including)c(zero)j(c)m +(haracters\))i(and)d(the)h(`?')53 b(c)m(haracter)36 b(matc)m(hes)g(an)m +(y)f(single)227 4305 y(c)m(haracter.)42 b(The)29 b(#)h(wildcard)d(will) +g(matc)m(h)k(an)m(y)e(consecutiv)m(e)i(string)e(of)g(decimal)g(digits)f +(\(0-9\).)43 b(If)29 b(more)227 4418 y(than)43 b(one)f(column)g(name)g +(in)f(the)i(table)g(matc)m(hes)g(the)g(template)g(string,)i(then)d(the) +h(\014rst)e(matc)m(h)j(is)227 4530 y(returned)28 b(and)h(the)g(status)h +(v)-5 b(alue)29 b(will)d(b)s(e)j(set)h(to)g(COL)p 2171 +4530 28 4 v 32 w(NOT)p 2408 4530 V 32 w(UNIQUE)f(as)h(a)f(w)m(arning)f +(that)i(a)g(unique)227 4643 y(matc)m(h)e(w)m(as)g(not)f(found.)39 +b(T)-8 b(o)27 b(\014nd)f(the)h(other)g(cases)h(that)g(matc)m(h)g(the)g +(template,)g(call)e(the)i(routine)e(again)227 4756 y(lea)m(ving)f(the)g +(input)e(status)i(v)-5 b(alue)25 b(equal)f(to)i(COL)p +1950 4756 V 32 w(NOT)p 2187 4756 V 32 w(UNIQUE)f(and)f(the)h(next)h +(matc)m(hing)f(name)g(will)227 4869 y(then)30 b(b)s(e)g(returned.)40 +b(Rep)s(eat)30 b(this)g(pro)s(cess)g(un)m(til)e(a)j(status)g(=)f(COL)p +2628 4869 V 32 w(NOT)p 2865 4869 V 32 w(F)m(OUND)i(is)d(returned.)227 +5017 y(The)36 b(FITS)g(Standard)g(recommends)g(that)i(only)d(letters,)k +(digits,)e(and)f(the)h(underscore)f(c)m(haracter)j(b)s(e)227 +5130 y(used)32 b(in)g(column)g(names)g(\(with)g(no)h(em)m(b)s(edded)f +(spaces\).)49 b(T)-8 b(railing)30 b(blank)i(c)m(haracters)i(are)f(not)h +(signif-)227 5243 y(ican)m(t.)57 b(It)36 b(is)f(recommended)g(that)h +(all)f(the)h(column)e(names)i(in)e(a)i(giv)m(en)g(table)g(b)s(e)f +(unique)f(within)f(the)227 5356 y(\014rst)i(8)i(c)m(haracters,)h(and)e +(strongly)f(recommended)g(that)i(the)f(names)g(b)s(e)f(unique)f(within) +f(the)j(\014rst)f(16)227 5469 y(c)m(haracters.)95 5714 +y Fe(int)47 b(fits_get_colnum)d(/)j(ffgcno)p eop +%%Page: 47 55 +47 54 bop 0 299 a Fh(5.7.)72 b(ASCI)s(I)29 b(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(R)m(OUTINES)1864 b Fj(47)286 +555 y Fe(\(fitsfile)46 b(*fptr,)g(int)h(casesen,)e(char)i(*templt,)e(>) +j(int)f(*colnum,)334 668 y(int)g(*status\))95 894 y(int)g +(fits_get_colname)d(/)j(ffgcnn)286 1007 y(\(fitsfile)f(*fptr,)g(int)h +(casesen,)e(char)i(*templt,)e(>)j(char)e(*colname,)334 +1120 y(int)h(*colnum,)f(int)g(*status\))0 1350 y Fi(3)81 +b Fj(Return)30 b(the)i(data)g(t)m(yp)s(e,)h(v)m(ector)g(rep)s(eat)f(v) +-5 b(alue,)31 b(and)g(the)h(width)e(in)g(b)m(ytes)i(of)g(a)g(column)e +(in)g(an)i(ASCI)s(I)e(or)227 1463 y(binary)k(table.)55 +b(Allo)m(w)m(ed)35 b(v)-5 b(alues)35 b(for)g(the)h(data)g(t)m(yp)s(e)f +(in)f(ASCI)s(I)g(tables)h(are:)51 b(TSTRING,)35 b(TSHOR)-8 +b(T,)227 1576 y(TLONG,)36 b(TFLO)m(A)-8 b(T,)36 b(and)f(TDOUBLE.)i +(Binary)d(tables)i(also)g(supp)s(ort)e(these)i(t)m(yp)s(es:)52 +b(TLOGICAL,)227 1689 y(TBIT,)38 b(TBYTE,)h(TCOMPLEX)e(and)h +(TDBLCOMPLEX.)h(The)f(negativ)m(e)h(of)g(the)g(data)g(t)m(yp)s(e)g(co)s +(de)227 1802 y(v)-5 b(alue)31 b(is)f(returned)g(if)g(it)g(is)h(a)g(v)-5 +b(ariable)30 b(length)g(arra)m(y)i(column.)42 b(Note)32 +b(that)g(in)d(the)j(case)g(of)f(a)g('J')h(32-bit)227 +1914 y(in)m(teger)f(binary)d(table)i(column,)f(this)g(routine)g(will)e +(return)i(data)i(t)m(yp)s(e)f(=)g(TINT32BIT)g(\(whic)m(h)f(in)g(fact) +227 2027 y(is)35 b(equiv)-5 b(alen)m(t)35 b(to)i(TLONG\).)f(With)f +(most)h(curren)m(t)g(C)f(compilers,)h(a)h(v)-5 b(alue)35 +b(in)f(a)j('J')f(column)e(has)i(the)227 2140 y(same)29 +b(size)f(as)h(an)f('in)m(t')h(v)-5 b(ariable,)28 b(and)f(ma)m(y)j(not)e +(b)s(e)g(equiv)-5 b(alen)m(t)28 b(to)h(a)g('long')f(v)-5 +b(ariable,)28 b(whic)m(h)f(is)h(64-bits)227 2253 y(long)i(on)h(an)f +(increasing)f(n)m(um)m(b)s(er)g(of)h(compilers.)227 2398 +y(The)22 b('rep)s(eat')h(parameter)g(returns)f(the)g(v)m(ector)i(rep)s +(eat)f(coun)m(t)g(on)f(the)h(binary)e(table)h(TF)m(ORMn)g(k)m(eyw)m +(ord)227 2511 y(v)-5 b(alue.)59 b(\(ASCI)s(I)35 b(table)i(columns)e +(alw)m(a)m(ys)i(ha)m(v)m(e)h(rep)s(eat)e(=)g(1\).)60 +b(The)36 b('width')f(parameter)i(returns)f(the)227 2624 +y(width)29 b(in)g(b)m(ytes)i(of)g(a)f(single)f(column)h(elemen)m(t)h +(\(e.g.,)h(a)f('10D')h(binary)d(table)h(column)f(will)f(ha)m(v)m(e)k +(width)227 2737 y(=)d(8,)i(an)e(ASCI)s(I)f(table)h('F12.2')j(column)d +(will)e(ha)m(v)m(e)j(width)e(=)h(12,)i(and)e(a)h(binary)d(table'60A')k +(c)m(haracter)227 2850 y(string)36 b(column)g(will)f(ha)m(v)m(e)j +(width)e(=)h(60\);)42 b(Note)c(that)g(this)e(routine)h(supp)s(orts)e +(the)i(lo)s(cal)g(con)m(v)m(en)m(tion)227 2963 y(for)42 +b(sp)s(ecifying)d(arra)m(ys)k(of)f(\014xed)f(length)g(strings)f(within) +g(a)i(binary)e(table)h(c)m(haracter)j(column)c(using)227 +3076 y(the)h(syn)m(tax)g(TF)m(ORM)g(=)g('rAw')f(where)g('r')h(is)f(the) +h(total)g(n)m(um)m(b)s(er)e(of)i(c)m(haracters)h(\(=)f(the)g(width)e +(of)227 3189 y(the)g(column\))f(and)f('w')i(is)e(the)i(width)e(of)h(a)h +(unit)e(string)g(within)f(the)j(column.)64 b(Th)m(us)37 +b(if)g(the)i(column)227 3302 y(has)34 b(TF)m(ORM)h(=)f('60A12')j(then)d +(this)f(means)h(that)h(eac)m(h)g(ro)m(w)g(of)f(the)h(table)f(con)m +(tains)g(5)h(12-c)m(haracter)227 3415 y(substrings)22 +b(within)g(the)i(60-c)m(haracter)j(\014eld,)e(and)e(th)m(us)h(in)f +(this)g(case)i(this)f(routine)f(will)e(return)i(t)m(yp)s(eco)s(de)227 +3528 y(=)36 b(TSTRING,)f(rep)s(eat)h(=)f(60,)j(and)d(width)f(=)i(12.)57 +b(The)35 b(n)m(um)m(b)s(er)g(of)h(substings)e(in)g(an)m(y)i(binary)e +(table)227 3640 y(c)m(haracter)i(string)d(\014eld)f(can)i(b)s(e)g +(calculated)g(b)m(y)f(\(rep)s(eat/width\).)52 b(A)34 +b(n)m(ull)d(p)s(oin)m(ter)i(ma)m(y)i(b)s(e)e(giv)m(en)h(for)227 +3753 y(an)m(y)d(of)g(the)f(output)g(parameters)h(that)g(are)g(not)f +(needed.)227 3899 y(The)46 b(second)g(routine,)j(\014t)p +1188 3899 28 4 v 33 w(get)p 1341 3899 V 34 w(eqcolt)m(yp)s(e)d(is)f +(similar)f(except)j(that)f(in)f(the)h(case)i(of)e(scaled)g(in)m(teger) +227 4012 y(columns)34 b(it)g(returns)g(the)h('equiv)-5 +b(alen)m(t')35 b(data)h(t)m(yp)s(e)f(that)h(is)e(needed)g(to)i(store)g +(the)f(scaled)g(v)-5 b(alues,)36 b(and)227 4125 y(not)28 +b(necessarily)f(the)h(ph)m(ysical)e(data)i(t)m(yp)s(e)g(of)g(the)g +(unscaled)e(v)-5 b(alues)28 b(as)f(stored)h(in)f(the)g(FITS)g(table.)40 +b(F)-8 b(or)227 4237 y(example)37 b(if)g(a)h('1I')g(column)e(in)g(a)i +(binary)e(table)h(has)h(TSCALn)d(=)j(1)f(and)g(TZER)m(On)f(=)i(32768,)j +(then)227 4350 y(this)28 b(column)f(e\013ectiv)m(ely)j(con)m(tains)e +(unsigned)f(short)h(in)m(teger)h(v)-5 b(alues,)28 b(and)g(th)m(us)h +(the)f(returned)g(v)-5 b(alue)28 b(of)227 4463 y(t)m(yp)s(eco)s(de)34 +b(will)c(b)s(e)j(TUSHOR)-8 b(T,)32 b(not)h(TSHOR)-8 b(T.)33 +b(Similarly)-8 b(,)30 b(if)i(a)i(column)e(has)g(TTYPEn)g(=)h('1I')h +(and)227 4576 y(TSCALn)29 b(=)h(0.12,)i(then)e(the)h(returned)e(t)m(yp) +s(eco)s(de)i(will)c(b)s(e)j(TFLO)m(A)-8 b(T.)95 4806 +y Fe(int)47 b(fits_get_coltype)d(/)j(ffgtcl)286 4919 +y(\(fitsfile)f(*fptr,)g(int)h(colnum,)e(>)j(int)f(*typecode,)e(long)h +(*repeat,)334 5032 y(long)h(*width,)f(int)g(*status\))95 +5258 y(int)h(fits_get_eqcoltype)c(/)48 b(ffeqty)286 5371 +y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(>)j(int)f(*typecode,)e(long)h +(*repeat,)334 5484 y(long)h(*width,)f(int)g(*status\))0 +5714 y Fi(4)81 b Fj(Return)29 b(the)h(displa)m(y)e(width)g(of)i(a)h +(column.)39 b(This)28 b(is)h(the)h(length)g(of)g(the)g(string)f(that)i +(will)c(b)s(e)i(returned)g(b)m(y)p eop +%%Page: 48 56 +48 55 bop 0 299 a Fj(48)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(the)k(\014ts)p 514 555 28 4 v 32 w(read)p 718 +555 V 33 w(col)f(routine)f(when)g(reading)g(the)i(column)d(as)j(a)f +(formatted)h(string.)48 b(The)32 b(displa)m(y)g(width)227 +668 y(is)c(determined)g(b)m(y)h(the)g(TDISPn)f(k)m(eyw)m(ord,)i(if)e +(presen)m(t,)i(otherwise)e(b)m(y)h(the)g(data)h(t)m(yp)s(e)f(of)h(the)f +(column.)95 1039 y Fe(int)47 b(fits_get_col_display_width)41 +b(/)47 b(ffgcdw)286 1152 y(\(fitsfile)f(*fptr,)g(int)h(colnum,)e(>)j +(int)f(*dispwidth,)e(int)h(*status\))0 1410 y Fi(5)81 +b Fj(Return)27 b(the)i(n)m(um)m(b)s(er)e(of)i(and)e(size)i(of)f(the)h +(dimensions)d(of)i(a)h(table)f(column)g(in)f(a)h(binary)f(table.)40 +b(Normally)227 1523 y(this)27 b(information)g(is)g(giv)m(en)h(b)m(y)g +(the)h(TDIMn)f(k)m(eyw)m(ord,)h(but)e(if)h(this)f(k)m(eyw)m(ord)h(is)f +(not)i(presen)m(t)f(then)g(this)227 1635 y(routine)i(returns)f(naxis)g +(=)h(1)h(and)f(naxes[0])h(equal)f(to)h(the)g(rep)s(eat)f(coun)m(t)h(in) +e(the)i(TF)m(ORM)g(k)m(eyw)m(ord.)95 1893 y Fe(int)47 +b(fits_read_tdim)d(/)k(ffgtdm)286 2006 y(\(fitsfile)e(*fptr,)g(int)h +(colnum,)e(int)i(maxdim,)f(>)i(int)f(*naxis,)334 2119 +y(long)g(*naxes,)f(int)g(*status\))0 2377 y Fi(6)81 b +Fj(Deco)s(de)33 b(the)g(input)e(TDIMn)i(k)m(eyw)m(ord)g(string)e +(\(e.g.)50 b('\(100,200\)'\))37 b(and)32 b(return)g(the)h(n)m(um)m(b)s +(er)e(of)i(and)f(size)227 2490 y(of)c(the)g(dimensions)d(of)j(a)g +(binary)e(table)h(column.)39 b(If)27 b(the)h(input)e(tdimstr)g(c)m +(haracter)j(string)e(is)g(n)m(ull,)f(then)227 2603 y(this)e(routine)f +(returns)g(naxis)g(=)i(1)f(and)g(naxes[0])i(equal)d(to)j(the)e(rep)s +(eat)h(coun)m(t)g(in)e(the)h(TF)m(ORM)h(k)m(eyw)m(ord.)227 +2716 y(This)k(routine)g(is)h(called)f(b)m(y)h(\014ts)p +1350 2716 V 33 w(read)p 1555 2716 V 33 w(tdim.)95 2973 +y Fe(int)47 b(fits_decode_tdim)d(/)j(ffdtdm)286 3086 +y(\(fitsfile)f(*fptr,)g(char)g(*tdimstr,)g(int)h(colnum,)e(int)i +(maxdim,)f(>)i(int)e(*naxis,)334 3199 y(long)h(*naxes,)f(int)g +(*status\))0 3457 y Fi(7)81 b Fj(W)-8 b(rite)22 b(a)h(TDIMn)f(k)m(eyw)m +(ord)h(whose)f(v)-5 b(alue)22 b(has)h(the)f(form)g('\(l,m,n...\)')39 +b(where)22 b(l,)h(m,)h(n...)38 b(are)23 b(the)g(dimensions)227 +3570 y(of)31 b(a)g(m)m(ultidimension)26 b(arra)m(y)31 +b(column)e(in)g(a)i(binary)d(table.)95 3828 y Fe(int)47 +b(fits_write_tdim)d(/)j(ffptdm)286 3941 y(\(fitsfile)f(*fptr,)g(int)h +(colnum,)e(int)i(naxis,)f(long)h(*naxes,)f(>)h(int)g(*status\))0 +4231 y Fd(5.7.3)112 b(Routines)37 b(to)g(Edit)f(Ro)m(ws)h(or)g(Columns) +0 4440 y Fi(1)81 b Fj(Insert)22 b(or)h(delete)g(ro)m(ws)f(in)g(an)h +(ASCI)s(I)e(or)i(binary)e(table.)38 b(When)22 b(inserting)f(ro)m(ws)i +(all)f(the)h(ro)m(ws)g(follo)m(wing)e(ro)m(w)227 4553 +y(FR)m(O)m(W)29 b(are)f(shifted)f(do)m(wn)g(b)m(y)h(NR)m(O)m(WS)g(ro)m +(ws;)h(if)e(FR)m(O)m(W)i(=)e(0)h(then)f(the)h(blank)f(ro)m(ws)h(are)g +(inserted)e(at)227 4666 y(the)h(b)s(eginning)d(of)j(the)f(table.)40 +b(The)26 b(\014rst)g(delete)h(routine)e(deletes)i(NR)m(O)m(WS)g +(consecutiv)m(e)h(ro)m(ws)e(starting)227 4779 y(with)i(ro)m(w)i(FIRSTR) +m(O)m(W.)g(The)f(second)g(delete)h(routine)e(tak)m(es)j(an)e(input)f +(string)g(that)i(lists)e(the)i(ro)m(ws)f(or)227 4891 +y(ro)m(w)24 b(ranges)f(\(e.g.,)k('5-10,12,20-30'\),)k(whereas)23 +b(the)h(third)d(delete)j(routine)e(tak)m(es)j(an)e(input)f(in)m(teger)h +(arra)m(y)227 5004 y(that)35 b(sp)s(eci\014es)e(eac)m(h)i(individual)30 +b(ro)m(w)k(to)h(b)s(e)f(deleted.)52 b(In)34 b(b)s(oth)f(latter)i +(cases,)h(the)e(input)f(list)g(of)h(ro)m(ws)227 5117 +y(to)e(delete)f(m)m(ust)f(b)s(e)g(sorted)h(in)e(ascending)h(order.)41 +b(These)31 b(routines)e(up)s(date)h(the)h(NAXIS2)g(k)m(eyw)m(ord)g(to) +227 5230 y(re\015ect)g(the)g(new)f(n)m(um)m(b)s(er)f(of)h(ro)m(ws)h(in) +e(the)h(table.)95 5488 y Fe(int)47 b(fits_insert_rows)d(/)j(ffirow)286 +5601 y(\(fitsfile)f(*fptr,)g(long)g(firstrow,)g(long)g(nrows,)g(>)i +(int)f(*status\))p eop +%%Page: 49 57 +49 56 bop 0 299 a Fh(5.7.)72 b(ASCI)s(I)29 b(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(R)m(OUTINES)1864 b Fj(49)95 +555 y Fe(int)47 b(fits_delete_rows)d(/)j(ffdrow)286 668 +y(\(fitsfile)f(*fptr,)g(long)g(firstrow,)g(long)g(nrows,)g(>)i(int)f +(*status\))95 894 y(int)g(fits_delete_rowrange)c(/)k(ffdrrg)286 +1007 y(\(fitsfile)f(*fptr,)g(char)g(*rangelist,)f(>)j(int)e(*status\)) +95 1233 y(int)h(fits_delete_rowlist)c(/)k(ffdrws)286 +1346 y(\(fitsfile)f(*fptr,)g(long)g(*rowlist,)g(long)g(nrows,)g(>)i +(int)f(*status\))0 1600 y Fi(2)81 b Fj(Insert)36 b(or)h(delete)h +(column\(s\))e(in)g(an)h(ASCI)s(I)f(or)h(binary)e(table.)61 +b(When)37 b(inserting,)g(COLNUM)g(sp)s(eci\014es)227 +1713 y(the)28 b(column)f(n)m(um)m(b)s(er)g(that)h(the)g(\(\014rst\))g +(new)f(column)g(should)f(o)s(ccup)m(y)i(in)f(the)h(table.)40 +b(NCOLS)26 b(sp)s(eci\014es)227 1826 y(ho)m(w)35 b(man)m(y)g(columns)e +(are)i(to)g(b)s(e)f(inserted.)52 b(An)m(y)35 b(existing)f(columns)f +(from)h(this)g(p)s(osition)e(and)i(higher)227 1939 y(are)c(shifted)e(o) +m(v)m(er)i(to)g(allo)m(w)e(ro)s(om)h(for)g(the)h(new)e(column\(s\).)40 +b(The)29 b(index)e(n)m(um)m(b)s(er)h(on)h(all)f(the)h(follo)m(wing)227 +2051 y(k)m(eyw)m(ords)34 b(will)c(b)s(e)j(incremen)m(ted)g(or)g +(decremen)m(ted)h(if)e(necessary)i(to)g(re\015ect)g(the)f(new)g(p)s +(osition)e(of)j(the)227 2164 y(column\(s\))25 b(in)f(the)i(table:)38 +b(TBCOLn,)26 b(TF)m(ORMn,)h(TTYPEn,)e(TUNITn,)h(TNULLn,)g(TSCALn,)f +(TZE-)227 2277 y(R)m(On,)43 b(TDISPn,)g(TDIMn,)g(TLMINn,)g(TLMAXn,)g +(TDMINn,)g(TDMAXn,)h(TCTYPn,)e(TCRPXn,)227 2390 y(TCR)-10 +b(VLn,)29 b(TCDL)-8 b(Tn,)30 b(TCR)m(OTn,)f(and)h(TCUNIn.)95 +2644 y Fe(int)47 b(fits_insert_col)d(/)j(fficol)286 2757 +y(\(fitsfile)f(*fptr,)g(int)h(colnum,)e(char)i(*ttype,)f(char)h +(*tform,)334 2870 y(>)h(int)e(*status\))95 3096 y(int)h +(fits_insert_cols)d(/)j(fficls)286 3209 y(\(fitsfile)f(*fptr,)g(int)h +(colnum,)e(int)i(ncols,)f(char)h(**ttype,)334 3322 y(char)g(**tform,)e +(>)j(int)f(*status\))95 3548 y(int)g(fits_delete_col)d(/)j +(ffdcol\(fitsfile)d(*fptr,)i(int)h(colnum,)f(>)h(int)g(*status\))0 +3802 y Fi(3)81 b Fj(Cop)m(y)32 b(a)h(column)f(from)g(one)h(HDU)g(to)h +(another)e(\(or)h(to)h(the)f(same)g(HDU\).)h(If)e(create)p +3129 3802 28 4 v 34 w(col)h(=)f(TR)m(UE,)h(then)227 3915 +y(a)40 b(new)e(column)g(will)e(b)s(e)j(inserted)f(in)f(the)i(output)g +(table,)i(at)f(p)s(osition)d(`outcolumn',)k(otherwise)e(the)227 +4028 y(existing)e(output)h(column)e(will)g(b)s(e)h(o)m(v)m(erwritten)h +(\(in)f(whic)m(h)g(case)i(it)e(m)m(ust)h(ha)m(v)m(e)h(a)f(compatible)f +(data)227 4141 y(t)m(yp)s(e\).)k(If)29 b(outcoln)m(um)g(is)f(greater)j +(than)e(the)h(n)m(um)m(b)s(er)e(of)h(column)f(in)g(the)i(table,)g(then) +f(the)g(new)g(column)227 4254 y(will)g(b)s(e)i(app)s(ended)f(to)j(the)f +(end)f(of)g(the)h(table.)45 b(Note)33 b(that)f(the)g(\014rst)f(column)f +(in)h(a)h(table)f(is)g(at)i(coln)m(um)227 4366 y(=)j(1.)58 +b(The)36 b(standard)f(indexed)f(k)m(eyw)m(ords)j(that)f(related)g(to)h +(the)f(column)f(\(e.g.,)k(TDISPn,)e(TUNITn,)227 4479 +y(TCRPXn,)30 b(TCDL)-8 b(Tn,)29 b(etc.\))43 b(will)27 +b(also)k(b)s(e)e(copied.)95 4734 y Fe(int)47 b(fits_copy_col)e(/)i +(ffcpcl)286 4846 y(\(fitsfile)f(*infptr,)f(fitsfile)h(*outfptr,)f(int)i +(incolnum,)e(int)i(outcolnum,)334 4959 y(int)g(create_col,)e(>)i(int)g +(*status\);)0 5214 y Fi(4)81 b Fj(Mo)s(dify)36 b(the)h(v)m(ector)i +(length)e(of)g(a)h(binary)d(table)i(column)f(\(e.g.,)41 +b(c)m(hange)e(a)e(column)f(from)h(TF)m(ORMn)g(=)227 5327 +y('1E')31 b(to)h('20E'\).)g(The)e(v)m(ector)i(length)d(ma)m(y)i(b)s(e)f +(increased)g(or)g(decreased)h(from)f(the)g(curren)m(t)h(v)-5 +b(alue.)95 5581 y Fe(int)47 b(fits_modify_vector_len)42 +b(/)48 b(ffmvec)286 5694 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i +(newveclen,)e(>)j(int)e(*status\))p eop +%%Page: 50 58 +50 57 bop 0 299 a Fj(50)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fd(5.7.4)112 b(Read)38 b(and)h(W)-9 b(rite)35 b(Column)i(Data)g +(Routines)0 775 y Fj(The)e(follo)m(wing)e(routines)i(write)f(or)h(read) +g(data)h(v)-5 b(alues)35 b(in)f(the)h(curren)m(t)g(ASCI)s(I)f(or)h +(binary)f(table)h(extension.)0 888 y(If)e(a)g(write)f(op)s(eration)h +(extends)g(b)s(ey)m(ond)f(the)h(curren)m(t)g(size)g(of)g(the)g(table,)h +(then)f(the)g(n)m(um)m(b)s(er)f(of)h(ro)m(ws)g(in)f(the)0 +1001 y(table)i(will)e(automatically)i(b)s(e)f(increased)h(and)f(the)i +(NAXIS2)f(k)m(eyw)m(ord)h(v)-5 b(alue)34 b(will)d(b)s(e)j(up)s(dated.) +51 b(A)m(ttempts)0 1114 y(to)31 b(read)f(b)s(ey)m(ond)g(the)h(end)e(of) +i(the)f(table)h(will)c(result)j(in)f(an)h(error.)0 1274 +y(Automatic)c(data)f(t)m(yp)s(e)g(con)m(v)m(ersion)g(is)f(p)s(erformed) +g(for)g(n)m(umerical)g(data)h(t)m(yp)s(es)g(\(only\))g(if)f(the)h(data) +h(t)m(yp)s(e)f(of)g(the)0 1387 y(column)f(\(de\014ned)h(b)m(y)g(the)h +(TF)m(ORMn)f(k)m(eyw)m(ord\))h(di\013ers)e(from)h(the)h(data)g(t)m(yp)s +(e)f(of)h(the)f(calling)f(routine.)38 b(ASCI)s(I)0 1500 +y(and)20 b(binary)e(tables)i(supp)s(ort)f(the)i(follo)m(wing)d(data)j +(t)m(yp)s(e)g(v)-5 b(alues:)35 b(TSTRING,)20 b(TBYTE,)g(TSBYTE,)g +(TSHOR)-8 b(T,)0 1613 y(TUSHOR)g(T,)22 b(TINT,)g(TUINT,)f(TLONG,)i +(TLONGLONG,)f(TULONG,)g(TFLO)m(A)-8 b(T,)23 b(or)f(TDOUBLE.)h(Binary)0 +1726 y(tables)37 b(also)g(supp)s(ort)e(TLOGICAL)h(\(in)m(ternally)g +(mapp)s(ed)g(to)h(the)h(`c)m(har')g(data)g(t)m(yp)s(e\),)h(TCOMPLEX,)e +(and)0 1839 y(TDBLCOMPLEX.)0 1999 y(Note)25 b(that)g(within)c(the)j +(con)m(text)i(of)e(these)g(routines,)h(the)f(TSTRING)f(data)h(t)m(yp)s +(e)g(corresp)s(onds)f(to)h(a)h(C)e('c)m(har**')0 2112 +y(data)35 b(t)m(yp)s(e,)h(i.e.,)g(a)f(p)s(oin)m(ter)e(to)j(an)e(arra)m +(y)h(of)g(p)s(oin)m(ters)e(to)i(an)g(arra)m(y)g(of)g(c)m(haracters.)54 +b(This)33 b(is)g(di\013eren)m(t)h(from)0 2225 y(the)e(k)m(eyw)m(ord)h +(reading)e(and)g(writing)f(routines)h(where)h(TSTRING)f(corresp)s(onds) +g(to)h(a)h(C)e('c)m(har*')j(data)f(t)m(yp)s(e,)0 2338 +y(i.e.,)f(a)f(single)f(p)s(oin)m(ter)g(to)i(an)f(arra)m(y)g(of)g(c)m +(haracters.)45 b(When)30 b(reading)h(strings)e(from)i(a)g(table,)h(the) +f(c)m(har)h(arra)m(ys)0 2451 y(ob)m(viously)d(m)m(ust)h(ha)m(v)m(e)i(b) +s(een)e(allo)s(cated)g(long)g(enough)g(to)h(hold)e(the)i(whole)e(FITS)h +(table)g(string.)0 2611 y(Numerical)h(data)i(v)-5 b(alues)32 +b(are)h(automatically)g(scaled)f(b)m(y)g(the)h(TSCALn)e(and)h(TZER)m +(On)f(k)m(eyw)m(ord)i(v)-5 b(alues)32 b(\(if)0 2724 y(they)f(exist\).)0 +2884 y(In)25 b(the)g(case)i(of)e(binary)f(tables)h(with)f(v)m(ector)j +(elemen)m(ts,)g(the)f('felem')f(parameter)h(de\014nes)f(the)g(starting) +g(elemen)m(t)0 2997 y(\(b)s(eginning)g(with)h(1,)i(not)g(0\))g(within)d +(the)i(cell)g(\(a)h(cell)e(is)g(de\014ned)g(as)i(the)f(in)m(tersection) +g(of)h(a)f(ro)m(w)h(and)e(a)i(column)0 3110 y(and)e(ma)m(y)h(con)m +(tain)g(a)h(single)d(v)-5 b(alue)26 b(or)h(a)g(v)m(ector)h(of)f(v)-5 +b(alues\).)39 b(The)26 b(felem)h(parameter)g(is)f(ignored)f(when)h +(dealing)0 3223 y(with)33 b(ASCI)s(I)f(tables.)51 b(Similarly)-8 +b(,)32 b(in)g(the)j(case)f(of)h(binary)d(tables)h(the)i('nelemen)m(ts') +f(parameter)g(sp)s(eci\014es)f(the)0 3336 y(total)27 +b(n)m(um)m(b)s(er)e(of)h(v)m(ector)i(v)-5 b(alues)26 +b(to)h(b)s(e)e(read)h(or)h(written)e(\(con)m(tin)m(uing)h(on)g +(subsequen)m(t)f(ro)m(ws)i(if)e(required\))g(and)0 3448 +y(not)31 b(the)f(n)m(um)m(b)s(er)f(of)i(table)f(cells.)0 +3714 y Fi(1)81 b Fj(W)-8 b(rite)30 b(elemen)m(ts)h(in)m(to)f(an)h(ASCI) +s(I)e(or)h(binary)e(table)j(column.)0 3980 y(The)38 b(\014rst)f +(routine)g(simply)f(writes)h(the)h(arra)m(y)h(of)f(v)-5 +b(alues)38 b(to)h(the)f(FITS)g(\014le)f(\(doing)g(data)i(t)m(yp)s(e)g +(con)m(v)m(ersion)0 4093 y(if)g(necessary\))i(whereas)f(the)h(second)f +(routine)g(will)d(substitute)j(the)g(appropriate)f(FITS)h(n)m(ull)e(v) +-5 b(alue)40 b(for)g(all)0 4206 y(elemen)m(ts)33 b(whic)m(h)f(are)h +(equal)g(to)g(the)g(input)e(v)-5 b(alue)33 b(of)g(n)m(ulv)-5 +b(al)31 b(\(note)j(that)f(this)f(parameter)h(giv)m(es)h(the)f(address)0 +4319 y(of)40 b(n)m(ulv)-5 b(al,)42 b(not)e(the)g(n)m(ull)e(v)-5 +b(alue)40 b(itself)7 b(\).)70 b(F)-8 b(or)40 b(in)m(teger)h(columns)e +(the)h(FITS)g(n)m(ull)e(v)-5 b(alue)39 b(is)h(de\014ned)f(b)m(y)h(the)0 +4432 y(TNULLn)32 b(k)m(eyw)m(ord)i(\(an)g(error)e(is)h(returned)f(if)g +(the)i(k)m(eyw)m(ord)f(do)s(esn't)g(exist\).)50 b(F)-8 +b(or)34 b(\015oating)f(p)s(oin)m(t)f(columns)0 4545 y(the)i(sp)s(ecial) +f(IEEE)h(NaN)h(\(Not-a-Num)m(b)s(er\))h(v)-5 b(alue)34 +b(will)d(b)s(e)j(written)f(in)m(to)i(the)f(FITS)g(\014le.)51 +b(If)34 b(a)h(n)m(ull)d(p)s(oin)m(ter)0 4658 y(is)g(en)m(tered)h(for)g +(n)m(ulv)-5 b(al,)32 b(then)h(the)g(n)m(ull)e(v)-5 b(alue)32 +b(is)g(ignored)g(and)h(this)f(routine)f(b)s(eha)m(v)m(es)j(the)f(same)g +(as)h(the)f(\014rst)0 4771 y(routine.)39 b(The)26 b(second)i(routine)e +(m)m(ust)h(not)h(b)s(e)e(used)h(to)h(write)e(to)i(v)-5 +b(ariable)26 b(length)h(arra)m(y)h(columns.)38 b(The)27 +b(third)0 4883 y(routine)i(simply)f(writes)i(unde\014ned)e(pixel)h(v)-5 +b(alues)29 b(to)i(the)g(column.)95 5149 y Fe(int)47 b(fits_write_col)d +(/)k(ffpcl)286 5262 y(\(fitsfile)e(*fptr,)g(int)h(datatype,)e(int)i +(colnum,)f(long)g(firstrow,)334 5375 y(long)h(firstelem,)e(long)h +(nelements,)f(DTYPE)i(*array,)f(>)h(int)g(*status\))95 +5601 y(int)g(fits_write_colnull)c(/)48 b(ffpcn)286 5714 +y(\(fitsfile)e(*fptr,)g(int)h(datatype,)e(int)i(colnum,)f(long)g +(firstrow,)p eop +%%Page: 51 59 +51 58 bop 0 299 a Fh(5.7.)72 b(ASCI)s(I)29 b(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(R)m(OUTINES)1864 b Fj(51)286 +555 y Fe(long)47 b(firstelem,)e(long)i(nelements,)e(DTYPE)h(*array,)g +(DTYPE)g(*nulval,)286 668 y(>)i(int)f(*status\))143 894 +y(int)g(fits_write_col_null)c(/)k(ffpclu)334 1007 y(\(fitsfile)e +(*fptr,)h(int)h(colnum,)f(long)h(firstrow,)e(long)i(firstelem,)382 +1120 y(long)f(nelements,)f(>)j(int)f(*status\))0 1375 +y Fi(2)81 b Fj(Read)33 b(elemen)m(ts)h(from)f(an)g(ASCI)s(I)f(or)i +(binary)d(table)i(column.)49 b(The)33 b(data)h(t)m(yp)s(e)g(parameter)g +(sp)s(eci\014es)e(the)227 1488 y(data)c(t)m(yp)s(e)g(of)g(the)f(`n)m +(ulv)-5 b(al')27 b(and)g(`arra)m(y')h(p)s(oin)m(ters;)g(Unde\014ned)d +(arra)m(y)j(elemen)m(ts)g(will)d(b)s(e)i(returned)f(with)227 +1601 y(a)k(v)-5 b(alue)29 b(=)f(*n)m(ullv)-5 b(al,)28 +b(\(note)i(that)g(this)e(parameter)i(giv)m(es)f(the)h(address)e(of)h +(the)h(n)m(ull)d(v)-5 b(alue,)29 b(not)h(the)f(n)m(ull)227 +1714 y(v)-5 b(alue)30 b(itself)7 b(\))30 b(unless)f(n)m(ulv)-5 +b(al)30 b(=)g(0)h(or)g(*n)m(ulv)-5 b(al)29 b(=)i(0,)g(in)e(whic)m(h)h +(case)i(no)e(c)m(hec)m(king)i(for)e(unde\014ned)f(pixels)227 +1827 y(will)i(b)s(e)i(p)s(erformed.)48 b(The)33 b(second)g(routine)g +(is)f(similar)f(except)j(that)g(an)m(y)g(unde\014ned)d(pixels)h(will)f +(ha)m(v)m(e)227 1940 y(the)g(corresp)s(onding)d(n)m(ullarra)m(y)h +(elemen)m(t)i(set)g(equal)f(to)h(TR)m(UE)f(\(=)h(1\).)227 +2089 y(An)m(y)c(column,)f(regardless)f(of)h(it's)g(in)m(trinsic)e(data) +j(t)m(yp)s(e,)g(ma)m(y)g(b)s(e)e(read)i(as)f(a)g(string.)39 +b(It)26 b(should)e(b)s(e)i(noted)227 2202 y(ho)m(w)m(ev)m(er)32 +b(that)f(reading)e(a)i(n)m(umeric)e(column)g(as)i(a)g(string)e(is)g(10) +j(-)e(100)i(times)e(slo)m(w)m(er)g(than)g(reading)g(the)227 +2315 y(same)22 b(column)f(as)g(a)h(n)m(um)m(b)s(er)e(due)h(to)i(the)e +(large)h(o)m(v)m(erhead)h(in)d(constructing)h(the)h(formatted)g +(strings.)36 b(The)227 2428 y(displa)m(y)24 b(format)i(of)f(the)h +(returned)e(strings)g(will)f(b)s(e)i(determined)f(b)m(y)h(the)h(TDISPn) +e(k)m(eyw)m(ord,)j(if)d(it)h(exists,)227 2541 y(otherwise)31 +b(b)m(y)g(the)g(data)h(t)m(yp)s(e)f(of)g(the)g(column.)42 +b(The)30 b(length)h(of)g(the)g(returned)f(strings)g(\(not)h(including) +227 2654 y(the)26 b(n)m(ull)d(terminating)i(c)m(haracter\))i(can)f(b)s +(e)f(determined)f(with)g(the)i(\014ts)p 2703 2654 28 +4 v 32 w(get)p 2855 2654 V 34 w(col)p 3000 2654 V 33 +w(displa)m(y)p 3313 2654 V 31 w(width)e(routine.)227 +2767 y(The)30 b(follo)m(wing)f(TDISPn)g(displa)m(y)g(formats)h(are)h +(curren)m(tly)e(supp)s(orted:)418 3011 y Fe(Iw.m)142 +b(Integer)418 3124 y(Ow.m)g(Octal)47 b(integer)418 3237 +y(Zw.m)142 b(Hexadecimal)45 b(integer)418 3350 y(Fw.d)142 +b(Fixed)47 b(floating)e(point)418 3463 y(Ew.d)142 b(Exponential)45 +b(floating)h(point)418 3576 y(Dw.d)142 b(Exponential)45 +b(floating)h(point)418 3689 y(Gw.d)142 b(General;)46 +b(uses)g(Fw.d)h(if)g(significance)e(not)i(lost,)f(else)h(Ew.d)227 +3934 y Fj(where)24 b(w)h(is)e(the)i(width)e(in)g(c)m(haracters)j(of)f +(the)g(displa)m(y)m(ed)e(v)-5 b(alues,)26 b(m)e(is)g(the)g(minim)m(um)e +(n)m(um)m(b)s(er)i(of)g(digits)227 4046 y(displa)m(y)m(ed,)j(and)g(d)g +(is)g(the)g(n)m(um)m(b)s(er)g(of)g(digits)g(to)h(the)g(righ)m(t)f(of)g +(the)h(decimal.)39 b(The)27 b(.m)g(\014eld)f(is)h(optional.)95 +4302 y Fe(int)47 b(fits_read_col)e(/)i(ffgcv)286 4415 +y(\(fitsfile)f(*fptr,)g(int)h(datatype,)e(int)i(colnum,)f(long)g +(firstrow,)g(long)g(firstelem,)334 4528 y(long)h(nelements,)e(DTYPE)h +(*nulval,)g(DTYPE)g(*array,)g(int)h(*anynul,)e(int)i(*status\))95 +4753 y(int)g(fits_read_colnull)c(/)48 b(ffgcf)286 4866 +y(\(fitsfile)e(*fptr,)g(int)h(datatype,)e(int)i(colnum,)f(long)g +(firstrow,)g(long)g(firstelem,)286 4979 y(long)h(nelements,)e(DTYPE)h +(*array,)g(char)h(*nullarray,)e(int)h(*anynul,)g(int)h(*status\))0 +5269 y Fd(5.7.5)112 b(Ro)m(w)37 b(Selection)f(and)j(Calculator)d +(Routines)0 5488 y Fj(These)21 b(routines)e(all)h(parse)h(and)f(ev)-5 +b(aluate)22 b(an)e(input)f(string)h(con)m(taining)h(a)g(user)f +(de\014ned)g(arithmetic)g(expression.)0 5601 y(The)29 +b(\014rst)f(3)i(routines)e(select)i(ro)m(ws)f(in)f(a)i(FITS)e(table,)i +(based)f(on)g(whether)g(the)g(expression)f(ev)-5 b(aluates)30 +b(to)g(true)0 5714 y(\(not)e(equal)e(to)i(zero\))g(or)f(false)g +(\(zero\).)41 b(The)27 b(other)g(routines)f(ev)-5 b(aluate)28 +b(the)f(expression)f(and)g(calculate)i(a)f(v)-5 b(alue)p +eop +%%Page: 52 60 +52 59 bop 0 299 a Fj(52)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fj(for)c(eac)m(h)i(ro)m(w)f(of)g(the)g(table.)39 +b(The)26 b(allo)m(w)m(ed)h(expression)e(syn)m(tax)j(is)d(describ)s(ed)g +(in)g(the)i(ro)m(w)g(\014lter)f(section)g(in)g(the)0 +668 y(`Extended)32 b(File)f(Name)i(Syn)m(tax')g(c)m(hapter)g(of)f(this) +f(do)s(cumen)m(t.)46 b(The)32 b(expression)f(ma)m(y)i(also)f(b)s(e)f +(written)h(to)h(a)0 781 y(text)h(\014le,)g(and)f(the)h(name)f(of)h(the) +f(\014le,)h(prep)s(ended)d(with)h(a)i('@')g(c)m(haracter)h(ma)m(y)f(b)s +(e)f(supplied)d(for)j(the)h('expr')0 894 y(parameter)d(\(e.g.)42 +b('@\014lename.txt'\).)f(The)30 b(expression)f(in)g(the)h(\014le)g(can) +g(b)s(e)g(arbitrarily)d(complex)j(and)g(extend)0 1007 +y(o)m(v)m(er)35 b(m)m(ultiple)d(lines)h(of)h(the)g(\014le.)52 +b(Lines)32 b(that)j(b)s(egin)e(with)g(2)h(slash)f(c)m(haracters)j +(\('//'\))g(will)c(b)s(e)h(ignored)h(and)0 1120 y(ma)m(y)d(b)s(e)f +(used)f(to)i(add)f(commen)m(ts)h(to)h(the)e(\014le.)0 +1342 y Fi(1)81 b Fj(Ev)-5 b(aluate)37 b(a)g(b)s(o)s(olean)f(expression) +g(o)m(v)m(er)i(the)g(indicated)d(ro)m(ws,)k(returning)c(an)i(arra)m(y)h +(of)f(\015ags)g(indicating)227 1455 y(whic)m(h)29 b(ro)m(ws)i(ev)-5 +b(aluated)30 b(to)h(TR)m(UE/F)-10 b(ALSE)95 1676 y Fe(int)47 +b(fits_find_rows)d(/)k(fffrow)286 1789 y(\(fitsfile)e(*fptr,)93 +b(char)47 b(*expr,)f(long)h(firstrow,)e(long)i(nrows,)286 +1902 y(>)h(long)e(*n_good_rows,)f(char)h(*row_status,)92 +b(int)47 b(*status\))0 2124 y Fi(2)81 b Fj(Find)28 b(the)j(\014rst)f +(ro)m(w)g(whic)m(h)f(satis\014es)h(the)h(input)d(b)s(o)s(olean)h +(expression)95 2346 y Fe(int)47 b(fits_find_first_row)c(/)k(ffffrw)286 +2459 y(\(fitsfile)f(*fptr,)93 b(char)47 b(*expr,)f(>)i(long)e(*rownum,) +g(int)h(*status\))0 2681 y Fi(3)81 b Fj(Ev)-5 b(aluate)34 +b(an)g(expression)g(on)g(all)f(ro)m(ws)i(of)f(a)h(table.)53 +b(If)34 b(the)g(input)f(and)h(output)g(\014les)f(are)i(not)g(the)f +(same,)227 2794 y(cop)m(y)39 b(the)f(TR)m(UE)g(ro)m(ws)h(to)f(the)h +(output)e(\014le.)63 b(If)38 b(the)g(\014les)f(are)i(the)f(same,)j +(delete)d(the)g(F)-10 b(ALSE)38 b(ro)m(ws)227 2907 y(\(preserv)m(e)31 +b(the)g(TR)m(UE)f(ro)m(ws\).)95 3129 y Fe(int)47 b(fits_select_rows)d +(/)j(ffsrow)286 3242 y(\(fitsfile)f(*infptr,)f(fitsfile)h(*outfptr,)93 +b(char)46 b(*expr,)94 b(>)48 b(int)f(*status)e(\))0 3463 +y Fi(4)81 b Fj(Calculate)26 b(an)h(expression)e(for)i(the)f(indicated)g +(ro)m(ws)g(of)h(a)g(table,)h(returning)d(the)i(results,)f(cast)i(as)f +(datat)m(yp)s(e)227 3576 y(\(TSHOR)-8 b(T,)32 b(TDOUBLE,)h(etc\),)h(in) +d(arra)m(y)-8 b(.)48 b(If)31 b(n)m(ulv)-5 b(al==NULL,)31 +b(UNDEFs)i(will)c(b)s(e)j(zero)s(ed)g(out.)47 b(F)-8 +b(or)227 3689 y(v)m(ector)37 b(results,)e(the)g(n)m(um)m(b)s(er)e(of)i +(elemen)m(ts)h(returned)d(ma)m(y)j(b)s(e)e(less)g(than)h(nelemen)m(ts)f +(if)g(nelemen)m(ts)h(is)227 3802 y(not)d(an)g(ev)m(en)h(m)m(ultiple)c +(of)j(the)g(result)f(dimension.)42 b(Call)31 b(\014ts)p +2392 3802 28 4 v 32 w(test)p 2570 3802 V 34 w(expr)g(to)h(obtain)g(the) +g(dimensions)d(of)227 3915 y(the)i(results.)95 4137 y +Fe(int)47 b(fits_calc_rows)d(/)k(ffcrow)286 4250 y(\(fitsfile)e(*fptr,) +93 b(int)47 b(datatype,)f(char)g(*expr,)g(long)h(firstrow,)334 +4363 y(long)g(nelements,)e(void)h(*nulval,)g(>)h(void)g(*array,)94 +b(int)46 b(*anynul,)g(int)h(*status\))0 4585 y Fi(5)81 +b Fj(Ev)-5 b(aluate)32 b(an)h(expression)e(and)i(write)e(the)i(result)f +(either)g(to)i(a)f(column)e(\(if)h(the)h(expression)e(is)h(a)h +(function)227 4698 y(of)d(other)g(columns)f(in)f(the)i(table\))g(or)g +(to)g(a)h(k)m(eyw)m(ord)f(\(if)f(the)h(expression)e(ev)-5 +b(aluates)31 b(to)f(a)g(constan)m(t)i(and)227 4811 y(is)e(not)g(a)h +(function)e(of)i(other)f(columns)g(in)f(the)h(table\).)41 +b(In)30 b(the)h(former)e(case,)j(the)f(parName)f(parameter)227 +4924 y(is)39 b(the)h(name)f(of)h(the)g(column)e(\(whic)m(h)h(ma)m(y)h +(or)f(ma)m(y)h(not)g(already)f(exist\))h(in)m(to)f(whic)m(h)g(to)h +(write)f(the)227 5036 y(results,)e(and)g(parInfo)e(con)m(tains)i(an)g +(optional)e(TF)m(ORM)i(k)m(eyw)m(ord)g(v)-5 b(alue)37 +b(if)e(a)i(new)f(column)g(is)f(b)s(eing)227 5149 y(created.)42 +b(If)28 b(a)h(TF)m(ORM)h(v)-5 b(alue)28 b(is)g(not)h(sp)s(eci\014ed)f +(then)g(a)i(default)e(format)h(will)e(b)s(e)h(used,)h(dep)s(ending)d +(on)227 5262 y(the)35 b(expression.)53 b(If)34 b(the)h(expression)e(ev) +-5 b(aluates)36 b(to)f(a)g(constan)m(t,)i(then)e(the)g(result)e(will)f +(b)s(e)i(written)g(to)227 5375 y(the)28 b(k)m(eyw)m(ord)g(name)f(giv)m +(en)g(b)m(y)h(the)f(parName)h(parameter,)h(and)d(the)i(parInfo)e +(parameter)i(ma)m(y)g(b)s(e)f(used)227 5488 y(to)k(supply)d(an)i +(optional)g(commen)m(t)h(for)f(the)g(k)m(eyw)m(ord.)42 +b(If)29 b(the)i(k)m(eyw)m(ord)g(do)s(es)f(not)g(already)g(exist,)g +(then)227 5601 y(the)g(name)f(of)h(the)g(k)m(eyw)m(ord)g(m)m(ust)f(b)s +(e)g(preceded)g(with)f(a)i('#')f(c)m(haracter,)j(otherwise)d(the)g +(result)g(will)e(b)s(e)227 5714 y(written)j(to)h(a)g(column)e(with)g +(that)i(name.)p eop +%%Page: 53 61 +53 60 bop 0 299 a Fh(5.8.)72 b(UTILITY)30 b(R)m(OUTINES)2693 +b Fj(53)95 555 y Fe(int)47 b(fits_calculator)d(/)j(ffcalc)286 +668 y(\(fitsfile)f(*infptr,)f(char)i(*expr,)f(fitsfile)f(*outfptr,)h +(char)g(*parName,)334 781 y(char)h(*parInfo,)e(>)95 b(int)47 +b(*status\))0 1032 y Fi(6)81 b Fj(This)37 b(calculator)j(routine)f(is)f +(similar)f(to)j(the)g(previous)e(routine,)j(except)g(that)f(the)g +(expression)e(is)h(only)227 1145 y(ev)-5 b(aluated)41 +b(o)m(v)m(er)g(the)f(sp)s(eci\014ed)f(ro)m(w)h(ranges.)70 +b(nranges)39 b(sp)s(eci\014es)g(the)h(n)m(um)m(b)s(er)f(of)h(ro)m(w)h +(ranges,)i(and)227 1258 y(\014rstro)m(w)30 b(and)g(lastro)m(w)g(giv)m +(e)h(the)g(starting)f(and)g(ending)f(ro)m(w)h(n)m(um)m(b)s(er)f(of)i +(eac)m(h)g(range.)95 1509 y Fe(int)47 b(fits_calculator_rng)c(/)k +(ffcalc_rng)286 1622 y(\(fitsfile)f(*infptr,)f(char)i(*expr,)f +(fitsfile)f(*outfptr,)h(char)g(*parName,)334 1735 y(char)h(*parInfo,)e +(int)i(nranges,)e(long)i(*firstrow,)e(long)i(*lastrow)334 +1848 y(>)95 b(int)47 b(*status\))0 2099 y Fi(7)81 b Fj(Ev)-5 +b(aluate)30 b(the)h(giv)m(en)f(expression)f(and)h(return)f(information) +g(on)h(the)h(result.)95 2350 y Fe(int)47 b(fits_test_expr)d(/)k(fftexp) +286 2463 y(\(fitsfile)e(*fptr,)g(char)g(*expr,)g(>)i(int)f(*datatype,)e +(long)h(*nelem,)g(int)h(*naxis,)334 2575 y(long)g(*naxes,)f(int)g +(*status\))0 2908 y Ff(5.8)135 b(Utilit)l(y)47 b(Routines)0 +3161 y Fd(5.8.1)112 b(File)37 b(Chec)m(ksum)g(Routines)0 +3380 y Fj(The)c(follo)m(wing)e(routines)h(either)h(compute)g(or)h(v)-5 +b(alidate)32 b(the)i(c)m(hec)m(ksums)f(for)g(the)h(CHDU.)g(The)e(D)m(A) +-8 b(T)g(ASUM)0 3493 y(k)m(eyw)m(ord)33 b(is)e(used)g(to)i(store)f(the) +h(n)m(umerical)d(v)-5 b(alue)32 b(of)g(the)g(32-bit,)h(1's)g(complemen) +m(t)f(c)m(hec)m(ksum)h(for)f(the)g(data)0 3606 y(unit)25 +b(alone.)39 b(If)25 b(there)h(is)g(no)f(data)i(unit)e(then)g(the)h(v)-5 +b(alue)26 b(is)f(set)h(to)h(zero.)40 b(The)26 b(n)m(umerical)e(v)-5 +b(alue)26 b(is)f(stored)h(as)g(an)0 3719 y(ASCI)s(I)20 +b(string)h(of)i(digits,)f(enclosed)g(in)e(quotes,)25 +b(b)s(ecause)d(the)g(v)-5 b(alue)22 b(ma)m(y)g(b)s(e)f(to)s(o)i(large)f +(to)h(represen)m(t)f(as)g(a)h(32-bit)0 3832 y(signed)k(in)m(teger.)40 +b(The)27 b(CHECKSUM)g(k)m(eyw)m(ord)i(is)e(used)g(to)h(store)h(the)f +(ASCI)s(I)e(enco)s(ded)i(COMPLEMENT)f(of)0 3945 y(the)f(c)m(hec)m(ksum) +h(for)f(the)h(en)m(tire)f(HDU.)h(Storing)e(the)i(complemen)m(t,)g +(rather)f(than)g(the)h(actual)f(c)m(hec)m(ksum,)i(forces)0 +4058 y(the)k(c)m(hec)m(ksum)h(for)f(the)h(whole)e(HDU)i(to)g(equal)f +(zero.)47 b(If)31 b(the)i(\014le)e(has)h(b)s(een)f(mo)s(di\014ed)f +(since)i(the)g(c)m(hec)m(ksums)0 4170 y(w)m(ere)39 b(computed,)i(then)e +(the)g(HDU)g(c)m(hec)m(ksum)h(will)c(usually)g(not)j(equal)g(zero.)66 +b(These)39 b(c)m(hec)m(ksum)g(k)m(eyw)m(ord)0 4283 y(con)m(v)m(en)m +(tions)33 b(are)g(based)f(on)g(a)g(pap)s(er)f(b)m(y)h(Rob)g(Seaman)g +(published)d(in)i(the)h(pro)s(ceedings)f(of)h(the)h(AD)m(ASS)f(IV)0 +4396 y(conference)h(in)d(Baltimore)i(in)e(No)m(v)m(em)m(b)s(er)j(1994)h +(and)d(a)h(later)g(revision)e(in)g(June)h(1995.)47 b(See)32 +b(App)s(endix)d(B)j(for)0 4509 y(the)f(de\014nition)d(of)i(the)h +(parameters)f(used)g(in)f(these)i(routines.)0 4760 y +Fi(1)81 b Fj(Compute)33 b(and)g(write)g(the)h(D)m(A)-8 +b(T)g(ASUM)35 b(and)e(CHECKSUM)g(k)m(eyw)m(ord)h(v)-5 +b(alues)33 b(for)g(the)h(CHDU)g(in)m(to)g(the)227 4873 +y(curren)m(t)e(header.)46 b(If)32 b(the)g(k)m(eyw)m(ords)h(already)f +(exist,)g(their)g(v)-5 b(alues)31 b(will)f(b)s(e)h(up)s(dated)g(only)g +(if)h(necessary)227 4986 y(\(i.e.,)f(if)f(the)g(\014le)g(has)g(b)s(een) +f(mo)s(di\014ed)g(since)g(the)i(original)e(k)m(eyw)m(ord)h(v)-5 +b(alues)30 b(w)m(ere)h(computed\).)95 5237 y Fe(int)47 +b(fits_write_chksum)c(/)48 b(ffpcks)286 5350 y(\(fitsfile)e(*fptr,)g(>) +h(int)g(*status\))0 5601 y Fi(2)81 b Fj(Up)s(date)28 +b(the)h(CHECKSUM)e(k)m(eyw)m(ord)i(v)-5 b(alue)28 b(in)f(the)i(CHDU,)g +(assuming)e(that)i(the)f(D)m(A)-8 b(T)g(ASUM)30 b(k)m(eyw)m(ord)227 +5714 y(exists)35 b(and)g(already)g(has)g(the)h(correct)g(v)-5 +b(alue.)55 b(This)34 b(routine)g(calculates)i(the)g(new)f(c)m(hec)m +(ksum)h(for)f(the)p eop +%%Page: 54 62 +54 61 bop 0 299 a Fj(54)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(curren)m(t)40 b(header)g(unit,)i(adds)d(it)h(to)h(the)f(data)h +(unit)e(c)m(hec)m(ksum,)44 b(enco)s(des)c(the)g(v)-5 +b(alue)40 b(in)m(to)g(an)g(ASCI)s(I)227 668 y(string,)30 +b(and)g(writes)f(the)i(string)e(to)i(the)g(CHECKSUM)e(k)m(eyw)m(ord.)95 +897 y Fe(int)47 b(fits_update_chksum)c(/)48 b(ffupck)286 +1010 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*status\))0 1238 +y Fi(3)81 b Fj(V)-8 b(erify)34 b(the)g(CHDU)h(b)m(y)g(computing)e(the)i +(c)m(hec)m(ksums)g(and)f(comparing)g(them)g(with)f(the)i(k)m(eyw)m +(ords.)53 b(The)227 1351 y(data)34 b(unit)e(is)g(v)m(eri\014ed)g +(correctly)h(if)f(the)i(computed)f(c)m(hec)m(ksum)g(equals)g(the)g(v)-5 +b(alue)33 b(of)g(the)g(D)m(A)-8 b(T)g(ASUM)227 1464 y(k)m(eyw)m(ord.)64 +b(The)37 b(c)m(hec)m(ksum)i(for)f(the)g(en)m(tire)f(HDU)i(\(header)f +(plus)e(data)j(unit\))d(is)h(correct)i(if)e(it)h(equals)227 +1577 y(zero.)47 b(The)32 b(output)f(D)m(A)-8 b(T)g(A)m(OK)34 +b(and)d(HDUOK)i(parameters)f(in)f(this)g(routine)g(are)h(in)m(tegers)h +(whic)m(h)e(will)227 1690 y(ha)m(v)m(e)36 b(a)f(v)-5 +b(alue)34 b(=)g(1)h(if)e(the)i(data)g(or)f(HDU)h(is)f(v)m(eri\014ed)f +(correctly)-8 b(,)37 b(a)e(v)-5 b(alue)34 b(=)g(0)h(if)e(the)i(D)m(A)-8 +b(T)g(ASUM)36 b(or)227 1803 y(CHECKSUM)29 b(k)m(eyw)m(ord)g(is)g(not)g +(presen)m(t,)h(or)f(v)-5 b(alue)29 b(=)g(-1)h(if)e(the)i(computed)f(c)m +(hec)m(ksum)h(is)e(not)i(correct.)95 2144 y Fe(int)47 +b(fits_verify_chksum)c(/)48 b(ffvcks)286 2257 y(\(fitsfile)e(*fptr,)g +(>)h(int)g(*dataok,)f(int)h(*hduok,)e(int)i(*status\))0 +2486 y Fi(4)81 b Fj(Compute)40 b(and)g(return)g(the)h(c)m(hec)m(ksum)g +(v)-5 b(alues)40 b(for)h(the)g(CHDU)g(without)f(creating)h(or)g(mo)s +(difying)d(the)227 2599 y(CHECKSUM)33 b(and)h(D)m(A)-8 +b(T)g(ASUM)35 b(k)m(eyw)m(ords.)52 b(This)32 b(routine)h(is)g(used)g +(in)m(ternally)f(b)m(y)i(\013v)m(c)m(ks,)i(but)d(ma)m(y)227 +2711 y(b)s(e)d(useful)f(in)g(other)h(situations)f(as)i(w)m(ell.)95 +2940 y Fe(int)47 b(fits_get_chksum/)d(/ffgcks)286 3053 +y(\(fitsfile)i(*fptr,)g(>)h(unsigned)f(long)g(*datasum,)g(unsigned)f +(long)i(*hdusum,)334 3166 y(int)g(*status\))0 3394 y +Fi(5)81 b Fj(Enco)s(de)23 b(a)h(c)m(hec)m(ksum)g(v)-5 +b(alue)23 b(in)m(to)g(a)h(16-c)m(haracter)j(string.)37 +b(If)23 b(complm)g(is)f(non-zero)j(\(true\))f(then)f(the)h(32-bit)227 +3507 y(sum)30 b(v)-5 b(alue)30 b(will)d(b)s(e)j(complemen)m(ted)g(b)s +(efore)g(enco)s(ding.)95 3736 y Fe(int)47 b(fits_encode_chksum)c(/)48 +b(ffesum)286 3849 y(\(unsigned)e(long)g(sum,)h(int)g(complm,)f(>)h +(char)g(*ascii\);)0 4077 y Fi(6)81 b Fj(Deco)s(de)24 +b(a)f(16-c)m(haracter)j(c)m(hec)m(ksum)e(string)e(in)m(to)g(a)i +(unsigned)d(long)h(v)-5 b(alue.)38 b(If)23 b(is)f(non-zero)h(\(true\).) +39 b(then)23 b(the)227 4190 y(32-bit)32 b(sum)e(v)-5 +b(alue)31 b(will)e(b)s(e)i(complemen)m(ted)g(after)h(deco)s(ding.)43 +b(The)31 b(c)m(hec)m(ksum)h(v)-5 b(alue)31 b(is)g(also)g(returned)227 +4303 y(as)g(the)f(v)-5 b(alue)30 b(of)h(the)f(function.)95 +4532 y Fe(unsigned)46 b(long)h(fits_decode_chksum)42 +b(/)48 b(ffdsum)525 4645 y(\(char)e(*ascii,)g(int)h(complm,)f(>)h +(unsigned)f(long)h(*sum\);)0 4930 y Fd(5.8.2)112 b(Date)38 +b(and)g(Time)e(Utilit)m(y)e(Routines)0 5149 y Fj(The)29 +b(follo)m(wing)f(routines)h(help)f(to)j(construct)f(or)f(parse)h(the)g +(FITS)f(date/time)h(strings.)40 b(Starting)29 b(in)f(the)i(y)m(ear)0 +5262 y(2000,)k(the)d(FITS)g(D)m(A)-8 b(TE)32 b(k)m(eyw)m(ord)g(v)-5 +b(alues)30 b(\(and)i(the)f(v)-5 b(alues)31 b(of)g(other)h(`D)m(A)-8 +b(TE-')33 b(k)m(eyw)m(ords\))f(m)m(ust)f(ha)m(v)m(e)i(the)0 +5375 y(form)j('YYYY-MM-DD')k(\(date)e(only\))e(or)h +('YYYY-MM-DDThh:mm:ss.ddd...')61 b(\(date)38 b(and)e(time\))g(where)0 +5488 y(the)30 b(n)m(um)m(b)s(er)f(of)i(decimal)e(places)h(in)f(the)h +(seconds)g(v)-5 b(alue)30 b(is)f(optional.)40 b(These)30 +b(times)g(are)g(in)f(UTC.)h(The)g(older)0 5601 y('dd/mm/yy')d(date)g +(format)g(ma)m(y)h(not)f(b)s(e)f(used)g(for)h(dates)h(after)f(01)h(Jan) +m(uary)e(2000.)42 b(See)27 b(App)s(endix)d(B)j(for)g(the)0 +5714 y(de\014nition)h(of)j(the)f(parameters)h(used)e(in)g(these)i +(routines.)p eop +%%Page: 55 63 +55 62 bop 0 299 a Fh(5.8.)72 b(UTILITY)30 b(R)m(OUTINES)2693 +b Fj(55)0 555 y Fi(1)81 b Fj(Get)23 b(the)f(curren)m(t)f(system)i +(date.)38 b(C)22 b(already)f(pro)m(vides)g(standard)g(library)f +(routines)h(for)g(getting)i(the)f(curren)m(t)227 668 +y(date)k(and)e(time,)i(but)e(this)g(routine)g(is)g(pro)m(vided)g(for)g +(compatibilit)m(y)g(with)f(the)i(F)-8 b(ortran)26 b(FITSIO)e(library)-8 +b(.)227 781 y(The)30 b(returned)f(y)m(ear)j(has)e(4)g(digits)f(\(1999,) +k(2000,)g(etc.\))95 1026 y Fe(int)47 b(fits_get_system_date/ffgsd)o(t) +286 1139 y(\()h(>)f(int)g(*day,)g(int)f(*month,)g(int)h(*year,)f(int)h +(*status)f(\))0 1384 y Fi(2)81 b Fj(Get)34 b(the)g(curren)m(t)g(system) +f(date)i(and)e(time)g(string)g(\('YYYY-MM-DDThh:mm:ss'\).)53 +b(The)33 b(time)h(will)d(b)s(e)227 1497 y(in)25 b(UTC/GMT)h(if)f(a)m(v) +-5 b(ailable,)26 b(as)h(indicated)d(b)m(y)i(a)g(returned)f(timeref)g(v) +-5 b(alue)26 b(=)f(0.)40 b(If)26 b(the)g(returned)e(v)-5 +b(alue)227 1610 y(of)31 b(timeref)f(=)h(1)g(then)f(this)g(indicates)f +(that)j(it)e(w)m(as)h(not)g(p)s(ossible)d(to)j(con)m(v)m(ert)i(the)d +(lo)s(cal)g(time)h(to)g(UTC,)227 1722 y(and)f(th)m(us)g(the)h(lo)s(cal) +e(time)h(w)m(as)h(returned.)95 1967 y Fe(int)47 b +(fits_get_system_time/ffgst)o(m)286 2080 y(\(>)h(char)e(*datestr,)f +(int)95 b(*timeref,)45 b(int)i(*status\))0 2325 y Fi(3)81 +b Fj(Construct)26 b(a)i(date)g(string)e(from)h(the)g(input)e(date)j(v) +-5 b(alues.)39 b(If)27 b(the)g(y)m(ear)h(is)f(b)s(et)m(w)m(een)g(1900)i +(and)e(1998,)j(inclu-)227 2438 y(siv)m(e,)37 b(then)d(the)i(returned)d +(date)j(string)e(will)e(ha)m(v)m(e)37 b(the)e(old)f(FITS)g(format)i +(\('dd/mm/yy'\),)h(otherwise)227 2551 y(the)32 b(date)f(string)f(will)f +(ha)m(v)m(e)j(the)g(new)e(FITS)h(format)g(\('YYYY-MM-DD'\).)36 +b(Use)31 b(\014ts)p 3229 2551 28 4 v 33 w(time2str)g(instead)227 +2664 y(to)g(alw)m(a)m(ys)g(return)f(a)g(date)h(string)f(using)f(the)h +(new)g(FITS)g(format.)95 2909 y Fe(int)47 b(fits_date2str/ffdt2s)286 +3022 y(\(int)g(year,)f(int)h(month,)f(int)h(day,)g(>)g(char)g +(*datestr,)e(int)i(*status\))0 3267 y Fi(4)81 b Fj(Construct)34 +b(a)i(new-format)f(date)h(+)f(time)g(string)f +(\('YYYY-MM-DDThh:mm:ss.ddd...'\).)57 b(If)34 b(the)i(y)m(ear,)227 +3379 y(mon)m(th,)d(and)e(da)m(y)h(v)-5 b(alues)31 b(all)g(=)g(0)h(then) +g(only)f(the)h(time)f(is)g(enco)s(ded)g(with)g(format)h +('hh:mm:ss.ddd...'.)227 3492 y(The)j(decimals)f(parameter)i(sp)s +(eci\014es)d(ho)m(w)j(man)m(y)f(decimal)f(places)h(of)g(fractional)g +(seconds)g(to)h(include)227 3605 y(in)29 b(the)i(string.)40 +b(If)29 b(`decimals')h(is)g(negativ)m(e,)h(then)g(only)e(the)i(date)g +(will)c(b)s(e)j(return)f(\('YYYY-MM-DD'\).)95 3850 y +Fe(int)47 b(fits_time2str/fftm2s)286 3963 y(\(int)g(year,)f(int)h +(month,)f(int)h(day,)g(int)g(hour,)f(int)h(minute,)f(double)g(second,) +286 4076 y(int)h(decimals,)f(>)h(char)g(*datestr,)e(int)i(*status\))0 +4321 y Fi(5)81 b Fj(Return)44 b(the)g(date)i(as)f(read)f(from)h(the)g +(input)d(string,)48 b(where)c(the)h(string)f(ma)m(y)h(b)s(e)f(in)g +(either)g(the)h(old)227 4434 y(\('dd/mm/yy'\))29 b(or)f(new)f +(\('YYYY-MM-DDThh:mm:ss')k(or)d('YYYY-MM-DD'\))j(FITS)d(format.)40 +b(Null)227 4547 y(p)s(oin)m(ters)30 b(ma)m(y)g(b)s(e)g(supplied)d(for)j +(an)m(y)h(un)m(w)m(an)m(ted)g(output)f(date)h(parameters.)95 +4792 y Fe(int)47 b(fits_str2date/ffs2dt)286 4904 y(\(char)g(*datestr,)e +(>)i(int)g(*year,)f(int)h(*month,)f(int)h(*day,)f(int)h(*status\))0 +5149 y Fi(6)81 b Fj(Return)30 b(the)h(date)h(and)f(time)g(as)g(read)g +(from)g(the)h(input)d(string,)h(where)h(the)h(string)e(ma)m(y)i(b)s(e)e +(in)g(either)h(the)227 5262 y(old)d(or)g(new)g(FITS)g(format.)40 +b(The)28 b(returned)f(hours,)h(min)m(utes,)g(and)g(seconds)g(v)-5 +b(alues)28 b(will)d(b)s(e)j(set)h(to)g(zero)227 5375 +y(if)j(the)i(input)d(string)h(do)s(es)h(not)h(include)d(the)i(time)g +(\('dd/mm/yy')g(or)h('YYYY-MM-DD'\))j(.)c(Similarly)-8 +b(,)227 5488 y(the)36 b(returned)e(y)m(ear,)j(mon)m(th,)g(and)d(date)i +(v)-5 b(alues)35 b(will)d(b)s(e)j(set)h(to)g(zero)g(if)e(the)h(date)h +(is)e(not)i(included)c(in)227 5601 y(the)d(input)e(string)h +(\('hh:mm:ss.ddd...'\).)40 b(Null)27 b(p)s(oin)m(ters)g(ma)m(y)j(b)s(e) +e(supplied)d(for)k(an)m(y)g(un)m(w)m(an)m(ted)g(output)227 +5714 y(date)i(and)f(time)g(parameters.)p eop +%%Page: 56 64 +56 63 bop 0 299 a Fj(56)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)95 +555 y Fe(int)47 b(fits_str2time/ffs2tm)286 668 y(\(char)g(*datestr,)e +(>)i(int)g(*year,)f(int)h(*month,)f(int)h(*day,)f(int)h(*hour,)286 +781 y(int)g(*minute,)f(double)g(*second,)f(int)i(*status\))0 +1068 y Fd(5.8.3)112 b(General)38 b(Utilit)m(y)c(Routines)0 +1286 y Fj(The)c(follo)m(wing)f(utilit)m(y)f(routines)i(ma)m(y)h(b)s(e)e +(useful)g(for)h(certain)g(applications.)0 1520 y Fi(1)81 +b Fj(Return)30 b(the)h(revision)e(n)m(um)m(b)s(er)h(of)h(the)g(CFITSIO) +f(library)-8 b(.)40 b(The)31 b(revision)e(n)m(um)m(b)s(er)h(will)e(b)s +(e)i(incremen)m(ted)227 1633 y(with)f(eac)m(h)j(new)e(release)g(of)h +(CFITSIO.)95 1867 y Fe(float)47 b(fits_get_version)c(/)48 +b(ffvers)e(\()h(>)h(float)e(*version\))0 2100 y Fi(2)81 +b Fj(W)-8 b(rite)33 b(an)h(80-c)m(haracter)i(message)e(to)g(the)g +(CFITSIO)e(error)h(stac)m(k.)51 b(Application)31 b(programs)i(should)f +(not)227 2213 y(normally)d(write)g(to)j(the)e(stac)m(k,)i(but)e(there)g +(ma)m(y)h(b)s(e)f(some)h(situations)e(where)h(this)f(is)h(desirable.)95 +2447 y Fe(void)47 b(fits_write_errmsg)c(/)48 b(ffpmsg)e(\(char)g +(*err_msg\))0 2681 y Fi(3)81 b Fj(Con)m(v)m(ert)31 b(a)g(c)m(haracter)h +(string)d(to)i(upp)s(ercase)e(\(op)s(erates)j(in)d(place\).)95 +2914 y Fe(void)47 b(fits_uppercase)d(/)j(ffupch)g(\(char)f(*string\))0 +3148 y Fi(4)81 b Fj(Compare)43 b(the)i(input)d(template)i(string)f +(against)h(the)h(reference)f(string)f(to)i(see)g(if)e(they)h(matc)m(h.) +82 b(The)227 3261 y(template)35 b(string)f(ma)m(y)h(con)m(tain)f +(wildcard)e(c)m(haracters:)51 b('*')35 b(will)d(matc)m(h)j(an)m(y)g +(sequence)g(of)f(c)m(haracters)227 3374 y(\(including)26 +b(zero)k(c)m(haracters\))h(and)d('\045')i(will)c(matc)m(h)k(an)m(y)f +(single)f(c)m(haracter)j(in)c(the)j(reference)f(string.)39 +b(If)227 3487 y(casesen)25 b(=)f(CASESEN)f(=)h(TR)m(UE)h(then)e(the)i +(matc)m(h)g(will)d(b)s(e)h(case)j(sensitiv)m(e,)f(otherwise)e(the)i +(case)g(of)g(the)227 3600 y(letters)h(will)d(b)s(e)i(ignored)f(if)h +(casesen)h(=)f(CASEINSEN)f(=)h(F)-10 b(ALSE.)25 b(The)g(returned)g(MA) +-8 b(TCH)25 b(parameter)227 3713 y(will)30 b(b)s(e)h(TR)m(UE)i(if)e +(the)h(2)h(strings)e(matc)m(h,)j(and)d(EXA)m(CT)h(will)e(b)s(e)h(TR)m +(UE)i(if)e(the)h(matc)m(h)h(is)f(exact)h(\(i.e.,)227 +3826 y(if)27 b(no)h(wildcard)e(c)m(haracters)j(w)m(ere)g(used)e(in)f +(the)j(matc)m(h\).)41 b(Both)28 b(strings)f(m)m(ust)h(b)s(e)f(68)i(c)m +(haracters)h(or)e(less)227 3938 y(in)h(length.)95 4172 +y Fe(void)47 b(fits_compare_str)c(/)48 b(ffcmps)334 4285 +y(\(char)e(*templt,)g(char)h(*string,)e(int)i(casesen,)f(>)h(int)g +(*match,)f(int)h(*exact\))0 4519 y Fi(5)81 b Fj(Split)28 +b(a)k(string)e(con)m(taining)g(a)i(list)d(of)i(names)g(\(t)m(ypically)g +(\014le)f(names)h(or)g(column)e(names\))j(in)m(to)f(individual)227 +4632 y(name)23 b(tok)m(ens)g(b)m(y)g(a)g(sequence)g(of)g(calls)e(to)j +(\014ts)p 1814 4632 28 4 v 32 w(split)p 2020 4632 V 31 +w(names.)38 b(The)22 b(names)h(in)e(the)i(list)e(m)m(ust)h(b)s(e)g +(delimited)227 4745 y(b)m(y)45 b(a)f(comma)i(and/or)e(spaces.)83 +b(This)43 b(routine)g(ignores)h(spaces)h(and)f(commas)h(that)g(o)s +(ccur)f(within)227 4857 y(paren)m(theses,)36 b(brac)m(k)m(ets,)h(or)e +(curly)e(brac)m(k)m(ets.)54 b(It)35 b(also)f(strips)f(an)m(y)i(leading) +e(and)h(trailing)e(blanks)h(from)227 4970 y(the)e(returned)e(name.)227 +5116 y(This)g(routine)g(is)h(similar)d(to)k(the)g(ANSI)f(C)g('strtok')h +(function:)227 5262 y(The)37 b(\014rst)f(call)g(to)i(\014ts)p +1033 5262 V 32 w(split)p 1239 5262 V 31 w(names)f(has)g(a)g(non-n)m +(ull)d(input)h(string.)60 b(It)37 b(\014nds)e(the)i(\014rst)f(name)h +(in)f(the)227 5375 y(string)25 b(and)g(terminates)g(it)h(b)m(y)f(o)m(v) +m(erwriting)g(the)h(next)g(c)m(haracter)h(of)f(the)g(string)e(with)h(a) +h(n)m(ull)d(terminator)227 5488 y(and)31 b(returns)g(a)h(p)s(oin)m(ter) +e(to)j(the)e(name.)45 b(Eac)m(h)32 b(subsequen)m(t)f(call,)h(indicated) +e(b)m(y)h(a)h(NULL)g(v)-5 b(alue)31 b(of)h(the)227 5601 +y(input)e(string,)i(returns)f(the)h(next)h(name,)f(searc)m(hing)g(from) +g(just)g(past)g(the)g(end)f(of)i(the)f(previous)f(name.)227 +5714 y(It)g(returns)e(NULL)h(when)g(no)g(further)f(names)h(are)h +(found.)p eop +%%Page: 57 65 +57 64 bop 0 299 a Fh(5.8.)72 b(UTILITY)30 b(R)m(OUTINES)2693 +b Fj(57)143 555 y Fe(char)47 b(*fits_split_names\(char)42 +b(*namelist\))0 797 y Fj(The)30 b(follo)m(wing)f(example)h(sho)m(ws)g +(ho)m(w)g(a)h(string)e(w)m(ould)h(b)s(e)f(split)g(in)m(to)h(3)h(names:) +191 1039 y Fe(myfile[1][bin)44 b(\(x,y\)=4],)h(file2.fits)93 +b(file3.fits)191 1152 y(^^^^^^^^^^^^^^^^^^^^^^)c(^^^^^^^^^^)k +(^^^^^^^^^^)382 1264 y(1st)47 b(name)619 b(2nd)47 b(name)190 +b(3rd)47 b(name)0 1506 y Fi(6)81 b Fj(T)-8 b(est)34 b(that)g(the)g(k)m +(eyw)m(ord)g(name)f(con)m(tains)h(only)e(legal)i(c)m(haracters)h +(\(A-Z,0-9,)h(h)m(yphen,)d(and)g(underscore\))227 1619 +y(or)e(that)g(the)f(k)m(eyw)m(ord)h(record)f(con)m(tains)h(only)e +(legal)h(prin)m(table)f(ASCI)s(I)g(c)m(haracters)95 1861 +y Fe(int)47 b(fits_test_keyword)c(/)48 b(fftkey)e(\(char)g(*keyname,)g +(>)h(int)g(*status\))95 2087 y(int)g(fits_test_record)d(/)j(fftrec)f +(\(char)h(*card,)f(>)h(int)g(*status\))0 2328 y Fi(7)81 +b Fj(T)-8 b(est)25 b(whether)f(the)h(curren)m(t)f(header)h(con)m(tains) +f(an)m(y)h(NULL)g(\(ASCI)s(I)e(0\))j(c)m(haracters.)40 +b(These)24 b(c)m(haracters)j(are)227 2441 y(illegal)33 +b(in)g(the)i(header,)g(but)f(they)g(will)e(go)j(undetected)g(b)m(y)f +(most)h(of)g(the)f(CFITSIO)f(k)m(eyw)m(ord)i(header)227 +2554 y(routines,)28 b(b)s(ecause)g(the)h(n)m(ull)d(is)h(in)m(terpreted) +g(as)i(the)f(normal)f(end-of-string)h(terminator.)40 +b(This)26 b(routine)227 2667 y(returns)i(the)g(p)s(osition)f(of)i(the)g +(\014rst)f(n)m(ull)e(c)m(haracter)k(in)e(the)g(header,)h(or)g(zero)g +(if)f(there)h(are)g(no)f(n)m(ulls.)38 b(F)-8 b(or)227 +2780 y(example)36 b(a)g(returned)f(v)-5 b(alue)36 b(of)g(110)h(w)m +(ould)e(indicate)g(that)i(the)f(\014rst)f(NULL)h(is)f(lo)s(cated)h(in)f +(the)h(30th)227 2893 y(c)m(haracter)28 b(of)f(the)g(second)f(k)m(eyw)m +(ord)h(in)e(the)i(header)f(\(recall)g(that)h(eac)m(h)h(header)e(record) +h(is)e(80)i(c)m(haracters)227 3006 y(long\).)44 b(Note)33 +b(that)f(this)f(is)f(one)i(of)g(the)g(few)f(CFITSIO)f(routines)g(in)h +(whic)m(h)f(the)i(returned)e(v)-5 b(alue)31 b(is)g(not)227 +3119 y(necessarily)f(equal)f(to)j(the)e(status)h(v)-5 +b(alue\).)95 3360 y Fe(int)47 b(fits_null_check)d(/)j(ffnchk)g(\(char)f +(*card,)g(>)h(int)g(*status\))0 3602 y Fi(8)81 b Fj(P)m(arse)25 +b(a)g(header)g(k)m(eyw)m(ord)g(record)g(and)f(return)g(the)h(name)g(of) +g(the)g(k)m(eyw)m(ord,)i(and)d(the)h(length)g(of)g(the)g(name.)227 +3715 y(The)34 b(k)m(eyw)m(ord)h(name)f(normally)f(o)s(ccupies)g(the)i +(\014rst)e(8)i(c)m(haracters)g(of)g(the)f(record,)i(except)f(under)e +(the)227 3828 y(HIERAR)m(CH)e(con)m(v)m(en)m(tion)g(where)f(the)h(name) +f(can)h(b)s(e)f(up)f(to)i(70)g(c)m(haracters)h(in)d(length.)95 +4070 y Fe(int)47 b(fits_get_keyname)d(/)j(ffgknm)286 +4182 y(\(char)g(*card,)f(>)h(char)g(*keyname,)e(int)i(*keylength,)e +(int)i(*status\))0 4424 y Fi(9)81 b Fj(P)m(arse)29 b(a)h(header)f(k)m +(eyw)m(ord)h(record,)f(returning)f(the)h(v)-5 b(alue)29 +b(\(as)h(a)f(literal)f(c)m(haracter)j(string\))d(and)h(commen)m(t)227 +4537 y(strings.)39 b(If)27 b(the)g(k)m(eyw)m(ord)h(has)f(no)g(v)-5 +b(alue)27 b(\(columns)f(9-10)j(not)f(equal)e(to)i('=)g('\),)g(then)f(a) +h(n)m(ull)d(v)-5 b(alue)27 b(string)227 4650 y(is)j(returned)f(and)h +(the)g(commen)m(t)i(string)d(is)g(set)i(equal)f(to)h(column)e(9)i(-)g +(80)g(of)g(the)f(input)f(string.)95 4892 y Fe(int)47 +b(fits_parse_value)d(/)j(ffpsvc)286 5005 y(\(char)g(*card,)f(>)h(char)g +(*value,)f(char)g(*comment,)g(int)h(*status\))0 5246 +y Fi(10)f Fj(Construct)26 b(an)h(arra)m(y)g(indexed)e(k)m(eyw)m(ord)i +(name)f(\(R)m(OOT)g(+)h(nnn\).)38 b(This)25 b(routine)g(app)s(ends)g +(the)i(sequence)227 5359 y(n)m(um)m(b)s(er)i(to)i(the)g(ro)s(ot)g +(string)e(to)i(create)h(a)f(k)m(eyw)m(ord)g(name)f(\(e.g.,)i('NAXIS')f +(+)f(2)h(=)f('NAXIS2'\))95 5601 y Fe(int)47 b(fits_make_keyn)d(/)k +(ffkeyn)286 5714 y(\(char)f(*keyroot,)e(int)i(value,)f(>)h(char)g +(*keyname,)e(int)i(*status\))p eop +%%Page: 58 66 +58 65 bop 0 299 a Fj(58)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(11)46 b Fj(Construct)41 b(a)h(sequence)f(k)m(eyw)m(ord)h(name) +g(\(n)f(+)g(R)m(OOT\).)g(This)f(routine)g(concatenates)k(the)e +(sequence)227 668 y(n)m(um)m(b)s(er)20 b(to)j(the)e(fron)m(t)h(of)g +(the)f(ro)s(ot)h(string)f(to)h(create)h(a)f(k)m(eyw)m(ord)g(name)g +(\(e.g.,)j(1)d(+)f('CTYP')g(=)g('1CTYP'\))95 1045 y Fe(int)47 +b(fits_make_nkey)d(/)k(ffnkey)286 1158 y(\(int)f(value,)f(char)h +(*keyroot,)e(>)i(char)g(*keyname,)e(int)i(*status\))0 +1422 y Fi(12)f Fj(Determine)40 b(the)h(data)f(t)m(yp)s(e)h(of)f(a)h(k)m +(eyw)m(ord)f(v)-5 b(alue)40 b(string.)69 b(This)38 b(routine)i(parses)f +(the)i(k)m(eyw)m(ord)f(v)-5 b(alue)227 1535 y(string)27 +b(to)i(determine)e(its)g(data)i(t)m(yp)s(e.)40 b(Returns)27 +b('C',)h('L',)h('I',)f('F')h(or)f('X',)g(for)g(c)m(haracter)i(string,)d +(logical,)227 1648 y(in)m(teger,)k(\015oating)g(p)s(oin)m(t,)e(or)i +(complex,)f(resp)s(ectiv)m(ely)-8 b(.)95 1912 y Fe(int)47 +b(fits_get_keytype)d(/)j(ffdtyp)286 2025 y(\(char)g(*value,)f(>)h(char) +g(*dtype,)e(int)i(*status\))0 2288 y Fi(13)f Fj(Return)35 +b(the)g(class)g(of)h(an)f(input)f(header)h(record.)56 +b(The)35 b(record)g(is)f(classi\014ed)g(in)m(to)i(one)f(of)h(the)f +(follo)m(wing)227 2401 y(categories)c(\(the)f(class)f(v)-5 +b(alues)29 b(are)g(de\014ned)f(in)g(\014tsio.h\).)40 +b(Note)31 b(that)f(this)e(is)g(one)i(of)f(the)g(few)g(CFITSIO)227 +2514 y(routines)h(that)g(do)s(es)h(not)f(return)f(a)i(status)g(v)-5 +b(alue.)334 2778 y Fe(Class)94 b(Value)619 b(Keywords)95 +2891 y(TYP_STRUC_KEY)92 b(10)j(SIMPLE,)46 b(BITPIX,)g(NAXIS,)g(NAXISn,) +g(EXTEND,)g(BLOCKED,)1002 3004 y(GROUPS,)g(PCOUNT,)g(GCOUNT,)g(END)1002 +3117 y(XTENSION,)g(TFIELDS,)f(TTYPEn,)h(TBCOLn,)g(TFORMn,)g(THEAP,)1002 +3230 y(and)h(the)g(first)f(4)i(COMMENT)e(keywords)f(in)i(the)g(primary) +f(array)1002 3343 y(that)h(define)f(the)h(FITS)g(format.)95 +3456 y(TYP_CMPRS_KEY)92 b(20)j(The)47 b(experimental)e(keywords)g(used) +i(in)g(the)g(compressed)1002 3569 y(image)g(format)f(ZIMAGE,)g +(ZCMPTYPE,)f(ZNAMEn,)h(ZVALn,)1002 3681 y(ZTILEn,)g(ZBITPIX,)g +(ZNAXISn,)f(ZSCALE,)h(ZZERO,)g(ZBLANK)95 3794 y(TYP_SCAL_KEY)140 +b(30)95 b(BSCALE,)46 b(BZERO,)g(TSCALn,)g(TZEROn)95 3907 +y(TYP_NULL_KEY)140 b(40)95 b(BLANK,)46 b(TNULLn)95 4020 +y(TYP_DIM_KEY)188 b(50)95 b(TDIMn)95 4133 y(TYP_RANG_KEY)140 +b(60)95 b(TLMINn,)46 b(TLMAXn,)g(TDMINn,)g(TDMAXn,)g(DATAMIN,)f +(DATAMAX)95 4246 y(TYP_UNIT_KEY)140 b(70)95 b(BUNIT,)46 +b(TUNITn)95 4359 y(TYP_DISP_KEY)140 b(80)95 b(TDISPn)95 +4472 y(TYP_HDUID_KEY)d(90)j(EXTNAME,)46 b(EXTVER,)g(EXTLEVEL,)f +(HDUNAME,)g(HDUVER,)h(HDULEVEL)95 4585 y(TYP_CKSUM_KEY)f(100)94 +b(CHECKSUM,)46 b(DATASUM)95 4698 y(TYP_WCS_KEY)141 b(110)94 +b(CTYPEn,)46 b(CUNITn,)g(CRVALn,)g(CRPIXn,)g(CROTAn,)f(CDELTn)1002 +4811 y(CDj_is,)h(PVj_ms,)g(LONPOLEs,)f(LATPOLEs)1002 +4924 y(TCTYPn,)h(TCTYns,)g(TCUNIn,)g(TCUNns,)g(TCRVLn,)f(TCRVns,)h +(TCRPXn,)1002 5036 y(TCRPks,)g(TCDn_k,)g(TCn_ks,)g(TPVn_m,)g(TPn_ms,)f +(TCDLTn,)h(TCROTn)1002 5149 y(jCTYPn,)g(jCTYns,)g(jCUNIn,)g(jCUNns,)g +(jCRVLn,)f(jCRVns,)h(iCRPXn,)1002 5262 y(iCRPns,)g(jiCDn,)94 +b(jiCDns,)46 b(jPVn_m,)g(jPn_ms,)f(jCDLTn,)h(jCROTn)1002 +5375 y(\(i,j,m,n)g(are)h(integers,)e(s)i(is)h(any)f(letter\))95 +5488 y(TYP_REFSYS_KEY)d(120)j(EQUINOXs,)f(EPOCH,)g(MJD-OBSs,)f +(RADECSYS,)g(RADESYSs)95 5601 y(TYP_COMM_KEY)140 b(130)47 +b(COMMENT,)f(HISTORY,)f(\(blank)h(keyword\))95 5714 y(TYP_CONT_KEY)140 +b(140)47 b(CONTINUE)p eop +%%Page: 59 67 +59 66 bop 0 299 a Fh(5.8.)72 b(UTILITY)30 b(R)m(OUTINES)2693 +b Fj(59)95 555 y Fe(TYP_USER_KEY)140 b(150)47 b(all)g(other)g(keywords) +95 781 y(int)g(fits_get_keyclass)c(/)48 b(ffgkcl)e(\(char)g(*card\))0 +1034 y Fi(14)g Fj(P)m(arse)28 b(the)g('TF)m(ORM')g(binary)e(table)h +(column)g(format)g(string.)39 b(This)26 b(routine)g(parses)h(the)h +(input)e(TF)m(ORM)227 1147 y(c)m(haracter)38 b(string)c(and)h(returns)g +(the)g(in)m(teger)h(data)h(t)m(yp)s(e)f(co)s(de,)h(the)f(rep)s(eat)g +(coun)m(t)g(of)g(the)f(\014eld,)h(and,)227 1260 y(in)e(the)g(case)i(of) +f(c)m(haracter)h(string)e(\014elds,)g(the)h(length)f(of)h(the)g(unit)e +(string.)53 b(See)34 b(App)s(endix)e(B)j(for)g(the)227 +1373 y(allo)m(w)m(ed)k(v)-5 b(alues)37 b(for)i(the)f(returned)g(t)m(yp) +s(eco)s(de)h(parameter.)65 b(A)39 b(n)m(ull)d(p)s(oin)m(ter)i(ma)m(y)h +(b)s(e)f(giv)m(en)g(for)h(an)m(y)227 1486 y(output)30 +b(parameters)h(that)g(are)g(not)f(needed.)143 1739 y +Fe(int)47 b(fits_binary_tform)c(/)48 b(ffbnfm)334 1852 +y(\(char)e(*tform,)g(>)i(int)f(*typecode,)e(long)h(*repeat,)g(long)g +(*width,)382 1965 y(int)h(*status\))0 2218 y Fi(15)f +Fj(P)m(arse)38 b(the)f('TF)m(ORM')h(k)m(eyw)m(ord)g(v)-5 +b(alue)36 b(that)i(de\014nes)e(the)h(column)f(format)i(in)d(an)i(ASCI)s +(I)f(table.)61 b(This)227 2331 y(routine)28 b(parses)h(the)g(input)e +(TF)m(ORM)i(c)m(haracter)h(string)e(and)h(returns)e(the)i(data)h(t)m +(yp)s(e)f(co)s(de,)h(the)f(width)227 2443 y(of)f(the)f(column,)g(and)g +(\(if)g(it)g(is)f(a)i(\015oating)f(p)s(oin)m(t)g(column\))f(the)i(n)m +(um)m(b)s(er)e(of)h(decimal)g(places)g(to)h(the)f(righ)m(t)227 +2556 y(of)39 b(the)f(decimal)f(p)s(oin)m(t.)64 b(The)38 +b(returned)f(data)i(t)m(yp)s(e)f(co)s(des)g(are)h(the)g(same)f(as)h +(for)f(the)g(binary)f(table,)227 2669 y(with)25 b(the)i(follo)m(wing)e +(additional)f(rules:)37 b(in)m(teger)27 b(columns)e(that)i(are)f(b)s +(et)m(w)m(een)h(1)g(and)f(4)g(c)m(haracters)i(wide)227 +2782 y(are)i(de\014ned)e(to)j(b)s(e)d(short)i(in)m(tegers)f(\(co)s(de)h +(=)g(TSHOR)-8 b(T\).)29 b(Wider)f(in)m(teger)i(columns)e(are)i +(de\014ned)e(to)j(b)s(e)227 2895 y(regular)38 b(in)m(tegers)g(\(co)s +(de)h(=)f(TLONG\).)h(Similarly)-8 b(,)37 b(Fixed)h(decimal)f(p)s(oin)m +(t)g(columns)g(\(with)h(TF)m(ORM)227 3008 y(=)d('Fw.d'\))g(are)h +(de\014ned)d(to)j(b)s(e)e(single)g(precision)f(reals)i(\(co)s(de)g(=)g +(TFLO)m(A)-8 b(T\))35 b(if)f(w)h(is)f(b)s(et)m(w)m(een)h(1)h(and)227 +3121 y(7)42 b(c)m(haracters)h(wide,)g(inclusiv)m(e.)72 +b(Wider)40 b('F')i(columns)e(will)f(return)h(a)i(double)e(precision)g +(data)i(co)s(de)227 3234 y(\(=)32 b(TDOUBLE\).)h('Ew.d')f(format)g +(columns)f(will)e(ha)m(v)m(e)34 b(dataco)s(de)f(=)e(TFLO)m(A)-8 +b(T,)33 b(and)e('Dw.d')i(format)227 3347 y(columns)44 +b(will)f(ha)m(v)m(e)k(dataco)s(de)f(=)f(TDOUBLE.)g(A)h(n)m(ull)d(p)s +(oin)m(ter)i(ma)m(y)g(b)s(e)g(giv)m(en)h(for)f(an)m(y)g(output)227 +3460 y(parameters)31 b(that)g(are)g(not)f(needed.)95 +3713 y Fe(int)47 b(fits_ascii_tform)d(/)j(ffasfm)286 +3826 y(\(char)g(*tform,)f(>)h(int)g(*typecode,)e(long)i(*width,)e(int)i +(*decimals,)334 3939 y(int)g(*status\))0 4192 y Fi(16)f +Fj(Calculate)30 b(the)h(starting)f(column)g(p)s(ositions)e(and)i(total) +h(ASCI)s(I)e(table)i(width)d(based)j(on)f(the)h(input)d(arra)m(y)227 +4304 y(of)f(ASCI)s(I)e(table)h(TF)m(ORM)h(v)-5 b(alues.)39 +b(The)26 b(SP)-8 b(A)m(CE)27 b(input)d(parameter)j(de\014nes)f(ho)m(w)h +(man)m(y)f(blank)g(spaces)227 4417 y(to)40 b(lea)m(v)m(e)h(b)s(et)m(w)m +(een)f(eac)m(h)g(column)f(\(it)g(is)f(recommended)h(to)h(ha)m(v)m(e)h +(one)e(space)h(b)s(et)m(w)m(een)g(columns)e(for)227 4530 +y(b)s(etter)31 b(h)m(uman)e(readabilit)m(y\).)95 4783 +y Fe(int)47 b(fits_get_tbcol)d(/)k(ffgabc)286 4896 y(\(int)f(tfields,)f +(char)g(**tform,)g(int)h(space,)f(>)h(long)g(*rowlen,)334 +5009 y(long)g(*tbcol,)f(int)g(*status\))0 5262 y Fi(17)g +Fj(P)m(arse)27 b(a)g(template)g(header)f(record)g(and)g(return)g(a)g +(formatted)h(80-c)m(haracter)j(string)25 b(suitable)g(for)h(app)s(end-) +227 5375 y(ing)39 b(to)g(\(or)h(deleting)e(from\))h(a)g(FITS)g(header)g +(\014le.)66 b(This)37 b(routine)h(is)g(useful)g(for)g(parsing)g(lines)f +(from)227 5488 y(an)c(ASCI)s(I)f(template)h(\014le)f(and)h +(reformatting)g(them)g(in)m(to)g(legal)g(FITS)f(header)h(records.)49 +b(The)32 b(format-)227 5601 y(ted)i(string)f(ma)m(y)h(then)f(b)s(e)g +(passed)h(to)g(the)g(\014ts)p 1880 5601 28 4 v 32 w(write)p +2115 5601 V 32 w(record,)h(\013mcrd,)f(or)g(\014ts)p +3007 5601 V 32 w(delete)p 3271 5601 V 33 w(k)m(ey)h(routines)d(to)227 +5714 y(app)s(end)d(or)h(mo)s(dify)f(a)i(FITS)e(header)h(record.)p +eop +%%Page: 60 68 +60 67 bop 0 299 a Fj(60)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)95 +555 y Fe(int)47 b(fits_parse_template)c(/)k(ffgthd)286 +668 y(\(char)g(*templt,)e(>)j(char)e(*card,)g(int)h(*keytype,)f(int)h +(*status\))0 932 y Fj(The)31 b(input)f(templt)h(c)m(haracter)i(string)e +(generally)g(should)e(con)m(tain)j(3)g(tok)m(ens:)44 +b(\(1\))33 b(the)f(KEYNAME,)g(\(2\))h(the)0 1045 y(V)-10 +b(ALUE,)37 b(and)f(\(3\))i(the)f(COMMENT)g(string.)58 +b(The)37 b(TEMPLA)-8 b(TE)36 b(string)g(m)m(ust)g(adhere)h(to)h(the)e +(follo)m(wing)0 1158 y(format:)0 1421 y Fi(-)80 b Fj(The)32 +b(KEYNAME)h(tok)m(en)h(m)m(ust)f(b)s(egin)e(in)h(columns)f(1-8)j(and)e +(b)s(e)g(a)h(maxim)m(um)f(of)h(8)g(c)m(haracters)h(long.)48 +b(A)227 1534 y(legal)28 b(FITS)g(k)m(eyw)m(ord)h(name)f(ma)m(y)h(only)e +(con)m(tain)i(the)g(c)m(haracters)g(A-Z,)g(0-9,)h(and)e('-')h(\(min)m +(us)e(sign\))h(and)227 1647 y(underscore.)40 b(This)26 +b(routine)i(will)e(automatically)i(con)m(v)m(ert)i(an)m(y)f(lo)m(w)m +(ercase)h(c)m(haracters)g(to)g(upp)s(ercase)d(in)227 +1760 y(the)k(output)f(string.)41 b(If)30 b(the)h(\014rst)f(8)h(c)m +(haracters)h(of)f(the)g(template)g(line)e(are)i(blank)e(then)i(the)g +(remainder)227 1873 y(of)g(the)f(line)f(is)h(considered)f(to)i(b)s(e)f +(a)g(FITS)g(commen)m(t)h(\(with)f(a)h(blank)e(k)m(eyw)m(ord)h(name\).)0 +2137 y Fi(-)80 b Fj(The)26 b(V)-10 b(ALUE)26 b(tok)m(en)h(m)m(ust)e(b)s +(e)h(separated)g(from)f(the)i(KEYNAME)f(tok)m(en)h(b)m(y)f(one)g(or)g +(more)g(spaces)g(and/or)227 2250 y(an)g('=')g(c)m(haracter.)41 +b(The)25 b(data)h(t)m(yp)s(e)g(of)g(the)g(V)-10 b(ALUE)26 +b(tok)m(en)g(\(n)m(umeric,)g(logical,)h(or)f(c)m(haracter)h(string\))e +(is)227 2363 y(automatically)32 b(determined)e(and)i(the)g(output)f +(CARD)h(string)f(is)g(formatted)h(accordingly)-8 b(.)45 +b(The)31 b(v)-5 b(alue)227 2476 y(tok)m(en)34 b(ma)m(y)f(b)s(e)f +(forced)g(to)i(b)s(e)e(in)m(terpreted)f(as)i(a)g(string)f(\(e.g.)48 +b(if)32 b(it)g(is)f(a)i(string)f(of)g(n)m(umeric)g(digits\))f(b)m(y)227 +2588 y(enclosing)f(it)g(in)f(single)g(quotes.)0 2852 +y Fi(-)80 b Fj(The)28 b(COMMENT)g(tok)m(en)h(is)e(optional,)h(but)g(if) +f(presen)m(t)h(m)m(ust)g(b)s(e)g(separated)g(from)g(the)g(V)-10 +b(ALUE)29 b(tok)m(en)g(b)m(y)227 2965 y(at)i(least)g(one)g(blank)e +(space)i(and)e(a)i('/')g(c)m(haracter.)0 3229 y Fi(-)80 +b Fj(One)29 b(exception)g(to)g(the)g(ab)s(o)m(v)m(e)i(rules)c(is)h +(that)h(if)f(the)h(\014rst)g(non-blank)e(c)m(haracter)j(in)e(the)h +(\014rst)f(8)h(c)m(haracters)227 3342 y(of)24 b(the)h(template)f +(string)f(is)g(a)h(min)m(us)f(sign)g(\('-'\))i(follo)m(w)m(ed)f(b)m(y)g +(a)g(single)f(tok)m(en,)j(or)e(a)h(single)d(tok)m(en)j(follo)m(w)m(ed) +227 3455 y(b)m(y)k(an)g(equal)g(sign,)g(then)g(it)f(is)h(in)m +(terpreted)f(as)i(the)f(name)g(of)h(a)f(k)m(eyw)m(ord)h(whic)m(h)e(is)g +(to)i(b)s(e)e(deleted)h(from)227 3568 y(the)i(FITS)e(header.)0 +3831 y Fi(-)80 b Fj(The)32 b(second)g(exception)g(is)f(that)i(if)e(the) +h(template)g(string)f(starts)i(with)d(a)j(min)m(us)d(sign)h(and)g(is)g +(follo)m(w)m(ed)h(b)m(y)227 3944 y(2)h(tok)m(ens)g(\(without)f(an)g +(equals)g(sign)g(b)s(et)m(w)m(een)h(them\))f(then)g(the)h(second)f(tok) +m(en)i(is)d(in)m(terpreted)h(as)h(the)227 4057 y(new)f(name)h(for)f +(the)h(k)m(eyw)m(ord)g(sp)s(eci\014ed)e(b)m(y)i(\014rst)f(tok)m(en.)48 +b(In)32 b(this)f(case)j(the)f(old)f(k)m(eyw)m(ord)h(name)f(\(\014rst) +227 4170 y(tok)m(en\))c(is)d(returned)f(in)h(c)m(haracters)i(1-8)g(of)g +(the)f(returned)e(CARD)j(string,)f(and)f(the)h(new)f(k)m(eyw)m(ord)i +(name)227 4283 y(\(the)35 b(second)e(tok)m(en\))j(is)d(returned)f(in)h +(c)m(haracters)i(41-48)h(of)e(the)g(returned)e(CARD)i(string.)50 +b(These)34 b(old)227 4396 y(and)i(new)f(names)h(ma)m(y)h(then)f(b)s(e)f +(passed)g(to)i(the)f(\013mnam)g(routine)f(whic)m(h)g(will)e(c)m(hange)k +(the)f(k)m(eyw)m(ord)227 4509 y(name.)0 4773 y(The)30 +b(k)m(eyt)m(yp)s(e)h(output)f(parameter)h(indicates)e(ho)m(w)i(the)f +(returned)g(CARD)g(string)f(should)g(b)s(e)g(in)m(terpreted:)382 +5036 y Fe(keytype)857 b(interpretation)382 5149 y(-------)475 +b(-------------------------)o(----)o(---)o(----)o(----)o(---)o(----)o +(--)525 5262 y(-2)572 b(Rename)46 b(the)h(keyword)f(with)h(name)f(=)i +(the)f(first)f(8)h(characters)e(of)j(CARD)1193 5375 y(to)f(the)g(new)g +(name)g(given)f(in)h(characters)e(41)j(-)f(48)g(of)g(CARD.)525 +5601 y(-1)572 b(delete)46 b(the)h(keyword)f(with)h(this)f(name)h(from)g +(the)f(FITS)h(header.)p eop +%%Page: 61 69 +61 68 bop 0 299 a Fh(5.8.)72 b(UTILITY)30 b(R)m(OUTINES)2693 +b Fj(61)573 555 y Fe(0)572 b(append)46 b(the)h(CARD)g(string)f(to)h +(the)g(FITS)g(header)f(if)h(the)1193 668 y(keyword)f(does)h(not)g +(already)e(exist,)h(otherwise)g(update)1193 781 y(the)h(keyword)f +(value)g(and/or)g(comment)g(field)h(if)g(is)g(already)f(exists.)573 +1007 y(1)572 b(This)47 b(is)g(a)g(HISTORY)f(or)h(COMMENT)f(keyword;)g +(append)g(it)h(to)g(the)g(header)573 1233 y(2)572 b(END)47 +b(record;)f(do)h(not)g(explicitly)e(write)h(it)i(to)f(the)g(FITS)f +(file.)0 1458 y Fj(EXAMPLES:)30 b(The)g(follo)m(wing)f(lines)f +(illustrate)h(v)-5 b(alid)29 b(input)f(template)j(strings:)286 +1682 y Fe(INTVAL)46 b(7)i(/)f(This)g(is)g(an)g(integer)f(keyword)286 +1795 y(RVAL)524 b(34.6)142 b(/)239 b(This)46 b(is)i(a)f(floating)f +(point)g(keyword)286 1908 y(EVAL=-12.45E-03)92 b(/)47 +b(This)g(is)g(a)g(floating)f(point)g(keyword)g(in)h(exponential)e +(notation)286 2021 y(lval)i(F)g(/)h(This)f(is)g(a)g(boolean)f(keyword) +859 2134 y(This)h(is)g(a)g(comment)f(keyword)g(with)h(a)g(blank)f +(keyword)g(name)286 2247 y(SVAL1)h(=)g('Hello)f(world')142 +b(/)95 b(this)47 b(is)g(a)g(string)f(keyword)286 2360 +y(SVAL2)94 b('123.5')g(this)47 b(is)g(also)f(a)i(string)e(keyword)286 +2473 y(sval3)94 b(123+)h(/)g(this)47 b(is)g(also)f(a)i(string)e +(keyword)g(with)g(the)h(value)g('123+)189 b(')286 2586 +y(#)48 b(the)f(following)e(template)h(line)g(deletes)g(the)h(DATE)g +(keyword)286 2699 y(-)h(DATE)286 2812 y(#)g(the)f(following)e(template) +h(line)g(modifies)g(the)h(NAME)f(keyword)g(to)h(OBJECT)286 +2924 y(-)h(NAME)e(OBJECT)0 3149 y Fi(18)g Fj(P)m(arse)35 +b(the)g(input)e(string)h(con)m(taining)g(a)h(list)f(of)h(ro)m(ws)f(or)h +(ro)m(w)g(ranges,)h(and)e(return)g(in)m(teger)h(arra)m(ys)g(con-)227 +3262 y(taining)25 b(the)h(\014rst)f(and)g(last)h(ro)m(w)g(in)e(eac)m(h) +j(range.)40 b(F)-8 b(or)26 b(example,)h(if)d(ro)m(wlist)h(=)g("3-5,)k +(6,)e(8-9")h(then)d(it)h(will)227 3375 y(return)34 b(n)m(umranges)h(=)g +(3,)h(rangemin)e(=)h(3,)i(6,)g(8)e(and)g(rangemax)g(=)g(5,)i(6,)g(9.)55 +b(A)m(t)36 b(most,)h('maxranges')227 3488 y(n)m(um)m(b)s(er)31 +b(of)h(ranges)f(will)e(b)s(e)j(returned.)43 b('maxro)m(ws')32 +b(is)f(the)h(maxim)m(um)f(n)m(um)m(b)s(er)f(of)i(ro)m(ws)g(in)e(the)i +(table;)227 3601 y(an)m(y)e(ro)m(ws)f(or)g(ranges)g(larger)g(than)g +(this)f(will)e(b)s(e)j(ignored.)39 b(The)29 b(ro)m(ws)g(m)m(ust)g(b)s +(e)f(sp)s(eci\014ed)g(in)f(increasing)227 3714 y(order,)33 +b(and)f(the)g(ranges)h(m)m(ust)f(not)g(o)m(v)m(erlap.)47 +b(A)33 b(min)m(us)d(sign)i(ma)m(y)h(b)s(e)e(use)h(to)h(sp)s(ecify)e +(all)g(the)i(ro)m(ws)f(to)227 3827 y(the)h(upp)s(er)d(or)j(lo)m(w)m(er) +g(b)s(ound,)e(so)i("50-")h(means)e(all)g(the)h(ro)m(ws)f(from)g(50)h +(to)h(the)e(end)g(of)h(the)f(table,)i(and)227 3940 y("-")e(means)e(all) +f(the)i(ro)m(ws)f(in)f(the)i(table,)f(from)g(1)h(-)g(maxro)m(ws.)191 +4165 y Fe(int)47 b(fits_parse_range)c(/)48 b(ffrwrg\(char)c(*rowlist,)i +(long)g(maxrows,)g(int)h(maxranges,)e(>)334 4278 y(int)i(*numranges,)e +(long)h(*rangemin,)f(long)i(*rangemax,)e(int)i(*status\))0 +4503 y Fi(19)f Fj(Chec)m(k)37 b(that)g(the)g(Header)g(\014ll)e(b)m +(ytes)i(\(if)f(an)m(y\))h(are)g(all)f(blank.)58 b(These)36 +b(are)h(the)g(b)m(ytes)g(that)g(ma)m(y)h(follo)m(w)227 +4615 y(END)e(k)m(eyw)m(ord)g(and)f(b)s(efore)g(the)h(b)s(eginning)d(of) +j(data)g(unit,)f(or)h(the)g(end)f(of)g(the)h(HDU)g(if)f(there)g(is)g +(no)227 4728 y(data)c(unit.)191 4953 y Fe(int)47 b(ffchfl\(fitsfile)c +(*fptr,)k(>)g(int)g(*status\))0 5178 y Fi(20)f Fj(Chec)m(k)30 +b(that)g(the)f(Data)i(\014ll)c(b)m(ytes)j(\(if)f(an)m(y\))h(are)g(all)e +(zero)i(\(for)f(IMA)m(GE)i(or)e(BINAR)-8 b(Y)30 b(T)-8 +b(able)29 b(HDU\))i(or)e(all)227 5291 y(blanks)f(\(for)h(ASCI)s(I)f +(table)h(HDU\).)h(These)f(\014le)f(b)m(ytes)i(ma)m(y)f(b)s(e)g(lo)s +(cated)g(after)h(the)f(last)g(v)-5 b(alid)27 b(data)j(b)m(yte)227 +5404 y(in)f(the)i(HDU)g(and)f(b)s(efore)g(the)g(ph)m(ysical)f(end)h(of) +h(the)f(HDU.)191 5629 y Fe(int)47 b(ffcdfl\(fitsfile)c(*fptr,)k(>)g +(int)g(*status\))p eop +%%Page: 62 70 +62 69 bop 0 299 a Fj(62)1379 b Fh(CHAPTER)30 b(5.)71 +b(BASIC)30 b(CFITSIO)f(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)p +eop +%%Page: 63 71 +63 70 bop 0 1225 a Fg(Chapter)65 b(6)0 1687 y Fm(The)77 +b(CFITSIO)f(Iterator)i(F)-19 b(unction)0 2180 y Fj(The)41 +b(\014ts)p 325 2180 28 4 v 33 w(iterate)p 615 2180 V +33 w(data)i(function)d(in)h(CFITSIO)f(pro)m(vides)h(a)h(unique)d(metho) +s(d)j(of)g(executing)g(an)f(arbitrary)0 2293 y(user-supplied)33 +b(`w)m(ork')k(function)e(that)i(op)s(erates)g(on)g(ro)m(ws)f(of)h(data) +g(in)e(FITS)h(tables)g(or)g(on)h(pixels)d(in)i(FITS)0 +2406 y(images.)i(Rather)24 b(than)e(explicitly)f(reading)h(and)h +(writing)e(the)i(FITS)g(images)g(or)g(columns)f(of)h(data,)i(one)f +(instead)0 2518 y(calls)34 b(the)i(CFITSIO)d(iterator)j(routine,)g +(passing)e(to)i(it)f(the)g(name)g(of)h(the)f(user's)g(w)m(ork)g +(function)f(that)i(is)e(to)0 2631 y(b)s(e)c(executed)h(along)f(with)f +(a)i(list)e(of)h(all)f(the)i(table)f(columns)f(or)h(image)g(arra)m(ys)h +(that)g(are)f(to)h(b)s(e)f(passed)g(to)h(the)0 2744 y(w)m(ork)37 +b(function.)60 b(The)37 b(CFITSIO)e(iterator)j(function)e(then)h(do)s +(es)g(all)f(the)h(w)m(ork)g(of)h(allo)s(cating)e(memory)h(for)0 +2857 y(the)28 b(arra)m(ys,)h(reading)e(the)h(input)d(data)k(from)e(the) +h(FITS)f(\014le,)g(passing)g(them)h(to)g(the)g(w)m(ork)g(function,)f +(and)g(then)0 2970 y(writing)34 b(an)m(y)j(output)f(data)h(bac)m(k)h +(to)f(the)f(FITS)g(\014le)f(after)i(the)g(w)m(ork)g(function)e(exits.) +58 b(Because)38 b(it)e(is)g(often)0 3083 y(more)h(e\016cien)m(t)h(to)g +(pro)s(cess)f(only)f(a)i(subset)f(of)g(the)g(total)h(table)g(ro)m(ws)f +(at)h(one)f(time,)i(the)f(iterator)f(function)0 3196 +y(can)f(determine)f(the)i(optim)m(um)e(amoun)m(t)h(of)g(data)h(to)g +(pass)e(in)g(eac)m(h)i(iteration)f(and)f(rep)s(eatly)g(call)h(the)g(w)m +(ork)0 3309 y(function)29 b(un)m(til)g(the)h(en)m(tire)h(table)f(b)s +(een)f(pro)s(cessed.)0 3469 y(F)-8 b(or)37 b(man)m(y)f(applications)e +(this)g(single)h(CFITSIO)f(iterator)j(function)d(can)i(e\013ectiv)m +(ely)h(replace)f(all)f(the)h(other)0 3582 y(CFITSIO)g(routines)h(for)g +(reading)g(or)g(writing)f(data)i(in)e(FITS)h(images)h(or)f(tables.)63 +b(Using)36 b(the)i(iterator)g(has)0 3695 y(sev)m(eral)31 +b(imp)s(ortan)m(t)e(adv)-5 b(an)m(tages)32 b(o)m(v)m(er)g(the)f +(traditional)d(metho)s(d)i(of)h(reading)e(and)h(writing)e(FITS)i(data)h +(\014les:)136 3961 y Fc(\017)46 b Fj(It)33 b(cleanly)f(separates)i(the) +f(data)h(I/O)f(from)f(the)h(routine)f(that)i(op)s(erates)f(on)g(the)g +(data.)49 b(This)31 b(leads)h(to)227 4074 y(a)f(more)g(mo)s(dular)d +(and)i(`ob)5 b(ject)31 b(orien)m(ted')g(programming)e(st)m(yle.)136 +4268 y Fc(\017)46 b Fj(It)27 b(simpli\014es)c(the)k(application)e +(program)i(b)m(y)f(eliminating)e(the)j(need)g(to)g(allo)s(cate)g +(memory)g(for)f(the)h(data)227 4381 y(arra)m(ys)e(and)f(eliminates)f +(most)h(of)h(the)f(calls)g(to)h(the)g(CFITSIO)d(routines)i(that)h +(explicitly)d(read)i(and)g(write)227 4494 y(the)31 b(data.)136 +4689 y Fc(\017)46 b Fj(It)32 b(ensures)e(that)i(the)g(data)g(are)g(pro) +s(cessed)f(as)h(e\016cien)m(tly)f(as)g(p)s(ossible.)42 +b(This)30 b(is)g(esp)s(ecially)g(imp)s(ortan)m(t)227 +4801 y(when)44 b(pro)s(cessing)f(tabular)h(data)i(since)e(the)h +(iterator)g(function)e(will)f(calculate)j(the)g(most)g(e\016cien)m(t) +227 4914 y(n)m(um)m(b)s(er)36 b(of)i(ro)m(ws)g(in)e(the)i(table)f(to)h +(b)s(e)f(passed)g(at)i(one)e(time)h(to)g(the)g(user's)e(w)m(ork)i +(function)e(on)i(eac)m(h)227 5027 y(iteration.)136 5222 +y Fc(\017)46 b Fj(Mak)m(es)39 b(it)d(p)s(ossible)f(for)i(larger)g(pro)5 +b(jects)37 b(to)h(dev)m(elop)f(a)h(library)c(of)k(w)m(ork)f(functions)f +(that)h(all)f(ha)m(v)m(e)j(a)227 5335 y(uniform)28 b(calling)h +(sequence)i(and)f(are)h(all)e(indep)s(enden)m(t)f(of)j(the)f(details)g +(of)g(the)h(FITS)e(\014le)h(format.)0 5601 y(There)g(are)h(basically)e +(2)j(steps)e(in)g(using)f(the)i(CFITSIO)e(iterator)i(function.)41 +b(The)30 b(\014rst)g(step)h(is)f(to)h(design)f(the)0 +5714 y(w)m(ork)c(function)e(itself)g(whic)m(h)g(m)m(ust)i(ha)m(v)m(e)g +(a)g(prescrib)s(ed)d(set)j(of)g(input)e(parameters.)39 +b(One)25 b(of)h(these)g(parameters)1905 5942 y(63)p eop +%%Page: 64 72 +64 71 bop 0 299 a Fj(64)1455 b Fh(CHAPTER)30 b(6.)112 +b(THE)30 b(CFITSIO)e(ITERA)-8 b(TOR)30 b(FUNCTION)0 555 +y Fj(is)e(a)h(structure)g(con)m(taining)g(p)s(oin)m(ters)e(to)j(the)f +(arra)m(ys)h(of)f(data;)h(the)f(w)m(ork)h(function)d(can)j(p)s(erform)d +(an)m(y)i(desired)0 668 y(op)s(erations)j(on)i(these)f(arra)m(ys)h(and) +e(do)s(es)h(not)g(need)g(to)h(w)m(orry)f(ab)s(out)g(ho)m(w)g(the)h +(input)d(data)j(w)m(ere)f(read)g(from)0 781 y(the)e(\014le)e(or)h(ho)m +(w)h(the)f(output)g(data)h(get)h(written)d(bac)m(k)i(to)h(the)e +(\014le.)0 941 y(The)24 b(second)h(step)g(is)e(to)j(design)d(the)i +(driv)m(er)f(routine)f(that)j(op)s(ens)e(all)f(the)i(necessary)g(FITS)f +(\014les)g(and)g(initializes)0 1054 y(the)41 b(input)f(parameters)h(to) +h(the)g(iterator)f(function.)72 b(The)41 b(driv)m(er)f(program)h(calls) +f(the)i(CFITSIO)e(iterator)0 1167 y(function)29 b(whic)m(h)g(then)h +(reads)g(the)h(data)g(and)f(passes)g(it)g(to)h(the)g(user's)e(w)m(ork)i +(function.)0 1327 y(The)20 b(follo)m(wing)f(2)i(sections)f(describ)s(e) +f(these)i(steps)g(in)e(more)h(detail.)37 b(There)20 b(are)h(also)f(sev) +m(eral)h(example)f(programs)0 1440 y(included)28 b(with)h(the)h +(CFITSIO)f(distribution)e(whic)m(h)i(illustrate)g(ho)m(w)h(to)h(use)f +(the)h(iterator)f(function.)0 1789 y Ff(6.1)135 b(The)45 +b(Iterator)h(W)-11 b(ork)45 b(F)-11 b(unction)0 2043 +y Fj(The)42 b(user-supplied)d(iterator)k(w)m(ork)g(function)e(m)m(ust)h +(ha)m(v)m(e)i(the)f(follo)m(wing)e(set)i(of)g(input)d(parameters)j +(\(the)0 2156 y(function)29 b(can)i(b)s(e)e(giv)m(en)i(an)m(y)g +(desired)d(name\):)95 2429 y Fe(int)47 b(user_fn\()f(long)h(totaln,)e +(long)i(offset,)f(long)g(firstn,)g(long)h(nvalues,)716 +2542 y(int)g(narrays,)e(iteratorCol)g(*data,)94 b(void)47 +b(*userPointer)d(\))136 2815 y Fc(\017)i Fj(totaln)23 +b({)g(the)f(total)i(n)m(um)m(b)s(er)d(of)h(table)h(ro)m(ws)f(or)g +(image)h(pixels)e(that)i(will)c(b)s(e)j(passed)g(to)h(the)g(w)m(ork)f +(function)227 2928 y(during)28 b(1)j(or)g(more)f(iterations.)136 +3129 y Fc(\017)46 b Fj(o\013set)d({)f(the)h(o\013set)f(applied)e(to)j +(the)f(\014rst)f(table)h(ro)m(w)g(or)g(image)g(pixel)e(to)j(b)s(e)e +(passed)g(to)i(the)f(w)m(ork)227 3241 y(function.)54 +b(In)34 b(other)i(w)m(ords,)g(this)e(is)g(the)h(n)m(um)m(b)s(er)f(of)h +(ro)m(ws)h(or)f(pixels)e(that)j(are)f(skipp)s(ed)e(o)m(v)m(er)j(b)s +(efore)227 3354 y(starting)29 b(the)h(iterations.)40 +b(If)28 b(o\013set)j(=)e(0,)h(then)f(all)f(the)h(table)h(ro)m(ws)f(or)g +(image)h(pixels)d(will)g(b)s(e)h(passed)h(to)227 3467 +y(the)i(w)m(ork)f(function.)136 3668 y Fc(\017)46 b Fj(\014rstn)26 +b({)i(the)f(n)m(um)m(b)s(er)f(of)i(the)f(\014rst)g(table)g(ro)m(w)g(or) +g(image)h(pixel)d(\(starting)j(with)e(1\))i(that)f(is)g(b)s(eing)e +(passed)227 3781 y(in)k(this)h(particular)e(call)i(to)h(the)g(w)m(ork)f +(function.)136 3982 y Fc(\017)46 b Fj(n)m(v)-5 b(alues)34 +b({)h(the)f(n)m(um)m(b)s(er)g(of)g(table)g(ro)m(ws)h(or)f(image)h +(pixels)d(that)j(are)g(b)s(eing)e(passed)h(in)f(this)h(particular)227 +4095 y(call)g(to)i(the)f(w)m(ork)f(function.)53 b(n)m(v)-5 +b(alues)34 b(will)e(alw)m(a)m(ys)j(b)s(e)f(less)g(than)g(or)h(equal)f +(to)i(totaln)f(and)f(will)e(ha)m(v)m(e)227 4208 y(the)i(same)f(v)-5 +b(alue)33 b(on)g(eac)m(h)h(iteration,)g(except)g(p)s(ossibly)d(on)i +(the)g(last)g(call)g(whic)m(h)f(ma)m(y)h(ha)m(v)m(e)i(a)e(smaller)227 +4321 y(v)-5 b(alue.)136 4522 y Fc(\017)46 b Fj(narra)m(ys)31 +b({)g(the)g(n)m(um)m(b)s(er)f(of)h(arra)m(ys)g(of)g(data)h(that)f(are)g +(b)s(eing)f(passed)g(to)i(the)f(w)m(ork)g(function.)41 +b(There)30 b(is)227 4635 y(one)h(arra)m(y)g(for)f(eac)m(h)i(image)e(or) +g(table)h(column.)136 4835 y Fc(\017)46 b Fj(*data)31 +b({)e(arra)m(y)h(of)f(structures,)g(one)h(for)f(eac)m(h)h(column)e(or)h +(image.)41 b(Eac)m(h)29 b(structure)g(con)m(tains)g(a)h(p)s(oin)m(ter) +227 4948 y(to)h(the)g(arra)m(y)g(of)f(data)h(as)g(w)m(ell)e(as)i(other) +g(descriptiv)m(e)e(parameters)i(ab)s(out)f(that)h(arra)m(y)-8 +b(.)136 5149 y Fc(\017)46 b Fj(*userP)m(oin)m(ter)25 +b({)h(a)f(user)f(supplied)e(p)s(oin)m(ter)i(that)i(can)f(b)s(e)f(used)h +(to)g(pass)g(ancillary)e(information)g(from)i(the)227 +5262 y(driv)m(er)g(function)g(to)h(the)g(w)m(ork)g(function.)38 +b(This)24 b(p)s(oin)m(ter)h(is)g(passed)h(to)g(the)h(CFITSIO)d +(iterator)i(function)227 5375 y(whic)m(h)36 b(then)g(passes)g(it)g(on)h +(to)g(the)f(w)m(ork)h(function)e(without)h(an)m(y)h(mo)s(di\014cation.) +57 b(It)37 b(ma)m(y)g(p)s(oin)m(t)e(to)j(a)227 5488 y(single)27 +b(n)m(um)m(b)s(er,)h(to)h(an)f(arra)m(y)h(of)g(v)-5 b(alues,)28 +b(to)h(a)g(structure)f(con)m(taining)g(an)g(arbitrary)f(set)i(of)g +(parameters)227 5601 y(of)e(di\013eren)m(t)g(t)m(yp)s(es,)h(or)f(it)g +(ma)m(y)g(b)s(e)g(a)g(n)m(ull)e(p)s(oin)m(ter)h(if)g(it)h(is)f(not)h +(needed.)40 b(The)26 b(w)m(ork)h(function)f(m)m(ust)h(cast)227 +5714 y(this)j(p)s(oin)m(ter)f(to)i(the)g(appropriate)e(data)i(t)m(yp)s +(e)g(b)s(efore)f(using)e(it)i(it.)p eop +%%Page: 65 73 +65 72 bop 0 299 a Fh(6.1.)72 b(THE)30 b(ITERA)-8 b(TOR)30 +b(W)m(ORK)g(FUNCTION)2021 b Fj(65)0 555 y(The)23 b(totaln,)j(o\013set,) +h(narra)m(ys,)e(data,)h(and)d(userP)m(oin)m(ter)h(parameters)g(are)g +(guaran)m(teed)h(to)g(ha)m(v)m(e)g(the)f(same)g(v)-5 +b(alue)0 668 y(on)35 b(eac)m(h)i(iteration.)55 b(Only)33 +b(\014rstn,)j(n)m(v)-5 b(alues,)36 b(and)e(the)i(arra)m(ys)f(of)h(data) +g(p)s(oin)m(ted)e(to)i(b)m(y)f(the)h(data)g(structures)0 +781 y(ma)m(y)31 b(c)m(hange)g(on)g(eac)m(h)g(iterativ)m(e)g(call)f(to)h +(the)f(w)m(ork)h(function.)0 941 y(Note)43 b(that)g(the)f(iterator)g +(treats)h(an)f(image)g(as)g(a)g(long)g(1-D)h(arra)m(y)f(of)h(pixels)d +(regardless)h(of)h(it's)g(in)m(trinsic)0 1054 y(dimensionalit)m(y)-8 +b(.)48 b(The)33 b(total)i(n)m(um)m(b)s(er)d(of)i(pixels)e(is)h(just)g +(the)h(pro)s(duct)e(of)i(the)g(size)g(of)f(eac)m(h)i(dimension,)e(and)0 +1167 y(the)g(order)g(of)g(the)g(pixels)e(is)h(the)h(same)g(as)g(the)h +(order)e(that)h(they)h(are)f(stored)g(in)f(the)h(FITS)f(\014le.)47 +b(If)33 b(the)g(w)m(ork)0 1280 y(function)26 b(needs)h(to)h(kno)m(w)f +(the)h(n)m(um)m(b)s(er)e(and)h(size)g(of)h(the)f(image)h(dimensions)c +(then)j(these)h(parameters)g(can)g(b)s(e)0 1393 y(passed)i(via)g(the)g +(userP)m(oin)m(ter)h(structure.)0 1553 y(The)f(iteratorCol)g(structure) +g(is)f(curren)m(tly)h(de\014ned)f(as)h(follo)m(ws:)0 +1780 y Fe(typedef)46 b(struct)94 b(/*)47 b(structure)e(for)i(the)g +(iterator)e(function)h(column)g(information)f(*/)0 1893 +y({)143 2005 y(/*)i(structure)f(elements)f(required)h(as)h(input)f(to)h +(fits_iterate_data:)c(*/)95 2231 y(fitsfile)j(*fptr;)332 +b(/*)48 b(pointer)d(to)j(the)f(HDU)f(containing)f(the)i(column)f(or)i +(image)e(*/)95 2344 y(int)286 b(colnum;)e(/*)48 b(column)e(number)g(in) +h(the)g(table;)f(ignored)g(for)h(images)189 b(*/)95 2457 +y(char)238 b(colname[70];)44 b(/*)k(name)e(\(TTYPEn\))g(of)h(the)g +(column;)f(null)g(for)h(images)285 b(*/)95 2570 y(int)h(datatype;)188 +b(/*)48 b(output)e(data)g(type)h(\(converted)e(if)i(necessary\))e(*/)95 +2683 y(int)286 b(iotype;)e(/*)48 b(type:)e(InputCol,)f(InputOutputCol,) +f(or)j(OutputCol)e(*/)95 2909 y(/*)j(output)e(structure)f(elements)h +(that)g(may)h(be)g(useful)f(for)h(the)g(work)g(function:)e(*/)95 +3135 y(void)238 b(*array;)189 b(/*)47 b(pointer)f(to)h(the)g(array)f +(\(and)h(the)g(null)g(value\))f(*/)95 3247 y(long)238 +b(repeat;)189 b(/*)47 b(binary)f(table)h(vector)f(repeat)g(value;)g +(set)238 b(*/)1050 3360 y(/*)g(equal)46 b(to)i(1)f(for)g(images)810 +b(*/)95 3473 y(long)238 b(tlmin;)f(/*)47 b(legal)g(minimum)e(data)i +(value,)f(if)h(any)477 b(*/)95 3586 y(long)238 b(tlmax;)f(/*)47 +b(legal)g(maximum)e(data)i(value,)f(if)h(any)477 b(*/)95 +3699 y(char)238 b(unit[70];)93 b(/*)47 b(physical)f(unit)g(string)g +(\(BUNIT)h(or)g(TUNITn\))189 b(*/)95 3812 y(char)238 +b(tdisp[70];)45 b(/*)i(suggested)e(display)h(format;)g(null)h(if)g +(none)190 b(*/)0 4038 y(})47 b(iteratorCol;)0 4264 y +Fj(Instead)34 b(of)g(directly)e(reading)h(or)h(writing)e(the)h(elemen)m +(ts)i(in)d(this)h(structure,)h(it)g(is)e(recommended)i(that)g(pro-)0 +4377 y(grammers)c(use)g(the)h(access)h(functions)c(that)j(are)g(pro)m +(vided)e(for)h(this)g(purp)s(ose.)0 4538 y(The)25 b(\014rst)g(\014v)m +(e)h(elemen)m(ts)g(in)f(this)f(structure)i(m)m(ust)f(b)s(e)g(initially) +e(de\014ned)h(b)m(y)i(the)g(driv)m(er)e(routine)h(b)s(efore)g(calling)0 +4650 y(the)f(iterator)g(routine.)37 b(The)23 b(CFITSIO)f(iterator)i +(routine)f(uses)g(this)f(information)g(to)i(determine)f(what)g(column)0 +4763 y(or)32 b(arra)m(y)h(to)h(pass)e(to)h(the)g(w)m(ork)f(function,)g +(and)g(whether)g(the)g(arra)m(y)h(is)f(to)h(b)s(e)f(input)f(to)i(the)f +(w)m(ork)h(function,)0 4876 y(output)g(from)g(the)h(w)m(ork)f +(function,)g(or)h(b)s(oth.)49 b(The)33 b(CFITSIO)f(iterator)h(function) +f(\014lls)g(in)g(the)h(v)-5 b(alues)33 b(of)h(the)0 4989 +y(remaining)28 b(structure)i(elemen)m(ts)h(b)s(efore)f(passing)f(it)h +(to)h(the)g(w)m(ork)f(function.)0 5149 y(The)d(arra)m(y)g(structure)g +(elemen)m(t)h(is)e(a)h(p)s(oin)m(ter)f(to)i(the)g(actual)f(data)h(arra) +m(y)g(and)e(it)h(m)m(ust)g(b)s(e)f(cast)j(to)e(the)h(correct)0 +5262 y(data)k(t)m(yp)s(e)f(b)s(efore)f(it)h(is)f(used.)41 +b(The)31 b(`rep)s(eat')g(structure)g(elemen)m(t)g(giv)m(e)g(the)h(n)m +(um)m(b)s(er)d(of)i(data)h(v)-5 b(alues)30 b(in)g(eac)m(h)0 +5375 y(ro)m(w)g(of)g(the)g(table,)h(so)f(that)h(the)f(total)h(n)m(um)m +(b)s(er)d(of)i(data)h(v)-5 b(alues)29 b(in)g(the)h(arra)m(y)h(is)e(giv) +m(en)h(b)m(y)g(rep)s(eat)g(*)g(n)m(v)-5 b(alues.)0 5488 +y(In)36 b(the)g(case)i(of)e(image)h(arra)m(ys)g(and)e(ASCI)s(I)g +(tables,)j(rep)s(eat)f(will)d(alw)m(a)m(ys)i(b)s(e)g(equal)g(to)h(1.)59 +b(When)37 b(the)f(data)0 5601 y(t)m(yp)s(e)k(is)e(a)i(c)m(haracter)h +(string,)g(the)f(arra)m(y)g(p)s(oin)m(ter)e(is)h(actually)g(a)h(p)s +(oin)m(ter)e(to)j(an)e(arra)m(y)h(of)g(string)e(p)s(oin)m(ters)0 +5714 y(\(i.e.,)30 b(c)m(har)f(**arra)m(y\).)42 b(The)29 +b(other)g(output)g(structure)f(elemen)m(ts)i(are)f(pro)m(vided)f(for)g +(con)m(v)m(enience)j(in)c(case)j(that)p eop +%%Page: 66 74 +66 73 bop 0 299 a Fj(66)1455 b Fh(CHAPTER)30 b(6.)112 +b(THE)30 b(CFITSIO)e(ITERA)-8 b(TOR)30 b(FUNCTION)0 555 +y Fj(information)k(is)h(needed)g(within)e(the)j(w)m(ork)g(function.)55 +b(An)m(y)35 b(other)h(information)e(ma)m(y)i(b)s(e)f(passed)h(from)f +(the)0 668 y(driv)m(er)29 b(routine)h(to)h(the)f(w)m(ork)h(function)e +(via)h(the)g(userP)m(oin)m(ter)g(parameter.)0 828 y(Up)s(on)h +(completion,)h(the)g(w)m(ork)h(routine)e(m)m(ust)h(return)f(an)h(in)m +(teger)g(status)g(v)-5 b(alue,)33 b(with)d(0)j(indicating)d(success)0 +941 y(and)h(an)m(y)g(other)g(v)-5 b(alue)31 b(indicating)e(an)i(error)g +(whic)m(h)f(will)e(cause)k(the)f(iterator)h(function)e(to)i +(immediately)d(exit)0 1054 y(at)e(that)f(p)s(oin)m(t.)38 +b(Return)25 b(status)i(v)-5 b(alues)25 b(in)f(the)i(range)h(1)f({)g +(1000)i(should)23 b(b)s(e)j(a)m(v)m(oided)g(since)f(these)i(are)f +(reserv)m(ed)0 1167 y(for)d(use)g(b)m(y)h(CFITSIO.)e(A)i(return)e +(status)i(v)-5 b(alue)23 b(of)h(-1)g(ma)m(y)g(b)s(e)f(used)f(to)j +(force)f(the)f(CFITSIO)f(iterator)i(function)0 1280 y(to)j(stop)g(at)g +(that)h(p)s(oin)m(t)d(and)h(return)g(con)m(trol)h(to)g(the)g(driv)m(er) +e(routine)h(after)h(writing)d(an)m(y)j(output)f(arra)m(ys)h(to)h(the)0 +1393 y(FITS)e(\014le.)39 b(CFITSIO)26 b(do)s(es)g(not)i(considered)e +(this)g(to)i(b)s(e)e(an)h(error)g(condition,)g(so)g(an)m(y)g(further)f +(pro)s(cessing)g(b)m(y)0 1506 y(the)31 b(application)d(program)i(will)e +(con)m(tin)m(ue)j(normally)-8 b(.)0 1837 y Ff(6.2)135 +b(The)45 b(Iterator)h(Driv)l(er)g(F)-11 b(unction)0 2087 +y Fj(The)33 b(iterator)g(driv)m(er)f(function)g(m)m(ust)i(op)s(en)e +(the)i(necessary)f(FITS)g(\014les)f(and)h(p)s(osition)e(them)i(to)h +(the)g(correct)0 2200 y(HDU.)23 b(It)f(m)m(ust)g(also)h(initialize)c +(the)j(follo)m(wing)f(parameters)h(in)f(the)i(iteratorCol)f(structure)f +(\(de\014ned)g(ab)s(o)m(v)m(e\))j(for)0 2313 y(eac)m(h)31 +b(column)e(or)h(image)g(b)s(efore)f(calling)g(the)h(CFITSIO)e(iterator) +i(function.)39 b(Sev)m(eral)30 b(`constructor')h(routines)0 +2426 y(are)g(pro)m(vided)e(in)g(CFITSIO)g(for)h(this)f(purp)s(ose.)136 +2670 y Fc(\017)46 b Fj(*fptr)30 b({)h(The)f(\014ts\014le)f(p)s(oin)m +(ter)g(to)j(the)e(table)g(or)h(image.)136 2853 y Fc(\017)46 +b Fj(coln)m(um)29 b({)g(the)h(n)m(um)m(b)s(er)e(of)h(the)h(column)e(in) +g(the)h(table.)41 b(This)27 b(v)-5 b(alue)29 b(is)f(ignored)g(in)g(the) +i(case)g(of)g(images.)227 2966 y(If)j(coln)m(um)g(equals)g(0,)h(then)g +(the)f(column)f(name)i(will)c(b)s(e)j(used)g(to)h(iden)m(tify)e(the)h +(column)g(to)h(b)s(e)e(passed)227 3079 y(to)f(the)g(w)m(ork)f +(function.)136 3261 y Fc(\017)46 b Fj(colname)31 b({)f(the)g(name)h +(\(TTYPEn)e(k)m(eyw)m(ord\))i(of)f(the)h(column.)39 b(This)28 +b(is)i(only)f(required)f(if)h(coln)m(um)h(=)g(0)227 3374 +y(and)g(is)f(ignored)h(for)g(images.)136 3556 y Fc(\017)46 +b Fj(datat)m(yp)s(e)29 b({)g(The)e(desired)g(data)h(t)m(yp)s(e)g(of)h +(the)f(arra)m(y)g(to)h(b)s(e)e(passed)h(to)h(the)f(w)m(ork)g(function.) +39 b(F)-8 b(or)28 b(n)m(umer-)227 3669 y(ical)f(data)h(the)f(data)h(t)m +(yp)s(e)g(do)s(es)f(not)g(need)g(to)h(b)s(e)f(the)g(same)h(as)f(the)h +(actual)f(data)h(t)m(yp)s(e)g(in)e(the)h(FITS)g(\014le,)227 +3782 y(in)g(whic)m(h)h(case)h(CFITSIO)e(will)f(do)j(the)f(con)m(v)m +(ersion.)41 b(Allo)m(w)m(ed)28 b(v)-5 b(alues)28 b(are:)40 +b(TSTRING,)28 b(TLOGICAL,)227 3895 y(TBYTE,)37 b(TSBYTE,)f(TSHOR)-8 +b(T,)36 b(TUSHOR)-8 b(T,)37 b(TINT,)f(TLONG,)h(TULONG,)f(TFLO)m(A)-8 +b(T,)38 b(TDOU-)227 4008 y(BLE.)33 b(If)g(the)g(input)e(v)-5 +b(alue)32 b(of)h(data)h(t)m(yp)s(e)f(equals)f(0,)j(then)d(the)h +(existing)f(data)i(t)m(yp)s(e)f(of)g(the)g(column)f(or)227 +4121 y(image)f(will)d(b)s(e)h(used)h(without)f(an)m(y)i(con)m(v)m +(ersion.)136 4303 y Fc(\017)46 b Fj(iot)m(yp)s(e)36 b({)g(de\014nes)e +(whether)h(the)h(data)g(arra)m(y)g(is)f(to)h(b)s(e)f(input)f(to)i(the)g +(w)m(ork)f(function)g(\(i.e,)i(read)e(from)227 4416 y(the)42 +b(FITS)e(\014le\),)j(or)e(output)g(from)g(the)g(w)m(ork)g(function)f +(\(i.e.,)k(written)c(to)i(the)f(FITS)g(\014le\))f(or)h(b)s(oth.)227 +4529 y(Allo)m(w)m(ed)28 b(v)-5 b(alues)28 b(are)g(InputCol,)f +(OutputCol,)h(or)g(InputOutputCol.)37 b(V)-8 b(ariable-length)27 +b(arra)m(y)i(columns)227 4642 y(are)h(supp)s(orted)e(as)i(InputCol)d +(or)j(InputOutputCol)c(t)m(yp)s(es,)k(but)f(ma)m(y)h(not)g(b)s(e)e +(used)h(for)g(an)h(OutputCol)227 4755 y(t)m(yp)s(e.)0 +4999 y(After)h(the)f(driv)m(er)f(routine)g(has)h(initialized)e(all)h +(these)h(parameters,)h(it)f(can)h(then)f(call)f(the)i(CFITSIO)e +(iterator)0 5112 y(function:)95 5357 y Fe(int)47 b +(fits_iterate_data\(int)42 b(narrays,)k(iteratorCol)f(*data,)h(long)g +(offset,)286 5470 y(long)h(nPerLoop,)e(int)i(\(*workFn\)\()e(\),)i +(void)g(*userPointer,)d(int)j(*status\);)136 5714 y Fc(\017)f +Fj(narra)m(ys)31 b({)f(the)h(n)m(um)m(b)s(er)e(of)h(columns)f(or)i +(images)f(that)h(are)g(to)g(b)s(e)f(passed)g(to)h(the)f(w)m(ork)h +(function.)p eop +%%Page: 67 75 +67 74 bop 0 299 a Fh(6.3.)72 b(GUIDELINES)30 b(F)m(OR)h(USING)f(THE)g +(ITERA)-8 b(TOR)30 b(FUNCTION)1200 b Fj(67)136 555 y +Fc(\017)46 b Fj(*data)32 b({)f(p)s(oin)m(ter)e(to)i(arra)m(y)g(of)f +(structures)g(con)m(taining)g(information)f(ab)s(out)h(eac)m(h)h +(column)f(or)g(image.)136 736 y Fc(\017)46 b Fj(o\013set)31 +b({)f(if)e(p)s(ositiv)m(e,)h(this)g(n)m(um)m(b)s(er)f(of)i(ro)m(ws)f +(at)h(the)g(b)s(eginning)d(of)j(the)f(table)h(\(or)g(pixels)d(in)i(the) +g(image\))227 849 y(will)f(b)s(e)i(skipp)s(ed)e(and)h(will)f(not)j(b)s +(e)e(passed)h(to)h(the)g(w)m(ork)f(function.)136 1030 +y Fc(\017)46 b Fj(nP)m(erLo)s(op)38 b(-)h(sp)s(eci\014es)d(the)j(n)m +(um)m(b)s(er)e(of)h(table)g(ro)m(ws)h(\(or)f(n)m(um)m(b)s(er)f(of)i +(image)f(pixels\))f(that)i(are)g(to)g(b)s(e)227 1143 +y(passed)29 b(to)h(the)f(w)m(ork)h(function)d(on)i(eac)m(h)i +(iteration.)40 b(If)28 b(nP)m(erLo)s(op)h(=)g(0)g(then)g(CFITSIO)f +(will)f(calculate)227 1256 y(the)22 b(optim)m(um)f(n)m(um)m(b)s(er)f +(for)h(greatest)j(e\016ciency)-8 b(.)38 b(If)21 b(nP)m(erLo)s(op)g(is)g +(negativ)m(e,)k(then)c(all)g(the)h(ro)m(ws)f(or)h(pixels)227 +1368 y(will)33 b(b)s(e)i(passed)g(at)h(one)g(time,)h(and)d(the)i(w)m +(ork)g(function)e(will)f(only)h(b)s(e)h(called)g(once.)56 +b(If)35 b(an)m(y)h(v)-5 b(ariable)227 1481 y(length)32 +b(arra)m(ys)h(are)g(b)s(eing)e(pro)s(cessed,)i(then)g(the)f(nP)m(erLo)s +(op)h(v)-5 b(alue)32 b(is)f(ignored,)i(and)f(the)h(iterator)g(will)227 +1594 y(alw)m(a)m(ys)e(pro)s(cess)f(one)h(ro)m(w)f(of)h(the)f(table)h +(at)g(a)g(time.)136 1775 y Fc(\017)46 b Fj(*w)m(orkFn)f(-)f(the)h(name) +f(\(actually)g(the)h(address\))f(of)g(the)g(w)m(ork)h(function)e(that)i +(is)e(to)i(b)s(e)f(called)f(b)m(y)227 1888 y(\014ts)p +354 1888 28 4 v 33 w(iterate)p 644 1888 V 33 w(data.)136 +2069 y Fc(\017)j Fj(*userP)m(oin)m(ter)33 b(-)g(this)f(is)g(a)h(user)f +(supplied)e(p)s(oin)m(ter)i(that)h(can)g(b)s(e)g(used)f(to)h(pass)g +(ancillary)e(information)227 2182 y(from)i(the)g(driv)m(er)f(routine)g +(to)i(the)f(w)m(ork)g(function.)47 b(It)33 b(ma)m(y)h(p)s(oin)m(t)e(to) +i(a)f(single)f(n)m(um)m(b)s(er,)g(an)h(arra)m(y)-8 b(,)35 +b(or)227 2295 y(to)c(a)g(structure)f(con)m(taining)g(an)g(arbitrary)f +(set)i(of)g(parameters.)136 2476 y Fc(\017)46 b Fj(*status)30 +b(-)f(The)f(CFITSIO)f(error)h(status.)41 b(Should)26 +b(=)i(0)h(on)g(input;)e(a)i(non-zero)h(output)e(v)-5 +b(alue)28 b(indicates)227 2588 y(an)j(error.)0 2828 y(When)f(\014ts)p +392 2828 V 32 w(iterate)p 681 2828 V 34 w(data)h(is)e(called)g(it)g +(\014rst)h(allo)s(cates)g(memory)g(to)h(hold)d(all)h(the)h(requested)g +(columns)f(of)h(data)0 2941 y(or)f(image)h(pixel)d(arra)m(ys.)41 +b(It)29 b(then)g(reads)g(the)h(input)d(data)j(from)f(the)g(FITS)f +(tables)h(or)h(images)f(in)m(to)g(the)h(arra)m(ys)0 3054 +y(then)h(passes)h(the)g(structure)f(with)f(p)s(oin)m(ters)h(to)h(these) +g(data)h(arra)m(ys)f(to)g(the)g(w)m(ork)g(function.)43 +b(After)32 b(the)g(w)m(ork)0 3167 y(function)k(returns,)h(the)h +(iterator)f(function)f(writes)g(an)m(y)h(output)g(columns)e(of)i(data)h +(or)f(images)g(bac)m(k)h(to)g(the)0 3279 y(FITS)31 b(\014les.)45 +b(It)32 b(then)g(rep)s(eats)g(this)f(pro)s(cess)h(for)f(an)m(y)i +(remaining)d(sets)i(of)h(ro)m(ws)f(or)g(image)g(pixels)e(un)m(til)h(it) +g(has)0 3392 y(pro)s(cessed)c(the)i(en)m(tire)f(table)f(or)h(image)h +(or)f(un)m(til)e(the)i(w)m(ork)g(function)f(returns)g(a)h(non-zero)h +(status)f(v)-5 b(alue.)39 b(The)0 3505 y(iterator)32 +b(then)g(frees)g(the)h(memory)e(that)i(it)f(initially)c(allo)s(cated)k +(and)g(returns)f(con)m(trol)h(to)h(the)f(driv)m(er)f(routine)0 +3618 y(that)g(called)f(it.)0 3949 y Ff(6.3)135 b(Guidelines)46 +b(for)f(Using)h(the)f(Iterator)h(F)-11 b(unction)0 4199 +y Fj(The)34 b(totaln,)h(o\013set,)i(\014rstn,)d(and)f(n)m(v)-5 +b(alues)34 b(parameters)g(that)h(are)f(passed)g(to)h(the)f(w)m(ork)g +(function)f(are)i(useful)0 4312 y(for)f(determining)e(ho)m(w)i(m)m(uc)m +(h)g(of)h(the)f(data)h(has)f(b)s(een)f(pro)s(cessed)h(and)f(ho)m(w)h(m) +m(uc)m(h)g(remains)f(left)h(to)h(do.)52 b(On)0 4425 y(the)36 +b(v)m(ery)h(\014rst)f(call)f(to)i(the)f(w)m(ork)h(function)e(\014rstn)g +(will)e(b)s(e)j(equal)g(to)h(o\013set)g(+)f(1;)k(the)c(w)m(ork)g +(function)f(ma)m(y)0 4538 y(need)c(to)g(p)s(erform)f(v)-5 +b(arious)30 b(initialization)d(tasks)32 b(b)s(efore)e(starting)h(to)g +(pro)s(cess)g(the)g(data.)43 b(Similarly)-8 b(,)28 b(\014rstn)h(+)0 +4650 y(n)m(v)-5 b(alues)28 b(-)g(1)h(will)c(b)s(e)j(equal)f(to)i +(totaln)g(on)f(the)g(last)g(iteration,)h(at)g(whic)m(h)e(p)s(oin)m(t)g +(the)h(w)m(ork)h(function)d(ma)m(y)j(need)0 4763 y(to)k(p)s(erform)f +(some)h(clean)g(up)e(op)s(erations)h(b)s(efore)h(exiting)f(for)g(the)h +(last)g(time.)47 b(The)33 b(w)m(ork)f(function)g(can)h(also)0 +4876 y(force)e(an)f(early)g(termination)f(of)i(the)g(iterations)e(b)m +(y)i(returning)d(a)j(status)g(v)-5 b(alue)29 b(=)h(-1.)0 +5036 y(The)f(narra)m(ys)g(and)g(iteratorCol.datat)m(yp)s(e)h(argumen)m +(ts)g(allo)m(w)e(the)i(w)m(ork)f(function)f(to)i(double)e(c)m(hec)m(k)j +(that)f(the)0 5149 y(n)m(um)m(b)s(er)k(of)i(input)e(arra)m(ys)i(and)f +(their)f(data)j(t)m(yp)s(es)e(ha)m(v)m(e)i(the)f(exp)s(ected)g(v)-5 +b(alues.)56 b(The)35 b(iteratorCol.fptr)g(and)0 5262 +y(iteratorCol.coln)m(um)c(structure)g(elemen)m(ts)g(can)h(b)s(e)f(used) +f(if)h(the)g(w)m(ork)h(function)e(needs)h(to)h(read)f(or)g(write)g(the) +0 5375 y(v)-5 b(alues)30 b(of)h(other)g(k)m(eyw)m(ords)g(in)f(the)h +(FITS)f(\014le)g(asso)s(ciated)h(with)f(the)h(arra)m(y)-8 +b(.)43 b(This)29 b(should)g(generally)h(only)g(b)s(e)0 +5488 y(done)k(during)d(the)j(initialization)d(step)i(or)h(during)e(the) +i(clean)f(up)g(step)h(after)g(the)g(last)g(set)g(of)g(data)g(has)g(b)s +(een)0 5601 y(pro)s(cessed.)40 b(Extra)29 b(FITS)f(\014le)g(I/O)h +(during)d(the)j(main)f(pro)s(cessing)g(lo)s(op)g(of)h(the)g(w)m(ork)g +(function)f(can)h(seriously)0 5714 y(degrade)i(the)f(sp)s(eed)g(of)g +(the)h(program.)p eop +%%Page: 68 76 +68 75 bop 0 299 a Fj(68)1455 b Fh(CHAPTER)30 b(6.)112 +b(THE)30 b(CFITSIO)e(ITERA)-8 b(TOR)30 b(FUNCTION)0 555 +y Fj(If)i(v)-5 b(ariable-length)32 b(arra)m(y)h(columns)f(are)h(b)s +(eing)e(pro)s(cessed,)i(then)g(the)g(iterator)g(will)d(op)s(erate)k(on) +f(one)g(ro)m(w)g(of)0 668 y(the)j(table)f(at)h(a)g(time.)56 +b(In)34 b(this)h(case)h(the)g(the)f(rep)s(eat)h(elemen)m(t)g(in)e(the)i +(in)m(teratorCol)f(structure)g(will)e(b)s(e)h(set)0 781 +y(equal)c(to)h(the)g(n)m(um)m(b)s(er)e(of)h(elemen)m(ts)h(in)e(the)i +(curren)m(t)f(ro)m(w)g(that)h(is)f(b)s(eing)f(pro)s(cessed.)0 +941 y(One)k(imp)s(ortan)m(t)f(feature)i(of)f(the)h(iterator)g(is)e +(that)i(the)f(\014rst)g(elemen)m(t)h(in)e(eac)m(h)i(arra)m(y)g(that)g +(is)e(passed)h(to)h(the)0 1054 y(w)m(ork)f(function)f(giv)m(es)h(the)g +(v)-5 b(alue)32 b(that)i(is)e(used)g(to)h(represen)m(t)g(n)m(ull)e(or)i +(unde\014ned)d(v)-5 b(alues)33 b(in)e(the)i(arra)m(y)-8 +b(.)49 b(The)0 1167 y(real)40 b(data)h(then)g(b)s(egins)e(with)g(the)h +(second)h(elemen)m(t)g(of)g(the)f(arra)m(y)h(\(i.e.,)j(arra)m(y[1],)h +(not)c(arra)m(y[0]\).)73 b(If)40 b(the)0 1280 y(\014rst)e(arra)m(y)h +(elemen)m(t)g(is)f(equal)g(to)h(zero,)j(then)c(this)f(indicates)h(that) +h(all)f(the)g(arra)m(y)h(elemen)m(ts)g(ha)m(v)m(e)h(de\014ned)0 +1393 y(v)-5 b(alues)32 b(and)g(there)h(are)g(no)g(unde\014ned)d(v)-5 +b(alues.)47 b(If)33 b(arra)m(y[0])h(is)e(not)h(equal)f(to)h(zero,)i +(then)d(this)g(indicates)f(that)0 1506 y(some)j(of)g(the)g(data)h(v)-5 +b(alues)33 b(are)h(unde\014ned)d(and)j(this)e(v)-5 b(alue)34 +b(\(arra)m(y[0]\))i(is)c(used)h(to)i(represen)m(t)f(them.)51 +b(In)33 b(the)0 1619 y(case)i(of)e(output)g(arra)m(ys)h(\(i.e.,)h +(those)f(arra)m(ys)g(that)g(will)d(b)s(e)i(written)f(bac)m(k)i(to)h +(the)e(FITS)g(\014le)f(b)m(y)i(the)g(iterator)0 1732 +y(function)g(after)j(the)f(w)m(ork)f(function)g(exits\))h(the)g(w)m +(ork)g(function)e(m)m(ust)i(set)g(the)g(\014rst)f(arra)m(y)h(elemen)m +(t)g(to)h(the)0 1844 y(desired)f(n)m(ull)f(v)-5 b(alue)36 +b(if)g(necessary)-8 b(,)40 b(otherwise)d(the)g(\014rst)g(elemen)m(t)g +(should)e(b)s(e)i(set)g(to)h(zero)g(to)g(indicate)e(that)0 +1957 y(there)30 b(are)h(no)e(n)m(ull)f(v)-5 b(alues)30 +b(in)e(the)i(output)g(arra)m(y)-8 b(.)42 b(CFITSIO)28 +b(de\014nes)h(2)h(v)-5 b(alues,)30 b(FLO)m(A)-8 b(TNULL)e(V)g(ALUE)31 +b(and)0 2070 y(DOUBLENULL)-10 b(V)g(ALUE,)37 b(that)f(can)h(b)s(e)e +(used)g(as)i(default)e(n)m(ull)f(v)-5 b(alues)35 b(for)h(\015oat)h(and) +e(double)g(data)i(t)m(yp)s(es,)0 2183 y(resp)s(ectiv)m(ely)-8 +b(.)58 b(In)35 b(the)i(case)g(of)f(c)m(haracter)i(string)d(data)i(t)m +(yp)s(es,)h(a)e(n)m(ull)f(string)g(is)g(alw)m(a)m(ys)i(used)e(to)i +(represen)m(t)0 2296 y(unde\014ned)28 b(strings.)0 2456 +y(In)33 b(some)h(applications)d(it)i(ma)m(y)h(b)s(e)f(necessary)h(to)g +(recursiv)m(ely)e(call)h(the)h(iterator)g(function.)49 +b(An)33 b(example)g(of)0 2569 y(this)26 b(is)g(giv)m(en)h(b)m(y)g(one)h +(of)f(the)h(example)e(programs)h(that)h(is)e(distributed)e(with)i +(CFITSIO:)g(it)h(\014rst)f(calls)g(a)i(w)m(ork)0 2682 +y(function)37 b(that)h(writes)g(out)g(a)g(2D)h(histogram)f(image.)64 +b(That)38 b(w)m(ork)g(function)f(in)f(turn)h(calls)h(another)g(w)m(ork) +0 2795 y(function)28 b(that)i(reads)g(the)f(`X')i(and)e(`Y')h(columns)e +(in)g(a)i(table)g(to)g(calculate)g(the)f(v)-5 b(alue)30 +b(of)f(eac)m(h)i(2D)f(histogram)0 2908 y(image)h(pixel.)39 +b(Graphically)-8 b(,)29 b(the)h(program)g(structure)g(can)h(b)s(e)f +(describ)s(ed)e(as:)48 3153 y Fe(driver)46 b(-->)h(iterator)e(-->)i +(work1_fn)f(-->)h(iterator)e(-->)i(work2_fn)0 3399 y +Fj(Finally)-8 b(,)39 b(it)f(should)e(b)s(e)i(noted)g(that)h(the)g +(table)f(columns)f(or)h(image)h(arra)m(ys)g(that)g(are)f(passed)g(to)h +(the)g(w)m(ork)0 3512 y(function)34 b(do)i(not)g(all)e(ha)m(v)m(e)j(to) +f(come)h(from)e(the)h(same)g(FITS)f(\014le)f(and)h(instead)g(ma)m(y)h +(come)h(from)e(an)m(y)h(com-)0 3625 y(bination)31 b(of)i(sources)g(as)h +(long)e(as)i(they)f(ha)m(v)m(e)h(the)f(same)h(length.)48 +b(The)32 b(length)h(of)g(the)g(\014rst)f(table)h(column)f(or)0 +3738 y(image)f(arra)m(y)g(is)e(used)g(b)m(y)i(the)f(iterator)h(if)e +(they)i(do)f(not)h(all)e(ha)m(v)m(e)j(the)e(same)h(length.)0 +4069 y Ff(6.4)135 b(Complete)47 b(List)e(of)g(Iterator)i(Routines)0 +4319 y Fj(All)34 b(of)h(the)g(iterator)g(routines)f(are)h(listed)f(b)s +(elo)m(w.)53 b(Most)36 b(of)f(these)h(routines)d(do)i(not)g(ha)m(v)m(e) +i(a)e(corresp)s(onding)0 4432 y(short)30 b(function)f(name.)0 +4678 y Fi(1)81 b Fj(Iterator)32 b(`constructor')h(functions)d(that)j +(set)f(the)g(v)-5 b(alue)31 b(of)h(elemen)m(ts)g(in)f(the)h +(iteratorCol)f(structure)g(that)227 4791 y(de\014ne)k(the)h(columns)e +(or)i(arra)m(ys.)56 b(These)36 b(set)g(the)g(\014ts\014le)e(p)s(oin)m +(ter,)i(column)e(name,)k(column)c(n)m(um)m(b)s(er,)227 +4904 y(datat)m(yp)s(e,)28 b(and)e(iot)m(yp)s(e,)h(resp)s(ectiv)m(ely)-8 +b(.)39 b(The)25 b(last)h(2)h(routines)e(allo)m(w)g(all)g(the)h +(parameters)h(to)f(b)s(e)g(set)g(with)227 5017 y(one)31 +b(function)e(call)h(\(one)h(supplies)c(the)k(column)e(name,)i(the)f +(other)h(the)f(column)f(n)m(um)m(b)s(er\).)95 5262 y +Fe(int)47 b(fits_iter_set_file\(iterato)o(rCo)o(l)42 +b(*col,)k(fitsfile)g(*fptr\);)95 5488 y(int)h +(fits_iter_set_colname\(iter)o(ato)o(rCol)41 b(*col,)46 +b(char)h(*colname\);)95 5714 y(int)g(fits_iter_set_colnum\(itera)o(tor) +o(Col)41 b(*col,)47 b(int)g(colnum\);)p eop +%%Page: 69 77 +69 76 bop 0 299 a Fh(6.4.)72 b(COMPLETE)29 b(LIST)g(OF)i(ITERA)-8 +b(TOR)29 b(R)m(OUTINES)1638 b Fj(69)95 668 y Fe(int)47 +b(fits_iter_set_datatype\(ite)o(rat)o(orCo)o(l)42 b(*col,)k(int)h +(datatype\);)95 894 y(int)g(fits_iter_set_iotype\(itera)o(tor)o(Col)41 +b(*col,)47 b(int)g(iotype\);)95 1120 y(int)g +(fits_iter_set_by_name\(iter)o(ato)o(rCol)41 b(*col,)46 +b(fitsfile)g(*fptr,)477 1233 y(char)h(*colname,)e(int)i(datatype,)93 +b(int)47 b(iotype\);)95 1458 y(int)g(fits_iter_set_by_num\(itera)o(tor) +o(Col)41 b(*col,)47 b(fitsfile)e(*fptr,)477 1571 y(int)i(colnum,)f(int) +h(datatype,)93 b(int)47 b(iotype\);)0 1820 y Fi(2)81 +b Fj(Iterator)38 b(`accessor')h(functions)d(that)h(return)g(the)g(v)-5 +b(alue)37 b(of)g(the)g(elemen)m(t)h(in)e(the)h(iteratorCol)g(structure) +227 1933 y(that)31 b(describ)s(es)e(a)i(particular)d(data)j(column)f +(or)g(arra)m(y)95 2181 y Fe(fitsfile)46 b(*)h +(fits_iter_get_file\(iterato)o(rCol)41 b(*col\);)95 2407 +y(char)47 b(*)h(fits_iter_get_colname\(i)o(ter)o(ator)o(Col)41 +b(*col\);)95 2633 y(int)47 b(fits_iter_get_colnum\(itera)o(tor)o(Col)41 +b(*col\);)95 2858 y(int)47 b(fits_iter_get_datatype\(ite)o(rat)o(orCo)o +(l)42 b(*col\);)95 3084 y(int)47 b(fits_iter_get_iotype\(itera)o(tor)o +(Col)41 b(*col\);)95 3310 y(void)47 b(*)h(fits_iter_get_array\(ite)o +(rat)o(orCo)o(l)42 b(*col\);)95 3536 y(long)47 b +(fits_iter_get_tlmin\(itera)o(tor)o(Col)41 b(*col\);)95 +3762 y(long)47 b(fits_iter_get_tlmax\(itera)o(tor)o(Col)41 +b(*col\);)95 3987 y(long)47 b(fits_iter_get_repeat\(iter)o(ato)o(rCol) +41 b(*col\);)95 4213 y(char)47 b(*)h(fits_iter_get_tunit\(ite)o(rat)o +(orCo)o(l)42 b(*col\);)95 4439 y(char)47 b(*)h +(fits_iter_get_tdisp\(ite)o(rat)o(orCo)o(l)42 b(*col\);)0 +4687 y Fi(3)81 b Fj(The)29 b(CFITSIO)g(iterator)i(function)95 +4936 y Fe(int)47 b(fits_iterate_data\(int)42 b(narrays,)94 +b(iteratorCol)44 b(*data,)i(long)h(offset,)573 5049 y(long)f(nPerLoop,) +573 5161 y(int)h(\(*workFn\)\()e(long)h(totaln,)g(long)h(offset,)f +(long)g(firstn,)1289 5274 y(long)g(nvalues,)g(int)h(narrays,)e +(iteratorCol)g(*data,)1289 5387 y(void)h(*userPointer\),)573 +5500 y(void)g(*userPointer,)573 5613 y(int)h(*status\);)p +eop +%%Page: 70 78 +70 77 bop 0 299 a Fj(70)1455 b Fh(CHAPTER)30 b(6.)112 +b(THE)30 b(CFITSIO)e(ITERA)-8 b(TOR)30 b(FUNCTION)p eop +%%Page: 71 79 +71 78 bop 0 1225 a Fg(Chapter)65 b(7)0 1687 y Fm(Celestial)76 +b(Co)6 b(ordinate)78 b(System)f(Routines)0 2180 y Fj(The)36 +b(FITS)g(comm)m(unit)m(y)g(has)g(adopted)h(a)g(set)g(of)g(k)m(eyw)m +(ord)g(con)m(v)m(en)m(tions)g(that)g(de\014ne)f(the)h(transformations)0 +2293 y(needed)30 b(to)i(con)m(v)m(ert)g(b)s(et)m(w)m(een)f(pixel)e(lo)s +(cations)h(in)f(an)i(image)g(and)f(the)g(corresp)s(onding)f(celestial)h +(co)s(ordinates)0 2406 y(on)25 b(the)h(sky)-8 b(,)27 +b(or)e(more)g(generally)-8 b(,)27 b(that)f(de\014ne)e(w)m(orld)g(co)s +(ordinates)i(that)f(are)h(to)g(b)s(e)f(asso)s(ciated)h(with)e(an)m(y)i +(pixel)0 2518 y(lo)s(cation)34 b(in)f(an)i(n-dimensional)c(FITS)j(arra) +m(y)-8 b(.)54 b(CFITSIO)33 b(is)g(distributed)f(with)h(a)i(couple)e(of) +i(self-con)m(tained)0 2631 y(W)-8 b(orld)27 b(Co)s(ordinate)f(System)g +(\(W)m(CS\))i(routines,)f(ho)m(w)m(ev)m(er,)i(these)f(routines)e(DO)h +(NOT)f(supp)s(ort)f(all)h(the)h(latest)0 2744 y(W)m(CS)38 +b(con)m(v)m(en)m(tions,)j(so)e(it)f(is)f(STR)m(ONGL)-8 +b(Y)38 b(RECOMMENDED)h(that)f(soft)m(w)m(are)i(dev)m(elop)s(ers)d(use)h +(a)h(more)0 2857 y(robust)30 b(external)g(W)m(CS)g(library)-8 +b(.)39 b(Sev)m(eral)30 b(recommended)g(libraries)e(are:)95 +3094 y Fe(WCSLIB)47 b(-)95 b(supported)45 b(by)i(Mark)g(Calabretta)95 +3207 y(WCSTools)f(-)h(supported)f(by)h(Doug)g(Mink)95 +3320 y(AST)g(library)f(-)i(developed)d(by)i(the)g(U.K.)g(Starlink)e +(project)0 3556 y Fj(More)30 b(information)d(ab)s(out)i(the)g(W)m(CS)g +(k)m(eyw)m(ord)h(con)m(v)m(en)m(tions)g(and)e(links)f(to)j(all)e(of)h +(these)g(W)m(CS)g(libraries)e(can)0 3669 y(b)s(e)j(found)f(on)h(the)h +(FITS)e(Supp)s(ort)g(O\016ce)h(w)m(eb)g(site)h(at)g(h)m +(ttp://\014ts.gsfc.nasa.go)m(v)j(under)29 b(the)h(W)m(CS)h(link.)0 +3829 y(The)i(functions)g(pro)m(vided)g(in)f(these)j(external)e(W)m(CS)h +(libraries)e(will)f(need)j(access)h(to)g(the)f(W)m(CS)g(information)0 +3942 y(con)m(tained)g(in)e(the)i(FITS)f(\014le)g(headers.)51 +b(One)33 b(con)m(v)m(enien)m(t)i(w)m(a)m(y)g(to)f(pass)g(this)e +(information)g(to)j(the)f(extermal)0 4055 y(library)29 +b(is)g(to)j(use)f(the)g(\014ts)p 942 4055 28 4 v 32 w(hdr2str)f +(routine)g(in)g(CFITSIO)f(\(de\014ned)h(b)s(elo)m(w\))g(to)i(cop)m(y)g +(the)f(header)g(k)m(eyw)m(ords)0 4168 y(in)m(to)j(one)f(long)h(string,) +f(and)g(then)g(pass)g(this)g(string)f(to)j(an)e(in)m(terface)h(routine) +f(in)f(the)i(external)f(library)e(that)0 4281 y(will)i(extract)j(the)g +(necessary)f(W)m(CS)g(information)f(\(e.g.,)k(see)e(the)f(astFitsChan)g +(and)f(astPutCards)h(routines)0 4394 y(in)29 b(the)i(Starlink)d(AST)h +(library\).)0 4631 y Fi(1)81 b Fj(Concatenate)38 b(the)f(header)f(k)m +(eyw)m(ords)h(in)e(the)h(CHDU)h(in)m(to)g(a)g(single)e(long)h(string)f +(of)i(c)m(haracters.)60 b(Eac)m(h)227 4744 y(80-c)m(haracter)28 +b(\014xed-length)23 b(k)m(eyw)m(ord)i(record)g(is)f(app)s(ended)e(to)k +(the)f(output)f(c)m(haracter)i(string,)f(in)e(order,)227 +4856 y(with)h(no)g(in)m(terv)m(ening)g(separator)h(or)g(terminating)f +(c)m(haracters.)40 b(The)24 b(last)h(header)f(record)h(is)e(terminated) +227 4969 y(with)32 b(a)h(NULL)f(c)m(haracter.)49 b(This)31 +b(routine)h(allo)s(cates)h(memory)f(for)h(the)g(returned)e(c)m +(haracter)j(arra)m(y)-8 b(,)35 b(so)227 5082 y(the)c(calling)e(program) +h(m)m(ust)g(free)h(the)f(memory)g(when)g(\014nished.)227 +5229 y(Selected)f(k)m(eyw)m(ords)f(ma)m(y)h(b)s(e)e(excluded)g(from)h +(the)g(returned)f(c)m(haracter)j(string.)39 b(If)27 b(the)i(second)f +(param-)227 5342 y(eter)h(\(no)s(commen)m(ts\))g(is)e(TR)m(UE)h +(\(nonzero\))h(then)e(an)m(y)i(COMMENT,)f(HISTOR)-8 b(Y,)27 +b(or)h(blank)f(k)m(eyw)m(ords)227 5455 y(in)i(the)i(header)f(will)e +(not)i(b)s(e)g(copied)g(to)h(the)g(output)f(string.)227 +5601 y(The)25 b('exclist')h(parameter)g(ma)m(y)g(b)s(e)f(used)g(to)h +(supply)d(a)j(list)f(of)g(k)m(eyw)m(ords)h(that)h(are)f(to)g(b)s(e)f +(excluded)f(from)227 5714 y(the)29 b(output)g(c)m(haracter)h(string.)40 +b(Wild)27 b(card)i(c)m(haracters)h(\(*,)g(?,)f(and)g(#\))g(ma)m(y)g(b)s +(e)f(used)g(in)g(the)h(excluded)1905 5942 y(71)p eop +%%Page: 72 80 +72 79 bop 0 299 a Fj(72)1003 b Fh(CHAPTER)30 b(7.)112 +b(CELESTIAL)28 b(COORDINA)-8 b(TE)30 b(SYSTEM)f(R)m(OUTINES)227 +555 y Fj(k)m(eyw)m(ord)h(names.)41 b(If)29 b(no)g(additional)f(k)m(eyw) +m(ords)i(are)g(to)g(b)s(e)f(excluded,)g(then)g(set)h(nexc)g(=)f(0)h +(and)f(sp)s(ecify)227 668 y(NULL)i(for)f(the)g(the)h(**header)g +(parameter.)95 890 y Fe(int)47 b(fits_hdr2str)286 1003 +y(\(fitsfile)f(*fptr,)g(int)h(nocomments,)d(char)j(**exclist,)e(int)i +(nexc,)286 1116 y(>)h(char)e(**header,)g(int)h(*nkeys,)e(int)i +(*status\))0 1444 y Ff(7.1)180 b(Self-con)l(tained)46 +b(W)l(CS)f(Routines)0 1694 y Fj(The)21 b(follo)m(wing)f(routines)g(DO)h +(NOT)g(supp)s(ort)f(the)h(more)h(recen)m(t)g(W)m(CS)f(con)m(v)m(en)m +(tions)i(that)e(ha)m(v)m(e)i(b)s(een)e(appro)m(v)m(ed)0 +1807 y(as)34 b(part)g(of)g(the)g(FITS)f(standard.)50 +b(Consequen)m(tly)-8 b(,)34 b(the)g(follo)m(wing)f(routines)f(ARE)i(NO) +m(W)h(DEPRECA)-8 b(TED.)0 1920 y(It)30 b(is)f(STR)m(ONGL)-8 +b(Y)30 b(RECOMMENDED)h(that)g(soft)m(w)m(are)g(dev)m(elop)s(ers)e(not)i +(use)f(these)g(routines,)f(and)h(instead)0 2033 y(use)g(an)g(external)h +(W)m(CS)f(library)-8 b(,)29 b(as)h(describ)s(ed)e(in)i(the)g(previous)f +(section.)0 2193 y(These)21 b(routines)f(are)h(included)d(mainly)h(for) +i(bac)m(kw)m(ard)g(compatibilit)m(y)f(with)f(existing)h(soft)m(w)m +(are.)39 b(They)21 b(supp)s(ort)0 2306 y(the)30 b(follo)m(wing)f +(standard)g(map)g(pro)5 b(jections:)40 b(-SIN,)30 b(-T)-8 +b(AN,)31 b(-AR)m(C,)g(-NCP)-8 b(,)30 b(-GLS,)g(-MER,)h(and)e(-AIT)h +(\(these)0 2419 y(are)f(the)g(legal)f(v)-5 b(alues)28 +b(for)g(the)h(co)s(ordt)m(yp)s(e)f(parameter\).)41 b(These)28 +b(routines)g(are)h(based)f(on)g(similar)e(functions)h(in)0 +2532 y(Classic)i(AIPS.)h(All)f(the)i(angular)e(quan)m(tities)h(are)h +(giv)m(en)f(in)f(units)g(of)h(degrees.)0 2754 y Fi(1)81 +b Fj(Get)41 b(the)f(v)-5 b(alues)40 b(of)h(the)f(basic)g(set)h(of)f +(standard)g(FITS)f(celestial)h(co)s(ordinate)g(system)h(k)m(eyw)m(ords) +f(from)227 2867 y(the)33 b(header)f(of)h(a)f(FITS)g(image)h(\(i.e.,)g +(the)g(primary)e(arra)m(y)h(or)h(an)f(IMA)m(GE)i(extension\).)46 +b(These)33 b(v)-5 b(alues)227 2980 y(ma)m(y)35 b(then)f(b)s(e)g(passed) +f(to)i(the)g(\014ts)p 1462 2980 28 4 v 32 w(pix)p 1619 +2980 V 31 w(to)p 1730 2980 V 34 w(w)m(orld)e(and)h(\014ts)p +2321 2980 V 32 w(w)m(orld)p 2574 2980 V 32 w(to)p 2686 +2980 V 33 w(pix)f(routines)g(that)i(p)s(erform)e(the)227 +3093 y(co)s(ordinate)e(transformations.)41 b(If)30 b(an)m(y)h(or)f(all) +g(of)h(the)g(W)m(CS)f(k)m(eyw)m(ords)h(are)g(not)g(presen)m(t,)g(then)g +(default)227 3206 y(v)-5 b(alues)25 b(will)d(b)s(e)i(returned.)38 +b(If)24 b(the)i(\014rst)e(co)s(ordinate)h(axis)f(is)g(the)h +(declination-lik)m(e)e(co)s(ordinate,)j(then)f(this)227 +3319 y(routine)30 b(will)d(sw)m(ap)k(them)f(so)h(that)g(the)f +(longitudinal-lik)m(e)d(co)s(ordinate)j(is)f(returned)h(as)g(the)h +(\014rst)e(axis.)227 3463 y(If)35 b(the)h(\014le)e(uses)h(the)g(new)m +(er)h('CDj)p 1454 3463 V 32 w(i')f(W)m(CS)g(transformation)g(matrix)g +(k)m(eyw)m(ords)g(instead)g(of)g(old)g(st)m(yle)227 3576 +y('CDEL)-8 b(Tn')37 b(and)f('CR)m(OT)-8 b(A2')38 b(k)m(eyw)m(ords,)h +(then)e(this)e(routine)h(will)e(calculate)k(and)e(return)g(the)h(v)-5 +b(alues)227 3689 y(of)33 b(the)g(equiv)-5 b(alen)m(t)33 +b(old-st)m(yle)f(k)m(eyw)m(ords.)49 b(Note)34 b(that)g(the)f(con)m(v)m +(ersion)g(from)f(the)i(new-st)m(yle)f(k)m(eyw)m(ords)227 +3801 y(to)f(the)f(old-st)m(yle)f(v)-5 b(alues)30 b(is)g(sometimes)g +(only)g(an)h(appro)m(ximation,)f(so)g(if)g(the)h(appro)m(ximation)f(is) +f(larger)227 3914 y(than)37 b(an)h(in)m(ternally)d(de\014ned)h +(threshold)g(lev)m(el,)j(then)e(CFITSIO)f(will)f(still)g(return)h(the)i +(appro)m(ximate)227 4027 y(W)m(CS)32 b(k)m(eyw)m(ord)h(v)-5 +b(alues,)32 b(but)f(will)e(also)j(return)f(with)g(status)h(=)f(APPR)m +(O)m(X)p 2908 4027 V 34 w(W)m(CS)p 3149 4027 V 33 w(KEY,)g(to)i(w)m +(arn)f(the)227 4140 y(calling)h(program)h(that)h(appro)m(ximations)e +(ha)m(v)m(e)i(b)s(een)f(made.)52 b(It)35 b(is)e(then)h(up)f(to)i(the)f +(calling)f(program)227 4253 y(to)d(decide)f(whether)f(the)h(appro)m +(ximations)f(are)i(su\016cien)m(tly)d(accurate)k(for)e(the)g +(particular)e(application,)227 4366 y(or)46 b(whether)e(more)i(precise) +f(W)m(CS)g(transformations)g(m)m(ust)g(b)s(e)g(p)s(erformed)f(using)f +(new-st)m(yle)j(W)m(CS)227 4479 y(k)m(eyw)m(ords)31 b(directly)-8 +b(.)95 4701 y Fe(int)47 b(fits_read_img_coord)c(/)k(ffgics)286 +4814 y(\(fitsfile)f(*fptr,)g(>)h(double)f(*xrefval,)g(double)g +(*yrefval,)334 4927 y(double)g(*xrefpix,)f(double)i(*yrefpix,)e(double) +h(*xinc,)g(double)g(*yinc,)334 5040 y(double)g(*rot,)h(char)f +(*coordtype,)f(int)i(*status\))0 5262 y Fi(2)81 b Fj(Get)30 +b(the)f(v)-5 b(alues)29 b(of)g(the)h(standard)e(FITS)h(celestial)g(co)s +(ordinate)g(system)g(k)m(eyw)m(ords)h(from)f(the)g(header)g(of)h(a)227 +5375 y(FITS)23 b(table)h(where)f(the)h(X)g(and)g(Y)g(\(or)g(RA)g(and)f +(DEC\))h(co)s(ordinates)g(are)g(stored)g(in)e(2)i(separate)h(columns) +227 5488 y(of)30 b(the)f(table)g(\(as)h(in)e(the)i(Ev)m(en)m(t)g(List)f +(table)g(format)g(that)h(is)f(often)g(used)g(b)m(y)g(high)f(energy)h +(astroph)m(ysics)227 5601 y(missions\).)69 b(These)40 +b(v)-5 b(alues)39 b(ma)m(y)i(then)f(b)s(e)f(passed)h(to)h(the)f(\014ts) +p 2511 5601 V 33 w(pix)p 2669 5601 V 31 w(to)p 2780 5601 +V 34 w(w)m(orld)f(and)h(\014ts)p 3383 5601 V 32 w(w)m(orld)p +3636 5601 V 32 w(to)p 3748 5601 V 33 w(pix)227 5714 y(routines)30 +b(that)g(p)s(erform)f(the)i(co)s(ordinate)f(transformations.)p +eop +%%Page: 73 81 +73 80 bop 0 299 a Fh(7.1.)113 b(SELF-CONT)-8 b(AINED)30 +b(W)m(CS)g(R)m(OUTINES)1984 b Fj(73)95 555 y Fe(int)47 +b(fits_read_tbl_coord)c(/)k(ffgtcs)286 668 y(\(fitsfile)f(*fptr,)g(int) +h(xcol,)f(int)h(ycol,)f(>)i(double)e(*xrefval,)334 781 +y(double)g(*yrefval,)f(double)i(*xrefpix,)e(double)h(*yrefpix,)f +(double)h(*xinc,)334 894 y(double)g(*yinc,)g(double)g(*rot,)h(char)f +(*coordtype,)f(int)i(*status\))0 1154 y Fi(3)81 b Fj(Calculate)40 +b(the)i(celestial)e(co)s(ordinate)h(corresp)s(onding)e(to)j(the)f +(input)e(X)i(and)g(Y)g(pixel)e(lo)s(cation)i(in)f(the)227 +1267 y(image.)95 1526 y Fe(int)47 b(fits_pix_to_world)c(/)48 +b(ffwldp)286 1639 y(\(double)e(xpix,)h(double)f(ypix,)g(double)g +(xrefval,)g(double)g(yrefval,)334 1752 y(double)g(xrefpix,)g(double)g +(yrefpix,)f(double)h(xinc,)h(double)f(yinc,)334 1865 +y(double)g(rot,)h(char)f(*coordtype,)f(>)j(double)e(*xpos,)g(double)g +(*ypos,)334 1978 y(int)h(*status\))0 2238 y Fi(4)81 b +Fj(Calculate)40 b(the)i(X)f(and)f(Y)h(pixel)f(lo)s(cation)g(corresp)s +(onding)f(to)j(the)f(input)e(celestial)i(co)s(ordinate)g(in)f(the)227 +2351 y(image.)95 2611 y Fe(int)47 b(fits_world_to_pix)c(/)48 +b(ffxypx)286 2723 y(\(double)e(xpos,)h(double)f(ypos,)g(double)g +(xrefval,)g(double)g(yrefval,)334 2836 y(double)g(xrefpix,)g(double)g +(yrefpix,)f(double)h(xinc,)h(double)f(yinc,)334 2949 +y(double)g(rot,)h(char)f(*coordtype,)f(>)j(double)e(*xpix,)g(double)g +(*ypix,)334 3062 y(int)h(*status\))p eop +%%Page: 74 82 +74 81 bop 0 299 a Fj(74)1003 b Fh(CHAPTER)30 b(7.)112 +b(CELESTIAL)28 b(COORDINA)-8 b(TE)30 b(SYSTEM)f(R)m(OUTINES)p +eop +%%Page: 75 83 +75 82 bop 0 1225 a Fg(Chapter)65 b(8)0 1687 y Fm(Hierarc)-6 +b(hical)76 b(Grouping)h(Routines)0 2180 y Fj(These)34 +b(functions)g(allo)m(w)g(for)g(the)h(creation)g(and)f(manipulation)e +(of)j(FITS)f(HDU)h(Groups,)h(as)f(de\014ned)e(in)g("A)0 +2293 y(Hierarc)m(hical)22 b(Grouping)g(Con)m(v)m(en)m(tion)h(for)g +(FITS")f(b)m(y)h(Jennings,)g(P)m(ence,)i(F)-8 b(olk)24 +b(and)e(Sc)m(hlesinger)g(\()h(h)m(ttp:)37 b(//ad-)0 2406 +y(fwww.gsfc.nasa.go)m(v/other/con)m(v)m(ert/group.h)m(tml)27 +b(\).)38 b(A)23 b(group)g(is)e(a)j(collection)e(of)h(HDUs)h(whose)e +(asso)s(ciation)0 2518 y(is)33 b(de\014ned)f(b)m(y)h(a)h +Fa(gr)-5 b(ouping)37 b(table)p Fj(.)50 b(HDUs)35 b(whic)m(h)d(are)i +(part)f(of)h(a)g(group)f(are)h(referred)f(to)h(as)g Fa(memb)-5 +b(er)36 b(HDUs)0 2631 y Fj(or)i(simply)d(as)i Fa(memb)-5 +b(ers)p Fj(.)63 b(Grouping)37 b(table)g(mem)m(b)s(er)g(HDUs)h(ma)m(y)g +(themselv)m(es)g(b)s(e)f(grouping)f(tables,)j(th)m(us)0 +2744 y(allo)m(wing)29 b(for)h(the)h(construction)f(of)g(op)s(en-ended)g +(hierarc)m(hies)f(of)h(HDUs.)0 2904 y(Grouping)25 b(tables)i(con)m +(tain)g(one)g(ro)m(w)g(for)f(eac)m(h)i(mem)m(b)s(er)e(HDU.)i(The)e +(grouping)f(table)i(columns)e(pro)m(vide)h(iden-)0 3017 +y(ti\014cation)h(information)f(that)i(allo)m(ws)f(applications)e(to)j +(reference)g(or)g("p)s(oin)m(t)f(to")h(the)g(mem)m(b)s(er)f(HDUs.)40 +b(Mem-)0 3130 y(b)s(er)27 b(HDUs)h(are)g(exp)s(ected,)h(but)e(not)h +(required,)e(to)j(con)m(tain)f(a)g(set)g(of)g(GRPIDn/GRPLCn)f(k)m(eyw)m +(ords)h(in)e(their)0 3243 y(headers)k(for)h(eac)m(h)g(grouping)f(table) +g(that)h(they)g(are)g(referenced)g(b)m(y)-8 b(.)41 b(In)30 +b(this)g(sense,)h(the)g(GRPIDn/GRPLCn)0 3356 y(k)m(eyw)m(ords)d("link") +e(the)i(mem)m(b)s(er)f(HDU)h(bac)m(k)g(to)g(its)f(Grouping)f(table.)40 +b(Note)29 b(that)f(a)f(mem)m(b)s(er)g(HDU)h(need)g(not)0 +3469 y(reside)h(in)g(the)h(same)g(FITS)f(\014le)h(as)g(its)f(grouping)g +(table,)h(and)f(that)i(a)f(giv)m(en)g(HDU)h(ma)m(y)g(b)s(e)e +(referenced)h(b)m(y)g(up)0 3582 y(to)h(999)h(grouping)d(tables)h(sim)m +(ultaneously)-8 b(.)0 3742 y(Grouping)21 b(tables)i(are)g(implemen)m +(ted)e(as)i(FITS)f(binary)f(tables)h(with)g(up)f(to)j(six)d +(pre-de\014ned)h(column)f(TTYPEn)0 3855 y(v)-5 b(alues:)35 +b('MEMBER)p 752 3855 28 4 v 34 w(XTENSION',)20 b('MEMBER)p +1789 3855 V 33 w(NAME',)h('MEMBER)p 2620 3855 V 34 w(VERSION',)f +('MEMBER)p 3590 3855 V 34 w(POSITION',)0 3968 y('MEMBER)p +451 3968 V 34 w(URI)p 653 3968 V 32 w(TYPE')g(and)g('MEMBER)p +1601 3968 V 34 w(LOCA)-8 b(TION'.)20 b(The)f(\014rst)h(three)g(columns) +f(allo)m(w)h(mem)m(b)s(er)g(HDUs)0 4081 y(to)28 b(b)s(e)f(iden)m +(ti\014ed)e(b)m(y)i(reference)h(to)g(their)e(XTENSION,)h(EXTNAME)g(and) +g(EXTVER)g(k)m(eyw)m(ord)g(v)-5 b(alues.)39 b(The)0 4194 +y(fourth)29 b(column)g(allo)m(ws)h(mem)m(b)s(er)f(HDUs)i(to)g(b)s(e)f +(iden)m(ti\014ed)e(b)m(y)i(HDU)h(p)s(osition)d(within)g(their)h(FITS)h +(\014le.)39 b(The)0 4307 y(last)f(t)m(w)m(o)h(columns)d(iden)m(tify)g +(the)i(FITS)f(\014le)g(in)f(whic)m(h)h(the)h(mem)m(b)s(er)f(HDU)h +(resides,)h(if)d(di\013eren)m(t)i(from)f(the)0 4419 y(grouping)29 +b(table)h(FITS)g(\014le.)0 4580 y(Additional)22 b(user)i(de\014ned)f +("auxiliary")g(columns)g(ma)m(y)i(also)f(b)s(e)g(included)e(with)h(an)m +(y)i(grouping)e(table.)38 b(When)25 b(a)0 4693 y(grouping)h(table)i(is) +f(copied)g(or)g(mo)s(di\014ed)f(the)i(presence)g(of)f(auxiliary)f +(columns)g(is)h(alw)m(a)m(ys)h(tak)m(en)h(in)m(to)e(accoun)m(t)0 +4805 y(b)m(y)k(the)g(grouping)f(supp)s(ort)g(functions;)g(ho)m(w)m(ev)m +(er,)j(the)e(grouping)f(supp)s(ort)g(functions)f(cannot)j(directly)e +(mak)m(e)0 4918 y(use)g(of)h(this)e(data.)0 5079 y(If)44 +b(a)h(grouping)e(table)h(column)f(is)h(de\014ned)f(but)h(the)g(corresp) +s(onding)f(mem)m(b)s(er)g(HDU)j(information)c(is)i(un-)0 +5191 y(a)m(v)-5 b(ailable)38 b(then)f(a)i(n)m(ull)d(v)-5 +b(alue)38 b(of)g(the)g(appropriate)g(data)g(t)m(yp)s(e)h(is)e(inserted) +g(in)g(the)h(column)f(\014eld.)63 b(In)m(teger)0 5304 +y(columns)25 b(\(MEMBER)p 811 5304 V 34 w(POSITION,)g(MEMBER)p +1771 5304 V 34 w(VERSION\))h(are)h(de\014ned)f(with)f(a)i(TNULLn)f(v)-5 +b(alue)26 b(of)h(zero)0 5417 y(\(0\).)41 b(Character)27 +b(\014eld)e(columns)h(\(MEMBER)p 1607 5417 V 34 w(XTENSION,)g(MEMBER)p +2600 5417 V 33 w(NAME,)i(MEMBER)p 3388 5417 V 34 w(URI)p +3590 5417 V 32 w(TYPE,)0 5530 y(MEMBER)p 426 5530 V 33 +w(LOCA)-8 b(TION\))30 b(utilize)f(an)h(ASCI)s(I)f(n)m(ull)f(c)m +(haracter)k(to)f(denote)g(a)g(n)m(ull)d(\014eld)h(v)-5 +b(alue.)0 5690 y(The)23 b(grouping)f(supp)s(ort)g(functions)g(b)s +(elong)h(to)h(t)m(w)m(o)h(basic)e(categories:)39 b(those)24 +b(that)h(w)m(ork)e(with)g(grouping)f(table)1905 5942 +y(75)p eop +%%Page: 76 84 +76 83 bop 0 299 a Fj(76)1338 b Fh(CHAPTER)29 b(8.)112 +b(HIERAR)m(CHICAL)30 b(GR)m(OUPING)h(R)m(OUTINES)0 555 +y Fj(HDUs)26 b(\(\013gt**\))j(and)c(those)h(that)h(w)m(ork)f(with)e +(mem)m(b)s(er)i(HDUs)g(\(\013gm**\).)41 b(Tw)m(o)26 b(functions,)g +(\014ts)p 3360 555 28 4 v 32 w(cop)m(y)p 3573 555 V 34 +w(group\(\))0 668 y(and)40 b(\014ts)p 314 668 V 33 w(remo)m(v)m(e)p +626 668 V 34 w(group\(\),)k(ha)m(v)m(e)e(the)f(option)f(to)i(recursiv)m +(ely)d(cop)m(y/delete)k(en)m(tire)e(groups.)71 b(Care)41 +b(should)0 781 y(b)s(e)33 b(tak)m(en)h(when)f(emplo)m(ying)f(these)i +(functions)e(in)g(recursiv)m(e)h(mo)s(de)g(as)g(p)s(o)s(orly)f +(de\014ned)g(groups)h(could)f(cause)0 894 y(unpredictable)23 +b(results.)38 b(The)25 b(problem)f(of)i(a)g(grouping)e(table)i +(directly)e(or)i(indirectly)d(referencing)i(itself)f(\(th)m(us)0 +1007 y(creating)40 b(an)g(in\014nite)d(lo)s(op\))j(is)e(protected)j +(against;)k(in)38 b(fact,)44 b(neither)38 b(function)h(will)e(attempt)k +(to)f(cop)m(y)h(or)0 1120 y(delete)31 b(an)f(HDU)h(t)m(wice.)0 +1453 y Ff(8.1)135 b(Grouping)45 b(T)-11 b(able)45 b(Routines)0 +1693 y Fi(1)81 b Fj(Create)34 b(\(app)s(end\))f(a)h(grouping)e(table)i +(at)g(the)g(end)f(of)h(the)g(curren)m(t)f(FITS)g(\014le)g(p)s(oin)m +(ted)g(to)h(b)m(y)g(fptr.)49 b(The)227 1806 y(grpname)28 +b(parameter)h(pro)m(vides)f(the)h(grouping)e(table)h(name)h(\(GRPNAME)g +(k)m(eyw)m(ord)g(v)-5 b(alue\))28 b(and)g(ma)m(y)227 +1919 y(b)s(e)42 b(set)h(to)g(NULL)f(if)f(no)h(group)g(name)g(is)g(to)h +(b)s(e)e(sp)s(eci\014ed.)75 b(The)42 b(groupt)m(yp)s(e)g(parameter)g +(sp)s(eci\014es)227 2032 y(the)c(desired)f(structure)g(of)h(the)g +(grouping)e(table)i(and)f(ma)m(y)i(tak)m(e)g(on)f(the)g(v)-5 +b(alues:)55 b(GT)p 3355 2032 V 33 w(ID)p 3490 2032 V +33 w(ALL)p 3705 2032 V 32 w(URI)227 2145 y(\(all)33 b(columns)f +(created\),)k(GT)p 1274 2145 V 33 w(ID)p 1409 2145 V +33 w(REF)d(\(ID)h(b)m(y)g(reference)g(columns\),)f(GT)p +2904 2145 V 33 w(ID)p 3039 2145 V 33 w(POS)f(\(ID)i(b)m(y)g(p)s +(osition)227 2258 y(columns\),)47 b(GT)p 801 2258 V 32 +w(ID)p 935 2258 V 33 w(ALL)d(\(ID)g(b)m(y)f(reference)i(and)e(p)s +(osition)e(columns\),)47 b(GT)p 3028 2258 V 32 w(ID)p +3162 2258 V 33 w(REF)p 3383 2258 V 33 w(URI)d(\(ID)g(b)m(y)227 +2371 y(reference)35 b(and)e(FITS)g(\014le)h(URI)f(columns\),)i(and)e +(GT)p 2129 2371 V 33 w(ID)p 2264 2371 V 33 w(POS)p 2481 +2371 V 32 w(URI)h(\(ID)g(b)m(y)g(p)s(osition)e(and)i(FITS)f(\014le)227 +2484 y(URI)e(columns\).)95 2742 y Fe(int)47 b(fits_create_group)c(/)48 +b(ffgtcr)286 2855 y(\(fitsfile)e(*fptr,)g(char)g(*grpname,)g(int)h +(grouptype,)e(>)i(int)g(*status\))0 3113 y Fi(2)81 b +Fj(Create)26 b(\(insert\))f(a)g(grouping)f(table)h(just)g(after)h(the)f +(CHDU)h(of)g(the)f(curren)m(t)g(FITS)g(\014le)f(p)s(oin)m(ted)g(to)i(b) +m(y)g(fptr.)227 3226 y(All)i(HDUs)h(b)s(elo)m(w)f(the)h(the)g +(insertion)e(p)s(oin)m(t)g(will)g(b)s(e)h(shifted)f(do)m(wn)m(w)m(ards) +h(to)i(mak)m(e)g(ro)s(om)e(for)g(the)h(new)227 3339 y(HDU.)23 +b(The)e(grpname)h(parameter)g(pro)m(vides)e(the)i(grouping)f(table)g +(name)h(\(GRPNAME)h(k)m(eyw)m(ord)f(v)-5 b(alue\))227 +3451 y(and)25 b(ma)m(y)i(b)s(e)e(set)h(to)h(NULL)e(if)g(no)h(group)f +(name)h(is)f(to)h(b)s(e)f(sp)s(eci\014ed.)38 b(The)25 +b(groupt)m(yp)s(e)h(parameter)g(sp)s(eci-)227 3564 y(\014es)g(the)h +(desired)e(structure)h(of)h(the)f(grouping)f(table)i(and)f(ma)m(y)h +(tak)m(e)h(on)e(the)h(v)-5 b(alues:)38 b(GT)p 3355 3564 +V 33 w(ID)p 3490 3564 V 33 w(ALL)p 3705 3564 V 32 w(URI)227 +3677 y(\(all)33 b(columns)f(created\),)k(GT)p 1274 3677 +V 33 w(ID)p 1409 3677 V 33 w(REF)d(\(ID)h(b)m(y)g(reference)g +(columns\),)f(GT)p 2904 3677 V 33 w(ID)p 3039 3677 V +33 w(POS)f(\(ID)i(b)m(y)g(p)s(osition)227 3790 y(columns\),)28 +b(GT)p 782 3790 V 33 w(ID)p 917 3790 V 33 w(ALL)g(\(ID)g(b)m(y)g +(reference)h(and)e(p)s(osition)f(columns\),)i(GT)p 2897 +3790 V 33 w(ID)p 3032 3790 V 33 w(REF)p 3253 3790 V 32 +w(URI)g(\(ID)h(b)m(y)f(ref-)227 3903 y(erence)g(and)e(FITS)h(\014le)f +(URI)h(columns\),)g(and)f(GT)p 1976 3903 V 33 w(ID)p +2111 3903 V 33 w(POS)p 2328 3903 V 32 w(URI)h(\(ID)g(b)m(y)g(p)s +(osition)e(and)i(FITS)f(\014le)g(URI)227 4016 y(columns\))k(.)95 +4274 y Fe(int)47 b(fits_insert_group)c(/)48 b(ffgtis)286 +4387 y(\(fitsfile)e(*fptr,)g(char)g(*grpname,)g(int)h(grouptype,)e(>)i +(int)g(*status\))0 4645 y Fi(3)81 b Fj(Change)20 b(the)h(structure)f +(of)h(an)g(existing)e(grouping)h(table)g(p)s(oin)m(ted)g(to)h(b)m(y)g +(gfptr.)37 b(The)20 b(groupt)m(yp)s(e)g(parameter)227 +4758 y(\(see)27 b(\014ts)p 532 4758 V 32 w(create)p 800 +4758 V 35 w(group\(\))e(for)h(v)-5 b(alid)24 b(parameter)i(v)-5 +b(alues\))25 b(sp)s(eci\014es)g(the)g(new)g(structure)h(of)f(the)h +(grouping)227 4871 y(table.)43 b(This)29 b(function)h(only)g(adds)h(or) +g(remo)m(v)m(es)h(grouping)e(table)h(columns,)f(it)h(do)s(es)g(not)g +(add)g(or)g(delete)227 4984 y(group)26 b(mem)m(b)s(ers)f(\(i.e.,)j +(table)e(ro)m(ws\).)40 b(If)26 b(the)g(grouping)f(table)h(already)g +(has)g(the)h(desired)d(structure)i(then)227 5097 y(no)35 +b(op)s(erations)e(are)i(p)s(erformed)e(and)h(function)f(simply)g +(returns)g(with)g(a)i(\(0\))g(success)g(status)g(co)s(de.)53 +b(If)227 5210 y(the)32 b(requested)g(structure)g(c)m(hange)h(creates)g +(new)f(grouping)f(table)h(columns,)f(then)h(the)g(column)f(v)-5 +b(alues)227 5323 y(for)30 b(all)g(existing)f(mem)m(b)s(ers)h(will)d(b)s +(e)j(\014lled)e(with)h(the)i(n)m(ull)d(v)-5 b(alues)30 +b(appropriate)f(to)i(the)g(column)e(t)m(yp)s(e.)95 5581 +y Fe(int)47 b(fits_change_group)c(/)48 b(ffgtch)286 5694 +y(\(fitsfile)e(*gfptr,)f(int)i(grouptype,)e(>)j(int)f(*status\))p +eop +%%Page: 77 85 +77 84 bop 0 299 a Fh(8.1.)72 b(GR)m(OUPING)31 b(T)-8 +b(ABLE)31 b(R)m(OUTINES)2235 b Fj(77)0 555 y Fi(4)81 +b Fj(Remo)m(v)m(e)41 b(the)e(group)g(de\014ned)f(b)m(y)h(the)h +(grouping)e(table)h(p)s(oin)m(ted)f(to)i(b)m(y)g(gfptr,)h(and)e +(optionally)f(all)g(the)227 668 y(group)29 b(mem)m(b)s(er)f(HDUs.)41 +b(The)28 b(rmopt)h(parameter)g(sp)s(eci\014es)f(the)h(action)g(to)h(b)s +(e)e(tak)m(en)i(for)f(all)f(mem)m(b)s(ers)227 781 y(of)f(the)g(group)g +(de\014ned)e(b)m(y)i(the)g(grouping)f(table.)39 b(V)-8 +b(alid)26 b(v)-5 b(alues)26 b(are:)40 b(OPT)p 2848 781 +28 4 v 32 w(RM)p 3030 781 V 33 w(GPT)26 b(\(delete)i(only)e(the)227 +894 y(grouping)32 b(table\))i(and)f(OPT)p 1259 894 V +32 w(RM)p 1441 894 V 33 w(ALL)g(\(recursiv)m(ely)f(delete)i(all)e(HDUs) +i(that)g(b)s(elong)e(to)i(the)g(group\).)227 1007 y(An)m(y)d(groups)g +(con)m(taining)g(the)g(grouping)f(table)h(gfptr)f(as)i(a)f(mem)m(b)s +(er)g(are)g(up)s(dated,)f(and)h(if)f(rmopt)h(==)227 1120 +y(OPT)p 431 1120 V 32 w(RM)p 613 1120 V 33 w(GPT)21 b(all)f(mem)m(b)s +(ers)h(ha)m(v)m(e)h(their)e(GRPIDn)h(and)g(GRPLCn)f(k)m(eyw)m(ords)h +(up)s(dated)f(accordingly)-8 b(.)227 1233 y(If)36 b(rmopt)g(==)g(OPT)p +985 1233 V 32 w(RM)p 1167 1233 V 33 w(ALL,)g(then)g(other)h(groups)e +(that)i(con)m(tain)g(the)f(deleted)g(mem)m(b)s(ers)g(of)g(gfptr)227 +1346 y(are)31 b(up)s(dated)e(to)i(re\015ect)g(the)g(deletion)e +(accordingly)-8 b(.)95 1582 y Fe(int)47 b(fits_remove_group)c(/)48 +b(ffgtrm)286 1695 y(\(fitsfile)e(*gfptr,)f(int)i(rmopt,)f(>)i(int)f +(*status\))0 1932 y Fi(5)81 b Fj(Cop)m(y)28 b(\(app)s(end\))g(the)h +(group)f(de\014ned)g(b)m(y)h(the)f(grouping)g(table)h(p)s(oin)m(ted)e +(to)j(b)m(y)e(infptr,)g(and)g(optionally)f(all)227 2045 +y(group)j(mem)m(b)s(er)h(HDUs,)g(to)h(the)f(FITS)f(\014le)f(p)s(oin)m +(ted)h(to)i(b)m(y)e(outfptr.)41 b(The)31 b(cp)s(opt)f(parameter)h(sp)s +(eci\014es)227 2158 y(the)c(action)g(to)g(b)s(e)f(tak)m(en)h(for)g(all) +e(mem)m(b)s(ers)h(of)g(the)h(group)f(infptr.)37 b(V)-8 +b(alid)26 b(v)-5 b(alues)25 b(are:)40 b(OPT)p 3443 2158 +V 32 w(GCP)p 3674 2158 V 32 w(GPT)227 2271 y(\(cop)m(y)d(only)f(the)g +(grouping)f(table\))h(and)f(OPT)p 1887 2271 V 32 w(GCP)p +2118 2271 V 33 w(ALL)h(\(recursiv)m(ely)f(cop)m(y)i(ALL)e(the)i(HDUs)f +(that)227 2384 y(b)s(elong)23 b(to)h(the)g(group)f(de\014ned)g(b)m(y)g +(infptr\).)37 b(If)23 b(the)h(cp)s(opt)g(==)f(OPT)p 2618 +2384 V 32 w(GCP)p 2849 2384 V 32 w(GPT)h(then)f(the)h(mem)m(b)s(ers)f +(of)227 2497 y(infptr)h(ha)m(v)m(e)i(their)f(GRPIDn)g(and)g(GRPLCn)g(k) +m(eyw)m(ords)h(up)s(dated)e(to)i(re\015ect)g(the)g(existence)g(of)g +(the)f(new)227 2610 y(grouping)e(table)g(outfptr,)i(since)e(they)h(no)m +(w)g(b)s(elong)f(to)h(the)g(new)g(group.)38 b(If)23 b(cp)s(opt)h(==)f +(OPT)p 3460 2610 V 32 w(GCP)p 3691 2610 V 32 w(ALL)227 +2723 y(then)29 b(the)g(new)g(grouping)f(table)h(outfptr)f(only)g(con)m +(tains)i(p)s(oin)m(ters)e(to)i(the)f(copied)f(mem)m(b)s(er)h(HDUs)h +(and)227 2836 y(not)38 b(the)g(original)d(mem)m(b)s(er)i(HDUs)h(of)g +(infptr.)60 b(Note)39 b(that,)h(when)d(cp)s(opt)g(==)g(OPT)p +3301 2836 V 32 w(GCP)p 3532 2836 V 33 w(ALL,)g(all)227 +2949 y(mem)m(b)s(ers)h(of)h(the)f(group)g(de\014ned)f(b)m(y)i(infptr)d +(will)g(b)s(e)h(copied)h(to)h(a)g(single)e(FITS)h(\014le)g(p)s(oin)m +(ted)f(to)i(b)m(y)227 3061 y(outfptr)30 b(regardless)g(of)g(their)g +(\014le)f(distribution)e(in)i(the)i(original)d(group.)95 +3298 y Fe(int)47 b(fits_copy_group)d(/)j(ffgtcp)286 3411 +y(\(fitsfile)f(*infptr,)f(fitsfile)h(*outfptr,)f(int)i(cpopt,)f(>)h +(int)g(*status\))0 3648 y Fi(6)81 b Fj(Merge)40 b(the)f(t)m(w)m(o)h +(groups)e(de\014ned)g(b)m(y)h(the)g(grouping)f(table)g(HDUs)i(infptr)d +(and)h(outfptr)h(b)m(y)f(com)m(bining)227 3761 y(their)29 +b(mem)m(b)s(ers)g(in)m(to)h(a)g(single)e(grouping)g(table.)41 +b(All)28 b(mem)m(b)s(er)h(HDUs)h(\(ro)m(ws\))h(are)f(copied)f(from)g +(infptr)227 3874 y(to)f(outfptr.)39 b(If)26 b(mgopt)i(==)e(OPT)p +1419 3874 V 32 w(MR)m(G)p 1669 3874 V 34 w(COPY)g(then)g(infptr)f(con)m +(tin)m(ues)i(to)h(exist)f(unaltered)e(after)j(the)227 +3987 y(merge.)57 b(If)36 b(the)f(mgopt)i(==)e(OPT)p 1474 +3987 V 31 w(MR)m(G)p 1723 3987 V 34 w(MO)m(V)i(then)e(infptr)e(is)i +(deleted)h(after)g(the)g(merge.)57 b(In)35 b(b)s(oth)227 +4100 y(cases,)d(the)e(GRPIDn)h(and)e(GRPLCn)h(k)m(eyw)m(ords)g(of)h +(the)g(mem)m(b)s(er)e(HDUs)i(are)g(up)s(dated)e(accordingly)-8 +b(.)95 4337 y Fe(int)47 b(fits_merge_groups)c(/)48 b(ffgtmg)286 +4450 y(\(fitsfile)e(*infptr,)f(fitsfile)h(*outfptr,)f(int)i(mgopt,)f(>) +h(int)g(*status\))0 4687 y Fi(7)81 b Fj("Compact")24 +b(the)f(group)g(de\014ned)f(b)m(y)h(grouping)e(table)i(p)s(oin)m(ted)f +(to)i(b)m(y)f(gfptr.)38 b(The)23 b(compaction)g(is)f(ac)m(hiev)m(ed)227 +4799 y(b)m(y)37 b(merging)g(\(via)g(\014ts)p 1034 4799 +V 32 w(merge)p 1303 4799 V 34 w(groups\(\)\))g(all)f(direct)h(mem)m(b)s +(er)g(HDUs)g(of)h(gfptr)e(that)i(are)g(themselv)m(es)227 +4912 y(grouping)h(tables.)69 b(The)40 b(cmopt)g(parameter)h(de\014nes)e +(whether)g(the)i(merged)f(grouping)e(table)i(HDUs)227 +5025 y(remain)j(after)i(merging)e(\(cmopt)i(==)f(OPT)p +1852 5025 V 32 w(CMT)p 2099 5025 V 32 w(MBR\))h(or)f(if)f(they)i(are)f +(deleted)g(after)h(merging)227 5138 y(\(cmopt)31 b(==)f(OPT)p +916 5138 V 32 w(CMT)p 1163 5138 V 32 w(MBR)p 1409 5138 +V 34 w(DEL\).)g(If)g(the)h(grouping)d(table)j(con)m(tains)f(no)g +(direct)g(mem)m(b)s(er)f(HDUs)227 5251 y(that)i(are)f(themselv)m(es)g +(grouping)e(tables)i(then)f(this)g(function)f(do)s(es)i(nothing.)39 +b(Note)31 b(that)g(this)d(function)227 5364 y(is)i(not)g(recursiv)m(e,) +g(i.e.,)h(only)f(the)g(direct)g(mem)m(b)s(er)g(HDUs)h(of)f(gfptr)g(are) +h(considered)e(for)h(merging.)95 5601 y Fe(int)47 b(fits_compact_group) +c(/)48 b(ffgtcm)286 5714 y(\(fitsfile)e(*gfptr,)f(int)i(cmopt,)f(>)i +(int)f(*status\))p eop +%%Page: 78 86 +78 85 bop 0 299 a Fj(78)1338 b Fh(CHAPTER)29 b(8.)112 +b(HIERAR)m(CHICAL)30 b(GR)m(OUPING)h(R)m(OUTINES)0 555 +y Fi(8)81 b Fj(V)-8 b(erify)20 b(the)i(in)m(tegrit)m(y)f(of)g(the)g +(grouping)f(table)h(p)s(oin)m(ted)f(to)i(b)m(y)f(gfptr)g(to)h(mak)m(e)g +(sure)e(that)i(all)e(group)h(mem)m(b)s(ers)227 668 y(are)31 +b(accessible)g(and)f(that)h(all)e(links)g(to)i(other)g(grouping)e +(tables)i(are)g(v)-5 b(alid.)40 b(The)30 b(\014rstfailed)e(parameter) +227 781 y(returns)e(the)i(mem)m(b)s(er)e(ID)h(\(ro)m(w)h(n)m(um)m(b)s +(er\))e(of)i(the)f(\014rst)f(mem)m(b)s(er)h(HDU)h(to)g(fail)e(v)m +(eri\014cation)g(\(if)h(p)s(ositiv)m(e)227 894 y(v)-5 +b(alue\))35 b(or)f(the)h(\014rst)e(group)h(link)e(to)k(fail)d(\(if)g +(negativ)m(e)j(v)-5 b(alue\).)53 b(If)34 b(gfptr)g(is)f(successfully)g +(v)m(eri\014ed)g(then)227 1007 y(\014rstfailed)c(con)m(tains)h(a)h +(return)e(v)-5 b(alue)30 b(of)h(0.)95 1284 y Fe(int)47 +b(fits_verify_group)c(/)48 b(ffgtvf)286 1397 y(\(fitsfile)e(*gfptr,)f +(>)j(long)f(*firstfailed,)d(int)j(*status\))0 1674 y +Fi(9)81 b Fj(Op)s(en)23 b(a)j(grouping)e(table)h(that)h(con)m(tains)f +(the)h(mem)m(b)s(er)e(HDU)i(p)s(oin)m(ted)e(to)i(b)m(y)f(mfptr.)38 +b(The)25 b(grouping)f(table)227 1787 y(to)39 b(op)s(en)e(is)g +(de\014ned)g(b)m(y)h(the)g(grpid)e(parameter,)k(whic)m(h)d(con)m(tains) +h(the)g(k)m(eyw)m(ord)h(index)d(v)-5 b(alue)38 b(of)g(the)227 +1900 y(GRPIDn/GRPLCn)d(k)m(eyw)m(ord\(s\))g(that)h(link)d(the)i(mem)m +(b)s(er)f(HDU)h(mfptr)f(to)i(the)f(grouping)e(table.)54 +b(If)227 2013 y(the)30 b(grouping)e(table)h(resides)f(in)h(a)g(\014le)g +(other)g(than)h(the)f(mem)m(b)s(er)g(HDUs)h(\014le)e(then)h(an)h +(attempt)g(is)f(\014rst)227 2126 y(made)g(to)h(op)s(en)e(the)h(\014le)f +(readwrite,)h(and)f(failing)f(that)j(readonly)-8 b(.)39 +b(A)29 b(p)s(oin)m(ter)f(to)i(the)f(op)s(ened)f(grouping)227 +2238 y(table)j(HDU)g(is)e(returned)g(in)g(gfptr.)227 +2397 y(Note)35 b(that)g(it)e(is)g(p)s(ossible,)f(although)i(unlik)m +(ely)d(and)i(undesirable,)f(for)i(the)g(GRPIDn/GRPLCn)f(k)m(ey-)227 +2510 y(w)m(ords)k(in)f(a)h(mem)m(b)s(er)g(HDU)h(header)f(to)h(b)s(e)e +(non-con)m(tin)m(uous,)j(e.g.,)h(GRPID1,)g(GRPID2,)g(GRPID5,)227 +2623 y(GRPID6.)i(In)29 b(suc)m(h)g(cases,)i(the)f(grpid)e(index)g(v)-5 +b(alue)30 b(sp)s(eci\014ed)e(in)g(the)i(function)e(call)i(shall)e(iden) +m(tify)g(the)227 2736 y(\(grpid\)th)35 b(GRPID)g(v)-5 +b(alue.)56 b(In)34 b(the)i(ab)s(o)m(v)m(e)h(example,)f(if)f(grpid)e(==) +i(3,)j(then)d(the)g(group)g(sp)s(eci\014ed)f(b)m(y)227 +2849 y(GRPID5)d(w)m(ould)f(b)s(e)f(op)s(ened.)95 3126 +y Fe(int)47 b(fits_open_group)d(/)j(ffgtop)286 3239 y(\(fitsfile)f +(*mfptr,)f(int)i(group,)f(>)i(fitsfile)d(**gfptr,)h(int)h(*status\))0 +3516 y Fi(10)f Fj(Add)38 b(a)h(mem)m(b)s(er)f(HDU)i(to)f(an)g(existing) +e(grouping)h(table)h(p)s(oin)m(ted)e(to)j(b)m(y)e(gfptr.)66 +b(The)38 b(mem)m(b)s(er)g(HDU)227 3629 y(ma)m(y)30 b(either)f(b)s(e)g +(p)s(oin)m(ted)f(to)i(mfptr)f(\(whic)m(h)f(m)m(ust)i(b)s(e)e(p)s +(ositioned)g(to)i(the)f(mem)m(b)s(er)g(HDU\))i(or,)f(if)e(mfptr)227 +3742 y(==)36 b(NULL,)g(iden)m(ti\014ed)e(b)m(y)i(the)g(hdup)s(os)e +(parameter)i(\(the)h(HDU)g(p)s(osition)d(n)m(um)m(b)s(er,)i(Primary)e +(arra)m(y)227 3855 y(==)g(1\))i(if)e(b)s(oth)g(the)h(grouping)f(table)g +(and)h(the)g(mem)m(b)s(er)f(HDU)h(reside)f(in)g(the)h(same)g(FITS)f +(\014le.)53 b(The)227 3968 y(new)27 b(mem)m(b)s(er)f(HDU)h(shall)e(ha)m +(v)m(e)j(the)f(appropriate)f(GRPIDn)g(and)g(GRPLCn)g(k)m(eyw)m(ords)h +(created)h(in)e(its)227 4081 y(header.)44 b(Note)33 b(that)f(if)f(the)h +(mem)m(b)s(er)e(HDU)j(is)d(already)h(a)h(mem)m(b)s(er)f(of)h(the)g +(group)f(then)g(it)g(will)e(not)j(b)s(e)227 4194 y(added)e(a)h(second)f +(time.)95 4471 y Fe(int)47 b(fits_add_group_member)42 +b(/)48 b(ffgtam)286 4584 y(\(fitsfile)e(*gfptr,)f(fitsfile)h(*mfptr,)g +(int)h(hdupos,)f(>)h(int)g(*status\))0 4938 y Ff(8.2)135 +b(Group)45 b(Mem)l(b)t(er)f(Routines)0 5191 y Fi(1)81 +b Fj(Return)29 b(the)h(n)m(um)m(b)s(er)f(of)i(mem)m(b)s(er)e(HDUs)i(in) +e(a)i(grouping)d(table)j(gfptr.)40 b(The)30 b(n)m(um)m(b)s(er)e(mem)m +(b)s(er)i(HDUs)h(is)227 5304 y(just)f(the)h(NAXIS2)f(v)-5 +b(alue)30 b(\(n)m(um)m(b)s(er)g(of)g(ro)m(ws\))h(of)f(the)h(grouping)e +(table.)95 5581 y Fe(int)47 b(fits_get_num_members)c(/)k(ffgtnm)286 +5694 y(\(fitsfile)f(*gfptr,)f(>)j(long)f(*nmembers,)e(int)h(*status\))p +eop +%%Page: 79 87 +79 86 bop 0 299 a Fh(8.2.)72 b(GR)m(OUP)31 b(MEMBER)g(R)m(OUTINES)2295 +b Fj(79)0 555 y Fi(2)81 b Fj(Return)34 b(the)h(n)m(um)m(b)s(er)f(of)i +(groups)e(to)i(whic)m(h)e(the)h(HDU)h(p)s(oin)m(ted)e(to)i(b)m(y)f +(mfptr)f(is)h(link)m(ed,)g(as)g(de\014ned)f(b)m(y)227 +668 y(the)27 b(n)m(um)m(b)s(er)f(of)h(GRPIDn/GRPLCn)f(k)m(eyw)m(ord)i +(records)e(that)i(app)s(ear)e(in)f(its)i(header.)39 b(Note)28 +b(that)g(eac)m(h)227 781 y(time)36 b(this)g(function)f(is)g(called,)j +(the)e(indices)f(of)i(the)f(GRPIDn/GRPLCn)g(k)m(eyw)m(ords)h(are)g(c)m +(hec)m(k)m(ed)h(to)227 894 y(mak)m(e)29 b(sure)e(they)g(are)h(con)m +(tin)m(uous)f(\(ie)h(no)f(gaps\))h(and)f(are)h(re-en)m(umerated)g(to)h +(eliminate)d(gaps)i(if)e(found.)95 1228 y Fe(int)47 b +(fits_get_num_groups)c(/)k(ffgmng)286 1341 y(\(fitsfile)f(*mfptr,)f(>)j +(long)f(*nmembers,)e(int)h(*status\))0 1563 y Fi(3)81 +b Fj(Op)s(en)26 b(a)i(mem)m(b)s(er)f(of)h(the)f(grouping)g(table)g(p)s +(oin)m(ted)g(to)h(b)m(y)g(gfptr.)39 b(The)27 b(mem)m(b)s(er)g(to)i(op)s +(en)e(is)f(iden)m(ti\014ed)g(b)m(y)227 1676 y(its)j(ro)m(w)h(n)m(um)m +(b)s(er)e(within)f(the)i(grouping)g(table)g(as)h(giv)m(en)f(b)m(y)h +(the)f(parameter)h('mem)m(b)s(er')f(\(\014rst)h(mem)m(b)s(er)227 +1788 y(==)g(1\))g(.)41 b(A)30 b(\014ts\014le)e(p)s(oin)m(ter)h(to)i +(the)f(op)s(ened)f(mem)m(b)s(er)g(HDU)i(is)e(returned)g(as)h(mfptr.)39 +b(Note)31 b(that)g(if)e(the)227 1901 y(mem)m(b)s(er)f(HDU)h(resides)f +(in)f(a)i(FITS)f(\014le)f(di\013eren)m(t)h(from)g(the)h(grouping)e +(table)h(HDU)i(then)e(the)h(mem)m(b)s(er)227 2014 y(\014le)h(is)f +(\014rst)h(op)s(ened)f(readwrite)h(and,)g(failing)e(this,)i(op)s(ened)f +(readonly)-8 b(.)95 2236 y Fe(int)47 b(fits_open_member)d(/)j(ffgmop) +286 2349 y(\(fitsfile)f(*gfptr,)f(long)i(member,)f(>)h(fitsfile)f +(**mfptr,)f(int)i(*status\))0 2570 y Fi(4)81 b Fj(Cop)m(y)27 +b(\(app)s(end\))f(a)i(mem)m(b)s(er)f(HDU)h(of)f(the)h(grouping)d(table) +j(p)s(oin)m(ted)e(to)i(b)m(y)f(gfptr.)39 b(The)27 b(mem)m(b)s(er)g(HDU) +h(is)227 2683 y(iden)m(ti\014ed)j(b)m(y)i(its)g(ro)m(w)g(n)m(um)m(b)s +(er)e(within)g(the)i(grouping)f(table)g(as)i(giv)m(en)f(b)m(y)f(the)i +(parameter)f('mem)m(b)s(er')227 2796 y(\(\014rst)j(mem)m(b)s(er)f(==)g +(1\).)58 b(The)35 b(cop)m(y)i(of)f(the)g(group)f(mem)m(b)s(er)g(HDU)i +(will)c(b)s(e)i(app)s(ended)f(to)j(the)f(FITS)227 2909 +y(\014le)28 b(p)s(oin)m(ted)g(to)h(b)m(y)f(mfptr,)h(and)f(up)s(on)f +(return)g(mfptr)h(shall)f(p)s(oin)m(t)g(to)j(the)f(copied)f(mem)m(b)s +(er)g(HDU.)h(The)227 3022 y(cp)s(opt)e(parameter)h(ma)m(y)g(tak)m(e)h +(on)e(the)g(follo)m(wing)f(v)-5 b(alues:)39 b(OPT)p 2465 +3022 28 4 v 32 w(MCP)p 2708 3022 V 32 w(ADD)29 b(whic)m(h)d(adds)g(a)i +(new)f(en)m(try)227 3135 y(in)c(gfptr)h(for)f(the)i(copied)e(mem)m(b)s +(er)h(HDU,)h(OPT)p 1907 3135 V 31 w(MCP)p 2149 3135 V +33 w(NADD)g(whic)m(h)e(do)s(es)h(not)g(add)f(an)h(en)m(try)h(in)d +(gfptr)227 3247 y(for)j(the)h(copied)e(mem)m(b)s(er,)i(and)f(OPT)p +1536 3247 V 32 w(MCP)p 1779 3247 V 32 w(REPL)g(whic)m(h)f(replaces)h +(the)g(original)e(mem)m(b)s(er)i(en)m(try)g(with)227 +3360 y(the)31 b(copied)f(mem)m(b)s(er)f(en)m(try)-8 b(.)95 +3582 y Fe(int)47 b(fits_copy_member)d(/)j(ffgmcp)286 +3695 y(\(fitsfile)f(*gfptr,)f(fitsfile)h(*mfptr,)g(long)g(member,)g +(int)h(cpopt,)f(>)i(int)f(*status\))0 3916 y Fi(5)81 +b Fj(T)-8 b(ransfer)34 b(a)i(group)f(mem)m(b)s(er)f(HDU)i(from)f(the)h +(grouping)e(table)h(p)s(oin)m(ted)f(to)i(b)m(y)f(infptr)f(to)i(the)f +(grouping)227 4029 y(table)h(p)s(oin)m(ted)f(to)i(b)m(y)f(outfptr.)58 +b(The)35 b(mem)m(b)s(er)h(HDU)h(to)f(transfer)g(is)f(iden)m(ti\014ed)f +(b)m(y)i(its)g(ro)m(w)g(n)m(um)m(b)s(er)227 4142 y(within)k(infptr)g +(as)j(sp)s(eci\014ed)e(b)m(y)h(the)h(parameter)g('mem)m(b)s(er')f +(\(\014rst)g(mem)m(b)s(er)g(==)f(1\).)78 b(If)42 b(tfopt)h(==)227 +4255 y(OPT)p 431 4255 V 32 w(MCP)p 674 4255 V 33 w(ADD)26 +b(then)f(the)h(mem)m(b)s(er)e(HDU)i(is)f(made)g(a)h(mem)m(b)s(er)f(of)g +(outfptr)g(and)g(remains)f(a)i(mem)m(b)s(er)227 4368 +y(of)34 b(infptr.)50 b(If)34 b(tfopt)g(==)g(OPT)p 1339 +4368 V 32 w(MCP)p 1582 4368 V 32 w(MO)m(V)h(then)f(the)g(mem)m(b)s(er)f +(HDU)i(is)e(deleted)h(from)f(infptr)f(after)227 4481 +y(the)f(transfer)f(to)h(outfptr.)95 4702 y Fe(int)47 +b(fits_transfer_member)c(/)k(ffgmtf)286 4815 y(\(fitsfile)f(*infptr,)f +(fitsfile)h(*outfptr,)f(long)i(member,)e(int)i(tfopt,)334 +4928 y(>)h(int)e(*status\))0 5149 y Fi(6)81 b Fj(Remo)m(v)m(e)31 +b(a)e(mem)m(b)s(er)g(HDU)h(from)f(the)h(grouping)e(table)h(p)s(oin)m +(ted)f(to)i(b)m(y)g(gfptr.)40 b(The)29 b(mem)m(b)s(er)f(HDU)i(to)h(b)s +(e)227 5262 y(deleted)36 b(is)e(iden)m(ti\014ed)g(b)m(y)h(its)g(ro)m(w) +h(n)m(um)m(b)s(er)f(in)f(the)i(grouping)e(table)h(as)h(sp)s(eci\014ed)e +(b)m(y)i(the)f(parameter)227 5375 y('mem)m(b)s(er')41 +b(\(\014rst)g(mem)m(b)s(er)g(==)f(1\).)74 b(The)41 b(rmopt)g(parameter) +h(ma)m(y)f(tak)m(e)i(on)e(the)h(follo)m(wing)d(v)-5 b(alues:)227 +5488 y(OPT)p 431 5488 V 32 w(RM)p 613 5488 V 33 w(ENTR)d(Y)34 +b(whic)m(h)d(remo)m(v)m(es)k(the)e(mem)m(b)s(er)g(HDU)h(en)m(try)f +(from)g(the)g(grouping)f(table)h(and)g(up-)227 5601 y(dates)40 +b(the)f(mem)m(b)s(er's)f(GRPIDn/GRPLCn)g(k)m(eyw)m(ords,)k(and)c(OPT)p +2687 5601 V 32 w(RM)p 2869 5601 V 33 w(MBR)h(whic)m(h)f(remo)m(v)m(es)i +(the)227 5714 y(mem)m(b)s(er)30 b(HDU)h(en)m(try)g(from)f(the)g +(grouping)f(table)i(and)e(deletes)i(the)f(mem)m(b)s(er)g(HDU)h(itself.) +p eop +%%Page: 80 88 +80 87 bop 0 299 a Fj(80)1338 b Fh(CHAPTER)29 b(8.)112 +b(HIERAR)m(CHICAL)30 b(GR)m(OUPING)h(R)m(OUTINES)95 555 +y Fe(int)47 b(fits_remove_member)c(/)48 b(ffgmrm)286 +668 y(\(fitsfile)e(*fptr,)g(long)g(member,)g(int)h(rmopt,)f(>)i(int)f +(*status\))p eop +%%Page: 81 89 +81 88 bop 0 1225 a Fg(Chapter)65 b(9)0 1687 y Fm(Sp)6 +b(ecialized)77 b(CFITSIO)f(In)-6 b(terface)0 1937 y(Routines)0 +2429 y Fj(The)28 b(basic)g(in)m(terface)i(routines)e(describ)s(ed)e +(previously)h(are)i(recommended)f(for)h(most)g(uses,)g(but)f(the)h +(routines)0 2542 y(describ)s(ed)g(in)g(this)h(c)m(hapter)h(are)h(also)e +(a)m(v)-5 b(ailable)31 b(if)e(necessary)-8 b(.)43 b(Some)31 +b(of)g(these)g(routines)f(p)s(erform)f(more)i(sp)s(e-)0 +2655 y(cialized)26 b(function)f(that)j(cannot)f(easily)f(b)s(e)g(done)h +(with)e(the)i(basic)g(in)m(terface)g(routines)f(while)e(others)j +(duplicate)0 2767 y(the)j(functionalit)m(y)f(of)h(the)g(basic)g +(routines)f(but)g(ha)m(v)m(e)i(a)g(sligh)m(tly)d(di\013eren)m(t)i +(calling)e(sequence.)41 b(See)31 b(App)s(endix)0 2880 +y(B)g(for)f(the)g(de\014nition)e(of)j(eac)m(h)h(function)d(parameter.)0 +3210 y Ff(9.1)135 b(FITS)44 b(File)i(Access)e(Routines)0 +3446 y Fi(1)81 b Fj(Op)s(en)37 b(an)i(existing)g(FITS)f(\014le)g +(residing)f(in)h(core)i(computer)f(memory)-8 b(.)68 b(This)37 +b(routine)h(is)h(analogous)g(to)227 3559 y(\014ts)p 354 +3559 28 4 v 33 w(op)s(en)p 577 3559 V 32 w(\014le.)54 +b(The)35 b('\014lename')f(is)g(curren)m(tly)h(ignored)f(b)m(y)h(this)f +(routine)g(and)h(ma)m(y)g(b)s(e)g(an)m(y)g(arbitrary)227 +3672 y(string.)77 b(In)42 b(general,)k(the)d(application)e(m)m(ust)i +(ha)m(v)m(e)h(preallo)s(cated)e(an)g(initial)e(blo)s(c)m(k)j(of)g +(memory)f(to)227 3785 y(hold)h(the)i(FITS)f(\014le)g(prior)f(to)i +(calling)e(this)g(routine:)69 b('memptr')44 b(p)s(oin)m(ts)f(to)j(the)e +(starting)h(address)227 3898 y(and)39 b('memsize')h(giv)m(es)g(the)g +(initial)d(size)i(of)h(the)g(blo)s(c)m(k)f(of)h(memory)-8 +b(.)69 b('mem)p 2958 3898 V 33 w(reallo)s(c')39 b(is)g(a)h(p)s(oin)m +(ter)e(to)227 4011 y(an)d(optional)g(function)e(that)j(CFITSIO)e(can)h +(call)f(to)i(allo)s(cate)g(additional)d(memory)-8 b(,)37 +b(if)d(needed)g(\(only)227 4124 y(if)40 b(mo)s(de)f(=)h(READ)m +(WRITE\),)i(and)e(is)f(mo)s(deled)g(after)i(the)f(standard)g(C)g +('reallo)s(c')g(function;)k(a)d(n)m(ull)227 4237 y(p)s(oin)m(ter)f(ma)m +(y)h(b)s(e)f(giv)m(en)h(if)e(the)i(initial)d(allo)s(cation)i(of)h +(memory)f(is)g(all)f(that)i(will)d(b)s(e)i(required)f(\(e.g.,)227 +4350 y(if)34 b(the)h(\014le)f(is)g(op)s(ened)g(with)g(mo)s(de)g(=)h +(READONL)-8 b(Y\).)36 b(The)e('deltasize')h(parameter)g(ma)m(y)h(b)s(e) +e(used)g(to)227 4463 y(suggest)g(a)f(minim)m(um)d(amoun)m(t)j(of)g +(additional)e(memory)i(that)g(should)e(b)s(e)h(allo)s(cated)h(during)e +(eac)m(h)j(call)227 4575 y(to)d(the)f(memory)f(reallo)s(cation)g +(function.)39 b(By)30 b(default,)f(CFITSIO)f(will)f(reallo)s(cate)k +(enough)e(additional)227 4688 y(space)44 b(to)g(hold)e(the)i(en)m(tire) +f(curren)m(tly)f(de\014ned)h(FITS)f(\014le)h(\(as)g(giv)m(en)h(b)m(y)f +(the)h(NAXISn)e(k)m(eyw)m(ords\))227 4801 y(or)g(1)f(FITS)g(blo)s(c)m +(k)g(\(=)g(2880)i(b)m(ytes\),)i(whic)m(h)c(ev)m(er)h(is)e(larger.)73 +b(V)-8 b(alues)42 b(of)f(deltasize)g(less)g(than)g(2880)227 +4914 y(will)28 b(b)s(e)i(ignored.)41 b(Since)30 b(the)h(memory)g +(reallo)s(cation)f(op)s(eration)g(can)h(b)s(e)f(computationally)f(exp)s +(ensiv)m(e,)227 5027 y(allo)s(cating)24 b(a)h(larger)f(initial)e(blo)s +(c)m(k)i(of)h(memory)-8 b(,)26 b(and/or)f(sp)s(ecifying)d(a)j(larger)g +(deltasize)f(v)-5 b(alue)24 b(ma)m(y)h(help)227 5140 +y(to)31 b(reduce)g(the)f(n)m(um)m(b)s(er)f(of)i(reallo)s(cation)e +(calls)h(and)g(mak)m(e)h(the)g(application)d(program)i(run)f(faster.)95 +5375 y Fe(int)47 b(fits_open_memfile)c(/)48 b(ffomem)286 +5488 y(\(fitsfile)e(**fptr,)f(const)i(char)f(*filename,)f(int)i(mode,)g +(void)f(**memptr,)334 5601 y(size_t)g(*memsize,)f(size_t)i(deltasize,) +334 5714 y(void)g(*\(*mem_realloc\)\(void)42 b(*p,)47 +b(size_t)f(newsize\),)f(int)i(*status\))1905 5942 y Fj(81)p +eop +%%Page: 82 90 +82 89 bop 0 299 a Fj(82)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(2)81 b Fj(Create)49 b(a)g(new)f(FITS)g(\014le)g(residing)e(in) +i(core)h(computer)g(memory)-8 b(.)96 b(This)47 b(routine)g(is)h +(analogous)h(to)227 668 y(\014ts)p 354 668 28 4 v 33 +w(create)p 623 668 V 34 w(\014le.)39 b(In)29 b(general,)h(the)f +(application)e(m)m(ust)i(ha)m(v)m(e)i(preallo)s(cated)e(an)g(initial)d +(blo)s(c)m(k)j(of)g(memory)227 781 y(to)38 b(hold)d(the)i(FITS)f +(\014le)g(prior)f(to)i(calling)f(this)f(routine:)53 b('memptr')36 +b(p)s(oin)m(ts)g(to)h(the)g(starting)g(address)227 894 +y(and)i('memsize')h(giv)m(es)g(the)g(initial)d(size)i(of)h(the)g(blo)s +(c)m(k)f(of)h(memory)-8 b(.)69 b('mem)p 2958 894 V 33 +w(reallo)s(c')39 b(is)g(a)h(p)s(oin)m(ter)e(to)227 1007 +y(an)g(optional)e(function)g(that)i(CFITSIO)e(can)i(call)f(to)h(allo)s +(cate)g(additional)d(memory)-8 b(,)40 b(if)c(needed,)k(and)227 +1120 y(is)33 b(mo)s(deled)f(after)i(the)g(standard)f(C)g('reallo)s(c')g +(function;)h(a)g(n)m(ull)d(p)s(oin)m(ter)i(ma)m(y)h(b)s(e)f(giv)m(en)g +(if)g(the)h(initial)227 1233 y(allo)s(cation)f(of)g(memory)g(is)g(all)f +(that)i(will)c(b)s(e)j(required.)47 b(The)33 b('deltasize')h(parameter) +f(ma)m(y)h(b)s(e)f(used)f(to)227 1346 y(suggest)i(a)f(minim)m(um)d +(amoun)m(t)j(of)g(additional)e(memory)i(that)g(should)e(b)s(e)h(allo)s +(cated)h(during)e(eac)m(h)j(call)227 1458 y(to)d(the)f(memory)f(reallo) +s(cation)g(function.)39 b(By)30 b(default,)f(CFITSIO)f(will)f(reallo)s +(cate)k(enough)e(additional)227 1571 y(space)k(to)g(hold)e(1)h(FITS)g +(blo)s(c)m(k)f(\(=)h(2880)i(b)m(ytes\))f(and)f(v)-5 b(alues)31 +b(of)i(deltasize)f(less)f(than)h(2880)i(will)29 b(b)s(e)j(ig-)227 +1684 y(nored.)39 b(Since)24 b(the)i(memory)f(reallo)s(cation)f(op)s +(eration)h(can)h(b)s(e)f(computationally)f(exp)s(ensiv)m(e,)i(allo)s +(cating)227 1797 y(a)h(larger)f(initial)d(blo)s(c)m(k)j(of)g(memory)-8 +b(,)28 b(and/or)e(sp)s(ecifying)e(a)i(larger)g(deltasize)g(v)-5 +b(alue)26 b(ma)m(y)h(help)d(to)j(reduce)227 1910 y(the)k(n)m(um)m(b)s +(er)e(of)h(reallo)s(cation)g(calls)g(and)f(mak)m(e)j(the)e(application) +f(program)h(run)f(faster.)95 2147 y Fe(int)47 b(fits_create_memfile)c +(/)k(ffimem)286 2260 y(\(fitsfile)f(**fptr,)f(void)i(**memptr,)334 +2373 y(size_t)f(*memsize,)f(size_t)i(deltasize,)334 2486 +y(void)g(*\(*mem_realloc\)\(void)42 b(*p,)47 b(size_t)f(newsize\),)f +(int)i(*status\))0 2723 y Fi(3)81 b Fj(Reop)s(en)34 b(a)i(FITS)e +(\014le)g(that)i(w)m(as)f(previously)e(op)s(ened)i(with)e(\014ts)p +2414 2723 V 33 w(op)s(en)p 2637 2723 V 32 w(\014le)h(or)h(\014ts)p +3058 2723 V 33 w(create)p 3327 2723 V 34 w(\014le.)54 +b(The)34 b(new)227 2836 y(\014ts\014le)h(p)s(oin)m(ter)h(ma)m(y)h(then) +f(b)s(e)f(treated)j(as)e(a)h(separate)g(\014le,)g(and)f(one)h(ma)m(y)g +(sim)m(ultaneously)d(read)i(or)227 2949 y(write)d(to)i(2)f(\(or)g +(more\))g(di\013eren)m(t)f(extensions)g(in)g(the)h(same)g(\014le.)50 +b(The)33 b(\014ts)p 2886 2949 V 32 w(op)s(en)p 3108 2949 +V 32 w(\014le)g(routine)g(\(ab)s(o)m(v)m(e\))227 3061 +y(automatically)i(detects)i(cases)f(where)e(a)i(previously)d(op)s(ened) +h(\014le)h(is)f(b)s(eing)g(op)s(ened)g(again,)j(and)d(then)227 +3174 y(in)m(ternally)29 b(call)g(\014ts)p 930 3174 V +33 w(reop)s(en)p 1229 3174 V 32 w(\014le,)h(so)g(programs)g(should)f +(rarely)g(need)h(to)h(explicitly)d(call)i(this)f(routine.)95 +3411 y Fe(int)47 b(fits_reopen_file)d(/)j(ffreopen)286 +3524 y(\(fitsfile)f(*openfptr,)f(fitsfile)g(**newfptr,)g(>)j(int)f +(*status\))0 3761 y Fi(4)81 b Fj(Create)24 b(a)g(new)f(FITS)g(\014le,)h +(using)e(a)i(template)g(\014le)e(to)j(de\014ne)d(its)h(initial)e(size)j +(and)f(structure.)37 b(The)24 b(template)227 3874 y(ma)m(y)i(b)s(e)f +(another)g(FITS)g(HDU)h(or)f(an)g(ASCI)s(I)f(template)i(\014le.)38 +b(If)25 b(the)g(input)f(template)h(\014le)g(name)g(p)s(oin)m(ter)227 +3987 y(is)i(n)m(ull,)g(then)g(this)g(routine)f(b)s(eha)m(v)m(es)j(the)f +(same)g(as)g(\014ts)p 2160 3987 V 32 w(create)p 2428 +3987 V 35 w(\014le.)39 b(The)27 b(curren)m(tly)g(supp)s(orted)f(format) +227 4100 y(of)33 b(the)g(ASCI)s(I)e(template)i(\014le)e(is)h(describ)s +(ed)e(under)h(the)i(\014ts)p 2350 4100 V 33 w(parse)p +2591 4100 V 32 w(template)g(routine)f(\(in)f(the)i(general)227 +4213 y(Utilities)c(section\))95 4450 y Fe(int)47 b +(fits_create_template)c(/)k(fftplt)286 4563 y(\(fitsfile)f(**fptr,)f +(char)i(*filename,)e(char)i(*tpltfile)e(>)i(int)g(*status\))0 +4799 y Fi(5)81 b Fj(P)m(arse)28 b(the)f(input)f(\014lename)g(or)i(URL)f +(in)m(to)g(its)g(comp)s(onen)m(t)h(parts:)39 b(the)27 +b(\014le)g(t)m(yp)s(e)h(\(\014le://,)g(ftp://,)h(h)m(ttp://,)227 +4912 y(etc\),)34 b(the)e(base)g(input)d(\014le)i(name,)h(the)g(name)g +(of)g(the)g(output)f(\014le)g(that)h(the)g(input)e(\014le)g(is)h(to)h +(b)s(e)f(copied)227 5025 y(to)38 b(prior)d(to)i(op)s(ening,)g(the)g +(HDU)g(or)f(extension)h(sp)s(eci\014cation,)g(the)g(\014ltering)d(sp)s +(eci\014er,)j(the)g(binning)227 5138 y(sp)s(eci\014er,)27 +b(and)h(the)g(column)f(sp)s(eci\014er.)38 b(Null)26 b(strings)h(will)e +(b)s(e)j(returned)f(for)g(an)m(y)i(comp)s(onen)m(ts)f(that)h(are)227 +5251 y(not)i(presen)m(t)f(in)f(the)i(input)d(\014le)i(name.)95 +5488 y Fe(int)47 b(fits_parse_input_url)c(/)k(ffiurl)286 +5601 y(\(char)g(*filename,)e(>)i(char)g(*filetype,)e(char)h(*infile,)g +(char)h(*outfile,)e(char)334 5714 y(*extspec,)g(char)i(*filter,)f(char) +g(*binspec,)f(char)i(*colspec,)e(int)i(*status\))p eop +%%Page: 83 91 +83 90 bop 0 299 a Fh(9.1.)72 b(FITS)30 b(FILE)g(A)m(CCESS)f(R)m +(OUTINES)2244 b Fj(83)0 555 y Fi(6)81 b Fj(P)m(arse)33 +b(the)f(input)f(\014lename)h(and)f(return)h(the)h(HDU)g(n)m(um)m(b)s +(er)e(that)i(w)m(ould)e(b)s(e)h(mo)m(v)m(ed)i(to)f(if)e(the)i(\014le)e +(w)m(ere)227 668 y(op)s(ened)i(with)f(\014ts)p 878 668 +28 4 v 32 w(op)s(en)p 1100 668 V 32 w(\014le.)48 b(The)33 +b(returned)f(HDU)i(n)m(um)m(b)s(er)e(b)s(egins)g(with)g(1)h(for)g(the)g +(primary)f(arra)m(y)-8 b(,)227 781 y(so)40 b(for)f(example,)j(if)c(the) +i(input)d(\014lename)i(=)g(`m)m(y\014le.\014ts[2]')h(then)f(hdun)m(um)e +(=)i(3)h(will)d(b)s(e)i(returned.)227 894 y(CFITSIO)j(do)s(es)i(not)g +(op)s(en)f(the)g(\014le)g(to)i(c)m(hec)m(k)g(if)d(the)i(extension)g +(actually)f(exists)g(if)g(an)g(extension)227 1007 y(n)m(um)m(b)s(er)e +(is)h(sp)s(eci\014ed.)74 b(If)42 b(an)g(extension)g(name)g(is)g +(included)d(in)i(the)i(\014le)e(name)h(sp)s(eci\014cation)f(\(e.g.)227 +1120 y(`m)m(y\014le.\014ts[EVENTS]')j(then)f(this)g(routine)g(will)f +(ha)m(v)m(e)j(to)f(op)s(en)g(the)g(FITS)f(\014le)g(and)g(lo)s(ok)h(for) +g(the)227 1233 y(p)s(osition)29 b(of)h(the)h(named)f(extension,)h(then) +f(close)h(\014le)e(again.)41 b(This)29 b(is)g(not)i(p)s(ossible)d(if)i +(the)g(\014le)g(is)f(b)s(eing)227 1346 y(read)34 b(from)f(the)h(stdin)e +(stream,)j(and)f(an)f(error)g(will)f(b)s(e)h(returned)f(in)h(this)f +(case.)52 b(If)33 b(the)h(\014lename)f(do)s(es)227 1458 +y(not)42 b(sp)s(ecify)f(an)h(explicit)e(extension)i(\(e.g.)76 +b('m)m(y\014le.\014ts'\))42 b(then)g(hdun)m(um)e(=)h(-99)i(will)d(b)s +(e)h(returned,)227 1571 y(whic)m(h)34 b(is)g(functionally)f(equiv)-5 +b(alen)m(t)34 b(to)i(hdun)m(um)d(=)h(1.)55 b(This)33 +b(routine)h(is)g(mainly)g(used)g(for)g(bac)m(kw)m(ard)227 +1684 y(compatibilit)m(y)h(in)h(the)g(fto)s(ols)h(soft)m(w)m(are)h(pac)m +(k)-5 b(age)39 b(and)d(is)f(not)i(recommended)g(for)f(general)h(use.)59 +b(It)37 b(is)227 1797 y(generally)i(b)s(etter)g(and)g(more)g(e\016cien) +m(t)h(to)g(\014rst)e(op)s(en)h(the)g(FITS)g(\014le)f(with)g(\014ts)p +3125 1797 V 32 w(op)s(en)p 3347 1797 V 33 w(\014le,)i(then)f(use)227 +1910 y(\014ts)p 354 1910 V 33 w(get)p 507 1910 V 34 w(hdu)p +694 1910 V 31 w(n)m(um)c(to)i(determine)f(whic)m(h)f(HDU)i(in)e(the)i +(\014le)e(has)h(b)s(een)g(op)s(ened,)h(rather)f(than)g(calling)227 +2023 y(\014ts)p 354 2023 V 33 w(parse)p 595 2023 V 32 +w(input)p 841 2023 V 31 w(url)29 b(follo)m(w)m(ed)h(b)m(y)g(a)h(call)e +(to)j(\014ts)p 1967 2023 V 32 w(op)s(en)p 2189 2023 V +32 w(\014le.)143 2280 y Fe(int)47 b(fits_parse_extnum)c(/)48 +b(ffextn)334 2393 y(\(char)e(*filename,)f(>)j(int)f(*hdunum,)e(int)i +(*status\))0 2650 y Fi(7)81 b Fj(P)m(arse)45 b(the)g(input)d(\014le)i +(name)h(and)f(return)f(the)i(ro)s(ot)g(\014le)f(name.)83 +b(The)44 b(ro)s(ot)h(name)g(includes)d(the)j(\014le)227 +2763 y(t)m(yp)s(e)35 b(if)f(sp)s(eci\014ed,)h(\(e.g.)56 +b('ftp://')37 b(or)e('h)m(ttp://'\))i(and)d(the)h(full)e(path)i(name,)h +(to)g(the)f(exten)m(t)i(that)e(it)g(is)227 2875 y(sp)s(eci\014ed)25 +b(in)f(the)j(input)d(\014lename.)38 b(It)26 b(do)s(es)g(not)g(include)e +(the)i(HDU)h(name)f(or)g(n)m(um)m(b)s(er,)g(or)g(an)m(y)h(\014ltering) +227 2988 y(sp)s(eci\014cations.)143 3245 y Fe(int)47 +b(fits_parse_rootname)c(/)k(ffrtnm)334 3358 y(\(char)f(*filename,)f(>)j +(char)f(*rootname,)e(int)h(*status\);)0 3615 y Fi(8)81 +b Fj(T)-8 b(est)37 b(if)e(the)i(input)e(\014le)h(or)g(a)h(compressed)g +(v)m(ersion)f(of)h(the)g(\014le)e(\(with)h(a)h(.gz,)j(.Z,)c(.z,)j(or)e +(.zip)f(extension\))227 3728 y(exists)i(on)g(disk.)62 +b(The)37 b(returned)g(v)-5 b(alue)37 b(of)h(the)h('exists')f(parameter) +g(will)d(ha)m(v)m(e)40 b(1)e(of)g(the)g(4)g(follo)m(wing)227 +3841 y(v)-5 b(alues:)370 4087 y Fe(2:)95 b(the)47 b(file)g(does)g(not)f +(exist,)h(but)f(a)i(compressed)d(version)h(does)g(exist)370 +4200 y(1:)95 b(the)47 b(disk)g(file)g(does)f(exist)370 +4313 y(0:)95 b(neither)46 b(the)h(file)g(nor)g(a)g(compressed)e +(version)h(of)h(the)g(file)g(exist)323 4426 y(-1:)94 +b(the)47 b(input)g(file)f(name)h(is)g(not)g(a)g(disk)g(file)g(\(could)f +(be)h(a)g(ftp,)g(http,)561 4539 y(smem,)g(or)g(mem)g(file,)f(or)h(a)h +(file)e(piped)h(in)g(on)g(the)g(STDIN)f(stream\))143 +4892 y(int)h(fits_file_exists)c(/)48 b(ffexist)334 5005 +y(\(char)e(*filename,)f(>)j(int)f(*exists,)e(int)i(*status\);)0 +5262 y Fi(9)81 b Fj(Flush)35 b(an)m(y)j(in)m(ternal)e(bu\013ers)g(of)i +(data)g(to)g(the)f(output)g(FITS)g(\014le.)61 b(These)37 +b(routines)f(rarely)g(need)h(to)i(b)s(e)227 5375 y(called,)g(but)d(can) +i(b)s(e)f(useful)e(in)h(cases)j(where)d(other)i(pro)s(cesses)f(need)g +(to)h(access)h(the)f(same)f(FITS)g(\014le)227 5488 y(in)i(real)i(time,) +h(either)e(on)h(disk)e(or)h(in)f(memory)-8 b(.)71 b(These)41 +b(routines)e(also)h(help)f(to)j(ensure)d(that)i(if)f(the)227 +5601 y(application)34 b(program)g(subsequen)m(tly)g(ab)s(orts)g(then)h +(the)g(FITS)f(\014le)g(will)e(ha)m(v)m(e)37 b(b)s(een)d(closed)g(prop)s +(erly)-8 b(.)227 5714 y(The)43 b(\014rst)g(routine,)j(\014ts)p +1110 5714 V 33 w(\015ush)p 1332 5714 V 31 w(\014le)c(is)h(more)g +(rigorous)g(and)g(completely)g(closes,)k(then)d(reop)s(ens,)i(the)p +eop +%%Page: 84 92 +84 91 bop 0 299 a Fj(84)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)227 +555 y Fj(curren)m(t)h(HDU,)h(b)s(efore)e(\015ushing)f(the)i(in)m +(ternal)e(bu\013ers,)h(th)m(us)h(ensuring)e(that)i(the)g(output)g(FITS) +f(\014le)g(is)227 668 y(iden)m(tical)35 b(to)h(what)f(w)m(ould)g(b)s(e) +g(pro)s(duced)f(if)g(the)i(FITS)f(w)m(as)h(closed)f(at)h(that)g(p)s +(oin)m(t)f(\(i.e.,)i(with)e(a)h(call)227 781 y(to)g(\014ts)p +470 781 28 4 v 33 w(close)p 690 781 V 33 w(\014le\).)55 +b(The)35 b(second)g(routine,)h(\014ts)p 1912 781 V 33 +w(\015ush)p 2134 781 V 31 w(bu\013er)e(simply)f(\015ushes)h(the)h(in)m +(ternal)f(CFITSIO)227 894 y(bu\013ers)28 b(of)h(data)h(to)f(the)h +(output)e(FITS)g(\014le,)h(without)f(up)s(dating)f(and)h(closing)g(the) +h(curren)m(t)g(HDU.)h(This)227 1007 y(is)36 b(m)m(uc)m(h)h(faster,)i +(but)e(there)g(ma)m(y)g(b)s(e)f(circumstances)h(where)f(the)h +(\015ushed)f(\014le)g(do)s(es)g(not)h(completely)227 +1120 y(re\015ect)31 b(the)g(\014nal)e(state)j(of)e(the)h(\014le)e(as)i +(it)f(will)d(exist)k(when)e(the)h(\014le)g(is)f(actually)h(closed.)227 +1266 y(A)h(t)m(ypical)f(use)g(of)h(these)g(routines)e(w)m(ould)g(b)s(e) +h(to)h(\015ush)e(the)h(state)i(of)f(a)g(FITS)e(table)i(to)g(disk)e +(after)i(eac)m(h)227 1379 y(ro)m(w)36 b(of)f(the)h(table)f(is)f +(written.)54 b(It)36 b(is)e(recommend)h(that)h(\014ts)p +2392 1379 V 32 w(\015ush)p 2613 1379 V 32 w(\014le)e(b)s(e)h(called)f +(after)i(the)f(\014rst)g(ro)m(w)227 1492 y(is)j(written,)i(then)e +(\014ts)p 1023 1492 V 32 w(\015ush)p 1244 1492 V 31 w(bu\013er)g(ma)m +(y)h(b)s(e)f(called)f(after)i(eac)m(h)h(subsequen)m(t)e(ro)m(w)g(is)g +(written.)64 b(Note)227 1605 y(that)40 b(this)e(latter)h(routine)f +(will)e(not)j(automatically)g(up)s(date)f(the)h(NAXIS2)g(k)m(eyw)m(ord) +h(whic)m(h)d(records)227 1718 y(the)d(n)m(um)m(b)s(er)d(of)i(ro)m(ws)h +(of)f(data)g(in)f(the)h(table,)h(so)g(this)e(k)m(eyw)m(ord)h(m)m(ust)g +(b)s(e)f(explicitly)f(up)s(dated)h(b)m(y)h(the)227 1831 +y(application)c(program)h(after)h(eac)m(h)h(ro)m(w)e(is)f(written.)95 +2067 y Fe(int)47 b(fits_flush_file)d(/)j(ffflus)286 2180 +y(\(fitsfile)f(*fptr,)g(>)h(int)g(*status\))95 2406 y(int)g +(fits_flush_buffer)c(/)48 b(ffflsh)286 2519 y(\(fitsfile)e(*fptr,)g(0,) +h(>)g(int)g(*status\))286 2745 y(\(Note:)94 b(The)47 +b(second)f(argument)g(must)g(be)i(0\).)0 3075 y Ff(9.2)135 +b(HDU)46 b(Access)e(Routines)0 3311 y Fi(1)81 b Fj(Get)28 +b(the)f(b)m(yte)h(o\013sets)g(in)e(the)h(FITS)f(\014le)h(to)g(the)h +(start)g(of)f(the)g(header)g(and)g(the)g(start)h(and)e(end)h(of)g(the)g +(data)227 3424 y(in)33 b(the)h(CHDU.)g(The)f(di\013erence)g(b)s(et)m(w) +m(een)i(headstart)f(and)f(dataend)h(equals)f(the)h(size)f(of)h(the)g +(CHDU.)227 3537 y(If)e(the)h(CHDU)f(is)g(the)g(last)g(HDU)h(in)e(the)i +(\014le,)f(then)g(dataend)g(is)f(also)i(equal)e(to)i(the)g(size)f(of)h +(the)f(en)m(tire)227 3650 y(FITS)25 b(\014le.)38 b(Null)24 +b(p)s(oin)m(ters)g(ma)m(y)i(b)s(e)f(input)e(for)j(an)m(y)f(of)h(the)g +(address)e(parameters)i(if)f(their)f(v)-5 b(alues)25 +b(are)h(not)227 3763 y(needed.)54 b(The)34 b(\014ts)p +897 3763 V 32 w(get)p 1049 3763 V 34 w(hduaddr)e(routine)i(is)g +(obsolete)h(and)f(should)f(no)i(longer)f(b)s(e)g(used.)53 +b(The)34 b(new)m(er)227 3876 y(\014ts)p 354 3876 V 33 +w(get)p 507 3876 V 34 w(hduo\013)24 b(routine)h(uses)g(the)h('o\013)p +1588 3876 V 33 w(t')g(data)h(t)m(yp)s(e)f(whic)m(h)e(can)i(supp)s(ort)e +(o\013sets)i(in)e(large)i(\014les)f(greater)227 3988 +y(than)30 b(2.1GB)j(in)c(size.)95 4225 y Fe(int)47 b(fits_get_hduoff)d +(/)j(ffghof)334 4338 y(\(fitsfile)e(*fptr,)h(>)i(off_t)e(*headstart,)f +(off_t)h(*datastart,)f(off_t)h(*dataend,)382 4451 y(int)h(*status\))95 +4676 y(int)g(fits_get_hduaddr)d(/)j(ffghad)94 b(\(OBSOLETE)45 +b(routine\))334 4789 y(\(fitsfile)g(*fptr,)h(>)i(long)f(*headstart,)d +(long)j(*datastart,)e(long)h(*dataend,)382 4902 y(int)h(*status\))0 +5139 y Fi(2)81 b Fj(Create)31 b(\(app)s(end\))f(a)i(new)e(empt)m(y)i +(HDU)f(at)h(the)f(end)f(of)i(the)f(FITS)f(\014le.)41 +b(This)30 b(is)g(no)m(w)h(the)g(CHDU)g(but)f(it)227 5252 +y(is)h(completely)f(empt)m(y)i(and)f(has)g(no)g(header)g(k)m(eyw)m +(ords.)43 b(It)32 b(is)e(recommended)h(that)h(\014ts)p +3344 5252 V 32 w(create)p 3612 5252 V 34 w(img)f(or)227 +5365 y(\014ts)p 354 5365 V 33 w(create)p 623 5365 V 34 +w(tbl)e(b)s(e)h(used)g(instead)f(of)i(this)e(routine.)95 +5601 y Fe(int)47 b(fits_create_hdu)d(/)j(ffcrhd)286 5714 +y(\(fitsfile)f(*fptr,)g(>)h(int)g(*status\))p eop +%%Page: 85 93 +85 92 bop 0 299 a Fh(9.2.)72 b(HDU)31 b(A)m(CCESS)e(R)m(OUTINES)2488 +b Fj(85)0 555 y Fi(3)81 b Fj(Insert)22 b(a)h(new)g(IMA)m(GE)h +(extension)e(immediately)g(follo)m(wing)f(the)i(CHDU,)h(or)f(insert)f +(a)h(new)f(Primary)g(Arra)m(y)227 668 y(at)30 b(the)e(b)s(eginning)e +(of)j(the)g(\014le.)39 b(An)m(y)29 b(follo)m(wing)e(extensions)h(in)g +(the)g(\014le)g(will)e(b)s(e)i(shifted)f(do)m(wn)i(to)g(mak)m(e)227 +781 y(ro)s(om)36 b(for)h(the)f(new)g(extension.)58 b(If)36 +b(the)h(CHDU)g(is)e(the)i(last)f(HDU)h(in)e(the)i(\014le)e(then)h(the)h +(new)f(image)227 894 y(extension)30 b(will)e(simply)f(b)s(e)j(app)s +(ended)e(to)j(the)f(end)g(of)g(the)g(\014le.)40 b(One)30 +b(can)g(force)h(a)g(new)e(primary)f(arra)m(y)227 1007 +y(to)35 b(b)s(e)d(inserted)h(at)h(the)g(b)s(eginning)d(of)i(the)h(FITS) +f(\014le)f(b)m(y)i(setting)g(status)f(=)h(PREPEND)p 3432 +1007 28 4 v 32 w(PRIMAR)-8 b(Y)227 1120 y(prior)24 b(to)h(calling)f +(the)h(routine.)37 b(In)25 b(this)e(case)j(the)f(old)f(primary)f(arra)m +(y)j(will)c(b)s(e)i(con)m(v)m(erted)j(to)e(an)g(IMA)m(GE)227 +1233 y(extension.)48 b(The)32 b(new)g(extension)h(\(or)g(primary)e +(arra)m(y\))i(will)e(b)s(ecome)i(the)g(CHDU.)g(Refer)g(to)h(Chapter)227 +1346 y(9)d(for)f(a)h(list)e(of)h(pre-de\014ned)f(bitpix)g(v)-5 +b(alues.)95 1605 y Fe(int)47 b(fits_insert_img)d(/)j(ffiimg)286 +1718 y(\(fitsfile)f(*fptr,)g(int)h(bitpix,)e(int)i(naxis,)f(long)h +(*naxes,)f(>)h(int)g(*status\))0 1978 y Fi(4)81 b Fj(Insert)30 +b(a)g(new)g(ASCI)s(I)f(or)i(binary)e(table)h(extension)g(immediately)f +(follo)m(wing)g(the)i(CHDU.)g(An)m(y)f(follo)m(wing)227 +2091 y(extensions)35 b(will)e(b)s(e)i(shifted)f(do)m(wn)h(to)h(mak)m(e) +g(ro)s(om)g(for)f(the)g(new)g(extension.)56 b(If)35 b(there)h(are)f(no) +h(other)227 2204 y(follo)m(wing)29 b(extensions)i(then)f(the)h(new)f +(table)g(extension)h(will)d(simply)g(b)s(e)i(app)s(ended)f(to)i(the)g +(end)f(of)h(the)227 2317 y(\014le.)41 b(If)30 b(the)h(FITS)f(\014le)f +(is)h(curren)m(tly)g(empt)m(y)h(then)f(this)f(routine)h(will)e(create)k +(a)f(dumm)m(y)f(primary)e(arra)m(y)227 2430 y(b)s(efore)j(app)s(ending) +e(the)j(table)g(to)g(it.)43 b(The)31 b(new)g(extension)h(will)c(b)s +(ecome)k(the)g(CHDU.)g(The)f(tunit)g(and)227 2543 y(extname)39 +b(parameters)g(are)f(optional)g(and)g(a)g(n)m(ull)e(p)s(oin)m(ter)i(ma) +m(y)g(b)s(e)g(giv)m(en)g(if)f(they)i(are)f(not)h(de\014ned.)227 +2656 y(When)32 b(inserting)e(an)i(ASCI)s(I)f(table)h(with)e(\014ts)p +1847 2656 V 33 w(insert)p 2104 2656 V 32 w(atbl,)i(a)g(n)m(ull)e(p)s +(oin)m(ter)h(ma)m(y)i(giv)m(en)f(for)g(the)g(*tb)s(col)227 +2769 y(parameter)23 b(in)e(whic)m(h)h(case)h(eac)m(h)h(column)d(of)i +(the)g(table)f(will)e(b)s(e)i(separated)h(b)m(y)f(a)h(single)e(space)i +(c)m(haracter.)227 2882 y(Similarly)-8 b(,)25 b(if)g(the)i(input)e(v)-5 +b(alue)26 b(of)h(ro)m(wlen)f(is)f(0,)j(then)f(CFITSIO)e(will)f +(calculate)j(the)g(default)e(ro)m(wlength)227 2994 y(based)40 +b(on)h(the)g(tb)s(col)e(and)h(tt)m(yp)s(e)h(v)-5 b(alues.)71 +b(When)40 b(inserting)f(a)i(binary)d(table)j(with)e(\014ts)p +3430 2994 V 32 w(insert)p 3686 2994 V 32 w(btbl,)227 +3107 y(if)g(there)i(are)f(follo)m(wing)f(extensions)h(in)f(the)h +(\014le)f(and)h(if)f(the)h(table)g(con)m(tains)h(v)-5 +b(ariable)39 b(length)g(arra)m(y)227 3220 y(columns)28 +b(then)h(p)s(coun)m(t)g(m)m(ust)g(sp)s(ecify)f(the)i(exp)s(ected)g +(\014nal)e(size)h(of)g(the)h(data)g(heap,)g(otherwise)e(p)s(coun)m(t) +227 3333 y(m)m(ust)j(=)f(0.)95 3593 y Fe(int)47 b(fits_insert_atbl)d(/) +j(ffitab)286 3706 y(\(fitsfile)f(*fptr,)g(long)g(rowlen,)g(long)h +(nrows,)f(int)h(tfields,)e(char)i(*ttype[],)334 3819 +y(long)g(*tbcol,)f(char)g(*tform[],)f(char)i(*tunit[],)e(char)i +(*extname,)e(>)j(int)f(*status\))95 4045 y(int)g(fits_insert_btbl)d(/)j +(ffibin)286 4158 y(\(fitsfile)f(*fptr,)g(long)g(nrows,)g(int)h +(tfields,)f(char)h(**ttype,)286 4271 y(char)g(**tform,)f(char)g +(**tunit,)g(char)g(*extname,)g(long)g(pcount,)g(>)i(int)e(*status\))0 +4530 y Fi(5)81 b Fj(Mo)s(dify)26 b(the)i(size,)g(dimensions,)e(and/or)h +(data)i(t)m(yp)s(e)f(of)f(the)h(curren)m(t)g(primary)d(arra)m(y)j(or)g +(image)g(extension.)227 4643 y(If)39 b(the)h(new)e(image,)43 +b(as)c(sp)s(eci\014ed)f(b)m(y)h(the)g(input)f(argumen)m(ts,)k(is)c +(larger)h(than)g(the)h(curren)m(t)f(existing)227 4756 +y(image)29 b(in)e(the)h(FITS)g(\014le)f(then)h(zero)h(\014ll)d(data)j +(will)d(b)s(e)i(inserted)f(at)i(the)f(end)g(of)g(the)h(curren)m(t)f +(image)h(and)227 4869 y(an)m(y)35 b(follo)m(wing)e(extensions)h(will)e +(b)s(e)i(mo)m(v)m(ed)i(further)d(bac)m(k)i(in)f(the)g(\014le.)53 +b(Similarly)-8 b(,)32 b(if)i(the)h(new)f(image)227 4982 +y(is)i(smaller)f(than)i(the)f(curren)m(t)h(image)g(then)f(an)m(y)h +(follo)m(wing)e(extensions)h(will)e(b)s(e)i(shifted)g(up)f(to)m(w)m +(ards)227 5095 y(the)h(b)s(eginning)d(of)j(the)g(FITS)f(\014le)g(and)g +(the)h(image)g(data)g(will)e(b)s(e)h(truncated)g(to)i(the)f(new)f +(size.)57 b(This)227 5208 y(routine)26 b(rewrites)g(the)i(BITPIX,)f +(NAXIS,)g(and)f(NAXISn)g(k)m(eyw)m(ords)i(with)e(the)h(appropriate)f(v) +-5 b(alues)26 b(for)227 5321 y(the)31 b(new)f(image.)95 +5581 y Fe(int)47 b(fits_resize_img)d(/)j(ffrsim)286 5694 +y(\(fitsfile)f(*fptr,)g(int)h(bitpix,)e(int)i(naxis,)f(long)h(*naxes,)f +(>)h(int)g(*status\))p eop +%%Page: 86 94 +86 93 bop 0 299 a Fj(86)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(6)81 b Fj(Cop)m(y)43 b(the)h(data)h(\(and)e(not)h(the)g +(header\))g(from)f(the)h(CHDU)g(asso)s(ciated)g(with)f(infptr)e(to)k +(the)f(CHDU)227 668 y(asso)s(ciated)33 b(with)e(outfptr.)47 +b(This)31 b(will)e(o)m(v)m(erwrite)k(an)m(y)g(data)g(previously)e(in)g +(the)i(output)f(CHDU.)h(This)227 781 y(lo)m(w)38 b(lev)m(el)g(routine)f +(is)g(used)g(b)m(y)h(\014ts)p 1510 781 28 4 v 33 w(cop)m(y)p +1724 781 V 33 w(hdu,)h(but)e(it)h(ma)m(y)g(also)g(b)s(e)g(useful)e(in)h +(certain)h(application)227 894 y(programs)30 b(that)h(w)m(an)m(t)g(to)g +(cop)m(y)g(the)f(data)h(from)f(one)h(FITS)e(\014le)h(to)h(another)f +(but)f(also)i(w)m(an)m(t)g(to)g(mo)s(dify)227 1007 y(the)h(header)g(k)m +(eyw)m(ords.)46 b(The)32 b(required)e(FITS)h(header)h(k)m(eyw)m(ords)g +(whic)m(h)f(de\014ne)g(the)h(structure)g(of)g(the)227 +1120 y(HDU)f(m)m(ust)g(b)s(e)e(written)h(to)h(the)f(output)g(CHDU)h(b)s +(efore)f(calling)f(this)g(routine.)95 1369 y Fe(int)47 +b(fits_copy_data)d(/)k(ffcpdt)286 1482 y(\(fitsfile)e(*infptr,)f +(fitsfile)h(*outfptr,)f(>)i(int)g(*status\))0 1732 y +Fi(7)81 b Fj(This)33 b(routine)g(forces)i(CFITSIO)f(to)h(rescan)g(the)g +(curren)m(t)g(header)f(k)m(eyw)m(ords)h(that)g(de\014ne)f(the)h +(structure)227 1845 y(of)f(the)f(HDU)h(\(suc)m(h)g(as)f(the)h(NAXIS)f +(and)g(BITPIX)g(k)m(eyw)m(ords\))h(so)f(that)h(it)f(reinitializes)e +(the)i(in)m(ternal)227 1958 y(bu\013ers)26 b(that)h(describ)s(e)f(the)h +(HDU)g(structure.)39 b(This)25 b(routine)h(is)g(useful)f(for)h +(reinitializing)d(the)k(structure)227 2071 y(of)34 b(an)f(HDU)h(if)e +(an)m(y)i(of)g(the)f(required)f(k)m(eyw)m(ords)h(\(e.g.,)j(NAXISn\))d +(ha)m(v)m(e)i(b)s(een)e(mo)s(di\014ed.)47 b(In)33 b(practice)227 +2184 y(it)d(should)e(rarely)h(b)s(e)g(necessary)h(to)h(call)e(this)g +(routine)g(b)s(ecause)g(CFITSIO)g(in)m(ternally)f(calls)h(it)g(in)g +(most)227 2297 y(situations.)95 2546 y Fe(int)47 b(fits_set_hdustruc)c +(/)48 b(ffrdef)286 2659 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*status\))141 +b(\(DEPRECATED\))0 2991 y Ff(9.3)135 b(Sp)t(ecialized)46 +b(Header)g(Keyw)l(ord)f(Routines)0 3245 y Fd(9.3.1)112 +b(Header)38 b(Information)f(Routines)0 3452 y Fi(1)81 +b Fj(Reserv)m(e)29 b(space)g(in)d(the)j(CHU)f(for)g(MOREKEYS)f(more)h +(header)g(k)m(eyw)m(ords.)41 b(This)26 b(routine)h(ma)m(y)i(b)s(e)f +(called)227 3565 y(to)34 b(allo)s(cate)f(space)g(for)f(additional)f(k)m +(eyw)m(ords)i(at)g(the)g(time)f(the)h(header)f(is)g(created)h(\(prior)f +(to)h(writing)227 3678 y(an)m(y)h(data\).)51 b(CFITSIO)32 +b(can)i(dynamically)d(add)i(more)g(space)h(to)g(the)g(header)f(when)f +(needed,)j(ho)m(w)m(ev)m(er)227 3791 y(it)30 b(is)g(more)g(e\016cien)m +(t)h(to)g(preallo)s(cate)f(the)h(required)e(space)i(if)e(the)h(size)h +(is)e(kno)m(wn)h(in)f(adv)-5 b(ance.)95 4041 y Fe(int)47 +b(fits_set_hdrsize)d(/)j(ffhdef)286 4153 y(\(fitsfile)f(*fptr,)g(int)h +(morekeys,)e(>)i(int)g(*status\))0 4403 y Fi(2)81 b Fj(Return)26 +b(the)h(n)m(um)m(b)s(er)e(of)j(k)m(eyw)m(ords)f(in)e(the)i(header)g +(\(not)h(coun)m(ting)f(the)g(END)g(k)m(eyw)m(ord\))h(and)e(the)h +(curren)m(t)227 4516 y(p)s(osition)32 b(in)h(the)h(header.)50 +b(The)34 b(p)s(osition)d(is)i(the)h(n)m(um)m(b)s(er)f(of)h(the)g(k)m +(eyw)m(ord)g(record)f(that)i(will)c(b)s(e)i(read)227 +4629 y(next)k(\(or)g(one)f(greater)i(than)e(the)h(p)s(osition)d(of)j +(the)g(last)f(k)m(eyw)m(ord)h(that)g(w)m(as)g(read\).)59 +b(A)37 b(v)-5 b(alue)35 b(of)i(1)g(is)227 4742 y(returned)29 +b(if)h(the)g(p)s(oin)m(ter)g(is)f(p)s(ositioned)g(at)i(the)f(b)s +(eginning)e(of)i(the)h(header.)95 4992 y Fe(int)47 b(fits_get_hdrpos)d +(/)j(ffghps)286 5105 y(\(fitsfile)f(*fptr,)g(>)h(int)g(*keysexist,)e +(int)i(*keynum,)e(int)i(*status\))0 5394 y Fd(9.3.2)112 +b(Read)38 b(and)h(W)-9 b(rite)35 b(the)i(Required)g(Keyw)m(ords)0 +5601 y Fi(1)81 b Fj(W)-8 b(rite)20 b(the)h(primary)d(header)i(or)g(IMA) +m(GE)i(extension)e(k)m(eyw)m(ords)g(in)m(to)g(the)h(CHU.)f(The)g +(simpler)e(\014ts)p 3535 5601 V 32 w(write)p 3770 5601 +V 32 w(imghdr)227 5714 y(routine)32 b(is)h(equiv)-5 b(alen)m(t)32 +b(to)i(calling)e(\014ts)p 1604 5714 V 32 w(write)p 1839 +5714 V 32 w(grphdr)f(with)h(the)i(default)e(v)-5 b(alues)32 +b(of)i(simple)d(=)i(TR)m(UE,)p eop +%%Page: 87 95 +87 94 bop 0 299 a Fh(9.3.)72 b(SPECIALIZED)29 b(HEADER)i(KEYW)m(ORD)g +(R)m(OUTINES)1510 b Fj(87)227 555 y(p)s(coun)m(t)39 b(=)g(0,)j(gcoun)m +(t)e(=)f(1,)j(and)c(extend)h(=)g(TR)m(UE.)g(The)g(PCOUNT,)g(GCOUNT)f +(and)h(EXTEND)227 668 y(k)m(eyw)m(ords)32 b(are)f(not)g(required)f(in)f +(the)i(primary)f(header)g(and)h(are)g(only)f(written)g(if)g(p)s(coun)m +(t)h(is)f(not)h(equal)227 781 y(to)26 b(zero,)h(gcoun)m(t)f(is)e(not)i +(equal)e(to)i(zero)g(or)f(one,)h(and)f(if)f(extend)h(is)f(TR)m(UE,)h +(resp)s(ectiv)m(ely)-8 b(.)39 b(When)25 b(writing)227 +894 y(to)37 b(an)f(IMA)m(GE)h(extension,)h(the)e(SIMPLE)f(and)h(EXTEND) +g(parameters)g(are)h(ignored.)57 b(It)36 b(is)f(recom-)227 +1007 y(mended)27 b(that)i(\014ts)p 885 1007 28 4 v 33 +w(create)p 1154 1007 V 34 w(image)g(or)f(\014ts)p 1680 +1007 V 32 w(create)p 1948 1007 V 35 w(tbl)f(b)s(e)g(used)h(instead)f +(of)i(these)f(routines)f(to)i(write)f(the)227 1120 y(required)h(header) +h(k)m(eyw)m(ords.)95 1374 y Fe(int)47 b(fits_write_imghdr)c(/)48 +b(ffphps)286 1487 y(\(fitsfile)e(*fptr,)g(int)h(bitpix,)e(int)i(naxis,) +f(long)h(*naxes,)f(>)h(int)g(*status\))95 1713 y(int)g +(fits_write_grphdr)c(/)48 b(ffphpr)286 1826 y(\(fitsfile)e(*fptr,)g +(int)h(simple,)e(int)i(bitpix,)f(int)h(naxis,)f(long)h(*naxes,)334 +1939 y(long)g(pcount,)f(long)g(gcount,)g(int)h(extend,)f(>)h(int)g +(*status\))0 2194 y Fi(2)81 b Fj(W)-8 b(rite)29 b(the)h(ASCI)s(I)d +(table)j(header)f(k)m(eyw)m(ords)g(in)m(to)h(the)f(CHU.)h(The)e +(optional)h(TUNITn)f(and)h(EXTNAME)227 2307 y(k)m(eyw)m(ords)f(are)h +(written)d(only)h(if)g(the)h(input)e(p)s(oin)m(ters)h(are)h(not)g(n)m +(ull.)38 b(A)27 b(n)m(ull)f(p)s(oin)m(ter)h(ma)m(y)h(giv)m(en)g(for)g +(the)227 2419 y(*tb)s(col)36 b(parameter)h(in)e(whic)m(h)g(case)j(a)e +(single)f(space)i(will)d(b)s(e)i(inserted)f(b)s(et)m(w)m(een)i(eac)m(h) +g(column)e(of)i(the)227 2532 y(table.)56 b(Similarly)-8 +b(,)33 b(if)i(ro)m(wlen)f(is)h(giv)m(en)g(=)g(0,)i(then)e(CFITSIO)f +(will)f(calculate)i(the)h(default)e(ro)m(wlength)227 +2645 y(based)c(on)h(the)f(tb)s(col)g(and)g(tt)m(yp)s(e)h(v)-5 +b(alues.)95 2900 y Fe(int)47 b(fits_write_atblhdr)c(/)48 +b(ffphtb)286 3013 y(\(fitsfile)e(*fptr,)g(long)g(rowlen,)g(long)h +(nrows,)f(int)h(tfields,)e(char)i(**ttype,)334 3126 y(long)g(*tbcol,)f +(char)g(**tform,)g(char)g(**tunit,)g(char)h(*extname,)e(>)i(int)g +(*status\))0 3380 y Fi(3)81 b Fj(W)-8 b(rite)29 b(the)g(binary)f(table) +h(header)f(k)m(eyw)m(ords)i(in)m(to)f(the)g(CHU.)g(The)g(optional)f +(TUNITn)g(and)h(EXTNAME)227 3493 y(k)m(eyw)m(ords)35 +b(are)g(written)f(only)g(if)f(the)i(input)e(p)s(oin)m(ters)g(are)i(not) +g(n)m(ull.)51 b(The)35 b(p)s(coun)m(t)f(parameter,)i(whic)m(h)227 +3606 y(sp)s(eci\014es)g(the)h(size)f(of)h(the)g(v)-5 +b(ariable)36 b(length)g(arra)m(y)h(heap,)h(should)d(initially)e(=)k(0;) +j(CFITSIO)c(will)e(au-)227 3719 y(tomatically)d(up)s(date)g(the)g +(PCOUNT)f(k)m(eyw)m(ord)i(v)-5 b(alue)31 b(if)f(an)m(y)h(v)-5 +b(ariable)30 b(length)h(arra)m(y)h(data)g(is)e(written)227 +3832 y(to)h(the)e(heap.)41 b(The)29 b(TF)m(ORM)g(k)m(eyw)m(ord)h(v)-5 +b(alue)29 b(for)h(v)-5 b(ariable)28 b(length)h(v)m(ector)i(columns)d +(should)g(ha)m(v)m(e)j(the)227 3945 y(form)c('Pt\(len\)')i(or)e +('1Pt\(len\)')i(where)e(`t')h(is)f(the)h(data)g(t)m(yp)s(e)g(co)s(de)f +(letter)h(\(A,I,J,E,D,)h(etc.\))42 b(and)27 b(`len')g(is)227 +4058 y(an)h(in)m(teger)h(sp)s(ecifying)d(the)i(maxim)m(um)f(length)g +(of)i(the)f(v)m(ectors)h(in)e(that)i(column)e(\(len)g(m)m(ust)h(b)s(e)g +(greater)227 4171 y(than)36 b(or)g(equal)g(to)h(the)f(longest)h(v)m +(ector)g(in)e(the)i(column\).)57 b(If)36 b(`len')f(is)h(not)g(sp)s +(eci\014ed)f(when)g(the)h(table)227 4284 y(is)31 b(created)h(\(e.g.,)h +(the)f(input)d(TF)m(ORMn)i(v)-5 b(alue)31 b(is)f(just)h('1Pt'\))i(then) +e(CFITSIO)f(will)e(scan)k(the)f(column)227 4397 y(when)f(the)h(table)g +(is)f(\014rst)g(closed)g(and)h(will)d(app)s(end)h(the)i(maxim)m(um)f +(length)g(to)h(the)g(TF)m(ORM)g(k)m(eyw)m(ord)227 4509 +y(v)-5 b(alue.)40 b(Note)30 b(that)f(if)e(the)i(table)f(is)g(subsequen) +m(tly)f(mo)s(di\014ed)f(to)k(increase)e(the)h(maxim)m(um)e(length)h(of) +h(the)227 4622 y(v)m(ectors)39 b(then)e(the)g(mo)s(difying)e(program)i +(is)f(resp)s(onsible)f(for)i(also)g(up)s(dating)e(the)j(TF)m(ORM)f(k)m +(eyw)m(ord)227 4735 y(v)-5 b(alue.)95 4990 y Fe(int)47 +b(fits_write_btblhdr)c(/)48 b(ffphbn)286 5103 y(\(fitsfile)e(*fptr,)g +(long)g(nrows,)g(int)h(tfields,)f(char)h(**ttype,)334 +5216 y(char)g(**tform,)e(char)i(**tunit,)e(char)i(*extname,)e(long)i +(pcount,)f(>)h(int)g(*status\))0 5470 y Fi(4)81 b Fj(Read)30 +b(the)h(required)d(k)m(eyw)m(ords)j(from)f(the)h(CHDU)f(\(image)i(or)e +(table\).)41 b(When)30 b(reading)g(from)g(an)g(IMA)m(GE)227 +5583 y(extension)23 b(the)h(SIMPLE)e(and)h(EXTEND)g(parameters)h(are)f +(ignored.)38 b(A)23 b(n)m(ull)e(p)s(oin)m(ter)i(ma)m(y)h(b)s(e)e +(supplied)227 5696 y(for)30 b(an)m(y)h(of)g(the)f(returned)f +(parameters)i(that)g(are)g(not)f(needed.)p eop +%%Page: 88 96 +88 95 bop 0 299 a Fj(88)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)95 +555 y Fe(int)47 b(fits_read_imghdr)d(/)j(ffghpr)286 668 +y(\(fitsfile)f(*fptr,)g(int)h(maxdim,)e(>)j(int)f(*simple,)e(int)i +(*bitpix,)f(int)h(*naxis,)334 781 y(long)g(*naxes,)f(long)g(*pcount,)g +(long)g(*gcount,)g(int)h(*extend,)e(int)i(*status\))95 +1007 y(int)g(fits_read_atblhdr)c(/)48 b(ffghtb)286 1120 +y(\(fitsfile)e(*fptr,int)f(maxdim,)h(>)h(long)g(*rowlen,)e(long)i +(*nrows,)334 1233 y(int)g(*tfields,)e(char)i(**ttype,)e(long)i(*tbcol,) +f(char)h(**tform,)e(char)i(**tunit,)334 1346 y(char)g(*extname,)93 +b(int)47 b(*status\))95 1571 y(int)g(fits_read_btblhdr)c(/)48 +b(ffghbn)286 1684 y(\(fitsfile)e(*fptr,)g(int)h(maxdim,)e(>)j(long)f +(*nrows,)e(int)i(*tfields,)334 1797 y(char)g(**ttype,)e(char)i +(**tform,)e(char)i(**tunit,)f(char)g(*extname,)334 1910 +y(long)h(*pcount,)e(int)i(*status\))0 2197 y Fd(9.3.3)112 +b(W)-9 b(rite)36 b(Keyw)m(ord)h(Routines)0 2416 y Fj(These)32 +b(routines)g(simply)e(app)s(end)h(a)h(new)g(k)m(eyw)m(ord)h(to)h(the)e +(header)h(and)f(do)g(not)h(c)m(hec)m(k)h(to)f(see)g(if)f(a)g(k)m(eyw)m +(ord)0 2528 y(with)c(the)h(same)h(name)f(already)g(exists.)40 +b(In)28 b(general)h(it)g(is)f(preferable)g(to)i(use)f(the)h(\014ts)p +3009 2528 28 4 v 32 w(up)s(date)p 3317 2528 V 32 w(k)m(ey)g(routine)e +(to)0 2641 y(ensure)34 b(that)h(the)g(same)g(k)m(eyw)m(ord)g(is)e(not)i +(written)f(more)h(than)f(once)h(to)h(the)e(header.)54 +b(See)34 b(App)s(endix)e(B)j(for)0 2754 y(the)c(de\014nition)d(of)i +(the)h(parameters)f(used)g(in)f(these)i(routines.)0 2988 +y Fi(1)81 b Fj(W)-8 b(rite)29 b(\(app)s(end\))g(a)g(new)g(k)m(eyw)m +(ord)h(of)g(the)f(appropriate)f(data)i(t)m(yp)s(e)g(in)m(to)f(the)h +(CHU.)f(A)h(n)m(ull)d(p)s(oin)m(ter)h(ma)m(y)227 3101 +y(b)s(e)35 b(en)m(tered)h(for)f(the)h(commen)m(t)h(parameter,)g(whic)m +(h)d(will)f(cause)j(the)g(commen)m(t)g(\014eld)e(of)i(the)f(k)m(eyw)m +(ord)227 3214 y(to)43 b(b)s(e)e(left)h(blank.)75 b(The)41 +b(\015t,)k(dbl,)e(cmp,)i(and)d(dblcmp)e(v)m(ersions)h(of)h(this)f +(routine)g(ha)m(v)m(e)i(the)g(added)227 3327 y(feature)33 +b(that)g(if)f(the)g('decimals')g(parameter)h(is)f(negativ)m(e,)i(then)e +(the)h('G')g(displa)m(y)e(format)i(rather)f(then)227 +3440 y(the)i('E')f(format)h(will)c(b)s(e)j(used)f(when)g(constructing)h +(the)h(k)m(eyw)m(ord)f(v)-5 b(alue,)34 b(taking)f(the)h(absolute)e(v)-5 +b(alue)227 3553 y(of)34 b('decimals')f(for)g(the)h(precision.)49 +b(This)32 b(will)f(suppress)g(trailing)h(zeros,)j(and)e(will)e(use)j(a) +g(\014xed)f(format)227 3666 y(rather)e(than)f(an)g(exp)s(onen)m(tial)f +(format,)i(dep)s(ending)d(on)i(the)h(magnitude)e(of)i(the)g(v)-5 +b(alue.)95 3899 y Fe(int)47 b(fits_write_key_str)c(/)48 +b(ffpkys)286 4012 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(char)g +(*value,)g(char)h(*comment,)334 4125 y(>)h(int)e(*status\))95 +4351 y(int)h(fits_write_key_[log,)c(lng])j(/)95 b(ffpky[lj])286 +4464 y(\(fitsfile)46 b(*fptr,)g(char)g(*keyname,)g(DTYPE)g(numval,)g +(char)g(*comment,)334 4577 y(>)i(int)e(*status\))95 4803 +y(int)h(fits_write_key_[flt,)c(dbl,)j(fixflg,)g(fixdbl])g(/)h +(ffpky[edfg])286 4916 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE) +g(numval,)g(int)h(decimals,)286 5028 y(char)g(*comment,)e(>)j(int)f +(*status\))95 5254 y(int)g(fits_write_key_[cmp,)c(dblcmp,)i(fixcmp,)h +(fixdblcmp])f(/)j(ffpk[yc,ym,fc,fm])286 5367 y(\(fitsfile)e(*fptr,)g +(char)g(*keyname,)g(DTYPE)g(*numval,)g(int)g(decimals,)286 +5480 y(char)h(*comment,)e(>)j(int)f(*status\))0 5714 +y Fi(2)81 b Fj(W)-8 b(rite)29 b(\(app)s(end\))f(a)i(string)e(v)-5 +b(alued)28 b(k)m(eyw)m(ord)i(in)m(to)f(the)g(CHU)h(whic)m(h)d(ma)m(y)j +(b)s(e)f(longer)g(than)f(68)i(c)m(haracters)p eop +%%Page: 89 97 +89 96 bop 0 299 a Fh(9.3.)72 b(SPECIALIZED)29 b(HEADER)i(KEYW)m(ORD)g +(R)m(OUTINES)1510 b Fj(89)227 555 y(in)42 b(length.)79 +b(This)41 b(uses)i(the)g(Long)h(String)d(Keyw)m(ord)i(con)m(v)m(en)m +(tion)i(that)e(is)g(describ)s(ed)e(in)h(the`Lo)s(cal)227 +668 y(FITS)c(Con)m(v)m(en)m(tions')h(section)g(in)f(Chapter)g(4.)66 +b(Since)37 b(this)h(uses)g(a)h(non-standard)f(FITS)g(con)m(v)m(en)m +(tion)227 781 y(to)45 b(enco)s(de)f(the)g(long)g(k)m(eyw)m(ord)g +(string,)j(programs)c(whic)m(h)g(use)h(this)f(routine)g(should)f(also)h +(call)h(the)227 894 y(\014ts)p 354 894 28 4 v 33 w(write)p +590 894 V 32 w(k)m(ey)p 755 894 V 33 w(longw)m(arn)25 +b(routine)f(to)i(add)f(some)h(COMMENT)f(k)m(eyw)m(ords)g(to)h(w)m(arn)f +(users)g(of)g(the)h(FITS)227 1007 y(\014le)42 b(that)i(this)d(con)m(v)m +(en)m(tion)j(is)e(b)s(eing)f(used.)78 b(The)42 b(\014ts)p +2220 1007 V 32 w(write)p 2455 1007 V 32 w(k)m(ey)p 2620 +1007 V 34 w(longw)m(arn)g(routine)g(also)h(writes)f(a)227 +1120 y(k)m(eyw)m(ord)29 b(called)e(LONGSTRN)g(to)i(record)f(the)g(v)m +(ersion)g(of)g(the)g(longstring)f(con)m(v)m(en)m(tion)i(that)g(has)f(b) +s(een)227 1233 y(used,)35 b(in)e(case)j(a)f(new)e(con)m(v)m(en)m(tion)j +(is)e(adopted)g(at)h(some)g(p)s(oin)m(t)e(in)h(the)g(future.)52 +b(If)34 b(the)h(LONGSTRN)227 1346 y(k)m(eyw)m(ord)43 +b(is)f(already)g(presen)m(t)h(in)f(the)g(header,)k(then)d(\014ts)p +2332 1346 V 32 w(write)p 2567 1346 V 32 w(k)m(ey)p 2732 +1346 V 34 w(longw)m(arn)f(will)e(simply)g(return)227 +1458 y(without)30 b(doing)f(an)m(ything.)95 1700 y Fe(int)47 +b(fits_write_key_longstr)42 b(/)48 b(ffpkls)286 1813 +y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(char)g(*longstr,)g(char)g +(*comment,)334 1926 y(>)i(int)e(*status\))95 2151 y(int)h +(fits_write_key_longwarn)42 b(/)47 b(ffplsw)286 2264 +y(\(fitsfile)f(*fptr,)g(>)h(int)g(*status\))0 2506 y +Fi(3)81 b Fj(W)-8 b(rite)37 b(\(app)s(end\))e(a)i(n)m(um)m(b)s(ered)e +(sequence)i(of)g(k)m(eyw)m(ords)g(in)m(to)f(the)h(CHU.)g(The)f +(starting)g(index)f(n)m(um)m(b)s(er)227 2619 y(\(nstart\))30 +b(m)m(ust)e(b)s(e)g(greater)i(than)f(0.)40 b(One)28 b(ma)m(y)i(app)s +(end)d(the)h(same)i(commen)m(t)f(to)h(ev)m(ery)f(k)m(eyw)m(ord)g(\(and) +227 2732 y(eliminate)j(the)i(need)f(to)h(ha)m(v)m(e)g(an)f(arra)m(y)h +(of)f(iden)m(tical)g(commen)m(t)h(strings,)f(one)g(for)h(eac)m(h)g(k)m +(eyw)m(ord\))g(b)m(y)227 2844 y(including)21 b(the)k(amp)s(ersand)e(c)m +(haracter)j(as)e(the)h(last)f(non-blank)f(c)m(haracter)j(in)d(the)h +(\(\014rst\))h(COMMENTS)227 2957 y(string)d(parameter.)38 +b(This)21 b(same)i(string)e(will)f(then)i(b)s(e)g(used)f(for)h(the)h +(commen)m(t)g(\014eld)e(in)g(all)h(the)g(k)m(eyw)m(ords.)227 +3070 y(One)32 b(ma)m(y)h(also)f(en)m(ter)g(a)h(n)m(ull)d(p)s(oin)m(ter) +h(for)h(the)g(commen)m(t)h(parameter)g(to)f(lea)m(v)m(e)i(the)e(commen) +m(t)h(\014eld)e(of)227 3183 y(the)g(k)m(eyw)m(ord)g(blank.)95 +3425 y Fe(int)47 b(fits_write_keys_str)c(/)k(ffpkns)286 +3537 y(\(fitsfile)f(*fptr,)g(char)g(*keyroot,)g(int)h(nstart,)e(int)i +(nkeys,)334 3650 y(char)g(**value,)e(char)i(**comment,)e(>)i(int)g +(*status\))95 3876 y(int)g(fits_write_keys_[log,)42 b(lng])47 +b(/)g(ffpkn[lj])286 3989 y(\(fitsfile)f(*fptr,)g(char)g(*keyroot,)g +(int)h(nstart,)e(int)i(nkeys,)334 4102 y(DTYPE)f(*numval,)g(char)h +(**comment,)e(int)i(*status\))95 4328 y(int)g(fits_write_keys_[flt,)42 +b(dbl,)47 b(fixflg,)f(fixdbl])g(/)h(ffpkne[edfg])286 +4441 y(\(fitsfile)f(*fptr,)g(char)g(*keyroot,)g(int)h(nstart,)e(int)i +(nkey,)334 4554 y(DTYPE)f(*numval,)g(int)h(decimals,)e(char)i +(**comment,)e(>)i(int)g(*status\))0 4795 y Fi(4)81 b +Fj(Cop)m(y)21 b(an)h(indexed)e(k)m(eyw)m(ord)j(from)e(one)h(HDU)h(to)f +(another,)i(mo)s(difying)c(the)i(index)e(n)m(um)m(b)s(er)g(of)i(the)g +(k)m(eyw)m(ord)227 4908 y(name)37 b(in)e(the)h(pro)s(cess.)58 +b(F)-8 b(or)37 b(example,)h(this)d(routine)h(could)f(read)h(the)h +(TLMIN3)f(k)m(eyw)m(ord)h(from)f(the)227 5021 y(input)29 +b(HDU)i(\(b)m(y)g(giving)f(k)m(eyro)s(ot)h(=)g(`TLMIN')g(and)f(inn)m +(um)e(=)i(3\))i(and)e(write)g(it)g(to)h(the)g(output)f(HDU)227 +5134 y(with)35 b(the)h(k)m(eyw)m(ord)h(name)f(TLMIN4)g(\(b)m(y)g +(setting)h(outn)m(um)e(=)h(4\).)58 b(If)36 b(the)g(input)e(k)m(eyw)m +(ord)j(do)s(es)f(not)227 5247 y(exist,)31 b(then)f(this)f(routine)g +(simply)f(returns)h(without)h(indicating)e(an)i(error.)95 +5488 y Fe(int)47 b(fits_copy_key)e(/)i(ffcpky)286 5601 +y(\(fitsfile)f(*infptr,)f(fitsfile)h(*outfptr,)f(int)i(innum,)f(int)h +(outnum,)334 5714 y(char)g(*keyroot,)e(>)i(int)g(*status\))p +eop +%%Page: 90 98 +90 97 bop 0 299 a Fj(90)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(5)81 b Fj(W)-8 b(rite)29 b(\(app)s(end\))g(a)h(`triple)d +(precision')h(k)m(eyw)m(ord)i(in)m(to)f(the)h(CHU)f(in)f(F28.16)k +(format.)41 b(The)29 b(\015oating)g(p)s(oin)m(t)227 668 +y(k)m(eyw)m(ord)h(v)-5 b(alue)29 b(is)f(constructed)i(b)m(y)f +(concatenating)i(the)e(input)f(in)m(teger)i(v)-5 b(alue)28 +b(with)g(the)i(input)d(double)227 781 y(precision)33 +b(fraction)g(v)-5 b(alue)34 b(\(whic)m(h)f(m)m(ust)h(ha)m(v)m(e)i(a)e +(v)-5 b(alue)34 b(b)s(et)m(w)m(een)g(0.0)i(and)d(1.0\).)53 +b(The)34 b(\013gkyt)h(routine)227 894 y(should)c(b)s(e)i(used)f(to)i +(read)f(this)f(k)m(eyw)m(ord)i(v)-5 b(alue,)34 b(b)s(ecause)f(the)g +(other)h(k)m(eyw)m(ord)f(reading)g(routines)f(will)227 +1007 y(not)f(preserv)m(e)f(the)h(full)d(precision)h(of)h(the)h(v)-5 +b(alue.)95 1268 y Fe(int)47 b(fits_write_key_triple)42 +b(/)48 b(ffpkyt)286 1380 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g +(long)g(intval,)g(double)g(frac,)334 1493 y(char)h(*comment,)e(>)i(int) +g(*status\))0 1754 y Fi(6)81 b Fj(W)-8 b(rite)36 b(k)m(eyw)m(ords)g(to) +h(the)f(CHDU)g(that)h(are)f(de\014ned)f(in)g(an)h(ASCI)s(I)e(template)i +(\014le.)57 b(The)35 b(format)i(of)f(the)227 1867 y(template)31 +b(\014le)f(is)f(describ)s(ed)f(under)h(the)i(\014ts)p +1788 1867 28 4 v 32 w(parse)p 2028 1867 V 33 w(template)f(routine.)95 +2128 y Fe(int)47 b(fits_write_key_template)42 b(/)47 +b(ffpktp)286 2241 y(\(fitsfile)f(*fptr,)g(const)g(char)h(*filename,)e +(>)i(int)g(*status\))0 2532 y Fd(9.3.4)112 b(Insert)38 +b(Keyw)m(ord)f(Routines)0 2752 y Fj(These)42 b(insert)g(routines)f(are) +i(somewhat)g(less)e(e\016cien)m(t)i(than)g(the)f(`up)s(date')g(or)h +(`write')f(k)m(eyw)m(ord)h(routines)0 2864 y(b)s(ecause)30 +b(the)g(follo)m(wing)f(k)m(eyw)m(ords)h(in)f(the)h(header)g(m)m(ust)g +(b)s(e)f(shifted)g(do)m(wn)g(to)i(mak)m(e)g(ro)s(om)f(for)g(the)g +(inserted)0 2977 y(k)m(eyw)m(ord.)41 b(See)31 b(App)s(endix)c(B)k(for)f +(the)h(de\014nition)d(of)i(the)h(parameters)g(used)e(in)g(these)i +(routines.)0 3238 y Fi(1)81 b Fj(Insert)26 b(a)h(new)f(k)m(eyw)m(ord)h +(record)g(in)m(to)f(the)h(CHU)g(at)g(the)g(sp)s(eci\014ed)e(p)s +(osition)g(\(i.e.,)j(immediately)d(preceding)227 3351 +y(the)31 b(\(k)m(eyn)m(um\)th)g(k)m(eyw)m(ord)g(in)e(the)h(header.\))95 +3612 y Fe(int)47 b(fits_insert_record)c(/)48 b(ffirec)286 +3725 y(\(fitsfile)e(*fptr,)g(int)h(keynum,)e(char)i(*card,)f(>)i(int)f +(*status\))0 3985 y Fi(2)81 b Fj(Insert)24 b(a)h(new)g(k)m(eyw)m(ord)g +(in)m(to)g(the)g(CHU.)g(The)g(new)f(k)m(eyw)m(ord)i(is)e(inserted)f +(immediately)h(follo)m(wing)f(the)i(last)227 4098 y(k)m(eyw)m(ord)i +(that)f(has)f(b)s(een)h(read)f(from)h(the)g(header.)39 +b(The)25 b(`longstr')h(v)m(ersion)f(has)g(the)h(same)g(functionalit)m +(y)227 4211 y(as)33 b(the)g(`str')f(v)m(ersion)g(except)i(that)f(it)f +(also)g(supp)s(orts)f(the)h(lo)s(cal)g(long)g(string)g(k)m(eyw)m(ord)h +(con)m(v)m(en)m(tion)g(for)227 4324 y(strings)28 b(longer)g(than)h(68)h +(c)m(haracters.)41 b(A)29 b(n)m(ull)e(p)s(oin)m(ter)h(ma)m(y)h(b)s(e)g +(en)m(tered)g(for)g(the)g(commen)m(t)g(parameter)227 +4437 y(whic)m(h)c(will)d(cause)k(the)g(commen)m(t)h(\014eld)d(to)i(b)s +(e)f(left)g(blank.)38 b(The)25 b(\015t,)h(dbl,)f(cmp,)i(and)e(dblcmp)e +(v)m(ersions)i(of)227 4550 y(this)k(routine)g(ha)m(v)m(e)i(the)e(added) +g(feature)i(that)f(if)f(the)h('decimals')f(parameter)h(is)f(negativ)m +(e,)i(then)e(the)h('G')227 4663 y(displa)m(y)e(format)i(rather)f(then)g +(the)h('E')f(format)h(will)d(b)s(e)i(used)f(when)h(constructing)g(the)g +(k)m(eyw)m(ord)h(v)-5 b(alue,)227 4776 y(taking)26 b(the)h(absolute)f +(v)-5 b(alue)25 b(of)i('decimals')e(for)h(the)h(precision.)37 +b(This)25 b(will)e(suppress)h(trailing)h(zeros,)j(and)227 +4889 y(will)34 b(use)j(a)g(\014xed)f(format)h(rather)g(than)f(an)h(exp) +s(onen)m(tial)e(format,)k(dep)s(ending)34 b(on)j(the)g(magnitude)f(of) +227 5002 y(the)31 b(v)-5 b(alue.)95 5262 y Fe(int)47 +b(fits_insert_card)d(/)j(ffikey)286 5375 y(\(fitsfile)f(*fptr,)g(char)g +(*card,)g(>)i(&status\))95 5601 y(int)f(fits_insert_key_[str,)42 +b(longstr])k(/)h(ffi[kys,)f(kls])286 5714 y(\(fitsfile)g(*fptr,)g(char) +g(*keyname,)g(char)g(*value,)g(char)h(*comment,)p eop +%%Page: 91 99 +91 98 bop 0 299 a Fh(9.3.)72 b(SPECIALIZED)29 b(HEADER)i(KEYW)m(ORD)g +(R)m(OUTINES)1510 b Fj(91)334 555 y Fe(>)48 b(int)e(*status\))95 +781 y(int)h(fits_insert_key_[log,)42 b(lng])47 b(/)g(ffiky[lj])286 +894 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE)g(numval,)g(char)g +(*comment,)334 1007 y(>)i(int)e(*status\))95 1233 y(int)h +(fits_insert_key_[flt,)42 b(fixflt,)k(dbl,)h(fixdbl])f(/)h(ffiky[edfg]) +286 1346 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE)g(numval,)g +(int)h(decimals,)334 1458 y(char)g(*comment,)e(>)i(int)g(*status\))95 +1684 y(int)g(fits_insert_key_[cmp,)42 b(dblcmp,)k(fixcmp,)g(fixdblcmp]) +f(/)i(ffik[yc,ym,fc,fm])286 1797 y(\(fitsfile)f(*fptr,)g(char)g +(*keyname,)g(DTYPE)g(*numval,)g(int)g(decimals,)334 1910 +y(char)h(*comment,)e(>)i(int)g(*status\))0 2169 y Fi(3)81 +b Fj(Insert)32 b(a)i(new)f(k)m(eyw)m(ord)h(with)e(an)h(unde\014ned,)g +(or)g(n)m(ull,)f(v)-5 b(alue)33 b(in)m(to)h(the)f(CHU.)h(The)f(v)-5 +b(alue)33 b(string)f(of)i(the)227 2282 y(k)m(eyw)m(ord)d(is)f(left)g +(blank)f(in)g(this)g(case.)95 2541 y Fe(int)47 b(fits_insert_key_null)c +(/)k(ffikyu)286 2654 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(char)g +(*comment,)g(>)h(int)g(*status\))0 2945 y Fd(9.3.5)112 +b(Read)38 b(Keyw)m(ord)g(Routines)0 3163 y Fj(Wild)29 +b(card)h(c)m(haracters)i(ma)m(y)f(b)s(e)f(used)f(when)h(sp)s(ecifying)e +(the)i(name)h(of)f(the)h(k)m(eyw)m(ord)g(to)g(b)s(e)f(read.)0 +3422 y Fi(1)81 b Fj(Read)43 b(a)h(k)m(eyw)m(ord)g(v)-5 +b(alue)42 b(\(with)h(the)g(appropriate)g(data)h(t)m(yp)s(e\))g(and)e +(commen)m(t)j(from)e(the)g(CHU.)h(If)f(a)227 3535 y(NULL)32 +b(commen)m(t)h(p)s(oin)m(ter)e(is)h(giv)m(en)g(on)g(input,)e(then)i +(the)g(commen)m(t)i(string)d(will)e(not)j(b)s(e)g(returned.)44 +b(If)227 3648 y(the)32 b(v)-5 b(alue)32 b(of)g(the)g(k)m(eyw)m(ord)g +(is)f(not)i(de\014ned)d(\(i.e.,)j(the)f(v)-5 b(alue)32 +b(\014eld)e(is)h(blank\))g(then)h(an)g(error)f(status)h(=)227 +3761 y(V)-10 b(ALUE)p 545 3761 28 4 v 33 w(UNDEFINED)29 +b(will)c(b)s(e)j(returned)e(and)h(the)h(input)e(v)-5 +b(alue)27 b(will)f(not)i(b)s(e)f(c)m(hanged)h(\(except)h(that)227 +3874 y(\013gkys)i(will)d(reset)j(the)f(v)-5 b(alue)30 +b(to)h(a)g(n)m(ull)d(string\).)95 4133 y Fe(int)47 b(fits_read_key_str) +c(/)48 b(ffgkys)286 4246 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(>)h +(char)g(*value,)f(char)g(*comment,)334 4359 y(int)h(*status\);)95 +4585 y(NOTE:)g(after)f(calling)g(the)h(following)e(routine,)h(programs) +f(must)i(explicitly)e(free)382 4698 y(the)i(memory)f(allocated)f(for)i +('longstr')e(after)i(it)g(is)g(no)g(longer)f(needed.)95 +4924 y(int)h(fits_read_key_longstr)42 b(/)48 b(ffgkls)286 +5036 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(>)h(char)g(**longstr,)e +(char)h(*comment,)620 5149 y(int)h(*status\))95 5375 +y(int)g(fits_read_key_[log,)c(lng,)k(flt,)f(dbl,)h(cmp,)f(dblcmp])g(/)i +(ffgky[ljedcm])286 5488 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(>)h +(DTYPE)f(*numval,)g(char)h(*comment,)334 5601 y(int)g(*status\))p +eop +%%Page: 92 100 +92 99 bop 0 299 a Fj(92)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(2)81 b Fj(Read)36 b(a)h(sequence)f(of)h(indexed)d(k)m(eyw)m +(ord)j(v)-5 b(alues)36 b(\(e.g.,)j(NAXIS1,)g(NAXIS2,)f(...\).)59 +b(The)36 b(input)e(starting)227 668 y(index)j(n)m(um)m(b)s(er)f +(\(nstart\))j(m)m(ust)f(b)s(e)f(greater)i(than)e(0.)64 +b(If)37 b(the)h(v)-5 b(alue)37 b(of)h(an)m(y)h(of)f(the)g(k)m(eyw)m +(ords)g(is)f(not)227 781 y(de\014ned)d(\(i.e.,)i(the)f(v)-5 +b(alue)34 b(\014eld)f(is)h(blank\))g(then)g(an)g(error)h(status)g(=)f +(V)-10 b(ALUE)p 3009 781 28 4 v 33 w(UNDEFINED)36 b(will)c(b)s(e)227 +894 y(returned)21 b(and)h(the)h(input)d(v)-5 b(alue)22 +b(for)g(the)g(unde\014ned)e(k)m(eyw)m(ord\(s\))k(will)19 +b(not)k(b)s(e)e(c)m(hanged.)39 b(These)22 b(routines)227 +1007 y(do)j(not)h(supp)s(ort)d(wild)g(card)i(c)m(haracters)i(in)d(the)i +(ro)s(ot)f(name.)39 b(If)25 b(there)h(are)f(no)g(indexed)f(k)m(eyw)m +(ords)i(in)e(the)227 1120 y(header)35 b(with)e(the)i(input)d(ro)s(ot)j +(name)g(then)f(these)h(routines)f(do)g(not)h(return)e(a)i(non-zero)h +(status)e(v)-5 b(alue)227 1233 y(and)30 b(instead)g(simply)e(return)h +(nfound)f(=)i(0.)95 1489 y Fe(int)47 b(fits_read_keys_str)c(/)48 +b(ffgkns)286 1602 y(\(fitsfile)e(*fptr,)g(char)g(*keyname,)g(int)h +(nstart,)e(int)i(nkeys,)334 1715 y(>)h(char)e(**value,)g(int)h +(*nfound,)93 b(int)47 b(*status\))95 1941 y(int)g(fits_read_keys_[log,) +c(lng,)j(flt,)h(dbl])g(/)g(ffgkn[ljed])286 2054 y(\(fitsfile)f(*fptr,)g +(char)g(*keyname,)g(int)h(nstart,)e(int)i(nkeys,)334 +2167 y(>)h(DTYPE)e(*numval,)f(int)i(*nfound,)f(int)h(*status\))0 +2423 y Fi(3)81 b Fj(Read)37 b(the)h(v)-5 b(alue)37 b(of)h(a)g +(\015oating)f(p)s(oin)m(t)g(k)m(eyw)m(ord,)j(returning)c(the)i(in)m +(teger)g(and)f(fractional)g(parts)g(of)h(the)227 2536 +y(v)-5 b(alue)34 b(in)e(separate)j(routine)e(argumen)m(ts.)52 +b(This)32 b(routine)h(ma)m(y)h(b)s(e)f(used)h(to)g(read)g(an)m(y)g(k)m +(eyw)m(ord)h(but)e(is)227 2649 y(esp)s(ecially)c(useful)f(for)j +(reading)e(the)i('triple)e(precision')f(k)m(eyw)m(ords)j(written)f(b)m +(y)g(\013pkyt.)95 2906 y Fe(int)47 b(fits_read_key_triple)c(/)k(ffgkyt) +286 3019 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(>)h(long)g +(*intval,)e(double)h(*frac,)334 3132 y(char)h(*comment,)e(int)i +(*status\))0 3422 y Fd(9.3.6)112 b(Mo)s(dify)38 b(Keyw)m(ord)f +(Routines)0 3641 y Fj(These)31 b(routines)g(mo)s(dify)f(the)i(v)-5 +b(alue)31 b(of)h(an)g(existing)e(k)m(eyw)m(ord.)46 b(An)31 +b(error)g(is)g(returned)f(if)h(the)h(k)m(eyw)m(ord)g(do)s(es)0 +3753 y(not)43 b(exist.)76 b(Wild)41 b(card)i(c)m(haracters)h(ma)m(y)f +(b)s(e)f(used)f(when)h(sp)s(ecifying)e(the)j(name)f(of)h(the)f(k)m(eyw) +m(ord)h(to)h(b)s(e)0 3866 y(mo)s(di\014ed.)39 b(See)30 +b(App)s(endix)e(B)j(for)f(the)g(de\014nition)e(of)j(the)f(parameters)h +(used)f(in)f(these)i(routines.)0 4123 y Fi(1)81 b Fj(Mo)s(dify)29 +b(\(o)m(v)m(erwrite\))i(the)g(n)m(th)f(80-c)m(haracter)j(header)d +(record)h(in)e(the)h(CHU.)95 4380 y Fe(int)47 b(fits_modify_record)c(/) +48 b(ffmrec)286 4492 y(\(fitsfile)e(*fptr,)g(int)h(keynum,)e(char)i +(*card,)f(>)i(int)f(*status\))0 4749 y Fi(2)81 b Fj(Mo)s(dify)36 +b(\(o)m(v)m(erwrite\))j(the)f(80-c)m(haracter)j(header)c(record)h(for)f +(the)h(named)f(k)m(eyw)m(ord)h(in)f(the)h(CHU.)g(This)227 +4862 y(can)31 b(b)s(e)f(used)f(to)i(o)m(v)m(erwrite)g(the)g(name)f(of)h +(the)f(k)m(eyw)m(ord)h(as)g(w)m(ell)e(as)i(its)f(v)-5 +b(alue)29 b(and)h(commen)m(t)i(\014elds.)95 5119 y Fe(int)47 +b(fits_modify_card)d(/)j(ffmcrd)286 5231 y(\(fitsfile)f(*fptr,)g(char)g +(*keyname,)g(char)g(*card,)g(>)i(int)f(*status\))0 5488 +y Fi(5)81 b Fj(Mo)s(dify)29 b(the)h(v)-5 b(alue)30 b(and)f(commen)m(t)i +(\014elds)e(of)h(an)g(existing)f(k)m(eyw)m(ord)i(in)e(the)h(CHU.)h(The) +e(`longstr')h(v)m(ersion)227 5601 y(has)41 b(the)h(same)f(functionalit) +m(y)f(as)h(the)h(`str')f(v)m(ersion)g(except)h(that)g(it)f(also)g(supp) +s(orts)e(the)j(lo)s(cal)e(long)227 5714 y(string)28 b(k)m(eyw)m(ord)i +(con)m(v)m(en)m(tion)g(for)f(strings)e(longer)i(than)g(68)h(c)m +(haracters.)41 b(Optionally)-8 b(,)28 b(one)h(ma)m(y)h(mo)s(dify)p +eop +%%Page: 93 101 +93 100 bop 0 299 a Fh(9.3.)72 b(SPECIALIZED)29 b(HEADER)i(KEYW)m(ORD)g +(R)m(OUTINES)1510 b Fj(93)227 555 y(only)27 b(the)h(v)-5 +b(alue)27 b(\014eld)g(and)g(lea)m(v)m(e)i(the)f(commen)m(t)h(\014eld)d +(unc)m(hanged)i(b)m(y)g(setting)f(the)h(input)e(COMMENT)227 +668 y(parameter)d(equal)g(to)g(the)g(amp)s(ersand)e(c)m(haracter)j +(\(&\))f(or)g(b)m(y)g(en)m(tering)f(a)h(n)m(ull)e(p)s(oin)m(ter)h(for)g +(the)h(commen)m(t)227 781 y(parameter.)40 b(The)24 b(\015t,)i(dbl,)f +(cmp,)g(and)g(dblcmp)d(v)m(ersions)j(of)g(this)f(routine)g(ha)m(v)m(e)i +(the)f(added)f(feature)h(that)227 894 y(if)g(the)i('decimals')e +(parameter)i(is)e(negativ)m(e,)k(then)d(the)g('G')h(displa)m(y)d +(format)j(rather)f(then)g(the)g('E')h(format)227 1007 +y(will)f(b)s(e)i(used)f(when)h(constructing)g(the)g(k)m(eyw)m(ord)h(v) +-5 b(alue,)29 b(taking)f(the)h(absolute)f(v)-5 b(alue)28 +b(of)g('decimals')g(for)227 1120 y(the)37 b(precision.)58 +b(This)34 b(will)g(suppress)h(trailing)f(zeros,)39 b(and)d(will)e(use)j +(a)g(\014xed)e(format)i(rather)g(than)f(an)227 1233 y(exp)s(onen)m +(tial)30 b(format,)h(dep)s(ending)c(on)k(the)f(magnitude)g(of)g(the)h +(v)-5 b(alue.)95 1468 y Fe(int)47 b(fits_modify_key_[str,)42 +b(longstr])k(/)h(ffm[kys,)f(kls])286 1581 y(\(fitsfile)g(*fptr,)g(char) +g(*keyname,)g(char)g(*value,)g(char)h(*comment,)334 1694 +y(>)h(int)e(*status\);)95 1920 y(int)h(fits_modify_key_[log,)42 +b(lng])47 b(/)g(ffmky[lj])286 2032 y(\(fitsfile)f(*fptr,)g(char)g +(*keyname,)g(DTYPE)g(numval,)g(char)g(*comment,)334 2145 +y(>)i(int)e(*status\))95 2371 y(int)h(fits_modify_key_[flt,)42 +b(dbl,)47 b(fixflt,)f(fixdbl])g(/)h(ffmky[edfg])286 2484 +y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE)g(numval,)g(int)h +(decimals,)334 2597 y(char)g(*comment,)e(>)i(int)g(*status\))95 +2823 y(int)g(fits_modify_key_[cmp,)42 b(dblcmp,)k(fixcmp,)g(fixdblcmp]) +f(/)i(ffmk[yc,ym,fc,fm])286 2936 y(\(fitsfile)f(*fptr,)g(char)g +(*keyname,)g(DTYPE)g(*numval,)g(int)g(decimals,)334 3049 +y(char)h(*comment,)e(>)i(int)g(*status\))0 3284 y Fi(6)81 +b Fj(Mo)s(dify)21 b(the)h(v)-5 b(alue)22 b(of)g(an)g(existing)g(k)m +(eyw)m(ord)g(to)h(b)s(e)f(unde\014ned,)g(or)g(n)m(ull.)36 +b(The)22 b(v)-5 b(alue)21 b(string)h(of)g(the)g(k)m(eyw)m(ord)227 +3397 y(is)29 b(set)i(to)g(blank.)39 b(Optionally)-8 b(,)28 +b(one)i(ma)m(y)h(lea)m(v)m(e)g(the)g(commen)m(t)g(\014eld)d(unc)m +(hanged)i(b)m(y)g(setting)g(the)g(input)227 3510 y(COMMENT)f(parameter) +g(equal)f(to)h(the)g(amp)s(ersand)e(c)m(haracter)k(\(&\))e(or)f(b)m(y)h +(en)m(tering)f(a)h(n)m(ull)e(p)s(oin)m(ter.)95 3745 y +Fe(int)47 b(fits_modify_key_null)c(/)k(ffmkyu)286 3858 +y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(char)g(*comment,)g(>)h(int)g +(*status\))0 4145 y Fd(9.3.7)112 b(Up)s(date)39 b(Keyw)m(ord)e +(Routines)0 4350 y Fi(1)81 b Fj(These)29 b(up)s(date)g(routines)g(mo)s +(dify)f(the)h(v)-5 b(alue,)30 b(and)f(optionally)f(the)i(commen)m(t)h +(\014eld,)e(of)h(the)g(k)m(eyw)m(ord)g(if)e(it)227 4462 +y(already)33 b(exists,)g(otherwise)f(the)h(new)f(k)m(eyw)m(ord)h(is)e +(app)s(ended)g(to)j(the)f(header.)47 b(A)33 b(separate)g(routine)f(is) +227 4575 y(pro)m(vided)c(for)h(eac)m(h)h(k)m(eyw)m(ord)f(data)h(t)m(yp) +s(e.)41 b(The)28 b(`longstr')h(v)m(ersion)g(has)f(the)i(same)f +(functionalit)m(y)e(as)j(the)227 4688 y(`str')h(v)m(ersion)f(except)i +(that)g(it)e(also)h(supp)s(orts)d(the)j(lo)s(cal)f(long)h(string)e(k)m +(eyw)m(ord)j(con)m(v)m(en)m(tion)g(for)e(strings)227 +4801 y(longer)h(than)g(68)h(c)m(haracters.)45 b(A)31 +b(n)m(ull)e(p)s(oin)m(ter)i(ma)m(y)g(b)s(e)g(en)m(tered)h(for)f(the)g +(commen)m(t)i(parameter)e(whic)m(h)227 4914 y(will)f(lea)m(v)m(e)j(the) +g(commen)m(t)g(\014eld)e(unc)m(hanged)h(or)g(blank.)45 +b(The)31 b(\015t,)i(dbl,)e(cmp,)i(and)e(dblcmp)f(v)m(ersions)i(of)227 +5027 y(this)d(routine)g(ha)m(v)m(e)i(the)e(added)g(feature)i(that)f(if) +f(the)h('decimals')f(parameter)h(is)f(negativ)m(e,)i(then)e(the)h('G') +227 5140 y(displa)m(y)e(format)i(rather)f(then)g(the)h('E')f(format)h +(will)d(b)s(e)i(used)f(when)h(constructing)g(the)g(k)m(eyw)m(ord)h(v)-5 +b(alue,)227 5253 y(taking)26 b(the)h(absolute)f(v)-5 +b(alue)25 b(of)i('decimals')e(for)h(the)h(precision.)37 +b(This)25 b(will)e(suppress)h(trailing)h(zeros,)j(and)227 +5366 y(will)34 b(use)j(a)g(\014xed)f(format)h(rather)g(than)f(an)h(exp) +s(onen)m(tial)e(format,)k(dep)s(ending)34 b(on)j(the)g(magnitude)f(of) +227 5479 y(the)31 b(v)-5 b(alue.)95 5714 y Fe(int)47 +b(fits_update_key_[str,)42 b(longstr])k(/)h(ffu[kys,)f(kls])p +eop +%%Page: 94 102 +94 101 bop 0 299 a Fj(94)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)286 +555 y Fe(\(fitsfile)46 b(*fptr,)g(char)g(*keyname,)g(char)g(*value,)g +(char)h(*comment,)334 668 y(>)h(int)e(*status\))95 894 +y(int)h(fits_update_key_[log,)42 b(lng])47 b(/)g(ffuky[lj])286 +1007 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE)g(numval,)g(char) +g(*comment,)334 1120 y(>)i(int)e(*status\))95 1346 y(int)h +(fits_update_key_[flt,)42 b(dbl,)47 b(fixflt,)f(fixdbl])g(/)h +(ffuky[edfg])286 1458 y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE) +g(numval,)g(int)h(decimals,)334 1571 y(char)g(*comment,)e(>)i(int)g +(*status\))95 1797 y(int)g(fits_update_key_[cmp,)42 b(dblcmp,)k +(fixcmp,)g(fixdblcmp])f(/)i(ffuk[yc,ym,fc,fm])286 1910 +y(\(fitsfile)f(*fptr,)g(char)g(*keyname,)g(DTYPE)g(*numval,)g(int)g +(decimals,)334 2023 y(char)h(*comment,)e(>)i(int)g(*status\))0 +2363 y Ff(9.4)135 b(De\014ne)45 b(Data)h(Scaling)g(and)e(Unde\014ned)h +(Pixel)h(P)l(arameters)0 2614 y Fj(These)37 b(routines)f(set)i(or)f(mo) +s(dify)f(the)h(in)m(ternal)f(parameters)i(used)e(b)m(y)i(CFITSIO)d(to)j +(either)f(scale)h(the)f(data)0 2727 y(or)f(to)h(represen)m(t)f +(unde\014ned)d(pixels.)56 b(Generally)35 b(CFITSIO)f(will)g(scale)i +(the)g(data)h(according)f(to)g(the)h(v)-5 b(alues)0 2840 +y(of)35 b(the)f(BSCALE)g(and)g(BZER)m(O)h(\(or)g(TSCALn)d(and)i(TZER)m +(On\))g(k)m(eyw)m(ords,)i(ho)m(w)m(ev)m(er)g(these)f(routines)e(ma)m(y) +0 2953 y(b)s(e)f(used)h(to)h(o)m(v)m(erride)f(the)g(k)m(eyw)m(ord)h(v) +-5 b(alues.)48 b(This)31 b(ma)m(y)j(b)s(e)f(useful)e(when)h(one)i(w)m +(an)m(ts)f(to)h(read)f(or)g(write)g(the)0 3066 y(ra)m(w)f(unscaled)f(v) +-5 b(alues)32 b(in)f(the)h(FITS)f(\014le.)46 b(Similarly)-8 +b(,)29 b(CFITSIO)i(generally)g(uses)h(the)g(v)-5 b(alue)32 +b(of)g(the)h(BLANK)0 3179 y(or)40 b(TNULLn)f(k)m(eyw)m(ord)h(to)h +(signify)c(an)j(unde\014ned)e(pixel,)j(but)e(these)h(routines)f(ma)m(y) +h(b)s(e)f(used)g(to)i(o)m(v)m(erride)0 3292 y(this)31 +b(v)-5 b(alue.)47 b(These)32 b(routines)f(do)i(not)f(create)i(or)f(mo)s +(dify)d(the)j(corresp)s(onding)d(header)j(k)m(eyw)m(ord)f(v)-5 +b(alues.)47 b(See)0 3405 y(App)s(endix)28 b(B)i(for)h(the)f +(de\014nition)e(of)j(the)f(parameters)h(used)e(in)h(these)g(routines.)0 +3669 y Fi(1)81 b Fj(Reset)26 b(the)g(scaling)e(factors)i(in)e(the)i +(primary)e(arra)m(y)i(or)f(image)h(extension;)h(do)s(es)e(not)g(c)m +(hange)i(the)f(BSCALE)227 3782 y(and)i(BZER)m(O)g(k)m(eyw)m(ord)h(v)-5 +b(alues)27 b(and)h(only)f(a\013ects)j(the)e(automatic)i(scaling)d(p)s +(erformed)g(when)g(the)h(data)227 3895 y(elemen)m(ts)e(are)g +(written/read)f(to/from)h(the)g(FITS)f(\014le.)38 b(When)25 +b(reading)g(from)g(a)h(FITS)f(\014le)f(the)i(returned)227 +4008 y(data)i(v)-5 b(alue)27 b(=)g(\(the)h(v)-5 b(alue)27 +b(giv)m(en)h(in)e(the)h(FITS)g(arra)m(y\))h(*)g(BSCALE)f(+)g(BZER)m(O.) +g(The)g(in)m(v)m(erse)h(form)m(ula)227 4121 y(is)i(used)f(when)h +(writing)e(data)j(v)-5 b(alues)30 b(to)h(the)f(FITS)g(\014le.)95 +4386 y Fe(int)47 b(fits_set_bscale)d(/)j(ffpscl)286 4499 +y(\(fitsfile)f(*fptr,)g(double)g(scale,)g(double)g(zero,)g(>)i(int)f +(*status\))0 4764 y Fi(2)81 b Fj(Reset)39 b(the)f(scaling)g(parameters) +g(for)h(a)f(table)g(column;)k(do)s(es)c(not)g(c)m(hange)i(the)e(TSCALn) +f(or)h(TZER)m(On)227 4877 y(k)m(eyw)m(ord)29 b(v)-5 b(alues)28 +b(and)f(only)h(a\013ects)h(the)g(automatic)g(scaling)e(p)s(erformed)g +(when)g(the)i(data)g(elemen)m(ts)g(are)227 4990 y(written/read)i +(to/from)h(the)g(FITS)f(\014le.)43 b(When)31 b(reading)f(from)h(a)h +(FITS)f(\014le)f(the)i(returned)e(data)i(v)-5 b(alue)227 +5103 y(=)25 b(\(the)i(v)-5 b(alue)25 b(giv)m(en)g(in)f(the)i(FITS)f +(arra)m(y\))h(*)g(TSCAL)e(+)i(TZER)m(O.)e(The)h(in)m(v)m(erse)h(form)m +(ula)f(is)f(used)h(when)227 5216 y(writing)k(data)i(v)-5 +b(alues)29 b(to)j(the)e(FITS)g(\014le.)95 5480 y Fe(int)47 +b(fits_set_tscale)d(/)j(fftscl)286 5593 y(\(fitsfile)f(*fptr,)g(int)h +(colnum,)e(double)i(scale,)f(double)g(zero,)334 5706 +y(>)i(int)e(*status\))p eop +%%Page: 95 103 +95 102 bop 0 299 a Fh(9.5.)72 b(SPECIALIZED)29 b(FITS)g(PRIMAR)-8 +b(Y)31 b(ARRA)-8 b(Y)32 b(OR)d(IMA)m(GE)j(EXTENSION)d(I/O)h(R)m +(OUTINES)125 b Fj(95)0 555 y Fi(3)81 b Fj(De\014ne)36 +b(the)g(in)m(teger)h(v)-5 b(alue)35 b(to)i(b)s(e)e(used)h(to)h(signify) +d(unde\014ned)g(pixels)g(in)h(the)h(primary)e(arra)m(y)j(or)f(image)227 +668 y(extension.)53 b(This)33 b(is)g(only)h(used)g(if)f(BITPIX)h(=)h +(8,)h(16,)g(or)f(32.)54 b(This)33 b(do)s(es)h(not)h(create)h(or)e(c)m +(hange)i(the)227 781 y(v)-5 b(alue)30 b(of)h(the)f(BLANK)h(k)m(eyw)m +(ord)g(in)e(the)h(header.)95 1038 y Fe(int)47 b(fits_set_imgnull)d(/)j +(ffpnul)286 1150 y(\(fitsfile)f(*fptr,)g(long)g(nulval,)g(>)i(int)f +(*status\))0 1407 y Fi(4)81 b Fj(De\014ne)36 b(the)g(string)f(to)h(b)s +(e)f(used)g(to)i(signify)d(unde\014ned)g(pixels)g(in)g(a)i(column)f(in) +g(an)g(ASCI)s(I)g(table.)57 b(This)227 1520 y(do)s(es)30 +b(not)h(create)h(or)e(c)m(hange)i(the)e(v)-5 b(alue)30 +b(of)h(the)f(TNULLn)g(k)m(eyw)m(ord.)95 1777 y Fe(int)47 +b(fits_set_atblnull)c(/)48 b(ffsnul)286 1889 y(\(fitsfile)e(*fptr,)g +(int)h(colnum,)e(char)i(*nulstr,)f(>)h(int)g(*status\))0 +2146 y Fi(5)81 b Fj(De\014ne)34 b(the)h(v)-5 b(alue)33 +b(to)i(b)s(e)f(used)g(to)h(signify)d(unde\014ned)g(pixels)h(in)g(an)h +(in)m(teger)h(column)e(in)g(a)h(binary)f(table)227 2259 +y(\(where)c(TF)m(ORMn)f(=)g('B',)i('I',)f(or)f('J'\).)i(This)c(do)s(es) +j(not)f(create)j(or)d(c)m(hange)i(the)e(v)-5 b(alue)28 +b(of)h(the)g(TNULLn)227 2372 y(k)m(eyw)m(ord.)95 2628 +y Fe(int)47 b(fits_set_btblnull)c(/)48 b(fftnul)286 2741 +y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i(nulval,)f(>)h(int)g +(*status\))0 3074 y Ff(9.5)135 b(Sp)t(ecialized)61 b(FITS)e(Primary)i +(Arra)l(y)f(or)h(IMA)l(GE)e(Extension)j(I/O)306 3224 +y(Routines)0 3474 y Fj(These)27 b(routines)g(read)g(or)h(write)f(data)h +(v)-5 b(alues)27 b(in)g(the)g(primary)f(data)i(arra)m(y)h(\(i.e.,)f +(the)g(\014rst)f(HDU)i(in)d(the)i(FITS)0 3587 y(\014le\))36 +b(or)h(an)f(IMA)m(GE)h(extension.)59 b(Automatic)38 b(data)f(t)m(yp)s +(e)g(con)m(v)m(ersion)f(is)g(p)s(erformed)f(for)h(if)g(the)h(data)g(t)m +(yp)s(e)0 3700 y(of)c(the)g(FITS)f(arra)m(y)h(\(as)g(de\014ned)f(b)m(y) +g(the)h(BITPIX)g(k)m(eyw)m(ord\))g(di\013ers)f(from)g(the)h(data)g(t)m +(yp)s(e)g(of)g(the)g(arra)m(y)g(in)0 3813 y(the)c(calling)f(routine.)39 +b(The)28 b(data)i(v)-5 b(alues)28 b(are)i(automatically)f(scaled)f(b)m +(y)h(the)h(BSCALE)e(and)g(BZER)m(O)h(header)0 3926 y(v)-5 +b(alues)24 b(as)i(they)f(are)g(b)s(eing)f(written)g(or)h(read)f(from)h +(the)g(FITS)f(arra)m(y)-8 b(.)40 b(Unlik)m(e)24 b(the)h(basic)g +(routines)e(describ)s(ed)g(in)0 4039 y(the)31 b(previous)f(c)m(hapter,) +j(most)e(of)h(these)g(routines)e(sp)s(eci\014cally)f(supp)s(ort)g(the)j +(FITS)e(random)h(groups)f(format.)0 4152 y(See)h(App)s(endix)c(B)k(for) +f(the)h(de\014nition)d(of)i(the)h(parameters)g(used)e(in)g(these)i +(routines.)0 4312 y(The)24 b(more)h(primitiv)m(e)e(reading)h(and)g +(writing)f(routines)g(\(i.)39 b(e.,)26 b(\013ppr)p 2364 +4312 28 4 v 32 w(,)g(\013ppn)p 2653 4312 V 31 w(,)g(\013ppn,)f(\013gp)m +(v)p 3185 4312 V 33 w(,)h(or)f(\013gpf)p 3552 4312 V +32 w(\))g(simply)0 4425 y(treat)g(the)g(primary)d(arra)m(y)j(as)f(a)h +(long)f(1-dimensional)e(arra)m(y)j(of)f(pixels,)g(ignoring)f(the)h(in)m +(trinsic)e(dimensionalit)m(y)0 4538 y(of)30 b(the)g(arra)m(y)-8 +b(.)42 b(When)30 b(dealing)f(with)f(a)j(2D)g(image,)f(for)g(example,)g +(the)g(application)f(program)h(m)m(ust)g(calculate)0 +4650 y(the)i(pixel)e(o\013set)i(in)e(the)i(1-D)h(arra)m(y)f(that)g +(corresp)s(onds)e(to)i(an)m(y)g(particular)e(X,)i(Y)f(co)s(ordinate)h +(in)e(the)h(image.)0 4763 y(C)25 b(programmers)h(should)e(note)i(that)g +(the)h(ordering)d(of)i(arra)m(ys)g(in)f(FITS)g(\014les,)h(and)f(hence)h +(in)f(all)f(the)i(CFITSIO)0 4876 y(calls,)38 b(is)e(more)h(similar)e +(to)i(the)h(dimensionalit)m(y)c(of)j(arra)m(ys)g(in)f(F)-8 +b(ortran)38 b(rather)f(than)f(C.)h(F)-8 b(or)38 b(instance)f(if)f(a)0 +4989 y(FITS)28 b(image)h(has)f(NAXIS1)h(=)f(100)i(and)e(NAXIS2)h(=)f +(50,)i(then)e(a)h(2-D)h(arra)m(y)f(just)f(large)h(enough)f(to)i(hold)d +(the)0 5102 y(image)k(should)d(b)s(e)i(declared)g(as)g(arra)m +(y[50][100])k(and)c(not)h(as)f(arra)m(y[100][50].)0 5262 +y(F)-8 b(or)36 b(con)m(v)m(enience,)h(higher-lev)m(el)d(routines)g(are) +h(also)g(pro)m(vided)f(to)h(sp)s(eci\014cly)e(deal)i(with)f(2D)h +(images)g(\(\013p2d)p 3872 5262 V 0 5375 a(and)26 b(\013g2d)p +372 5375 V 33 w(\))h(and)f(3D)i(data)f(cub)s(es)f(\(\013p3d)p +1467 5375 V 59 w(and)g(\013g3d)p 1893 5375 V 33 w(\).)40 +b(The)26 b(dimensionalit)m(y)e(of)j(the)g(FITS)f(image)h(is)e(passed)0 +5488 y(b)m(y)36 b(the)h(naxis1,)g(naxis2,)h(and)e(naxis3)g(parameters)g +(and)g(the)h(declared)e(dimensions)f(of)j(the)f(program)g(arra)m(y)0 +5601 y(are)30 b(passed)g(in)e(the)i(dim1)f(and)g(dim2)g(parameters.)41 +b(Note)31 b(that)f(the)g(dimensions)d(of)j(the)g(program)g(arra)m(y)g +(ma)m(y)0 5714 y(b)s(e)35 b(larger)g(than)g(the)h(dimensions)d(of)j +(the)g(FITS)e(arra)m(y)-8 b(.)58 b(F)-8 b(or)36 b(example)f(if)g(a)h +(FITS)e(image)i(with)e(NAXIS1)i(=)p eop +%%Page: 96 104 +96 103 bop 0 299 a Fj(96)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fj(NAXIS2)36 b(=)g(400)h(is)e(read)h(in)m(to)g(a)h(program)f +(arra)m(y)g(whic)m(h)f(is)g(dimensioned)e(as)k(512)g(x)f(512)h(pixels,) +f(then)g(the)0 668 y(image)f(will)d(just)i(\014ll)e(the)j(lo)m(w)m(er)g +(left)f(corner)g(of)h(the)g(arra)m(y)g(with)e(pixels)g(in)g(the)i +(range)g(1)g(-)g(400)g(in)f(the)g(X)h(an)0 781 y(Y)g(directions.)52 +b(This)33 b(has)i(the)g(e\013ect)h(of)f(taking)f(a)i(con)m(tiguous)e +(set)i(of)f(pixel)e(v)-5 b(alue)34 b(in)f(the)i(FITS)f(arra)m(y)i(and)0 +894 y(writing)28 b(them)i(to)h(a)f(non-con)m(tiguous)g(arra)m(y)h(in)d +(program)i(memory)g(\(i.e.,)h(there)f(are)h(no)m(w)f(some)g(blank)f +(pixels)0 1007 y(around)g(the)i(edge)g(of)g(the)f(image)h(in)e(the)h +(program)g(arra)m(y\).)0 1167 y(The)k(most)i(general)e(set)i(of)f +(routines)e(\(\013pss)p 1560 1167 28 4 v 33 w(,)j(\013gsv)p +1836 1167 V 33 w(,)g(and)e(\013gsf)p 2273 1167 V 33 w(\))h(ma)m(y)h(b)s +(e)e(used)g(to)h(transfer)g(a)g(rectangular)0 1280 y(subset)27 +b(of)h(the)g(pixels)d(in)i(a)h(FITS)f(N-dimensional)e(image)j(to)g(or)g +(from)f(an)g(arra)m(y)i(whic)m(h)d(has)h(b)s(een)g(declared)g(in)0 +1393 y(the)i(calling)e(program.)40 b(The)28 b(fpixel)f(and)h(lpixel)e +(parameters)j(are)g(in)m(teger)g(arra)m(ys)g(whic)m(h)e(sp)s(ecify)g +(the)i(starting)0 1506 y(and)k(ending)e(pixel)h(co)s(ordinate)h(in)f +(eac)m(h)i(dimension)d(\(starting)i(with)f(1,)i(not)g(0\))g(of)f(the)g +(FITS)g(image)g(that)h(is)0 1619 y(to)f(b)s(e)e(read)g(or)h(written.)44 +b(It)32 b(is)f(imp)s(ortan)m(t)g(to)i(note)f(that)h(these)f(are)g(the)g +(starting)g(and)f(ending)f(pixels)g(in)h(the)0 1732 y(FITS)j(image,)j +(not)e(in)e(the)i(declared)g(arra)m(y)g(in)e(the)i(program.)54 +b(The)35 b(arra)m(y)g(parameter)g(in)f(these)h(routines)f(is)0 +1844 y(treated)g(simply)c(as)j(a)f(large)h(one-dimensional)e(arra)m(y)i +(of)f(the)h(appropriate)f(data)h(t)m(yp)s(e)g(con)m(taining)f(the)h +(pixel)0 1957 y(v)-5 b(alues;)36 b(The)e(pixel)f(v)-5 +b(alues)34 b(in)g(the)g(FITS)g(arra)m(y)h(are)g(read/written)f(from/to) +i(this)d(program)i(arra)m(y)g(in)e(strict)0 2070 y(sequence)e(without)e +(an)m(y)i(gaps;)g(it)f(is)f(up)g(to)j(the)e(calling)f(routine)g(to)j +(correctly)e(in)m(terpret)g(the)h(dimensionalit)m(y)0 +2183 y(of)d(this)e(arra)m(y)-8 b(.)41 b(The)27 b(t)m(w)m(o)i(FITS)e +(reading)g(routines)f(\(\013gsv)p 2018 2183 V 61 w(and)h(\013gsf)p +2415 2183 V 61 w(\))h(also)f(ha)m(v)m(e)i(an)f(`inc')f(parameter)h +(whic)m(h)0 2296 y(de\014nes)33 b(the)h(data)h(sampling)d(in)m(terv)-5 +b(al)34 b(in)e(eac)m(h)k(dimension)31 b(of)j(the)h(FITS)e(arra)m(y)-8 +b(.)53 b(F)-8 b(or)35 b(example,)g(if)e(inc[0]=2)0 2409 +y(and)j(inc[1]=3)i(when)e(reading)g(a)h(2-dimensional)e(FITS)h(image,)k +(then)c(only)g(ev)m(ery)i(other)f(pixel)f(in)f(the)j(\014rst)0 +2522 y(dimension)28 b(and)i(ev)m(ery)h(3rd)f(pixel)e(in)h(the)i(second) +f(dimension)e(will)g(b)s(e)i(returned)f(to)i(the)f('arra)m(y')i +(parameter.)0 2682 y(Tw)m(o)d(t)m(yp)s(es)h(of)f(routines)f(are)i(pro)m +(vided)d(to)j(read)f(the)h(data)g(arra)m(y)f(whic)m(h)f(di\013er)g(in)g +(the)i(w)m(a)m(y)g(unde\014ned)d(pixels)0 2795 y(are)38 +b(handled.)59 b(The)37 b(\014rst)g(t)m(yp)s(e)g(of)g(routines)g +(\(e.g.,)j(\013gp)m(v)p 2059 2795 V 34 w(\))d(simply)e(return)h(an)h +(arra)m(y)h(of)g(data)g(elemen)m(ts)f(in)0 2908 y(whic)m(h)29 +b(unde\014ned)g(pixels)f(are)j(set)g(equal)f(to)i(a)f(v)-5 +b(alue)30 b(sp)s(eci\014ed)e(b)m(y)j(the)g(user)e(in)h(the)g(`n)m(ulv) +-5 b(al')30 b(parameter.)41 b(An)0 3021 y(additional)27 +b(feature)i(of)g(these)h(routines)d(is)h(that)i(if)e(the)h(user)f(sets) +h(n)m(ulv)-5 b(al)27 b(=)i(0,)h(then)e(no)h(c)m(hec)m(ks)h(for)f +(unde\014ned)0 3134 y(pixels)23 b(will)f(b)s(e)j(p)s(erformed,)f(th)m +(us)h(reducing)e(the)i(amoun)m(t)h(of)f(CPU)f(pro)s(cessing.)38 +b(The)24 b(second)h(t)m(yp)s(e)g(of)g(routines)0 3247 +y(\(e.g.,)36 b(\013gpf)p 413 3247 V 32 w(\))e(returns)e(the)i(data)g +(elemen)m(t)f(arra)m(y)h(and,)g(in)e(addition,)g(a)i(c)m(har)g(arra)m +(y)f(that)h(indicates)f(whether)0 3360 y(the)h(v)-5 b(alue)33 +b(of)h(the)f(corresp)s(onding)f(data)i(pixel)e(is)h(unde\014ned)e(\(=)j +(1\))g(or)g(de\014ned)e(\(=)i(0\).)51 b(The)33 b(latter)h(t)m(yp)s(e)g +(of)0 3472 y(routines)c(ma)m(y)i(b)s(e)e(more)i(con)m(v)m(enien)m(t)g +(to)g(use)f(in)f(some)h(circumstances,)h(ho)m(w)m(ev)m(er,)h(it)d +(requires)g(an)h(additional)0 3585 y(arra)m(y)g(of)f(logical)g(v)-5 +b(alues)30 b(whic)m(h)f(can)i(b)s(e)e(un)m(wieldy)f(when)i(w)m(orking)f +(with)g(large)i(data)g(arra)m(ys.)0 3859 y Fi(1)81 b +Fj(W)-8 b(rite)30 b(elemen)m(ts)h(in)m(to)f(the)h(FITS)f(data)h(arra)m +(y)-8 b(.)95 4133 y Fe(int)47 b(fits_write_img)d(/)k(ffppr)286 +4246 y(\(fitsfile)e(*fptr,)g(int)h(datatype,)e(long)i(firstelem,)e +(long)h(nelements,)334 4359 y(DTYPE)g(*array,)g(int)h(*status\);)95 +4585 y(int)g(fits_write_img_[byt,)c(sht,)j(usht,)h(int,)f(uint,)h(lng,) +f(ulng,)h(lnglng,)e(flt,)i(dbl])g(/)286 4698 y +(ffppr[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 4811 y(\(fitsfile)f(*fptr,)g +(long)g(group,)g(long)h(firstelem,)e(long)i(nelements,)334 +4924 y(DTYPE)f(*array,)g(>)i(int)f(*status\);)95 5149 +y(int)g(fits_write_imgnull)c(/)48 b(ffppn)286 5262 y(\(fitsfile)e +(*fptr,)g(int)h(datatype,)e(long)i(firstelem,)e(long)h(nelements,)334 +5375 y(DTYPE)g(*array,)g(DTYPE)h(*nulval,)e(>)j(int)f(*status\);)95 +5601 y(int)g(fits_write_imgnull_[byt,)42 b(sht,)k(usht,)h(int,)f(uint,) +h(lng,)f(ulng,)h(lnglng,)e(flt,)i(dbl])g(/)286 5714 y +(ffppn[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])p eop +%%Page: 97 105 +97 104 bop 0 299 a Fh(9.5.)72 b(SPECIALIZED)29 b(FITS)g(PRIMAR)-8 +b(Y)31 b(ARRA)-8 b(Y)32 b(OR)d(IMA)m(GE)j(EXTENSION)d(I/O)h(R)m +(OUTINES)125 b Fj(97)286 555 y Fe(\(fitsfile)46 b(*fptr,)g(long)g +(group,)g(long)h(firstelem,)525 668 y(long)g(nelements,)e(DTYPE)h +(*array,)g(DTYPE)g(nulval,)g(>)h(int)g(*status\);)0 924 +y Fi(2)81 b Fj(Set)30 b(data)h(arra)m(y)g(elemen)m(ts)g(as)f +(unde\014ned.)95 1180 y Fe(int)47 b(fits_write_img_null)c(/)k(ffppru) +286 1293 y(\(fitsfile)f(*fptr,)g(long)g(group,)g(long)h(firstelem,)e +(long)i(nelements,)334 1406 y(>)h(int)e(*status\))0 1662 +y Fi(3)81 b Fj(W)-8 b(rite)31 b(v)-5 b(alues)29 b(in)m(to)i(group)f +(parameters.)42 b(This)29 b(routine)g(only)h(applies)f(to)i(the)g +(`Random)f(Group)s(ed')g(FITS)227 1775 y(format)22 b(whic)m(h)e(has)h +(b)s(een)f(used)h(for)g(applications)e(in)h(radio)h(in)m(terferometry) +-8 b(,)24 b(but)c(is)g(o\016cially)g(deprecated)227 1888 +y(for)30 b(future)g(use.)95 2144 y Fe(int)47 b(fits_write_grppar_[byt,) +42 b(sht,)k(usht,)h(int,)f(uint,)h(lng,)f(ulng,)h(lnglng,)f(flt,)g +(dbl])h(/)286 2257 y(ffpgp[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 +2370 y(\(fitsfile)f(*fptr,)g(long)g(group,)g(long)h(firstelem,)e(long)i +(nelements,)334 2483 y(>)h(DTYPE)e(*array,)g(int)h(*status\))0 +2739 y Fi(4)81 b Fj(W)-8 b(rite)30 b(a)h(2-D)h(or)e(3-D)h(image)g(in)m +(to)f(the)h(data)g(arra)m(y)-8 b(.)95 2996 y Fe(int)47 +b(fits_write_2d_[byt,)c(sht,)k(usht,)f(int,)h(uint,)f(lng,)h(ulng,)f +(lnglng,)g(flt,)g(dbl])h(/)286 3108 y(ffp2d[b,i,ui,k,uk,j,uj,jj,)o(e,d) +o(])286 3221 y(\(fitsfile)f(*fptr,)g(long)g(group,)g(long)h(dim1,)f +(long)h(naxis1,)334 3334 y(long)g(naxis2,)f(DTYPE)g(*array,)g(>)h(int)g +(*status\))95 3560 y(int)g(fits_write_3d_[byt,)c(sht,)k(usht,)f(int,)h +(uint,)f(lng,)h(ulng,)f(lnglng,)g(flt,)g(dbl])h(/)286 +3673 y(ffp3d[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 3786 +y(\(fitsfile)f(*fptr,)g(long)g(group,)g(long)h(dim1,)f(long)h(dim2,)334 +3899 y(long)g(naxis1,)f(long)g(naxis2,)g(long)h(naxis3,)e(DTYPE)i +(*array,)f(>)h(int)g(*status\))0 4155 y Fi(5)81 b Fj(W)-8 +b(rite)30 b(an)h(arbitrary)e(data)i(subsection)e(in)m(to)i(the)f(data)h +(arra)m(y)-8 b(.)95 4411 y Fe(int)47 b(fits_write_subset_[byt,)42 +b(sht,)k(usht,)h(int,)f(uint,)h(lng,)f(ulng,)h(lnglng,)f(flt,)g(dbl])h +(/)286 4524 y(ffpss[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 +4637 y(\(fitsfile)f(*fptr,)g(long)g(group,)g(long)h(naxis,)f(long)h +(*naxes,)334 4750 y(long)g(*fpixel,)e(long)i(*lpixel,)e(DTYPE)i +(*array,)f(>)h(int)g(*status\))0 5006 y Fi(6)81 b Fj(Read)30 +b(elemen)m(ts)h(from)f(the)g(FITS)g(data)h(arra)m(y)-8 +b(.)95 5262 y Fe(int)47 b(fits_read_img)e(/)i(ffgpv)286 +5375 y(\(fitsfile)f(*fptr,)g(int)94 b(datatype,)46 b(long)g(firstelem,) +f(long)i(nelements,)334 5488 y(DTYPE)f(*nulval,)g(>)h(DTYPE)g(*array,)f +(int)h(*anynul,)e(int)i(*status\))95 5714 y(int)g(fits_read_img_[byt,)c +(sht,)k(usht,)f(int,)h(uint,)f(lng,)h(ulng,)f(lnglng,)g(flt,)g(dbl])h +(/)p eop +%%Page: 98 106 +98 105 bop 0 299 a Fj(98)1003 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)286 +555 y Fe(ffgpv[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 668 +y(\(fitsfile)46 b(*fptr,)g(long)g(group,)g(long)h(firstelem,)e(long)i +(nelements,)334 781 y(DTYPE)f(nulval,)g(>)i(DTYPE)e(*array,)g(int)h +(*anynul,)e(int)i(*status\))95 1007 y(int)g(fits_read_imgnull)c(/)48 +b(ffgpf)286 1120 y(\(fitsfile)e(*fptr,)g(int)94 b(datatype,)46 +b(long)g(firstelem,)f(long)i(nelements,)334 1233 y(>)h(DTYPE)e(*array,) +g(char)g(*nullarray,)f(int)i(*anynul,)f(int)g(*status\))95 +1458 y(int)95 b(fits_read_imgnull_[byt,)42 b(sht,)k(usht,)h(int,)f +(uint,)h(lng,)f(ulng,)h(flt,)f(dbl])h(/)334 1571 y +(ffgpf[b,i,ui,k,uk,j,uj,jj)o(,e,)o(d])334 1684 y(\(fitsfile)e(*fptr,)h +(long)h(group,)f(long)h(firstelem,)e(long)h(nelements,)334 +1797 y(>)i(DTYPE)e(*array,)g(char)g(*nullarray,)f(int)i(*anynul,)f(int) +g(*status\))0 2055 y Fi(7)81 b Fj(Read)29 b(v)-5 b(alues)30 +b(from)f(group)g(parameters.)41 b(This)28 b(routine)g(only)h(applies)f +(to)j(the)e(`Random)h(Group)s(ed')f(FITS)227 2168 y(format)22 +b(whic)m(h)e(has)h(b)s(een)f(used)h(for)g(applications)e(in)h(radio)h +(in)m(terferometry)-8 b(,)24 b(but)c(is)g(o\016cially)g(deprecated)227 +2281 y(for)30 b(future)g(use.)95 2538 y Fe(int)95 b +(fits_read_grppar_[byt,)42 b(sht,)k(usht,)h(int,)f(uint,)h(lng,)f +(ulng,)h(lnglng,)f(flt,)g(dbl])h(/)334 2651 y +(ffggp[b,i,ui,k,uk,j,uj,jj)o(,e,)o(d])334 2764 y(\(fitsfile)e(*fptr,)h +(long)h(group,)f(long)h(firstelem,)e(long)h(nelements,)334 +2877 y(>)i(DTYPE)e(*array,)g(int)h(*status\))0 3135 y +Fi(8)81 b Fj(Read)37 b(2-D)h(or)g(3-D)g(image)f(from)g(the)g(data)h +(arra)m(y)-8 b(.)62 b(Unde\014ned)36 b(pixels)g(in)f(the)j(arra)m(y)g +(will)c(b)s(e)j(set)g(equal)227 3247 y(to)32 b(the)g(v)-5 +b(alue)30 b(of)i('n)m(ulv)-5 b(al',)30 b(unless)g(n)m(ulv)-5 +b(al=0)29 b(in)h(whic)m(h)g(case)i(no)f(testing)h(for)f(unde\014ned)e +(pixels)g(will)g(b)s(e)227 3360 y(p)s(erformed.)95 3618 +y Fe(int)95 b(fits_read_2d_[byt,)43 b(sht,)k(usht,)f(int,)h(uint,)f +(lng,)h(ulng,)f(lnglng,)g(flt,)g(dbl])h(/)334 3731 y +(ffg2d[b,i,ui,k,uk,j,uj,jj)o(,e,)o(d])334 3844 y(\(fitsfile)e(*fptr,)h +(long)h(group,)f(DTYPE)h(nulval,)e(long)i(dim1,)f(long)h(naxis1,)334 +3957 y(long)g(naxis2,)f(>)h(DTYPE)f(*array,)g(int)h(*anynul,)f(int)h +(*status\))95 4183 y(int)95 b(fits_read_3d_[byt,)43 b(sht,)k(usht,)f +(int,)h(uint,)f(lng,)h(ulng,)f(lnglng,)g(flt,)g(dbl])h(/)334 +4295 y(ffg3d[b,i,ui,k,uk,j,uj,jj)o(,e,)o(d])334 4408 +y(\(fitsfile)e(*fptr,)h(long)h(group,)f(DTYPE)h(nulval,)e(long)i(dim1,) +334 4521 y(long)g(dim2,)f(long)h(naxis1,)f(long)g(naxis2,)g(long)h +(naxis3,)334 4634 y(>)h(DTYPE)e(*array,)g(int)h(*anynul,)e(int)i +(*status\))0 4892 y Fi(9)81 b Fj(Read)30 b(an)g(arbitrary)g(data)h +(subsection)e(from)h(the)g(data)i(arra)m(y)-8 b(.)95 +5149 y Fe(int)95 b(fits_read_subset_[byt,)42 b(sht,)k(usht,)h(int,)f +(uint,)h(lng,)f(ulng,)h(lnglng,)f(flt,)g(dbl])h(/)334 +5262 y(ffgsv[b,i,ui,k,uk,j,uj,jj)o(,e,)o(d])334 5375 +y(\(fitsfile)e(*fptr,)h(int)h(group,)f(int)h(naxis,)f(long)h(*naxes,) +334 5488 y(long)g(*fpixel,)e(long)i(*lpixel,)e(long)i(*inc,)f(DTYPE)h +(nulval,)334 5601 y(>)h(DTYPE)e(*array,)g(int)h(*anynul,)e(int)i +(*status\))p eop +%%Page: 99 107 +99 106 bop 0 299 a Fh(9.6.)72 b(SPECIALIZED)29 b(FITS)g(ASCI)s(I)g(AND) +i(BINAR)-8 b(Y)32 b(T)-8 b(ABLE)30 b(R)m(OUTINES)978 +b Fj(99)95 555 y Fe(int)95 b(fits_read_subsetnull_[byt)o(,)42 +b(sht,)k(usht,)h(int,)f(uint,)h(lng,)f(ulng,)h(lnglng,)f(flt,)g(dbl])h +(/)334 668 y(ffgsf[b,i,ui,k,uk,j,uj,jj)o(,e,)o(d])334 +781 y(\(fitsfile)e(*fptr,)h(int)h(group,)f(int)h(naxis,)f(long)h +(*naxes,)334 894 y(long)g(*fpixel,)e(long)i(*lpixel,)e(long)i(*inc,)f +(>)i(DTYPE)e(*array,)334 1007 y(char)h(*nullarray,)d(int)j(*anynul,)f +(int)h(*status\))0 1338 y Ff(9.6)135 b(Sp)t(ecialized)46 +b(FITS)e(ASCI)t(I)g(and)g(Binary)h(T)-11 b(able)45 b(Routines)0 +1591 y Fd(9.6.1)112 b(General)38 b(Column)e(Routines)0 +1797 y Fi(1)81 b Fj(Get)31 b(information)d(ab)s(out)i(an)g(existing)f +(ASCI)s(I)f(or)i(binary)e(table)i(column.)40 b(A)30 b(n)m(ull)e(p)s +(oin)m(ter)h(ma)m(y)i(b)s(e)e(giv)m(en)227 1910 y(for)40 +b(an)m(y)h(of)f(the)h(output)f(parameters)g(that)h(are)g(not)f(needed.) +70 b(D)m(A)-8 b(T)g(A)g(TYPE)42 b(is)d(a)i(c)m(haracter)h(string)227 +2023 y(whic)m(h)c(returns)f(the)i(data)g(t)m(yp)s(e)g(of)g(the)f +(column)g(as)h(de\014ned)e(b)m(y)i(the)f(TF)m(ORMn)h(k)m(eyw)m(ord)g +(\(e.g.,)j('I',)227 2136 y('J','E',)28 b('D',)g(etc.\).)41 +b(In)27 b(the)g(case)g(of)g(an)g(ASCI)s(I)f(c)m(haracter)i(column,)f(t) +m(yp)s(eco)s(de)g(will)d(ha)m(v)m(e)k(a)f(v)-5 b(alue)27 +b(of)g(the)227 2249 y(form)g('An')g(where)f('n')h(is)f(an)h(in)m(teger) +h(expressing)d(the)i(width)f(of)h(the)g(\014eld)f(in)f(c)m(haracters.) +41 b(F)-8 b(or)28 b(example,)227 2362 y(if)f(TF)m(ORM)i(=)e('160A8')k +(then)d(\013gb)s(cl)f(will)e(return)i(t)m(yp)s(ec)m(har='A8')j(and)d +(rep)s(eat=20.)41 b(All)27 b(the)h(returned)227 2475 +y(parameters)j(are)g(scalar)f(quan)m(tities.)95 2716 +y Fe(int)47 b(fits_get_acolparms)c(/)48 b(ffgacl)191 +2829 y(\(fitsfile)d(*fptr,)h(int)h(colnum,)f(>)h(char)g(*ttype,)f(long) +h(*tbcol,)239 2942 y(char)f(*tunit,)g(char)h(*tform,)f(double)g +(*scale,)f(double)i(*zero,)239 3055 y(char)f(*nulstr,)g(char)g(*tdisp,) +g(int)h(*status\))95 3280 y(int)g(fits_get_bcolparms)c(/)48 +b(ffgbcl)286 3393 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(>)j(char)f +(*ttype,)e(char)i(*tunit,)334 3506 y(char)g(*typechar,)e(long)h +(*repeat,)g(double)g(*scale,)g(double)g(*zero,)334 3619 +y(long)h(*nulval,)e(char)i(*tdisp,)f(int)94 b(*status\))0 +3861 y Fi(2)81 b Fj(Return)27 b(optimal)g(n)m(um)m(b)s(er)g(of)h(ro)m +(ws)g(to)h(read)f(or)g(write)f(at)i(one)f(time)g(for)g(maxim)m(um)f +(I/O)g(e\016ciency)-8 b(.)41 b(Refer)227 3973 y(to)25 +b(the)g(\\Optimizing)d(Co)s(de")i(section)h(in)e(Chapter)h(5)g(for)g +(more)h(discussion)d(on)i(ho)m(w)g(to)h(use)f(this)g(routine.)95 +4328 y Fe(int)47 b(fits_get_rowsize)d(/)j(ffgrsz)286 +4441 y(\(fitsfile)f(*fptr,)g(long)g(*nrows,)g(*status\))0 +4682 y Fi(3)81 b Fj(De\014ne)22 b(the)g(zero)i(indexed)c(b)m(yte)j +(o\013set)g(of)g(the)f('heap')h(measured)e(from)h(the)h(start)g(of)f +(the)g(binary)f(table)h(data.)227 4795 y(By)30 b(default)f(the)g(heap)h +(is)e(assumed)h(to)h(start)g(immediately)e(follo)m(wing)g(the)i +(regular)e(table)i(data,)g(i.e.,)g(at)227 4908 y(lo)s(cation)36 +b(NAXIS1)h(x)g(NAXIS2.)59 b(This)35 b(routine)g(is)h(only)f(relev)-5 +b(an)m(t)37 b(for)f(binary)f(tables)h(whic)m(h)g(con)m(tain)227 +5021 y(v)-5 b(ariable)23 b(length)h(arra)m(y)h(columns)e(\(with)g(TF)m +(ORMn)h(=)g('Pt'\).)40 b(This)22 b(routine)i(also)g(automatically)g +(writes)227 5134 y(the)35 b(v)-5 b(alue)34 b(of)h(theap)f(to)h(a)g(k)m +(eyw)m(ord)g(in)f(the)g(extension)g(header.)53 b(This)33 +b(routine)g(m)m(ust)i(b)s(e)f(called)f(after)227 5247 +y(the)e(required)d(k)m(eyw)m(ords)i(ha)m(v)m(e)i(b)s(een)d(written)g +(\(with)g(\013ph)m(bn\))g(but)h(b)s(efore)f(an)m(y)i(data)g(is)e +(written)g(to)i(the)227 5360 y(table.)95 5601 y Fe(int)47 +b(fits_write_theap)d(/)j(ffpthp)286 5714 y(\(fitsfile)f(*fptr,)g(long)g +(theap,)g(>)i(int)f(*status\))p eop +%%Page: 100 108 +100 107 bop 0 299 a Fj(100)958 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(4)81 b Fj(T)-8 b(est)37 b(the)f(con)m(ten)m(ts)i(of)f(the)g +(binary)d(table)j(v)-5 b(ariable)35 b(arra)m(y)i(heap,)h(returning)d +(the)h(size)g(of)h(the)g(heap,)h(the)227 668 y(n)m(um)m(b)s(er)30 +b(of)h(un)m(used)e(b)m(ytes)j(that)f(are)g(not)g(curren)m(tly)f(p)s +(oin)m(ted)g(to)i(b)m(y)e(an)m(y)i(of)f(the)g(descriptors,)f(and)g(the) +227 781 y(n)m(um)m(b)s(er)d(of)h(b)m(ytes)h(whic)m(h)e(are)h(p)s(oin)m +(ted)f(to)i(b)m(y)f(m)m(ultiple)e(descriptors.)39 b(It)28 +b(also)g(returns)f(v)-5 b(alid)27 b(=)g(F)-10 b(ALSE)227 +894 y(if)30 b(an)m(y)g(of)h(the)f(descriptors)g(p)s(oin)m(t)f(to)i(in)m +(v)-5 b(alid)28 b(addresses)i(out)g(of)h(range)g(of)f(the)h(heap.)95 +1153 y Fe(int)47 b(fits_test_heap)d(/)k(fftheap)286 1266 +y(\(fitsfile)e(*fptr,)g(>)h(long)g(*heapsize,)e(long)h(*unused,)g(long) +h(*overlap,)334 1379 y(int)g(*validheap,)e(int)i(*status\))0 +1637 y Fi(5)81 b Fj(Re-pac)m(k)33 b(the)f(v)m(ectors)h(in)d(the)i +(binary)e(table)i(v)-5 b(ariable)30 b(arra)m(y)i(heap)g(to)g(reco)m(v)m +(er)i(an)m(y)e(un)m(used)e(space.)45 b(Nor-)227 1750 +y(mally)-8 b(,)38 b(when)f(a)g(v)m(ector)i(in)d(a)h(v)-5 +b(ariable)36 b(length)h(arra)m(y)g(column)f(is)g(rewritten)h(the)g +(previously)e(written)227 1863 y(arra)m(y)f(remains)d(in)h(the)h(heap)f +(as)h(w)m(asted)h(un)m(used)d(space.)49 b(This)31 b(routine)g(will)g +(repac)m(k)i(the)g(arra)m(ys)g(that)227 1976 y(are)h(still)d(in)h(use,) +i(th)m(us)f(eliminating)d(an)m(y)k(b)m(ytes)g(in)e(the)h(heap)g(that)h +(are)g(no)f(longer)g(in)f(use.)49 b(Note)34 b(that)227 +2089 y(if)e(sev)m(eral)h(v)m(ectors)h(p)s(oin)m(t)d(to)j(the)e(same)h +(b)m(ytes)g(in)f(the)g(heap,)i(then)e(this)f(routine)h(will)e(mak)m(e)j +(duplicate)227 2202 y(copies)d(of)h(the)g(b)m(ytes)f(for)h(eac)m(h)g(v) +m(ector,)h(whic)m(h)d(will)f(actually)i(expand)g(the)g(size)h(of)f(the) +h(heap.)95 2461 y Fe(int)47 b(fits_compress_heap)c(/)48 +b(ffcmph)286 2574 y(\(fitsfile)e(*fptr,)g(>)h(int)g(*status\))0 +2864 y Fd(9.6.2)112 b(Lo)m(w-Lev)m(el)38 b(T)-9 b(able)37 +b(Access)g(Routines)0 3083 y Fj(The)g(follo)m(wing)g(2)h(routines)e +(pro)m(vide)h(lo)m(w-lev)m(el)h(access)h(to)g(the)f(data)g(in)f(ASCI)s +(I)f(or)i(binary)e(tables)h(and)h(are)0 3196 y(mainly)27 +b(useful)g(as)j(an)f(e\016cien)m(t)g(w)m(a)m(y)h(to)g(cop)m(y)g(all)e +(or)h(part)g(of)g(a)g(table)g(from)g(one)g(lo)s(cation)g(to)h(another.) +40 b(These)0 3309 y(routines)23 b(simply)f(read)i(or)h(write)e(the)i +(sp)s(eci\014ed)d(n)m(um)m(b)s(er)h(of)i(consecutiv)m(e)g(b)m(ytes)g +(in)e(an)h(ASCI)s(I)f(or)h(binary)f(table,)0 3422 y(without)g(regard)h +(for)f(column)g(b)s(oundaries)e(or)j(the)g(ro)m(w)g(length)f(in)f(the)i +(table.)39 b(These)23 b(routines)g(do)g(not)h(p)s(erform)0 +3535 y(an)m(y)36 b(mac)m(hine)g(dep)s(enden)m(t)f(data)i(con)m(v)m +(ersion)f(or)h(b)m(yte)f(sw)m(apping.)57 b(See)36 b(App)s(endix)d(B)k +(for)f(the)g(de\014nition)e(of)0 3648 y(the)d(parameters)f(used)g(in)f +(these)i(routines.)0 3906 y Fi(1)81 b Fj(Read)30 b(or)h(write)e(a)i +(consecutiv)m(e)g(arra)m(y)g(of)g(b)m(ytes)f(from)g(an)h(ASCI)s(I)d(or) +j(binary)d(table)95 4165 y Fe(int)47 b(fits_read_tblbytes)c(/)48 +b(ffgtbb)286 4278 y(\(fitsfile)e(*fptr,)g(long)g(firstrow,)g(long)g +(firstchar,)f(long)i(nchars,)334 4391 y(>)h(unsigned)d(char)i(*values,) +e(int)i(*status\))95 4617 y(int)g(fits_write_tblbytes)c(/)k(ffptbb)286 +4730 y(\(fitsfile)f(*fptr,)g(long)g(firstrow,)g(long)g(firstchar,)f +(long)i(nchars,)334 4843 y(unsigned)f(char)g(*values,)g(>)h(int)g +(*status\))0 5133 y Fd(9.6.3)112 b(W)-9 b(rite)36 b(Column)g(Data)i +(Routines)0 5342 y Fi(1)81 b Fj(W)-8 b(rite)27 b(elemen)m(ts)h(in)m(to) +f(an)h(ASCI)s(I)d(or)j(binary)d(table)j(column)e(\(in)g(the)i(CDU\).)g +(The)f(data)h(t)m(yp)s(e)f(of)h(the)f(arra)m(y)227 5455 +y(is)j(implied)d(b)m(y)j(the)h(su\016x)e(of)i(the)f(routine)g(name.)95 +5714 y Fe(int)47 b(fits_write_col_str)c(/)48 b(ffpcls)p +eop +%%Page: 101 109 +101 108 bop 0 299 a Fh(9.6.)72 b(SPECIALIZED)29 b(FITS)g(ASCI)s(I)g +(AND)i(BINAR)-8 b(Y)32 b(T)-8 b(ABLE)30 b(R)m(OUTINES)933 +b Fj(101)286 555 y Fe(\(fitsfile)46 b(*fptr,)g(int)h(colnum,)e(long)i +(firstrow,)e(long)i(firstelem,)334 668 y(long)g(nelements,)e(char)h +(**array,)g(>)h(int)g(*status\))95 894 y(int)g +(fits_write_col_[log,byt,sh)o(t,u)o(sht,)o(int,)o(uin)o(t,ln)o(g,ul)o +(ng,)o(lngl)o(ng,f)o(lt,)o(dbl,)o(cmp,)o(dbl)o(cmp])41 +b(/)286 1007 y(ffpcl[l,b,i,ui,k,uk,j,uj,j)o(j,e)o(,d,c)o(,m])286 +1120 y(\(fitsfile)46 b(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)525 +1233 y(long)g(firstelem,)e(long)h(nelements,)f(DTYPE)i(*array,)e(>)j +(int)f(*status\))0 1487 y Fi(2)81 b Fj(W)-8 b(rite)35 +b(elemen)m(ts)h(in)m(to)g(an)f(ASCI)s(I)f(or)i(binary)d(table)j(column) +e(substituting)f(the)j(appropriate)e(FITS)h(n)m(ull)227 +1600 y(v)-5 b(alue)37 b(for)h(an)m(y)g(elemen)m(ts)g(that)g(are)g +(equal)f(to)i(the)f(n)m(ulv)-5 b(al)36 b(parameter.)63 +b(This)36 b(routines)g(m)m(ust)i(not)g(b)s(e)227 1713 +y(used)30 b(to)h(write)f(to)h(v)-5 b(ariable)29 b(length)h(arra)m(y)g +(columns.)95 1967 y Fe(int)47 b(fits_write_colnull_[log,)42 +b(byt,)k(sht,)h(usht,)f(int,)h(uint,)f(lng,)h(ulng,)f(lnglng,)g(flt,)h +(dbl])f(/)286 2080 y(ffpcn[l,b,i,ui,k,uk,j,uj,j)o(j,e)o(,d])286 +2193 y(\(fitsfile)g(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)e(long)i +(firstelem,)334 2306 y(long)g(nelements,)e(DTYPE)h(*array,)g(DTYPE)g +(nulval,)g(>)i(int)e(*status\))0 2560 y Fi(3)81 b Fj(W)-8 +b(rite)26 b(string)g(elemen)m(ts)h(in)m(to)f(a)h(binary)e(table)h +(column)f(\(in)h(the)g(CDU\))i(substituting)c(the)i(FITS)g(n)m(ull)e(v) +-5 b(alue)227 2673 y(for)28 b(an)m(y)f(elemen)m(ts)h(that)g(are)g +(equal)f(to)i(the)e(n)m(ulstr)f(string.)39 b(This)26 +b(routine)g(m)m(ust)i(NOT)f(b)s(e)g(used)f(to)j(write)227 +2786 y(to)i(v)-5 b(ariable)30 b(length)f(arra)m(y)i(columns.)95 +3040 y Fe(int)47 b(fits_write_colnull_str)42 b(/)48 b(ffpcns)286 +3153 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)e(long)i +(firstelem,)334 3266 y(long)g(nelements,)e(char)h(**array,)g(char)h +(*nulstr,)e(>)j(int)e(*status\))0 3520 y Fi(4)81 b Fj(W)-8 +b(rite)33 b(bit)f(v)-5 b(alues)32 b(in)m(to)h(a)h(binary)d(b)m(yte)i +(\('B'\))i(or)e(bit)f(\('X'\))i(table)f(column)f(\(in)g(the)h(CDU\).)h +(Larra)m(y)f(is)f(an)227 3633 y(arra)m(y)25 b(of)g(c)m(haracters)h +(corresp)s(onding)d(to)i(the)g(sequence)g(of)f(bits)g(to)h(b)s(e)f +(written.)38 b(If)24 b(an)g(elemen)m(t)h(of)g(larra)m(y)227 +3746 y(is)j(true)h(\(not)h(equal)e(to)i(zero\))g(then)f(the)g(corresp)s +(onding)e(bit)h(in)g(the)h(FITS)f(table)h(is)f(set)i(to)g(1,)g +(otherwise)227 3859 y(the)37 b(bit)f(is)g(set)h(to)g(0.)60 +b(The)37 b('X')g(column)e(in)h(a)h(FITS)f(table)g(is)g(alw)m(a)m(ys)h +(padded)f(out)h(to)g(a)g(m)m(ultiple)e(of)227 3972 y(8)i(bits)e(where)h +(the)g(bit)g(arra)m(y)g(starts)h(with)e(the)i(most)f(signi\014can)m(t)f +(bit)h(of)g(the)h(b)m(yte)g(and)e(w)m(orks)h(do)m(wn)227 +4085 y(to)m(w)m(ards)h(the)g(1's)f(bit.)58 b(F)-8 b(or)37 +b(example,)h(a)e('4X')h(arra)m(y)-8 b(,)39 b(with)c(the)i(\014rst)e +(bit)h(=)f(1)i(and)f(the)g(remaining)f(3)227 4197 y(bits)30 +b(=)h(0)h(is)e(equiv)-5 b(alen)m(t)31 b(to)h(the)g(8-bit)f(unsigned)e +(b)m(yte)j(decimal)e(v)-5 b(alue)31 b(of)h(128)g(\('1000)i(0000B'\).)g +(In)d(the)227 4310 y(case)h(of)f('X')g(columns,)f(CFITSIO)g(can)h +(write)f(to)h(all)f(8)h(bits)f(of)h(eac)m(h)h(b)m(yte)f(whether)f(they) +h(are)g(formally)227 4423 y(v)-5 b(alid)32 b(or)h(not.)50 +b(Th)m(us)32 b(if)h(the)g(column)f(is)h(de\014ned)f(as)h('4X',)i(and)e +(one)g(calls)g(\013p)s(clx)f(with)g(\014rstbit=1)g(and)227 +4536 y(n)m(bits=8,)i(then)g(all)e(8)j(bits)d(will)f(b)s(e)j(written)f +(in)m(to)g(the)h(\014rst)f(b)m(yte)i(\(as)f(opp)s(osed)f(to)i(writing)c +(the)j(\014rst)g(4)227 4649 y(bits)27 b(in)m(to)h(the)f(\014rst)g(ro)m +(w)h(and)f(then)h(the)g(next)g(4)g(bits)e(in)m(to)i(the)g(next)g(ro)m +(w\),)h(ev)m(en)f(though)f(the)h(last)g(4)g(bits)227 +4762 y(of)j(eac)m(h)g(b)m(yte)g(are)f(formally)f(not)h(de\014ned)f(and) +h(should)e(all)h(b)s(e)g(set)i(=)f(0.)41 b(It)30 b(should)e(also)j(b)s +(e)e(noted)h(that)227 4875 y(it)j(is)e(more)i(e\016cien)m(t)h(to)f +(write)f('X')i(columns)d(an)i(en)m(tire)g(b)m(yte)g(at)h(a)f(time,)g +(instead)f(of)h(bit)f(b)m(y)h(bit.)47 b(An)m(y)227 4988 +y(of)31 b(the)g(CFITSIO)e(routines)g(that)j(write)e(to)h(columns)e +(\(e.g.)43 b(\014ts)p 2481 4988 28 4 v 33 w(write)p 2717 +4988 V 32 w(col)p 2860 4988 V 32 w(b)m(yt\))32 b(ma)m(y)f(b)s(e)f(used) +g(for)g(this)227 5101 y(purp)s(ose.)60 b(These)36 b(routines)h(will)d +(in)m(terpret)j('X')g(columns)f(as)h(though)g(they)h(w)m(ere)f('B')h +(columns)e(\(e.g.,)227 5214 y('1X')c(through)d('8X')j(is)d(equiv)-5 +b(alen)m(t)30 b(to)h('1B',)h(and)e('9X')h(through)f('16X')i(is)d(equiv) +-5 b(alen)m(t)30 b(to)h('2B'\).)95 5468 y Fe(int)47 b +(fits_write_col_bit)c(/)48 b(ffpclx)286 5581 y(\(fitsfile)e(*fptr,)g +(int)h(colnum,)e(long)i(firstrow,)e(long)i(firstbit,)334 +5694 y(long)g(nbits,)f(char)g(*larray,)g(>)h(int)g(*status\))p +eop +%%Page: 102 110 +102 109 bop 0 299 a Fj(102)958 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 +555 y Fi(5)81 b Fj(W)-8 b(rite)34 b(the)g(descriptor)f(for)g(a)h(v)-5 +b(ariable)33 b(length)g(column)g(in)f(a)j(binary)d(table.)51 +b(This)32 b(routine)g(can)j(b)s(e)e(used)227 668 y(in)g(conjunction)g +(with)f(\013gdes)i(to)h(enable)e(2)h(or)g(more)g(arra)m(ys)h(to)f(p)s +(oin)m(t)f(to)i(the)f(same)g(storage)h(lo)s(cation)227 +781 y(to)c(sa)m(v)m(e)h(storage)g(space)f(if)e(the)i(arra)m(ys)g(are)g +(iden)m(tical.)191 1045 y Fe(int)47 b(fits_write_descript)42 +b(/)48 b(ffpdes)382 1158 y(\(fitsfile)d(*fptr,)h(int)h(colnum,)f(long)h +(rownum,)e(long)i(repeat,)430 1271 y(long)f(offset,)g(>)h(int)g +(*status\))0 1567 y Fd(9.6.4)112 b(Read)38 b(Column)f(Data)h(Routines)0 +1787 y Fj(Tw)m(o)28 b(t)m(yp)s(es)f(of)h(routines)e(are)i(pro)m(vided)e +(to)i(get)h(the)e(column)g(data)h(whic)m(h)e(di\013er)g(in)g(the)i(w)m +(a)m(y)h(unde\014ned)c(pixels)0 1900 y(are)40 b(handled.)65 +b(The)39 b(\014rst)g(set)h(of)f(routines)f(\(\013gcv\))j(simply)c +(return)h(an)h(arra)m(y)h(of)g(data)g(elemen)m(ts)f(in)f(whic)m(h)0 +2013 y(unde\014ned)28 b(pixels)h(are)i(set)g(equal)f(to)h(a)g(v)-5 +b(alue)30 b(sp)s(eci\014ed)f(b)m(y)i(the)f(user)g(in)f(the)i('n)m(ullv) +-5 b(al')29 b(parameter.)41 b(If)30 b(n)m(ullv)-5 b(al)0 +2126 y(=)22 b(0,)j(then)d(no)g(c)m(hec)m(ks)i(for)e(unde\014ned)e +(pixels)h(will)f(b)s(e)i(p)s(erformed,)g(th)m(us)g(increasing)g(the)g +(sp)s(eed)g(of)g(the)h(program.)0 2239 y(The)36 b(second)g(set)g(of)h +(routines)d(\(\013gcf)7 b(\))38 b(returns)d(the)h(data)h(elemen)m(t)f +(arra)m(y)h(and)e(in)g(addition)f(a)j(logical)e(arra)m(y)0 +2351 y(of)e(\015ags)f(whic)m(h)f(de\014nes)h(whether)g(the)g(corresp)s +(onding)f(data)i(pixel)d(is)i(unde\014ned.)44 b(See)33 +b(App)s(endix)d(B)j(for)f(the)0 2464 y(de\014nition)c(of)j(the)f +(parameters)h(used)e(in)g(these)i(routines.)0 2625 y(An)m(y)39 +b(column,)g(regardless)f(of)h(it's)f(in)m(trinsic)e(data)k(t)m(yp)s(e,) +h(ma)m(y)e(b)s(e)f(read)g(as)h(a)g(string.)65 b(It)38 +b(should)f(b)s(e)h(noted)0 2737 y(ho)m(w)m(ev)m(er)32 +b(that)f(reading)e(a)i(n)m(umeric)e(column)g(as)i(a)f(string)g(is)f(10) +i(-)g(100)g(times)f(slo)m(w)m(er)h(than)f(reading)f(the)i(same)0 +2850 y(column)f(as)i(a)g(n)m(um)m(b)s(er)e(due)h(to)h(the)g(large)g(o)m +(v)m(erhead)g(in)f(constructing)g(the)h(formatted)g(strings.)43 +b(The)31 b(displa)m(y)0 2963 y(format)26 b(of)g(the)h(returned)d +(strings)h(will)e(b)s(e)j(determined)e(b)m(y)i(the)g(TDISPn)f(k)m(eyw)m +(ord,)j(if)c(it)i(exists,)h(otherwise)e(b)m(y)0 3076 +y(the)i(data)g(t)m(yp)s(e)f(of)h(the)f(column.)38 b(The)26 +b(length)g(of)h(the)f(returned)f(strings)g(\(not)i(including)c(the)k(n) +m(ull)d(terminating)0 3189 y(c)m(haracter\))38 b(can)e(b)s(e)g +(determined)e(with)h(the)h(\014ts)p 1722 3189 28 4 v +33 w(get)p 1875 3189 V 34 w(col)p 2020 3189 V 32 w(displa)m(y)p +2332 3189 V 31 w(width)f(routine.)56 b(The)36 b(follo)m(wing)e(TDISPn)0 +3302 y(displa)m(y)29 b(formats)h(are)h(curren)m(tly)e(supp)s(orted:)191 +3566 y Fe(Iw.m)142 b(Integer)191 3679 y(Ow.m)g(Octal)46 +b(integer)191 3792 y(Zw.m)142 b(Hexadecimal)45 b(integer)191 +3905 y(Fw.d)142 b(Fixed)46 b(floating)g(point)191 4018 +y(Ew.d)142 b(Exponential)45 b(floating)g(point)191 4131 +y(Dw.d)142 b(Exponential)45 b(floating)g(point)191 4244 +y(Gw.d)142 b(General;)46 b(uses)g(Fw.d)h(if)g(significance)d(not)j +(lost,)g(else)f(Ew.d)0 4508 y Fj(where)37 b(w)h(is)f(the)h(width)e(in)h +(c)m(haracters)i(of)f(the)h(displa)m(y)m(ed)d(v)-5 b(alues,)40 +b(m)d(is)g(the)h(minim)m(um)e(n)m(um)m(b)s(er)g(of)i(digits)0 +4621 y(displa)m(y)m(ed,)29 b(and)h(d)g(is)f(the)i(n)m(um)m(b)s(er)e(of) +h(digits)f(to)i(the)g(righ)m(t)f(of)h(the)f(decimal.)40 +b(The)30 b(.m)g(\014eld)f(is)g(optional.)0 4885 y Fi(1)81 +b Fj(Read)29 b(elemen)m(ts)h(from)f(an)g(ASCI)s(I)f(or)i(binary)e +(table)h(column)f(\(in)h(the)g(CDU\).)i(These)e(routines)f(return)h +(the)227 4998 y(v)-5 b(alues)29 b(of)h(the)g(table)g(column)f(arra)m(y) +h(elemen)m(ts.)41 b(Unde\014ned)28 b(arra)m(y)j(elemen)m(ts)f(will)d(b) +s(e)i(returned)g(with)g(a)227 5111 y(v)-5 b(alue)29 b(=)f(n)m(ulv)-5 +b(al,)28 b(unless)f(n)m(ulv)-5 b(al)27 b(=)h(0)i(\(or)f(=)f(')h(')g +(for)g(\013gcvs\))g(in)f(whic)m(h)f(case)j(no)f(c)m(hec)m(king)h(for)e +(unde\014ned)227 5224 y(v)-5 b(alues)27 b(will)e(b)s(e)i(p)s(erformed.) +39 b(The)27 b(ANYF)h(parameter)g(is)f(set)h(to)g(true)g(if)f(an)m(y)g +(of)h(the)g(returned)f(elemen)m(ts)227 5337 y(are)k(unde\014ned.)95 +5601 y Fe(int)47 b(fits_read_col_str)c(/)48 b(ffgcvs)286 +5714 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)e(long)i +(firstelem,)p eop +%%Page: 103 111 +103 110 bop 0 299 a Fh(9.6.)72 b(SPECIALIZED)29 b(FITS)g(ASCI)s(I)g +(AND)i(BINAR)-8 b(Y)32 b(T)-8 b(ABLE)30 b(R)m(OUTINES)933 +b Fj(103)334 555 y Fe(long)47 b(nelements,)e(char)h(*nulstr,)g(>)h +(char)g(**array,)f(int)g(*anynul,)334 668 y(int)h(*status\))95 +894 y(int)g(fits_read_col_[log,byt,sht)o(,us)o(ht,i)o(nt,u)o(int)o +(,lng)o(,uln)o(g,)41 b(lnglng,)46 b(flt,)h(dbl,)g(cmp,)f(dblcmp])g(/) +286 1007 y(ffgcv[l,b,i,ui,k,uk,j,uj,j)o(j,e)o(,d,c)o(,m])286 +1120 y(\(fitsfile)g(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)e(long)i +(firstelem,)334 1233 y(long)g(nelements,)e(DTYPE)h(nulval,)g(>)h(DTYPE) +g(*array,)f(int)g(*anynul,)334 1346 y(int)h(*status\))0 +1632 y Fi(2)81 b Fj(Read)39 b(elemen)m(ts)h(and)f(n)m(ull)f(\015ags)i +(from)f(an)g(ASCI)s(I)g(or)g(binary)f(table)i(column)e(\(in)h(the)h +(CHDU\).)g(These)227 1745 y(routines)28 b(return)f(the)i(v)-5 +b(alues)28 b(of)h(the)g(table)g(column)e(arra)m(y)j(elemen)m(ts.)40 +b(An)m(y)29 b(unde\014ned)d(arra)m(y)k(elemen)m(ts)227 +1858 y(will)h(ha)m(v)m(e)k(the)f(corresp)s(onding)d(n)m(ullarra)m(y)h +(elemen)m(t)i(set)g(equal)f(to)h(TR)m(UE.)g(The)f(an)m(yn)m(ul)g +(parameter)h(is)227 1971 y(set)d(to)g(true)f(if)g(an)m(y)h(of)f(the)h +(returned)e(elemen)m(ts)i(are)f(unde\014ned.)95 2257 +y Fe(int)47 b(fits_read_colnull_str)42 b(/)48 b(ffgcfs)286 +2370 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)e(long)i +(firstelem,)334 2483 y(long)g(nelements,)e(>)i(char)g(**array,)e(char)i +(*nullarray,)e(int)i(*anynul,)334 2596 y(int)g(*status\))95 +2822 y(int)g(fits_read_colnull_[log,byt)o(,sh)o(t,us)o(ht,i)o(nt,)o +(uint)o(,lng)o(,ul)o(ng,l)o(ngln)o(g,f)o(lt,d)o(bl,c)o(mp,)o(dblc)o +(mp])41 b(/)286 2935 y(ffgcf[l,b,i,ui,k,uk,j,uj,j)o(j,e)o(,d,c)o(,m]) +286 3048 y(\(fitsfile)46 b(*fptr,)g(int)h(colnum,)e(long)i(firstrow,) +334 3161 y(long)g(firstelem,)e(long)h(nelements,)f(>)j(DTYPE)e(*array,) +334 3274 y(char)h(*nullarray,)d(int)j(*anynul,)f(int)h(*status\))0 +3560 y Fi(3)81 b Fj(Read)24 b(an)g(arbitrary)f(data)i(subsection)e +(from)h(an)g(N-dimensional)e(arra)m(y)j(in)e(a)h(binary)f(table)h(v)m +(ector)i(column.)227 3673 y(Unde\014ned)21 b(pixels)g(in)g(the)i(arra)m +(y)g(will)d(b)s(e)i(set)h(equal)g(to)g(the)g(v)-5 b(alue)22 +b(of)h('n)m(ulv)-5 b(al',)23 b(unless)e(n)m(ulv)-5 b(al=0)21 +b(in)g(whic)m(h)227 3786 y(case)37 b(no)e(testing)g(for)g(unde\014ned)e +(pixels)g(will)g(b)s(e)i(p)s(erformed.)53 b(The)35 b(\014rst)g(and)f +(last)h(ro)m(ws)h(in)e(the)h(table)227 3899 y(to)30 b(b)s(e)e(read)h +(are)g(sp)s(eci\014ed)f(b)m(y)h(fpixel\(naxis+1\))d(and)j +(lpixel\(naxis+1\),)e(and)h(hence)h(are)h(treated)g(as)f(the)227 +4012 y(next)38 b(higher)e(dimension)f(of)j(the)f(FITS)g(N-dimensional)e +(arra)m(y)-8 b(.)63 b(The)37 b(INC)h(parameter)g(sp)s(eci\014es)e(the) +227 4125 y(sampling)29 b(in)m(terv)-5 b(al)29 b(in)g(eac)m(h)j +(dimension)c(b)s(et)m(w)m(een)j(the)f(data)h(elemen)m(ts)g(that)g(will) +d(b)s(e)h(returned.)95 4411 y Fe(int)47 b(fits_read_subset_[byt,)42 +b(sht,)47 b(usht,)f(int,)h(uint,)f(lng,)h(ulng,)f(lnglng,)g(flt,)h +(dbl])f(/)286 4524 y(ffgsv[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 +4637 y(\(fitsfile)g(*fptr,)g(int)h(colnum,)e(int)i(naxis,)f(long)h +(*naxes,)f(long)h(*fpixel,)334 4750 y(long)g(*lpixel,)e(long)i(*inc,)f +(DTYPE)h(nulval,)e(>)j(DTYPE)e(*array,)g(int)h(*anynul,)334 +4863 y(int)g(*status\))0 5149 y Fi(4)81 b Fj(Read)24 +b(an)g(arbitrary)f(data)i(subsection)e(from)h(an)g(N-dimensional)e +(arra)m(y)j(in)e(a)h(binary)f(table)h(v)m(ector)i(column.)227 +5262 y(An)m(y)34 b(Unde\014ned)e(pixels)g(in)h(the)g(arra)m(y)i(will)c +(ha)m(v)m(e)k(the)f(corresp)s(onding)d('n)m(ullarra)m(y')i(elemen)m(t)h +(set)g(equal)227 5375 y(to)40 b(TR)m(UE.)e(The)h(\014rst)e(and)h(last)h +(ro)m(ws)f(in)g(the)g(table)h(to)g(b)s(e)f(read)h(are)g(sp)s(eci\014ed) +d(b)m(y)j(fpixel\(naxis+1\))227 5488 y(and)i(lpixel\(naxis+1\),)i(and)e +(hence)h(are)g(treated)g(as)g(the)g(next)g(higher)f(dimension)e(of)j +(the)g(FITS)f(N-)227 5601 y(dimensional)f(arra)m(y)-8 +b(.)78 b(The)41 b(INC)h(parameter)h(sp)s(eci\014es)e(the)i(sampling)d +(in)m(terv)-5 b(al)42 b(in)f(eac)m(h)j(dimension)227 +5714 y(b)s(et)m(w)m(een)31 b(the)g(data)g(elemen)m(ts)g(that)g(will)c +(b)s(e)j(returned.)p eop +%%Page: 104 112 +104 111 bop 0 299 a Fj(104)958 b Fh(CHAPTER)30 b(9.)112 +b(SPECIALIZED)28 b(CFITSIO)h(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)95 +555 y Fe(int)47 b(fits_read_subsetnull_[byt,)41 b(sht,)47 +b(usht,)f(int,)h(uint,)f(lng,)h(ulng,)f(lnglng,)g(flt,)g(dbl])h(/)286 +668 y(ffgsf[b,i,ui,k,uk,j,uj,jj,)o(e,d)o(])286 781 y(\(fitsfile)f +(*fptr,)g(int)h(colnum,)e(int)i(naxis,)f(long)h(*naxes,)334 +894 y(long)g(*fpixel,)e(long)i(*lpixel,)e(long)i(*inc,)f(>)i(DTYPE)e +(*array,)334 1007 y(char)h(*nullarray,)d(int)j(*anynul,)f(int)h +(*status\))0 1227 y Fi(5)81 b Fj(Read)35 b(bit)f(v)-5 +b(alues)34 b(from)h(a)g(b)m(yte)h(\('B'\))g(or)f(bit)f(\(`X`\))i(table) +f(column)f(\(in)g(the)h(CDU\).)h(Larra)m(y)g(is)e(an)g(arra)m(y)227 +1340 y(of)g(logical)f(v)-5 b(alues)33 b(corresp)s(onding)f(to)i(the)g +(sequence)g(of)g(bits)f(to)h(b)s(e)f(read.)51 b(If)33 +b(larra)m(y)g(is)g(true)g(then)h(the)227 1453 y(corresp)s(onding)h(bit) +h(w)m(as)h(set)h(to)f(1,)j(otherwise)c(the)h(bit)f(w)m(as)h(set)h(to)f +(0.)61 b(The)37 b('X')g(column)f(in)f(a)j(FITS)227 1566 +y(table)d(is)e(alw)m(a)m(ys)i(padded)f(out)h(to)g(a)g(m)m(ultiple)d(of) +j(8)g(bits)e(where)h(the)h(bit)f(arra)m(y)h(starts)g(with)e(the)i(most) +227 1678 y(signi\014can)m(t)h(bit)f(of)i(the)g(b)m(yte)g(and)f(w)m +(orks)g(do)m(wn)h(to)m(w)m(ards)g(the)g(1's)g(bit.)58 +b(F)-8 b(or)37 b(example,)h(a)f('4X')h(arra)m(y)-8 b(,)227 +1791 y(with)32 b(the)i(\014rst)e(bit)h(=)g(1)h(and)e(the)i(remaining)d +(3)j(bits)e(=)h(0)h(is)e(equiv)-5 b(alen)m(t)33 b(to)h(the)g(8-bit)f +(unsigned)e(b)m(yte)227 1904 y(v)-5 b(alue)30 b(of)g(128.)42 +b(Note)31 b(that)g(in)d(the)j(case)g(of)f('X')g(columns,)f(CFITSIO)g +(can)h(read)g(all)f(8)h(bits)f(of)h(eac)m(h)h(b)m(yte)227 +2017 y(whether)h(they)h(are)g(formally)e(v)-5 b(alid)31 +b(or)h(not.)48 b(Th)m(us)31 b(if)h(the)g(column)g(is)f(de\014ned)g(as)i +('4X',)h(and)e(one)h(calls)227 2130 y(\013gcx)d(with)e(\014rstbit=1)f +(and)i(n)m(bits=8,)f(then)h(all)f(8)h(bits)f(will)e(b)s(e)j(read)g +(from)f(the)h(\014rst)g(b)m(yte)g(\(as)h(opp)s(osed)227 +2243 y(to)39 b(reading)e(the)h(\014rst)g(4)g(bits)f(from)h(the)g +(\014rst)f(ro)m(w)h(and)g(then)f(the)i(\014rst)e(4)h(bits)f(from)h(the) +g(next)g(ro)m(w\),)227 2356 y(ev)m(en)g(though)f(the)g(last)h(4)f(bits) +f(of)i(eac)m(h)g(b)m(yte)g(are)f(formally)f(not)i(de\014ned.)60 +b(It)37 b(should)e(also)i(b)s(e)g(noted)227 2469 y(that)f(it)e(is)h +(more)g(e\016cien)m(t)g(to)h(read)f('X')h(columns)d(an)i(en)m(tire)g(b) +m(yte)h(at)g(a)f(time,)h(instead)e(of)i(bit)e(b)m(y)h(bit.)227 +2582 y(An)m(y)29 b(of)g(the)h(CFITSIO)d(routines)h(that)h(read)g +(columns)f(\(e.g.)42 b(\014ts)p 2520 2582 28 4 v 32 w(read)p +2724 2582 V 33 w(col)p 2868 2582 V 33 w(b)m(yt\))29 b(ma)m(y)h(b)s(e)e +(used)g(for)h(this)227 2695 y(purp)s(ose.)60 b(These)36 +b(routines)h(will)d(in)m(terpret)j('X')g(columns)f(as)h(though)g(they)h +(w)m(ere)f('B')h(columns)e(\(e.g.,)227 2808 y('8X')c(is)d(equiv)-5 +b(alen)m(t)30 b(to)h('1B',)h(and)e('16X')i(is)d(equiv)-5 +b(alen)m(t)30 b(to)h('2B'\).)95 3027 y Fe(int)47 b(fits_read_col_bit)c +(/)48 b(ffgcx)286 3140 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i +(firstrow,)e(long)i(firstbit,)334 3253 y(long)g(nbits,)f(>)h(char)g +(*larray,)e(int)i(*status\))0 3473 y Fi(6)81 b Fj(Read)31 +b(an)m(y)h(consecutiv)m(e)h(set)f(of)g(bits)e(from)i(an)f('X')h(or)g +('B')h(column)d(and)h(in)m(terpret)g(them)h(as)f(an)h(unsigned)227 +3586 y(n-bit)g(in)m(teger.)47 b(n)m(bits)32 b(m)m(ust)g(b)s(e)g(less)g +(than)h(16)g(or)g(32)g(in)e(\013gcxui)i(and)e(\013gcxuk,)j(resp)s +(ectiv)m(ely)-8 b(.)47 b(If)32 b(nro)m(ws)227 3699 y(is)27 +b(greater)i(than)f(1,)h(then)e(the)h(same)h(set)f(of)g(bits)f(will)e(b) +s(e)i(read)h(from)f(eac)m(h)i(ro)m(w,)g(starting)f(with)e(\014rstro)m +(w.)227 3812 y(The)k(bits)f(are)i(n)m(um)m(b)s(ered)e(with)g(1)i(=)f +(the)h(most)f(signi\014can)m(t)g(bit)f(of)i(the)f(\014rst)g(elemen)m(t) +h(of)f(the)h(column.)95 4032 y Fe(int)47 b(fits_read_col_bit_[usht,)42 +b(uint])k(/)h(ffgcx[ui,uk])286 4145 y(\(fitsfile)f(*fptr,)g(int)h +(colnum,)e(long)i(firstrow,)e(long,)i(nrows,)334 4258 +y(long)g(firstbit,)e(long)i(nbits,)f(>)h(DTYPE)g(*array,)e(int)i +(*status\))0 4478 y Fi(7)81 b Fj(Return)27 b(the)i(descriptor)e(for)i +(a)g(v)-5 b(ariable)27 b(length)h(column)f(in)h(a)h(binary)d(table.)40 +b(The)28 b(descriptor)g(consists)g(of)227 4591 y(2)k(in)m(teger)f +(parameters:)42 b(the)31 b(n)m(um)m(b)s(er)f(of)h(elemen)m(ts)h(in)d +(the)i(arra)m(y)h(and)e(the)h(starting)g(o\013set)h(relativ)m(e)f(to) +227 4704 y(the)d(start)f(of)g(the)h(heap.)39 b(The)27 +b(\014rst)f(routine)g(returns)g(a)h(single)f(descriptor)g(whereas)h +(the)g(second)g(routine)227 4816 y(returns)i(the)i(descriptors)e(for)h +(a)h(range)g(of)f(ro)m(ws)h(in)e(the)h(table.)95 5036 +y Fe(int)47 b(fits_read_descript)c(/)48 b(ffgdes)286 +5149 y(\(fitsfile)e(*fptr,)g(int)h(colnum,)e(long)i(rownum,)f(>)h(long) +g(*repeat,)525 5262 y(long)g(*offset,)e(int)i(*status\))95 +5488 y(int)g(fits_read_descripts)c(/)k(ffgdess)286 5601 +y(\(fitsfile)f(*fptr,)g(int)h(colnum,)e(long)i(firstrow,)e(long)i +(nrows)f(>)i(long)e(*repeat,)525 5714 y(long)h(*offset,)e(int)i +(*status\))p eop +%%Page: 105 113 +105 112 bop 0 1225 a Fg(Chapter)65 b(10)0 1687 y Fm(Extended)77 +b(File)g(Name)g(Syn)-6 b(tax)0 2216 y Ff(10.1)136 b(Ov)l(erview)0 +2466 y Fj(CFITSIO)30 b(supp)s(orts)f(an)j(extended)f(syn)m(tax)h(when)f +(sp)s(ecifying)e(the)j(name)f(of)h(the)g(data)g(\014le)e(to)i(b)s(e)f +(op)s(ened)g(or)0 2579 y(created)g(that)g(includes)d(the)j(follo)m +(wing)e(features:)136 2813 y Fc(\017)46 b Fj(CFITSIO)40 +b(can)i(read)f(IRAF)h(format)g(images)f(whic)m(h)f(ha)m(v)m(e)j(header) +e(\014le)g(names)g(that)h(end)f(with)f(the)227 2926 y('.imh')d +(extension,)i(as)f(w)m(ell)e(as)i(reading)e(and)h(writing)e(FITS)i +(\014les,)h(This)e(feature)i(is)e(implemen)m(ted)g(in)227 +3039 y(CFITSIO)29 b(b)m(y)i(\014rst)e(con)m(v)m(erting)j(the)e(IRAF)h +(image)g(in)m(to)f(a)h(temp)s(orary)f(FITS)g(format)h(\014le)e(in)g +(memory)-8 b(,)227 3152 y(then)35 b(op)s(ening)e(the)i(FITS)f(\014le.) +53 b(An)m(y)35 b(of)g(the)g(usual)e(CFITSIO)h(routines)f(then)i(ma)m(y) +g(b)s(e)f(used)g(to)i(read)227 3265 y(the)31 b(image)f(header)g(or)h +(data.)41 b(Similarly)-8 b(,)27 b(ra)m(w)j(binary)f(data)i(arra)m(ys)f +(can)h(b)s(e)f(read)g(b)m(y)g(con)m(v)m(erting)h(them)227 +3378 y(on)g(the)f(\015y)g(in)m(to)g(virtual)f(FITS)h(images.)136 +3557 y Fc(\017)46 b Fj(FITS)37 b(\014les)g(on)g(the)h(in)m(ternet)g +(can)g(b)s(e)f(read)g(\(and)g(sometimes)h(written\))f(using)f(the)i +(FTP)-8 b(,)38 b(HTTP)-8 b(,)38 b(or)227 3670 y(R)m(OOT)30 +b(proto)s(cols.)136 3849 y Fc(\017)46 b Fj(FITS)30 b(\014les)f(can)i(b) +s(e)f(pip)s(ed)e(b)s(et)m(w)m(een)j(tasks)f(on)h(the)f(stdin)f(and)h +(stdout)g(streams.)136 4028 y Fc(\017)46 b Fj(FITS)36 +b(\014les)g(can)h(b)s(e)f(read)h(and)f(written)g(in)g(shared)g(memory) +-8 b(.)60 b(This)35 b(can)i(p)s(oten)m(tially)f(ac)m(hiev)m(e)i(b)s +(etter)227 4141 y(data)26 b(I/O)e(p)s(erformance)g(compared)h(to)h +(reading)e(and)g(writing)e(the)j(same)h(FITS)e(\014les)f(on)i(magnetic) +g(disk.)136 4320 y Fc(\017)46 b Fj(Compressed)30 b(FITS)f(\014les)h(in) +f(gzip)h(or)g(Unix)f(COMPRESS)g(format)h(can)h(b)s(e)f(directly)f +(read.)136 4499 y Fc(\017)46 b Fj(Output)28 b(FITS)h(\014les)f(can)h(b) +s(e)g(written)f(directly)g(in)f(compressed)i(gzip)g(format,)h(th)m(us)e +(sa)m(ving)h(disk)f(space.)136 4678 y Fc(\017)46 b Fj(FITS)26 +b(table)g(columns)f(can)i(b)s(e)f(created,)i(mo)s(di\014ed,)e(or)g +(deleted)g('on-the-\015y')h(as)g(the)g(table)f(is)f(op)s(ened)h(b)m(y) +227 4791 y(CFITSIO.)32 b(This)g(creates)j(a)e(virtual)f(FITS)h(\014le)f +(con)m(taining)h(the)h(mo)s(di\014cations)d(that)j(is)f(then)g(op)s +(ened)227 4904 y(b)m(y)e(the)f(application)f(program.)136 +5083 y Fc(\017)46 b Fj(T)-8 b(able)28 b(ro)m(ws)f(ma)m(y)i(b)s(e)e +(selected,)i(or)f(\014ltered)f(out,)h(on)g(the)g(\015y)f(when)g(the)h +(table)g(is)f(op)s(ened)g(b)m(y)g(CFITSIO,)227 5196 y(based)22 +b(on)f(an)g(user-sp)s(eci\014ed)f(expression.)37 b(Only)20 +b(ro)m(ws)h(for)g(whic)m(h)g(the)h(expression)e(ev)-5 +b(aluates)22 b(to)g('TR)m(UE')227 5309 y(are)31 b(retained)f(in)f(the)h +(cop)m(y)i(of)e(the)h(table)f(that)h(is)e(op)s(ened)h(b)m(y)g(the)h +(application)d(program.)136 5488 y Fc(\017)46 b Fj(Histogram)27 +b(images)g(ma)m(y)g(b)s(e)f(created)h(on)f(the)h(\015y)f(b)m(y)g +(binning)e(the)i(v)-5 b(alues)26 b(in)f(table)i(columns,)f(resulting) +227 5601 y(in)35 b(a)h(virtual)f(N-dimensional)e(FITS)j(image.)58 +b(The)35 b(application)f(program)i(then)g(only)f(sees)h(the)h(FITS)227 +5714 y(image)31 b(\(in)e(the)i(primary)d(arra)m(y\))k(instead)d(of)i +(the)f(original)f(FITS)g(table.)1882 5942 y(105)p eop +%%Page: 106 114 +106 113 bop 0 299 a Fj(106)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(The)39 +b(latter)h(3)g(table)g(\014ltering)e(features)i(in)e(particular)g(add)h +(v)m(ery)h(p)s(o)m(w)m(erful)e(data)j(pro)s(cessing)d(capabilities)0 +668 y(directly)31 b(in)m(to)h(CFITSIO,)f(and)h(hence)h(in)m(to)f(ev)m +(ery)h(task)g(that)g(uses)f(CFITSIO)f(to)i(read)f(or)h(write)e(FITS)h +(\014les.)0 781 y(F)-8 b(or)29 b(example,)f(these)g(features)h +(transform)e(a)h(v)m(ery)g(simple)e(program)i(that)g(just)g(copies)f +(an)h(input)e(FITS)h(\014le)g(to)0 894 y(a)d(new)f(output)h(\014le)f +(\(lik)m(e)g(the)h(`\014tscop)m(y')h(program)e(that)i(is)d(distributed) +f(with)i(CFITSIO\))f(in)m(to)i(a)g(m)m(ultipurp)s(ose)0 +1007 y(FITS)33 b(\014le)f(pro)s(cessing)g(to)s(ol.)50 +b(By)33 b(app)s(ending)e(fairly)h(simple)f(quali\014ers)g(on)m(to)j +(the)g(name)f(of)h(the)f(input)f(FITS)0 1120 y(\014le,)44 +b(the)e(user)f(can)h(p)s(erform)e(quite)h(complex)h(table)f(editing)g +(op)s(erations)g(\(e.g.,)46 b(create)d(new)e(columns,)j(or)0 +1233 y(\014lter)31 b(out)i(ro)m(ws)f(in)f(a)h(table\))h(or)f(create)i +(FITS)d(images)i(b)m(y)f(binning)d(or)j(histogramming)f(the)i(v)-5 +b(alues)31 b(in)g(table)0 1346 y(columns.)46 b(In)32 +b(addition,)f(these)i(functions)e(ha)m(v)m(e)j(b)s(een)e(co)s(ded)g +(using)f(new)h(state-of-the)j(art)e(algorithms)e(that)0 +1458 y(are,)g(in)e(some)i(cases,)g(10)h(-)e(100)i(times)e(faster)h +(than)f(previous)f(widely)f(used)h(implemen)m(tations.)0 +1619 y(Before)34 b(describing)d(the)j(complete)g(syn)m(tax)g(for)f(the) +h(extended)f(FITS)g(\014le)f(names)h(in)f(the)i(next)g(section,)g(here) +0 1732 y(are)d(a)g(few)f(examples)g(of)g(FITS)g(\014le)f(names)i(that)f +(giv)m(e)h(a)g(quic)m(k)f(o)m(v)m(erview)h(of)g(the)f(allo)m(w)m(ed)g +(syn)m(tax:)136 1984 y Fc(\017)46 b Fe(myfile.fits)p +Fj(:)38 b(the)30 b(simplest)f(case)i(of)g(a)g(FITS)e(\014le)h(on)g +(disk)f(in)g(the)i(curren)m(t)f(directory)-8 b(.)136 +2169 y Fc(\017)46 b Fe(myfile.imh)p Fj(:)i(op)s(ens)34 +b(an)h(IRAF)g(format)g(image)h(\014le)e(and)g(con)m(v)m(erts)j(it)d(on) +h(the)g(\015y)g(in)m(to)g(a)g(temp)s(orary)227 2282 y(FITS)30 +b(format)h(image)f(in)f(memory)i(whic)m(h)e(can)h(then)g(b)s(e)g(read)g +(with)f(an)m(y)i(other)g(CFITSIO)e(routine.)136 2467 +y Fc(\017)46 b Fe(rawfile.dat[i512,512])p Fj(:)35 b(op)s(ens)30 +b(a)g(ra)m(w)h(binary)d(data)j(arra)m(y)g(\(a)g(512)g(x)f(512)i(short)e +(in)m(teger)g(arra)m(y)h(in)227 2580 y(this)h(case\))j(and)d(con)m(v)m +(erts)j(it)d(on)h(the)g(\015y)g(in)m(to)g(a)g(temp)s(orary)g(FITS)f +(format)h(image)h(in)d(memory)i(whic)m(h)227 2693 y(can)e(then)f(b)s(e) +g(read)g(with)f(an)m(y)i(other)f(CFITSIO)f(routine.)136 +2878 y Fc(\017)46 b Fe(myfile.fits.gz)p Fj(:)d(if)32 +b(this)g(is)g(the)h(name)g(of)h(a)f(new)g(output)g(\014le,)g(the)g +('.gz')i(su\016x)d(will)e(cause)k(it)f(to)h(b)s(e)227 +2991 y(compressed)c(in)f(gzip)h(format)h(when)e(it)h(is)g(written)f(to) +i(disk.)136 3176 y Fc(\017)46 b Fe(myfile.fits.gz[events,)c(2])p +Fj(:)35 b(op)s(ens)20 b(and)f(uncompresses)g(the)i(gzipp)s(ed)e(\014le) +g(m)m(y\014le.\014ts)h(then)g(mo)m(v)m(es)227 3289 y(to)31 +b(the)g(extension)f(with)f(the)i(k)m(eyw)m(ords)f(EXTNAME)h(=)f +('EVENTS')g(and)g(EXTVER)g(=)g(2.)136 3474 y Fc(\017)46 +b Fe(-)p Fj(:)40 b(a)30 b(dash)f(\(min)m(us)f(sign\))h(signi\014es)f +(that)i(the)g(input)e(\014le)g(is)h(to)h(b)s(e)f(read)h(from)f(the)h +(stdin)e(\014le)h(stream,)h(or)227 3587 y(that)h(the)g(output)f(\014le) +f(is)h(to)h(b)s(e)f(written)f(to)i(the)g(stdout)f(stream.)136 +3772 y Fc(\017)46 b Fe(ftp://legacy.gsfc.nasa.go)o(v/te)o(st/v)o(ela)o +(.fit)o(s)p Fj(:)k(FITS)37 b(\014les)g(in)g(an)m(y)i(ftp)e(arc)m(hiv)m +(e)i(site)f(on)g(the)227 3885 y(in)m(ternet)30 b(ma)m(y)h(b)s(e)f +(directly)f(op)s(ened)h(with)f(read-only)h(access.)136 +4070 y Fc(\017)46 b Fe(http://legacy.gsfc.nasa.g)o(ov/s)o(oftw)o(are)o +(/tes)o(t.fi)o(ts)p Fj(:)33 b(an)m(y)27 b(v)-5 b(alid)26 +b(URL)h(to)h(a)g(FITS)e(\014le)h(on)g(the)227 4183 y(W)-8 +b(eb)31 b(ma)m(y)g(b)s(e)f(op)s(ened)g(with)f(read-only)g(access.)136 +4368 y Fc(\017)46 b Fe(root://legacy.gsfc.nasa.g)o(ov/t)o(est/)o(vel)o +(a.fi)o(ts)p Fj(:)e(similar)33 b(to)j(ftp)f(access)i(except)f(that)g +(it)f(pro-)227 4481 y(vides)29 b(write)h(as)g(w)m(ell)f(as)i(read)f +(access)h(to)g(the)f(\014les)g(across)g(the)h(net)m(w)m(ork.)41 +b(This)28 b(uses)i(the)h(ro)s(ot)f(proto)s(col)227 4594 +y(dev)m(elop)s(ed)g(at)h(CERN.)136 4779 y Fc(\017)46 +b Fe(shmem://h2[events])p Fj(:)j(op)s(ens)36 b(the)i(FITS)e(\014le)g +(in)g(a)h(shared)f(memory)h(segmen)m(t)h(and)f(mo)m(v)m(es)h(to)g(the) +227 4892 y(EVENTS)30 b(extension.)136 5077 y Fc(\017)46 +b Fe(mem://)p Fj(:)65 b(creates)44 b(a)g(scratc)m(h)g(output)f(\014le)f +(in)g(core)i(computer)f(memory)-8 b(.)79 b(The)43 b(resulting)e +('\014le')i(will)227 5190 y(disapp)s(ear)24 b(when)g(the)i(program)f +(exits,)h(so)g(this)e(is)h(mainly)e(useful)h(for)h(testing)h(purp)s +(oses)d(when)i(one)g(do)s(es)227 5303 y(not)31 b(w)m(an)m(t)g(a)g(p)s +(ermanen)m(t)f(cop)m(y)h(of)f(the)h(output)f(\014le.)136 +5488 y Fc(\017)46 b Fe(myfile.fits[3;)e(Images\(10\)])p +Fj(:)c(op)s(ens)30 b(a)i(cop)m(y)g(of)g(the)g(image)f(con)m(tained)h +(in)e(the)i(10th)g(ro)m(w)f(of)h(the)227 5601 y('Images')38 +b(column)e(in)g(the)h(binary)e(table)i(in)e(the)i(3th)g(extension)g(of) +g(the)g(FITS)f(\014le.)59 b(The)37 b(virtual)e(\014le)227 +5714 y(that)c(is)f(op)s(ened)f(b)m(y)i(the)f(application)f(just)h(con)m +(tains)g(this)f(single)g(image)i(in)e(the)i(primary)d(arra)m(y)-8 +b(.)p eop +%%Page: 107 115 +107 114 bop 0 299 a Fh(10.1.)73 b(O)m(VER)-10 b(VIEW)2995 +b Fj(107)136 555 y Fc(\017)46 b Fe(myfile.fits[1:512:2,)d(1:512:2])p +Fj(:)c(op)s(ens)30 b(a)h(section)g(of)h(the)f(input)e(image)i(ranging)f +(from)g(the)h(1st)227 668 y(to)k(the)f(512th)h(pixel)d(in)h(X)h(and)g +(Y,)g(and)f(selects)i(ev)m(ery)f(second)g(pixel)f(in)f(b)s(oth)h +(dimensions,)g(resulting)227 781 y(in)c(a)i(256)h(x)e(256)i(pixel)c +(input)h(image)h(in)g(this)f(case.)136 981 y Fc(\017)46 +b Fe(myfile.fits[EVENTS][col)c(Rad)47 b(=)g(sqrt\(X**2)e(+)j(Y**2\)])p +Fj(:)36 b(creates)27 b(and)d(op)s(ens)h(a)g(virtual)f(\014le)g(on)227 +1094 y(the)i(\015y)f(that)i(is)e(iden)m(tical)f(to)j(m)m +(y\014le.\014ts)e(except)h(that)h(it)e(will)e(con)m(tain)j(a)g(new)g +(column)e(in)h(the)h(EVENTS)227 1207 y(extension)40 b(called)g('Rad')h +(whose)f(v)-5 b(alue)40 b(is)g(computed)g(using)g(the)g(indicated)f +(expression)h(whic)m(h)f(is)h(a)227 1320 y(function)29 +b(of)i(the)f(v)-5 b(alues)30 b(in)f(the)i(X)f(and)g(Y)h(columns.)136 +1520 y Fc(\017)46 b Fe(myfile.fits[EVENTS][PHA)c(>)47 +b(5])p Fj(:)41 b(creates)33 b(and)d(op)s(ens)g(a)i(virtual)d(FITS)h +(\014les)g(that)h(is)f(iden)m(tical)g(to)227 1633 y('m)m +(y\014le.\014ts')39 b(except)i(that)f(the)f(EVENTS)g(table)g(will)e +(only)h(con)m(tain)i(the)f(ro)m(ws)h(that)g(ha)m(v)m(e)g(v)-5 +b(alues)39 b(of)227 1746 y(the)34 b(PHA)g(column)f(greater)i(than)e(5.) +52 b(In)33 b(general,)i(an)m(y)f(arbitrary)f(b)s(o)s(olean)f +(expression)h(using)f(a)j(C)e(or)227 1859 y(F)-8 b(ortran-lik)m(e)29 +b(syn)m(tax,)g(whic)m(h)e(ma)m(y)i(com)m(bine)f(AND)h(and)f(OR)f(op)s +(erators,)i(ma)m(y)g(b)s(e)f(used)f(to)i(select)g(ro)m(ws)227 +1972 y(from)h(a)h(table.)136 2172 y Fc(\017)46 b Fe +(myfile.fits[EVENTS][bin)c(\(X,Y\)=1,2048,4])p Fj(:)34 +b(creates)26 b(a)g(temp)s(orary)f(FITS)g(primary)e(arra)m(y)j(im-)227 +2285 y(age)38 b(whic)m(h)d(is)h(computed)g(on)g(the)h(\015y)f(b)m(y)g +(binning)d(\(i.e,)39 b(computing)c(the)i(2-dimensional)d(histogram\)) +227 2398 y(of)g(the)f(v)-5 b(alues)33 b(in)f(the)i(X)g(and)e(Y)i +(columns)e(of)i(the)f(EVENTS)g(extension.)49 b(In)33 +b(this)f(case)j(the)e(X)h(and)f(Y)227 2511 y(co)s(ordinates)g(range)h +(from)f(1)h(to)g(2048)h(and)e(the)h(image)f(pixel)f(size)h(is)g(4)g +(units)f(in)g(b)s(oth)h(dimensions,)f(so)227 2624 y(the)f(resulting)d +(image)j(is)e(512)j(x)e(512)i(pixels)d(in)g(size.)136 +2824 y Fc(\017)46 b Fj(The)31 b(\014nal)f(example)i(com)m(bines)f(man)m +(y)g(of)h(these)g(feature)g(in)m(to)f(one)h(complex)f(expression)f +(\(it)i(is)e(brok)m(en)227 2937 y(in)m(to)h(sev)m(eral)f(lines)f(for)h +(clarit)m(y\):)370 3206 y Fe(ftp://legacy.gsfc.nasa.gov)o(/dat)o(a/s)o +(ampl)o(e.fi)o(ts.)o(gz[E)o(VENT)o(S])370 3319 y([col)47 +b(phacorr)f(=)h(pha)g(*)h(1.1)f(-)g(0.3][phacorr)e(>=)i(5.0)g(&&)g +(phacorr)f(<=)h(14.0])370 3432 y([bin)g(\(X,Y\)=32])227 +3701 y Fj(In)37 b(this)g(case,)k(CFITSIO)36 b(\(1\))j(copies)f(and)f +(uncompresses)g(the)h(FITS)f(\014le)g(from)g(the)h(ftp)f(site)h(on)g +(the)227 3814 y(legacy)f(mac)m(hine,)h(\(2\))f(mo)m(v)m(es)g(to)g(the)g +('EVENTS')f(extension,)h(\(3\))g(calculates)g(a)f(new)g(column)f +(called)227 3927 y('phacorr',)30 b(\(4\))f(selects)g(the)g(ro)m(ws)g +(in)e(the)i(table)g(that)g(ha)m(v)m(e)h(phacorr)e(in)f(the)i(range)g(5) +g(to)h(14,)g(and)e(\014nally)227 4040 y(\(5\))35 b(bins)c(the)i +(remaining)e(ro)m(ws)i(on)h(the)f(X)g(and)g(Y)g(column)f(co)s +(ordinates,)i(using)d(a)j(pixel)d(size)i(=)g(32)h(to)227 +4153 y(create)d(a)f(2D)g(image.)41 b(All)28 b(this)g(pro)s(cessing)g +(is)h(completely)g(transparen)m(t)g(to)i(the)e(application)f(program,) +227 4266 y(whic)m(h)h(simply)f(sees)j(the)g(\014nal)e(2-D)i(image)g(in) +e(the)h(primary)f(arra)m(y)i(of)f(the)h(op)s(ened)f(\014le.)0 +4538 y(The)c(full)f(extended)i(CFITSIO)e(FITS)h(\014le)g(name)h(can)g +(con)m(tain)g(sev)m(eral)g(di\013eren)m(t)g(comp)s(onen)m(ts)g(dep)s +(ending)d(on)0 4651 y(the)31 b(con)m(text.)42 b(These)30 +b(comp)s(onen)m(ts)h(are)g(describ)s(ed)d(in)h(the)h(follo)m(wing)f +(sections:)0 4924 y Fe(When)47 b(creating)e(a)j(new)f(file:)143 +5036 y(filetype://BaseFilename\(t)o(empl)o(ate)o(Name)o(\)[co)o(mpr)o +(ess])0 5262 y(When)g(opening)e(an)j(existing)d(primary)h(array)g(or)i +(image)e(HDU:)143 5375 y(filetype://BaseFilename\(o)o(utNa)o(me\))o +([HDU)o(loca)o(tio)o(n][I)o(mage)o(Sec)o(tion)o(])0 5601 +y(When)h(opening)e(an)j(existing)d(table)i(HDU:)143 5714 +y(filetype://BaseFilename\(o)o(utNa)o(me\))o([HDU)o(loca)o(tio)o(n][c)o +(olFi)o(lte)o(r][r)o(owFi)o(lte)o(r][b)o(inSp)o(ec])p +eop +%%Page: 108 116 +108 115 bop 0 299 a Fj(108)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(The)41 +b(\014let)m(yp)s(e,)j(BaseFilename,)h(outName,)g(HDUlo)s(cation,)g(and) +c(ImageSection)h(comp)s(onen)m(ts,)j(if)c(presen)m(t,)0 +668 y(m)m(ust)30 b(b)s(e)g(giv)m(en)h(in)e(that)i(order,)g(but)f(the)g +(colFilter,)g(ro)m(wFilter,)h(and)e(binSp)s(ec)g(sp)s(eci\014ers)f(ma)m +(y)k(follo)m(w)d(in)h(an)m(y)0 781 y(order.)39 b(Regardless)28 +b(of)h(the)f(order,)g(ho)m(w)m(ev)m(er,)i(the)f(colFilter)e(sp)s +(eci\014er,)g(if)g(presen)m(t,)i(will)d(b)s(e)h(pro)s(cessed)h(\014rst) +f(b)m(y)0 894 y(CFITSIO,)i(follo)m(w)m(ed)h(b)m(y)g(the)h(ro)m(wFilter) +f(sp)s(eci\014er,)f(and)g(\014nally)g(b)m(y)h(the)g(binSp)s(ec)e(sp)s +(eci\014er.)0 1221 y Ff(10.2)136 b(Filet)l(yp)t(e)0 1471 +y Fj(The)37 b(t)m(yp)s(e)g(of)g(\014le)f(determines)g(the)h(medium)e +(on)i(whic)m(h)f(the)h(\014le)f(is)h(lo)s(cated)g(\(e.g.,)j(disk)c(or)h +(net)m(w)m(ork\))h(and,)0 1584 y(hence,)f(whic)m(h)d(in)m(ternal)g +(device)h(driv)m(er)f(is)g(used)g(b)m(y)h(CFITSIO)f(to)i(read)f(and/or) +g(write)f(the)h(\014le.)55 b(Curren)m(tly)0 1697 y(supp)s(orted)29 +b(t)m(yp)s(es)h(are)382 1913 y Fe(file://)93 b(-)48 b(file)e(on)i +(local)e(magnetic)g(disk)g(\(default\))382 2026 y(ftp://)141 +b(-)48 b(a)f(readonly)f(file)g(accessed)g(with)h(the)g(anonymous)e(FTP) +i(protocol.)907 2139 y(It)g(also)g(supports)93 b +(ftp://username:password@)o(host)o(nam)o(e/..)o(.)907 +2252 y(for)47 b(accessing)e(password-protected)e(ftp)k(sites.)382 +2365 y(http://)93 b(-)48 b(a)f(readonly)f(file)g(accessed)g(with)h(the) +g(HTTP)f(protocol.)93 b(It)907 2478 y(does)46 b(not)95 +b(support)46 b(username:password)d(like)k(the)g(ftp)f(driver.)907 +2591 y(Proxy)g(HTTP)h(survers)f(are)h(supported)e(using)h(the)h +(http_proxy)907 2704 y(environment)e(variable.)382 2817 +y(root://)93 b(-)48 b(uses)e(the)h(CERN)g(root)g(protocol)e(for)i +(writing)f(as)h(well)g(as)907 2930 y(reading)f(files)g(over)h(the)g +(network.)382 3042 y(shmem://)e(-)j(opens)e(or)h(creates)f(a)i(file)e +(which)h(persists)e(in)i(the)g(computer's)907 3155 y(shared)f(memory.) +382 3268 y(mem://)141 b(-)48 b(opens)e(a)i(temporary)d(file)i(in)g +(core)f(memory.)94 b(The)47 b(file)907 3381 y(disappears)e(when)h(the)h +(program)f(exits)h(so)g(this)f(is)i(mainly)907 3494 y(useful)e(for)h +(test)f(purposes)g(when)h(a)g(permanent)e(output)h(file)907 +3607 y(is)h(not)g(desired.)0 3824 y Fj(If)35 b(the)h(\014let)m(yp)s(e)f +(is)f(not)i(sp)s(eci\014ed,)g(then)f(t)m(yp)s(e)h(\014le://)g(is)e +(assumed.)56 b(The)35 b(double)f(slashes)h('//')i(are)f(optional)0 +3937 y(and)30 b(ma)m(y)h(b)s(e)e(omitted)i(in)e(most)i(cases.)0 +4220 y Fd(10.2.1)113 b(Notes)36 b(ab)s(out)j(HTTP)d(pro)m(xy)i(serv)m +(ers)0 4439 y Fj(A)32 b(pro)m(xy)g(HTTP)f(serv)m(er)h(ma)m(y)h(b)s(e)e +(used)g(b)m(y)h(de\014ning)e(the)i(address)f(\(URL\))i(and)e(p)s(ort)g +(n)m(um)m(b)s(er)g(of)h(the)g(pro)m(xy)0 4552 y(serv)m(er)f(with)e(the) +h(h)m(ttp)p 801 4552 28 4 v 33 w(pro)m(xy)g(en)m(vironmen)m(t)g(v)-5 +b(ariable.)40 b(F)-8 b(or)31 b(example)191 4769 y Fe(setenv)46 +b(http_proxy)f(http://heasarc.gsfc.nasa)o(.gov)o(:312)o(8)0 +4985 y Fj(will)35 b(cause)j(CFITSIO)f(to)h(use)g(p)s(ort)f(3128)i(on)f +(the)g(heasarc)g(pro)m(xy)g(serv)m(er)g(whenev)m(er)g(reading)f(a)h +(FITS)f(\014le)0 5098 y(with)29 b(HTTP)-8 b(.)0 5382 +y Fd(10.2.2)113 b(Notes)36 b(ab)s(out)j(the)e(ro)s(ot)g(\014let)m(yp)s +(e)0 5601 y Fj(The)20 b(original)g(ro)s(otd)g(serv)m(er)h(can)h(b)s(e)e +(obtained)g(from:)36 b Fe(ftp://root.cern.ch/root)o(/roo)o(td.t)o(ar.)o +(gz)15 b Fj(but,)22 b(for)0 5714 y(it)32 b(to)i(w)m(ork)f(correctly)g +(with)e(CFITSIO)h(one)h(has)f(to)i(use)e(a)i(mo)s(di\014ed)c(v)m +(ersion)j(whic)m(h)e(supp)s(orts)g(a)i(command)p eop +%%Page: 109 117 +109 116 bop 0 299 a Fh(10.2.)73 b(FILETYPE)3037 b Fj(109)0 +555 y(to)41 b(return)d(the)j(length)e(of)h(the)g(\014le.)69 +b(This)38 b(mo)s(di\014ed)f(v)m(ersion)j(is)f(a)m(v)-5 +b(ailable)39 b(in)g(ro)s(otd)g(sub)s(directory)f(in)h(the)0 +668 y(CFITSIO)29 b(ftp)h(area)h(at)286 928 y Fe +(ftp://legacy.gsfc.nasa.gov)o(/so)o(ftwa)o(re/f)o(its)o(io/c)o(/roo)o +(t/r)o(ootd)o(.tar)o(.gz)o(.)0 1187 y Fj(This)i(small)f(serv)m(er)j(is) +f(started)g(either)g(b)m(y)h(inetd)e(when)g(a)i(clien)m(t)f(requests)g +(a)h(connection)g(to)g(a)f(ro)s(otd)h(serv)m(er)0 1300 +y(or)30 b(b)m(y)g(hand)f(\(i.e.)41 b(from)30 b(the)g(command)g(line\).) +40 b(The)29 b(ro)s(otd)h(serv)m(er)h(w)m(orks)f(with)f(the)h(R)m(OOT)g +(TNetFile)g(class.)0 1413 y(It)g(allo)m(ws)e(remote)j(access)f(to)h(R)m +(OOT)e(database)h(\014les)e(in)g(either)h(read)h(or)f(write)g(mo)s(de.) +40 b(By)30 b(default)e(TNetFile)0 1526 y(assumes)38 b(p)s(ort)g(432)h +(\(whic)m(h)e(requires)g(ro)s(otd)h(to)h(b)s(e)f(started)h(as)f(ro)s +(ot\).)65 b(T)-8 b(o)39 b(run)e(ro)s(otd)h(via)g(inetd)f(add)h(the)0 +1639 y(follo)m(wing)29 b(line)g(to)i(/etc/services:)95 +1898 y Fe(rootd)238 b(432/tcp)0 2158 y Fj(and)30 b(to)h +(/etc/inetd.conf,)h(add)e(the)g(follo)m(wing)f(line:)95 +2417 y Fe(rootd)47 b(stream)f(tcp)h(nowait)f(root)h +(/user/rdm/root/bin/root)o(d)42 b(rootd)k(-i)0 2677 y +Fj(F)-8 b(orce)30 b(inetd)d(to)i(reread)f(its)g(conf)g(\014le)f(with)g +Fe(kill)47 b(-HUP)g()p Fj(.)39 b(Y)-8 b(ou)28 +b(can)h(also)f(start)h(ro)s(otd)f(b)m(y)g(hand)0 2790 +y(running)34 b(directly)h(under)f(y)m(our)j(priv)-5 b(ate)36 +b(accoun)m(t)h(\(no)g(ro)s(ot)g(system)f(privileges)e(needed\).)59 +b(F)-8 b(or)37 b(example)f(to)0 2903 y(start)f(ro)s(otd)g(listening)d +(on)j(p)s(ort)f(5151)j(just)d(t)m(yp)s(e:)49 b Fe(rootd)e(-p)g(5151)33 +b Fj(Notice)j(that)g(no)e(&)h(is)e(needed.)54 b(Ro)s(otd)0 +3016 y(will)28 b(go)j(in)m(to)f(bac)m(kground)g(b)m(y)h(itself.)95 +3275 y Fe(Rootd)47 b(arguments:)191 3388 y(-i)763 b(says)47 +b(we)g(were)f(started)g(by)h(inetd)191 3501 y(-p)g(port#)476 +b(specifies)45 b(a)j(different)d(port)i(to)g(listen)f(on)191 +3614 y(-d)h(level)476 b(level)46 b(of)i(debug)e(info)h(written)e(to)j +(syslog)1050 3727 y(0)f(=)h(no)f(debug)f(\(default\))1050 +3840 y(1)h(=)h(minimum)1050 3953 y(2)f(=)h(medium)1050 +4066 y(3)f(=)h(maximum)0 4325 y Fj(Ro)s(otd)29 b(can)f(also)g(b)s(e)g +(con\014gured)g(for)g(anon)m(ymous)g(usage)h(\(lik)m(e)f(anon)m(ymous)g +(ftp\).)40 b(T)-8 b(o)29 b(setup)f(ro)s(otd)g(to)h(accept)0 +4438 y(anon)m(ymous)h(logins)f(do)i(the)f(follo)m(wing)f(\(while)g(b)s +(eing)g(logged)i(in)e(as)h(ro)s(ot\):)143 4698 y Fe(-)48 +b(Add)f(the)f(following)g(line)g(to)i(/etc/passwd:)239 +4924 y(rootd:*:71:72:Anonymous)41 b(rootd:/var/spool/rootd:/b)o(in/)o +(fals)o(e)239 5149 y(where)46 b(you)h(may)g(modify)f(the)h(uid,)f(gid)h +(\(71,)g(72\))g(and)g(the)g(home)f(directory)239 5262 +y(to)h(suite)f(your)h(system.)143 5488 y(-)h(Add)f(the)f(following)g +(line)g(to)i(/etc/group:)239 5714 y(rootd:*:72:rootd)p +eop +%%Page: 110 118 +110 117 bop 0 299 a Fj(110)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)239 668 y +Fe(where)46 b(the)h(gid)g(must)f(match)h(the)g(gid)g(in)g(/etc/passwd.) +143 894 y(-)h(Create)e(the)h(directories:)239 1120 y(mkdir)f +(/var/spool/rootd)239 1233 y(mkdir)g(/var/spool/rootd/tmp)239 +1346 y(chmod)g(777)h(/var/spool/rootd/tmp)239 1571 y(Where)f +(/var/spool/rootd)d(must)k(match)f(the)h(rootd)g(home)f(directory)g(as) +239 1684 y(specified)f(in)i(the)g(rootd)f(/etc/passwd)f(entry.)143 +1910 y(-)j(To)f(make)f(writeable)g(directories)e(for)j(anonymous)f(do,) +h(for)f(example:)239 2136 y(mkdir)g(/var/spool/rootd/pub)239 +2249 y(chown)g(rootd:rootd)f(/var/spool/rootd/pub)0 2492 +y Fj(That's)d(all.)74 b(Sev)m(eral)42 b(additional)e(remarks:)64 +b(y)m(ou)42 b(can)g(login)f(to)i(an)f(anon)m(ymous)f(serv)m(er)i +(either)e(with)g(the)0 2605 y(names)31 b("anon)m(ymous")h(or)f("ro)s +(otd".)43 b(The)31 b(passw)m(ord)f(should)f(b)s(e)i(of)g(t)m(yp)s(e)g +(user@host.do.main.)42 b(Only)29 b(the)i(@)0 2718 y(is)d(enforced)g +(for)h(the)f(time)h(b)s(eing.)38 b(In)28 b(anon)m(ymous)h(mo)s(de)f +(the)g(top)h(of)g(the)g(\014le)e(tree)j(is)d(set)i(to)h(the)e(ro)s(otd) +h(home)0 2831 y(directory)-8 b(,)38 b(therefore)f(only)e(\014les)h(b)s +(elo)m(w)f(the)i(home)f(directory)g(can)g(b)s(e)g(accessed.)60 +b(Anon)m(ymous)36 b(mo)s(de)g(only)0 2944 y(w)m(orks)30 +b(when)g(the)g(serv)m(er)h(is)e(started)i(via)f(inetd.)0 +3232 y Fd(10.2.3)113 b(Notes)36 b(ab)s(out)j(the)e(shmem)g(\014let)m +(yp)s(e:)0 3451 y Fj(Shared)d(memory)h(\014les)f(are)h(curren)m(tly)f +(supp)s(orted)f(on)i(most)h(Unix)e(platforms,)h(where)g(the)g(shared)f +(memory)0 3564 y(segmen)m(ts)d(are)g(managed)g(b)m(y)f(the)g(op)s +(erating)g(system)h(k)m(ernel)e(and)h(`liv)m(e')g(indep)s(enden)m(tly)d +(of)k(pro)s(cesses.)40 b(They)0 3677 y(are)34 b(not)g(deleted)g(\(b)m +(y)g(default\))f(when)g(the)h(pro)s(cess)f(whic)m(h)g(created)i(them)f +(terminates,)g(although)g(they)g(will)0 3790 y(disapp)s(ear)d(if)h(the) +i(system)f(is)f(reb)s(o)s(oted.)49 b(Applications)31 +b(can)j(create)h(shared)d(memory)h(\014les)f(in)g(CFITSIO)g(b)m(y)0 +3903 y(calling:)143 4146 y Fe(fit_create_file\(&fitsfile)o(ptr,)41 +b("shmem://h2",)j(&status\);)0 4389 y Fj(where)25 b(the)g(ro)s(ot)h +(`\014le')e(names)i(are)f(curren)m(tly)f(restricted)h(to)h(b)s(e)f +('h0',)i('h1',)g('h2',)g('h3',)f(etc.,)i(up)d(to)g(a)h(maxim)m(um)0 +4502 y(n)m(um)m(b)s(er)20 b(de\014ned)f(b)m(y)i(the)g(the)g(v)-5 +b(alue)21 b(of)g(SHARED)p 1746 4502 28 4 v 33 w(MAXSEG)g(\(equal)g(to)g +(16)h(b)m(y)f(default\).)37 b(This)19 b(is)h(a)h(protot)m(yp)s(e)0 +4615 y(implemen)m(tation)27 b(of)i(the)g(shared)f(memory)g(in)m +(terface)h(and)f(a)h(more)g(robust)f(in)m(terface,)i(whic)m(h)d(will)f +(ha)m(v)m(e)k(few)m(er)0 4728 y(restrictions)f(on)h(the)h(n)m(um)m(b)s +(er)e(of)i(\014les)e(and)h(on)g(their)f(names,)i(ma)m(y)g(b)s(e)f(dev)m +(elop)s(ed)f(in)g(the)i(future.)0 4888 y(When)23 b(op)s(ening)g(an)g +(already)g(existing)g(FITS)g(\014le)g(in)f(shared)h(memory)h(one)g +(calls)e(the)i(usual)f(CFITSIO)f(routine:)143 5132 y +Fe(fits_open_file\(&fitsfilep)o(tr,)41 b("shmem://h7",)j(mode,)j +(&status\))0 5375 y Fj(The)26 b(\014le)g(mo)s(de)h(can)g(b)s(e)f(READ)m +(WRITE)h(or)g(READONL)-8 b(Y)28 b(just)e(as)h(with)e(disk)h(\014les.)38 +b(More)28 b(than)e(one)h(pro)s(cess)0 5488 y(can)35 b(op)s(erate)g(on)f +(READONL)-8 b(Y)35 b(mo)s(de)f(\014les)g(at)h(the)f(same)h(time.)53 +b(CFITSIO)33 b(supp)s(orts)f(prop)s(er)h(\014le)h(lo)s(c)m(king)0 +5601 y(\(b)s(oth)27 b(in)g(READONL)-8 b(Y)29 b(and)e(READ)m(WRITE)h(mo) +s(des\),)h(so)f(calls)f(to)h(\014ts)p 2572 5601 V 33 +w(op)s(en)p 2795 5601 V 32 w(\014le)f(ma)m(y)h(b)s(e)f(lo)s(c)m(k)m(ed) +i(out)f(un)m(til)0 5714 y(another)j(other)f(pro)s(cess)g(closes)h(the)f +(\014le.)p eop +%%Page: 111 119 +111 118 bop 0 299 a Fh(10.3.)73 b(BASE)30 b(FILENAME)2739 +b Fj(111)0 555 y(When)30 b(an)g(application)f(is)g(\014nished)f +(accessing)j(a)f(FITS)g(\014le)f(in)g(a)i(shared)e(memory)h(segmen)m +(t,)i(it)e(ma)m(y)h(close)f(it)0 668 y(\(and)k(the)g(\014le)f(will)e +(remain)h(in)h(the)h(system\))g(with)f(\014ts)p 1955 +668 28 4 v 32 w(close)p 2174 668 V 33 w(\014le,)h(or)g(delete)g(it)g +(with)e(\014ts)p 3191 668 V 33 w(delete)p 3456 668 V +33 w(\014le.)50 b(Ph)m(ys-)0 781 y(ical)34 b(deletion)g(is)g(p)s(ostp)s +(oned)f(un)m(til)h(the)h(last)f(pro)s(cess)h(calls)f +(\013clos/\013delt.)54 b(\014ts)p 2801 781 V 32 w(delete)p +3065 781 V 33 w(\014le)34 b(tries)h(to)g(obtain)g(a)0 +894 y(READ)m(WRITE)f(lo)s(c)m(k)f(on)g(the)g(\014le)g(to)h(b)s(e)e +(deleted,)i(th)m(us)f(it)g(can)g(b)s(e)g(blo)s(c)m(k)m(ed)g(if)f(the)i +(ob)5 b(ject)34 b(w)m(as)f(not)h(op)s(ened)0 1007 y(in)29 +b(READ)m(WRITE)i(mo)s(de.)0 1167 y(A)i(shared)f(memory)h(managemen)m(t) +h(utilit)m(y)d(program)i(called)f(`smem',)h(is)f(included)e(with)i(the) +h(CFITSIO)e(dis-)0 1280 y(tribution.)37 b(It)27 b(can)g(b)s(e)f(built)f +(b)m(y)i(t)m(yping)f(`mak)m(e)i(smem';)g(then)f(t)m(yp)s(e)g(`smem)f +(-h')h(to)h(get)g(a)f(list)e(of)i(v)-5 b(alid)25 b(options.)0 +1393 y(Executing)36 b(smem)g(without)f(an)m(y)i(options)f(causes)g(it)g +(to)h(list)e(all)g(the)i(shared)e(memory)i(segmen)m(ts)g(curren)m(tly)0 +1506 y(residing)31 b(in)h(the)h(system)h(and)e(managed)i(b)m(y)f(the)h +(shared)e(memory)h(driv)m(er.)48 b(T)-8 b(o)34 b(get)g(a)g(list)e(of)h +(all)f(the)i(shared)0 1619 y(memory)c(ob)5 b(jects,)32 +b(run)d(the)h(system)h(utilit)m(y)d(program)i(`ip)s(cs)g([-a]'.)0 +1978 y Ff(10.3)136 b(Base)45 b(Filename)0 2233 y Fj(The)31 +b(base)g(\014lename)g(is)f(the)i(name)f(of)h(the)f(\014le)g(optionally) +e(including)f(the)k(director/sub)s(directory)d(path,)j(and)0 +2346 y(in)d(the)i(case)g(of)g(`ftp',)f(`h)m(ttp',)i(and)d(`ro)s(ot')j +(\014let)m(yp)s(es,)d(the)i(mac)m(hine)f(iden)m(ti\014er.)39 +b(Examples:)191 2628 y Fe(myfile.fits)191 2741 y(!data.fits)191 +2854 y(/data/myfile.fits)191 2967 y(fits.gsfc.nasa.gov/ftp/s)o(ampl)o +(eda)o(ta/m)o(yfil)o(e.f)o(its.)o(gz)0 3248 y Fj(When)29 +b(creating)g(a)g(new)f(output)h(\014le)f(on)h(magnetic)g(disk)e(\(of)j +(t)m(yp)s(e)f(\014le://\))g(if)f(the)h(base)g(\014lename)f(b)s(egins)f +(with)0 3361 y(an)34 b(exclamation)h(p)s(oin)m(t)e(\(!\))54 +b(then)34 b(an)m(y)g(existing)g(\014le)f(with)g(that)i(same)g(basename) +g(will)d(b)s(e)h(deleted)h(prior)f(to)0 3474 y(creating)h(the)g(new)g +(FITS)f(\014le.)50 b(Otherwise)33 b(if)g(the)h(\014le)f(to)h(b)s(e)g +(created)h(already)e(exists,)i(then)e(CFITSIO)g(will)0 +3587 y(return)g(an)h(error)f(and)g(will)f(not)i(o)m(v)m(erwrite)g(the)g +(existing)f(\014le.)51 b(Note)35 b(that)g(the)f(exclamation)g(p)s(oin)m +(t,)g(')10 b(!',)36 b(is)d(a)0 3700 y(sp)s(ecial)26 b(UNIX)i(c)m +(haracter,)j(so)d(if)e(it)i(is)f(used)g(on)g(the)h(command)g(line)e +(rather)i(than)f(en)m(tered)h(at)h(a)f(task)h(prompt,)0 +3813 y(it)i(m)m(ust)g(b)s(e)g(preceded)g(b)m(y)h(a)g(bac)m(kslash)f(to) +h(force)g(the)g(UNIX)g(shell)d(to)j(pass)f(it)h(v)m(erbatim)f(to)h(the) +g(application)0 3926 y(program.)0 4086 y(If)24 b(the)i(output)e(disk)g +(\014le)g(name)h(ends)f(with)f(the)i(su\016x)f('.gz',)k(then)d(CFITSIO) +e(will)f(compress)j(the)g(\014le)f(using)g(the)0 4199 +y(gzip)g(compression)f(algorithm)g(b)s(efore)h(writing)e(it)i(to)h +(disk.)37 b(This)22 b(can)j(reduce)f(the)g(amoun)m(t)h(of)f(disk)f +(space)i(used)0 4312 y(b)m(y)34 b(the)h(\014le.)52 b(Note)36 +b(that)f(this)f(feature)h(requires)e(that)i(the)f(uncompressed)g +(\014le)f(b)s(e)h(constructed)h(in)e(memory)0 4425 y(b)s(efore)d(it)g +(is)f(compressed)h(and)g(written)g(to)h(disk,)e(so)h(it)g(can)h(fail)e +(if)g(there)i(is)e(insu\016cien)m(t)g(a)m(v)-5 b(ailable)30 +b(memory)-8 b(.)0 4585 y(An)45 b(input)f(FITS)g(\014le)h(ma)m(y)h(b)s +(e)f(compressed)g(with)g(the)g(gzip)g(or)h(Unix)e(compress)i +(algorithms,)i(in)c(whic)m(h)0 4698 y(case)38 b(CFITSIO)e(will)f +(uncompress)h(the)i(\014le)f(on)g(the)h(\015y)e(in)m(to)i(a)g(temp)s +(orary)f(\014le)f(\(in)h(memory)g(or)g(on)h(disk\).)0 +4811 y(Compressed)32 b(\014les)h(ma)m(y)h(only)e(b)s(e)h(op)s(ened)f +(with)g(read-only)h(p)s(ermission.)47 b(When)33 b(sp)s(ecifying)e(the)j +(name)f(of)h(a)0 4924 y(compressed)h(FITS)g(\014le)g(it)g(is)g(not)h +(necessary)g(to)g(app)s(end)e(the)i(\014le)f(su\016x)f(\(e.g.,)39 +b(`.gz')e(or)f(`.Z'\).)g(If)f(CFITSIO)0 5036 y(cannot)24 +b(\014nd)e(the)h(input)e(\014le)i(name)g(without)f(the)h(su\016x,)h +(then)f(it)g(will)e(automatically)i(searc)m(h)h(for)f(a)g(compressed)0 +5149 y(\014le)35 b(with)f(the)i(same)g(ro)s(ot)g(name.)57 +b(In)35 b(the)h(case)h(of)f(reading)f(ftp)g(and)g(h)m(ttp)h(t)m(yp)s(e) +g(\014les,)g(CFITSIO)f(generally)0 5262 y(lo)s(oks)i(for)h(a)g +(compressed)g(v)m(ersion)f(of)h(the)g(\014le)f(\014rst,)i(b)s(efore)e +(trying)g(to)i(op)s(en)e(the)h(uncompressed)e(\014le.)63 +b(By)0 5375 y(default,)36 b(CFITSIO)f(copies)g(\(and)h(uncompressed)e +(if)h(necessary\))h(the)g(ftp)f(or)h(h)m(ttp)g(FITS)f(\014le)f(in)m(to) +i(memory)0 5488 y(on)g(the)g(lo)s(cal)f(mac)m(hine)g(b)s(efore)h(op)s +(ening)e(it.)57 b(This)34 b(will)f(fail)h(if)h(the)h(lo)s(cal)f(mac)m +(hine)h(do)s(es)f(not)h(ha)m(v)m(e)h(enough)0 5601 y(memory)g(to)h +(hold)e(the)h(whole)g(FITS)f(\014le,)j(so)e(in)f(this)g(case,)41 +b(the)c(output)g(\014lename)f(sp)s(eci\014er)g(\(see)i(the)g(next)0 +5714 y(section\))31 b(can)g(b)s(e)e(used)h(to)h(further)e(con)m(trol)i +(ho)m(w)f(CFITSIO)f(reads)h(ftp)g(and)g(h)m(ttp)g(\014les.)p +eop +%%Page: 112 120 +112 119 bop 0 299 a Fj(112)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(If)32 +b(the)h(input)e(\014le)h(is)g(an)h(IRAF)g(image)g(\014le)f(\(*.imh)g +(\014le\))h(then)f(CFITSIO)f(will)g(automatically)h(con)m(v)m(ert)j(it) +d(on)0 668 y(the)27 b(\015y)g(in)m(to)g(a)h(virtual)d(FITS)h(image)i(b) +s(efore)f(it)f(is)g(op)s(ened)h(b)m(y)g(the)g(application)f(program.)39 +b(IRAF)27 b(images)h(can)0 781 y(only)h(b)s(e)h(op)s(ened)g(with)f +(READONL)-8 b(Y)31 b(\014le)e(access.)0 941 y(Similarly)-8 +b(,)28 b(if)i(the)h(input)e(\014le)i(is)f(a)h(ra)m(w)g(binary)e(data)j +(arra)m(y)-8 b(,)33 b(then)d(CFITSIO)g(will)e(con)m(v)m(ert)33 +b(it)d(on)h(the)h(\015y)e(in)m(to)0 1054 y(a)38 b(virtual)e(FITS)i +(image)g(with)e(the)i(basic)g(set)g(of)g(required)e(header)i(k)m(eyw)m +(ords)g(b)s(efore)g(it)f(is)g(op)s(ened)g(b)m(y)h(the)0 +1167 y(application)29 b(program)i(\(with)f(READONL)-8 +b(Y)31 b(access\).)44 b(In)30 b(this)g(case)i(the)f(data)g(t)m(yp)s(e)g +(and)g(dimensions)d(of)j(the)0 1280 y(image)c(m)m(ust)g(b)s(e)f(sp)s +(eci\014ed)f(in)h(square)h(brac)m(k)m(ets)h(follo)m(wing)d(the)i +(\014lename)f(\(e.g.)41 b(ra)m(w\014le.dat[ib512,512]\).)h(The)0 +1393 y(\014rst)30 b(c)m(haracter)i(\(case)f(insensitiv)m(e\))e +(de\014nes)h(the)g(data)h(t)m(yp)s(e)g(of)f(the)h(arra)m(y:)239 +1671 y Fe(b)429 b(8-bit)46 b(unsigned)g(byte)239 1784 +y(i)381 b(16-bit)46 b(signed)g(integer)239 1897 y(u)381 +b(16-bit)46 b(unsigned)g(integer)239 2010 y(j)381 b(32-bit)46 +b(signed)g(integer)239 2123 y(r)h(or)g(f)143 b(32-bit)46 +b(floating)g(point)239 2235 y(d)381 b(64-bit)46 b(floating)g(point)0 +2514 y Fj(An)40 b(optional)f(second)h(c)m(haracter)i(sp)s(eci\014es)d +(the)i(b)m(yte)f(order)g(of)g(the)h(arra)m(y)g(v)-5 b(alues:)59 +b(b)40 b(or)g(B)h(indicates)e(big)0 2626 y(endian)29 +b(\(as)h(in)f(FITS)g(\014les)g(and)g(the)h(nativ)m(e)h(format)f(of)g +(SUN)g(UNIX)g(w)m(orkstations)g(and)g(Mac)h(PCs\))e(and)h(l)f(or)0 +2739 y(L)e(indicates)g(little)f(endian)g(\(nativ)m(e)j(format)e(of)h +(DEC)g(OSF)f(w)m(orkstations)g(and)g(IBM)h(PCs\).)40 +b(If)27 b(this)f(c)m(haracter)0 2852 y(is)f(omitted)g(then)g(the)h +(arra)m(y)g(is)f(assumed)g(to)h(ha)m(v)m(e)h(the)f(nativ)m(e)f(b)m(yte) +i(order)e(of)g(the)h(lo)s(cal)f(mac)m(hine.)39 b(These)25 +b(data)0 2965 y(t)m(yp)s(e)35 b(c)m(haracters)h(are)g(then)e(follo)m(w) +m(ed)h(b)m(y)f(a)i(series)e(of)h(one)g(or)g(more)g(in)m(teger)g(v)-5 +b(alues)34 b(separated)i(b)m(y)e(commas)0 3078 y(whic)m(h)40 +b(de\014ne)g(the)h(size)g(of)g(eac)m(h)h(dimension)d(of)i(the)g(ra)m(w) +g(arra)m(y)-8 b(.)74 b(Arra)m(ys)41 b(with)e(up)h(to)i(5)f(dimensions)e +(are)0 3191 y(curren)m(tly)30 b(supp)s(orted.)41 b(Finally)-8 +b(,)30 b(a)h(b)m(yte)h(o\013set)g(to)g(the)f(p)s(osition)f(of)h(the)g +(\014rst)f(pixel)g(in)g(the)h(data)h(\014le)e(ma)m(y)i(b)s(e)0 +3304 y(sp)s(eci\014ed)g(b)m(y)h(separating)h(it)f(with)f(a)i(':')48 +b(from)33 b(the)h(last)f(dimension)e(v)-5 b(alue.)50 +b(If)33 b(omitted,)i(it)e(is)f(assumed)h(that)0 3417 +y(the)i(o\013set)h(=)f(0.)54 b(This)34 b(parameter)h(ma)m(y)h(b)s(e)e +(used)g(to)i(skip)d(o)m(v)m(er)j(an)m(y)g(header)e(information)g(in)f +(the)i(\014le)f(that)0 3530 y(precedes)c(the)h(binary)e(data.)41 +b(F)-8 b(urther)30 b(examples:)95 3808 y Fe(raw.dat[b10000])521 +b(1-dimensional)45 b(10000)h(pixel)g(byte)h(array)95 +3921 y(raw.dat[rb400,400,12])233 b(3-dimensional)45 b(floating)g(point) +h(big-endian)f(array)95 4034 y(img.fits[ib512,512:2880])89 +b(reads)47 b(the)g(512)g(x)g(512)g(short)f(integer)g(array)g(in)1336 +4147 y(a)i(FITS)e(file,)h(skipping)e(over)i(the)g(2880)g(byte)f(header) +0 4425 y Fj(One)25 b(sp)s(ecial)e(case)j(of)f(input)e(\014le)h(is)g +(where)h(the)g(\014lename)f(=)h(`-')h(\(a)f(dash)g(or)g(min)m(us)e +(sign\))h(or)h('stdin')f(or)h('stdout',)0 4538 y(whic)m(h)c +(signi\014es)g(that)j(the)f(input)d(\014le)i(is)g(to)i(b)s(e)e(read)g +(from)h(the)g(stdin)e(stream,)k(or)e(written)e(to)j(the)f(stdout)g +(stream)0 4650 y(if)33 b(a)h(new)g(output)f(\014le)g(is)g(b)s(eing)g +(created.)52 b(In)33 b(the)h(case)h(of)f(reading)g(from)f(stdin,)g +(CFITSIO)g(\014rst)g(copies)h(the)0 4763 y(whole)g(stream)i(in)m(to)f +(a)g(temp)s(orary)g(FITS)f(\014le)h(\(in)f(memory)h(or)g(on)g(disk\),)g +(and)g(subsequen)m(t)f(reading)g(of)i(the)0 4876 y(FITS)c(\014le)g(o)s +(ccurs)h(in)e(this)h(cop)m(y)-8 b(.)49 b(When)33 b(writing)e(to)i +(stdout,)h(CFITSIO)d(\014rst)h(constructs)h(the)g(whole)f(\014le)g(in)0 +4989 y(memory)i(\(since)h(random)e(access)j(is)d(required\),)i(then)f +(\015ushes)f(it)h(out)h(to)g(the)f(stdout)h(stream)g(when)e(the)i +(\014le)0 5102 y(is)29 b(closed.)41 b(In)29 b(addition,)g(if)g(the)h +(output)g(\014lename)f(=)h('-.gz')i(or)e('stdout.gz')h(then)f(it)g +(will)d(b)s(e)j(gzip)f(compressed)0 5215 y(b)s(efore)h(b)s(eing)f +(written)g(to)i(stdout.)0 5375 y(This)24 b(abilit)m(y)h(to)h(read)g +(and)f(write)g(on)h(the)g(stdin)f(and)g(stdout)h(steams)g(allo)m(ws)g +(FITS)f(\014les)g(to)h(b)s(e)g(pip)s(ed)d(b)s(et)m(w)m(een)0 +5488 y(tasks)42 b(in)e(memory)h(rather)g(than)h(ha)m(ving)f(to)h +(create)h(temp)s(orary)e(in)m(termediate)g(FITS)f(\014les)h(on)g(disk.) +72 b(F)-8 b(or)0 5601 y(example)27 b(if)e(task1)j(creates)h(an)e +(output)f(FITS)g(\014le,)h(and)g(task2)g(reads)g(an)g(input)e(FITS)h +(\014le,)h(the)g(FITS)f(\014le)g(ma)m(y)0 5714 y(b)s(e)k(pip)s(ed)e(b)s +(et)m(w)m(een)j(the)f(2)h(tasks)g(b)m(y)f(sp)s(ecifying)p +eop +%%Page: 113 121 +113 120 bop 0 299 a Fh(10.4.)73 b(OUTPUT)29 b(FILE)h(NAME)h(WHEN)g +(OPENING)f(AN)h(EXISTING)f(FILE)876 b Fj(113)143 555 +y Fe(task1)47 b(-)g(|)g(task2)g(-)0 783 y Fj(where)30 +b(the)h(v)m(ertical)g(bar)g(is)e(the)i(Unix)f(piping)e(sym)m(b)s(ol.)41 +b(This)29 b(assumes)h(that)i(the)f(2)g(tasks)g(read)g(the)g(name)g(of)0 +896 y(the)g(FITS)e(\014le)h(o\013)g(of)h(the)g(command)f(line.)0 +1224 y Ff(10.4)136 b(Output)44 b(File)i(Name)f(when)g(Op)t(ening)g(an)g +(Existing)h(File)0 1474 y Fj(An)36 b(optional)g(output)g(\014lename)g +(ma)m(y)i(b)s(e)e(sp)s(eci\014ed)f(in)g(paren)m(theses)i(immediately)e +(follo)m(wing)g(the)i(base)g(\014le)0 1587 y(name)28 +b(to)h(b)s(e)f(op)s(ened.)39 b(This)27 b(is)g(mainly)f(useful)h(in)g +(those)h(cases)i(where)d(CFITSIO)g(creates)j(a)e(temp)s(orary)g(cop)m +(y)0 1700 y(of)i(the)f(input)f(FITS)g(\014le)h(b)s(efore)g(it)g(is)f +(op)s(ened)h(and)f(passed)h(to)h(the)g(application)e(program.)40 +b(This)27 b(happ)s(ens)h(b)m(y)0 1813 y(default)h(when)h(op)s(ening)f +(a)h(net)m(w)m(ork)h(FTP)g(or)f(HTTP-t)m(yp)s(e)g(\014le,)g(when)f +(reading)g(a)i(compressed)f(FITS)g(\014le)f(on)0 1926 +y(a)36 b(lo)s(cal)f(disk,)h(when)f(reading)g(from)h(the)g(stdin)e +(stream,)k(or)d(when)g(a)i(column)d(\014lter,)j(ro)m(w)f(\014lter,)g +(or)g(binning)0 2039 y(sp)s(eci\014er)28 b(is)g(included)f(as)j(part)f +(of)g(the)h(input)e(\014le)g(sp)s(eci\014cation.)39 b(By)30 +b(default)f(this)f(temp)s(orary)h(\014le)f(is)h(created)0 +2152 y(in)g(memory)-8 b(.)41 b(If)29 b(there)h(is)f(not)h(enough)g +(memory)g(to)h(create)g(the)g(\014le)e(cop)m(y)-8 b(,)31 +b(then)f(CFITSIO)e(will)f(exit)j(with)f(an)0 2265 y(error.)45 +b(In)32 b(these)g(cases)h(one)g(can)f(force)h(a)f(p)s(ermanen)m(t)g +(\014le)f(to)i(b)s(e)e(created)i(on)f(disk,)f(instead)h(of)g(a)g(temp)s +(orary)0 2378 y(\014le)37 b(in)f(memory)-8 b(,)40 b(b)m(y)d(supplying)d +(the)k(name)g(in)e(paren)m(theses)i(immediately)e(follo)m(wing)g(the)h +(base)h(\014le)f(name.)0 2490 y(The)30 b(output)g(\014lename)f(can)i +(include)d(the)j(')10 b(!')41 b(clobb)s(er)29 b(\015ag.)0 +2651 y(Th)m(us,)48 b(if)c(the)h(input)e(\014lename)h(to)h(CFITSIO)f +(is:)69 b Fe(file1.fits.gz\(file2.fit)o(s\))39 b Fj(then)44 +b(CFITSIO)g(will)0 2764 y(uncompress)39 b(`\014le1.\014ts.gz')i(in)m +(to)f(the)g(lo)s(cal)f(disk)f(\014le)h(`\014le2.\014ts')h(b)s(efore)g +(op)s(ening)e(it.)69 b(CFITSIO)38 b(do)s(es)i(not)0 2876 +y(automatically)30 b(delete)h(the)f(output)g(\014le,)g(so)h(it)f(will)d +(still)i(exist)h(after)h(the)f(application)f(program)h(exits.)0 +3037 y(The)i(output)h(\014lename)f("mem://")j(is)d(also)h(allo)m(w)m +(ed,)h(whic)m(h)d(will)g(write)h(the)h(output)f(\014le)g(in)m(to)h +(memory)-8 b(,)35 b(and)0 3150 y(also)27 b(allo)m(w)f(write)g(access)i +(to)g(the)f(\014le.)38 b(This)25 b('\014le')i(will)d(disapp)s(ear)h +(when)h(it)g(is)g(closed,)h(but)f(this)g(ma)m(y)i(b)s(e)e(useful)0 +3262 y(for)k(some)h(applications)d(whic)m(h)i(only)f(need)h(to)h(mo)s +(dify)e(a)i(temp)s(orary)f(cop)m(y)h(of)f(the)h(\014le.)0 +3423 y(In)k(some)i(cases,)h(sev)m(eral)e(di\013eren)m(t)g(temp)s(orary) +f(FITS)h(\014les)f(will)e(b)s(e)i(created)i(in)e(sequence,)j(for)e +(instance,)h(if)0 3535 y(one)g(op)s(ens)g(a)g(remote)h(\014le)e(using)g +(FTP)-8 b(,)37 b(then)g(\014lters)f(ro)m(ws)h(in)f(a)i(binary)d(table)i +(extension,)i(then)d(create)j(an)0 3648 y(image)e(b)m(y)g(binning)d(a)j +(pair)f(of)h(columns.)59 b(In)36 b(this)g(case,)k(the)d(remote)h +(\014le)e(will)e(b)s(e)i(copied)g(to)i(a)f(temp)s(orary)0 +3761 y(lo)s(cal)h(\014le,)i(then)e(a)h(second)f(temp)s(orary)h(\014le)e +(will)f(b)s(e)i(created)i(con)m(taining)e(the)g(\014ltered)g(ro)m(ws)g +(of)h(the)g(table,)0 3874 y(and)c(\014nally)e(a)j(third)d(temp)s(orary) +i(\014le)g(con)m(taining)f(the)i(binned)d(image)i(will)e(b)s(e)i +(created.)57 b(In)34 b(cases)i(lik)m(e)f(this)0 3987 +y(where)28 b(m)m(ultiple)e(\014les)h(are)i(created,)h(the)e(out\014le)g +(sp)s(eci\014er)f(will)e(b)s(e)j(in)m(terpreted)g(the)g(name)g(of)h +(the)f(\014nal)f(\014le)h(as)0 4100 y(describ)s(ed)g(b)s(elo)m(w,)i(in) +f(descending)g(priorit)m(y:)136 4327 y Fc(\017)46 b Fj(as)29 +b(the)g(name)g(of)g(the)g(\014nal)e(image)i(\014le)f(if)f(an)i(image)g +(within)d(a)j(single)e(binary)g(table)i(cell)f(is)f(op)s(ened)h(or)h +(if)227 4440 y(an)i(image)f(is)g(created)h(b)m(y)f(binning)e(a)i(table) +h(column.)136 4617 y Fc(\017)46 b Fj(as)33 b(the)f(name)h(of)f(the)h +(\014le)e(con)m(taining)h(the)g(\014ltered)f(table)i(if)e(a)i(column)e +(\014lter)g(and/or)h(a)h(ro)m(w)f(\014lter)g(are)227 +4730 y(sp)s(eci\014ed.)136 4907 y Fc(\017)46 b Fj(as)31 +b(the)f(name)h(of)f(the)h(lo)s(cal)f(cop)m(y)h(of)f(the)h(remote)g(FTP) +f(or)h(HTTP)e(\014le.)136 5084 y Fc(\017)46 b Fj(as)31 +b(the)g(name)g(of)g(the)f(uncompressed)g(v)m(ersion)g(of)h(the)f(FITS)g +(\014le,)g(if)g(a)h(compressed)f(FITS)g(\014le)g(on)h(lo)s(cal)227 +5197 y(disk)e(has)h(b)s(een)g(op)s(ened.)136 5374 y Fc(\017)46 +b Fj(otherwise,)30 b(the)h(output)f(\014lename)f(is)h(ignored.)0 +5601 y(The)f(output)f(\014le)g(sp)s(eci\014er)g(is)g(useful)f(when)h +(reading)g(FTP)h(or)g(HTTP-t)m(yp)s(e)g(FITS)f(\014les)g(since)g(it)h +(can)g(b)s(e)g(used)0 5714 y(to)34 b(create)i(a)e(lo)s(cal)f(disk)f +(cop)m(y)j(of)f(the)g(\014le)e(that)j(can)f(b)s(e)f(reused)g(in)f(the)i +(future.)50 b(If)33 b(the)h(output)g(\014le)e(name)i(=)p +eop +%%Page: 114 122 +114 121 bop 0 299 a Fj(114)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(`*')36 +b(then)f(a)g(lo)s(cal)f(\014le)g(with)g(the)h(same)g(name)g(as)g(the)h +(net)m(w)m(ork)f(\014le)f(will)f(b)s(e)h(created.)56 +b(Note)36 b(that)f(CFITSIO)0 668 y(will)27 b(b)s(eha)m(v)m(e)j +(di\013eren)m(tly)f(dep)s(ending)e(on)j(whether)f(the)h(remote)g +(\014le)f(is)g(compressed)g(or)h(not)g(as)g(sho)m(wn)f(b)m(y)h(the)0 +781 y(follo)m(wing)f(examples:)136 1005 y Fc(\017)46 +b Fe(ftp://remote.machine/tmp/)o(myfi)o(le.f)o(its)o(.gz\()o(*\))28 +b Fj(-)35 b(the)g(remote)h(compressed)e(\014le)g(is)g(copied)g(to)227 +1117 y(the)e(lo)s(cal)f(compressed)h(\014le)f(`m)m(y\014le.\014ts.gz',) +i(whic)m(h)d(is)h(then)h(uncompressed)e(in)h(lo)s(cal)g(memory)g(b)s +(efore)227 1230 y(b)s(eing)e(op)s(ened)h(and)g(passed)f(to)j(the)e +(application)f(program.)136 1414 y Fc(\017)46 b Fe +(ftp://remote.machine/tmp/)o(myfi)o(le.f)o(its)o(.gz\()o(myfi)o(le.)o +(fits)o(\))33 b Fj(-)39 b(the)g(remote)h(compressed)f(\014le)227 +1526 y(is)c(copied)g(and)g(uncompressed)g(in)m(to)g(the)h(lo)s(cal)f +(\014le)g(`m)m(y\014le.\014ts'.)56 b(This)34 b(example)h(requires)g +(less)g(lo)s(cal)227 1639 y(memory)21 b(than)g(the)g(previous)e +(example)i(since)f(the)h(\014le)f(is)g(uncompressed)f(on)i(disk)f +(instead)g(of)h(in)e(memory)-8 b(.)136 1822 y Fc(\017)46 +b Fe(ftp://remote.machine/tmp/)o(myfi)o(le.f)o(its)o(\(myf)o(ile.)o +(fit)o(s.gz)o(\))24 b Fj(-)30 b(this)f(will)e(usually)h(pro)s(duce)h +(an)227 1935 y(error)h(since)g(CFITSIO)f(itself)g(cannot)i(compress)f +(\014les.)0 2159 y(The)36 b(exact)i(b)s(eha)m(vior)d(of)i(CFITSIO)e(in) +g(the)i(latter)f(case)i(dep)s(ends)c(on)j(the)f(t)m(yp)s(e)h(of)g(ftp)f +(serv)m(er)g(running)e(on)0 2272 y(the)d(remote)g(mac)m(hine)f(and)g +(ho)m(w)g(it)g(is)f(con\014gured.)40 b(In)30 b(some)h(cases,)g(if)e +(the)i(\014le)e(`m)m(y\014le.\014ts.gz')j(exists)e(on)g(the)0 +2385 y(remote)38 b(mac)m(hine,)g(then)f(the)g(serv)m(er)g(will)e(cop)m +(y)i(it)g(to)g(the)h(lo)s(cal)e(mac)m(hine.)60 b(In)36 +b(other)h(cases)h(the)f(ftp)g(serv)m(er)0 2498 y(will)c(automatically)j +(create)h(and)f(transmit)f(a)h(compressed)g(v)m(ersion)f(of)h(the)g +(\014le)f(if)g(only)g(the)h(uncompressed)0 2611 y(v)m(ersion)26 +b(exists.)40 b(This)25 b(can)i(get)h(rather)f(confusing,)g(so)g(users)f +(should)f(use)i(a)g(certain)g(amoun)m(t)h(of)f(caution)g(when)0 +2723 y(using)33 b(the)i(output)f(\014le)g(sp)s(eci\014er)f(with)h(FTP)g +(or)h(HTTP)f(\014le)g(t)m(yp)s(es,)i(to)f(mak)m(e)h(sure)e(they)h(get)h +(the)f(b)s(eha)m(vior)0 2836 y(that)c(they)g(exp)s(ect.)0 +3168 y Ff(10.5)136 b(T)-11 b(emplate)45 b(File)h(Name)g(when)e +(Creating)j(a)e(New)g(File)0 3418 y Fj(When)38 b(a)h(new)f(FITS)g +(\014le)g(is)g(created)h(with)f(a)g(call)g(to)i(\014ts)p +2101 3418 28 4 v 32 w(create)p 2369 3418 V 35 w(\014le,)f(the)g(name)g +(of)g(a)g(template)g(\014le)e(ma)m(y)0 3531 y(b)s(e)i(supplied)e(in)i +(paren)m(theses)h(immediately)e(follo)m(wing)g(the)j(name)f(of)g(the)g +(new)f(\014le)g(to)i(b)s(e)e(created.)71 b(This)0 3644 +y(template)26 b(is)e(used)h(to)h(de\014ne)f(the)h(structure)f(of)h(one) +f(or)h(more)g(HDUs)g(in)e(the)i(new)f(\014le.)38 b(The)25 +b(template)h(\014le)e(ma)m(y)0 3757 y(b)s(e)32 b(another)h(FITS)f +(\014le,)h(in)f(whic)m(h)f(case)j(the)f(newly)f(created)i(\014le)e +(will)e(ha)m(v)m(e)k(exactly)g(the)f(same)g(k)m(eyw)m(ords)g(in)0 +3870 y(eac)m(h)25 b(HDU)g(as)g(in)e(the)h(template)h(FITS)e(\014le,)i +(but)e(all)h(the)g(data)h(units)d(will)g(b)s(e)i(\014lled)e(with)g +(zeros.)40 b(The)24 b(template)0 3983 y(\014le)h(ma)m(y)i(also)f(b)s(e) +f(an)h(ASCI)s(I)e(text)j(\014le,)f(where)g(eac)m(h)h(line)d(\(in)h +(general\))i(describ)s(es)d(one)i(FITS)f(k)m(eyw)m(ord)i(record.)0 +4096 y(The)j(format)h(of)f(the)h(ASCI)s(I)e(template)h(\014le)g(is)f +(describ)s(ed)f(in)i(the)g(follo)m(wing)f(T)-8 b(emplate)30 +b(Files)g(c)m(hapter.)0 4427 y Ff(10.6)136 b(Image)46 +b(Tile-Compression)g(Sp)t(eci\014cation)0 4677 y Fj(When)28 +b(sp)s(ecifying)e(the)j(name)g(of)f(the)h(output)f(FITS)g(\014le)f(to)i +(b)s(e)f(created,)i(the)f(user)f(can)g(indicate)g(that)h(images)0 +4790 y(should)c(b)s(e)i(written)f(in)g(tile-compressed)g(format)i +(\(see)g(section)f(5.5,)i(\\Primary)d(Arra)m(y)i(or)f(IMA)m(GE)h +(Extension)0 4903 y(I/O)f(Routines"\))h(b)m(y)f(enclosing)f(the)i +(compression)e(parameters)i(in)e(square)h(brac)m(k)m(ets)i(follo)m +(wing)d(the)i(ro)s(ot)f(disk)0 5016 y(\014le)i(name.)41 +b(Here)31 b(are)g(some)g(examples)f(of)g(the)h(syn)m(tax)g(for)f(sp)s +(ecifying)e(tile-compressed)i(output)g(images:)191 5262 +y Fe(myfile.fit[compress])185 b(-)48 b(use)f(Rice)f(algorithm)g(and)h +(default)e(tile)i(size)191 5488 y(myfile.fit[compress)42 +b(GZIP])47 b(-)g(use)g(the)g(specified)e(compression)g(algorithm;)191 +5601 y(myfile.fit[compress)d(Rice])238 b(only)46 b(the)h(first)g +(letter)f(of)h(the)g(algorithm)191 5714 y(myfile.fit[compress)42 +b(PLIO])238 b(name)46 b(is)i(required.)p eop +%%Page: 115 123 +115 122 bop 0 299 a Fh(10.7.)73 b(HDU)31 b(LOCA)-8 b(TION)29 +b(SPECIFICA)-8 b(TION)2019 b Fj(115)191 668 y Fe(myfile.fit[compress)42 +b(Rice)47 b(100,100])141 b(-)48 b(use)e(100)h(x)h(100)f(pixel)f(tile)h +(size)191 781 y(myfile.fit[compress)42 b(Rice)47 b(100,100;2])e(-)j(as) +f(above,)f(and)h(use)g(noisebits)e(=)i(2)0 1114 y Ff(10.7)136 +b(HDU)45 b(Lo)t(cation)g(Sp)t(eci\014cation)0 1364 y +Fj(The)c(optional)f(HDU)j(lo)s(cation)e(sp)s(eci\014er)e(de\014nes)i +(whic)m(h)f(HDU)i(\(Header-Data)i(Unit,)g(also)d(kno)m(wn)g(as)h(an)0 +1477 y(`extension'\))35 b(within)c(the)k(FITS)e(\014le)g(to)i +(initially)c(op)s(en.)51 b(It)34 b(m)m(ust)g(immediately)f(follo)m(w)g +(the)h(base)h(\014le)e(name)0 1590 y(\(or)h(the)g(output)g(\014le)f +(name)g(if)g(presen)m(t\).)52 b(If)33 b(it)g(is)g(not)h(sp)s(eci\014ed) +f(then)g(the)h(\014rst)f(HDU)i(\(the)f(primary)e(arra)m(y\))0 +1703 y(is)g(op)s(ened.)46 b(The)32 b(HDU)h(lo)s(cation)f(sp)s +(eci\014er)f(is)h(required)f(if)g(the)i(colFilter,)f(ro)m(wFilter,)h +(or)g(binSp)s(ec)d(sp)s(eci\014ers)0 1816 y(are)g(presen)m(t,)f(b)s +(ecause)h(the)f(primary)e(arra)m(y)j(is)e(not)i(a)f(v)-5 +b(alid)28 b(HDU)i(for)f(these)g(op)s(erations.)40 b(The)29 +b(HDU)h(ma)m(y)g(b)s(e)0 1929 y(sp)s(eci\014ed)d(either)i(b)m(y)f +(absolute)h(p)s(osition)e(n)m(um)m(b)s(er,)h(starting)h(with)e(0)j(for) +e(the)h(primary)e(arra)m(y)-8 b(,)31 b(or)e(b)m(y)f(reference)0 +2042 y(to)h(the)g(HDU)g(name,)g(and)f(optionally)-8 b(,)28 +b(the)h(v)m(ersion)f(n)m(um)m(b)s(er)f(and)h(the)h(HDU)g(t)m(yp)s(e)g +(of)f(the)h(desired)e(extension.)0 2155 y(The)32 b(lo)s(cation)f(of)h +(an)g(image)h(within)c(a)k(single)d(cell)i(of)g(a)g(binary)f(table)h +(ma)m(y)g(also)g(b)s(e)g(sp)s(eci\014ed,)f(as)h(describ)s(ed)0 +2268 y(b)s(elo)m(w.)0 2428 y(The)26 b(absolute)g(p)s(osition)e(of)i +(the)h(extension)f(is)f(sp)s(eci\014ed)f(either)i(b)m(y)g(enclosed)g +(the)h(n)m(um)m(b)s(er)e(in)g(square)g(brac)m(k)m(ets)0 +2541 y(\(e.g.,)k(`[1]')g(=)d(the)h(\014rst)f(extension)g(follo)m(wing)g +(the)h(primary)d(arra)m(y\))k(or)f(b)m(y)f(preceded)h(the)g(n)m(um)m(b) +s(er)e(with)h(a)h(plus)0 2654 y(sign)36 b(\(`+1'\).)63 +b(T)-8 b(o)38 b(sp)s(ecify)e(the)h(HDU)h(b)m(y)g(name,)h(giv)m(e)f(the) +f(name)h(of)f(the)h(desired)e(HDU)i(\(the)f(v)-5 b(alue)37 +b(of)h(the)0 2766 y(EXTNAME)e(or)g(HDUNAME)h(k)m(eyw)m(ord\))g(and)f +(optionally)e(the)i(extension)g(v)m(ersion)f(n)m(um)m(b)s(er)g(\(v)-5 +b(alue)36 b(of)g(the)0 2879 y(EXTVER)27 b(k)m(eyw)m(ord\))i(and)e(the)h +(extension)g(t)m(yp)s(e)f(\(v)-5 b(alue)28 b(of)g(the)g(XTENSION)f(k)m +(eyw)m(ord:)40 b(IMA)m(GE,)29 b(ASCI)s(I)d(or)0 2992 +y(T)-8 b(ABLE,)36 b(or)f(BINT)-8 b(ABLE\),)36 b(separated)f(b)m(y)g +(commas)h(and)e(all)g(enclosed)h(in)f(square)h(brac)m(k)m(ets.)56 +b(If)34 b(the)h(v)-5 b(alue)0 3105 y(of)34 b(EXTVER)f(and)f(XTENSION)h +(are)h(not)f(sp)s(eci\014ed,)g(then)g(the)h(\014rst)e(extension)i(with) +e(the)h(correct)i(v)-5 b(alue)33 b(of)0 3218 y(EXTNAME)39 +b(is)f(op)s(ened.)67 b(The)38 b(extension)h(name)g(and)f(t)m(yp)s(e)i +(are)f(not)h(case)g(sensitiv)m(e,)h(and)d(the)h(extension)0 +3331 y(t)m(yp)s(e)29 b(ma)m(y)g(b)s(e)f(abbreviated)g(to)h(a)g(single)e +(letter)i(\(e.g.,)i(I)d(=)g(IMA)m(GE)i(extension)e(or)g(primary)f(arra) +m(y)-8 b(,)30 b(A)f(or)f(T)g(=)0 3444 y(ASCI)s(I)d(table)h(extension,)h +(and)f(B)h(=)f(binary)f(table)h(BINT)-8 b(ABLE)27 b(extension\).)40 +b(If)26 b(the)g(HDU)h(lo)s(cation)g(sp)s(eci\014er)0 +3557 y(is)i(equal)h(to)h(`[PRIMAR)-8 b(Y]')32 b(or)f(`[P]',)g(then)f +(the)h(primary)d(arra)m(y)j(\(the)g(\014rst)f(HDU\))h(will)d(b)s(e)i +(op)s(ened.)0 3717 y(FITS)k(images)h(are)g(most)h(commonly)e(stored)h +(in)f(the)h(primary)e(arra)m(y)i(or)g(an)g(image)g(extension,)h(but)e +(images)0 3830 y(can)d(also)g(b)s(e)f(stored)h(as)h(a)f(v)m(ector)h(in) +e(a)h(single)f(cell)g(of)h(a)h(binary)d(table)i(\(i.e.)42 +b(eac)m(h)32 b(ro)m(w)f(of)g(the)h(v)m(ector)g(column)0 +3943 y(con)m(tains)c(a)h(di\013eren)m(t)e(image\).)41 +b(Suc)m(h)27 b(an)h(image)h(can)f(b)s(e)g(op)s(ened)f(with)g(CFITSIO)f +(b)m(y)i(sp)s(ecifying)e(the)i(desired)0 4056 y(column)j(name)h(and)f +(the)h(ro)m(w)g(n)m(um)m(b)s(er)f(after)h(the)g(binary)e(table)i(HDU)h +(sp)s(eci\014er)d(as)i(sho)m(wn)g(in)e(the)i(follo)m(wing)0 +4169 y(examples.)70 b(The)40 b(column)f(name)i(is)e(separated)i(from)f +(the)h(HDU)g(sp)s(eci\014er)e(b)m(y)h(a)h(semicolon)e(and)h(the)h(ro)m +(w)0 4282 y(n)m(um)m(b)s(er)29 b(is)g(enclosed)h(in)e(paren)m(theses.) +41 b(In)30 b(this)f(case)i(CFITSIO)d(copies)i(the)g(image)h(from)e(the) +i(table)f(cell)f(in)m(to)0 4394 y(a)j(temp)s(orary)e(primary)g(arra)m +(y)h(b)s(efore)g(it)g(is)f(op)s(ened.)43 b(The)30 b(application)g +(program)h(then)g(just)g(sees)g(the)h(image)0 4507 y(in)h(the)i +(primary)d(arra)m(y)-8 b(,)37 b(without)c(an)m(y)i(extensions.)52 +b(The)34 b(particular)e(ro)m(w)j(to)g(b)s(e)e(op)s(ened)h(ma)m(y)h(b)s +(e)f(sp)s(eci\014ed)0 4620 y(either)27 b(b)m(y)g(giving)f(an)h +(absolute)g(in)m(teger)h(ro)m(w)g(n)m(um)m(b)s(er)e(\(starting)h(with)f +(1)i(for)f(the)g(\014rst)g(ro)m(w\),)i(or)e(b)m(y)g(sp)s(ecifying)0 +4733 y(a)33 b(b)s(o)s(olean)e(expression)g(that)i(ev)-5 +b(aluates)33 b(to)g(TR)m(UE)g(for)f(the)g(desired)f(ro)m(w.)47 +b(The)32 b(\014rst)f(ro)m(w)i(that)g(satis\014es)f(the)0 +4846 y(expression)27 b(will)e(b)s(e)j(used.)39 b(The)28 +b(ro)m(w)g(selection)g(expression)f(has)h(the)g(same)g(syn)m(tax)h(as)f +(describ)s(ed)e(in)h(the)h(Ro)m(w)0 4959 y(Filter)i(Sp)s(eci\014er)e +(section,)j(b)s(elo)m(w.)0 5119 y(Examples:)143 5375 +y Fe(myfile.fits[3])44 b(-)k(open)e(the)h(3rd)g(HDU)g(following)e(the)i +(primary)f(array)143 5488 y(myfile.fits+3)92 b(-)48 b(same)e(as)h +(above,)f(but)h(using)g(the)g(FTOOLS-style)d(notation)143 +5601 y(myfile.fits[EVENTS])f(-)k(open)g(the)g(extension)e(that)i(has)g +(EXTNAME)e(=)j('EVENTS')143 5714 y(myfile.fits[EVENTS,)43 +b(2])95 b(-)47 b(same)g(as)g(above,)f(but)h(also)g(requires)e(EXTVER)h +(=)i(2)p eop +%%Page: 116 124 +116 123 bop 0 299 a Fj(116)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)143 555 y +Fe(myfile.fits[events,2,b])42 b(-)47 b(same,)f(but)h(also)g(requires)f +(XTENSION)f(=)j('BINTABLE')143 668 y(myfile.fits[3;)c(images\(17\)])h +(-)i(opens)g(the)g(image)f(in)h(row)g(17)g(of)g(the)g('images')1527 +781 y(column)f(in)i(the)e(3rd)h(extension)f(of)h(the)g(file.)143 +894 y(myfile.fits[3;)d(images\(exposure)g(>)j(100\)])g(-)g(as)g(above,) +f(but)h(opens)g(the)f(image)907 1007 y(in)h(the)g(first)f(row)h(that)g +(has)g(an)g('exposure')e(column)h(value)907 1120 y(greater)g(than)g +(100.)0 1449 y Ff(10.8)136 b(Image)46 b(Section)0 1699 +y Fj(A)41 b(virtual)e(\014le)g(con)m(taining)h(a)h(rectangular)g +(subsection)e(of)i(an)g(image)f(can)h(b)s(e)f(extracted)i(and)e(op)s +(ened)g(b)m(y)0 1812 y(sp)s(ecifying)30 b(the)j(range)g(of)g(pixels)e +(\(start:end\))i(along)g(eac)m(h)h(axis)e(to)h(b)s(e)f(extracted)i +(from)e(the)h(original)d(image.)0 1925 y(One)g(can)h(also)g(sp)s(ecify) +e(an)i(optional)f(pixel)f(incremen)m(t)h(\(start:end:step\))i(for)f +(eac)m(h)h(axis)e(of)h(the)g(input)d(image.)0 2038 y(A)g(pixel)d(step)j +(=)f(1)h(will)d(b)s(e)i(assumed)f(if)h(it)g(is)f(not)i(sp)s(eci\014ed.) +38 b(If)27 b(the)h(start)g(pixel)e(is)g(larger)i(then)f(the)h(end)e +(pixel,)0 2151 y(then)32 b(the)g(image)g(will)d(b)s(e)i(\015ipp)s(ed)e +(\(pro)s(ducing)h(a)i(mirror)f(image\))h(along)g(that)g(dimension.)43 +b(An)32 b(asterisk,)g('*',)0 2264 y(ma)m(y)39 b(b)s(e)e(used)h(to)h(sp) +s(ecify)e(the)h(en)m(tire)g(range)h(of)f(an)h(axis,)h(and)d('-*')j +(will)35 b(\015ip)i(the)h(en)m(tire)g(axis.)64 b(The)38 +b(input)0 2377 y(image)30 b(can)g(b)s(e)f(in)f(the)i(primary)e(arra)m +(y)-8 b(,)31 b(in)d(an)h(image)h(extension,)g(or)g(con)m(tained)f(in)g +(a)h(v)m(ector)h(cell)e(of)h(a)g(binary)0 2490 y(table.)39 +b(In)25 b(the)h(later)g(2)g(cases)h(the)f(extension)g(name)g(or)f(n)m +(um)m(b)s(er)g(m)m(ust)h(b)s(e)f(sp)s(eci\014ed)f(b)s(efore)i(the)g +(image)g(section)0 2603 y(sp)s(eci\014er.)0 2763 y(Examples:)95 +2996 y Fe(myfile.fits[1:512:2,)43 b(2:512:2])i(-)95 b(open)47 +b(a)h(256x256)d(pixel)i(image)668 3109 y(consisting)e(of)i(the)g(odd)g +(numbered)f(columns)g(\(1st)g(axis\))h(and)668 3222 y(the)g(even)g +(numbered)e(rows)i(\(2nd)g(axis\))f(of)h(the)g(image)f(in)i(the)668 +3335 y(primary)e(array)g(of)i(the)e(file.)95 3561 y(myfile.fits[*,)e +(512:256])i(-)h(open)g(an)g(image)g(consisting)e(of)i(all)g(the)g +(columns)668 3674 y(in)g(the)g(input)g(image,)f(but)h(only)f(rows)h +(256)g(through)f(512.)668 3787 y(The)h(image)f(will)h(be)g(flipped)f +(along)g(the)h(2nd)g(axis)g(since)668 3900 y(the)g(starting)f(pixel)g +(is)h(greater)f(than)h(the)g(ending)f(pixel.)95 4125 +y(myfile.fits[*:2,)e(512:256:2])h(-)i(same)g(as)g(above)f(but)h +(keeping)f(only)668 4238 y(every)h(other)f(row)h(and)g(column)f(in)h +(the)g(input)f(image.)95 4464 y(myfile.fits[-*,)e(*])j(-)h(copy)e(the)h +(entire)f(image,)g(flipping)g(it)h(along)668 4577 y(the)g(first)f +(axis.)95 4803 y(myfile.fits[3][1:256,1:256)o(])c(-)47 +b(opens)g(a)g(subsection)e(of)i(the)g(image)g(that)668 +4916 y(is)g(in)h(the)e(3rd)h(extension)f(of)h(the)g(file.)95 +5142 y(myfile.fits[4;)d(images\(12\)][1:10,1:10])e(-)48 +b(open)e(an)h(image)g(consisting)286 5255 y(of)h(the)e(first)h(10)g +(pixels)f(in)h(both)g(dimensions.)e(The)i(original)286 +5367 y(image)g(resides)f(in)h(the)g(12th)f(row)h(of)g(the)g('images')f +(vector)286 5480 y(column)g(in)i(the)f(table)f(in)h(the)g(4th)g +(extension)e(of)i(the)g(file.)0 5714 y Fj(When)23 b(CFITSIO)f(op)s(ens) +h(an)g(image)g(section)h(it)f(\014rst)g(creates)h(a)g(temp)s(orary)f +(\014le)g(con)m(taining)g(the)g(image)h(section)p eop +%%Page: 117 125 +117 124 bop 0 299 a Fh(10.9.)73 b(COLUMN)30 b(AND)h(KEYW)m(ORD)g(FIL)-8 +b(TERING)30 b(SPECIFICA)-8 b(TION)1030 b Fj(117)0 555 +y(plus)31 b(a)j(cop)m(y)g(of)g(an)m(y)g(other)f(HDUs)h(in)e(the)i +(\014le.)49 b(This)31 b(temp)s(orary)i(\014le)g(is)f(then)h(op)s(ened)g +(b)m(y)g(the)h(application)0 668 y(program,)28 b(so)g(it)f(is)f(not)i +(p)s(ossible)d(to)j(write)f(to)h(or)g(mo)s(dify)e(the)h(input)f(\014le) +g(when)h(sp)s(ecifying)e(an)j(image)g(section.)0 781 +y(Note)39 b(that)f(CFITSIO)e(automatically)h(up)s(dates)g(the)g(w)m +(orld)g(co)s(ordinate)g(system)h(k)m(eyw)m(ords)f(in)f(the)i(header)0 +894 y(of)33 b(the)h(image)f(section,)h(if)e(they)i(exist,)g(so)f(that)h +(the)f(co)s(ordinate)g(asso)s(ciated)h(with)e(eac)m(h)i(pixel)d(in)h +(the)i(image)0 1007 y(section)d(will)c(b)s(e)j(computed)g(correctly)-8 +b(.)0 1360 y Ff(10.9)136 b(Column)45 b(and)f(Keyw)l(ord)i(Filtering)g +(Sp)t(eci\014cation)0 1615 y Fj(The)27 b(optional)g(column/k)m(eyw)m +(ord)h(\014ltering)e(sp)s(eci\014er)g(is)h(used)g(to)i(mo)s(dify)d(the) +i(column)f(structure)g(and/or)h(the)0 1728 y(header)38 +b(k)m(eyw)m(ords)h(in)e(the)i(HDU)g(that)h(w)m(as)f(selected)g(with)e +(the)i(previous)e(HDU)i(lo)s(cation)f(sp)s(eci\014er.)64 +b(This)0 1840 y(\014ltering)40 b(sp)s(eci\014er)g(m)m(ust)i(b)s(e)f +(enclosed)h(in)e(square)i(brac)m(k)m(ets)h(and)e(can)h(b)s(e)f +(distinguished)d(from)k(a)g(general)0 1953 y(ro)m(w)d(\014lter)f(sp)s +(eci\014er)f(\(describ)s(ed)g(b)s(elo)m(w\))h(b)m(y)h(the)g(fact)h +(that)f(it)f(b)s(egins)f(with)h(the)h(string)f('col)h(')g(and)f(is)g +(not)0 2066 y(immediately)27 b(follo)m(w)m(ed)h(b)m(y)g(an)g(equals)g +(sign.)39 b(The)28 b(original)e(\014le)h(is)h(not)g(c)m(hanged)h(b)m(y) +f(this)g(\014ltering)e(op)s(eration,)0 2179 y(and)40 +b(instead)g(the)h(mo)s(di\014cations)e(are)i(made)f(on)h(a)g(cop)m(y)g +(of)g(the)g(input)e(FITS)h(\014le)f(\(usually)g(in)g(memory\),)0 +2292 y(whic)m(h)32 b(also)h(con)m(tains)g(a)g(cop)m(y)h(of)f(all)f(the) +i(other)f(HDUs)h(in)d(the)i(\014le.)48 b(This)32 b(temp)s(orary)g +(\014le)g(is)g(passed)h(to)h(the)0 2405 y(application)c(program)i(and)f +(will)e(p)s(ersist)h(only)h(un)m(til)f(the)i(\014le)f(is)g(closed)h(or) +g(un)m(til)e(the)i(program)f(exits,)i(unless)0 2518 y(the)e(out\014le)e +(sp)s(eci\014er)g(\(see)i(ab)s(o)m(v)m(e\))h(is)e(also)g(supplied.)0 +2678 y(The)h(column/k)m(eyw)m(ord)g(\014lter)f(can)h(b)s(e)g(used)f(to) +i(p)s(erform)e(the)i(follo)m(wing)d(op)s(erations.)43 +b(More)32 b(than)f(one)g(op)s(er-)0 2791 y(ation)f(ma)m(y)h(b)s(e)f(sp) +s(eci\014ed)f(b)m(y)h(separating)g(them)g(with)g(semi-colons.)136 +3068 y Fc(\017)46 b Fj(Cop)m(y)36 b(only)f(a)h(sp)s(eci\014ed)f(list)f +(of)i(columns)f(columns)f(to)j(the)f(\014ltered)f(input)f(\014le.)56 +b(The)36 b(list)e(of)i(column)227 3181 y(name)c(should)e(b)s(e)i +(separated)g(b)m(y)g(semi-colons.)46 b(Wild)30 b(card)i(c)m(haracters)i +(ma)m(y)e(b)s(e)g(used)f(in)g(the)h(column)227 3294 y(names)37 +b(to)h(matc)m(h)g(m)m(ultiple)d(columns.)60 b(If)37 b(the)g(expression) +f(con)m(tains)i(b)s(oth)e(a)i(list)d(of)j(columns)e(to)i(b)s(e)227 +3406 y(included)f(and)h(columns)g(to)h(b)s(e)g(deleted,)i(then)d(all)g +(the)h(columns)f(in)g(the)h(original)e(table)i(except)h(the)227 +3519 y(explicitly)28 b(deleted)i(columns)f(will)e(app)s(ear)j(in)f(the) +h(\014ltered)f(table)h(\(i.e.,)h(there)f(is)g(no)g(need)f(to)i +(explicitly)227 3632 y(list)e(the)i(columns)e(to)i(b)s(e)f(included)d +(if)j(an)m(y)g(columns)f(are)i(b)s(eing)e(deleted\).)136 +3837 y Fc(\017)46 b Fj(Delete)31 b(a)e(column)f(or)h(k)m(eyw)m(ord)h(b) +m(y)f(listing)e(the)i(name)g(preceded)g(b)m(y)g(a)g(min)m(us)f(sign)g +(or)h(an)g(exclamation)227 3950 y(mark)c(\(!\),)h(e.g.,)i('-TIME')d +(will)d(delete)j(the)f(TIME)h(column)e(if)g(it)i(exists,)g(otherwise)f +(the)h(TIME)f(k)m(eyw)m(ord.)227 4063 y(An)35 b(error)f(is)g(returned)f +(if)h(neither)f(a)j(column)d(nor)h(k)m(eyw)m(ord)h(with)f(this)f(name)i +(exists.)53 b(Note)36 b(that)g(the)227 4176 y(exclamation)25 +b(p)s(oin)m(t,)h(')10 b(!',)27 b(is)d(a)h(sp)s(ecial)f(UNIX)h(c)m +(haracter,)j(so)d(if)f(it)h(is)f(used)g(on)h(the)g(command)g(line)e +(rather)227 4289 y(than)33 b(en)m(tered)h(at)g(a)g(task)g(prompt,)f(it) +g(m)m(ust)g(b)s(e)g(preceded)g(b)m(y)g(a)h(bac)m(kslash)f(to)h(force)g +(the)f(UNIX)h(shell)227 4401 y(to)d(ignore)f(it.)136 +4606 y Fc(\017)46 b Fj(Rename)29 b(an)g(existing)e(column)g(or)i(k)m +(eyw)m(ord)g(with)e(the)i(syn)m(tax)g('NewName)h(==)e(OldName'.)39 +b(An)28 b(error)227 4719 y(is)i(returned)f(if)g(neither)h(a)g(column)f +(nor)h(k)m(eyw)m(ord)h(with)e(this)h(name)g(exists.)136 +4924 y Fc(\017)46 b Fj(App)s(end)37 b(a)j(new)f(column)e(or)j(k)m(eyw)m +(ord)f(to)h(the)f(table.)67 b(T)-8 b(o)40 b(create)g(a)g(column,)g(giv) +m(e)g(the)f(new)g(name,)227 5036 y(optionally)32 b(follo)m(w)m(ed)g(b)m +(y)h(the)g(data)h(t)m(yp)s(e)f(in)e(paren)m(theses,)j(follo)m(w)m(ed)f +(b)m(y)g(a)g(single)f(equals)g(sign)g(and)g(an)227 5149 +y(expression)i(to)i(b)s(e)e(used)g(to)i(compute)f(the)g(v)-5 +b(alue)34 b(\(e.g.,)k('new)m(col\(1J\))e(=)f(0')g(will)e(create)j(a)f +(new)g(32-bit)227 5262 y(in)m(teger)h(column)d(called)i('new)m(col')g +(\014lled)e(with)h(zeros\).)55 b(The)35 b(data)g(t)m(yp)s(e)h(is)e(sp)s +(eci\014ed)f(using)g(the)j(same)227 5375 y(syn)m(tax)j(that)g(is)e +(allo)m(w)m(ed)h(for)g(the)g(v)-5 b(alue)38 b(of)g(the)g(FITS)f(TF)m +(ORMn)h(k)m(eyw)m(ord)h(\(e.g.,)j('I',)d('J',)f('E',)h('D',)227 +5488 y(etc.)66 b(for)38 b(binary)e(tables,)41 b(and)c('I8',)k(F12.3',)i +('E20.12',)g(etc.)65 b(for)38 b(ASCI)s(I)f(tables\).)65 +b(If)37 b(the)i(data)g(t)m(yp)s(e)227 5601 y(is)34 b(not)h(sp)s +(eci\014ed)e(then)h(an)g(appropriate)g(data)h(t)m(yp)s(e)g(will)d(b)s +(e)i(c)m(hosen)h(dep)s(ending)d(on)i(the)h(form)f(of)h(the)227 +5714 y(expression)43 b(\(ma)m(y)h(b)s(e)f(a)h(c)m(haracter)i(string,)g +(logical,)h(bit,)f(long)d(in)m(teger,)48 b(or)43 b(double)g(column\).) +79 b(An)p eop +%%Page: 118 126 +118 125 bop 0 299 a Fj(118)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)227 555 y +Fj(appropriate)38 b(v)m(ector)j(coun)m(t)e(\(in)f(the)h(case)h(of)f +(binary)e(tables\))i(will)d(also)j(b)s(e)f(added)g(if)g(not)h +(explicitly)227 668 y(sp)s(eci\014ed.)227 819 y(When)26 +b(creating)g(a)g(new)f(k)m(eyw)m(ord,)j(the)e(k)m(eyw)m(ord)g(name)g(m) +m(ust)g(b)s(e)f(preceded)g(b)m(y)h(a)g(p)s(ound)e(sign)g('#',)k(and)227 +932 y(the)h(expression)e(m)m(ust)h(ev)-5 b(aluate)29 +b(to)g(a)g(scalar)f(\(i.e.,)h(cannot)g(ha)m(v)m(e)h(a)f(column)e(name)h +(in)f(the)i(expression\).)227 1045 y(The)j(commen)m(t)i(string)e(for)g +(the)h(k)m(eyw)m(ord)h(ma)m(y)f(b)s(e)f(sp)s(eci\014ed)f(in)g(paren)m +(theses)i(immediately)e(follo)m(wing)227 1158 y(the)c(k)m(eyw)m(ord)g +(name)f(\(instead)g(of)h(supplying)c(a)k(data)g(t)m(yp)s(e)g(as)f(in)f +(the)i(case)g(of)g(creating)g(a)g(new)f(column\).)136 +1348 y Fc(\017)46 b Fj(Recompute)f(\(o)m(v)m(erwrite\))h(the)e(v)-5 +b(alues)43 b(in)g(an)h(existing)g(column)f(or)h(k)m(eyw)m(ord)g(b)m(y)g +(giving)g(the)g(name)227 1461 y(follo)m(w)m(ed)30 b(b)m(y)h(an)f +(equals)g(sign)f(and)h(an)g(arithmetic)g(expression.)0 +1722 y(The)23 b(expression)f(that)j(is)d(used)h(when)g(app)s(ending)e +(or)i(recomputing)g(columns)f(or)i(k)m(eyw)m(ords)g(can)g(b)s(e)f +(arbitrarily)0 1835 y(complex)35 b(and)h(ma)m(y)g(b)s(e)f(a)h(function) +f(of)h(other)g(header)g(k)m(eyw)m(ord)g(v)-5 b(alues)35 +b(and)g(other)h(columns)f(\(in)g(the)h(same)0 1948 y(ro)m(w\).)63 +b(The)37 b(full)e(syn)m(tax)k(and)e(a)m(v)-5 b(ailable)37 +b(functions)f(for)h(the)h(expression)e(are)i(describ)s(ed)e(b)s(elo)m +(w)h(in)f(the)i(ro)m(w)0 2061 y(\014lter)29 b(sp)s(eci\014cation)h +(section.)0 2221 y(F)-8 b(or)30 b(complex)g(or)f(commonly)g(used)g(op)s +(erations,)h(one)f(can)h(also)g(place)g(the)f(op)s(erations)g(in)m(to)h +(an)f(external)h(text)0 2334 y(\014le)g(and)g(imp)s(ort)f(it)h(in)m(to) +h(the)g(column)f(\014lter)f(using)h(the)h(syn)m(tax)g('[col)g +(@\014lename.txt]'.)42 b(The)31 b(op)s(erations)f(can)0 +2447 y(extend)c(o)m(v)m(er)i(m)m(ultiple)c(lines)h(of)h(the)h(\014le,)g +(but)e(m)m(ultiple)f(op)s(erations)i(m)m(ust)g(still)f(b)s(e)g +(separated)i(b)m(y)g(semicolons.)0 2560 y(An)m(y)h(lines)f(in)g(the)h +(external)h(text)g(\014le)e(that)i(b)s(egin)e(with)g(2)i(slash)e(c)m +(haracters)j(\('//'\))g(will)c(b)s(e)h(ignored)h(and)f(ma)m(y)0 +2673 y(b)s(e)j(used)f(to)i(add)f(commen)m(ts)h(in)m(to)g(the)f(\014le.) +0 2833 y(Examples:)143 3095 y Fe([col)47 b(Time;rate])713 +b(-)47 b(only)g(the)g(Time)g(and)g(rate)f(columns)g(will)1670 +3208 y(appear)h(in)g(the)g(filtered)e(input)i(file.)143 +3434 y([col)g(Time;*raw])713 b(-)47 b(include)f(the)h(Time)g(column)f +(and)h(any)g(other)1670 3546 y(columns)f(whose)h(name)f(ends)h(with)g +('raw'.)143 3772 y([col)g(-TIME;)f(Good)h(==)g(STATUS])141 +b(-)47 b(deletes)f(the)h(TIME)g(column)f(and)1670 3885 +y(renames)g(the)h(status)f(column)g(to)i('Good')143 4111 +y([col)f(PI=PHA)f(*)h(1.1)g(+)h(0.2])285 b(-)47 b(creates)f(new)h(PI)g +(column)f(from)h(PHA)g(values)143 4337 y([col)g(rate)f(=)i +(rate/exposure])139 b(-)48 b(recomputes)d(the)i(rate)f(column)g(by)i +(dividing)1670 4450 y(it)g(by)f(the)g(EXPOSURE)e(keyword)h(value.)0 +4786 y Ff(10.10)136 b(Ro)l(w)46 b(Filtering)g(Sp)t(eci\014cation)0 +5036 y Fj(When)29 b(en)m(tering)g(the)g(name)g(of)g(a)g(FITS)f(table)h +(that)h(is)d(to)j(b)s(e)e(op)s(ened)h(b)m(y)f(a)i(program,)f(an)g +(optional)f(ro)m(w)h(\014lter)0 5149 y(ma)m(y)i(b)s(e)g(sp)s(eci\014ed) +e(to)i(select)g(a)h(subset)e(of)h(the)g(ro)m(ws)f(in)g(the)h(table.)42 +b(A)31 b(temp)s(orary)f(new)g(FITS)g(\014le)g(is)g(created)0 +5262 y(on)25 b(the)h(\015y)e(whic)m(h)g(con)m(tains)h(only)g(those)h +(ro)m(ws)f(for)g(whic)m(h)f(the)h(ro)m(w)g(\014lter)g(expression)f(ev) +-5 b(aluates)25 b(to)h(true.)39 b(\(The)0 5375 y(primary)25 +b(arra)m(y)i(and)f(an)m(y)g(other)h(extensions)f(in)f(the)i(input)e +(\014le)g(are)i(also)g(copied)f(to)h(the)f(temp)s(orary)h(\014le\).)38 +b(The)0 5488 y(original)27 b(FITS)i(\014le)f(is)g(closed)h(and)f(the)i +(new)e(virtual)g(\014le)g(is)g(op)s(ened)g(b)m(y)h(the)h(application)d +(program.)40 b(The)29 b(ro)m(w)0 5601 y(\014lter)36 b(expression)g(is)h +(enclosed)g(in)f(square)h(brac)m(k)m(ets)i(follo)m(wing)d(the)h(\014le) +g(name)g(and)g(extension)g(name)g(\(e.g.,)0 5714 y('\014le.\014ts[ev)m +(en)m(ts][GRADE==50]')28 b(selects)d(only)f(those)i(ro)m(ws)f(where)f +(the)h(GRADE)h(column)e(v)-5 b(alue)24 b(equals)g(50\).)p +eop +%%Page: 119 127 +119 126 bop 0 299 a Fh(10.10.)73 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)1936 b Fj(119)0 555 +y(When)33 b(dealing)f(with)g(tables)g(where)h(eac)m(h)h(ro)m(w)f(has)g +(an)g(asso)s(ciated)h(time)f(and/or)g(2D)g(spatial)g(p)s(osition,)f +(the)0 668 y(ro)m(w)g(\014lter)g(expression)e(can)j(also)f(b)s(e)g +(used)f(to)i(select)g(ro)m(ws)f(based)g(on)g(the)g(times)g(in)f(a)h(Go) +s(o)s(d)g(Time)f(In)m(terv)-5 b(als)0 781 y(\(GTI\))31 +b(extension,)f(or)g(on)h(spatial)e(p)s(osition)g(as)h(giv)m(en)h(in)e +(a)h(SA)m(O-st)m(yle)h(region)f(\014le.)0 1090 y Fd(10.10.1)113 +b(General)37 b(Syn)m(tax)0 1313 y Fj(The)32 b(ro)m(w)h(\014ltering)e +(expression)h(can)h(b)s(e)f(an)h(arbitrarily)d(complex)i(series)g(of)h +(op)s(erations)f(p)s(erformed)g(on)g(con-)0 1426 y(stan)m(ts,)39 +b(k)m(eyw)m(ord)e(v)-5 b(alues,)37 b(and)f(column)f(data)j(tak)m(en)f +(from)f(the)h(sp)s(eci\014ed)d(FITS)i(T)-8 b(ABLE)37 +b(extension.)58 b(The)0 1539 y(expression)36 b(m)m(ust)i(ev)-5 +b(aluate)38 b(to)h(a)f(b)s(o)s(olean)f(v)-5 b(alue)37 +b(for)g(eac)m(h)i(ro)m(w)f(of)g(the)f(table,)j(where)d(a)h(v)-5 +b(alue)38 b(of)f(F)-10 b(ALSE)0 1652 y(means)30 b(that)h(the)g(ro)m(w)f +(will)e(b)s(e)i(excluded.)0 1812 y(F)-8 b(or)34 b(complex)f(or)h +(commonly)e(used)h(\014lters,)g(one)h(can)g(place)f(the)h(expression)e +(in)m(to)h(a)h(text)g(\014le)f(and)g(imp)s(ort)e(it)0 +1925 y(in)m(to)37 b(the)f(ro)m(w)h(\014lter)f(using)f(the)i(syn)m(tax)g +('[@\014lename.txt]'.)60 b(The)36 b(expression)g(can)g(b)s(e)g +(arbitrarily)e(complex)0 2038 y(and)27 b(extend)i(o)m(v)m(er)g(m)m +(ultiple)d(lines)g(of)i(the)h(\014le.)39 b(An)m(y)28 +b(lines)e(in)h(the)h(external)g(text)h(\014le)e(that)i(b)s(egin)e(with) +g(2)h(slash)0 2151 y(c)m(haracters)k(\('//'\))g(will)c(b)s(e)i(ignored) +f(and)h(ma)m(y)h(b)s(e)f(used)f(to)i(add)f(commen)m(ts)h(in)m(to)g(the) +f(\014le.)0 2311 y(Keyw)m(ord)37 b(and)f(column)f(data)j(are)f +(referenced)g(b)m(y)g(name.)60 b(An)m(y)37 b(string)e(of)i(c)m +(haracters)i(not)e(surrounded)d(b)m(y)0 2424 y(quotes)41 +b(\(ie,)i(a)e(constan)m(t)h(string\))e(or)g(follo)m(w)m(ed)g(b)m(y)h +(an)f(op)s(en)g(paren)m(theses)h(\(ie,)i(a)e(function)e(name\))i(will)d +(b)s(e)0 2537 y(initially)33 b(in)m(terpreted)i(as)i(a)g(column)e(name) +h(and)g(its)g(con)m(ten)m(ts)i(for)e(the)h(curren)m(t)f(ro)m(w)g +(inserted)f(in)m(to)i(the)f(ex-)0 2650 y(pression.)j(If)28 +b(no)h(suc)m(h)g(column)f(exists,)h(a)h(k)m(eyw)m(ord)f(of)h(that)f +(name)g(will)e(b)s(e)h(searc)m(hed)i(for)f(and)f(its)h(v)-5 +b(alue)28 b(used,)0 2763 y(if)35 b(found.)55 b(T)-8 b(o)36 +b(force)g(the)g(name)g(to)h(b)s(e)e(in)m(terpreted)g(as)h(a)g(k)m(eyw)m +(ord)g(\(in)f(case)h(there)g(is)f(b)s(oth)g(a)h(column)f(and)0 +2875 y(k)m(eyw)m(ord)41 b(with)d(the)j(same)f(name\),)j(precede)d(the)h +(k)m(eyw)m(ord)f(name)g(with)f(a)i(single)d(p)s(ound)g(sign,)k('#',)h +(as)d(in)0 2988 y('#NAXIS2'.)g(Due)27 b(to)g(the)f(generalities)g(of)g +(FITS)g(column)f(and)h(k)m(eyw)m(ord)h(names,)g(if)e(the)i(column)e(or) +h(k)m(eyw)m(ord)0 3101 y(name)34 b(con)m(tains)g(a)g(space)h(or)e(a)i +(c)m(haracter)g(whic)m(h)e(migh)m(t)g(app)s(ear)g(as)i(an)e(arithmetic) +g(term)h(then)g(inclose)f(the)0 3214 y(name)d(in)f('$')j(c)m(haracters) +g(as)e(in)f($MAX)j(PHA$)f(or)f(#$MAX-PHA$.)43 b(Names)31 +b(are)f(case)i(insensitiv)m(e.)0 3374 y(T)-8 b(o)32 b(access)g(a)g +(table)f(en)m(try)h(in)e(a)i(ro)m(w)f(other)h(than)f(the)g(curren)m(t)g +(one,)h(follo)m(w)f(the)g(column's)g(name)g(with)f(a)i(ro)m(w)0 +3487 y(o\013set)37 b(within)c(curly)h(braces.)57 b(F)-8 +b(or)36 b(example,)h('PHA)p Fc(f)p Fj(-3)p Fc(g)p Fj(')h(will)33 +b(ev)-5 b(aluate)37 b(to)f(the)g(v)-5 b(alue)35 b(of)h(column)e(PHA,)j +(3)0 3600 y(ro)m(ws)28 b(ab)s(o)m(v)m(e)i(the)e(ro)m(w)h(curren)m(tly)e +(b)s(eing)g(pro)s(cessed.)40 b(One)28 b(cannot)h(sp)s(ecify)e(an)h +(absolute)g(ro)m(w)g(n)m(um)m(b)s(er,)g(only)g(a)0 3713 +y(relativ)m(e)i(o\013set.)42 b(Ro)m(ws)31 b(that)g(fall)e(outside)h +(the)g(table)g(will)e(b)s(e)i(treated)h(as)g(unde\014ned,)d(or)j +(NULLs.)0 3873 y(Bo)s(olean)g(op)s(erators)g(can)g(b)s(e)f(used)f(in)h +(the)g(expression)g(in)f(either)h(their)g(F)-8 b(ortran)31 +b(or)f(C)h(forms.)40 b(The)30 b(follo)m(wing)0 3986 y(b)s(o)s(olean)f +(op)s(erators)i(are)g(a)m(v)-5 b(ailable:)191 4262 y +Fe("equal")428 b(.eq.)46 b(.EQ.)h(==)95 b("not)46 b(equal")476 +b(.ne.)94 b(.NE.)h(!=)191 4375 y("less)46 b(than")238 +b(.lt.)46 b(.LT.)h(<)143 b("less)46 b(than/equal")188 +b(.le.)94 b(.LE.)h(<=)47 b(=<)191 4488 y("greater)e(than")95 +b(.gt.)46 b(.GT.)h(>)143 b("greater)45 b(than/equal")g(.ge.)94 +b(.GE.)h(>=)47 b(=>)191 4601 y("or")572 b(.or.)46 b(.OR.)h(||)95 +b("and")762 b(.and.)46 b(.AND.)h(&&)191 4713 y("negation")236 +b(.not.)46 b(.NOT.)h(!)95 b("approx.)45 b(equal\(1e-7\)")92 +b(~)0 4989 y Fj(Note)32 b(that)g(the)f(exclamation)g(p)s(oin)m(t,)f(') +10 b(!',)33 b(is)d(a)h(sp)s(ecial)e(UNIX)j(c)m(haracter,)h(so)e(if)f +(it)g(is)g(used)g(on)h(the)g(command)0 5102 y(line)g(rather)h(than)h +(en)m(tered)g(at)g(a)g(task)g(prompt,)g(it)f(m)m(ust)g(b)s(e)g +(preceded)h(b)m(y)f(a)h(bac)m(kslash)f(to)i(force)f(the)g(UNIX)0 +5215 y(shell)c(to)i(ignore)f(it.)0 5375 y(The)i(expression)f(ma)m(y)j +(also)e(include)e(arithmetic)i(op)s(erators)h(and)f(functions.)46 +b(T)-8 b(rigonometric)32 b(functions)f(use)0 5488 y(radians,)22 +b(not)h(degrees.)38 b(The)22 b(follo)m(wing)e(arithmetic)h(op)s +(erators)i(and)e(functions)f(can)j(b)s(e)e(used)g(in)g(the)h +(expression)0 5601 y(\(function)37 b(names)g(are)h(case)g(insensitiv)m +(e\).)61 b(A)37 b(n)m(ull)f(v)-5 b(alue)37 b(will)d(b)s(e)j(returned)g +(in)f(case)i(of)g(illegal)e(op)s(erations)0 5714 y(suc)m(h)30 +b(as)h(divide)d(b)m(y)i(zero,)i(sqrt\(negativ)m(e\))g(log\(negativ)m +(e\),)g(log10\(negativ)m(e\),)i(arccos\(.gt.)43 b(1\),)32 +b(arcsin\(.gt.)41 b(1\).)p eop +%%Page: 120 128 +120 127 bop 0 299 a Fj(120)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)191 555 y +Fe("addition")474 b(+)j("subtraction")d(-)191 668 y("multiplication") +186 b(*)477 b("division")618 b(/)191 781 y("negation")474 +b(-)j("exponentiation")330 b(**)143 b(^)191 894 y("absolute)45 +b(value")189 b(abs\(x\))237 b("cosine")762 b(cos\(x\))191 +1007 y("sine")666 b(sin\(x\))237 b("tangent")714 b(tan\(x\))191 +1120 y("arc)47 b(cosine")379 b(arccos\(x\))93 b("arc)47 +b(sine")667 b(arcsin\(x\))191 1233 y("arc)47 b(tangent")331 +b(arctan\(x\))93 b("arc)47 b(tangent")523 b(arctan2\(x,y\))191 +1346 y("hyperbolic)45 b(cos")189 b(cosh\(x\))g("hyperbolic)45 +b(sin")381 b(sinh\(x\))191 1458 y("hyperbolic)45 b(tan")189 +b(tanh\(x\))g("round)47 b(to)g(nearest)f(int")94 b(round\(x\))191 +1571 y("round)46 b(down)h(to)g(int")f(floor\(x\))141 +b("round)47 b(up)g(to)g(int")333 b(ceil\(x\))191 1684 +y("exponential")d(exp\(x\))237 b("square)46 b(root")524 +b(sqrt\(x\))191 1797 y("natural)45 b(log")333 b(log\(x\))237 +b("common)46 b(log")572 b(log10\(x\))191 1910 y("modulus")522 +b(i)48 b(\045)f(j)286 b("random)46 b(#)i([0.0,1.0\)")188 +b(random\(\))191 2023 y("minimum")522 b(min\(x,y\))141 +b("maximum")714 b(max\(x,y\))191 2136 y("cumulative)45 +b(sum")189 b(accum\(x\))141 b("sequential)45 b(difference")g +(seqdiff\(x\))191 2249 y("if-then-else")282 b(b?x:y)0 +2484 y Fj(An)31 b(alternate)h(syn)m(tax)g(for)f(the)g(min)f(and)h(max)g +(functions)f(has)h(only)f(a)i(single)e(argumen)m(t)i(whic)m(h)e(should) +f(b)s(e)i(a)0 2597 y(v)m(ector)g(v)-5 b(alue)29 b(\(see)h(b)s(elo)m +(w\).)40 b(The)29 b(result)f(will)f(b)s(e)h(the)i(minim)m(um/maxim)m +(um)c(elemen)m(t)j(con)m(tained)h(within)d(the)0 2710 +y(v)m(ector.)0 2870 y(The)35 b(accum\(x\))i(function)e(forms)g(the)h +(cum)m(ulativ)m(e)g(sum)f(of)h(x,)h(elemen)m(t)g(b)m(y)f(elemen)m(t.)57 +b(V)-8 b(ector)38 b(columns)d(are)0 2983 y(supp)s(orted)i(simply)f(b)m +(y)i(p)s(erforming)e(the)j(summation)f(pro)s(cess)g(through)f(all)h +(the)h(v)-5 b(alues.)64 b(Null)37 b(v)-5 b(alues)38 b(are)0 +3096 y(treated)30 b(as)f(0.)41 b(The)29 b(seqdi\013\(x\))g(function)e +(forms)i(the)g(sequen)m(tial)g(di\013erence)f(of)i(x,)f(elemen)m(t)h(b) +m(y)f(elemen)m(t.)40 b(The)0 3209 y(\014rst)c(v)-5 b(alue)37 +b(of)g(seqdi\013)f(is)g(the)h(\014rst)g(v)-5 b(alue)36 +b(of)h(x.)61 b(A)37 b(single)f(n)m(ull)f(v)-5 b(alue)37 +b(in)e(x)i(causes)h(a)f(pair)f(of)h(n)m(ulls)e(in)h(the)0 +3322 y(output.)55 b(The)35 b(seqdi\013)f(and)h(accum)g(functions)f(are) +i(functional)d(in)m(v)m(erses,)k(i.e.,)g(seqdi\013\(accum\(x\)\))f(==)f +(x)g(as)0 3435 y(long)30 b(as)h(no)f(n)m(ull)e(v)-5 b(alues)30 +b(are)h(presen)m(t.)0 3595 y(The)38 b(follo)m(wing)f(t)m(yp)s(e)i +(casting)g(op)s(erators)g(are)g(a)m(v)-5 b(ailable,)41 +b(where)d(the)h(inclosing)e(paren)m(theses)i(are)g(required)0 +3708 y(and)30 b(tak)m(en)h(from)f(the)h(C)f(language)g(usage.)42 +b(Also,)30 b(the)h(in)m(teger)f(to)i(real)e(casts)h(v)-5 +b(alues)29 b(to)j(double)d(precision:)764 3944 y Fe("real)46 +b(to)h(integer")189 b(\(int\))46 b(x)239 b(\(INT\))46 +b(x)764 4057 y("integer)f(to)i(real")190 b(\(float\))46 +b(i)143 b(\(FLOAT\))45 b(i)0 4292 y Fj(In)30 b(addition,)e(sev)m(eral)j +(constan)m(ts)h(are)f(built)d(in)h(for)h(use)g(in)f(n)m(umerical)g +(expressions:)382 4528 y Fe(#pi)667 b(3.1415...)284 b(#e)620 +b(2.7182...)382 4641 y(#deg)f(#pi/180)380 b(#row)524 +b(current)46 b(row)h(number)382 4754 y(#null)428 b(undefined)45 +b(value)142 b(#snull)428 b(undefined)45 b(string)0 4989 +y Fj(A)40 b(string)e(constan)m(t)j(m)m(ust)e(b)s(e)g(enclosed)g(in)g +(quotes)h(as)f(in)g('Crab'.)67 b(The)39 b("n)m(ull")g(constan)m(ts)h +(are)g(useful)e(for)0 5102 y(conditionally)d(setting)j(table)g(v)-5 +b(alues)37 b(to)h(a)g(NULL,)g(or)g(unde\014ned,)f(v)-5 +b(alue)38 b(\(eg.,)j("col1==-99)e(?)62 b(#NULL)38 b(:)0 +5215 y(col1"\).)0 5375 y(There)27 b(is)f(also)i(a)f(function)f(for)i +(testing)f(if)f(t)m(w)m(o)j(v)-5 b(alues)27 b(are)h(close)f(to)i(eac)m +(h)f(other,)h(i.e.,)f(if)e(they)i(are)g("near")g(eac)m(h)0 +5488 y(other)c(to)h(within)c(a)j(user)g(sp)s(eci\014ed)e(tolerance.)39 +b(The)24 b(argumen)m(ts,)h(v)-5 b(alue)p 2503 5488 28 +4 v 33 w(1)24 b(and)f(v)-5 b(alue)p 2980 5488 V 32 w(2)25 +b(can)f(b)s(e)f(in)m(teger)h(or)g(real)0 5601 y(and)32 +b(represen)m(t)h(the)g(t)m(w)m(o)h(v)-5 b(alues)32 b(who's)g(pro)m +(ximit)m(y)g(is)g(b)s(eing)f(tested)i(to)h(b)s(e)e(within)e(the)j(sp)s +(eci\014ed)e(tolerance,)0 5714 y(also)f(an)h(in)m(teger)f(or)h(real:)p +eop +%%Page: 121 129 +121 128 bop 0 299 a Fh(10.10.)73 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)1936 b Fj(121)955 555 +y Fe(near\(value_1,)44 b(value_2,)h(tolerance\))0 781 +y Fj(When)24 b(a)i(NULL,)e(or)h(unde\014ned,)f(v)-5 b(alue)24 +b(is)g(encoun)m(tered)h(in)f(the)g(FITS)g(table,)i(the)f(expression)f +(will)e(ev)-5 b(aluate)25 b(to)0 894 y(NULL)31 b(unless)e(the)i +(unde\014ned)e(v)-5 b(alue)30 b(is)g(not)h(actually)f(required)f(for)i +(ev)-5 b(aluation,)31 b(e.g.)43 b("TR)m(UE)31 b(.or.)43 +b(NULL")0 1006 y(ev)-5 b(aluates)31 b(to)g(TR)m(UE.)g(The)f(follo)m +(wing)e(t)m(w)m(o)k(functions)d(allo)m(w)h(some)h(NULL)f(detection)h +(and)f(handling:)430 1232 y Fe("a)47 b(null)f(value?")667 +b(ISNULL\(x\))430 1345 y("define)45 b(a)j(value)e(for)h(null")190 +b(DEFNULL\(x,y\))0 1570 y Fj(The)36 b(former)h(returns)e(a)i(b)s(o)s +(olean)f(v)-5 b(alue)36 b(of)h(TR)m(UE)g(if)f(the)h(argumen)m(t)g(x)g +(is)f(NULL.)h(The)f(later)h("de\014nes")g(a)0 1683 y(v)-5 +b(alue)34 b(to)h(b)s(e)e(substituted)g(for)h(NULL)g(v)-5 +b(alues;)36 b(it)e(returns)f(the)h(v)-5 b(alue)34 b(of)g(x)g(if)f(x)i +(is)e(not)h(NULL,)h(otherwise)e(it)0 1796 y(returns)c(the)i(v)-5 +b(alue)30 b(of)g(y)-8 b(.)0 2081 y Fd(10.10.2)113 b(Bit)35 +b(Masks)0 2300 y Fj(Bit)g(masks)g(can)h(b)s(e)f(used)f(to)i(select)g +(out)f(ro)m(ws)h(from)e(bit)h(columns)f(\(TF)m(ORMn)h(=)g(#X\))h(in)e +(FITS)g(\014les.)54 b(T)-8 b(o)0 2413 y(represen)m(t)30 +b(the)h(mask,)g(binary)-8 b(,)29 b(o)s(ctal,)i(and)f(hex)g(formats)g +(are)h(allo)m(w)m(ed:)811 2638 y Fe(binary:)142 b +(b0110xx1010000101xxxx00)o(01)811 2751 y(octal:)190 b(o720x1)46 +b(->)h(\(b111010000xxx001\))811 2864 y(hex:)286 b(h0FxD)94 +b(->)47 b(\(b00001111xxxx1101\))0 3090 y Fj(In)22 b(all)g(the)h +(represen)m(tations,)i(an)d(x)h(or)g(X)g(is)f(allo)m(w)m(ed)h(in)e(the) +i(mask)g(as)g(a)h(wild)c(card.)38 b(Note)25 b(that)e(the)g(x)g +(represen)m(ts)0 3203 y(a)k(di\013eren)m(t)g(n)m(um)m(b)s(er)f(of)h +(wild)d(card)j(bits)f(in)g(eac)m(h)i(represen)m(tation.)40 +b(All)25 b(represen)m(tations)i(are)h(case)g(insensitiv)m(e.)0 +3363 y(T)-8 b(o)28 b(construct)g(the)g(b)s(o)s(olean)e(expression)h +(using)f(the)i(mask)f(as)h(the)g(b)s(o)s(olean)e(equal)h(op)s(erator)h +(describ)s(ed)e(ab)s(o)m(v)m(e)0 3476 y(on)34 b(a)h(bit)f(table)h +(column.)52 b(F)-8 b(or)35 b(example,)h(if)d(y)m(ou)i(had)f(a)h(7)g +(bit)f(column)f(named)h(\015ags)h(in)e(a)i(FITS)f(table)h(and)0 +3589 y(w)m(an)m(ted)c(all)e(ro)m(ws)i(ha)m(ving)f(the)g(bit)g(pattern)g +(0010011,)k(the)c(selection)h(expression)e(w)m(ould)g(b)s(e:)1336 +3814 y Fe(flags)47 b(==)g(b0010011)191 3927 y(or)1336 +4040 y(flags)g(.eq.)f(b10011)0 4265 y Fj(It)35 b(is)f(also)h(p)s +(ossible)d(to)k(test)g(if)e(a)h(range)g(of)g(bits)f(is)g(less)g(than,)i +(less)e(than)h(equal,)h(greater)g(than)e(and)h(greater)0 +4378 y(than)30 b(equal)g(to)h(a)g(particular)e(b)s(o)s(olean)g(v)-5 +b(alue:)1336 4604 y Fe(flags)47 b(<=)g(bxxx010xx)1336 +4717 y(flags)g(.gt.)f(bxxx100xx)1336 4829 y(flags)h(.le.)f(b1xxxxxxx)0 +5055 y Fj(Notice)31 b(the)g(use)f(of)h(the)f(x)g(bit)g(v)-5 +b(alue)30 b(to)h(limit)d(the)i(range)h(of)g(bits)e(b)s(eing)g +(compared.)0 5215 y(It)j(is)g(not)g(necessary)h(to)g(sp)s(ecify)e(the)i +(leading)e(\(most)i(signi\014can)m(t\))f(zero)h(\(0\))g(bits)e(in)g +(the)i(mask,)g(as)g(sho)m(wn)e(in)0 5328 y(the)g(second)f(expression)f +(ab)s(o)m(v)m(e.)0 5488 y(Bit)43 b(wise)f(AND,)i(OR)e(and)g(NOT)h(op)s +(erations)f(are)h(also)g(p)s(ossible)d(on)j(t)m(w)m(o)h(or)f(more)g +(bit)f(\014elds)f(using)h(the)0 5601 y('&'\(AND\),)35 +b(')p Fc(j)p Fj('\(OR\),)g(and)e(the)h(')10 b(!'\(NOT\))34 +b(op)s(erators.)51 b(All)32 b(of)h(these)h(op)s(erators)g(result)e(in)h +(a)h(bit)e(\014eld)g(whic)m(h)0 5714 y(can)f(then)f(b)s(e)f(used)h +(with)f(the)i(equal)f(op)s(erator.)41 b(F)-8 b(or)31 +b(example:)p eop +%%Page: 122 130 +122 129 bop 0 299 a Fj(122)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)1241 555 y +Fe(\(!flags\))45 b(==)j(b1101100)1241 668 y(\(flags)e(&)h(b1000001\))f +(==)h(bx000001)0 928 y Fj(Bit)34 b(\014elds)f(can)h(b)s(e)f(app)s +(ended)g(as)h(w)m(ell)f(using)g(the)h('+')g(op)s(erator.)53 +b(Strings)32 b(can)j(b)s(e)e(concatenated)j(this)d(w)m(a)m(y)-8 +b(,)0 1041 y(to)s(o.)0 1331 y Fd(10.10.3)113 b(V)-9 b(ector)36 +b(Columns)0 1550 y Fj(V)-8 b(ector)37 b(columns)d(can)i(also)f(b)s(e)g +(used)f(in)g(building)e(the)j(expression.)55 b(No)36 +b(sp)s(ecial)e(syn)m(tax)h(is)g(required)e(if)i(one)0 +1663 y(w)m(an)m(ts)46 b(to)f(op)s(erate)h(on)f(all)f(elemen)m(ts)h(of)g +(the)h(v)m(ector.)86 b(Simply)42 b(use)j(the)g(column)f(name)h(as)g +(for)g(a)g(scalar)0 1776 y(column.)c(V)-8 b(ector)32 +b(columns)e(can)h(b)s(e)f(freely)g(in)m(termixed)g(with)f(scalar)i +(columns)e(or)i(constan)m(ts)h(in)e(virtually)e(all)0 +1889 y(expressions.)39 b(The)29 b(result)f(will)e(b)s(e)j(of)g(the)g +(same)h(dimension)c(as)k(the)f(v)m(ector.)42 b(Tw)m(o)29 +b(v)m(ectors)i(in)d(an)h(expression,)0 2002 y(though,)f(need)e(to)i(ha) +m(v)m(e)g(the)f(same)g(n)m(um)m(b)s(er)f(of)h(elemen)m(ts)g(and)f(ha)m +(v)m(e)j(the)e(same)g(dimensions.)37 b(The)26 b(only)g(places)0 +2115 y(a)35 b(v)m(ector)h(column)d(cannot)i(b)s(e)f(used)f(\(for)i(no)m +(w,)g(an)m(yw)m(a)m(y\))h(are)f(the)g(SA)m(O)f(region)g(functions)f +(and)g(the)i(NEAR)0 2228 y(b)s(o)s(olean)29 b(function.)0 +2388 y(Arithmetic)22 b(and)g(logical)h(op)s(erations)f(are)i(all)e(p)s +(erformed)f(on)i(an)g(elemen)m(t)g(b)m(y)g(elemen)m(t)h(basis.)37 +b(Comparing)22 b(t)m(w)m(o)0 2501 y(v)m(ector)32 b(columns,)d(eg)i +("COL1)f(==)g(COL2",)g(th)m(us)g(results)f(in)g(another)h(v)m(ector)i +(of)e(b)s(o)s(olean)g(v)-5 b(alues)29 b(indicating)0 +2614 y(whic)m(h)g(elemen)m(ts)i(of)f(the)h(t)m(w)m(o)h(v)m(ectors)f +(are)g(equal.)0 2774 y(Eigh)m(t)f(functions)f(are)i(a)m(v)-5 +b(ailable)30 b(that)h(op)s(erate)g(on)f(a)h(v)m(ector)h(and)d(return)h +(a)g(scalar)h(result:)191 3034 y Fe("minimum")284 b(MIN\(V\))475 +b("maximum")714 b(MAX\(V\))191 3147 y("average")284 b(AVERAGE\(V\))f +("median")762 b(MEDIAN\(V\))191 3259 y("sumation")236 +b(SUM\(V\))475 b("standard)46 b(deviation")188 b(STDDEV\(V\))191 +3372 y("#)47 b(of)g(values")94 b(NELEM\(V\))379 b("#)48 +b(of)f(non-null)e(values")94 b(NVALID\(V\))0 3632 y Fj(where)40 +b(V)h(represen)m(ts)g(the)g(name)g(of)h(a)f(v)m(ector)h(column)e(or)h +(a)h(man)m(ually)d(constructed)i(v)m(ector)i(using)c(curly)0 +3745 y(brac)m(k)m(ets)27 b(as)f(describ)s(ed)d(b)s(elo)m(w.)38 +b(The)25 b(\014rst)g(6)h(of)g(these)g(functions)e(ignore)h(an)m(y)h(n)m +(ull)d(v)-5 b(alues)25 b(in)f(the)i(v)m(ector)h(when)0 +3858 y(computing)i(the)i(result.)0 4018 y(The)g(SUM)h(function)e +(literally)g(sums)h(all)f(the)i(elemen)m(ts)g(in)f(x,)h(returning)e(a)i +(scalar)g(v)-5 b(alue.)44 b(If)31 b(V)h(is)f(a)h(b)s(o)s(olean)0 +4131 y(v)m(ector,)40 b(SUM)c(returns)f(the)h(n)m(um)m(b)s(er)f(of)i(TR) +m(UE)f(elemen)m(ts.)59 b(The)36 b(NELEM)g(function)f(returns)g(the)h(n) +m(um)m(b)s(er)0 4244 y(of)h(elemen)m(ts)f(in)g(v)m(ector)i(V)e(whereas) +h(NV)-10 b(ALID)36 b(return)g(the)h(n)m(um)m(b)s(er)e(of)h(non-n)m(ull) +e(elemen)m(ts)j(in)e(the)i(v)m(ector.)0 4357 y(\(NELEM)28 +b(also)g(op)s(erates)g(on)g(bit)e(and)h(string)g(columns,)g(returning)f +(their)h(column)f(widths.\))39 b(As)27 b(an)h(example,)0 +4470 y(to)42 b(test)g(whether)f(all)f(elemen)m(ts)i(of)g(t)m(w)m(o)g(v) +m(ectors)h(satisfy)e(a)h(giv)m(en)f(logical)g(comparison,)i(one)f(can)g +(use)f(the)0 4583 y(expression)668 4842 y Fe(SUM\()47 +b(COL1)f(>)i(COL2)f(\))g(==)g(NELEM\()f(COL1)h(\))0 5102 +y Fj(whic)m(h)31 b(will)e(return)i(TR)m(UE)h(if)f(all)g(elemen)m(ts)h +(of)g(COL1)g(are)g(greater)h(than)f(their)f(corresp)s(onding)f(elemen)m +(ts)i(in)0 5215 y(COL2.)0 5375 y(T)-8 b(o)32 b(sp)s(ecify)e(a)j(single) +d(elemen)m(t)i(of)g(a)g(v)m(ector,)i(giv)m(e)e(the)g(column)e(name)i +(follo)m(w)m(ed)f(b)m(y)h(a)g(comma-separated)h(list)0 +5488 y(of)c(co)s(ordinates)f(enclosed)h(in)e(square)i(brac)m(k)m(ets.) +41 b(F)-8 b(or)30 b(example,)f(if)e(a)i(v)m(ector)i(column)c(named)i +(PHAS)f(exists)g(in)0 5601 y(the)f(table)f(as)h(a)g(one)g(dimensional,) +e(256)j(comp)s(onen)m(t)f(list)e(of)i(n)m(um)m(b)s(ers)e(from)h(whic)m +(h)g(y)m(ou)h(w)m(an)m(ted)g(to)g(select)h(the)0 5714 +y(57th)k(comp)s(onen)m(t)g(for)f(use)g(in)f(the)i(expression,)e(then)i +(PHAS[57])g(w)m(ould)e(do)i(the)f(tric)m(k.)44 b(Higher)31 +b(dimensional)p eop +%%Page: 123 131 +123 130 bop 0 299 a Fh(10.10.)73 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)1936 b Fj(123)0 555 +y(arra)m(ys)41 b(of)h(data)f(ma)m(y)h(app)s(ear)f(in)e(a)j(column.)72 +b(But)41 b(in)f(order)g(to)i(in)m(terpret)e(them,)k(the)e(TDIMn)e(k)m +(eyw)m(ord)0 668 y(m)m(ust)34 b(app)s(ear)g(in)f(the)h(header.)52 +b(Assuming)33 b(that)i(a)f(\(4,4,4,4\))k(arra)m(y)c(is)g(pac)m(k)m(ed)h +(in)m(to)f(eac)m(h)i(ro)m(w)e(of)g(a)h(column)0 781 y(named)26 +b(ARRA)-8 b(Y4D,)28 b(the)f(\(1,2,3,4\))i(comp)s(onen)m(t)e(elemen)m(t) +f(of)h(eac)m(h)g(ro)m(w)g(is)e(accessed)j(b)m(y)e(ARRA)-8 +b(Y4D[1,2,3,4].)0 894 y(Arra)m(ys)33 b(up)e(to)j(dimension)c(5)j(are)f +(curren)m(tly)g(supp)s(orted.)46 b(Eac)m(h)33 b(v)m(ector)h(index)d +(can)i(itself)e(b)s(e)h(an)h(expression,)0 1007 y(although)38 +b(it)g(m)m(ust)h(ev)-5 b(aluate)39 b(to)g(an)g(in)m(teger)g(v)-5 +b(alue)38 b(within)e(the)j(b)s(ounds)d(of)j(the)g(v)m(ector.)67 +b(V)-8 b(ector)40 b(columns)0 1120 y(whic)m(h)30 b(con)m(tain)h(spaces) +h(or)f(arithmetic)f(op)s(erators)i(m)m(ust)f(ha)m(v)m(e)h(their)e +(names)h(enclosed)g(in)f("$")i(c)m(haracters)h(as)0 1233 +y(with)c($ARRA)-8 b(Y-4D$[1,2,3,4].)0 1393 y(A)45 b(more)f(C-lik)m(e)g +(syn)m(tax)i(for)e(sp)s(ecifying)e(v)m(ector)47 b(indices)42 +b(is)i(also)h(a)m(v)-5 b(ailable.)82 b(The)45 b(elemen)m(t)g(used)e(in) +h(the)0 1506 y(preceding)27 b(example)h(alternativ)m(ely)g(could)f(b)s +(e)h(sp)s(eci\014ed)f(with)f(the)j(syn)m(tax)g(ARRA)-8 +b(Y4D[4][3][2][1].)45 b(Note)30 b(the)0 1619 y(rev)m(erse)40 +b(order)f(of)h(indices)d(\(as)j(in)e(C\),)i(as)f(w)m(ell)g(as)g(the)h +(fact)g(that)g(the)g(v)-5 b(alues)39 b(are)g(still)f(ones-based)h(\(as) +h(in)0 1732 y(F)-8 b(ortran)39 b({)g(adopted)g(to)g(a)m(v)m(oid)g(am)m +(biguit)m(y)f(for)h(1D)g(v)m(ectors\).)67 b(With)38 b(this)g(syn)m +(tax,)j(one)e(do)s(es)f(not)h(need)f(to)0 1844 y(sp)s(ecify)29 +b(all)g(of)i(the)f(indices.)39 b(T)-8 b(o)31 b(extract)h(a)f(3D)g +(slice)e(of)i(this)e(4D)i(arra)m(y)-8 b(,)32 b(use)e(ARRA)-8 +b(Y4D[4].)0 2005 y(V)g(ariable-length)30 b(v)m(ector)i(columns)d(are)h +(not)h(supp)s(orted.)0 2165 y(V)-8 b(ectors)24 b(can)e(b)s(e)f(man)m +(ually)f(constructed)j(within)c(the)j(expression)f(using)f(a)i +(comma-separated)i(list)d(of)h(elemen)m(ts)0 2278 y(surrounded)35 +b(b)m(y)j(curly)f(braces)i(\(')p Fc(fg)p Fj('\).)66 b(F)-8 +b(or)38 b(example,)i(')p Fc(f)p Fj(1,3,6,1)p Fc(g)p Fj(')i(is)c(a)g +(4-elemen)m(t)h(v)m(ector)h(con)m(taining)e(the)0 2391 +y(v)-5 b(alues)25 b(1,)i(3,)g(6,)g(and)e(1.)40 b(The)25 +b(v)m(ector)i(can)f(con)m(tain)g(only)f(b)s(o)s(olean,)g(in)m(teger,)j +(and)d(real)g(v)-5 b(alues)25 b(\(or)h(expressions\).)0 +2503 y(The)c(elemen)m(ts)h(will)d(b)s(e)i(promoted)h(to)g(the)g +(highest)f(data)h(t)m(yp)s(e)g(presen)m(t.)38 b(An)m(y)22 +b(elemen)m(ts)h(whic)m(h)f(are)h(themselv)m(es)0 2616 +y(v)m(ectors,)40 b(will)34 b(b)s(e)i(expanded)g(out)h(with)f(eac)m(h)h +(of)g(its)f(elemen)m(ts)i(b)s(ecoming)d(an)i(elemen)m(t)g(in)f(the)h +(constructed)0 2729 y(v)m(ector.)0 3032 y Fd(10.10.4)113 +b(Go)s(o)s(d)38 b(Time)e(In)m(terv)-6 b(al)36 b(Filtering)0 +3254 y Fj(A)44 b(common)g(\014ltering)f(metho)s(d)g(in)m(v)m(olv)m(es)h +(selecting)g(ro)m(ws)g(whic)m(h)e(ha)m(v)m(e)k(a)e(time)g(v)-5 +b(alue)43 b(whic)m(h)g(lies)f(within)0 3367 y(what)37 +b(is)f(called)h(a)h(Go)s(o)s(d)f(Time)f(In)m(terv)-5 +b(al)37 b(or)g(GTI.)g(The)g(time)g(in)m(terv)-5 b(als)36 +b(are)i(de\014ned)e(in)g(a)h(separate)i(FITS)0 3480 y(table)h +(extension)g(whic)m(h)e(con)m(tains)i(2)h(columns)e(giving)f(the)j +(start)f(and)g(stop)g(time)f(of)h(eac)m(h)i(go)s(o)s(d)e(in)m(terv)-5 +b(al.)0 3592 y(The)34 b(\014ltering)f(op)s(eration)i(accepts)h(only)d +(those)j(ro)m(ws)e(of)h(the)g(input)e(table)i(whic)m(h)e(ha)m(v)m(e)j +(an)f(asso)s(ciated)g(time)0 3705 y(whic)m(h)f(falls)h(within)e(one)j +(of)g(the)g(time)f(in)m(terv)-5 b(als)35 b(de\014ned)g(in)f(the)i(GTI)g +(extension.)56 b(A)36 b(high)f(lev)m(el)g(function,)0 +3818 y(gti\014lter\(a,b,c,d\),)42 b(is)d(a)m(v)-5 b(ailable)39 +b(whic)m(h)f(ev)-5 b(aluates)40 b(eac)m(h)h(ro)m(w)e(of)h(the)f(input)f +(table)h(and)g(returns)f(TR)m(UE)i(or)0 3931 y(F)-10 +b(ALSE)30 b(dep)s(ending)e(whether)i(the)g(ro)m(w)h(is)e(inside)f(or)i +(outside)g(the)h(go)s(o)s(d)f(time)g(in)m(terv)-5 b(al.)40 +b(The)30 b(syn)m(tax)h(is)286 4202 y Fe(gtifilter\()45 +b([)j("gtifile")d([,)i(expr)g([,)g("STARTCOL",)e("STOPCOL")g(])j(])f(]) +g(\))191 4314 y(or)286 4427 y(gtifilter\()e([)j('gtifile')d([,)i(expr)g +([,)g('STARTCOL',)e('STOPCOL')g(])j(])f(])g(\))0 4698 +y Fj(where)20 b(eac)m(h)h("[]")h(demarks)e(optional)f(parameters.)38 +b(Note)21 b(that)g(the)g(quotes)f(around)g(the)g(gti\014le)g(and)f(ST) +-8 b(AR)g(T/STOP)0 4811 y(column)32 b(are)i(required.)49 +b(Either)33 b(single)f(or)i(double)e(quotes)i(ma)m(y)g(b)s(e)f(used.)50 +b(In)33 b(cases)h(where)g(this)e(expression)0 4924 y(is)d(en)m(tered)h +(on)g(the)g(Unix)f(command)h(line,)e(enclose)i(the)g(en)m(tire)g +(expression)f(in)f(double)h(quotes,)h(and)g(then)f(use)0 +5036 y(single)23 b(quotes)i(within)c(the)k(expression)e(to)i(enclose)f +(the)h('gti\014le')f(and)f(other)i(terms.)38 b(It)25 +b(is)e(also)h(usually)e(p)s(ossible)0 5149 y(to)38 b(do)e(the)h(rev)m +(erse,)j(and)c(enclose)h(the)g(whole)f(expression)g(in)f(single)h +(quotes)h(and)f(then)h(use)f(double)f(quotes)0 5262 y(within)c(the)i +(expression.)49 b(The)33 b(gti\014le,)g(if)g(sp)s(eci\014ed,)f(can)i(b) +s(e)f(blank)f(\(""\))j(whic)m(h)d(will)e(mean)k(to)g(use)f(the)h +(\014rst)0 5375 y(extension)f(with)g(the)g(name)h("*GTI*")h(in)e(the)g +(curren)m(t)h(\014le,)g(a)g(plain)d(extension)i(sp)s(eci\014er)f(\(eg,) +k("+2",)g("[2]",)0 5488 y(or)30 b("[STDGTI]"\))i(whic)m(h)d(will)f(b)s +(e)i(used)f(to)j(select)f(an)f(extension)g(in)f(the)i(curren)m(t)f +(\014le,)g(or)g(a)h(regular)f(\014lename)0 5601 y(with)f(or)i(without)e +(an)i(extension)f(sp)s(eci\014er)f(whic)m(h)g(in)g(the)i(latter)g(case) +g(will)d(mean)i(to)i(use)e(the)h(\014rst)e(extension)0 +5714 y(with)36 b(an)h(extension)f(name)i("*GTI*".)62 +b(Expr)36 b(can)h(b)s(e)g(an)m(y)g(arithmetic)g(expression,)g +(including)d(simply)h(the)p eop +%%Page: 124 132 +124 131 bop 0 299 a Fj(124)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(time)35 +b(column)g(name.)57 b(A)36 b(v)m(ector)h(time)f(expression)e(will)f +(pro)s(duce)i(a)h(v)m(ector)h(b)s(o)s(olean)e(result.)56 +b(ST)-8 b(AR)g(TCOL)0 668 y(and)27 b(STOPCOL)f(are)i(the)g(names)g(of)g +(the)g(ST)-8 b(AR)g(T/STOP)26 b(columns)h(in)f(the)i(GTI)g(extension.) +40 b(If)27 b(one)h(of)g(them)0 781 y(is)h(sp)s(eci\014ed,)g(they)i(b)s +(oth)f(m)m(ust)g(b)s(e.)0 941 y(In)21 b(its)g(simplest)f(form,)k(no)d +(parameters)h(need)g(to)h(b)s(e)e(pro)m(vided)f({)i(default)f(v)-5 +b(alues)21 b(will)f(b)s(e)h(used.)37 b(The)21 b(expression)0 +1054 y("gti\014lter\(\)")31 b(is)f(equiv)-5 b(alen)m(t)29 +b(to)334 1322 y Fe(gtifilter\()45 b("",)i(TIME,)f("*START*",)f +("*STOP*")h(\))0 1590 y Fj(This)30 b(will)e(searc)m(h)k(the)g(curren)m +(t)f(\014le)f(for)h(a)h(GTI)f(extension,)g(\014lter)g(the)g(TIME)g +(column)f(in)g(the)i(curren)m(t)f(table,)0 1703 y(using)i(ST)-8 +b(AR)g(T/STOP)34 b(times)h(tak)m(en)g(from)g(columns)e(in)h(the)h(GTI)g +(extension)f(with)g(names)g(con)m(taining)h(the)0 1816 +y(strings)c("ST)-8 b(AR)g(T")33 b(and)e("STOP".)46 b(The)32 +b(wildcards)d(\('*'\))34 b(allo)m(w)e(sligh)m(t)f(v)-5 +b(ariations)31 b(in)g(naming)g(con)m(v)m(en)m(tions)0 +1929 y(suc)m(h)38 b(as)g("TST)-8 b(AR)g(T")39 b(or)f("ST)-8 +b(AR)g(TTIME".)65 b(The)37 b(same)i(default)f(v)-5 b(alues)37 +b(apply)g(for)h(unsp)s(eci\014ed)e(parame-)0 2042 y(ters)g(when)f(the)h +(\014rst)f(one)i(or)f(t)m(w)m(o)h(parameters)f(are)h(sp)s(eci\014ed.)55 +b(The)36 b(function)e(automatically)i(searc)m(hes)h(for)0 +2154 y(TIMEZER)m(O/I/F)g(k)m(eyw)m(ords)f(in)f(the)i(curren)m(t)f(and)g +(GTI)g(extensions,)h(applying)e(a)h(relativ)m(e)h(time)f(o\013set,)j +(if)0 2267 y(necessary)-8 b(.)0 2568 y Fd(10.10.5)113 +b(Spatial)36 b(Region)h(Filtering)0 2788 y Fj(Another)h(common)g +(\014ltering)e(metho)s(d)h(selects)h(ro)m(ws)g(based)g(on)f(whether)h +(the)g(spatial)f(p)s(osition)e(asso)s(ciated)0 2901 y(with)c(eac)m(h)j +(ro)m(w)e(is)g(lo)s(cated)h(within)d(a)j(giv)m(en)f(2-dimensional)e +(region.)47 b(The)32 b(syn)m(tax)h(for)f(this)g(high-lev)m(el)f +(\014lter)0 3014 y(is)334 3282 y Fe(regfilter\()45 b("regfilename")f([) +k(,)f(Xexpr,)f(Yexpr)h([)g(,)h("wcs)e(cols")h(])g(])g(\))0 +3550 y Fj(where)22 b(eac)m(h)i("[]")g(demarks)e(optional)g(parameters.) +38 b(The)22 b(region)g(\014le)g(name)g(is)g(required)f(and)h(m)m(ust)g +(b)s(e)g(enclosed)0 3663 y(in)38 b(quotes.)70 b(The)39 +b(remaining)f(parameters)i(are)g(optional.)68 b(The)39 +b(region)g(\014le)g(is)g(an)g(ASCI)s(I)g(text)h(\014le)f(whic)m(h)0 +3776 y(con)m(tains)30 b(a)f(list)f(of)i(one)f(or)h(more)f(geometric)i +(shap)s(es)d(\(circle,)i(ellipse,)d(b)s(o)m(x,)j(etc.\))42 +b(whic)m(h)28 b(de\014nes)g(a)i(region)f(on)0 3889 y(the)i(celestial)f +(sphere)g(or)h(an)g(area)g(within)d(a)j(particular)f(2D)h(image.)42 +b(The)30 b(region)h(\014le)f(is)f(t)m(ypically)h(generated)0 +4002 y(using)21 b(an)i(image)g(displa)m(y)e(program)i(suc)m(h)f(as)h +(fv/PO)m(W)h(\(distribute)c(b)m(y)j(the)g(HEASAR)m(C\),)g(or)g(ds9)g +(\(distributed)0 4115 y(b)m(y)k(the)g(Smithsonian)d(Astroph)m(ysical)i +(Observ)-5 b(atory\).)39 b(Users)27 b(should)e(refer)h(to)i(the)f(do)s +(cumen)m(tation)f(pro)m(vided)0 4228 y(with)j(these)i(programs)f(for)g +(more)h(details)e(on)h(the)h(syn)m(tax)g(used)e(in)g(the)i(region)f +(\014les.)0 4388 y(In)44 b(its)g(simpliest)e(form,)47 +b(\(e.g.,)j(reg\014lter\("region.reg"\))c(\))f(the)g(co)s(ordinates)f +(in)f(the)i(default)e('X')i(and)f('Y')0 4501 y(columns)32 +b(will)e(b)s(e)i(used)g(to)i(determine)e(if)f(eac)m(h)j(ro)m(w)f(is)f +(inside)f(or)i(outside)f(the)h(area)h(sp)s(eci\014ed)d(in)g(the)i +(region)0 4613 y(\014le.)40 b(Alternate)31 b(p)s(osition)d(column)h +(names,)i(or)f(expressions,)f(ma)m(y)i(b)s(e)f(en)m(tered)h(if)e +(needed,)i(as)f(in)382 4881 y Fe(regfilter\("region.reg",)41 +b(XPOS,)47 b(YPOS\))0 5149 y Fj(Region)36 b(\014ltering)e(can)i(b)s(e)f +(applied)e(most)j(unam)m(biguously)d(if)i(the)h(p)s(ositions)e(in)g +(the)i(region)f(\014le)g(and)g(in)g(the)0 5262 y(table)g(to)h(b)s(e)e +(\014ltered)g(are)i(b)s(oth)e(giv)m(e)i(in)e(terms)h(of)g(absolute)g +(celestial)g(co)s(ordinate)g(units.)53 b(In)35 b(this)f(case)i(the)0 +5375 y(lo)s(cations)24 b(and)f(sizes)h(of)h(the)f(geometric)h(shap)s +(es)f(in)f(the)h(region)g(\014le)f(are)i(sp)s(eci\014ed)e(in)g(angular) +g(units)g(on)h(the)g(sky)0 5488 y(\(e.g.,)32 b(p)s(ositions)c(giv)m(en) +j(in)e(R.A.)h(and)g(Dec.)42 b(and)30 b(sizes)g(in)f(arcseconds)h(or)h +(arcmin)m(utes\).)40 b(Similarly)-8 b(,)27 b(eac)m(h)32 +b(ro)m(w)0 5601 y(of)h(the)h(\014ltered)e(table)h(will)d(ha)m(v)m(e)35 +b(a)e(celestial)g(co)s(ordinate)g(asso)s(ciated)g(with)f(it.)49 +b(This)31 b(asso)s(ciation)i(is)f(usually)0 5714 y(implemen)m(ted)37 +b(using)f(a)j(set)g(of)f(so-called)g('W)-8 b(orld)38 +b(Co)s(ordinate)g(System')g(\(or)h(W)m(CS\))f(FITS)g(k)m(eyw)m(ords)g +(that)p eop +%%Page: 125 133 +125 132 bop 0 299 a Fh(10.10.)73 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)1936 b Fj(125)0 555 +y(de\014ne)27 b(the)g(co)s(ordinate)g(transformation)g(that)h(m)m(ust)f +(b)s(e)f(applied)f(to)j(the)g(v)-5 b(alues)26 b(in)g(the)i('X')g(and)e +('Y')i(columns)0 668 y(to)j(calculate)g(the)f(co)s(ordinate.)0 +828 y(Alternativ)m(ely)-8 b(,)27 b(one)g(can)g(p)s(erform)e(spatial)h +(\014ltering)e(using)h(unitless)g('pixel')g(co)s(ordinates)i(for)f(the) +h(regions)f(and)0 941 y(ro)m(w)33 b(p)s(ositions.)47 +b(In)33 b(this)f(case)i(the)f(user)g(m)m(ust)g(b)s(e)f(careful)g(to)i +(ensure)f(that)g(the)h(p)s(ositions)d(in)h(the)h(2)g(\014les)g(are)0 +1054 y(self-consisten)m(t.)52 b(A)34 b(t)m(ypical)g(problem)e(is)h +(that)i(the)f(region)g(\014le)f(ma)m(y)i(b)s(e)e(generated)j(using)c(a) +j(binned)c(image,)0 1167 y(but)h(the)h(un)m(binned)d(co)s(ordinates)i +(are)h(giv)m(en)g(in)e(the)i(ev)m(en)m(t)i(table.)47 +b(The)32 b(R)m(OSA)-8 b(T)33 b(ev)m(en)m(ts)h(\014les,)f(for)f +(example,)0 1280 y(ha)m(v)m(e)f(X)f(and)f(Y)g(pixel)f(co)s(ordinates)h +(that)i(range)f(from)f(1)h(-)g(15360.)42 b(These)30 b(co)s(ordinates)f +(are)h(t)m(ypically)e(binned)0 1393 y(b)m(y)33 b(a)h(factor)g(of)f(32)h +(to)g(pro)s(duce)e(a)i(480x480)i(pixel)31 b(image.)50 +b(If)32 b(one)i(then)f(uses)g(a)g(region)g(\014le)f(generated)i(from)0 +1506 y(this)29 b(image)i(\(in)f(image)g(pixel)f(units\))h(to)h +(\014lter)e(the)i(R)m(OSA)-8 b(T)30 b(ev)m(en)m(ts)i(\014le,)e(then)g +(the)h(X)g(and)f(Y)g(column)g(v)-5 b(alues)0 1619 y(m)m(ust)30 +b(b)s(e)g(con)m(v)m(erted)i(to)f(corresp)s(onding)d(pixel)h(units)g(as) +h(in:)382 1885 y Fe(regfilter\("rosat.reg",)42 b(X/32.+.5,)j +(Y/32.+.5\))0 2151 y Fj(Note)h(that)f(this)e(binning)e(con)m(v)m +(ersion)k(is)e(not)i(necessary)g(if)e(the)i(region)f(\014le)f(is)h(sp)s +(eci\014ed)e(using)h(celestial)0 2264 y(co)s(ordinate)h(units)f +(instead)g(of)h(pixel)f(units)g(b)s(ecause)h(CFITSIO)e(is)i(then)f +(able)h(to)h(directly)e(compare)i(the)0 2377 y(celestial)27 +b(co)s(ordinate)h(of)f(eac)m(h)i(ro)m(w)f(in)e(the)i(table)f(with)g +(the)g(celestial)h(co)s(ordinates)f(in)f(the)i(region)f(\014le)g +(without)0 2490 y(ha)m(ving)j(to)h(kno)m(w)f(an)m(ything)g(ab)s(out)g +(ho)m(w)h(the)f(image)h(ma)m(y)g(ha)m(v)m(e)g(b)s(een)f(binned.)0 +2650 y(The)f(last)g("w)m(cs)h(cols")g(parameter)g(should)d(rarely)h(b)s +(e)h(needed.)40 b(If)29 b(supplied,)d(this)j(string)f(con)m(tains)i +(the)f(names)0 2763 y(of)37 b(the)g(2)h(columns)e(\(space)i(or)f(comma) +g(separated\))h(whic)m(h)e(ha)m(v)m(e)i(the)g(asso)s(ciated)f(W)m(CS)g +(k)m(eyw)m(ords.)61 b(If)37 b(not)0 2876 y(supplied,)d(the)i(\014lter)f +(will)f(scan)i(the)g(X)g(and)f(Y)h(expressions)f(for)h(column)e(names.) +58 b(If)35 b(only)g(one)i(is)e(found)f(in)0 2989 y(eac)m(h)e +(expression,)d(those)i(columns)e(will)f(b)s(e)h(used,)h(otherwise)g(an) +g(error)g(will)e(b)s(e)i(returned.)0 3149 y(These)g(region)g(shap)s(es) +g(are)g(supp)s(orted)f(\(names)h(are)h(case)h(insensitiv)m(e\):)334 +3415 y Fe(Point)428 b(\()48 b(X1,)f(Y1)g(\))715 b(<-)48 +b(One)f(pixel)f(square)g(region)334 3528 y(Line)476 b(\()48 +b(X1,)f(Y1,)g(X2,)f(Y2)i(\))333 b(<-)48 b(One)f(pixel)f(wide)h(region) +334 3641 y(Polygon)332 b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2,)h(...)g(\))95 +b(<-)48 b(Rest)e(are)h(interiors)e(with)334 3754 y(Rectangle)236 +b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2,)h(A)h(\))334 b(|)47 b(boundaries)e +(considered)334 3867 y(Box)524 b(\()48 b(Xc,)f(Yc,)g(Wdth,)f(Hght,)g(A) +i(\))143 b(V)47 b(within)f(the)h(region)334 3980 y(Diamond)332 +b(\()48 b(Xc,)f(Yc,)g(Wdth,)f(Hght,)g(A)i(\))334 4093 +y(Circle)380 b(\()48 b(Xc,)f(Yc,)g(R)g(\))334 4206 y(Annulus)332 +b(\()48 b(Xc,)f(Yc,)g(Rin,)f(Rout)h(\))334 4319 y(Ellipse)332 +b(\()48 b(Xc,)f(Yc,)g(Rx,)f(Ry,)h(A)h(\))334 4431 y(Elliptannulus)c(\() +k(Xc,)f(Yc,)g(Rinx,)f(Riny,)g(Routx,)g(Routy,)g(Ain,)h(Aout)g(\))334 +4544 y(Sector)380 b(\()48 b(Xc,)f(Yc,)g(Amin,)f(Amax)h(\))0 +4811 y Fj(where)28 b(\(Xc,Yc\))j(is)c(the)i(co)s(ordinate)g(of)f(the)h +(shap)s(e's)f(cen)m(ter;)j(\(X#,Y#\))e(are)g(the)g(co)s(ordinates)f(of) +h(the)g(shap)s(e's)0 4924 y(edges;)39 b(Rxxx)c(are)g(the)h(shap)s(es')f +(v)-5 b(arious)34 b(Radii)g(or)h(semima)5 b(jor/minor)34 +b(axes;)k(and)d(Axxx)g(are)h(the)g(angles)f(of)0 5036 +y(rotation)d(\(or)f(b)s(ounding)e(angles)i(for)g(Sector\))h(in)e +(degrees.)44 b(F)-8 b(or)32 b(rotated)h(shap)s(es,)e(the)g(rotation)h +(angle)f(can)h(b)s(e)0 5149 y(left)f(o\013,)i(indicating)c(no)i +(rotation.)45 b(Common)31 b(alternate)h(names)f(for)h(the)f(regions)g +(can)h(also)g(b)s(e)e(used:)43 b(rotb)s(o)m(x)0 5262 +y(=)29 b(b)s(o)m(x;)g(rotrectangle)h(=)f(rectangle;)h(\(rot\)rhom)m +(bus)f(=)f(\(rot\)diamond;)i(and)e(pie)g(=)g(sector.)42 +b(When)28 b(a)i(shap)s(e's)0 5375 y(name)e(is)f(preceded)g(b)m(y)h(a)g +(min)m(us)f(sign,)g('-',)j(the)e(de\014ned)e(region)i(is)f(instead)g +(the)h(area)h(*outside*)f(its)f(b)s(oundary)0 5488 y(\(ie,)35 +b(the)f(region)g(is)f(in)m(v)m(erted\).)52 b(All)32 b(the)i(shap)s(es)f +(within)f(a)i(single)f(region)g(\014le)h(are)g(OR'd)f(together)j(to)e +(create)0 5601 y(the)29 b(region,)h(and)e(the)i(order)f(is)f +(signi\014can)m(t.)39 b(The)29 b(o)m(v)m(erall)g(w)m(a)m(y)i(of)e(lo)s +(oking)f(at)i(region)f(\014les)f(is)g(that)i(if)e(the)i(\014rst)0 +5714 y(region)e(is)g(an)h(excluded)f(region)g(then)g(a)i(dumm)m(y)d +(included)f(region)j(of)g(the)g(whole)f(detector)i(is)e(inserted)f(in)h +(the)p eop +%%Page: 126 134 +126 133 bop 0 299 a Fj(126)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(fron)m(t.)40 +b(Then)25 b(eac)m(h)j(region)e(sp)s(eci\014cation)g(as)h(it)f(is)g(pro) +s(cessed)g(o)m(v)m(errides)g(an)m(y)h(selections)g(inside)d(of)j(that)g +(region)0 668 y(sp)s(eci\014ed)35 b(b)m(y)h(previous)f(regions.)58 +b(Another)37 b(w)m(a)m(y)g(of)g(thinking)d(ab)s(out)i(this)f(is)h(that) +h(if)e(a)i(previous)e(excluded)0 781 y(region)30 b(is)f(completely)h +(inside)f(of)h(a)h(subsequen)m(t)e(included)f(region)i(the)h(excluded)e +(region)h(is)f(ignored.)0 941 y(The)44 b(p)s(ositional)f(co)s +(ordinates)i(ma)m(y)g(b)s(e)g(giv)m(en)g(either)f(in)g(pixel)f(units,)k +(decimal)d(degrees)i(or)f(hh:mm:ss.s,)0 1054 y(dd:mm:ss.s)25 +b(units.)37 b(The)26 b(shap)s(e)f(sizes)h(ma)m(y)g(b)s(e)g(giv)m(en)g +(in)e(pixels,)i(degrees,)h(arcmin)m(utes,)g(or)f(arcseconds.)40 +b(Lo)s(ok)0 1167 y(at)31 b(examples)f(of)g(region)g(\014le)g(pro)s +(duced)e(b)m(y)i(fv/PO)m(W)h(or)g(ds9)f(for)g(further)f(details)g(of)i +(the)f(region)g(\014le)f(format.)0 1327 y(There)37 b(are)g(three)g +(functions)f(that)h(are)h(primarily)c(for)i(use)h(with)f(SA)m(O)h +(region)f(\014les)g(and)h(the)g(FSA)m(OI)g(task,)0 1440 +y(but)e(they)h(can)h(b)s(e)e(used)g(directly)-8 b(.)57 +b(They)36 b(return)f(a)h(b)s(o)s(olean)f(true)h(or)g(false)f(dep)s +(ending)f(on)i(whether)f(a)i(t)m(w)m(o)0 1553 y(dimensional)28 +b(p)s(oin)m(t)h(is)g(in)g(the)i(region)f(or)g(not:)191 +1815 y Fe("point)46 b(in)h(a)h(circular)d(region")477 +1927 y(circle\(xcntr,ycntr,radius)o(,Xco)o(lumn)o(,Yc)o(olum)o(n\))191 +2153 y("point)h(in)h(an)g(elliptical)e(region")430 2266 +y(ellipse\(xcntr,ycntr,xhl)o(f_w)o(dth,)o(yhlf)o(_wd)o(th,r)o(otat)o +(ion)o(,Xco)o(lumn)o(,Yc)o(olum)o(n\))191 2492 y("point)h(in)h(a)h +(rectangular)c(region")620 2605 y(box\(xcntr,ycntr,xfll_wdth,)o(yfll)o +(_wd)o(th,r)o(otat)o(ion)o(,Xco)o(lumn)o(,Yc)o(olum)o(n\))191 +2831 y(where)334 2944 y(\(xcntr,ycntr\))g(are)j(the)g(\(x,y\))f +(position)g(of)h(the)g(center)f(of)h(the)g(region)334 +3057 y(\(xhlf_wdth,yhlf_wdth\))42 b(are)47 b(the)g(\(x,y\))f(half)h +(widths)f(of)h(the)g(region)334 3169 y(\(xfll_wdth,yfll_wdth\))42 +b(are)47 b(the)g(\(x,y\))f(full)h(widths)f(of)h(the)g(region)334 +3282 y(\(radius\))f(is)h(half)f(the)h(diameter)f(of)h(the)g(circle)334 +3395 y(\(rotation\))e(is)i(the)g(angle\(degrees\))d(that)j(the)g +(region)f(is)h(rotated)f(with)620 3508 y(respect)g(to)h +(\(xcntr,ycntr\))334 3621 y(\(Xcoord,Ycoord\))d(are)j(the)g(\(x,y\))f +(coordinates)f(to)i(test,)f(usually)g(column)620 3734 +y(names)334 3847 y(NOTE:)g(each)h(parameter)e(can)i(itself)f(be)i(an)f +(expression,)d(not)j(merely)f(a)620 3960 y(column)h(name)f(or)h +(constant.)0 4253 y Fd(10.10.6)113 b(Example)36 b(Ro)m(w)h(Filters)191 +4472 y Fe([)47 b(binary)f(&&)i(mag)f(<=)g(5.0])380 b(-)48 +b(Extract)e(all)h(binary)f(stars)g(brighter)1766 4585 +y(than)94 b(fifth)47 b(magnitude)e(\(note)h(that)1766 +4698 y(the)h(initial)f(space)g(is)h(necessary)e(to)1766 +4811 y(prevent)h(it)h(from)g(being)f(treated)g(as)h(a)1766 +4924 y(binning)f(specification\))191 5149 y([#row)g(>=)h(125)g(&&)h +(#row)e(<=)h(175])142 b(-)48 b(Extract)e(row)h(numbers)e(125)i(through) +f(175)191 5375 y([IMAGE[4,5])f(.gt.)h(100])476 b(-)48 +b(Extract)e(all)h(rows)f(that)h(have)g(the)1766 5488 +y(\(4,5\))f(component)g(of)h(the)g(IMAGE)f(column)1766 +5601 y(greater)g(than)g(100)p eop +%%Page: 127 135 +127 134 bop 0 299 a Fh(10.11.)113 b(BINNING)32 b(OR)e(HISTOGRAMMING)g +(SPECIFICA)-8 b(TION)1223 b Fj(127)191 555 y Fe([abs\(sin\(theta)44 +b(*)j(#deg\)\))f(<)i(0.5])e(-)i(Extract)e(all)h(rows)f(having)g(the) +1766 668 y(absolute)f(value)i(of)g(the)g(sine)g(of)g(theta)1766 +781 y(less)94 b(than)47 b(a)g(half)g(where)f(the)h(angles)1766 +894 y(are)g(tabulated)e(in)i(degrees)191 1120 y([SUM\()f(SPEC)h(>)g +(3*BACKGRND)e(\)>=1])94 b(-)48 b(Extract)e(all)h(rows)f(containing)f(a) +1766 1233 y(spectrum,)g(held)i(in)g(vector)f(column)1766 +1346 y(SPEC,)g(with)h(at)g(least)f(one)h(value)g(3)1766 +1458 y(times)f(greater)g(than)h(the)g(background)1766 +1571 y(level)f(held)h(in)g(a)h(keyword,)d(BACKGRND)191 +1797 y([VCOL=={1,4,2}])759 b(-)48 b(Extract)e(all)h(rows)f(whose)h +(vector)f(column)1766 1910 y(VCOL)h(contains)e(the)i(3-elements)e(1,)i +(4,)g(and)1766 2023 y(2.)191 2249 y([@rowFilter.txt])711 +b(-)48 b(Extract)e(rows)g(using)h(the)g(expression)1766 +2362 y(contained)e(within)h(the)h(text)g(file)1766 2475 +y(rowFilter.txt)191 2700 y([gtifilter\(\)])855 b(-)48 +b(Search)e(the)h(current)f(file)g(for)h(a)h(GTI)239 2813 +y(extension,)92 b(filter)i(the)47 b(TIME)239 2926 y(column)f(in)h(the)g +(current)f(table,)g(using)239 3039 y(START/STOP)f(times)h(taken)g(from) +239 3152 y(columns)f(in)j(the)f(GTI)94 b(extension)191 +3378 y([regfilter\("pow.reg"\)])423 b(-)48 b(Extract)e(rows)g(which)h +(have)f(a)i(coordinate)1766 3491 y(\(as)f(given)f(in)h(the)g(X)h(and)f +(Y)g(columns\))1766 3604 y(within)f(the)h(spatial)f(region)g(specified) +1766 3717 y(in)h(the)g(pow.reg)f(region)g(file.)191 3942 +y([regfilter\("pow.reg",)c(Xs,)47 b(Ys\)])f(-)i(Same)f(as)g(above,)f +(except)g(that)h(the)1766 4055 y(Xs)g(and)g(Ys)g(columns)f(will)h(be)g +(used)f(to)1766 4168 y(determine)f(the)i(coordinate)e(of)i(each)1766 +4281 y(row)g(in)g(the)g(table.)0 4664 y Ff(10.11)181 +b(Binning)44 b(or)h(Histogramming)i(Sp)t(eci\014cation)0 +4924 y Fj(The)22 b(optional)g(binning)e(sp)s(eci\014er)h(is)h(enclosed) +h(in)f(square)g(brac)m(k)m(ets)j(and)d(can)h(b)s(e)f(distinguished)d +(from)k(a)g(general)0 5036 y(ro)m(w)32 b(\014lter)g(sp)s(eci\014cation) +f(b)m(y)h(the)h(fact)g(that)g(it)f(b)s(egins)f(with)g(the)h(k)m(eyw)m +(ord)h('bin')e(not)i(immediately)d(follo)m(w)m(ed)0 5149 +y(b)m(y)41 b(an)f(equals)h(sign.)71 b(When)41 b(binning)c(is)j(sp)s +(eci\014ed,)i(a)f(temp)s(orary)g(N-dimensional)d(FITS)i(primary)f(arra) +m(y)0 5262 y(is)j(created)i(b)m(y)f(computing)g(the)g(histogram)g(of)g +(the)g(v)-5 b(alues)43 b(in)e(the)j(sp)s(eci\014ed)d(columns)h(of)h(a)h +(FITS)e(table)0 5375 y(extension.)e(After)30 b(the)f(histogram)g(is)g +(computed)g(the)h(input)d(FITS)i(\014le)g(con)m(taining)g(the)g(table)h +(is)e(then)h(closed)0 5488 y(and)34 b(the)h(temp)s(orary)f(FITS)g +(primary)f(arra)m(y)i(is)f(op)s(ened)g(and)g(passed)g(to)h(the)g +(application)e(program.)54 b(Th)m(us,)0 5601 y(the)39 +b(application)e(program)i(nev)m(er)g(sees)g(the)g(original)e(FITS)h +(table)h(and)f(only)g(sees)i(the)f(image)g(in)e(the)i(new)0 +5714 y(temp)s(orary)32 b(\014le)g(\(whic)m(h)g(has)g(no)h(additional)d +(extensions\).)48 b(Ob)m(viously)-8 b(,)32 b(the)h(application)e +(program)h(m)m(ust)h(b)s(e)p eop +%%Page: 128 136 +128 135 bop 0 299 a Fj(128)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fj(exp)s(ecting)30 +b(to)h(op)s(en)f(a)h(FITS)e(image)i(and)f(not)g(a)h(FITS)f(table)g(in)f +(this)g(case.)0 715 y(The)h(data)h(t)m(yp)s(e)f(of)h(the)f(FITS)g +(histogram)f(image)i(ma)m(y)g(b)s(e)f(sp)s(eci\014ed)e(b)m(y)i(app)s +(ending)e('b')i(\(for)h(8-bit)f(b)m(yte\),)h('i')0 828 +y(\(for)g(16-bit)f(in)m(tegers\),)h('j')g(\(for)g(32-bit)f(in)m +(teger\),)i('r')e(\(for)h(32-bit)f(\015oating)h(p)s(oin)m(ts\),)e(or)i +('d')f(\(for)h(64-bit)f(double)0 941 y(precision)i(\015oating)j(p)s +(oin)m(t\))e(to)i(the)g('bin')e(k)m(eyw)m(ord)i(\(e.g.)54 +b('[binr)32 b(X]')j(creates)h(a)f(real)f(\015oating)g(p)s(oin)m(t)f +(image\).)0 1054 y(If)h(the)i(data)f(t)m(yp)s(e)g(is)f(not)i +(explicitly)c(sp)s(eci\014ed)h(then)i(a)g(32-bit)h(in)m(teger)f(image)g +(will)d(b)s(e)j(created)h(b)m(y)e(default,)0 1167 y(unless)23 +b(the)j(w)m(eigh)m(ting)e(option)h(is)f(also)h(sp)s(eci\014ed)e(in)h +(whic)m(h)g(case)i(the)f(image)h(will)c(ha)m(v)m(e)k(a)g(32-bit)f +(\015oating)g(p)s(oin)m(t)0 1280 y(data)31 b(t)m(yp)s(e)g(b)m(y)f +(default.)0 1440 y(The)24 b(histogram)f(image)i(ma)m(y)g(ha)m(v)m(e)g +(from)f(1)g(to)h(4)g(dimensions)c(\(axes\),)27 b(dep)s(ending)22 +b(on)i(the)g(n)m(um)m(b)s(er)f(of)h(columns)0 1553 y(that)31 +b(are)g(sp)s(eci\014ed.)39 b(The)30 b(general)g(form)g(of)g(the)h +(binning)c(sp)s(eci\014cation)i(is:)48 1767 y Fe([bin{bijrd})92 +b(Xcol=min:max:binsize,)42 b(Ycol=)47 b(...,)f(Zcol=...,)f(Tcol=...;)h +(weight])0 1982 y Fj(in)38 b(whic)m(h)g(up)g(to)i(4)g(columns,)g(eac)m +(h)g(corresp)s(onding)d(to)j(an)g(axis)e(of)i(the)f(image,)j(are)e +(listed.)65 b(The)39 b(column)0 2095 y(names)27 b(are)h(case)h +(insensitiv)m(e,)d(and)h(the)h(column)e(n)m(um)m(b)s(er)g(ma)m(y)i(b)s +(e)f(giv)m(en)g(instead)g(of)h(the)g(name,)g(preceded)f(b)m(y)0 +2208 y(a)32 b(p)s(ound)e(sign)h(\(e.g.,)j([bin)c(#4=1:512]\).)47 +b(If)31 b(the)h(column)f(name)h(is)e(not)i(sp)s(eci\014ed,)f(then)g +(CFITSIO)g(will)e(\014rst)0 2321 y(try)37 b(to)h(use)f(the)g +('preferred)f(column')h(as)g(sp)s(eci\014ed)f(b)m(y)h(the)g(CPREF)g(k)m +(eyw)m(ord)h(if)e(it)g(exists)h(\(e.g.,)k('CPREF)0 2433 +y(=)i('DETX,DETY'\),)h(otherwise)f(column)f(names)h('X',)h('Y',)g('Z',) +f(and)f('T')i(will)c(b)s(e)i(assumed)h(for)g(eac)m(h)h(of)0 +2546 y(the)37 b(4)h(axes,)i(resp)s(ectiv)m(ely)-8 b(.)60 +b(In)37 b(cases)h(where)e(the)i(column)e(name)h(could)f(b)s(e)g +(confused)h(with)f(an)h(arithmetic)0 2659 y(expression,)29 +b(enclose)i(the)g(column)e(name)h(in)f(paren)m(theses)i(to)g(force)g +(the)f(name)h(to)g(b)s(e)f(in)m(terpreted)f(literally)-8 +b(.)0 2819 y(Eac)m(h)33 b(column)e(name)h(ma)m(y)h(b)s(e)f(follo)m(w)m +(ed)f(b)m(y)i(an)f(equals)f(sign)h(and)f(then)h(the)g(lo)m(w)m(er)h +(and)f(upp)s(er)e(range)i(of)h(the)0 2932 y(histogram,)e(and)f(the)h +(size)g(of)g(the)g(histogram)g(bins,)e(separated)i(b)m(y)g(colons.)42 +b(Spaces)31 b(are)g(allo)m(w)m(ed)g(b)s(efore)g(and)0 +3045 y(after)e(the)g(equals)f(sign)f(but)h(not)h(within)d(the)j +('min:max:binsize')d(string.)39 b(The)29 b(min,)e(max)i(and)f(binsize)f +(v)-5 b(alues)0 3158 y(ma)m(y)32 b(b)s(e)e(in)m(teger)h(or)g +(\015oating)g(p)s(oin)m(t)f(n)m(um)m(b)s(ers,)g(or)h(they)g(ma)m(y)g(b) +s(e)g(the)g(names)g(of)g(k)m(eyw)m(ords)g(in)f(the)h(header)g(of)0 +3271 y(the)g(table.)40 b(If)30 b(the)h(latter,)g(then)f(the)g(v)-5 +b(alue)30 b(of)h(that)g(k)m(eyw)m(ord)f(is)g(substituted)f(in)m(to)h +(the)h(expression.)0 3431 y(Default)36 b(v)-5 b(alues)35 +b(for)h(the)g(min,)g(max)g(and)g(binsize)e(quan)m(tities)h(will)e(b)s +(e)i(used)h(if)e(not)j(explicitly)c(giv)m(en)j(in)f(the)0 +3544 y(binning)27 b(expression)i(as)i(sho)m(wn)f(in)f(these)i +(examples:)191 3759 y Fe([bin)47 b(x)g(=)g(:512:2])94 +b(-)47 b(use)g(default)f(minimum)g(value)191 3871 y([bin)h(x)g(=)g +(1::2])190 b(-)47 b(use)g(default)f(maximum)g(value)191 +3984 y([bin)h(x)g(=)g(1:512])142 b(-)47 b(use)g(default)f(bin)h(size) +191 4097 y([bin)g(x)g(=)g(1:])286 b(-)47 b(use)g(default)f(maximum)g +(value)g(and)h(bin)g(size)191 4210 y([bin)g(x)g(=)g(:512])190 +b(-)47 b(use)g(default)f(minimum)g(value)g(and)h(bin)g(size)191 +4323 y([bin)g(x)g(=)g(2])334 b(-)47 b(use)g(default)f(minimum)g(and)h +(maximum)f(values)191 4436 y([bin)h(x])524 b(-)47 b(use)g(default)f +(minimum,)g(maximum)g(and)g(bin)h(size)191 4549 y([bin)g(4])524 +b(-)47 b(default)f(2-D)h(image,)f(bin)h(size)g(=)g(4)h(in)f(both)g +(axes)191 4662 y([bin])619 b(-)47 b(default)f(2-D)h(image)0 +4876 y Fj(CFITSIO)31 b(will)f(use)i(the)h(v)-5 b(alue)32 +b(of)h(the)g(TLMINn,)f(TLMAXn,)h(and)f(TDBINn)h(k)m(eyw)m(ords,)h(if)d +(they)i(exist,)g(for)0 4989 y(the)k(default)e(min,)i(max,)h(and)e +(binsize,)g(resp)s(ectiv)m(ely)-8 b(.)59 b(If)36 b(they)h(do)f(not)h +(exist)f(then)g(CFITSIO)f(will)f(use)i(the)0 5102 y(actual)c(minim)m +(um)d(and)j(maxim)m(um)f(v)-5 b(alues)31 b(in)g(the)h(column)e(for)i +(the)g(histogram)g(min)e(and)i(max)g(v)-5 b(alues.)44 +b(The)0 5215 y(default)33 b(binsize)e(will)g(b)s(e)i(set)h(to)h(1,)g +(or)e(\(max)h(-)g(min\))e(/)i(10.,)i(whic)m(hev)m(er)d(is)g(smaller,)g +(so)g(that)i(the)e(histogram)0 5328 y(will)28 b(ha)m(v)m(e)j(at)g +(least)g(10)g(bins)e(along)h(eac)m(h)i(axis.)0 5488 y(A)41 +b(shortcut)g(notation)g(is)f(allo)m(w)m(ed)h(if)f(all)g(the)h +(columns/axes)g(ha)m(v)m(e)h(the)f(same)g(binning)d(sp)s +(eci\014cation.)72 b(In)0 5601 y(this)32 b(case)h(all)f(the)h(column)e +(names)i(ma)m(y)g(b)s(e)f(listed)f(within)f(paren)m(theses,)k(follo)m +(w)m(ed)f(b)m(y)f(the)h(\(single\))f(binning)0 5714 y(sp)s +(eci\014cation,)d(as)i(in:)p eop +%%Page: 129 137 +129 136 bop 0 299 a Fh(10.11.)113 b(BINNING)32 b(OR)e(HISTOGRAMMING)g +(SPECIFICA)-8 b(TION)1223 b Fj(129)191 555 y Fe([bin)47 +b(\(X,Y\)=1:512:2])191 668 y([bin)g(\(X,Y\))f(=)h(5])0 +888 y Fj(The)31 b(optional)g(w)m(eigh)m(ting)h(factor)g(is)f(the)h +(last)f(item)h(in)e(the)i(binning)d(sp)s(eci\014er)h(and,)i(if)e +(presen)m(t,)j(is)d(separated)0 1001 y(from)38 b(the)g(list)f(of)h +(columns)f(b)m(y)h(a)h(semi-colon.)63 b(As)39 b(the)f(histogram)g(is)f +(accum)m(ulated,)k(this)c(w)m(eigh)m(t)i(is)e(used)0 +1114 y(to)e(incremen)m(ted)e(the)h(v)-5 b(alue)34 b(of)g(the)g +(appropriated)e(bin)h(in)f(the)i(histogram.)51 b(If)34 +b(the)g(w)m(eigh)m(ting)g(factor)h(is)e(not)0 1227 y(sp)s(eci\014ed,)23 +b(then)g(the)g(default)f(w)m(eigh)m(t)i(=)e(1)i(is)e(assumed.)37 +b(The)23 b(w)m(eigh)m(ting)g(factor)h(ma)m(y)f(b)s(e)g(a)g(constan)m(t) +i(in)m(teger)e(or)0 1340 y(\015oating)29 b(p)s(oin)m(t)f(n)m(um)m(b)s +(er,)g(or)h(the)g(name)g(of)g(a)g(k)m(eyw)m(ord)h(con)m(taining)e(the)i +(w)m(eigh)m(ting)e(v)-5 b(alue.)40 b(Or)28 b(the)h(w)m(eigh)m(ting)0 +1453 y(factor)g(ma)m(y)g(b)s(e)e(the)h(name)g(of)h(a)f(table)g(column)f +(in)g(whic)m(h)f(case)k(the)e(v)-5 b(alue)27 b(in)g(that)i(column,)e +(on)h(a)h(ro)m(w)f(b)m(y)g(ro)m(w)0 1566 y(basis,)h(will)f(b)s(e)i +(used.)0 1726 y(In)35 b(some)h(cases,)i(the)d(column)g(or)g(k)m(eyw)m +(ord)h(ma)m(y)g(giv)m(e)g(the)g(recipro)s(cal)e(of)i(the)g(actual)g(w)m +(eigh)m(t)g(v)-5 b(alue)35 b(that)h(is)0 1839 y(needed.)49 +b(In)32 b(this)g(case,)j(precede)e(the)h(w)m(eigh)m(t)f(k)m(eyw)m(ord)h +(or)f(column)f(name)h(b)m(y)g(a)g(slash)f('/')i(to)g(tell)e(CFITSIO)0 +1952 y(to)f(use)f(the)h(recipro)s(cal)e(of)h(the)h(v)-5 +b(alue)30 b(when)f(constructing)h(the)h(histogram.)0 +2112 y(F)-8 b(or)25 b(complex)f(or)g(commonly)f(used)h(histograms,)h +(one)f(can)h(also)f(place)g(its)f(description)f(in)m(to)i(a)h(text)g +(\014le)e(and)h(im-)0 2225 y(p)s(ort)e(it)f(in)m(to)h(the)h(binning)c +(sp)s(eci\014cation)i(using)f(the)j(syn)m(tax)f([bin)f +(@\014lename.txt].)38 b(The)22 b(\014le's)f(con)m(ten)m(ts)j(can)e(ex-) +0 2338 y(tend)h(o)m(v)m(er)i(m)m(ultiple)c(lines,)i(although)g(it)g(m)m +(ust)g(still)e(conform)i(to)h(the)g(no-spaces)g(rule)e(for)h(the)h +(min:max:binsize)0 2451 y(syn)m(tax)35 b(and)f(eac)m(h)h(axis)f(sp)s +(eci\014cation)g(m)m(ust)g(still)e(b)s(e)i(comma-separated.)55 +b(An)m(y)34 b(lines)f(in)g(the)i(external)f(text)0 2564 +y(\014le)26 b(that)h(b)s(egin)f(with)f(2)j(slash)d(c)m(haracters)k +(\('//'\))g(will)24 b(b)s(e)i(ignored)g(and)g(ma)m(y)i(b)s(e)e(used)g +(to)i(add)e(commen)m(ts)i(in)m(to)0 2676 y(the)j(\014le.)0 +2837 y(Examples:)191 3057 y Fe([bini)46 b(detx,)h(dety])762 +b(-)47 b(2-D,)g(16-bit)f(integer)g(histogram)1861 3170 +y(of)i(DETX)e(and)h(DETY)g(columns,)e(using)1861 3283 +y(default)h(values)g(for)h(the)g(histogram)1861 3396 +y(range)g(and)g(binsize)191 3621 y([bin)g(\(detx,)f(dety\)=16;)f +(/exposure])g(-)i(2-D,)g(32-bit)f(real)h(histogram)e(of)i(DETX)1861 +3734 y(and)g(DETY)g(columns)f(with)g(a)i(bin)f(size)f(=)i(16)1861 +3847 y(in)g(both)e(axes.)h(The)f(histogram)g(values)1861 +3960 y(are)h(divided)f(by)h(the)g(EXPOSURE)f(keyword)1861 +4073 y(value.)191 4299 y([bin)h(time=TSTART:TSTOP:0.1])280 +b(-)47 b(1-D)g(lightcurve,)e(range)h(determined)f(by)1861 +4412 y(the)i(TSTART)f(and)h(TSTOP)g(keywords,)1861 4525 +y(with)g(0.1)g(unit)g(size)f(bins.)191 4751 y([bin)h(pha,)f +(time=8000.:8100.:0.1])90 b(-)47 b(2-D)g(image)g(using)f(default)g +(binning)1861 4863 y(of)i(the)e(PHA)h(column)f(for)h(the)g(X)h(axis,) +1861 4976 y(and)f(1000)g(bins)g(in)g(the)g(range)1861 +5089 y(8000.)g(to)g(8100.)f(for)h(the)g(Y)h(axis.)191 +5315 y([bin)f(@binFilter.txt])616 b(-)47 b(Use)g(the)g(contents)f(of)h +(the)g(text)f(file)1861 5428 y(binFilter.txt)f(for)h(the)h(binning)1861 +5541 y(specifications.)p eop +%%Page: 130 138 +130 137 bop 0 299 a Fj(130)1528 b Fh(CHAPTER)29 b(10.)113 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)p eop +%%Page: 131 139 +131 138 bop 0 1225 a Fg(Chapter)65 b(11)0 1687 y Fm(T)-19 +b(emplate)76 b(Files)0 2180 y Fj(When)38 b(a)h(new)f(FITS)g(\014le)g +(is)g(created)h(with)f(a)g(call)g(to)i(\014ts)p 2101 +2180 28 4 v 32 w(create)p 2369 2180 V 35 w(\014le,)f(the)g(name)g(of)g +(a)g(template)g(\014le)e(ma)m(y)0 2293 y(b)s(e)i(supplied)e(in)i(paren) +m(theses)h(immediately)e(follo)m(wing)g(the)j(name)f(of)g(the)g(new)f +(\014le)g(to)i(b)s(e)e(created.)71 b(This)0 2406 y(template)26 +b(is)e(used)h(to)h(de\014ne)f(the)h(structure)f(of)h(one)f(or)h(more)g +(HDUs)g(in)e(the)i(new)f(\014le.)38 b(The)25 b(template)h(\014le)e(ma)m +(y)0 2518 y(b)s(e)32 b(another)h(FITS)f(\014le,)h(in)f(whic)m(h)f(case) +j(the)f(newly)f(created)i(\014le)e(will)e(ha)m(v)m(e)k(exactly)g(the)f +(same)g(k)m(eyw)m(ords)g(in)0 2631 y(eac)m(h)25 b(HDU)g(as)g(in)e(the)h +(template)h(FITS)e(\014le,)i(but)e(all)h(the)g(data)h(units)d(will)g(b) +s(e)i(\014lled)e(with)g(zeros.)40 b(The)24 b(template)0 +2744 y(\014le)h(ma)m(y)i(also)f(b)s(e)f(an)h(ASCI)s(I)e(text)j(\014le,) +f(where)g(eac)m(h)h(line)d(\(in)h(general\))i(describ)s(es)d(one)i +(FITS)f(k)m(eyw)m(ord)i(record.)0 2857 y(The)j(format)h(of)f(the)h +(ASCI)s(I)e(template)h(\014le)g(is)f(describ)s(ed)f(in)i(the)g(follo)m +(wing)f(sections.)0 3188 y Ff(11.1)136 b(Detailed)46 +b(T)-11 b(emplate)46 b(Line)f(F)-11 b(ormat)0 3438 y +Fj(The)30 b(format)h(of)f(eac)m(h)i(ASCI)s(I)c(template)j(line)e +(closely)h(follo)m(ws)f(the)i(format)g(of)f(a)h(FITS)f(k)m(eyw)m(ord)g +(record:)95 3682 y Fe(KEYWORD)46 b(=)i(KEYVALUE)d(/)j(COMMENT)0 +3926 y Fj(except)22 b(that)g(free)g(format)f(ma)m(y)h(b)s(e)f(used)f +(\(e.g.,)25 b(the)d(equals)e(sign)h(ma)m(y)g(app)s(ear)g(at)h(an)m(y)g +(p)s(osition)d(in)h(the)i(line\))e(and)0 4039 y(T)-8 +b(AB)34 b(c)m(haracters)g(are)g(allo)m(w)m(ed)f(and)g(are)g(treated)h +(the)g(same)f(as)h(space)f(c)m(haracters.)51 b(The)33 +b(KEYV)-10 b(ALUE)33 b(and)0 4152 y(COMMENT)d(\014elds)f(are)i +(optional.)41 b(The)30 b(equals)g(sign)f(c)m(haracter)k(is)c(also)i +(optional,)f(but)g(it)g(is)f(recommended)0 4264 y(that)42 +b(it)e(b)s(e)h(included)d(for)j(clarit)m(y)-8 b(.)73 +b(An)m(y)41 b(template)h(line)d(that)j(b)s(egins)e(with)f(the)j(p)s +(ound)d('#')i(c)m(haracter)i(is)0 4377 y(ignored)29 b(b)m(y)i(the)f +(template)h(parser)f(and)g(ma)m(y)h(b)s(e)e(use)h(to)h(insert)f(commen) +m(ts)h(in)m(to)f(the)h(template)g(\014le)e(itself.)0 +4538 y(The)d(KEYW)m(ORD)g(name)g(\014eld)f(is)g(limited)f(to)j(8)f(c)m +(haracters)h(in)e(length)h(and)f(only)g(the)h(letters)h(A-Z,)f(digits)f +(0-9,)0 4650 y(and)j(the)g(h)m(yphen)f(and)h(underscore)g(c)m +(haracters)h(ma)m(y)g(b)s(e)f(used,)g(without)g(an)m(y)g(em)m(b)s +(edded)g(spaces.)40 b(Lo)m(w)m(ercase)0 4763 y(letters)21 +b(in)f(the)i(template)f(k)m(eyw)m(ord)h(name)f(will)d(b)s(e)j(con)m(v)m +(erted)i(to)f(upp)s(ercase.)36 b(Leading)21 b(spaces)g(in)f(the)i +(template)0 4876 y(line)i(preceding)h(the)g(k)m(eyw)m(ord)h(name)g(are) +g(generally)f(ignored,)h(except)g(if)f(the)h(\014rst)f(8)h(c)m +(haracters)h(of)f(a)g(template)0 4989 y(line)d(are)j(all)e(blank,)h +(then)g(the)g(en)m(tire)g(line)f(is)g(treated)i(as)f(a)h(FITS)e(commen) +m(t)i(k)m(eyw)m(ord)g(\(with)e(a)i(blank)d(k)m(eyw)m(ord)0 +5102 y(name\))31 b(and)f(is)f(copied)h(v)m(erbatim)g(in)m(to)g(the)h +(FITS)e(header.)0 5262 y(The)37 b(KEYV)-10 b(ALUE)37 +b(\014eld)f(ma)m(y)i(ha)m(v)m(e)g(an)m(y)g(allo)m(w)m(ed)f(FITS)g(data) +h(t)m(yp)s(e:)54 b(c)m(haracter)39 b(string,)g(logical,)f(in)m(teger,)0 +5375 y(real,)33 b(complex)f(in)m(teger,)i(or)e(complex)h(real.)46 +b(The)32 b(c)m(haracter)j(string)c(v)-5 b(alues)32 b(need)g(not)h(b)s +(e)f(enclosed)g(in)f(single)0 5488 y(quote)e(c)m(haracters)h(unless)d +(they)h(are)h(necessary)g(to)g(distinguish)24 b(the)29 +b(string)e(from)h(a)h(di\013eren)m(t)f(data)h(t)m(yp)s(e)f(\(e.g.)0 +5601 y(2.0)h(is)d(a)i(real)g(but)f('2.0')i(is)e(a)h(string\).)39 +b(The)27 b(k)m(eyw)m(ord)h(has)f(an)h(unde\014ned)d(\(n)m(ull\))h(v)-5 +b(alue)28 b(if)e(the)i(template)g(record)0 5714 y(only)h(con)m(tains)i +(blanks)e(follo)m(wing)g(the)h("=")h(or)g(b)s(et)m(w)m(een)g(the)f("=") +h(and)f(the)g("/")i(commen)m(t)g(\014eld)c(delimiter.)1882 +5942 y(131)p eop +%%Page: 132 140 +132 139 bop 0 299 a Fj(132)2250 b Fh(CHAPTER)29 b(11.)72 +b(TEMPLA)-8 b(TE)30 b(FILES)0 555 y Fj(String)25 b(k)m(eyw)m(ord)i(v)-5 +b(alues)26 b(longer)g(than)g(68)h(c)m(haracters)h(\(the)f(maxim)m(um)e +(length)h(that)h(will)d(\014t)i(in)f(a)i(single)e(FITS)0 +668 y(k)m(eyw)m(ord)41 b(record\))g(are)g(p)s(ermitted)e(using)g(the)i +(CFITSIO)e(long)h(string)g(con)m(v)m(en)m(tion.)73 b(They)40 +b(can)h(either)f(b)s(e)0 781 y(sp)s(eci\014ed)27 b(as)j(a)f(single)f +(long)g(line)g(in)f(the)j(template,)g(or)f(b)m(y)f(using)g(m)m(ultiple) +f(lines)g(where)h(the)i(con)m(tin)m(uing)e(lines)0 894 +y(con)m(tain)j(the)f('CONTINUE')g(k)m(eyw)m(ord,)h(as)g(in)e(this)g +(example:)95 1139 y Fe(LONGKEY)46 b(=)i('This)e(is)h(a)h(long)e(string) +g(value)h(that)f(is)i(contin&')95 1252 y(CONTINUE)94 +b('ued)46 b(over)h(2)g(records')f(/)h(comment)f(field)h(goes)f(here)0 +1497 y Fj(The)29 b(format)h(of)g(template)g(lines)d(with)i(CONTINUE)f +(k)m(eyw)m(ord)i(is)f(v)m(ery)h(strict:)40 b(3)30 b(spaces)g(m)m(ust)f +(follo)m(w)g(CON-)0 1610 y(TINUE)h(and)g(the)g(rest)h(of)f(the)h(line)e +(is)g(copied)h(v)m(erbatim)g(to)h(the)g(FITS)e(\014le.)0 +1771 y(The)i(start)h(of)g(the)f(optional)g(COMMENT)g(\014eld)f(m)m(ust) +i(b)s(e)e(preceded)i(b)m(y)f("/",)i(whic)m(h)d(is)h(used)g(to)h +(separate)g(it)0 1883 y(from)e(the)g(k)m(eyw)m(ord)h(v)-5 +b(alue)29 b(\014eld.)40 b(Exceptions)29 b(are)i(if)e(the)i(KEYW)m(ORD)g +(name)f(\014eld)f(con)m(tains)h(COMMENT,)0 1996 y(HISTOR)-8 +b(Y,)30 b(CONTINUE,)g(or)g(if)f(the)i(\014rst)f(8)g(c)m(haracters)i(of) +f(the)f(template)h(line)e(are)i(blanks.)0 2157 y(More)c(than)f(one)h +(Header-Data)i(Unit)d(\(HDU\))h(ma)m(y)g(b)s(e)f(de\014ned)f(in)g(the)i +(template)g(\014le.)38 b(The)26 b(start)h(of)g(an)f(HDU)0 +2269 y(de\014nition)i(is)h(denoted)i(with)e(a)i(SIMPLE)e(or)i(XTENSION) +e(template)i(line:)0 2430 y(1\))j(SIMPLE)f(b)s(egins)f(a)i(Primary)f +(HDU)h(de\014nition.)48 b(SIMPLE)33 b(ma)m(y)h(only)f(app)s(ear)g(as)h +(the)g(\014rst)f(k)m(eyw)m(ord)h(in)0 2543 y(the)e(template)h(\014le.) +44 b(If)32 b(the)g(template)h(\014le)e(b)s(egins)f(with)h(XTENSION)g +(instead)g(of)h(SIMPLE,)g(then)f(a)i(default)0 2655 y(empt)m(y)d +(Primary)d(HDU)j(is)f(created,)i(and)d(the)i(template)g(is)e(then)h +(assumed)f(to)i(de\014ne)f(the)h(k)m(eyw)m(ords)f(starting)0 +2768 y(with)g(the)i(\014rst)e(extension)h(follo)m(wing)f(the)i(Primary) +e(HDU.)0 2928 y(2\))35 b(XTENSION)e(marks)g(the)i(b)s(eginning)c(of)j +(a)h(new)e(extension)h(HDU)g(de\014nition.)50 b(The)33 +b(previous)g(HDU)i(will)0 3041 y(b)s(e)30 b(closed)g(at)h(this)e(p)s +(oin)m(t)h(and)f(pro)s(cessing)h(of)g(the)h(next)f(extension)g(b)s +(egins.)0 3373 y Ff(11.2)136 b(Auto-indexing)45 b(of)g(Keyw)l(ords)0 +3623 y Fj(If)31 b(a)h(template)f(k)m(eyw)m(ord)h(name)f(ends)g(with)f +(a)h("#")h(c)m(haracter,)i(it)d(is)f(said)g(to)i(b)s(e)f +('auto-indexed'.)43 b(Eac)m(h)32 b("#")0 3736 y(c)m(haracter)i(will)c +(b)s(e)i(replaced)h(b)m(y)f(the)h(curren)m(t)g(in)m(teger)g(index)e(v) +-5 b(alue,)33 b(whic)m(h)f(gets)h(reset)h(=)e(1)h(at)h(the)e(start)i +(of)0 3849 y(eac)m(h)h(new)f(HDU)g(in)f(the)h(\014le)f(\(or)h(7)h(in)d +(the)i(sp)s(ecial)f(case)i(of)f(a)g(GR)m(OUP)h(de\014nition\).)49 +b(The)33 b(FIRST)g(indexed)0 3962 y(k)m(eyw)m(ord)c(in)e(eac)m(h)i +(template)g(HDU)g(de\014nition)d(is)h(used)g(as)i(the)f('incremen)m +(tor';)i(eac)m(h)f(subsequen)m(t)f(o)s(ccurrence)0 4075 +y(of)k(this)e(SAME)h(k)m(eyw)m(ord)h(will)d(cause)j(the)g(index)e(v)-5 +b(alue)31 b(to)h(b)s(e)f(incremen)m(ted.)43 b(This)30 +b(b)s(eha)m(vior)g(can)i(b)s(e)f(rather)0 4188 y(subtle,)c(as)h +(illustrated)e(in)g(the)i(follo)m(wing)e(examples)h(in)f(whic)m(h)h +(the)h(TTYPE)e(k)m(eyw)m(ord)i(is)f(the)h(incremen)m(tor)f(in)0 +4300 y(b)s(oth)j(cases:)95 4546 y Fe(TTYPE#)47 b(=)g(TIME)95 +4659 y(TFORM#)g(=)g(1D)95 4772 y(TTYPE#)g(=)g(RATE)95 +4884 y(TFORM#)g(=)g(1E)0 5130 y Fj(will)23 b(create)28 +b(TTYPE1,)e(TF)m(ORM1,)i(TTYPE2,)f(and)e(TF)m(ORM2)i(k)m(eyw)m(ords.)40 +b(But)26 b(if)f(the)h(template)g(lo)s(oks)f(lik)m(e,)95 +5375 y Fe(TTYPE#)47 b(=)g(TIME)95 5488 y(TTYPE#)g(=)g(RATE)95 +5601 y(TFORM#)g(=)g(1D)95 5714 y(TFORM#)g(=)g(1E)p eop +%%Page: 133 141 +133 140 bop 0 299 a Fh(11.3.)73 b(TEMPLA)-8 b(TE)30 b(P)-8 +b(ARSER)30 b(DIRECTIVES)1982 b Fj(133)0 555 y(this)30 +b(results)f(in)h(a)h(FITS)f(\014les)g(with)f(TTYPE1,)i(TTYPE2,)g(TF)m +(ORM2,)h(and)e(TF)m(ORM2,)i(whic)m(h)e(is)g(probably)0 +668 y(not)h(what)f(w)m(as)h(in)m(tended!)0 1000 y Ff(11.3)136 +b(T)-11 b(emplate)45 b(P)l(arser)h(Directiv)l(es)0 1251 +y Fj(In)29 b(addition)g(to)h(the)g(template)h(lines)d(whic)m(h)h +(de\014ne)g(individual)d(k)m(eyw)m(ords,)k(the)g(template)h(parser)e +(recognizes)0 1363 y(3)h(sp)s(ecial)f(directiv)m(es)g(whic)m(h)g(are)h +(eac)m(h)h(preceded)f(b)m(y)f(the)h(bac)m(kslash)g(c)m(haracter:)90 +b Fe(\\include,)45 b(\\group)p Fj(,)29 b(and)48 1476 +y Fe(\\end)p Fj(.)0 1637 y(The)37 b('include')f(directiv)m(e)i(m)m(ust) +f(b)s(e)h(follo)m(w)m(ed)f(b)m(y)h(a)g(\014lename.)62 +b(It)38 b(forces)g(the)g(parser)f(to)i(temp)s(orarily)d(stop)0 +1749 y(reading)e(the)h(curren)m(t)g(template)g(\014le)f(and)g(b)s(egin) +g(reading)g(the)h(include)d(\014le.)54 b(Once)35 b(the)g(parser)f(reac) +m(hes)i(the)0 1862 y(end)f(of)h(the)g(include)d(\014le)i(it)g(con)m +(tin)m(ues)g(parsing)g(the)g(curren)m(t)h(template)g(\014le.)55 +b(Include)34 b(\014les)h(can)h(b)s(e)f(nested,)0 1975 +y(and)30 b(HDU)h(de\014nitions)d(can)i(span)g(m)m(ultiple)e(template)j +(\014les.)0 2135 y(The)g(start)h(of)g(a)g(GR)m(OUP)h(de\014nition)c(is) +i(denoted)h(with)e(the)i('group')g(directiv)m(e,)f(and)h(the)f(end)h +(of)f(a)i(GR)m(OUP)0 2248 y(de\014nition)i(is)i(denoted)g(with)f(the)i +('end')f(directiv)m(e.)61 b(Eac)m(h)39 b(GR)m(OUP)e(con)m(tains)h(0)g +(or)f(more)h(mem)m(b)s(er)f(blo)s(c)m(ks)0 2361 y(\(HDUs)44 +b(or)f(GR)m(OUPs\).)79 b(Mem)m(b)s(er)42 b(blo)s(c)m(ks)h(of)g(t)m(yp)s +(e)g(GR)m(OUP)g(can)g(con)m(tain)g(their)f(o)m(wn)h(mem)m(b)s(er)f(blo) +s(c)m(ks.)0 2474 y(The)32 b(GR)m(OUP)g(de\014nition)e(itself)h(o)s +(ccupies)h(one)g(FITS)g(\014le)f(HDU)i(of)f(sp)s(ecial)f(t)m(yp)s(e)h +(\(GR)m(OUP)h(HDU\),)h(so)e(if)g(a)0 2587 y(template)f(sp)s(eci\014es)e +(1)i(group)e(with)g(1)i(mem)m(b)s(er)f(HDU)h(lik)m(e:)0 +2838 y Fe(\\group)0 2951 y(grpdescr)46 b(=)h('demo')0 +3064 y(xtension)f(bintable)0 3177 y(#)h(this)g(bintable)f(has)h(0)g +(cols,)f(0)i(rows)0 3290 y(\\end)0 3541 y Fj(then)30 +b(the)h(parser)e(creates)j(a)f(FITS)f(\014le)f(with)g(3)i(HDUs)g(:)0 +3792 y Fe(1\))47 b(dummy)g(PHDU)0 3905 y(2\))g(GROUP)g(HDU)f(\(has)h(1) +h(member,)d(which)i(is)g(bintable)e(in)j(HDU)f(number)f(3\))0 +4018 y(3\))h(bintable)f(\(member)g(of)h(GROUP)f(in)h(HDU)g(number)f +(2\))0 4269 y Fj(T)-8 b(ec)m(hnically)29 b(sp)s(eaking,)g(the)g(GR)m +(OUP)i(HDU)f(is)f(a)h(BINT)-8 b(ABLE)30 b(with)f(6)h(columns.)39 +b(Applications)28 b(can)i(de\014ne)0 4382 y(additional)20 +b(columns)h(in)f(a)j(GR)m(OUP)f(HDU)h(using)e(TF)m(ORMn)g(and)h(TTYPEn) +f(\(where)g(n)h(is)f(7,)j(8,)h(....\))39 b(k)m(eyw)m(ords)0 +4494 y(or)30 b(their)g(auto-indexing)f(equiv)-5 b(alen)m(ts.)0 +4655 y(F)d(or)26 b(a)f(more)g(complicated)f(example)g(of)h(a)h +(template)f(\014le)f(using)f(the)i(group)f(directiv)m(es,)i(lo)s(ok)e +(at)h(the)g(sample.tpl)0 4767 y(\014le)k(that)i(is)f(included)d(in)j +(the)g(CFITSIO)f(distribution.)0 5100 y Ff(11.4)136 b(F)-11 +b(ormal)45 b(T)-11 b(emplate)46 b(Syn)l(tax)0 5350 y +Fj(The)30 b(template)h(syn)m(tax)g(can)f(formally)f(b)s(e)h(de\014ned)f +(as)i(follo)m(ws:)191 5601 y Fe(TEMPLATE)45 b(=)j(BLOCK)e([)i(BLOCK)e +(...)h(])p eop +%%Page: 134 142 +134 141 bop 0 299 a Fj(134)2250 b Fh(CHAPTER)29 b(11.)72 +b(TEMPLA)-8 b(TE)30 b(FILES)334 555 y Fe(BLOCK)46 b(=)i({)f(HDU)g(|)h +(GROUP)e(})334 781 y(GROUP)g(=)i(\\GROUP)e([)h(BLOCK)g(...)g(])g(\\END) +430 1007 y(HDU)f(=)i(XTENSION)d([)j(LINE)f(...)f(])i({)f(XTENSION)f(|)h +(\\GROUP)f(|)i(\\END)f(|)g(EOF)g(})382 1233 y(LINE)f(=)i([)f(KEYWORD)f +([)i(=)f(])h(])f([)g(VALUE)g(])g([)h(/)f(COMMENT)f(])191 +1458 y(X)h(...)238 b(-)48 b(X)f(can)g(be)g(present)f(1)h(or)h(more)e +(times)191 1571 y({)h(X)h(|)f(Y)h(})f(-)h(X)f(or)g(Y)191 +1684 y([)g(X)h(])238 b(-)48 b(X)f(is)g(optional)0 1937 +y Fj(A)m(t)34 b(the)f(topmost)g(lev)m(el,)g(the)g(template)h(de\014nes) +d(1)j(or)e(more)h(template)g(blo)s(c)m(ks.)48 b(Blo)s(c)m(ks)33 +b(can)g(b)s(e)f(either)g(HDU)0 2050 y(\(Header)27 b(Data)h(Unit\))f(or) +f(a)h(GR)m(OUP)-8 b(.)28 b(F)-8 b(or)27 b(eac)m(h)g(blo)s(c)m(k)f(the)h +(parser)f(creates)i(1)f(\(or)g(more)f(for)h(GR)m(OUPs\))g(FITS)0 +2163 y(\014le)i(HDUs.)0 2495 y Ff(11.5)136 b(Errors)0 +2745 y Fj(In)24 b(general)g(the)g(\014ts)p 692 2745 28 +4 v 33 w(execute)p 1019 2745 V 34 w(template\(\))h(function)e(tries)h +(to)h(b)s(e)f(as)g(atomic)h(as)g(p)s(ossible,)e(so)h(either)g(ev)m +(erything)0 2858 y(is)f(done)h(or)g(nothing)e(is)h(done.)39 +b(If)23 b(an)h(error)f(o)s(ccurs)h(during)e(parsing)g(of)i(the)g +(template,)i(\014ts)p 3125 2858 V 33 w(execute)p 3452 +2858 V 34 w(template\(\))0 2971 y(will)i(\(try)j(to\))h(delete)f(the)g +(top)g(lev)m(el)f(BLOCK)g(\(with)g(all)f(its)i(c)m(hildren)d(if)i(an)m +(y\))h(in)f(whic)m(h)f(the)i(error)f(o)s(ccurred,)0 3084 +y(then)g(it)g(will)e(stop)i(reading)g(the)g(template)h(\014le)e(and)h +(it)g(will)e(return)h(with)g(an)h(error.)0 3417 y Ff(11.6)136 +b(Examples)0 3667 y Fj(1.)54 b(This)33 b(template)i(\014le)f(will)e +(create)k(a)f(200)h(x)e(300)i(pixel)d(image,)k(with)c(4-b)m(yte)j(in)m +(teger)f(pixel)e(v)-5 b(alues,)35 b(in)f(the)0 3780 y(primary)28 +b(HDU:)95 4032 y Fe(SIMPLE)47 b(=)g(T)95 4145 y(BITPIX)g(=)g(32)95 +4258 y(NAXIS)g(=)g(2)239 b(/)47 b(number)f(of)h(dimensions)95 +4371 y(NAXIS1)g(=)g(100)95 b(/)47 b(length)f(of)h(first)g(axis)95 +4484 y(NAXIS2)g(=)g(200)95 b(/)47 b(length)f(of)h(second)f(axis)95 +4597 y(OBJECT)h(=)g(NGC)g(253)g(/)g(name)g(of)g(observed)f(object)0 +4850 y Fj(The)35 b(allo)m(w)m(ed)g(v)-5 b(alues)35 b(of)g(BITPIX)g(are) +h(8,)h(16,)h(32,)g(-32,)g(or)d(-64,)j(represen)m(ting,)e(resp)s(ectiv)m +(ely)-8 b(,)37 b(8-bit)e(in)m(teger,)0 4962 y(16-bit)c(in)m(teger,)g +(32-bit)f(in)m(teger,)h(32-bit)g(\015oating)f(p)s(oin)m(t,)g(or)g(64)h +(bit)f(\015oating)g(p)s(oin)m(t)f(pixels.)0 5123 y(2.)39 +b(T)-8 b(o)23 b(create)h(a)f(FITS)e(table,)k(the)d(template)h(\014rst)f +(needs)g(to)i(include)c(XTENSION)i(=)g(T)-8 b(ABLE)23 +b(or)f(BINT)-8 b(ABLE)0 5235 y(to)31 b(de\014ne)e(whether)g(it)g(is)g +(an)g(ASCI)s(I)g(or)g(binary)f(table,)i(and)g(NAXIS2)g(to)g(de\014ne)f +(the)h(n)m(um)m(b)s(er)f(of)h(ro)m(ws)f(in)g(the)0 5348 +y(table.)49 b(Tw)m(o)34 b(template)f(lines)f(are)i(then)f(needed)f(to)i +(de\014ne)f(the)g(name)h(\(TTYPEn\))e(and)h(FITS)g(data)h(format)0 +5461 y(\(TF)m(ORMn\))d(of)f(the)h(columns,)e(as)i(in)e(this)g(example:) +95 5714 y Fe(xtension)46 b(=)h(bintable)p eop +%%Page: 135 143 +135 142 bop 0 299 a Fh(11.6.)73 b(EXAMPLES)2993 b Fj(135)95 +555 y Fe(naxis2)47 b(=)g(40)95 668 y(ttype#)g(=)g(Name)95 +781 y(tform#)g(=)g(10a)95 894 y(ttype#)g(=)g(Npoints)95 +1007 y(tform#)g(=)g(j)95 1120 y(ttype#)g(=)g(Rate)95 +1233 y(tunit#)g(=)g(counts/s)95 1346 y(tform#)g(=)g(e)0 +1605 y Fj(The)26 b(ab)s(o)m(v)m(e)j(example)d(de\014nes)g(a)i(n)m(ull)d +(primary)g(arra)m(y)i(follo)m(w)m(ed)g(b)m(y)g(a)g(40-ro)m(w)h(binary)d +(table)i(extension)g(with)f(3)0 1718 y(columns)h(called)g('Name',)j +('Np)s(oin)m(ts',)e(and)g('Rate',)i(with)d(data)i(formats)f(of)g('10A') +i(\(ASCI)s(I)d(c)m(haracter)i(string\),)0 1831 y('1J')k(\(in)m(teger\)) +h(and)e('1E')i(\(\015oating)e(p)s(oin)m(t\),)h(resp)s(ectiv)m(ely)-8 +b(.)48 b(Note)34 b(that)f(the)g(other)g(required)e(FITS)h(k)m(eyw)m +(ords)0 1944 y(\(BITPIX,)37 b(NAXIS,)g(NAXIS1,)h(PCOUNT,)e(GCOUNT,)h +(TFIELDS,)f(and)g(END\))h(do)g(not)g(need)f(to)h(b)s(e)f(ex-)0 +2057 y(plicitly)f(de\014ned)h(in)h(the)g(template)h(b)s(ecause)g(their) +f(v)-5 b(alues)37 b(can)h(b)s(e)f(inferred)e(from)j(the)f(other)h(k)m +(eyw)m(ords)g(in)0 2170 y(the)d(template.)54 b(This)33 +b(example)i(also)g(illustrates)d(that)k(the)f(templates)g(are)g +(generally)f(case-insensitiv)m(e)g(\(the)0 2283 y(k)m(eyw)m(ord)29 +b(names)g(and)g(TF)m(ORMn)f(v)-5 b(alues)29 b(are)g(con)m(v)m(erted)i +(to)e(upp)s(er-case)g(in)e(the)i(FITS)g(\014le\))f(and)g(that)i(string) +0 2396 y(k)m(eyw)m(ord)h(v)-5 b(alues)30 b(generally)f(do)h(not)h(need) +f(to)h(b)s(e)f(enclosed)g(in)f(quotes.)p eop +%%Page: 136 144 +136 143 bop 0 299 a Fj(136)2250 b Fh(CHAPTER)29 b(11.)72 +b(TEMPLA)-8 b(TE)30 b(FILES)p eop +%%Page: 137 145 +137 144 bop 0 1225 a Fg(Chapter)65 b(12)0 1687 y Fm(Lo)6 +b(cal)78 b(FITS)e(Con)-6 b(v)g(en)g(tions)0 2180 y Fj(CFITSIO)25 +b(supp)s(orts)g(sev)m(eral)i(lo)s(cal)e(FITS)h(con)m(v)m(en)m(tions)i +(whic)m(h)d(are)i(not)g(de\014ned)e(in)g(the)i(o\016cial)f(NOST)g(FITS) +0 2293 y(standard)k(and)g(whic)m(h)g(are)h(not)g(necessarily)e +(recognized)i(or)g(supp)s(orted)e(b)m(y)i(other)g(FITS)f(soft)m(w)m +(are)i(pac)m(k)-5 b(ages.)0 2406 y(Programmers)36 b(should)e(b)s(e)h +(cautious)h(ab)s(out)f(using)g(these)h(features,)i(esp)s(ecially)c(if)h +(the)h(FITS)f(\014les)g(that)i(are)0 2518 y(pro)s(duced)31 +b(are)i(exp)s(ected)g(to)g(b)s(e)f(pro)s(cessed)g(b)m(y)h(other)f(soft) +m(w)m(are)i(systems)f(whic)m(h)e(do)i(not)f(use)h(the)f(CFITSIO)0 +2631 y(in)m(terface.)0 3275 y Ff(12.1)136 b(64-Bit)45 +b(Long)g(In)l(tegers)0 3587 y Fj(CFITSIO)38 b(can)i(read)f(and)g(write) +g(FITS)f(images)i(or)g(table)f(columns)f(con)m(taining)h(64-bit)h(in)m +(teger)g(data)g(v)-5 b(al-)0 3700 y(ues.)63 b(This)37 +b(data)h(t)m(yp)s(e)g(is)f(not)i(recognized)f(in)f(the)h(o\016cial)f +(FITS)h(Standard)e(de\014nition)g(do)s(cumen)m(t,)k(but)d(it)0 +3813 y(is)31 b(lik)m(ely)f(that)i(FITS)f(will)e(ev)m(en)m(tually)i +(supp)s(ort)f(this)h(data)h(t)m(yp)s(e,)g(esp)s(ecially)e(as)i +(computers)f(that)i(run)d(64-bit)0 3926 y(op)s(erating)25 +b(systems)h(b)s(ecome)f(more)h(common.)40 b(Supp)s(ort)23 +b(for)i(reading)g(and)g(writing)e(64-bit)j(in)m(tegers)g(in)e(CFIT-)0 +4039 y(SIO)32 b(can)i(b)s(e)f(con)m(trolled)g(with)f(the)i(#de\014ne)e +(statemen)m(t)k(at)e(the)g(b)s(eginning)d(of)i(the)h(\014tsio2.h)f +(\014le)f(b)m(y)i(setting)0 4152 y(SUPPOR)-8 b(T)p 444 +4152 28 4 v 32 w(64BIT)p 729 4152 V 33 w(INTEGERS)30 +b(to)h(1)g(\(enable\))f(or)h(0)f(\(disable\).)0 4312 +y(Under)k(the)h(con)m(v)m(en)m(tion)h(used)e(b)m(y)h(CFITSIO,)e(FITS)h +(64-bit)h(images)g(ha)m(v)m(e)h(BITPIX)f(=)f(64,)j(and)e(the)g(64-bit)0 +4425 y(binary)e(table)i(columns)e(ha)m(v)m(e)j(TF)m(ORMn)f(=)f('K'.)i +(The)e(use)g(of)h(these)h(data)f(t)m(yp)s(es)g(on)g(platforms)e(where)i +(the)0 4538 y(size)26 b(of)h(a)g('long')f(\(or)h('longlong'\))g(in)m +(teger)g(=)f(8)h(b)m(ytes)g(is)e(rather)i(in)m(tuitiv)m(e.)38 +b(CFITSIO)25 b(will)e(write)j(64-bit)h('long')0 4650 +y(v)-5 b(ariable)29 b(v)-5 b(alues)30 b(to)g(the)h(FITS)e(\014le)h(and) +f(read)h(them)g(bac)m(k)h(in)m(to)g('long')f(v)-5 b(ariables)29 +b(just)g(as)i(one)f(w)m(ould)f(exp)s(ect.)0 4763 y(CFITSIO)j(also)h +(supp)s(orts)f(implicit)e(data)k(t)m(yp)s(e)g(con)m(v)m(ersion)f(b)s +(et)m(w)m(een)i(64-bit)e(in)m(teger)h(images)f(and)g(columns)0 +4876 y(and)24 b(an)m(y)h(other)f(supp)s(orted)f(data)i(t)m(yp)s(e,)h +(although)e(some)h(loss)f(of)g(n)m(umerical)f(precision)g(or)i(n)m +(umerical)e(o)m(v)m(er\015o)m(w)0 4989 y(is)29 b(lik)m(ely)g(in)g(this) +h(case.)0 5149 y(The)h(situation)f(is)h(more)g(di\016cult)e(on)j +(32-bit)f(computing)g(platforms)f(that)i(do)f(not)h(supp)s(ort)e(an)h +(in)m(trinsic)e(64-)0 5262 y(bit)37 b(in)m(teger)i(data)g(t)m(yp)s(e.) +65 b(In)38 b(this)f(case)i(it)f(is)f(not)i(p)s(ossible)d(to)j(return)e +(the)i(full)d(64)j(precision)e(of)h(the)h(FITS)0 5375 +y(data)29 b(v)-5 b(alues)27 b(when)g(reading)g(the)i(v)-5 +b(alues)27 b(in)m(to)h(a)g(program)g(v)-5 b(ariable.)39 +b(CFITSIO)26 b(will)g(still)g(con)m(v)m(ert)j(the)g(64-bit)0 +5488 y(in)m(teger)d(v)-5 b(alues)25 b(in)m(to)g(an)m(y)h(other)g(supp)s +(orted)e(data)i(t)m(yp)s(e;)i(the)d(64-bit)h(double)e(data)j(t)m(yp)s +(e)e(is)g(probably)f(the)i(most)0 5601 y(useful)33 b(in)g(this)h(case.) +55 b(It)35 b(only)f(pro)m(vides)f(ab)s(out)i(52-bits)g(of)g(precision)e +(in)g(the)i(man)m(tissa,)h(ho)m(w)m(ev)m(er,)i(so)d(some)0 +5714 y(lose)30 b(of)h(precision)d(is)i(p)s(ossible.)1882 +5942 y(137)p eop +%%Page: 138 146 +138 145 bop 0 299 a Fj(138)1741 b Fh(CHAPTER)30 b(12.)112 +b(LOCAL)29 b(FITS)h(CONVENTIONS)0 555 y Ff(12.2)136 b(Long)44 +b(String)i(Keyw)l(ord)f(V)-11 b(alues.)0 805 y Fj(The)43 +b(length)h(of)g(a)g(standard)g(FITS)f(string)g(k)m(eyw)m(ord)h(is)f +(limited)f(to)j(68)f(c)m(haracters)i(b)s(ecause)e(it)f(m)m(ust)h(\014t) +0 918 y(en)m(tirely)33 b(within)e(a)j(single)f(FITS)g(header)g(k)m(eyw) +m(ord)i(record.)50 b(In)33 b(some)i(instances)e(it)g(is)g(necessary)h +(to)h(enco)s(de)0 1031 y(strings)28 b(longer)i(than)f(this)f(limit,)g +(so)i(CFITSIO)e(supp)s(orts)g(a)h(lo)s(cal)g(con)m(v)m(en)m(tion)i(in)d +(whic)m(h)h(the)g(string)g(v)-5 b(alue)29 b(is)0 1144 +y(con)m(tin)m(ued)35 b(o)m(v)m(er)h(m)m(ultiple)c(k)m(eyw)m(ords.)55 +b(This)33 b(con)m(tin)m(uation)h(con)m(v)m(en)m(tion)i(uses)f(an)f(amp) +s(ersand)g(c)m(haracter)i(at)0 1257 y(the)26 b(end)f(of)h(eac)m(h)g +(substring)e(to)i(indicate)f(that)h(it)g(is)e(con)m(tin)m(ued)i(on)f +(the)h(next)g(k)m(eyw)m(ord,)h(and)e(the)h(con)m(tin)m(uation)0 +1370 y(k)m(eyw)m(ords)40 b(all)f(ha)m(v)m(e)i(the)f(name)g(CONTINUE)f +(without)g(an)h(equal)f(sign)g(in)g(column)g(9.)69 b(The)40 +b(string)e(v)-5 b(alue)0 1483 y(ma)m(y)33 b(b)s(e)f(con)m(tin)m(ued)g +(in)g(this)f(w)m(a)m(y)i(o)m(v)m(er)h(as)f(man)m(y)g(additional)d +(CONTINUE)i(k)m(eyw)m(ords)h(as)f(is)g(required.)45 b(The)0 +1596 y(follo)m(wing)34 b(lines)f(illustrate)g(this)h(con)m(tin)m +(uation)h(con)m(v)m(en)m(tion)i(whic)m(h)c(is)i(used)f(in)g(the)h(v)-5 +b(alue)35 b(of)g(the)g(STRKEY)0 1709 y(k)m(eyw)m(ord:)0 +1939 y Fe(LONGSTRN=)45 b('OGIP)i(1.0')189 b(/)48 b(The)f(OGIP)f(Long)h +(String)f(Convention)f(may)i(be)g(used.)0 2051 y(STRKEY)94 +b(=)47 b('This)g(is)g(a)g(very)g(long)g(string)f(keyword&')93 +b(/)47 b(Optional)f(Comment)0 2164 y(CONTINUE)93 b(')48 +b(value)e(that)h(is)g(continued)e(over)i(3)g(keywords)f(in)h(the)g(&)95 +b(')0 2277 y(CONTINUE)e('FITS)47 b(header.')e(/)j(This)e(is)h(another)f +(optional)g(comment.)0 2507 y Fj(It)29 b(is)f(recommended)g(that)h(the) +g(LONGSTRN)f(k)m(eyw)m(ord,)i(as)f(sho)m(wn)f(here,)h(alw)m(a)m(ys)h(b) +s(e)e(included)e(in)h(an)m(y)i(HDU)0 2620 y(that)i(uses)f(this)f +(longstring)g(con)m(v)m(en)m(tion)j(as)f(a)f(w)m(arning)g(to)h(an)m(y)g +(soft)m(w)m(are)g(that)g(m)m(ust)g(read)f(the)h(k)m(eyw)m(ords.)41 +b(A)0 2733 y(routine)c(called)f(\014ts)p 712 2733 28 +4 v 33 w(write)p 948 2733 V 32 w(k)m(ey)p 1113 2733 V +33 w(longw)m(arn)h(has)g(b)s(een)g(pro)m(vided)f(in)h(CFITSIO)e(to)k +(write)d(this)h(k)m(eyw)m(ord)h(if)e(it)0 2846 y(do)s(es)30 +b(not)h(already)f(exist.)0 3006 y(This)f(long)h(string)f(con)m(v)m(en)m +(tion)i(is)f(supp)s(orted)e(b)m(y)j(the)f(follo)m(wing)f(CFITSIO)g +(routines:)191 3236 y Fe(fits_write_key_longstr)89 b(-)48 +b(write)e(a)i(long)e(string)g(keyword)g(value)191 3349 +y(fits_insert_key_longstr)41 b(-)48 b(insert)e(a)h(long)g(string)f +(keyword)g(value)191 3462 y(fits_modify_key_longstr)41 +b(-)48 b(modify)e(a)h(long)g(string)f(keyword)g(value)191 +3575 y(fits_update_key_longstr)41 b(-)48 b(modify)e(a)h(long)g(string)f +(keyword)g(value)191 3688 y(fits_read_key_longstr)137 +b(-)48 b(read)94 b(a)48 b(long)e(string)g(keyword)g(value)191 +3801 y(fits_delete_key)425 b(-)48 b(delete)e(a)h(keyword)0 +4030 y Fj(The)36 b(\014ts)p 320 4030 V 32 w(read)p 524 +4030 V 33 w(k)m(ey)p 690 4030 V 34 w(longstr)f(routine)h(is)f(unique)f +(among)j(all)f(the)g(CFITSIO)f(routines)g(in)g(that)i(it)f(in)m +(ternally)0 4143 y(allo)s(cates)e(memory)f(for)h(the)f(long)g(string)g +(v)-5 b(alue;)35 b(all)d(the)i(other)g(CFITSIO)e(routines)g(that)i +(deal)f(with)g(arra)m(ys)0 4256 y(require)38 b(that)i(the)g(calling)e +(program)h(pre-allo)s(cate)h(adequate)g(space)g(to)g(hold)e(the)i(arra) +m(y)g(of)f(data.)69 b(Conse-)0 4369 y(quen)m(tly)-8 b(,)30 +b(programs)g(whic)m(h)f(use)h(the)g(\014ts)p 1443 4369 +V 32 w(read)p 1647 4369 V 33 w(k)m(ey)p 1813 4369 V 34 +w(longstr)f(routine)g(m)m(ust)h(b)s(e)g(careful)f(to)i(free)g(the)f +(allo)s(cated)0 4482 y(memory)g(for)g(the)h(string)e(when)h(it)g(is)f +(no)h(longer)g(needed.)0 4642 y(The)g(follo)m(wing)f(2)h(routines)g +(also)g(ha)m(v)m(e)i(limited)c(supp)s(ort)g(for)i(this)g(long)g(string) +f(con)m(v)m(en)m(tion,)286 4872 y Fe(fits_modify_key_str)43 +b(-)k(modify)f(an)i(existing)d(string)h(keyword)g(value)286 +4985 y(fits_update_key_str)d(-)k(update)f(a)i(string)e(keyword)g(value) +0 5215 y Fj(in)23 b(that)i(they)f(will)e(correctly)i(o)m(v)m(erwrite)h +(an)f(existing)f(long)h(string)f(v)-5 b(alue,)26 b(but)d(the)h(new)g +(string)f(v)-5 b(alue)24 b(is)f(limited)0 5328 y(to)31 +b(a)g(maxim)m(um)e(of)i(68)g(c)m(haracters)h(in)d(length.)0 +5488 y(The)g(more)h(commonly)g(used)f(CFITSIO)f(routines)h(to)h(write)f +(string)g(v)-5 b(alued)29 b(k)m(eyw)m(ords)h(\(\014ts)p +3254 5488 V 33 w(up)s(date)p 3563 5488 V 32 w(k)m(ey)h(and)0 +5601 y(\014ts)p 127 5601 V 32 w(write)p 362 5601 V 32 +w(k)m(ey\))j(do)e(not)h(supp)s(ort)d(this)h(long)h(string)g(con)m(v)m +(en)m(tion)h(and)f(only)f(supp)s(ort)g(strings)g(up)g(to)i(68)g(c)m +(har-)0 5714 y(acters)g(in)e(length.)47 b(This)30 b(has)i(b)s(een)g +(done)g(delib)s(erately)e(to)j(prev)m(en)m(t)g(programs)f(from)g(inadv) +m(erten)m(tly)g(writing)p eop +%%Page: 139 147 +139 146 bop 0 299 a Fh(12.3.)73 b(ARRA)-8 b(YS)30 b(OF)h(FIXED-LENGTH)g +(STRINGS)e(IN)h(BINAR)-8 b(Y)32 b(T)-8 b(ABLES)871 b +Fj(139)0 555 y(k)m(eyw)m(ords)25 b(using)e(this)h(non-standard)f(con)m +(v)m(en)m(tion)j(without)e(the)h(explicit)e(in)m(ten)m(t)i(of)g(the)f +(programmer)h(or)f(user.)0 668 y(The)36 b(\014ts)p 320 +668 28 4 v 32 w(write)p 555 668 V 32 w(k)m(ey)p 720 668 +V 34 w(longstr)g(routine)f(m)m(ust)i(b)s(e)f(called)g(instead)f(to)j +(write)d(long)h(strings.)58 b(This)35 b(routine)h(can)0 +781 y(also)30 b(b)s(e)g(used)g(to)h(write)e(ordinary)g(string)g(v)-5 +b(alues)30 b(less)g(than)g(68)h(c)m(haracters)h(in)d(length.)0 +1128 y Ff(12.3)136 b(Arra)l(ys)45 b(of)g(Fixed-Length)g(Strings)g(in)g +(Binary)f(T)-11 b(ables)0 1381 y Fj(The)29 b(de\014nition)e(of)j(the)f +(FITS)g(binary)e(table)j(extension)f(format)g(do)s(es)h(not)f(pro)m +(vide)g(a)g(simple)f(w)m(a)m(y)i(to)g(sp)s(ecify)0 1494 +y(that)24 b(a)f(c)m(haracter)i(column)d(con)m(tains)h(an)g(arra)m(y)h +(of)f(\014xed-length)f(strings.)37 b(T)-8 b(o)24 b(supp)s(ort)d(this)h +(feature,)j(CFITSIO)0 1607 y(uses)31 b(a)h(lo)s(cal)f(con)m(v)m(en)m +(tion)h(for)f(the)h(format)g(of)g(the)f(TF)m(ORMn)g(k)m(eyw)m(ord)h(v) +-5 b(alue)31 b(of)h(the)g(form)f('rAw')g(where)g('r')0 +1720 y(is)c(an)g(in)m(teger)h(sp)s(ecifying)d(the)j(total)g(width)e(in) +g(c)m(haracters)j(of)f(the)g(column,)f(and)g('w')g(is)g(an)g(in)m +(teger)h(sp)s(ecifying)0 1833 y(the)c(\(\014xed\))g(length)g(of)g(an)g +(individual)19 b(unit)k(string)g(within)e(the)j(v)m(ector.)41 +b(F)-8 b(or)24 b(example,)i(TF)m(ORM1)e(=)g('120A10')0 +1946 y(w)m(ould)k(indicate)g(that)h(the)h(binary)d(table)i(column)f(is) +g(120)i(c)m(haracters)g(wide)e(and)h(consists)f(of)h(12)h(10-c)m +(haracter)0 2059 y(length)c(strings.)38 b(This)24 b(con)m(v)m(en)m +(tion)k(is)d(recognized)i(b)m(y)f(the)g(CFITSIO)f(routines)g(that)i +(read)f(or)h(write)e(strings)g(in)0 2171 y(binary)30 +b(tables.)44 b(The)31 b(Binary)g(T)-8 b(able)31 b(de\014nition)e(do)s +(cumen)m(t)i(sp)s(eci\014es)g(that)h(other)g(optional)e(c)m(haracters)j +(ma)m(y)0 2284 y(follo)m(w)f(the)h(data)g(t)m(yp)s(e)g(co)s(de)g(in)e +(the)i(TF)m(ORM)g(k)m(eyw)m(ord,)h(so)f(this)e(lo)s(cal)h(con)m(v)m(en) +m(tion)i(is)e(in)f(compliance)h(with)0 2397 y(the)f(FITS)e(standard)h +(although)g(other)g(FITS)g(readers)g(ma)m(y)h(not)g(recognize)g(this)e +(con)m(v)m(en)m(tion.)0 2557 y(The)c(Binary)g(T)-8 b(able)26 +b(de\014nition)d(do)s(cumen)m(t)j(that)h(w)m(as)f(appro)m(v)m(ed)g(b)m +(y)g(the)g(IA)m(U)g(in)f(1994)j(con)m(tains)e(an)f(app)s(endix)0 +2670 y(describing)20 b(an)j(alternate)g(con)m(v)m(en)m(tion)h(for)f(sp) +s(ecifying)d(arra)m(ys)j(of)g(\014xed)f(or)h(v)-5 b(ariable)22 +b(length)g(strings)f(in)h(a)h(binary)0 2783 y(table)34 +b(c)m(haracter)h(column)e(\(with)g(the)i(form)e('rA:SSTRw/nnn\)'.)50 +b(This)32 b(app)s(endix)f(w)m(as)k(not)f(o\016cially)f(v)m(oted)0 +2896 y(on)d(b)m(y)h(the)f(IA)m(U)h(and)f(hence)g(is)g(still)e(pro)m +(visional.)39 b(CFITSIO)29 b(do)s(es)h(not)g(curren)m(tly)g(supp)s(ort) +e(this)i(prop)s(osal.)0 3243 y Ff(12.4)136 b(Keyw)l(ord)45 +b(Units)h(Strings)0 3496 y Fj(One)37 b(limitation)f(of)h(the)h(curren)m +(t)g(FITS)e(Standard)h(is)g(that)h(it)f(do)s(es)g(not)h(de\014ne)f(a)h +(sp)s(eci\014c)e(con)m(v)m(en)m(tion)j(for)0 3609 y(recording)29 +b(the)h(ph)m(ysical)f(units)g(of)h(a)g(k)m(eyw)m(ord)h(v)-5 +b(alue.)40 b(The)30 b(TUNITn)f(k)m(eyw)m(ord)h(can)g(b)s(e)g(used)f(to) +i(sp)s(ecify)e(the)0 3722 y(ph)m(ysical)34 b(units)g(of)h(the)h(v)-5 +b(alues)35 b(in)f(a)h(table)h(column,)f(but)g(there)g(is)g(no)g +(analogous)h(con)m(v)m(en)m(tion)g(for)f(k)m(eyw)m(ord)0 +3835 y(v)-5 b(alues.)41 b(The)30 b(commen)m(t)h(\014eld)f(of)g(the)h(k) +m(eyw)m(ord)g(is)f(often)h(used)f(for)g(this)f(purp)s(ose,)h(but)f(the) +i(units)e(are)i(usually)0 3948 y(not)g(sp)s(eci\014ed)d(in)h(a)i(w)m +(ell)e(de\014ned)h(format)g(that)h(FITS)f(readers)g(can)h(easily)e +(recognize)i(and)f(extract.)0 4108 y(T)-8 b(o)27 b(solv)m(e)h(this)d +(problem,)i(CFITSIO)e(uses)i(a)g(lo)s(cal)f(con)m(v)m(en)m(tion)i(in)e +(whic)m(h)f(the)j(k)m(eyw)m(ord)f(units)e(are)j(enclosed)e(in)0 +4221 y(square)20 b(brac)m(k)m(ets)j(as)e(the)f(\014rst)g(tok)m(en)i(in) +e(the)g(k)m(eyw)m(ord)i(commen)m(t)f(\014eld;)i(more)e(sp)s +(eci\014cally)-8 b(,)21 b(the)g(op)s(ening)e(square)0 +4334 y(brac)m(k)m(et)28 b(immediately)d(follo)m(ws)g(the)i(slash)e('/') +i(commen)m(t)h(\014eld)d(delimiter)f(and)i(a)g(single)f(space)i(c)m +(haracter.)41 b(The)0 4447 y(follo)m(wing)29 b(examples)h(illustrate)e +(k)m(eyw)m(ords)j(that)g(use)f(this)f(con)m(v)m(en)m(tion:)0 +4718 y Fe(EXPOSURE=)713 b(1800.0)47 b(/)g([s])g(elapsed)f(exposure)f +(time)0 4831 y(V_HELIO)h(=)763 b(16.23)47 b(/)g([km)g(s**\(-1\)])e +(heliocentric)g(velocity)0 4944 y(LAMBDA)94 b(=)763 b(5400.)47 +b(/)g([angstrom])e(central)h(wavelength)0 5057 y(FLUX)190 +b(=)47 b(4.9033487787637465E-30)42 b(/)47 b([J/cm**2/s])e(average)h +(flux)0 5328 y Fj(In)28 b(general,)g(the)h(units)d(named)i(in)f(the)i +(IA)m(U\(1988\))i(St)m(yle)d(Guide)f(are)i(recommended,)f(with)f(the)i +(main)e(excep-)0 5441 y(tion)j(that)h(the)f(preferred)g(unit)e(for)j +(angle)f(is)f('deg')j(for)e(degrees.)0 5601 y(The)38 +b(\014ts)p 322 5601 V 33 w(read)p 527 5601 V 33 w(k)m(ey)p +693 5601 V 33 w(unit)g(and)g(\014ts)p 1234 5601 V 32 +w(write)p 1469 5601 V 32 w(k)m(ey)p 1634 5601 V 34 w(unit)f(routines)h +(in)g(CFITSIO)f(read)i(and)f(write,)j(resp)s(ectiv)m(ely)-8 +b(,)0 5714 y(the)31 b(k)m(eyw)m(ord)f(unit)f(strings)h(in)f(an)h +(existing)f(k)m(eyw)m(ord.)p eop +%%Page: 140 148 +140 147 bop 0 299 a Fj(140)1741 b Fh(CHAPTER)30 b(12.)112 +b(LOCAL)29 b(FITS)h(CONVENTIONS)0 555 y Ff(12.5)136 b(HIERAR)l(CH)46 +b(Con)l(v)l(en)l(tion)g(for)f(Extended)h(Keyw)l(ord)f(Names)0 +805 y Fj(CFITSIO)c(supp)s(orts)g(the)i(HIERAR)m(CH)g(k)m(eyw)m(ord)g +(con)m(v)m(en)m(tion)h(whic)m(h)e(allo)m(ws)g(k)m(eyw)m(ord)h(names)g +(that)h(are)0 918 y(longer)33 b(then)f(8)i(c)m(haracters)g(and)f(ma)m +(y)h(con)m(tain)f(the)g(full)e(range)i(of)h(prin)m(table)d(ASCI)s(I)g +(text)j(c)m(haracters.)51 b(This)0 1031 y(con)m(v)m(en)m(tion)38 +b(w)m(as)g(dev)m(elop)s(ed)e(at)i(the)f(Europ)s(ean)f(Southern)g +(Observ)-5 b(atory)37 b(\(ESO\))f(to)i(supp)s(ort)d(hierarc)m(hical)0 +1144 y(FITS)30 b(k)m(eyw)m(ord)g(suc)m(h)h(as:)0 1395 +y Fe(HIERARCH)46 b(ESO)g(INS)h(FOCU)g(POS)g(=)g(-0.00002500)e(/)j +(Focus)e(position)0 1646 y Fj(Basically)-8 b(,)52 b(this)46 +b(con)m(v)m(en)m(tion)j(uses)e(the)h(FITS)f(k)m(eyw)m(ord)h('HIERAR)m +(CH')h(to)f(indicate)f(that)h(this)e(con)m(v)m(en-)0 +1759 y(tion)e(is)f(b)s(eing)g(used,)k(then)d(the)g(actual)h(k)m(eyw)m +(ord)f(name)h(\()p Fe('ESO)i(INS)f(FOCU)h(POS')c Fj(in)g(this)g +(example\))h(b)s(e-)0 1872 y(gins)39 b(in)f(column)g(10)j(and)e(can)h +(con)m(tain)f(an)m(y)h(prin)m(table)e(ASCI)s(I)g(text)j(c)m(haracters,) +i(including)37 b(spaces.)68 b(The)0 1985 y(equals)43 +b(sign)h(marks)f(the)h(end)g(of)g(the)g(k)m(eyw)m(ord)h(name)f(and)f +(is)h(follo)m(w)m(ed)f(b)m(y)h(the)g(usual)f(v)-5 b(alue)44 +b(and)f(com-)0 2098 y(men)m(t)31 b(\014elds)e(just)h(as)h(in)e +(standard)h(FITS)g(k)m(eyw)m(ords.)41 b(F)-8 b(urther)30 +b(details)g(of)h(this)e(con)m(v)m(en)m(tion)j(are)f(describ)s(ed)d(at)0 +2211 y(h)m(ttp://arcdev.hq.eso.org/dicb/dicd/dic-1-1.4.h)m(tml)33 +b(\(searc)m(h)f(for)e(HIERAR)m(CH\).)0 2371 y(This)42 +b(con)m(v)m(en)m(tion)k(allo)m(ws)e(a)g(m)m(uc)m(h)h(broader)e(range)i +(of)f(k)m(eyw)m(ord)h(names)f(than)h(is)e(allo)m(w)m(ed)h(b)m(y)g(the)h +(FITS)0 2484 y(Standard.)40 b(Here)30 b(are)h(more)g(examples)f(of)g +(suc)m(h)g(k)m(eyw)m(ords:)0 2735 y Fe(HIERARCH)46 b(LongKeyword)e(=)k +(47.5)e(/)i(Keyword)e(has)h(>)g(8)g(characters,)e(and)i(mixed)f(case)0 +2848 y(HIERARCH)g(XTE$TEMP)f(=)j(98.6)e(/)i(Keyword)d(contains)h(the)h +('$')g(character)0 2961 y(HIERARCH)f(Earth)g(is)h(a)h(star)e(=)i(F)f(/) +h(Keyword)d(contains)h(embedded)f(spaces)0 3212 y Fj(CFITSIO)40 +b(will)f(transparen)m(tly)i(read)h(and)f(write)f(these)j(k)m(eyw)m +(ords,)i(so)d(application)e(programs)h(do)g(not)h(in)0 +3325 y(general)32 b(need)g(to)h(kno)m(w)f(an)m(ything)g(ab)s(out)g(the) +g(sp)s(eci\014c)f(implemen)m(tation)g(details)g(of)i(the)f(HIERAR)m(CH) +g(con-)0 3438 y(v)m(en)m(tion.)49 b(In)32 b(particular,)h(application)e +(programs)h(do)h(not)h(need)e(to)i(sp)s(ecify)e(the)h(`HIERAR)m(CH')h +(part)f(of)g(the)0 3551 y(k)m(eyw)m(ord)g(name)f(when)g(reading)f(or)h +(writing)f(k)m(eyw)m(ords)h(\(although)g(it)g(ma)m(y)h(b)s(e)f +(included)d(if)j(desired\).)45 b(When)0 3664 y(writing)33 +b(a)i(k)m(eyw)m(ord,)h(CFITSIO)d(\014rst)h(c)m(hec)m(ks)i(to)f(see)g +(if)f(the)h(k)m(eyw)m(ord)g(name)f(is)g(legal)g(as)h(a)g(standard)f +(FITS)0 3776 y(k)m(eyw)m(ord)k(\(no)g(more)f(than)h(8)g(c)m(haracters)h +(long)e(and)g(con)m(taining)g(only)f(letters,)k(digits,)e(or)g(a)g(min) +m(us)d(sign)i(or)0 3889 y(underscore\).)68 b(If)39 b(so)h(it)f(writes)g +(it)g(as)g(a)h(standard)f(FITS)g(k)m(eyw)m(ord,)k(otherwise)c(it)g +(uses)g(the)h(hierarc)m(h)e(con-)0 4002 y(v)m(en)m(tion)33 +b(to)g(write)f(the)g(k)m(eyw)m(ord.)48 b(The)32 b(maxim)m(um)f(k)m(eyw) +m(ord)i(name)f(length)g(is)g(67)h(c)m(haracters,)i(whic)m(h)c(lea)m(v)m +(es)0 4115 y(only)c(1)i(space)g(for)f(the)h(v)-5 b(alue)28 +b(\014eld.)38 b(A)29 b(more)f(practical)g(limit)e(is)i(ab)s(out)g(40)h +(c)m(haracters,)i(whic)m(h)c(lea)m(v)m(es)i(enough)0 +4228 y(ro)s(om)f(for)h(most)f(k)m(eyw)m(ord)h(v)-5 b(alues.)40 +b(CFITSIO)27 b(returns)g(an)h(error)h(if)e(there)i(is)e(not)i(enough)f +(ro)s(om)h(for)f(b)s(oth)g(the)0 4341 y(k)m(eyw)m(ord)k(name)f(and)f +(the)i(k)m(eyw)m(ord)f(v)-5 b(alue)31 b(on)g(the)h(80-c)m(haracter)h +(card,)f(except)g(for)f(string-v)-5 b(alued)30 b(k)m(eyw)m(ords)0 +4454 y(whic)m(h)i(are)h(simply)d(truncated)j(so)g(that)h(the)f(closing) +f(quote)i(c)m(haracter)g(falls)d(in)h(column)g(80.)49 +b(In)32 b(the)h(curren)m(t)0 4567 y(implemen)m(tation,)28 +b(CFITSIO)f(preserv)m(es)i(the)g(case)h(of)f(the)g(letters)g(when)f +(writing)f(the)i(k)m(eyw)m(ord)g(name,)g(but)f(it)0 4680 +y(is)c(case-insensitiv)m(e)g(when)g(reading)g(or)h(searc)m(hing)g(for)g +(a)g(k)m(eyw)m(ord.)40 b(The)24 b(curren)m(t)h(implemen)m(tation)e +(allo)m(ws)i(an)m(y)0 4793 y(ASCI)s(I)k(text)j(c)m(haracter)h(\(ASCI)s +(I)c(32)j(to)f(ASCI)s(I)f(126\))i(in)e(the)h(k)m(eyw)m(ord)g(name)g +(except)h(for)e(the)h('=')g(c)m(haracter.)0 4906 y(A)f(space)h(is)f +(also)g(required)f(on)h(either)g(side)f(of)i(the)f(equal)g(sign.)0 +5238 y Ff(12.6)136 b(Tile-Compressed)46 b(Image)g(F)-11 +b(ormat)0 5488 y Fj(CFITSIO)36 b(supp)s(orts)f(a)j(con)m(v)m(en)m(tion) +h(for)e(compressing)g(n-dimensional)d(images)j(and)g(storing)g(the)h +(resulting)0 5601 y(b)m(yte)i(stream)g(in)e(a)i(v)-5 +b(ariable-length)38 b(column)g(in)g(a)i(FITS)f(binary)e(table.)68 +b(The)39 b(general)h(principle)c(used)i(in)0 5714 y(this)33 +b(con)m(v)m(en)m(tion)j(is)d(to)i(\014rst)f(divide)e(the)j +(n-dimensional)c(image)k(in)m(to)f(a)h(rectangular)f(grid)f(of)i +(subimages)e(or)p eop +%%Page: 141 149 +141 148 bop 0 299 a Fh(12.6.)73 b(TILE-COMPRESSED)28 +b(IMA)m(GE)j(F)m(ORMA)-8 b(T)1838 b Fj(141)0 555 y(`tiles'.)55 +b(Eac)m(h)35 b(tile)g(is)f(then)h(compressed)g(as)g(a)h(con)m(tin)m +(uous)f(blo)s(c)m(k)f(of)i(data,)h(and)e(the)g(resulting)e(compressed)0 +668 y(b)m(yte)k(stream)h(is)e(stored)h(in)e(a)i(ro)m(w)g(of)g(a)h(v)-5 +b(ariable)35 b(length)h(column)g(in)g(a)h(FITS)f(binary)f(table.)60 +b(By)37 b(dividing)0 781 y(the)j(image)f(in)m(to)g(tiles)g(it)g(is)f +(generally)h(p)s(ossible)e(to)j(extract)h(and)d(uncompress)g +(subsections)h(of)g(the)h(image)0 894 y(without)c(ha)m(ving)h(to)h +(uncompress)e(the)h(whole)f(image.)61 b(The)37 b(default)f(tiling)f +(pattern)j(treats)g(eac)m(h)g(ro)m(w)f(of)h(a)0 1007 +y(2-dimensional)33 b(image)i(\(or)g(higher)e(dimensional)f(cub)s(e\))j +(as)g(a)g(tile,)h(suc)m(h)e(that)i(eac)m(h)g(tile)e(con)m(tains)h +(NAXIS1)0 1120 y(pixels.)57 b(An)m(y)36 b(other)h(rectangular)f(tiling) +f(pattern)h(ma)m(y)h(also)f(b)s(e)g(de\014ned.)58 b(In)35 +b(the)i(case)g(of)g(relativ)m(ely)e(small)0 1233 y(images)j(it)g(ma)m +(y)h(b)s(e)f(su\016cien)m(t)f(to)i(compress)f(the)h(en)m(tire)f(image)g +(as)h(a)f(single)f(tile,)j(resulting)c(in)h(an)h(output)0 +1346 y(binary)28 b(table)i(with)f(1)h(ro)m(w.)41 b(In)29 +b(the)h(case)h(of)f(3-dimensional)e(data)j(cub)s(es,)e(it)h(ma)m(y)g(b) +s(e)f(adv)-5 b(an)m(tageous)32 b(to)f(treat)0 1458 y(eac)m(h)i(plane)e +(of)h(the)g(cub)s(e)f(as)h(a)g(separate)h(tile)e(if)g(application)f +(soft)m(w)m(are)k(t)m(ypically)c(needs)i(to)g(access)i(the)e(cub)s(e)0 +1571 y(on)e(a)h(plane)e(b)m(y)i(plane)e(basis.)0 1732 +y(See)41 b(section)f(5.6)i(\\Image)f(Compression")e(for)h(more)h +(information)e(on)h(using)f(this)g(tile-compressed)h(image)0 +1844 y(format.)p eop +%%Page: 142 150 +142 149 bop 0 299 a Fj(142)1741 b Fh(CHAPTER)30 b(12.)112 +b(LOCAL)29 b(FITS)h(CONVENTIONS)p eop +%%Page: 143 151 +143 150 bop 0 1225 a Fg(Chapter)65 b(13)0 1687 y Fm(Optimizing)76 +b(Programs)0 2180 y Fj(CFITSIO)22 b(has)h(b)s(een)f(carefully)g +(designed)g(to)i(obtain)f(the)g(highest)g(p)s(ossible)d(sp)s(eed)j +(when)f(reading)g(and)h(writing)0 2293 y(FITS)33 b(\014les.)50 +b(In)33 b(order)h(to)g(ac)m(hiev)m(e)h(the)f(b)s(est)g(p)s(erformance,) +g(ho)m(w)m(ev)m(er,)i(application)d(programmers)g(m)m(ust)h(b)s(e)0 +2406 y(careful)23 b(to)i(call)e(the)h(CFITSIO)f(routines)f +(appropriately)h(and)g(in)g(an)g(e\016cien)m(t)i(sequence;)i +(inappropriate)21 b(usage)0 2518 y(of)31 b(CFITSIO)d(routines)i(can)g +(greatly)h(slo)m(w)f(do)m(wn)g(the)h(execution)f(sp)s(eed)g(of)g(a)h +(program.)0 2679 y(The)f(maxim)m(um)g(p)s(ossible)e(I/O)j(sp)s(eed)f +(of)h(CFITSIO)e(dep)s(ends)g(of)i(course)g(on)f(the)h(t)m(yp)s(e)g(of)g +(computer)g(system)0 2791 y(that)g(it)e(is)g(running)e(on.)41 +b(As)30 b(a)g(rough)g(guide,)f(the)h(curren)m(t)g(generation)g(of)g(w)m +(orkstations)g(can)h(ac)m(hiev)m(e)g(sp)s(eeds)0 2904 +y(of)k(2)g({)g(10)g(MB/s)h(when)e(reading)g(or)g(writing)f(FITS)h +(images)h(and)f(similar,)f(or)i(sligh)m(tly)e(slo)m(w)m(er)i(sp)s(eeds) +e(with)0 3017 y(FITS)c(binary)g(tables.)40 b(Reading)30 +b(of)g(FITS)g(\014les)f(can)i(o)s(ccur)f(at)h(ev)m(en)f(higher)f(rates) +i(\(30MB/s)i(or)d(more\))h(if)e(the)0 3130 y(FITS)d(\014le)g(is)f +(still)g(cac)m(hed)j(in)d(system)i(memory)f(follo)m(wing)g(a)h +(previous)e(read)h(or)h(write)f(op)s(eration)g(on)h(the)g(same)0 +3243 y(\014le.)43 b(T)-8 b(o)32 b(more)g(accurately)g(predict)e(the)i +(b)s(est)f(p)s(erformance)g(that)h(is)e(p)s(ossible)f(on)j(an)m(y)g +(particular)d(system,)k(a)0 3356 y(diagnostic)f(program)h(called)f +(\\sp)s(eed.c")h(is)f(included)e(with)i(the)h(CFITSIO)e(distribution)e +(whic)m(h)j(can)h(b)s(e)f(run)0 3469 y(to)f(appro)m(ximately)f(measure) +g(the)h(maxim)m(um)e(p)s(ossible)f(sp)s(eed)h(of)i(writing)d(and)i +(reading)g(a)g(test)i(FITS)d(\014le.)0 3629 y(The)k(follo)m(wing)e(2)j +(sections)f(pro)m(vide)g(some)g(bac)m(kground)g(on)h(ho)m(w)f(CFITSIO)f +(in)m(ternally)f(manages)j(the)f(data)0 3742 y(I/O)g(and)g(describ)s +(es)e(some)j(strategies)g(that)g(ma)m(y)g(b)s(e)e(used)h(to)h(optimize) +e(the)i(pro)s(cessing)e(sp)s(eed)g(of)h(soft)m(w)m(are)0 +3855 y(that)e(uses)f(CFITSIO.)0 4271 y Ff(13.1)136 b(Ho)l(w)45 +b(CFITSIO)f(Manages)i(Data)g(I/O)0 4538 y Fj(Man)m(y)22 +b(CFITSIO)e(op)s(erations)h(in)m(v)m(olv)m(e)h(transferring)e(only)h(a) +h(small)e(n)m(um)m(b)s(er)h(of)h(b)m(ytes)g(to)g(or)g(from)f(the)h +(FITS)f(\014le)0 4650 y(\(e.g,)31 b(reading)d(a)h(k)m(eyw)m(ord,)h(or)f +(writing)e(a)i(ro)m(w)g(in)e(a)i(table\);)h(it)f(w)m(ould)e(b)s(e)h(v)m +(ery)i(ine\016cien)m(t)e(to)h(ph)m(ysically)e(read)0 +4763 y(or)32 b(write)g(suc)m(h)g(small)e(blo)s(c)m(ks)i(of)g(data)h +(directly)e(in)g(the)h(FITS)g(\014le)f(on)h(disk,)g(therefore)g +(CFITSIO)f(main)m(tains)0 4876 y(a)38 b(set)g(of)g(in)m(ternal)f +(Input{Output)e(\(IO\))j(bu\013ers)f(in)f(RAM)i(memory)g(that)g(eac)m +(h)h(con)m(tain)f(one)g(FITS)f(blo)s(c)m(k)0 4989 y(\(2880)27 +b(b)m(ytes\))f(of)f(data.)40 b(Whenev)m(er)25 b(CFITSIO)f(needs)g(to)i +(access)g(data)g(in)e(the)h(FITS)f(\014le,)i(it)e(\014rst)g(transfers)h +(the)0 5102 y(FITS)30 b(blo)s(c)m(k)g(con)m(taining)g(those)h(b)m(ytes) +g(in)m(to)f(one)h(of)f(the)h(IO)f(bu\013ers)f(in)g(memory)-8 +b(.)42 b(The)30 b(next)g(time)g(CFITSIO)0 5215 y(needs)36 +b(to)g(access)i(b)m(ytes)e(in)f(the)h(same)h(blo)s(c)m(k)e(it)h(can)g +(then)g(go)h(to)f(the)h(fast)f(IO)f(bu\013er)g(rather)h(than)g(using)f +(a)0 5328 y(m)m(uc)m(h)d(slo)m(w)m(er)h(system)f(disk)f(access)i +(routine.)45 b(The)32 b(n)m(um)m(b)s(er)f(of)h(a)m(v)-5 +b(ailable)32 b(IO)g(bu\013ers)f(is)g(determined)g(b)m(y)h(the)0 +5441 y(NIOBUF)f(parameter)g(\(in)e(\014tsio2.h\))h(and)g(is)g(curren)m +(tly)f(set)i(to)g(40)g(b)m(y)g(default.)0 5601 y(Whenev)m(er)24 +b(CFITSIO)f(reads)g(or)h(writes)f(data)h(it)g(\014rst)f(c)m(hec)m(ks)i +(to)g(see)f(if)f(that)h(blo)s(c)m(k)g(of)g(the)g(FITS)f(\014le)f(is)h +(already)0 5714 y(loaded)32 b(in)m(to)g(one)g(of)g(the)g(IO)g +(bu\013ers.)44 b(If)32 b(not,)h(and)e(if)g(there)h(is)f(an)h(empt)m(y)h +(IO)e(bu\013er)g(a)m(v)-5 b(ailable,)32 b(then)g(it)g(will)1882 +5942 y(143)p eop +%%Page: 144 152 +144 151 bop 0 299 a Fj(144)1876 b Fh(CHAPTER)30 b(13.)112 +b(OPTIMIZING)29 b(PR)m(OGRAMS)0 555 y Fj(load)j(that)i(blo)s(c)m(k)e +(in)m(to)g(the)h(IO)g(bu\013er)e(\(when)h(reading)g(a)h(FITS)f +(\014le\))g(or)h(will)d(initialize)g(a)j(new)f(blo)s(c)m(k)h(\(when)0 +668 y(writing)i(to)j(a)g(FITS)f(\014le\).)61 b(If)37 +b(all)f(the)i(IO)e(bu\013ers)h(are)g(already)g(full,)g(it)g(m)m(ust)h +(decide)e(whic)m(h)g(one)i(to)g(reuse)0 781 y(\(generally)32 +b(the)h(one)g(that)g(has)f(b)s(een)g(accessed)i(least)e(recen)m(tly\),) +i(and)e(\015ush)f(the)i(con)m(ten)m(ts)h(bac)m(k)g(to)f(disk)e(if)g(it) +0 894 y(has)f(b)s(een)g(mo)s(di\014ed)e(b)s(efore)i(loading)f(the)i +(new)f(blo)s(c)m(k.)0 1054 y(The)g(one)g(ma)5 b(jor)30 +b(exception)h(to)g(the)f(ab)s(o)m(v)m(e)h(pro)s(cess)f(o)s(ccurs)g +(whenev)m(er)g(a)g(large)h(con)m(tiguous)f(set)h(of)f(b)m(ytes)h(are)0 +1167 y(accessed,)37 b(as)d(migh)m(t)h(o)s(ccur)f(when)f(reading)h(or)g +(writing)e(a)j(FITS)f(image.)53 b(In)34 b(this)f(case)i(CFITSIO)e(b)m +(ypasses)0 1280 y(the)i(in)m(ternal)f(IO)h(bu\013ers)f(and)g(simply)f +(reads)i(or)g(writes)g(the)g(desired)f(b)m(ytes)h(directly)f(in)g(the)h +(disk)f(\014le)g(with)0 1393 y(a)j(single)e(call)g(to)i(a)g(lo)m(w-lev) +m(el)f(\014le)f(read)h(or)h(write)e(routine.)57 b(The)36 +b(minim)m(um)e(threshold)g(for)i(the)h(n)m(um)m(b)s(er)e(of)0 +1506 y(b)m(ytes)40 b(to)g(read)f(or)g(write)f(this)h(w)m(a)m(y)h(is)e +(set)i(b)m(y)f(the)g(MINDIRECT)g(parameter)h(and)e(is)h(curren)m(tly)f +(set)i(to)g(3)0 1619 y(FITS)28 b(blo)s(c)m(ks)f(=)h(8640)i(b)m(ytes.)41 +b(This)27 b(is)g(the)h(most)h(e\016cien)m(t)g(w)m(a)m(y)g(to)g(read)g +(or)f(write)g(large)g(c)m(h)m(unks)g(of)g(data)i(and)0 +1732 y(can)37 b(ac)m(hiev)m(e)h(IO)e(transfer)g(rates)h(of)g(5)g({)g +(10MB/s)i(or)d(greater.)61 b(Note)38 b(that)f(this)f(fast)h(direct)f +(IO)g(pro)s(cess)g(is)0 1844 y(not)29 b(applicable)d(when)h(accessing)i +(columns)f(of)g(data)h(in)e(a)i(FITS)f(table)g(b)s(ecause)h(the)f(b)m +(ytes)h(are)g(generally)f(not)0 1957 y(con)m(tiguous)h(since)f(they)h +(are)h(in)m(terlea)m(v)m(ed)f(b)m(y)g(the)g(other)g(columns)f(of)h +(data)g(in)f(the)h(table.)40 b(This)27 b(explains)g(wh)m(y)0 +2070 y(the)k(sp)s(eed)e(for)h(accessing)h(FITS)f(tables)g(is)f +(generally)h(slo)m(w)m(er)g(than)h(accessing)f(FITS)g(images.)0 +2230 y(Giv)m(en)h(this)g(bac)m(kground)g(information,)f(the)i(general)f +(strategy)i(for)e(e\016cien)m(tly)g(accessing)h(FITS)f(\014les)f +(should)0 2343 y(b)s(e)f(apparen)m(t:)41 b(when)28 b(dealing)h(with)f +(FITS)h(images,)h(read)f(or)h(write)f(large)g(c)m(h)m(unks)h(of)g(data) +g(at)g(a)g(time)f(so)h(that)0 2456 y(the)25 b(direct)f(IO)g(mec)m +(hanism)f(will)f(b)s(e)i(in)m(v)m(ok)m(ed;)j(when)d(accessing)h(FITS)f +(headers)g(or)g(FITS)g(tables,)i(on)e(the)h(other)0 2569 +y(hand,)35 b(once)g(a)g(particular)e(FITS)h(blo)s(c)m(k)h(has)f(b)s +(een)g(loading)g(in)m(to)g(one)h(of)g(the)g(IO)f(bu\013ers,)h(try)g(to) +g(access)h(all)0 2682 y(the)30 b(needed)g(information)e(in)h(that)h +(blo)s(c)m(k)g(b)s(efore)g(it)f(gets)i(\015ushed)d(out)j(of)f(the)g(IO) +f(bu\013er.)40 b(It)30 b(is)f(imp)s(ortan)m(t)g(to)0 +2795 y(a)m(v)m(oid)e(the)g(situation)e(where)h(the)h(same)g(FITS)e(blo) +s(c)m(k)h(is)g(b)s(eing)f(read)h(then)g(\015ushed)f(from)h(a)h(IO)f +(bu\013er)f(m)m(ultiple)0 2908 y(times.)0 3068 y(The)30 +b(follo)m(wing)f(section)h(giv)m(es)h(more)f(sp)s(eci\014c)g +(suggestions)g(for)g(optimizing)f(the)h(use)g(of)h(CFITSIO.)0 +3481 y Ff(13.2)136 b(Optimization)46 b(Strategies)0 3747 +y Fj(1.)54 b(When)34 b(dealing)f(with)h(a)h(FITS)e(primary)g(arra)m(y)i +(or)g(IMA)m(GE)g(extension,)h(it)e(is)f(more)i(e\016cien)m(t)g(to)g +(read)g(or)0 3860 y(write)30 b(large)g(c)m(h)m(unks)g(of)g(the)h(image) +f(at)i(a)e(time)g(\(at)i(least)e(3)h(FITS)f(blo)s(c)m(ks)f(=)h(8640)i +(b)m(ytes\))f(so)g(that)g(the)f(direct)0 3973 y(IO)j(mec)m(hanism)g +(will)d(b)s(e)j(used)g(as)g(describ)s(ed)f(in)g(the)h(previous)f +(section.)50 b(Smaller)32 b(c)m(h)m(unks)h(of)g(data)h(are)g(read)0 +4086 y(or)d(written)f(via)h(the)g(IO)f(bu\013ers,)g(whic)m(h)g(is)g +(somewhat)h(less)f(e\016cien)m(t)i(b)s(ecause)f(of)g(the)g(extra)h(cop) +m(y)f(op)s(eration)0 4199 y(and)26 b(additional)e(b)s(o)s(okk)m(eeping) +i(steps)h(that)g(are)g(required.)38 b(In)26 b(principle)d(it)j(is)g +(more)g(e\016cien)m(t)h(to)h(read)e(or)h(write)0 4312 +y(as)i(big)f(an)h(arra)m(y)h(of)f(image)g(pixels)e(at)j(one)f(time)f +(as)i(p)s(ossible,)d(ho)m(w)m(ev)m(er,)j(if)e(the)i(arra)m(y)f(b)s +(ecomes)g(so)g(large)g(that)0 4425 y(the)j(op)s(erating)f(system)g +(cannot)h(store)g(it)f(all)g(in)f(RAM,)i(then)f(the)h(p)s(erformance)f +(ma)m(y)h(b)s(e)f(degraded)g(b)s(ecause)0 4538 y(of)g(the)f(increased)g +(sw)m(apping)f(of)h(virtual)f(memory)h(to)h(disk.)0 4698 +y(2.)51 b(When)33 b(dealing)g(with)f(FITS)h(tables,)i(the)f(most)g(imp) +s(ortan)m(t)f(e\016ciency)g(factor)i(in)d(the)i(soft)m(w)m(are)h +(design)e(is)0 4811 y(to)k(read)f(or)g(write)f(the)h(data)h(in)e(the)h +(FITS)g(\014le)f(in)g(a)h(single)f(pass)h(through)f(the)h(\014le.)57 +b(An)36 b(example)g(of)g(p)s(o)s(or)0 4924 y(program)g(design)g(w)m +(ould)f(b)s(e)h(to)h(read)g(a)f(large,)j(3-column)d(table)g(b)m(y)h +(sequen)m(tially)e(reading)h(the)g(en)m(tire)h(\014rst)0 +5036 y(column,)24 b(then)g(going)g(bac)m(k)g(to)h(read)e(the)h(2nd)g +(column,)g(and)f(\014nally)f(the)i(3rd)f(column;)i(this)e(ob)m(viously) +f(requires)0 5149 y(3)27 b(passes)g(through)g(the)g(\014le)f(whic)m(h)g +(could)g(triple)f(the)j(execution)f(time)g(of)g(an)g(IO)f(limited)f +(program.)40 b(F)-8 b(or)27 b(small)0 5262 y(tables)j(this)f(is)h(not)g +(imp)s(ortan)m(t,)g(but)g(when)f(reading)g(m)m(ulti-megab)m(yte)i +(sized)f(tables)g(these)h(ine\016ciencies)e(can)0 5375 +y(b)s(ecome)g(signi\014can)m(t.)39 b(The)28 b(more)h(e\016cien)m(t)g +(pro)s(cedure)e(in)h(this)f(case)j(is)d(to)j(read)e(or)h(write)f(only)f +(as)i(man)m(y)g(ro)m(ws)0 5488 y(of)j(the)g(table)f(as)h(will)d(\014t)j +(in)m(to)f(the)h(a)m(v)-5 b(ailable)31 b(in)m(ternal)f(IO)h(bu\013ers,) +h(then)f(access)i(all)d(the)i(necessary)g(columns)0 5601 +y(of)f(data)h(within)c(that)k(range)f(of)g(ro)m(ws.)43 +b(Then)29 b(after)j(the)f(program)g(is)f(completely)g(\014nished)f +(with)g(the)j(data)f(in)0 5714 y(those)i(ro)m(ws)e(it)h(can)g(mo)m(v)m +(e)i(on)e(to)g(the)h(next)f(range)g(of)g(ro)m(ws)g(that)h(will)c(\014t) +j(in)f(the)h(bu\013ers,)f(con)m(tin)m(uing)g(in)g(this)p +eop +%%Page: 145 153 +145 152 bop 0 299 a Fh(13.2.)73 b(OPTIMIZA)-8 b(TION)29 +b(STRA)-8 b(TEGIES)2186 b Fj(145)0 555 y(w)m(a)m(y)28 +b(un)m(til)d(the)h(en)m(tire)h(\014le)f(has)g(b)s(een)g(pro)s(cessed.) +39 b(By)27 b(using)e(this)h(pro)s(cedure)f(of)i(accessing)g(all)f(the)g +(columns)g(of)0 668 y(a)k(table)f(in)f(parallel)f(rather)i(than)g +(sequen)m(tially)-8 b(,)29 b(eac)m(h)h(blo)s(c)m(k)f(of)h(the)f(FITS)g +(\014le)f(will)e(only)j(b)s(e)f(read)i(or)f(written)0 +781 y(once.)0 941 y(The)g(optimal)f(n)m(um)m(b)s(er)g(of)i(ro)m(ws)f +(to)i(read)e(or)g(write)g(at)h(one)g(time)f(in)f(a)i(giv)m(en)f(table)h +(dep)s(ends)d(on)j(the)f(width)f(of)0 1054 y(the)j(table)g(ro)m(w,)g +(on)g(the)g(n)m(um)m(b)s(er)f(of)h(IO)g(bu\013ers)e(that)j(ha)m(v)m(e)g +(b)s(een)e(allo)s(cated)h(in)f(CFITSIO,)g(and)g(also)h(on)g(the)0 +1167 y(n)m(um)m(b)s(er)f(of)h(other)g(FITS)f(\014les)g(that)i(are)f(op) +s(en)f(at)i(the)f(same)g(time)g(\(since)g(one)g(IO)f(bu\013er)g(is)g +(alw)m(a)m(ys)i(reserv)m(ed)0 1280 y(for)i(eac)m(h)h(op)s(en)e(FITS)g +(\014le\).)50 b(The)34 b(CFITSIO)e(Iterator)j(routine)e(will)e +(automatically)j(use)f(the)h(optimal-sized)0 1393 y(bu\013er,)43 +b(but)c(there)i(is)f(also)h(a)g(CFITSIO)e(routine)h(that)h(will)d +(return)i(the)h(optimal)e(n)m(um)m(b)s(er)h(of)g(ro)m(ws)h(for)g(a)0 +1506 y(giv)m(en)36 b(table:)52 b(\014ts)p 644 1506 28 +4 v 32 w(get)p 796 1506 V 34 w(ro)m(wsize.)57 b(It)37 +b(is)d(not)j(critical)d(to)j(use)f(exactly)g(the)h(v)-5 +b(alue)35 b(of)h(nro)m(ws)f(returned)g(b)m(y)h(this)0 +1619 y(routine,)30 b(as)h(long)f(as)h(one)g(do)s(es)f(not)h(exceed)g +(it.)41 b(Using)30 b(a)h(v)m(ery)g(small)e(v)-5 b(alue)30 +b(ho)m(w)m(ev)m(er)i(can)f(also)f(lead)h(to)g(p)s(o)s(or)0 +1732 y(p)s(erformance)f(b)s(ecause)g(of)h(the)f(o)m(v)m(erhead)i(from)e +(the)g(larger)g(n)m(um)m(b)s(er)f(of)i(subroutine)d(calls.)0 +1892 y(The)36 b(optimal)f(n)m(um)m(b)s(er)g(of)h(ro)m(ws)g(returned)f +(b)m(y)i(\014ts)p 1829 1892 V 32 w(get)p 1981 1892 V +34 w(ro)m(wsize)f(is)g(v)-5 b(alid)34 b(only)h(as)i(long)f(as)g(the)h +(application)0 2005 y(program)27 b(is)f(only)g(reading)h(or)g(writing)e +(data)j(in)e(the)h(sp)s(eci\014ed)e(table.)40 b(An)m(y)27 +b(other)g(calls)g(to)h(access)g(data)g(in)e(the)0 2118 +y(table)31 b(header)g(or)g(in)e(an)m(y)j(other)f(FITS)f(\014le)g(w)m +(ould)g(cause)h(additional)e(blo)s(c)m(ks)i(of)g(data)g(to)h(b)s(e)e +(loaded)h(in)m(to)g(the)0 2230 y(IO)c(bu\013ers)g(displacing)f(data)i +(from)g(the)g(original)e(table,)j(and)e(should)f(b)s(e)i(a)m(v)m(oided) +g(during)e(the)i(critical)f(p)s(erio)s(d)0 2343 y(while)h(the)j(table)f +(is)g(b)s(eing)f(read)h(or)g(written.)0 2503 y(Occasionally)f(it)g(is)f +(necessary)i(to)h(sim)m(ultaneously)c(access)k(more)f(than)f(one)h +(FITS)f(table,)h(for)g(example)f(when)0 2616 y(transferring)41 +b(v)-5 b(alues)42 b(from)g(an)h(input)d(table)j(to)g(an)g(output)f +(table.)78 b(In)42 b(cases)h(lik)m(e)f(this,)j(one)e(should)e(call)0 +2729 y(\014ts)p 127 2729 V 32 w(get)p 279 2729 V 34 w(ro)m(wsize)24 +b(to)g(get)h(the)f(optimal)e(n)m(um)m(b)s(er)g(of)i(ro)m(ws)g(for)f +(eac)m(h)i(table)e(separately)-8 b(,)26 b(than)d(reduce)h(the)f(n)m(um) +m(b)s(er)0 2842 y(of)31 b(ro)m(ws)h(prop)s(ortionally)-8 +b(.)41 b(F)-8 b(or)32 b(example,)f(if)f(the)i(optimal)e(n)m(um)m(b)s +(er)g(of)h(ro)m(ws)g(in)f(the)i(input)d(table)i(is)g(3600)i(and)0 +2955 y(is)f(1400)i(in)e(the)h(output)f(table,)h(then)g(these)g(v)-5 +b(alues)32 b(should)f(b)s(e)h(cut)h(in)e(half)h(to)h(1800)i(and)d(700,) +j(resp)s(ectiv)m(ely)-8 b(,)0 3068 y(if)29 b(b)s(oth)h(tables)g(are)h +(going)f(to)h(b)s(e)f(accessed)i(at)f(the)f(same)h(time.)0 +3228 y(3.)39 b(Use)25 b(the)g(CFITSIO)e(Iterator)j(routine.)38 +b(This)23 b(routine)h(pro)m(vides)f(a)j(more)e(`ob)5 +b(ject)26 b(orien)m(ted')f(w)m(a)m(y)h(of)f(reading)0 +3341 y(and)34 b(writing)e(FITS)i(\014les)f(whic)m(h)h(automatically)g +(uses)g(the)g(most)h(appropriate)f(data)h(bu\013er)e(size)h(to)i(ac)m +(hiev)m(e)0 3454 y(the)31 b(maxim)m(um)e(I/O)h(throughput.)0 +3614 y(4.)39 b(Use)24 b(binary)e(table)h(extensions)g(rather)g(than)h +(ASCI)s(I)e(table)h(extensions)g(for)g(b)s(etter)h(e\016ciency)g(when)e +(dealing)0 3727 y(with)36 b(tabular)h(data.)62 b(The)37 +b(I/O)g(to)h(ASCI)s(I)e(tables)h(is)g(slo)m(w)m(er)g(b)s(ecause)h(of)f +(the)h(o)m(v)m(erhead)h(in)d(formatting)h(or)0 3840 y(parsing)31 +b(the)h(ASCI)s(I)f(data)i(\014elds)e(and)h(b)s(ecause)g(ASCI)s(I)f +(tables)h(are)h(ab)s(out)f(t)m(wice)h(as)g(large)f(as)h(binary)d +(tables)0 3953 y(with)f(the)i(same)f(information)f(con)m(ten)m(t.)0 +4113 y(5.)64 b(Design)38 b(soft)m(w)m(are)h(so)g(that)f(it)g(reads)g +(the)g(FITS)f(header)h(k)m(eyw)m(ords)g(in)f(the)h(same)h(order)e(in)g +(whic)m(h)g(they)0 4226 y(o)s(ccur)28 b(in)g(the)h(\014le.)39 +b(When)28 b(reading)g(k)m(eyw)m(ords,)i(CFITSIO)d(searc)m(hes)i(forw)m +(ard)g(starting)f(from)g(the)h(p)s(osition)e(of)0 4339 +y(the)i(last)h(k)m(eyw)m(ord)f(that)h(w)m(as)g(read.)40 +b(If)29 b(it)f(reac)m(hes)j(the)e(end)g(of)g(the)h(header)f(without)f +(\014nding)f(the)i(k)m(eyw)m(ord,)h(it)0 4452 y(then)j(go)s(es)h(bac)m +(k)g(to)h(the)e(start)h(of)g(the)g(header)f(and)g(con)m(tin)m(ues)g +(the)h(searc)m(h)g(do)m(wn)f(to)h(the)g(p)s(osition)d(where)i(it)0 +4565 y(started.)41 b(In)30 b(practice,)h(as)f(long)g(as)h(the)f(en)m +(tire)h(FITS)e(header)h(can)h(\014t)f(at)h(one)g(time)f(in)f(the)h(a)m +(v)-5 b(ailable)30 b(in)m(ternal)0 4678 y(IO)36 b(bu\013ers,)h(then)f +(the)g(header)g(k)m(eyw)m(ord)h(access)g(will)d(b)s(e)i(v)m(ery)g(fast) +h(and)f(it)f(mak)m(es)i(little)e(di\013erence)h(whic)m(h)0 +4791 y(order)30 b(they)g(are)h(accessed.)0 4951 y(6.)40 +b(Av)m(oid)28 b(the)f(use)h(of)f(scaling)g(\(b)m(y)h(using)e(the)i +(BSCALE)e(and)h(BZER)m(O)h(or)f(TSCAL)g(and)g(TZER)m(O)f(k)m(eyw)m +(ords\))0 5064 y(in)34 b(FITS)g(\014les)f(since)i(the)g(scaling)f(op)s +(erations)g(add)g(to)i(the)f(pro)s(cessing)e(time)i(needed)f(to)i(read) +f(or)g(write)f(the)0 5176 y(data.)39 b(In)24 b(some)h(cases)h(it)e(ma)m +(y)h(b)s(e)f(more)g(e\016cien)m(t)h(to)h(temp)s(orarily)c(turn)i(o\013) +h(the)f(scaling)g(\(using)f(\014ts)p 3490 5176 V 33 w(set)p +3634 5176 V 33 w(bscale)0 5289 y(or)30 b(\014ts)p 238 +5289 V 33 w(set)p 382 5289 V 33 w(tscale\))i(and)d(then)h(read)h(or)f +(write)g(the)g(ra)m(w)h(unscaled)e(v)-5 b(alues)30 b(in)f(the)h(FITS)g +(\014le.)0 5450 y(7.)77 b(Av)m(oid)42 b(using)f(the)i(`implicit)c(data) +44 b(t)m(yp)s(e)e(con)m(v)m(ersion')h(capabilit)m(y)e(in)g(CFITSIO.)g +(F)-8 b(or)44 b(instance,)h(when)0 5562 y(reading)27 +b(a)h(FITS)f(image)h(with)e(BITPIX)i(=)f(-32)i(\(32-bit)f(\015oating)g +(p)s(oin)m(t)f(pixels\),)g(read)g(the)h(data)g(in)m(to)g(a)g(single)0 +5675 y(precision)38 b(\015oating)i(p)s(oin)m(t)f(data)i(arra)m(y)f(in)f +(the)h(program.)69 b(F)-8 b(orcing)40 b(CFITSIO)f(to)i(con)m(v)m(ert)g +(the)f(data)h(to)g(a)p eop +%%Page: 146 154 +146 153 bop 0 299 a Fj(146)1876 b Fh(CHAPTER)30 b(13.)112 +b(OPTIMIZING)29 b(PR)m(OGRAMS)0 555 y Fj(di\013eren)m(t)h(data)h(t)m +(yp)s(e)f(can)h(slo)m(w)f(the)h(program.)0 715 y(8.)57 +b(Where)36 b(feasible,)g(design)f(FITS)g(binary)f(tables)h(using)f(v)m +(ector)k(column)c(elemen)m(ts)i(so)g(that)g(the)g(data)h(are)0 +828 y(written)29 b(as)h(a)g(con)m(tiguous)g(set)g(of)g(b)m(ytes,)g +(rather)g(than)f(as)h(single)e(elemen)m(ts)i(in)f(m)m(ultiple)e(ro)m +(ws.)41 b(F)-8 b(or)30 b(example,)0 941 y(it)35 b(is)g(faster)h(to)g +(access)h(the)f(data)h(in)d(a)i(table)g(that)g(con)m(tains)g(a)g +(single)e(ro)m(w)i(and)f(2)h(columns)e(with)h(TF)m(ORM)0 +1054 y(k)m(eyw)m(ords)e(equal)g(to)h('10000E')h(and)e('10000J',)j(than) +d(it)f(is)g(to)i(access)g(the)g(same)f(amoun)m(t)h(of)f(data)h(in)e(a)h +(table)0 1167 y(with)39 b(10000)k(ro)m(ws)d(whic)m(h)g(has)g(columns)f +(with)g(the)i(TF)m(ORM)g(k)m(eyw)m(ords)g(equal)f(to)h('1E')h(and)e +('1J'.)h(In)f(the)0 1280 y(former)27 b(case)i(the)f(10000)i(\015oating) +e(p)s(oin)m(t)f(v)-5 b(alues)27 b(in)g(the)h(\014rst)f(column)g(are)h +(all)f(written)g(in)f(a)i(con)m(tiguous)g(blo)s(c)m(k)0 +1393 y(of)e(the)f(\014le)g(whic)m(h)f(can)i(b)s(e)f(read)g(or)g +(written)g(quic)m(kly)-8 b(,)26 b(whereas)f(in)f(the)i(second)f(case)i +(eac)m(h)g(\015oating)e(p)s(oin)m(t)f(v)-5 b(alue)0 1506 +y(in)33 b(the)h(\014rst)f(column)f(is)h(in)m(terlea)m(v)m(ed)i(with)d +(the)i(in)m(teger)h(v)-5 b(alue)33 b(in)g(the)h(second)g(column)e(of)i +(the)g(same)h(ro)m(w)f(so)0 1619 y(CFITSIO)29 b(has)h(to)h(explicitly)d +(mo)m(v)m(e)k(to)f(the)g(p)s(osition)d(of)j(eac)m(h)g(elemen)m(t)g(to)g +(b)s(e)f(read)g(or)g(written.)0 1779 y(9.)52 b(Av)m(oid)34 +b(the)h(use)e(of)i(v)-5 b(ariable)32 b(length)i(v)m(ector)i(columns)c +(in)h(binary)g(tables,)i(since)e(an)m(y)i(reading)e(or)h(writing)0 +1892 y(of)f(these)g(data)g(requires)e(that)i(CFITSIO)f(\014rst)f(lo)s +(ok)i(up)e(or)i(compute)g(the)f(starting)h(address)f(of)g(eac)m(h)i(ro) +m(w)f(of)0 2005 y(data)e(in)e(the)i(heap.)0 2165 y(10.)73 +b(When)40 b(cop)m(ying)h(data)h(from)e(one)h(FITS)f(table)h(to)g +(another,)j(it)d(is)e(faster)j(to)f(transfer)g(the)f(ra)m(w)h(b)m(ytes) +0 2278 y(instead)27 b(of)i(reading)e(then)h(writing)e(eac)m(h)j(column) +e(of)h(the)g(table.)40 b(The)28 b(CFITSIO)e(routines)h(\014ts)p +3349 2278 28 4 v 33 w(read)p 3554 2278 V 32 w(tblb)m(ytes)0 +2391 y(and)36 b(\014ts)p 310 2391 V 32 w(write)p 545 +2391 V 32 w(tblb)m(ytes)h(will)d(p)s(erform)h(lo)m(w-lev)m(el)h(reads)h +(or)f(writes)g(of)h(an)m(y)g(con)m(tiguous)f(range)h(of)g(b)m(ytes)g +(in)0 2503 y(a)d(table)f(extension.)50 b(These)33 b(routines)g(can)g(b) +s(e)g(used)g(to)h(read)f(or)h(write)f(a)g(whole)g(ro)m(w)h(\(or)g(m)m +(ultiple)d(ro)m(ws)i(for)0 2616 y(ev)m(en)e(greater)h(e\016ciency\))g +(of)f(a)g(table)g(with)e(a)i(single)f(function)f(call.)41 +b(These)31 b(routines)f(are)h(fast)g(b)s(ecause)g(they)0 +2729 y(b)m(ypass)36 b(all)f(the)i(usual)e(data)i(scaling,)g(error)f(c)m +(hec)m(king)h(and)f(mac)m(hine)g(dep)s(enden)m(t)f(data)i(con)m(v)m +(ersion)g(that)g(is)0 2842 y(normally)e(done)i(b)m(y)f(CFITSIO,)g(and)g +(they)h(allo)m(w)f(the)i(program)e(to)i(write)e(the)h(data)g(to)h(the)f +(output)f(\014le)g(in)0 2955 y(exactly)29 b(the)f(same)h(b)m(yte)g +(order.)40 b(F)-8 b(or)29 b(these)f(same)h(reasons,)g(these)g(routines) +e(can)h(corrupt)g(the)g(FITS)g(data)h(\014le)0 3068 y(if)35 +b(used)f(incorrectly)h(b)s(ecause)h(no)f(v)-5 b(alidation)34 +b(or)i(mac)m(hine)f(dep)s(enden)m(t)f(con)m(v)m(ersion)i(is)f(p)s +(erformed)f(b)m(y)h(these)0 3181 y(routines.)54 b(These)35 +b(routines)f(are)i(only)e(recommended)h(for)g(optimizing)e(critical)h +(pieces)h(of)h(co)s(de)f(and)g(should)0 3294 y(only)d(b)s(e)h(used)g(b) +m(y)g(programmers)g(who)g(thoroughly)f(understand)f(the)j(in)m(ternal)e +(format)i(of)f(the)h(FITS)e(tables)0 3407 y(they)f(are)f(reading)g(or)g +(writing.)0 3567 y(11.)41 b(Another)30 b(strategy)g(for)g(impro)m(ving) +d(the)j(sp)s(eed)e(of)i(writing)e(a)h(FITS)g(table,)h(similar)d(to)j +(the)f(previous)f(one,)0 3680 y(is)j(to)h(directly)f(construct)h(the)f +(en)m(tire)h(b)m(yte)g(stream)g(for)g(a)g(whole)f(table)g(ro)m(w)h +(\(or)g(m)m(ultiple)e(ro)m(ws\))i(within)d(the)0 3793 +y(application)f(program)h(and)g(then)h(write)f(it)g(to)h(the)g(FITS)f +(\014le)g(with)f(\014ts)p 2520 3793 V 32 w(write)p 2755 +3793 V 32 w(tblb)m(ytes.)40 b(This)28 b(a)m(v)m(oids)i(all)f(the)0 +3906 y(o)m(v)m(erhead)h(normally)e(presen)m(t)h(in)f(the)i +(column-orien)m(ted)e(CFITSIO)g(write)g(routines.)39 +b(This)28 b(tec)m(hnique)h(should)0 4019 y(only)34 b(b)s(e)f(used)h +(for)g(critical)f(applications)g(b)s(ecause)h(it)g(mak)m(es)i(the)e(co) +s(de)h(more)f(di\016cult)f(to)i(understand)e(and)0 4131 +y(main)m(tain,)j(and)f(it)g(mak)m(es)h(the)g(co)s(de)f(more)h(system)g +(dep)s(enden)m(t)e(\(e.g.,)39 b(do)c(the)h(b)m(ytes)g(need)f(to)h(b)s +(e)f(sw)m(app)s(ed)0 4244 y(b)s(efore)30 b(writing)e(to)j(the)g(FITS)f +(\014le?\).)0 4405 y(12.)53 b(Finally)-8 b(,)34 b(external)g(factors)i +(suc)m(h)e(as)g(the)h(t)m(yp)s(e)f(of)h(magnetic)f(disk)f(con)m +(troller)h(\(SCSI)f(or)i(IDE\),)g(the)f(size)0 4517 y(of)h(the)g(disk)f +(cac)m(he,)k(the)d(a)m(v)m(erage)i(seek)f(sp)s(eed)e(of)h(the)g(disk,)g +(the)g(amoun)m(t)h(of)f(disk)e(fragmen)m(tation,)k(and)e(the)0 +4630 y(amoun)m(t)29 b(of)g(RAM)f(a)m(v)-5 b(ailable)28 +b(on)h(the)f(system)h(can)g(all)e(ha)m(v)m(e)j(a)f(signi\014can)m(t)e +(impact)i(on)f(o)m(v)m(erall)h(I/O)f(e\016ciency)-8 b(.)0 +4743 y(F)g(or)36 b(critical)e(applications,)g(a)i(system)f +(administrator)e(should)g(review)h(the)i(prop)s(osed)d(system)j(hardw)m +(are)e(to)0 4856 y(iden)m(tify)29 b(an)m(y)i(p)s(oten)m(tial)e(I/O)i(b) +s(ottlenec)m(ks.)p eop +%%Page: 147 155 +147 154 bop 0 1225 a Fg(App)5 b(endix)65 b(A)0 1687 y +Fm(Index)77 b(of)h(Routines)50 2154 y Fj(\014ts)p 177 +2154 28 4 v 32 w(add)p 356 2154 V 32 w(group)p 616 2154 +V 33 w(mem)m(b)s(er)144 b(78)50 2267 y(\014ts)p 177 2267 +V 32 w(ascii)p 382 2267 V 32 w(tform)478 b(59)50 2380 +y(\014ts)p 177 2380 V 32 w(binary)p 466 2380 V 31 w(tform)395 +b(59)50 2493 y(\014ts)p 177 2493 V 32 w(calculator)514 +b(52)50 2606 y(\014ts)p 177 2606 V 32 w(calculator)p +598 2606 V 33 w(rng)349 b(53)50 2719 y(\014ts)p 177 2719 +V 32 w(calc)p 360 2719 V 34 w(ro)m(ws)538 b(52)50 2832 +y(\014ts)p 177 2832 V 32 w(c)m(hange)p 478 2832 V 34 +w(group)372 b(76)50 2945 y(\014ts)p 177 2945 V 32 w(clear)p +396 2945 V 33 w(errmark)366 b(30)50 3057 y(\014ts)p 177 +3057 V 32 w(clear)p 396 3057 V 33 w(errmsg)414 b(30)50 +3170 y(\014ts)p 177 3170 V 32 w(close)p 396 3170 V 33 +w(\014le)566 b(33)50 3283 y(\014ts)p 177 3283 V 32 w(compact)p +541 3283 V 34 w(group)309 b(77)50 3396 y(\014ts)p 177 +3396 V 32 w(compare)p 542 3396 V 34 w(str)429 b(56)50 +3509 y(\014ts)p 177 3509 V 32 w(compress)p 569 3509 V +33 w(heap)278 b(100)50 3622 y(\014ts)p 177 3622 V 32 +w(cop)m(y)p 390 3622 V 34 w(col)577 b(49)50 3735 y(\014ts)p +177 3735 V 32 w(cop)m(y)p 390 3735 V 34 w(data)512 b(86)50 +3848 y(\014ts)p 177 3848 V 32 w(cop)m(y)p 390 3848 V +34 w(\014le)571 b(34)50 3961 y(\014ts)p 177 3961 V 32 +w(cop)m(y)p 390 3961 V 34 w(group)460 b(77)50 4074 y(\014ts)p +177 4074 V 32 w(cop)m(y)p 390 4074 V 34 w(hdu)535 b(34)50 +4187 y(\014ts)p 177 4187 V 32 w(cop)m(y)p 390 4187 V +34 w(header)425 b(34)50 4299 y(\014ts)p 177 4299 V 32 +w(cop)m(y)p 390 4299 V 34 w(k)m(ey)555 b(89)50 4412 y(\014ts)p +177 4412 V 32 w(cop)m(y)p 390 4412 V 34 w(mem)m(b)s(er)369 +b(79)50 4525 y(\014ts)p 177 4525 V 32 w(create)p 445 +4525 V 35 w(disk\014le)354 b(32)50 4638 y(\014ts)p 177 +4638 V 32 w(create)p 445 4638 V 35 w(\014le)515 b(32)50 +4751 y(\014ts)p 177 4751 V 32 w(create)p 445 4751 V 35 +w(group)404 b(76)50 4864 y(\014ts)p 177 4864 V 32 w(create)p +445 4864 V 35 w(hdu)479 b(84)50 4977 y(\014ts)p 177 4977 +V 32 w(create)p 445 4977 V 35 w(img)485 b(40)50 5090 +y(\014ts)p 177 5090 V 32 w(create)p 445 5090 V 35 w(mem\014le)323 +b(82)50 5203 y(\014ts)p 177 5203 V 32 w(create)p 445 +5203 V 35 w(tbl)520 b(46)50 5316 y(\014ts)p 177 5316 +V 32 w(create)p 445 5316 V 35 w(template)284 b(82)50 +5429 y(\014ts)p 177 5429 V 32 w(date2str)580 b(55)50 +5541 y(\014ts)p 177 5541 V 32 w(deco)s(de)p 479 5541 +V 33 w(c)m(hksum)301 b(54)50 5654 y(\014ts)p 177 5654 +V 32 w(deco)s(de)p 479 5654 V 33 w(tdim)412 b(48)1325 +2154 y(\014ts)p 1452 2154 V 33 w(delete)p 1717 2154 V +33 w(col)565 b(49)1325 2267 y(\014ts)p 1452 2267 V 33 +w(delete)p 1717 2267 V 33 w(\014le)559 b(33)1325 2380 +y(\014ts)p 1452 2380 V 33 w(delete)p 1717 2380 V 33 w(hdu)523 +b(35)1325 2493 y(\014ts)p 1452 2493 V 33 w(delete)p 1717 +2493 V 33 w(k)m(ey)543 b(39)1325 2606 y(\014ts)p 1452 +2606 V 33 w(delete)p 1717 2606 V 33 w(record)428 b(39)1325 +2719 y(\014ts)p 1452 2719 V 33 w(delete)p 1717 2719 V +33 w(ro)m(wlist)409 b(48)1325 2832 y(\014ts)p 1452 2832 +V 33 w(delete)p 1717 2832 V 33 w(ro)m(wrange)315 b(48)1325 +2945 y(\014ts)p 1452 2945 V 33 w(delete)p 1717 2945 V +33 w(ro)m(ws)496 b(48)1325 3057 y(\014ts)p 1452 3057 +V 33 w(enco)s(de)p 1755 3057 V 33 w(c)m(hksum)339 b(54)1325 +3170 y(\014ts)p 1452 3170 V 33 w(\014le)p 1602 3170 V +32 w(exists)571 b(83)1325 3283 y(\014ts)p 1452 3283 V +33 w(\014le)p 1602 3283 V 32 w(mo)s(de)577 b(33)1325 +3396 y(\014ts)p 1452 3396 V 33 w(\014le)p 1602 3396 V +32 w(name)j(33)1325 3509 y(\014ts)p 1452 3509 V 33 w(\014nd)p +1638 3509 V 31 w(\014rst)p 1827 3509 V 32 w(ro)m(w)423 +b(52)1325 3622 y(\014ts)p 1452 3622 V 33 w(\014nd)p 1638 +3622 V 31 w(nextk)m(ey)450 b(36)1325 3735 y(\014ts)p +1452 3735 V 33 w(\014nd)p 1638 3735 V 31 w(ro)m(ws)577 +b(52)1325 3848 y(\014ts)p 1452 3848 V 33 w(\015ush)p +1674 3848 V 31 w(bu\013er)490 b(84)1325 3961 y(\014ts)p +1452 3961 V 33 w(\015ush)p 1674 3961 V 31 w(\014le)604 +b(84)1325 4074 y(\014ts)p 1452 4074 V 33 w(get)p 1605 +4074 V 34 w(acolparms)387 b(99)1325 4187 y(\014ts)p 1452 +4187 V 33 w(get)p 1605 4187 V 34 w(b)s(colparms)378 b(99)1325 +4299 y(\014ts)p 1452 4299 V 33 w(get)p 1605 4299 V 34 +w(c)m(hksum)488 b(54)1325 4412 y(\014ts)p 1452 4412 V +33 w(get)p 1605 4412 V 34 w(col)p 1750 4412 V 32 w(displa)m(y)p +2062 4412 V 31 w(width)104 b(48)1325 4525 y(\014ts)p +1452 4525 V 33 w(get)p 1605 4525 V 34 w(colname)464 b(46)1325 +4638 y(\014ts)p 1452 4638 V 33 w(get)p 1605 4638 V 34 +w(coln)m(um)501 b(46)1325 4751 y(\014ts)p 1452 4751 V +33 w(get)p 1605 4751 V 34 w(colt)m(yp)s(e)h(47)1325 4864 +y(\014ts)p 1452 4864 V 33 w(get)p 1605 4864 V 34 w(compression)p +2121 4864 V 31 w(t)m(yp)s(e)100 b(44)1325 4977 y(\014ts)p +1452 4977 V 33 w(get)p 1605 4977 V 34 w(eqcolt)m(yp)s(e)414 +b(47)1325 5090 y(\014ts)p 1452 5090 V 33 w(get)p 1605 +5090 V 34 w(errstatus)437 b(29)1325 5203 y(\014ts)p 1452 +5203 V 33 w(get)p 1605 5203 V 34 w(hdrp)s(os)514 b(86)1325 +5316 y(\014ts)p 1452 5316 V 33 w(get)p 1605 5316 V 34 +w(hdrspace)437 b(35)1325 5429 y(\014ts)p 1452 5429 V +33 w(get)p 1605 5429 V 34 w(hdu)p 1792 5429 V 31 w(n)m(um)428 +b(34)1325 5541 y(\014ts)p 1452 5541 V 33 w(get)p 1605 +5541 V 34 w(hdu)p 1792 5541 V 31 w(t)m(yp)s(e)h(34)1325 +5654 y(\014ts)p 1452 5654 V 33 w(get)p 1605 5654 V 34 +w(hduaddr)451 b(84)2639 2154 y(\014ts)p 2766 2154 V 33 +w(get)p 2919 2154 V 34 w(hduo\013)560 b(84)2639 2267 +y(\014ts)p 2766 2267 V 33 w(get)p 2919 2267 V 34 w(img)p +3100 2267 V 32 w(dim)479 b(40)2639 2380 y(\014ts)p 2766 +2380 V 33 w(get)p 2919 2380 V 34 w(img)p 3100 2380 V +32 w(equivt)m(yp)s(e)245 b(40)2639 2493 y(\014ts)p 2766 +2493 V 33 w(get)p 2919 2493 V 34 w(img)p 3100 2493 V +32 w(param)379 b(40)2639 2606 y(\014ts)p 2766 2606 V +33 w(get)p 2919 2606 V 34 w(img)p 3100 2606 V 32 w(size)490 +b(40)2639 2719 y(\014ts)p 2766 2719 V 33 w(get)p 2919 +2719 V 34 w(img)p 3100 2719 V 32 w(t)m(yp)s(e)458 b(40)2639 +2832 y(\014ts)p 2766 2832 V 33 w(get)p 2919 2832 V 34 +w(k)m(eyclass)495 b(58)2639 2945 y(\014ts)p 2766 2945 +V 33 w(get)p 2919 2945 V 34 w(k)m(eyname)466 b(57)2639 +3057 y(\014ts)p 2766 3057 V 33 w(get)p 2919 3057 V 34 +w(k)m(eyt)m(yp)s(e)504 b(58)2639 3170 y(\014ts)p 2766 +3170 V 33 w(get)p 2919 3170 V 34 w(noise)p 3151 3170 +V 32 w(bits)433 b(44)2639 3283 y(\014ts)p 2766 3283 V +33 w(get)p 2919 3283 V 34 w(n)m(um)p 3128 3283 V 32 w(cols)457 +b(46)2639 3396 y(\014ts)p 2766 3396 V 33 w(get)p 2919 +3396 V 34 w(n)m(um)p 3128 3396 V 32 w(groups)340 b(79)2639 +3509 y(\014ts)p 2766 3509 V 33 w(get)p 2919 3509 V 34 +w(n)m(um)p 3128 3509 V 32 w(hdus)415 b(33)2639 3622 y(\014ts)p +2766 3622 V 33 w(get)p 2919 3622 V 34 w(n)m(um)p 3128 +3622 V 32 w(mem)m(b)s(ers)249 b(78)2639 3735 y(\014ts)p +2766 3735 V 33 w(get)p 2919 3735 V 34 w(n)m(um)p 3128 +3735 V 32 w(ro)m(ws)424 b(46)2639 3848 y(\014ts)p 2766 +3848 V 33 w(get)p 2919 3848 V 34 w(ro)m(wsize)525 b(99)2639 +3961 y(\014ts)p 2766 3961 V 33 w(get)p 2919 3961 V 34 +w(system)p 3224 3961 V 33 w(time)330 b(55)2639 4074 y(\014ts)p +2766 4074 V 33 w(get)p 2919 4074 V 34 w(tile)p 3080 4074 +V 32 w(dim)499 b(44)2639 4187 y(\014ts)p 2766 4187 V +33 w(get)p 2919 4187 V 34 w(tb)s(col)611 b(59)2639 4299 +y(\014ts)p 2766 4299 V 33 w(get)p 2919 4299 V 34 w(v)m(ersion)532 +b(56)2639 4412 y(\014ts)p 2766 4412 V 33 w(hdr2str)d(37,)31 +b(72)2639 4525 y(\014ts)p 2766 4525 V 33 w(insert)p 3023 +4525 V 31 w(atbl)553 b(85)2639 4638 y(\014ts)p 2766 4638 +V 33 w(insert)p 3023 4638 V 31 w(btbl)547 b(85)2639 4751 +y(\014ts)p 2766 4751 V 33 w(insert)p 3023 4751 V 31 w(col)599 +b(49)2639 4864 y(\014ts)p 2766 4864 V 33 w(insert)p 3023 +4864 V 31 w(cols)563 b(49)2639 4977 y(\014ts)p 2766 4977 +V 33 w(insert)p 3023 4977 V 31 w(group)482 b(76)2639 +5090 y(\014ts)p 2766 5090 V 33 w(insert)p 3023 5090 V +31 w(img)563 b(85)2639 5203 y(\014ts)p 2766 5203 V 33 +w(insert)p 3023 5203 V 31 w(k)m(ey)p 3187 5203 V 34 w(n)m(ull)392 +b(91)2639 5316 y(\014ts)p 2766 5316 V 33 w(insert)p 3023 +5316 V 31 w(k)m(ey)p 3187 5316 V 34 w(TYP)347 b(90)2639 +5429 y(\014ts)p 2766 5429 V 33 w(insert)p 3023 5429 V +31 w(record)462 b(90)2639 5541 y(\014ts)p 2766 5541 V +33 w(insert)p 3023 5541 V 31 w(ro)m(ws)530 b(48)2639 +5654 y(\014ts)p 2766 5654 V 33 w(iterate)p 3056 5654 +V 33 w(data)499 b(69)1882 5942 y(147)p eop +%%Page: 148 156 +148 155 bop 0 299 a Fj(148)2084 b Fh(APPENDIX)31 b(A.)61 +b(INDEX)31 b(OF)f(R)m(OUTINES)50 599 y Fj(\014ts)p 177 +599 28 4 v 32 w(mak)m(e)p 415 599 V 34 w(k)m(eyn)421 +b(57)50 712 y(\014ts)p 177 712 V 32 w(mak)m(e)p 415 712 +V 34 w(nk)m(ey)g(58)50 825 y(\014ts)p 177 825 V 32 w(merge)p +446 825 V 34 w(groups)310 b(77)50 938 y(\014ts)p 177 +938 V 32 w(mo)s(dify)p 486 938 V 31 w(card)365 b(92)50 +1051 y(\014ts)p 177 1051 V 32 w(mo)s(dify)p 486 1051 +V 31 w(commen)m(t)177 b(38)50 1164 y(\014ts)p 177 1164 +V 32 w(mo)s(dify)p 486 1164 V 31 w(k)m(ey)p 650 1164 +V 34 w(n)m(ull)219 b(93)50 1277 y(\014ts)p 177 1277 V +32 w(mo)s(dify)p 486 1277 V 31 w(k)m(ey)p 650 1277 V +34 w(TYP)174 b(93)50 1390 y(\014ts)p 177 1390 V 32 w(mo)s(dify)p +486 1390 V 31 w(name)325 b(39)50 1503 y(\014ts)p 177 +1503 V 32 w(mo)s(dify)p 486 1503 V 31 w(record)289 b(92)50 +1616 y(\014ts)p 177 1616 V 32 w(mo)s(dify)p 486 1616 +V 31 w(v)m(ector)p 758 1616 V 35 w(len)144 b(49)50 1728 +y(\014ts)p 177 1728 V 32 w(mo)m(v)-5 b(abs)p 502 1728 +V 33 w(hdu)366 b(33)50 1841 y(\014ts)p 177 1841 V 32 +w(mo)m(vnam)p 547 1841 V 33 w(hdu)321 b(33)50 1954 y(\014ts)p +177 1954 V 32 w(mo)m(vrel)p 477 1954 V 33 w(hdu)391 b(33)50 +2067 y(\014ts)p 177 2067 V 32 w(n)m(ull)p 360 2067 V +31 w(c)m(hec)m(k)450 b(57)50 2180 y(\014ts)p 177 2180 +V 32 w(op)s(en)p 399 2180 V 32 w(data)d(30)50 2293 y(\014ts)p +177 2293 V 32 w(op)s(en)p 399 2293 V 32 w(disk\014le)345 +b(30)50 2406 y(\014ts)p 177 2406 V 32 w(op)s(en)p 399 +2406 V 32 w(\014le)506 b(30)50 2519 y(\014ts)p 177 2519 +V 32 w(op)s(en)p 399 2519 V 32 w(image)391 b(30)50 2632 +y(\014ts)p 177 2632 V 32 w(op)s(en)p 399 2632 V 32 w(table)426 +b(30)50 2745 y(\014ts)p 177 2745 V 32 w(op)s(en)p 399 +2745 V 32 w(group)395 b(78)50 2858 y(\014ts)p 177 2858 +V 32 w(op)s(en)p 399 2858 V 32 w(mem)m(b)s(er)304 b(79)50 +2970 y(\014ts)p 177 2970 V 32 w(op)s(en)p 399 2970 V +32 w(mem\014le)314 b(81)50 3083 y(\014ts)p 177 3083 V +32 w(parse)p 417 3083 V 33 w(extn)m(um)306 b(83)50 3196 +y(\014ts)p 177 3196 V 32 w(parse)p 417 3196 V 33 w(input)p +664 3196 V 31 w(url)246 b(82)50 3309 y(\014ts)p 177 3309 +V 32 w(parse)p 417 3309 V 33 w(range)387 b(61)50 3422 +y(\014ts)p 177 3422 V 32 w(parse)p 417 3422 V 33 w(ro)s(otname)228 +b(83)50 3535 y(\014ts)p 177 3535 V 32 w(parse)p 417 3535 +V 33 w(template)256 b(59)50 3648 y(\014ts)p 177 3648 +V 32 w(parse)p 417 3648 V 33 w(v)-5 b(alue)399 b(57)50 +3761 y(\014ts)p 177 3761 V 32 w(pix)p 334 3761 V 32 w(to)p +446 3761 V 33 w(w)m(orld)354 b(73)50 3874 y(\014ts)p +177 3874 V 32 w(read)p 381 3874 V 33 w(2d)p 510 3874 +V 33 w(TYP)315 b(98)50 3987 y(\014ts)p 177 3987 V 32 +w(read)p 381 3987 V 33 w(3d)p 510 3987 V 33 w(TYP)g(98)50 +4100 y(\014ts)p 177 4100 V 32 w(read)p 381 4100 V 33 +w(atblhdr)345 b(87)50 4212 y(\014ts)p 177 4212 V 32 w(read)p +381 4212 V 33 w(btblhdr)339 b(87)50 4325 y(\014ts)p 177 +4325 V 32 w(read)p 381 4325 V 33 w(card)468 b(36)50 4438 +y(\014ts)p 177 4438 V 32 w(read)p 381 4438 V 33 w(col)529 +b(51)50 4551 y(\014ts)p 177 4551 V 32 w(read)p 381 4551 +V 33 w(col)p 525 4551 V 33 w(bit)p 670 4551 V 338 w(104)50 +4664 y(\014ts)p 177 4664 V 32 w(read)p 381 4664 V 33 +w(col)p 525 4664 V 33 w(TYP)254 b(102)50 4777 y(\014ts)p +177 4777 V 32 w(read)p 381 4777 V 33 w(coln)m(ull)378 +b(51)50 4890 y(\014ts)p 177 4890 V 32 w(read)p 381 4890 +V 33 w(coln)m(ull)p 676 4890 V 31 w(TYP)105 b(103)50 +5003 y(\014ts)p 177 5003 V 32 w(read)p 381 5003 V 33 +w(descript)279 b(104)50 5116 y(\014ts)p 177 5116 V 32 +w(read)p 381 5116 V 33 w(descripts)243 b(104)50 5229 +y(\014ts)p 177 5229 V 32 w(read)p 381 5229 V 33 w(errmsg)371 +b(30)50 5342 y(\014ts)p 177 5342 V 32 w(read)p 381 5342 +V 33 w(grppar)p 678 5342 V 32 w(TYP)148 b(98)50 5454 +y(\014ts)p 177 5454 V 32 w(read)p 381 5454 V 33 w(img)493 +b(97)50 5567 y(\014ts)p 177 5567 V 32 w(read)p 381 5567 +V 33 w(img)p 561 5567 V 32 w(co)s(ord)241 b(72)50 5680 +y(\014ts)p 177 5680 V 32 w(read)p 381 5680 V 33 w(img)p +561 5680 V 32 w(TYP)265 b(97)50 5793 y(\014ts)p 177 5793 +V 32 w(read)p 381 5793 V 33 w(imghdr)355 b(87)1260 543 +y(\014ts)p 1387 543 V 32 w(read)p 1591 543 V 33 w(imgn)m(ull)596 +b(97)1260 656 y(\014ts)p 1387 656 V 32 w(read)p 1591 +656 V 33 w(imgn)m(ull)p 1922 656 V 30 w(TYP)370 b(97)1260 +769 y(\014ts)p 1387 769 V 32 w(read)p 1591 769 V 33 w(k)m(ey)761 +b(36)1260 882 y(\014ts)p 1387 882 V 32 w(read)p 1591 +882 V 33 w(k)m(ey)p 1757 882 V 33 w(longstr)454 b(91)1260 +995 y(\014ts)p 1387 995 V 32 w(read)p 1591 995 V 33 w(k)m(ey)p +1757 995 V 33 w(triple)514 b(92)1260 1107 y(\014ts)p +1387 1107 V 32 w(read)p 1591 1107 V 33 w(k)m(ey)p 1757 +1107 V 33 w(unit)565 b(37)1260 1220 y(\014ts)p 1387 1220 +V 32 w(read)p 1591 1220 V 33 w(k)m(ey)p 1757 1220 V 33 +w(TYP)532 b(91)1260 1333 y(\014ts)p 1387 1333 V 32 w(read)p +1591 1333 V 33 w(k)m(eyn)710 b(36)1260 1446 y(\014ts)p +1387 1446 V 32 w(read)p 1591 1446 V 33 w(k)m(eys)p 1793 +1446 V 33 w(TYP)496 b(92)1260 1559 y(\014ts)p 1387 1559 +V 32 w(read)p 1591 1559 V 33 w(k)m(eyw)m(ord)566 b(36)1260 +1672 y(\014ts)p 1387 1672 V 32 w(read)p 1591 1672 V 33 +w(pix)769 b(42)1260 1785 y(\014ts)p 1387 1785 V 32 w(read)p +1591 1785 V 33 w(pixn)m(ull)618 b(42)1260 1898 y(\014ts)p +1387 1898 V 32 w(read)p 1591 1898 V 33 w(record)646 b(36)1260 +2011 y(\014ts)p 1387 2011 V 32 w(read)p 1591 2011 V 33 +w(subset)p 1873 2011 V 32 w(TYP)250 b(98)31 b(103)1260 +2124 y(\014ts)p 1387 2124 V 32 w(read)p 1591 2124 V 33 +w(subsetn)m(ull)p 2024 2124 V 30 w(TYP)101 b(98)31 b(103)1260 +2237 y(\014ts)p 1387 2237 V 32 w(read)p 1591 2237 V 33 +w(tbl)p 1736 2237 V 32 w(co)s(ord)530 b(72)1260 2349 +y(\014ts)p 1387 2349 V 32 w(read)p 1591 2349 V 33 w(tblb)m(ytes)f(100) +1260 2462 y(\014ts)p 1387 2462 V 32 w(read)p 1591 2462 +V 33 w(tdim)706 b(48)1260 2575 y(\014ts)p 1387 2575 V +32 w(remo)m(v)m(e)p 1698 2575 V 34 w(group)558 b(77)1260 +2688 y(\014ts)p 1387 2688 V 32 w(remo)m(v)m(e)p 1698 +2688 V 34 w(mem)m(b)s(er)467 b(79)1260 2801 y(\014ts)p +1387 2801 V 32 w(reop)s(en)p 1685 2801 V 32 w(\014le)684 +b(82)1260 2914 y(\014ts)p 1387 2914 V 32 w(rep)s(ort)p +1665 2914 V 32 w(error)628 b(30)1260 3027 y(\014ts)p +1387 3027 V 32 w(resize)p 1637 3027 V 33 w(img)701 b(85)1260 +3140 y(\014ts)p 1387 3140 V 32 w(select)p 1636 3140 V +33 w(ro)m(ws)669 b(52)1260 3253 y(\014ts)p 1387 3253 +V 32 w(set)p 1530 3253 V 33 w(atbln)m(ull)647 b(95)1260 +3366 y(\014ts)p 1387 3366 V 32 w(set)p 1530 3366 V 33 +w(bscale)717 b(94)1260 3479 y(\014ts)p 1387 3479 V 32 +w(set)p 1530 3479 V 33 w(btbln)m(ull)641 b(95)1260 3591 +y(\014ts)p 1387 3591 V 32 w(set)p 1530 3591 V 33 w(compression)p +2045 3591 V 32 w(t)m(yp)s(e)267 b(44)1260 3704 y(\014ts)p +1387 3704 V 32 w(set)p 1530 3704 V 33 w(hdrsize)675 b(86)1260 +3817 y(\014ts)p 1387 3817 V 32 w(set)p 1530 3817 V 33 +w(hdustruc)604 b(86)1260 3930 y(\014ts)p 1387 3930 V +32 w(set)p 1530 3930 V 33 w(imgn)m(ull)657 b(95)1260 +4043 y(\014ts)p 1387 4043 V 32 w(set)p 1530 4043 V 33 +w(noise)p 1761 4043 V 33 w(bits)576 b(44)1260 4156 y(\014ts)p +1387 4156 V 32 w(set)p 1530 4156 V 33 w(tile)p 1690 4156 +V 32 w(dim)643 b(44)1260 4269 y(\014ts)p 1387 4269 V +32 w(set)p 1530 4269 V 33 w(tscale)733 b(94)1260 4382 +y(\014ts)p 1387 4382 V 32 w(split)p 1593 4382 V 31 w(names)646 +b(56)1260 4495 y(\014ts)p 1387 4495 V 32 w(str2date)776 +b(55)1260 4608 y(\014ts)p 1387 4608 V 32 w(str2time)770 +b(55)1260 4721 y(\014ts)p 1387 4721 V 32 w(test)p 1565 +4721 V 34 w(expr)744 b(53)1260 4833 y(\014ts)p 1387 4833 +V 32 w(test)p 1565 4833 V 34 w(heap)686 b(100)1260 4946 +y(\014ts)p 1387 4946 V 32 w(test)p 1565 4946 V 34 w(k)m(eyw)m(ord)591 +b(57)1260 5059 y(\014ts)p 1387 5059 V 32 w(test)p 1565 +5059 V 34 w(record)671 b(57)1260 5172 y(\014ts)p 1387 +5172 V 32 w(time2str)770 b(55)1260 5285 y(\014ts)p 1387 +5285 V 32 w(transfer)p 1726 5285 V 32 w(mem)m(b)s(er)441 +b(79)1260 5398 y(\014ts)p 1387 5398 V 32 w(up)s(date)p +1695 5398 V 32 w(card)619 b(38)1260 5511 y(\014ts)p 1387 +5511 V 32 w(up)s(date)p 1695 5511 V 32 w(c)m(hksum)492 +b(54)1260 5624 y(\014ts)p 1387 5624 V 32 w(up)s(date)p +1695 5624 V 32 w(k)m(ey)658 b(37)1260 5737 y(\014ts)p +1387 5737 V 32 w(up)s(date)p 1695 5737 V 32 w(k)m(ey)p +1860 5737 V 34 w(n)m(ull)473 b(38)1260 5850 y(\014ts)p +1387 5850 V 32 w(up)s(date)p 1695 5850 V 32 w(k)m(ey)p +1860 5850 V 34 w(TYP)428 b(93)2723 543 y(\014ts)p 2850 +543 V 33 w(upp)s(ercase)515 b(56)2723 656 y(\014ts)p +2850 656 V 33 w(url)p 2996 656 V 31 w(t)m(yp)s(e)590 +b(33)2723 769 y(\014ts)p 2850 769 V 33 w(v)m(erify)p +3106 769 V 32 w(c)m(hksum)354 b(54)2723 882 y(\014ts)p +2850 882 V 33 w(v)m(erify)p 3106 882 V 32 w(group)425 +b(78)2723 995 y(\014ts)p 2850 995 V 33 w(w)m(orld)p 3104 +995 V 32 w(to)p 3216 995 V 33 w(pix)417 b(73)2723 1107 +y(\014ts)p 2850 1107 V 33 w(write)p 3086 1107 V 32 w(2d)p +3214 1107 V 33 w(TYP)348 b(97)2723 1220 y(\014ts)p 2850 +1220 V 33 w(write)p 3086 1220 V 32 w(3d)p 3214 1220 V +33 w(TYP)g(97)2723 1333 y(\014ts)p 2850 1333 V 33 w(write)p +3086 1333 V 32 w(atblhdr)378 b(87)2723 1446 y(\014ts)p +2850 1446 V 33 w(write)p 3086 1446 V 32 w(btblhdr)372 +b(87)2723 1559 y(\014ts)p 2850 1559 V 33 w(write)p 3086 +1559 V 32 w(c)m(hksum)i(53)2723 1672 y(\014ts)p 2850 +1672 V 33 w(write)p 3086 1672 V 32 w(col)562 b(50)2723 +1785 y(\014ts)p 2850 1785 V 33 w(write)p 3086 1785 V +32 w(col)p 3229 1785 V 33 w(bit)371 b(101)2723 1898 y(\014ts)p +2850 1898 V 33 w(write)p 3086 1898 V 32 w(col)p 3229 +1898 V 33 w(TYP)287 b(100)2723 2011 y(\014ts)p 2850 2011 +V 33 w(write)p 3086 2011 V 32 w(col)p 3229 2011 V 33 +w(n)m(ull)378 b(50)2723 2124 y(\014ts)p 2850 2124 V 33 +w(write)p 3086 2124 V 32 w(coln)m(ull)411 b(50)2723 2237 +y(\014ts)p 2850 2237 V 33 w(write)p 3086 2237 V 32 w(coln)m(ull)p +3380 2237 V 31 w(TYP)138 b(101)2723 2349 y(\014ts)p 2850 +2349 V 33 w(write)p 3086 2349 V 32 w(commen)m(t)313 b(38)2723 +2462 y(\014ts)p 2850 2462 V 33 w(write)p 3086 2462 V +32 w(date)502 b(38)2723 2575 y(\014ts)p 2850 2575 V 33 +w(write)p 3086 2575 V 32 w(descript)312 b(102)2723 2688 +y(\014ts)p 2850 2688 V 33 w(write)p 3086 2688 V 32 w(errmark)356 +b(30)2723 2801 y(\014ts)p 2850 2801 V 33 w(write)p 3086 +2801 V 32 w(errmsg)404 b(56)2723 2914 y(\014ts)p 2850 +2914 V 33 w(write)p 3086 2914 V 32 w(grphdr)f(87)2723 +3027 y(\014ts)p 2850 3027 V 33 w(write)p 3086 3027 V +32 w(grppar)p 3382 3027 V 32 w(TYP)181 b(97)2723 3140 +y(\014ts)p 2850 3140 V 33 w(write)p 3086 3140 V 32 w(history)396 +b(38)2723 3253 y(\014ts)p 2850 3253 V 33 w(write)p 3086 +3253 V 32 w(img)526 b(96)2723 3366 y(\014ts)p 2850 3366 +V 33 w(write)p 3086 3366 V 32 w(img)p 3265 3366 V 32 +w(n)m(ull)343 b(97)2723 3479 y(\014ts)p 2850 3479 V 33 +w(write)p 3086 3479 V 32 w(img)p 3265 3479 V 32 w(TYP)298 +b(96)2723 3591 y(\014ts)p 2850 3591 V 33 w(write)p 3086 +3591 V 32 w(imghdr)388 b(87)2723 3704 y(\014ts)p 2850 +3704 V 33 w(write)p 3086 3704 V 32 w(imgn)m(ull)375 b(96)2723 +3817 y(\014ts)p 2850 3817 V 33 w(write)p 3086 3817 V +32 w(imgn)m(ull)p 3416 3817 V 30 w(TYP)149 b(96)2723 +3930 y(\014ts)p 2850 3930 V 33 w(write)p 3086 3930 V +32 w(k)m(ey)540 b(37)2723 4043 y(\014ts)p 2850 4043 V +33 w(write)p 3086 4043 V 32 w(k)m(ey)p 3251 4043 V 33 +w(longstr)233 b(89)2723 4156 y(\014ts)p 2850 4156 V 33 +w(write)p 3086 4156 V 32 w(k)m(ey)p 3251 4156 V 33 w(longw)m(arn)145 +b(89)2723 4269 y(\014ts)p 2850 4269 V 33 w(write)p 3086 +4269 V 32 w(k)m(ey)p 3251 4269 V 33 w(n)m(ull)356 b(38)2723 +4382 y(\014ts)p 2850 4382 V 33 w(write)p 3086 4382 V +32 w(k)m(ey)p 3251 4382 V 33 w(template)159 b(90)2723 +4495 y(\014ts)p 2850 4495 V 33 w(write)p 3086 4495 V +32 w(k)m(ey)p 3251 4495 V 33 w(triple)293 b(90)2723 4608 +y(\014ts)p 2850 4608 V 33 w(write)p 3086 4608 V 32 w(k)m(ey)p +3251 4608 V 33 w(unit)344 b(39)2723 4721 y(\014ts)p 2850 +4721 V 33 w(write)p 3086 4721 V 32 w(k)m(ey)p 3251 4721 +V 33 w(TYP)311 b(88)2723 4833 y(\014ts)p 2850 4833 V +33 w(write)p 3086 4833 V 32 w(k)m(eys)p 3287 4833 V 33 +w(TYP)275 b(89)2723 4946 y(\014ts)p 2850 4946 V 33 w(write)p +3086 4946 V 32 w(n)m(ull)p 3269 4946 V 31 w(img)344 b(41)2723 +5059 y(\014ts)p 2850 5059 V 33 w(write)p 3086 5059 V +32 w(pix)548 b(41)2723 5172 y(\014ts)p 2850 5172 V 33 +w(write)p 3086 5172 V 32 w(pixn)m(ull)397 b(41)2723 5285 +y(\014ts)p 2850 5285 V 33 w(write)p 3086 5285 V 32 w(record)425 +b(38)2723 5398 y(\014ts)p 2850 5398 V 33 w(write)p 3086 +5398 V 32 w(subset)f(40)2723 5511 y(\014ts)p 2850 5511 +V 33 w(write)p 3086 5511 V 32 w(subset)p 3367 5511 V +32 w(TYP)196 b(97)2723 5624 y(\014ts)p 2850 5624 V 33 +w(write)p 3086 5624 V 32 w(tblb)m(ytes)308 b(100)2723 +5737 y(\014ts)p 2850 5737 V 33 w(write)p 3086 5737 V +32 w(tdim)485 b(48)2723 5850 y(\014ts)p 2850 5850 V 33 +w(write)p 3086 5850 V 32 w(theap)451 b(99)p eop +%%Page: 149 157 +149 156 bop 3764 299 a Fj(149)50 543 y(\013asfm)276 b(59)50 +656 y(\013bnfm)255 b(59)50 769 y(\013calc)310 b(52)50 +882 y(\013calc)p 259 882 28 4 v 33 w(rng)145 b(53)50 +995 y(\013clos)314 b(33)50 1107 y(\013cmph)197 b(100)50 +1220 y(\013cmps)258 b(56)50 1333 y(\013cmrk)j(30)50 1446 +y(\013cmsg)j(30)50 1559 y(\013cop)m(y)280 b(34)50 1672 +y(\013cp)s(cl)301 b(49)50 1785 y(\013cp)s(dt)281 b(86)50 +1898 y(\013cp\015)319 b(34)50 2011 y(\013cphd)268 b(34)50 +2124 y(\013cpky)274 b(89)50 2237 y(\013crhd)283 b(84)50 +2349 y(\013crim)g(40)50 2462 y(\013cro)m(w)277 b(52)50 +2575 y(\013crtb)299 b(46)50 2688 y(\013dcol)g(49)50 2801 +y(\013delt)309 b(33)50 2914 y(\013dhdu)257 b(35)50 3027 +y(\013dk)m(ey)277 b(39)50 3140 y(\013dkinit)224 b(32)50 +3253 y(\013dk)m(op)s(en)175 b(30)50 3366 y(\013dopn)263 +b(30)50 3479 y(\013drec)294 b(39)50 3591 y(\013dro)m(w)266 +b(48)50 3704 y(\013drrg)293 b(48)50 3817 y(\013drws)272 +b(48)50 3930 y(\013dsum)247 b(54)50 4043 y(\013dt2s)294 +b(55)50 4156 y(\013dtdm)248 b(48)50 4269 y(\013dt)m(yp)279 +b(58)50 4382 y(\013eqt)m(y)293 b(47)50 4495 y(\013esum)258 +b(54)50 4608 y(\013exest)k(83)50 4721 y(\013extn)287 +b(83)50 4833 y(\013\013rw)306 b(52)50 4946 y(\013\015md)283 +b(33)50 5059 y(\013\015nm)g(33)50 5172 y(\013\015sh)323 +b(84)50 5285 y(\013\015us)g(84)50 5398 y(\013fro)m(w)289 +b(52)50 5511 y(\013g2d)p 249 5511 V 320 w(98)50 5624 +y(\013g3d)p 249 5624 V 320 w(98)50 5737 y(\013gab)s(c)277 +b(59)785 543 y(\013gacl)221 b(99)785 656 y(\013gb)s(cl)212 +b(99)785 769 y(\013gcdw)175 b(48)785 882 y(\013gcf)264 +b(51)785 995 y(\013gcf)p 956 995 V 219 w(103)785 1107 +y(\013gc)m(ks)211 b(54)785 1220 y(\013gcnn)190 b(46)785 +1333 y(\013gcno)196 b(46)785 1446 y(\013gcrd)205 b(36)785 +1559 y(\013gcv)244 b(51)785 1672 y(\013gcv)p 976 1672 +V 199 w(102)785 1785 y(\013gcx)199 b(104)785 1898 y(\013gdes)160 +b(104)785 2011 y(\013gdess)124 b(104)785 2124 y(\013gerr)220 +b(29)785 2237 y(\013ggp)p 984 2237 V 236 w(98)785 2349 +y(\013ghad)185 b(84)785 2462 y(\013gh)m(bn)d(87)785 2575 +y(\013ghdn)d(34)785 2688 y(\013ghdt)195 b(34)785 2801 +y(\013ghof)208 b(84)785 2914 y(\013ghpr)194 b(87)785 +3027 y(\013ghps)g(86)785 3140 y(\013ghsp)g(35)785 3253 +y(\013gh)m(tb)k(87)785 3366 y(\013gics)230 b(72)785 3479 +y(\013gidm)179 b(40)785 3591 y(\013gidt)220 b(40)785 +3704 y(\013giet)231 b(40)785 3817 y(\013gipr)219 b(40)785 +3930 y(\013gisz)230 b(40)785 4043 y(\013gk)m(cl)221 b(58)785 +4156 y(\013gk)m(ey)199 b(36)785 4269 y(\013gkls)222 b(91)785 +4382 y(\013gkn)p 987 4382 V 233 w(92)785 4495 y(\013gknm)157 +b(57)785 4608 y(\013gky)236 b(36)785 4721 y(\013gkyn)185 +b(36)785 4833 y(\013gkyt)201 b(92)785 4946 y(\013gky)p +984 4946 V 236 w(91)785 5059 y(\013gmcp)165 b(79)785 +5172 y(\013gmng)160 b(79)785 5285 y(\013gmop)g(79)785 +5398 y(\013gmrm)144 b(79)785 5511 y(\013gmsg)175 b(30)785 +5624 y(\013gm)m(tf)196 b(79)785 5737 y(\013gncl)215 b(46)1436 +543 y(\013gnrw)283 b(46)1436 656 y(\013gnxk)289 b(36)1436 +769 y(\013gpf)357 b(97)1436 882 y(\013gpf)p 1618 882 +V 357 w(97)1436 995 y(\013gp)m(v)340 b(97)1436 1107 y(\013gp)m(v)p +1635 1107 V 340 w(97)1436 1220 y(\013gp)m(xv)292 b(42)1436 +1333 y(\013gp)m(xf)312 b(42)1436 1446 y(\013grec)320 +b(36)1436 1559 y(\013grsz)k(99)1436 1672 y(\013gsdt)314 +b(55)1436 1785 y(\013gsf)p 1603 1785 V 205 w(98)32 b(103)1436 +1898 y(\013gstm)289 b(55)1436 2011 y(\013gsv)p 1623 2011 +V 185 w(98)32 b(103)1436 2124 y(\013gtam)280 b(78)1436 +2237 y(\013gtbb)254 b(100)1436 2349 y(\013gtc)m(h)313 +b(76)1436 2462 y(\013gtcl)335 b(47)1436 2575 y(\013gtcm)285 +b(77)1436 2688 y(\013gtcp)310 b(77)1436 2801 y(\013gtcr)325 +b(76)1436 2914 y(\013gtcs)g(72)1436 3027 y(\013gtdm)274 +b(48)1436 3140 y(\013gthd)299 b(59)1436 3253 y(\013gtis)339 +b(76)1436 3366 y(\013gtmg)280 b(77)1436 3479 y(\013gtnm)274 +b(78)1436 3591 y(\013gtop)305 b(78)1436 3704 y(\013gtrm)289 +b(77)1436 3817 y(\013gtvf)325 b(78)1436 3930 y(\013gun)m(t)302 +b(37)1436 4043 y(\013hdef)311 b(86)1436 4156 y(\016bin)330 +b(85)1436 4269 y(\016cls)356 b(49)1436 4382 y(\016col)347 +b(49)1436 4495 y(\016img)311 b(85)1436 4608 y(\016kls)348 +b(90)1436 4721 y(\016kyu)311 b(91)1436 4833 y(\016ky)p +1613 4833 V 362 w(90)1436 4946 y(\016mem)266 b(82)1436 +5059 y(\016nit)346 b(32)1436 5172 y(\016opn)311 b(30)1436 +5285 y(\016rec)342 b(90)1436 5398 y(\016ro)m(w)314 b(48)1436 +5511 y(\016tab)327 b(85)1436 5624 y(\016ter)347 b(69)1436 +5737 y(\016url)e(82)2191 543 y(\013k)m(eyn)208 b(57)2191 +656 y(\013mahd)169 b(33)2191 769 y(\013mcom)155 b(38)2191 +882 y(\013mcrd)189 b(92)2191 995 y(\013mkls)206 b(93)2191 +1107 y(\013mkyu)169 b(93)2191 1220 y(\013mky)p 2421 1220 +V 220 w(93)2191 1333 y(\013mnam)144 b(39)2191 1446 y(\013mnhd)163 +b(33)2191 1559 y(\013mrec)200 b(92)2191 1672 y(\013mrhd)178 +b(33)2191 1785 y(\013m)m(v)m(ec)194 b(49)2191 1898 y(\013nc)m(hk)205 +b(57)2191 2011 y(\013nk)m(ey)j(58)2191 2124 y(\013omem)155 +b(81)2191 2237 y(\013op)s(en)202 b(30)2191 2349 y(\013p2d)p +2396 2349 V 245 w(97)2191 2462 y(\013p3d)p 2396 2462 +V 245 w(97)2191 2575 y(\013p)s(c)m(ks)217 b(53)2191 2688 +y(\013p)s(cl)272 b(50)2191 2801 y(\013p)s(cls)191 b(100)2191 +2914 y(\013p)s(cl)p 2369 2914 V 227 w(101)2191 3027 y(\013p)s(clu)221 +b(50)2191 3140 y(\013p)s(cn)247 b(50)2191 3253 y(\013p)s(cn)p +2394 3253 V 202 w(101)2191 3366 y(\013p)s(com)177 b(38)2191 +3479 y(\013p)s(dat)207 b(38)2191 3591 y(\013p)s(des)166 +b(102)2191 3704 y(\013pgp)p 2396 3704 V 245 w(97)2191 +3817 y(\013ph)m(bn)191 b(87)2191 3930 y(\013phis)228 +b(38)2191 4043 y(\013phpr)203 b(87)2191 4156 y(\013phps)g(87)2191 +4269 y(\013ph)m(tb)k(87)2191 4382 y(\013pkls)231 b(89)2191 +4495 y(\013pkn)p 2399 4495 V 242 w(89)2191 4608 y(\013pktp)207 +b(90)2191 4721 y(\013pky)245 b(37)2191 4833 y(\013pkyt)210 +b(90)2191 4946 y(\013pkyu)194 b(38)2191 5059 y(\013pky)p +2396 5059 V 245 w(88)2191 5172 y(\013plsw)213 b(89)2191 +5285 y(\013pmrk)181 b(30)2191 5398 y(\013pmsg)j(56)2191 +5511 y(\013pn)m(ul)216 b(95)2191 5624 y(\013ppn)239 b(96)2191 +5737 y(\013ppn)p 2402 5737 V 239 w(96)2857 543 y(\013ppr)273 +b(96)2857 656 y(\013pprn)222 b(41)2857 769 y(\013ppru)g(97)2857 +882 y(\013ppr)p 3053 882 V 273 w(96)2857 995 y(\013pp)m(x)264 +b(41)2857 1107 y(\013pp)m(xn)213 b(41)2857 1220 y(\013prec)244 +b(38)2857 1333 y(\013pscl)258 b(94)2857 1446 y(\013pss)288 +b(40)2857 1559 y(\013pss)p 3038 1559 V 288 w(97)2857 +1672 y(\013psv)m(c)239 b(57)2857 1785 y(\013ptbb)177 +b(100)2857 1898 y(\013ptdm)198 b(48)2857 2011 y(\013pthp)223 +b(99)2857 2124 y(\013pun)m(t)j(39)2857 2237 y(\013rdef)256 +b(86)2857 2349 y(\013reop)s(en)145 b(82)2857 2462 y(\013rprt)253 +b(30)2857 2575 y(\013rsim)237 b(85)2857 2688 y(\013rtnm)213 +b(83)2857 2801 y(\013rwrg)228 b(61)2857 2914 y(\013s2dt)244 +b(55)2857 3027 y(\013s2tm)219 b(55)2857 3140 y(\013sn)m(ul)250 +b(95)2857 3253 y(\013sro)m(w)231 b(52)2857 3366 y(\013texp)237 +b(53)2857 3479 y(\013thdu)223 b(33)2857 3591 y(\013theap)143 +b(100)2857 3704 y(\013tk)m(ey)243 b(57)2857 3817 y(\013tm2s)219 +b(55)2857 3930 y(\013tn)m(ul)251 b(95)2857 4043 y(\013topn)229 +b(30)2857 4156 y(\013tplt)264 b(82)2857 4269 y(\013trec)c(57)2857 +4382 y(\013tscl)274 b(94)2857 4495 y(\013ucrd)233 b(38)2857 +4608 y(\013ukls)250 b(93)2857 4721 y(\013uky)264 b(37)2857 +4833 y(\013ukyu)213 b(38)2857 4946 y(\013uky)p 3062 4946 +V 264 w(93)2857 5059 y(\013up)s(c)m(h)218 b(56)2857 5172 +y(\013up)s(c)m(k)j(54)2857 5285 y(\013urlt)263 b(33)2857 +5398 y(\013v)m(c)m(ks)245 b(54)2857 5511 y(\013v)m(ers)254 +b(56)2857 5624 y(\013wldp)217 b(73)2857 5737 y(\013xyp)m(x)i(73)p +eop +%%Page: 150 158 +150 157 bop 0 299 a Fj(150)2084 b Fh(APPENDIX)31 b(A.)61 +b(INDEX)31 b(OF)f(R)m(OUTINES)p eop +%%Page: 151 159 +151 158 bop 0 1225 a Fg(App)5 b(endix)65 b(B)0 1687 y +Fm(P)-6 b(arameter)77 b(De\014nitions)0 2180 y Fe(anynul)142 +b(-)47 b(set)g(to)g(TRUE)g(\(=1\))f(if)i(any)e(returned)g(values)g(are) +h(undefined,)e(else)i(FALSE)0 2293 y(array)190 b(-)47 +b(array)f(of)i(numerical)d(data)h(values)h(to)g(read)f(or)i(write)0 +2406 y(ascii)190 b(-)47 b(encoded)f(checksum)f(string)0 +2518 y(binspec)94 b(-)47 b(the)g(input)f(table)h(binning)e(specifier)0 +2631 y(bitpix)142 b(-)47 b(bits)g(per)g(pixel.)f(The)h(following)e +(symbolic)g(mnemonics)h(are)h(predefined:)716 2744 y(BYTE_IMG)141 +b(=)i(8)47 b(\(unsigned)f(char\))716 2857 y(SHORT_IMG)93 +b(=)i(16)47 b(\(signed)f(short)g(integer\))716 2970 y(LONG_IMG)141 +b(=)95 b(32)47 b(\(signed)f(long)h(integer\))716 3083 +y(LONGLONG_IMG)d(=)96 b(64)47 b(\(signed)f(long)g(64-bit)g(integer\)) +716 3196 y(FLOAT_IMG)93 b(=)47 b(-32)g(\(float\))716 +3309 y(DOUBLE_IMG)e(=)i(-64)g(\(double\).)525 3422 y(The)g +(LONGLONG_IMG)d(type)j(is)g(experimental)e(and)i(is)g(not)g(officially) +525 3535 y(recognized)e(in)i(the)g(FITS)g(Standard)e(document.)525 +3648 y(Two)i(additional)e(values,)h(USHORT_IMG)f(and)i(ULONG_IMG)e(are) +i(also)f(available)525 3760 y(for)h(creating)e(unsigned)h(integer)g +(images.)93 b(These)47 b(are)g(equivalent)e(to)525 3873 +y(creating)h(a)h(signed)f(integer)g(image)g(with)h(BZERO)f(offset)g +(keyword)g(values)525 3986 y(of)h(32768)g(or)g(2147483648,)d +(respectively,)h(which)h(is)h(the)g(convention)e(that)525 +4099 y(FITS)i(uses)f(to)h(store)g(unsigned)e(integers.)0 +4212 y(card)238 b(-)47 b(header)f(record)g(to)h(be)h(read)e(or)h +(written)f(\(80)h(char)g(max,)f(null-terminated\))0 4325 +y(casesen)94 b(-)47 b(CASESEN)f(\(=1\))g(for)h(case-sensitive)d(string) +i(matching,)g(else)g(CASEINSEN)g(\(=0\))0 4438 y(cmopt)190 +b(-)47 b(grouping)f(table)g("compact")f(option)h(parameter.)f(Allowed)h +(values)g(are:)525 4551 y(OPT_CMT_MBR)f(and)i(OPT_CMT_MBR_DEL.)0 +4664 y(colname)94 b(-)47 b(name)g(of)g(the)g(column)f +(\(null-terminated\))0 4777 y(colnum)142 b(-)47 b(column)f(number)g +(\(first)g(column)g(=)i(1\))0 4890 y(colspec)94 b(-)47 +b(the)g(input)f(file)h(column)f(specification;)e(used)j(to)g(delete,)f +(create,)f(or)j(rename)525 5002 y(table)e(columns)0 5115 +y(comment)94 b(-)47 b(the)g(keyword)f(comment)g(field)g(\(72)h(char)f +(max,)h(null-terminated\))0 5228 y(complm)142 b(-)47 +b(should)f(the)h(checksum)f(be)h(complemented?)0 5341 +y(comptype)f(-)h(compression)e(algorithm)g(to)i(use:)g(GZIP_1,)f +(RICE_1,)f(or)j(PLIO_1)0 5454 y(coordtype-)d(type)i(of)g(coordinate)e +(projection)g(\(-SIN,)h(-TAN,)g(-ARC,)h(-NCP,)525 5567 +y(-GLS,)f(-MER,)h(or)g(-AIT\))0 5680 y(cpopt)190 b(-)47 +b(grouping)f(table)g(copy)h(option)f(parameter.)f(Allowed)g(values)i +(are:)1882 5942 y Fj(151)p eop +%%Page: 152 160 +152 159 bop 0 299 a Fj(152)1822 b Fh(APPENDIX)31 b(B.)61 +b(P)-8 b(ARAMETER)30 b(DEFINITIONS)525 555 y Fe(OPT_GCP_GPT,)44 +b(OPT_GCP_MBR,)h(OPT_GCP_ALL,)f(OPT_MCP_ADD,)h(OPT_MCP_NADD,)525 +668 y(OPT_MCP_REPL,)f(amd)j(OPT_MCP_MOV.)0 781 y(create_col-)e(If)i +(TRUE,)f(then)h(insert)f(a)h(new)g(column)f(in)i(the)f(table,)f +(otherwise)525 894 y(overwrite)f(the)i(existing)f(column.)0 +1007 y(current)94 b(-)47 b(if)g(TRUE,)g(then)f(the)h(current)f(HDU)h +(will)f(be)i(copied)0 1120 y(dataok)142 b(-)47 b(was)g(the)g(data)f +(unit)h(verification)e(successful)g(\(=1\))h(or)525 1233 +y(not)h(\(=)g(-1\).)94 b(Equals)47 b(zero)f(if)h(the)g(DATASUM)f +(keyword)g(is)h(not)g(present.)0 1346 y(datasum)94 b(-)47 +b(32-bit)f(1's)h(complement)e(checksum)h(for)g(the)h(data)g(unit)0 +1458 y(dataend)94 b(-)47 b(address)f(\(in)h(bytes\))f(of)h(the)g(end)g +(of)g(the)g(HDU)0 1571 y(datastart-)e(address)h(\(in)h(bytes\))f(of)h +(the)g(start)f(of)h(the)g(data)g(unit)0 1684 y(datatype)f(-)h +(specifies)e(the)i(data)g(type)f(of)i(the)f(value.)93 +b(Allowed)46 b(value)h(are:)94 b(TSTRING,)525 1797 y(TLOGICAL,)45 +b(TBYTE,)h(TSBYTE,)g(TSHORT,)g(TUSHORT,)g(TINT,)g(TUINT,)g(TLONG,)g +(TULONG,)525 1910 y(TFLOAT,)g(TDOUBLE,)f(TCOMPLEX,)h(and)h(TDBLCOMPLEX) +0 2023 y(datestr)94 b(-)47 b(FITS)g(date/time)e(string:)h +('YYYY-MM-DDThh:mm:ss.dd)o(d',)41 b('YYYY-MM-dd',)525 +2136 y(or)47 b('dd/mm/yy')0 2249 y(day)286 b(-)47 b(calendar)f(day)g +(\(UTC\))h(\(1-31\))0 2362 y(decimals)f(-)h(number)f(of)h(decimal)f +(places)g(to)h(be)h(displayed)0 2475 y(deltasize)d(-)j(increment)d(for) +i(allocating)e(more)i(memory)0 2588 y(dim1)238 b(-)47 +b(declared)f(size)g(of)h(the)g(first)g(dimension)e(of)i(the)g(image)f +(or)i(cube)e(array)0 2700 y(dim2)238 b(-)47 b(declared)f(size)g(of)h +(the)g(second)f(dimension)g(of)h(the)g(data)f(cube)h(array)0 +2813 y(dispwidth)e(-)j(display)e(width)g(of)h(a)h(column)e(=)h(length)f +(of)h(string)f(that)h(will)g(be)g(read)0 2926 y(dtype)190 +b(-)47 b(data)g(type)f(of)h(the)g(keyword)f(\('C',)h('L',)f('I',)h('F') +g(or)g('X'\))764 3039 y(C)g(=)h(character)d(string)764 +3152 y(L)i(=)h(logical)764 3265 y(I)f(=)h(integer)764 +3378 y(F)f(=)h(floating)d(point)h(number)764 3491 y(X)h(=)h(complex,)d +(e.g.,)h("\(1.23,)g(-4.56\)")0 3604 y(err_msg)94 b(-)47 +b(error)f(message)g(on)h(the)g(internal)f(stack)g(\(80)h(chars)f(max\)) +0 3717 y(err_text)g(-)h(error)f(message)g(string)g(corresponding)e(to)k +(error)e(number)g(\(30)h(chars)f(max\))0 3830 y(exact)190 +b(-)47 b(TRUE)g(\(=1\))f(if)h(the)g(strings)f(match)h(exactly;)525 +3942 y(FALSE)f(\(=0\))h(if)g(wildcards)e(are)i(used)0 +4055 y(exclist)94 b(-)47 b(array)f(of)i(pointers)d(to)i(keyword)f +(names)g(to)i(be)f(excluded)e(from)i(search)0 4168 y(exists)142 +b(-)47 b(flag)g(indicating)e(whether)g(the)i(file)g(or)g(compressed)e +(file)i(exists)f(on)h(disk)0 4281 y(expr)238 b(-)47 b(boolean)f(or)h +(arithmetic)e(expression)0 4394 y(extend)142 b(-)47 b(TRUE)g(\(=1\))f +(if)h(FITS)g(file)g(may)g(have)f(extensions,)f(else)i(FALSE)f(\(=0\))0 +4507 y(extname)94 b(-)47 b(value)f(of)i(the)e(EXTNAME)g(keyword)g +(\(null-terminated\))0 4620 y(extspec)94 b(-)47 b(the)g(extension)e(or) +i(HDU)g(specifier;)e(a)j(number)e(or)h(name,)f(version,)g(and)h(type)0 +4733 y(extver)142 b(-)47 b(value)f(of)i(the)e(EXTVER)h(keyword)e(=)j +(integer)e(version)f(number)0 4846 y(filename)h(-)h(full)g(name)f(of)h +(the)g(FITS)g(file,)f(including)g(optional)f(HDU)i(and)g(filtering)e +(specs)0 4959 y(filetype)h(-)h(type)g(of)g(file)f(\(file://,)g(ftp://,) +g(http://,)f(etc.\))0 5072 y(filter)142 b(-)47 b(the)g(input)f(file)h +(filtering)e(specifier)0 5185 y(firstchar-)g(starting)h(byte)g(in)h +(the)g(row)g(\(first)f(byte)h(of)g(row)g(=)g(1\))0 5297 +y(firstfailed)e(-)i(member)f(HDU)h(ID)g(\(if)g(positive\))f(or)h +(grouping)e(table)i(GRPIDn)f(index)525 5410 y(value)g(\(if)h +(negative\))f(that)g(failed)g(grouping)g(table)g(verification.)0 +5523 y(firstelem-)f(first)h(element)g(in)h(a)h(vector)e(\(ignored)f +(for)i(ASCII)g(tables\))0 5636 y(firstrow)f(-)h(starting)f(row)g +(number)h(\(first)f(row)h(of)g(table)f(=)i(1\))p eop +%%Page: 153 161 +153 160 bop 3764 299 a Fj(153)0 555 y Fe(following-)45 +b(if)i(TRUE,)g(any)f(HDUs)h(following)e(the)i(current)f(HDU)h(will)g +(be)g(copied)0 668 y(fpixel)142 b(-)47 b(coordinate)e(of)i(the)g(first) +f(pixel)h(to)g(be)g(read)g(or)g(written)f(in)h(the)525 +781 y(FITS)g(array.)93 b(The)47 b(array)g(must)f(be)i(of)f(length)f +(NAXIS)g(and)h(have)g(values)f(such)525 894 y(that)h(fpixel[0])e(is)i +(in)g(the)g(range)g(1)g(to)g(NAXIS1,)f(fpixel[1])f(is)i(in)h(the)525 +1007 y(range)e(1)i(to)f(NAXIS2,)f(etc.)0 1120 y(fptr)238 +b(-)47 b(pointer)f(to)h(a)g('fitsfile')e(structure)h(describing)f(the)i +(FITS)f(file.)0 1233 y(frac)238 b(-)47 b(factional)e(part)i(of)g(the)g +(keyword)f(value)0 1346 y(gcount)142 b(-)47 b(number)f(of)h(groups)f +(in)i(the)e(primary)g(array)h(\(usually)e(=)j(1\))0 1458 +y(gfptr)190 b(-)47 b(fitsfile*)e(pointer)h(to)h(a)h(grouping)d(table)i +(HDU.)0 1571 y(group)190 b(-)47 b(GRPIDn/GRPLCn)d(index)j(value)f +(identifying)f(a)i(grouping)f(table)g(HDU,)h(or)525 1684 +y(data)g(group)f(number)g(\(=0)h(for)g(non-grouped)e(data\))0 +1797 y(grouptype)g(-)j(Grouping)d(table)i(parameter)e(that)i(specifies) +e(the)i(columns)f(to)h(be)525 1910 y(created)f(in)h(a)g(grouping)f +(table)g(HDU.)h(Allowed)f(values)g(are:)h(GT_ID_ALL_URI,)525 +2023 y(GT_ID_REF,)e(GT_ID_POS,)g(GT_ID_ALL,)g(GT_ID_REF_URI,)f(and)j +(GT_ID_POS_URI.)0 2136 y(grpname)94 b(-)47 b(value)f(to)i(use)e(for)h +(the)g(GRPNAME)f(keyword)g(value.)0 2249 y(hdunum)142 +b(-)47 b(sequence)f(number)g(of)h(the)g(HDU)g(\(Primary)e(array)i(=)g +(1\))0 2362 y(hduok)190 b(-)47 b(was)g(the)g(HDU)g(verification)d +(successful)h(\(=1\))i(or)525 2475 y(not)g(\(=)g(-1\).)94 +b(Equals)47 b(zero)f(if)h(the)g(CHECKSUM)f(keyword)g(is)h(not)g +(present.)0 2588 y(hdusum)142 b(-)47 b(32)g(bit)g(1's)g(complement)e +(checksum)h(for)g(the)h(entire)f(CHDU)0 2700 y(hdutype)94 +b(-)47 b(type)g(of)g(HDU:)f(IMAGE_HDU)g(\(=0\),)g(ASCII_TBL)f(\(=1\),)i +(or)g(BINARY_TBL)e(\(=2\))0 2813 y(header)142 b(-)47 +b(returned)f(character)f(string)h(containing)f(all)i(the)g(keyword)f +(records)0 2926 y(headstart-)f(starting)h(address)f(\(in)i(bytes\))f +(of)i(the)e(CHDU)0 3039 y(heapsize)g(-)h(size)g(of)g(the)g(binary)f +(table)g(heap,)h(in)g(bytes)0 3152 y(history)94 b(-)47 +b(the)g(HISTORY)f(keyword)g(comment)f(string)h(\(70)h(char)g(max,)g +(null-terminated\))0 3265 y(hour)238 b(-)47 b(hour)g(within)f(day)h +(\(UTC\))f(\(0)h(-)h(23\))0 3378 y(inc)286 b(-)47 b(sampling)f +(interval)f(for)i(pixels)f(in)h(each)g(FITS)g(dimension)0 +3491 y(inclist)94 b(-)47 b(array)f(of)i(pointers)d(to)i(matching)f +(keyword)g(names)0 3604 y(incolnum)g(-)h(input)f(column)g(number;)g +(range)h(=)g(1)h(to)f(TFIELDS)0 3717 y(infile)142 b(-)47 +b(the)g(input)f(filename,)g(including)f(path)h(if)i(specified)0 +3830 y(infptr)142 b(-)47 b(pointer)f(to)h(a)g('fitsfile')e(structure)h +(describing)f(the)i(input)f(FITS)h(file.)0 3942 y(intval)142 +b(-)47 b(integer)f(part)g(of)i(the)f(keyword)e(value)0 +4055 y(iomode)142 b(-)47 b(file)g(access)f(mode:)g(either)g(READONLY)g +(\(=0\))g(or)i(READWRITE)d(\(=1\))0 4168 y(keyname)94 +b(-)47 b(name)g(of)g(a)g(keyword)f(\(8)h(char)g(max,)g +(null-terminated\))0 4281 y(keynum)142 b(-)47 b(position)f(of)h +(keyword)f(in)h(header)f(\(1st)g(keyword)g(=)i(1\))0 +4394 y(keyroot)94 b(-)47 b(root)g(string)f(for)h(the)g(keyword)e(name)i +(\(5)g(char)g(max,)f(null-terminated\))0 4507 y(keysexist-)f(number)h +(of)h(existing)f(keyword)g(records)f(in)j(the)f(CHU)0 +4620 y(keytype)94 b(-)47 b(header)f(record)g(type:)h(-1=delete;)92 +b(0=append)46 b(or)h(replace;)907 4733 y(1=append;)e(2=this)h(is)h(the) +g(END)g(keyword)0 4846 y(longstr)94 b(-)47 b(arbitrarily)e(long)h +(string)g(keyword)g(value)h(\(null-terminated\))0 4959 +y(lpixel)142 b(-)47 b(coordinate)e(of)i(the)g(last)g(pixel)f(to)h(be)g +(read)g(or)g(written)f(in)h(the)525 5072 y(FITS)g(array.)93 +b(The)47 b(array)g(must)f(be)i(of)f(length)f(NAXIS)g(and)h(have)g +(values)f(such)525 5185 y(that)h(lpixel[0])e(is)i(in)g(the)g(range)g(1) +g(to)g(NAXIS1,)f(lpixel[1])f(is)i(in)h(the)525 5297 y(range)e(1)i(to)f +(NAXIS2,)f(etc.)0 5410 y(match)190 b(-)47 b(TRUE)g(\(=1\))f(if)h(the)g +(2)h(strings)e(match,)g(else)g(FALSE)h(\(=0\))0 5523 +y(maxdim)142 b(-)47 b(maximum)f(number)g(of)h(values)f(to)h(return)0 +5636 y(member)142 b(-)47 b(row)g(number)f(of)h(a)h(grouping)d(table)i +(member)f(HDU.)p eop +%%Page: 154 162 +154 161 bop 0 299 a Fj(154)1822 b Fh(APPENDIX)31 b(B.)61 +b(P)-8 b(ARAMETER)30 b(DEFINITIONS)0 555 y Fe(memptr)142 +b(-)47 b(pointer)f(to)h(the)g(a)g(FITS)g(file)g(in)g(memory)0 +668 y(mem_realloc)e(-)i(pointer)f(to)h(a)h(function)d(for)i +(reallocating)e(more)h(memory)0 781 y(memsize)94 b(-)47 +b(size)g(of)g(the)g(memory)f(block)g(allocated)f(for)i(the)g(FITS)g +(file)0 894 y(mfptr)190 b(-)47 b(fitsfile*)e(pointer)h(to)h(a)h +(grouping)d(table)i(member)f(HDU.)0 1007 y(mgopt)190 +b(-)47 b(grouping)f(table)g(merge)g(option)g(parameter.)f(Allowed)h +(values)g(are:)525 1120 y(OPT_MRG_COPY,)e(and)j(OPT_MRG_MOV.)0 +1233 y(minute)142 b(-)47 b(minute)f(within)g(hour)h(\(UTC\))f(\(0)h(-)h +(59\))0 1346 y(month)190 b(-)47 b(calendar)f(month)g(\(UTC\))g(\(1)h(-) +h(12\))0 1458 y(morekeys)e(-)h(space)f(in)i(the)e(header)h(for)f(this)h +(many)g(more)f(keywords)0 1571 y(n_good_rows)f(-)i(number)f(of)h(rows)g +(evaluating)e(to)i(TRUE)0 1684 y(namelist)f(-)h(string)f(containing)f +(a)j(comma)e(or)h(space)f(delimited)g(list)g(of)i(names)0 +1797 y(naxes)190 b(-)47 b(size)g(of)g(each)f(dimension)g(in)h(the)g +(FITS)f(array)0 1910 y(naxis)190 b(-)47 b(number)f(of)h(dimensions)e +(in)i(the)g(FITS)g(array)0 2023 y(naxis1)142 b(-)47 b(length)f(of)h +(the)g(X/first)f(axis)h(of)g(the)g(FITS)f(array)0 2136 +y(naxis2)142 b(-)47 b(length)f(of)h(the)g(Y/second)f(axis)g(of)i(the)e +(FITS)h(array)0 2249 y(naxis3)142 b(-)47 b(length)f(of)h(the)g(Z/third) +f(axis)h(of)g(the)g(FITS)f(array)0 2362 y(nchars)142 +b(-)47 b(number)f(of)h(characters)e(to)i(read)g(or)g(write)0 +2475 y(nelements-)e(number)h(of)h(data)g(elements)e(to)j(read)e(or)h +(write)0 2588 y(newfptr)94 b(-)47 b(returned)f(pointer)f(to)j(the)e +(reopened)g(file)0 2700 y(newveclen-)f(new)i(value)f(for)h(the)g +(column)f(vector)g(repeat)g(parameter)0 2813 y(nexc)238 +b(-)47 b(number)f(of)h(names)g(in)g(the)g(exclusion)e(list)i(\(may)f(=) +i(0\))0 2926 y(nfound)142 b(-)47 b(number)f(of)h(keywords)f(found)g +(\(highest)g(keyword)g(number\))0 3039 y(nkeys)190 b(-)47 +b(number)f(of)h(keywords)f(in)h(the)g(sequence)0 3152 +y(ninc)238 b(-)47 b(number)f(of)h(names)g(in)g(the)g(inclusion)e(list)0 +3265 y(nmembers)h(-)h(Number)f(of)h(grouping)f(table)g(members)g +(\(NAXIS2)g(value\).)0 3378 y(nmove)190 b(-)47 b(number)f(of)h(HDUs)g +(to)g(move)g(\(+)g(or)g(-\),)g(relative)f(to)h(current)f(position)0 +3491 y(nocomments)f(-)i(if)h(equal)e(to)h(TRUE,)g(then)f(no)h +(commentary)e(keywords)h(will)h(be)g(copied)0 3604 y(noisebits-)e +(number)h(of)h(bits)g(to)g(ignore)f(when)h(compressing)e(floating)g +(point)h(images)0 3717 y(nrows)190 b(-)47 b(number)f(of)h(rows)g(in)g +(the)g(table)0 3830 y(nstart)142 b(-)47 b(first)f(integer)g(value)0 +3942 y(nullarray-)f(set)i(to)g(TRUE)g(\(=1\))f(if)i(corresponding)c +(data)i(element)g(is)h(undefined)0 4055 y(nulval)142 +b(-)47 b(numerical)e(value)i(to)g(represent)e(undefined)g(pixels)0 +4168 y(nulstr)142 b(-)47 b(character)e(string)h(used)h(to)g(represent)e +(undefined)h(values)g(in)h(ASCII)f(table)0 4281 y(numval)142 +b(-)47 b(numerical)e(data)i(value,)f(of)h(the)g(appropriate)e(data)h +(type)0 4394 y(offset)142 b(-)95 b(byte)46 b(offset)g(in)i(the)f(heap)f +(to)h(the)g(first)g(element)e(of)j(the)f(vector)0 4507 +y(openfptr)f(-)h(pointer)f(to)h(a)g(currently)f(open)g(FITS)h(file)0 +4620 y(overlap)94 b(-)47 b(number)f(of)h(bytes)g(in)g(the)g(binary)f +(table)g(heap)h(pointed)f(to)h(by)g(more)g(than)f(1)525 +4733 y(descriptor)0 4846 y(outcolnum-)f(output)h(column)g(number;)g +(range)g(=)i(1)f(to)g(TFIELDS)f(+)i(1)0 4959 y(outfile)94 +b(-)47 b(and)g(optional)e(output)i(filename;)e(the)i(input)f(file)h +(will)f(be)i(copied)e(to)h(this)f(prior)525 5072 y(to)h(opening)f(the)h +(file)0 5185 y(outfptr)94 b(-)47 b(pointer)f(to)h(a)g('fitsfile')e +(structure)h(describing)f(the)i(output)f(FITS)g(file.)0 +5297 y(pcount)142 b(-)47 b(value)f(of)i(the)e(PCOUNT)h(keyword)e(=)j +(size)e(of)i(binary)e(table)g(heap)0 5410 y(previous)g(-)h(if)g(TRUE,)g +(any)f(previous)g(HDUs)h(in)g(the)g(input)f(file)h(will)f(be)i(copied.) +0 5523 y(repeat)142 b(-)47 b(length)f(of)h(column)f(vector)g(\(e.g.)h +(12J\);)f(==)h(1)h(for)f(ASCII)f(table)0 5636 y(rmopt)190 +b(-)47 b(grouping)f(table)g(remove)g(option)g(parameter.)f(Allowed)h +(values)g(are:)p eop +%%Page: 155 163 +155 162 bop 3764 299 a Fj(155)525 555 y Fe(OPT_RM_GPT,)45 +b(OPT_RM_ENTRY,)f(OPT_RM_MBR,)h(and)i(OPT_RM_ALL.)0 668 +y(rootname)f(-)h(root)g(filename,)e(minus)h(any)h(extension)e(or)j +(filtering)d(specifications)0 781 y(rot)286 b(-)47 b(celestial)e +(coordinate)g(rotation)h(angle)g(\(degrees\))0 894 y(rowlen)142 +b(-)47 b(length)f(of)h(a)h(table)e(row,)h(in)g(characters)e(or)i(bytes) +0 1007 y(rowlist)94 b(-)47 b(sorted)f(list)h(of)g(row)g(numbers)f(to)h +(be)g(deleted)f(from)g(the)h(table)0 1120 y(rownum)142 +b(-)47 b(number)f(of)h(the)g(row)g(\(first)f(row)h(=)h(1\))0 +1233 y(rowrange)e(-)h(list)g(of)g(rows)f(or)i(row)f(ranges:)e +('3,6-8,12,56-80')f(or)j('500-')0 1346 y(row_status)e(-)i(array)g(of)g +(True/False)e(results)h(for)h(each)f(row)h(that)g(was)g(evaluated)0 +1458 y(scale)190 b(-)47 b(linear)f(scaling)g(factor;)g(true)g(value)h +(=)g(\(FITS)g(value\))f(*)h(scale)f(+)i(zero)0 1571 y(second)142 +b(-)47 b(second)f(within)g(minute)g(\(0)h(-)h(60.9999999999\))c(\(leap) +i(second!\))0 1684 y(simple)142 b(-)47 b(TRUE)g(\(=1\))f(if)h(FITS)g +(file)g(conforms)e(to)i(the)g(Standard,)f(else)g(FALSE)h(\(=0\))0 +1797 y(space)190 b(-)47 b(number)f(of)h(blank)g(spaces)f(to)h(leave)f +(between)g(ASCII)g(table)h(columns)0 1910 y(status)142 +b(-)47 b(returned)f(error)g(status)g(code)h(\(0)g(=)g(OK\))0 +2023 y(sum)286 b(-)47 b(32)g(bit)g(unsigned)f(checksum)f(value)0 +2136 y(tbcol)190 b(-)47 b(byte)g(position)e(in)i(row)g(to)g(start)g(of) +g(column)f(\(1st)h(col)g(has)g(tbcol)f(=)h(1\))0 2249 +y(tdisp)190 b(-)47 b(Fortran)f(style)g(display)g(format)g(for)h(the)g +(table)f(column)0 2362 y(tdimstr)94 b(-)47 b(the)g(value)f(of)h(the)g +(TDIMn)g(keyword)0 2475 y(templt)142 b(-)47 b(template)f(string)g(used) +g(in)h(comparison)e(\(null-terminated\))0 2588 y(tfields)94 +b(-)47 b(number)f(of)h(fields)f(\(columns\))g(in)h(the)g(table)0 +2700 y(tfopt)190 b(-)47 b(grouping)f(table)g(member)g(transfer)g +(option)g(parameter.)f(Allowed)g(values)i(are:)525 2813 +y(OPT_MCP_ADD,)d(and)j(OPT_MCP_MOV.)0 2926 y(tform)190 +b(-)47 b(format)f(of)h(the)g(column)f(\(null-terminated\);)d(allowed)j +(values)g(are:)525 3039 y(ASCII)g(tables:)94 b(Iw,)47 +b(Aw,)g(Fww.dd,)f(Eww.dd,)f(or)j(Dww.dd)525 3152 y(Binary)e(tables:)g +(rL,)h(rX,)g(rB,)g(rI,)g(rJ,)f(rA,)h(rAw,)g(rE,)g(rD,)g(rC,)g(rM)525 +3265 y(where)f('w'=width)g(of)h(the)g(field,)f('d'=no.)g(of)h +(decimals,)e('r'=repeat)g(count.)525 3378 y(Variable)h(length)g(array)g +(columns)g(are)h(denoted)f(by)h(a)g('1P')g(before)f(the)h(data)f(type) +525 3491 y(character)f(\(e.g.,)h('1PJ'\).)94 b(When)47 +b(creating)e(a)j(binary)e(table,)g(2)h(addition)f(tform)525 +3604 y(data)h(type)f(codes)h(are)g(recognized)e(by)i(CFITSIO:)e('rU')i +(and)g('rV')f(for)h(unsigned)525 3717 y(16-bit)f(and)h(unsigned)f +(32-bit)g(integer,)f(respectively.)0 3942 y(theap)190 +b(-)47 b(zero)g(indexed)e(byte)i(offset)f(of)h(starting)f(address)g(of) +h(the)g(heap)525 4055 y(relative)f(to)h(the)g(beginning)e(of)i(the)g +(binary)f(table)g(data)0 4168 y(tilesize)g(-)h(array)f(of)i(length)e +(NAXIS)g(that)h(specifies)e(the)i(dimensions)e(of)525 +4281 y(the)i(image)f(compression)f(tiles)0 4394 y(ttype)190 +b(-)47 b(label)f(or)i(name)e(for)h(table)f(column)h +(\(null-terminated\))0 4507 y(tunit)190 b(-)47 b(physical)f(unit)g(for) +h(table)f(column)h(\(null-terminated\))0 4620 y(typechar)f(-)h +(symbolic)f(code)g(of)h(the)g(table)g(column)f(data)g(type)0 +4733 y(typecode)g(-)h(data)g(type)f(code)h(of)g(the)g(table)f(column.) +94 b(The)47 b(negative)e(of)525 4846 y(the)i(value)f(indicates)g(a)h +(variable)f(length)g(array)g(column.)764 4959 y(Datatype)618 +b(typecode)189 b(Mnemonic)764 5072 y(bit,)46 b(X)907 +b(1)381 b(TBIT)764 5185 y(byte,)46 b(B)811 b(11)381 b(TBYTE)764 +5297 y(logical,)45 b(L)668 b(14)381 b(TLOGICAL)764 5410 +y(ASCII)46 b(character,)f(A)286 b(16)381 b(TSTRING)764 +5523 y(short)46 b(integer,)g(I)381 b(21)g(TSHORT)764 +5636 y(integer,)45 b(J)668 b(41)381 b(TINT32BIT)p eop +%%Page: 156 164 +156 163 bop 0 299 a Fj(156)1822 b Fh(APPENDIX)31 b(B.)61 +b(P)-8 b(ARAMETER)30 b(DEFINITIONS)764 555 y Fe(long)46 +b(long)h(integer,)e(K)191 b(81)381 b(TLONGLONG)764 668 +y(real,)46 b(E)811 b(42)381 b(TFLOAT)764 781 y(double)46 +b(precision,)f(D)238 b(82)381 b(TDOUBLE)764 894 y(complex,)45 +b(C)668 b(83)381 b(TCOMPLEX)764 1007 y(double)46 b(complex,)f(M)286 +b(163)381 b(TDBLCOMPLEX)620 1120 y(The)47 b(TLONGLONG)f(column)g(type)g +(is)i(experimental)c(and)j(is)g(not)620 1233 y(recognized)e(in)j(the)f +(official)e(FITS)i(Standard)e(document)0 1346 y(unit)238 +b(-)47 b(the)g(physical)e(unit)i(string)f(\(e.g.,)g('km/s'\))g(for)h(a) +g(keyword)0 1458 y(unused)142 b(-)47 b(number)f(of)h(unused)f(bytes)h +(in)g(the)g(binary)f(table)g(heap)0 1571 y(urltype)94 +b(-)47 b(the)g(file)g(type)f(of)h(the)g(FITS)g(file)g(\(file://,)e +(ftp://,)h(mem://,)f(etc.\))0 1684 y(validheap-)g(returned)h(value)g(=) +h(FALSE)g(if)g(any)g(of)g(the)g(variable)e(length)i(array)525 +1797 y(address)f(are)h(outside)f(the)g(valid)h(range)f(of)h(addresses)f +(in)h(the)g(heap)0 1910 y(value)190 b(-)47 b(the)g(keyword)f(value)g +(string)g(\(70)h(char)g(max,)f(null-terminated\))0 2023 +y(version)94 b(-)47 b(current)f(version)g(number)g(of)h(the)g(CFITSIO)f +(library)0 2136 y(width)190 b(-)47 b(width)f(of)i(the)e(character)g +(string)g(field)0 2249 y(xcol)238 b(-)47 b(number)f(of)h(the)g(column)f +(containing)f(the)i(X)h(coordinate)d(values)0 2362 y(xinc)238 +b(-)47 b(X)g(axis)g(coordinate)e(increment)g(at)j(reference)d(pixel)h +(\(deg\))0 2475 y(xpix)238 b(-)47 b(X)g(axis)g(pixel)f(location)0 +2588 y(xpos)238 b(-)47 b(X)g(axis)g(celestial)e(coordinate)g(\(usually) +h(RA\))h(\(deg\))0 2700 y(xrefpix)94 b(-)47 b(X)g(axis)g(reference)e +(pixel)i(array)f(location)0 2813 y(xrefval)94 b(-)47 +b(X)g(axis)g(coordinate)e(value)h(at)i(the)f(reference)e(pixel)h +(\(deg\))0 2926 y(ycol)238 b(-)47 b(number)f(of)h(the)g(column)f +(containing)f(the)i(X)h(coordinate)d(values)0 3039 y(year)238 +b(-)47 b(calendar)f(year)g(\(e.g.)h(1999,)f(2000,)g(etc\))0 +3152 y(yinc)238 b(-)47 b(Y)g(axis)g(coordinate)e(increment)g(at)j +(reference)d(pixel)h(\(deg\))0 3265 y(ypix)238 b(-)47 +b(y)g(axis)g(pixel)f(location)0 3378 y(ypos)238 b(-)47 +b(y)g(axis)g(celestial)e(coordinate)g(\(usually)h(DEC\))h(\(deg\))0 +3491 y(yrefpix)94 b(-)47 b(Y)g(axis)g(reference)e(pixel)i(array)f +(location)0 3604 y(yrefval)94 b(-)47 b(Y)g(axis)g(coordinate)e(value)h +(at)i(the)f(reference)e(pixel)h(\(deg\))0 3717 y(zero)238 +b(-)47 b(scaling)f(offset;)g(true)g(value)h(=)g(\(FITS)f(value\))h(*)g +(scale)f(+)i(zero)p eop +%%Page: 157 165 +157 164 bop 0 1225 a Fg(App)5 b(endix)65 b(C)0 1687 y +Fm(CFITSIO)76 b(Error)h(Status)h(Co)6 b(des)0 2180 y +Fj(The)28 b(follo)m(wing)e(table)i(lists)f(all)g(the)h(error)g(status)g +(co)s(des)g(used)f(b)m(y)h(CFITSIO.)f(Programmers)h(are)g(encouraged)0 +2293 y(to)37 b(use)e(the)h(sym)m(b)s(olic)f(mnemonics)f(\(de\014ned)h +(in)g(the)h(\014le)f(\014tsio.h\))h(rather)f(than)h(the)g(actual)g(in)m +(teger)h(status)0 2406 y(v)-5 b(alues)30 b(to)h(impro)m(v)m(e)f(the)h +(readabilit)m(y)d(of)j(their)e(co)s(de.)48 2665 y Fe(Symbolic)45 +b(Const)190 b(Value)237 b(Meaning)48 2778 y(--------------)187 +b(-----)94 b(------------------------)o(----)o(---)o(----)o(----)o(--) +1002 2891 y(0)191 b(OK,)47 b(no)g(error)48 3004 y(SAME_FILE)427 +b(101)190 b(input)46 b(and)h(output)f(files)h(are)g(the)f(same)48 +3117 y(TOO_MANY_FILES)187 b(103)j(tried)46 b(to)h(open)g(too)g(many)g +(FITS)f(files)h(at)g(once)48 3230 y(FILE_NOT_OPENED)139 +b(104)190 b(could)46 b(not)h(open)g(the)g(named)f(file)48 +3343 y(FILE_NOT_CREATED)91 b(105)190 b(could)46 b(not)h(create)f(the)h +(named)g(file)48 3456 y(WRITE_ERROR)331 b(106)190 b(error)46 +b(writing)g(to)h(FITS)g(file)48 3569 y(END_OF_FILE)331 +b(107)190 b(tried)46 b(to)h(move)g(past)g(end)g(of)g(file)48 +3681 y(READ_ERROR)379 b(108)190 b(error)46 b(reading)g(from)h(FITS)f +(file)48 3794 y(FILE_NOT_CLOSED)139 b(110)190 b(could)46 +b(not)h(close)g(the)f(file)48 3907 y(ARRAY_TOO_BIG)235 +b(111)190 b(array)46 b(dimensions)f(exceed)h(internal)g(limit)48 +4020 y(READONLY_FILE)235 b(112)190 b(Cannot)46 b(write)g(to)i(readonly) +d(file)48 4133 y(MEMORY_ALLOCATION)e(113)190 b(Could)46 +b(not)h(allocate)f(memory)48 4246 y(BAD_FILEPTR)331 b(114)190 +b(invalid)46 b(fitsfile)f(pointer)48 4359 y(NULL_INPUT_PTR)187 +b(115)j(NULL)47 b(input)f(pointer)g(to)h(routine)48 4472 +y(SEEK_ERROR)379 b(116)190 b(error)46 b(seeking)g(position)g(in)h(file) +48 4698 y(BAD_URL_PREFIX)235 b(121)142 b(invalid)46 b(URL)h(prefix)f +(on)h(file)g(name)48 4811 y(TOO_MANY_DRIVERS)139 b(122)j(tried)46 +b(to)h(register)f(too)h(many)g(IO)g(drivers)48 4924 y +(DRIVER_INIT_FAILED)c(123)142 b(driver)46 b(initialization)e(failed)48 +5036 y(NO_MATCHING_DRIVER)f(124)142 b(matching)45 b(driver)i(is)g(not)g +(registered)48 5149 y(URL_PARSE_ERROR)187 b(125)142 b(failed)46 +b(to)h(parse)g(input)f(file)h(URL)48 5262 y(RANGE_PARSE_ERROR)91 +b(126)142 b(parse)46 b(error)h(in)g(range)f(list)48 5488 +y(SHARED_BADARG)235 b(151)190 b(bad)47 b(argument)e(in)j(shared)e +(memory)g(driver)48 5601 y(SHARED_NULPTR)235 b(152)190 +b(null)47 b(pointer)e(passed)h(as)i(an)f(argument)48 +5714 y(SHARED_TABFULL)187 b(153)j(no)47 b(more)g(free)f(shared)g +(memory)h(handles)1882 5942 y Fj(157)p eop +%%Page: 158 166 +158 165 bop 0 299 a Fj(158)1589 b Fh(APPENDIX)31 b(C.)61 +b(CFITSIO)29 b(ERR)m(OR)h(ST)-8 b(A)g(TUS)30 b(CODES)48 +555 y Fe(SHARED_NOTINIT)187 b(154)j(shared)46 b(memory)g(driver)g(is)h +(not)g(initialized)48 668 y(SHARED_IPCERR)235 b(155)190 +b(IPC)47 b(error)f(returned)g(by)h(a)g(system)f(call)48 +781 y(SHARED_NOMEM)283 b(156)190 b(no)47 b(memory)f(in)h(shared)f +(memory)h(driver)48 894 y(SHARED_AGAIN)283 b(157)190 +b(resource)45 b(deadlock)h(would)g(occur)48 1007 y(SHARED_NOFILE)235 +b(158)190 b(attempt)46 b(to)h(open/create)e(lock)h(file)h(failed)48 +1120 y(SHARED_NORESIZE)139 b(159)190 b(shared)46 b(memory)g(block)g +(cannot)h(be)g(resized)f(at)h(the)g(moment)48 1346 y(HEADER_NOT_EMPTY) +91 b(201)190 b(header)46 b(already)g(contains)f(keywords)48 +1458 y(KEY_NO_EXIST)283 b(202)190 b(keyword)46 b(not)h(found)f(in)h +(header)48 1571 y(KEY_OUT_BOUNDS)187 b(203)j(keyword)46 +b(record)g(number)g(is)h(out)g(of)g(bounds)48 1684 y(VALUE_UNDEFINED) +139 b(204)190 b(keyword)46 b(value)g(field)g(is)i(blank)48 +1797 y(NO_QUOTE)475 b(205)190 b(string)46 b(is)h(missing)f(the)h +(closing)f(quote)48 1910 y(BAD_KEYCHAR)331 b(207)190 +b(illegal)46 b(character)f(in)i(keyword)f(name)h(or)g(card)48 +2023 y(BAD_ORDER)427 b(208)190 b(required)45 b(keywords)h(out)h(of)g +(order)48 2136 y(NOT_POS_INT)331 b(209)190 b(keyword)46 +b(value)g(is)h(not)g(a)h(positive)d(integer)48 2249 y(NO_END)571 +b(210)190 b(couldn't)45 b(find)i(END)g(keyword)48 2362 +y(BAD_BITPIX)379 b(211)190 b(illegal)46 b(BITPIX)g(keyword)g(value)48 +2475 y(BAD_NAXIS)427 b(212)190 b(illegal)46 b(NAXIS)g(keyword)g(value) +48 2588 y(BAD_NAXES)427 b(213)190 b(illegal)46 b(NAXISn)g(keyword)g +(value)48 2700 y(BAD_PCOUNT)379 b(214)190 b(illegal)46 +b(PCOUNT)g(keyword)g(value)48 2813 y(BAD_GCOUNT)379 b(215)190 +b(illegal)46 b(GCOUNT)g(keyword)g(value)48 2926 y(BAD_TFIELDS)331 +b(216)190 b(illegal)46 b(TFIELDS)g(keyword)f(value)48 +3039 y(NEG_WIDTH)427 b(217)190 b(negative)45 b(table)i(row)g(size)48 +3152 y(NEG_ROWS)475 b(218)190 b(negative)45 b(number)i(of)g(rows)f(in)i +(table)48 3265 y(COL_NOT_FOUND)235 b(219)190 b(column)46 +b(with)h(this)f(name)h(not)g(found)f(in)h(table)48 3378 +y(BAD_SIMPLE)379 b(220)190 b(illegal)46 b(value)g(of)h(SIMPLE)f +(keyword)48 3491 y(NO_SIMPLE)427 b(221)190 b(Primary)46 +b(array)g(doesn't)g(start)g(with)h(SIMPLE)48 3604 y(NO_BITPIX)427 +b(222)190 b(Second)46 b(keyword)g(not)h(BITPIX)48 3717 +y(NO_NAXIS)475 b(223)190 b(Third)46 b(keyword)g(not)h(NAXIS)48 +3830 y(NO_NAXES)475 b(224)190 b(Couldn't)45 b(find)i(all)g(the)g +(NAXISn)f(keywords)48 3942 y(NO_XTENSION)331 b(225)190 +b(HDU)47 b(doesn't)f(start)g(with)h(XTENSION)e(keyword)48 +4055 y(NOT_ATABLE)379 b(226)190 b(the)47 b(CHDU)f(is)i(not)f(an)g +(ASCII)f(table)g(extension)48 4168 y(NOT_BTABLE)379 b(227)190 +b(the)47 b(CHDU)f(is)i(not)f(a)g(binary)f(table)g(extension)48 +4281 y(NO_PCOUNT)427 b(228)190 b(couldn't)45 b(find)i(PCOUNT)f(keyword) +48 4394 y(NO_GCOUNT)427 b(229)190 b(couldn't)45 b(find)i(GCOUNT)f +(keyword)48 4507 y(NO_TFIELDS)379 b(230)190 b(couldn't)45 +b(find)i(TFIELDS)f(keyword)48 4620 y(NO_TBCOL)475 b(231)190 +b(couldn't)45 b(find)i(TBCOLn)f(keyword)48 4733 y(NO_TFORM)475 +b(232)190 b(couldn't)45 b(find)i(TFORMn)f(keyword)48 +4846 y(NOT_IMAGE)427 b(233)190 b(the)47 b(CHDU)f(is)i(not)f(an)g(IMAGE) +f(extension)48 4959 y(BAD_TBCOL)427 b(234)190 b(TBCOLn)46 +b(keyword)g(value)g(<)i(0)f(or)g(>)h(rowlength)48 5072 +y(NOT_TABLE)427 b(235)190 b(the)47 b(CHDU)f(is)i(not)f(a)g(table)48 +5185 y(COL_TOO_WIDE)283 b(236)190 b(column)46 b(is)h(too)g(wide)g(to)g +(fit)g(in)g(table)48 5297 y(COL_NOT_UNIQUE)187 b(237)j(more)47 +b(than)f(1)i(column)e(name)g(matches)g(template)48 5410 +y(BAD_ROW_WIDTH)235 b(241)190 b(sum)47 b(of)g(column)f(widths)g(not)h +(=)h(NAXIS1)48 5523 y(UNKNOWN_EXT)331 b(251)190 b(unrecognizable)44 +b(FITS)i(extension)g(type)48 5636 y(UNKNOWN_REC)331 b(252)190 +b(unknown)46 b(record;)g(1st)g(keyword)g(not)h(SIMPLE)f(or)h(XTENSION)p +eop +%%Page: 159 167 +159 166 bop 3764 299 a Fj(159)48 555 y Fe(END_JUNK)475 +b(253)190 b(END)47 b(keyword)f(is)h(not)g(blank)48 668 +y(BAD_HEADER_FILL)139 b(254)190 b(Header)46 b(fill)h(area)f(contains)g +(non-blank)f(chars)48 781 y(BAD_DATA_FILL)235 b(255)190 +b(Illegal)46 b(data)g(fill)h(bytes)f(\(not)h(zero)g(or)g(blank\))48 +894 y(BAD_TFORM)427 b(261)190 b(illegal)46 b(TFORM)g(format)g(code)48 +1007 y(BAD_TFORM_DTYPE)139 b(262)190 b(unrecognizable)44 +b(TFORM)i(data)h(type)f(code)48 1120 y(BAD_TDIM)475 b(263)190 +b(illegal)46 b(TDIMn)g(keyword)g(value)48 1233 y(BAD_HEAP_PTR)283 +b(264)190 b(invalid)46 b(BINTABLE)f(heap)i(pointer)f(is)h(out)g(of)g +(range)48 1458 y(BAD_HDU_NUM)331 b(301)190 b(HDU)47 b(number)f(<)h(1)48 +1571 y(BAD_COL_NUM)331 b(302)190 b(column)46 b(number)g(<)i(1)f(or)g(>) +h(tfields)48 1684 y(NEG_FILE_POS)283 b(304)190 b(tried)46 +b(to)h(move)g(to)g(negative)f(byte)g(location)g(in)h(file)48 +1797 y(NEG_BYTES)427 b(306)190 b(tried)46 b(to)h(read)g(or)g(write)g +(negative)e(number)h(of)h(bytes)48 1910 y(BAD_ROW_NUM)331 +b(307)190 b(illegal)46 b(starting)f(row)i(number)f(in)h(table)48 +2023 y(BAD_ELEM_NUM)283 b(308)190 b(illegal)46 b(starting)f(element)h +(number)g(in)h(vector)48 2136 y(NOT_ASCII_COL)235 b(309)190 +b(this)47 b(is)g(not)g(an)g(ASCII)f(string)g(column)48 +2249 y(NOT_LOGICAL_COL)139 b(310)190 b(this)47 b(is)g(not)g(a)g +(logical)f(data)h(type)f(column)48 2362 y(BAD_ATABLE_FORMAT)d(311)190 +b(ASCII)46 b(table)h(column)f(has)h(wrong)f(format)48 +2475 y(BAD_BTABLE_FORMAT)d(312)190 b(Binary)46 b(table)g(column)g(has)h +(wrong)g(format)48 2588 y(NO_NULL)523 b(314)190 b(null)47 +b(value)f(has)h(not)g(been)f(defined)48 2700 y(NOT_VARI_LEN)283 +b(317)190 b(this)47 b(is)g(not)g(a)g(variable)f(length)g(column)48 +2813 y(BAD_DIMEN)427 b(320)190 b(illegal)46 b(number)g(of)h(dimensions) +e(in)i(array)48 2926 y(BAD_PIX_NUM)331 b(321)190 b(first)46 +b(pixel)h(number)f(greater)g(than)g(last)h(pixel)48 3039 +y(ZERO_SCALE)379 b(322)190 b(illegal)46 b(BSCALE)g(or)h(TSCALn)f +(keyword)g(=)h(0)48 3152 y(NEG_AXIS)475 b(323)190 b(illegal)46 +b(axis)g(length)g(<)i(1)48 3378 y(NOT_GROUP_TABLE)330 +b(340)142 b(Grouping)46 b(function)f(error)48 3491 y +(HDU_ALREADY_MEMBER)186 b(341)48 3604 y(MEMBER_NOT_FOUND)282 +b(342)48 3717 y(GROUP_NOT_FOUND)330 b(343)48 3830 y(BAD_GROUP_ID)474 +b(344)48 3942 y(TOO_MANY_HDUS_TRACKED)42 b(345)48 4055 +y(HDU_ALREADY_TRACKED)138 b(346)48 4168 y(BAD_OPTION)570 +b(347)48 4281 y(IDENTICAL_POINTERS)186 b(348)48 4394 +y(BAD_GROUP_ATTACH)282 b(349)48 4507 y(BAD_GROUP_DETACH)g(350)48 +4733 y(NGP_NO_MEMORY)426 b(360)238 b(malloc)46 b(failed)48 +4846 y(NGP_READ_ERR)474 b(361)238 b(read)46 b(error)h(from)f(file)48 +4959 y(NGP_NUL_PTR)522 b(362)238 b(null)46 b(pointer)g(passed)g(as)h +(an)g(argument.)1575 5072 y(Passing)f(null)g(pointer)g(as)h(a)h(name)f +(of)1575 5185 y(template)f(file)g(raises)g(this)h(error)48 +5297 y(NGP_EMPTY_CURLINE)234 b(363)k(line)46 b(read)h(seems)f(to)h(be)h +(empty)e(\(used)1575 5410 y(internally\))48 5523 y +(NGP_UNREAD_QUEUE_FULL)c(364)238 b(cannot)46 b(unread)g(more)g(then)h +(1)g(line)g(\(or)g(single)1575 5636 y(line)g(twice\))p +eop +%%Page: 160 168 +160 167 bop 0 299 a Fj(160)1589 b Fh(APPENDIX)31 b(C.)61 +b(CFITSIO)29 b(ERR)m(OR)h(ST)-8 b(A)g(TUS)30 b(CODES)48 +555 y Fe(NGP_INC_NESTING)330 b(365)238 b(too)46 b(deep)h(include)f +(file)h(nesting)e(\(infinite)1575 668 y(loop,)h(template)g(includes)f +(itself)i(?\))48 781 y(NGP_ERR_FOPEN)426 b(366)238 b(fopen\(\))45 +b(failed,)h(cannot)g(open)h(template)e(file)48 894 y(NGP_EOF)714 +b(367)238 b(end)46 b(of)i(file)e(encountered)f(and)i(not)g(expected)48 +1007 y(NGP_BAD_ARG)522 b(368)238 b(bad)46 b(arguments)g(passed.)g +(Usually)f(means)1575 1120 y(internal)h(parser)g(error.)g(Should)g(not) +h(happen)48 1233 y(NGP_TOKEN_NOT_EXPECT)90 b(369)238 +b(token)46 b(not)h(expected)e(here)48 1458 y(BAD_I2C)523 +b(401)190 b(bad)47 b(int)g(to)g(formatted)e(string)h(conversion)48 +1571 y(BAD_F2C)523 b(402)190 b(bad)47 b(float)f(to)h(formatted)f +(string)g(conversion)48 1684 y(BAD_INTKEY)379 b(403)190 +b(can't)46 b(interpret)g(keyword)f(value)i(as)g(integer)48 +1797 y(BAD_LOGICALKEY)187 b(404)j(can't)46 b(interpret)g(keyword)f +(value)i(as)g(logical)48 1910 y(BAD_FLOATKEY)283 b(405)190 +b(can't)46 b(interpret)g(keyword)f(value)i(as)g(float)48 +2023 y(BAD_DOUBLEKEY)235 b(406)190 b(can't)46 b(interpret)g(keyword)f +(value)i(as)g(double)48 2136 y(BAD_C2I)523 b(407)190 +b(bad)47 b(formatted)e(string)h(to)h(int)g(conversion)48 +2249 y(BAD_C2F)523 b(408)190 b(bad)47 b(formatted)e(string)h(to)h +(float)g(conversion)48 2362 y(BAD_C2D)523 b(409)190 b(bad)47 +b(formatted)e(string)h(to)h(double)f(conversion)48 2475 +y(BAD_DATATYPE)283 b(410)190 b(illegal)46 b(datatype)f(code)i(value)48 +2588 y(BAD_DECIM)427 b(411)190 b(bad)47 b(number)f(of)h(decimal)f +(places)g(specified)48 2700 y(NUM_OVERFLOW)283 b(412)190 +b(overflow)45 b(during)i(data)f(type)h(conversion)48 +2813 y(DATA_COMPRESSION_ERR)137 b(413)95 b(error)46 b(compressing)f +(image)48 2926 y(DATA_DECOMPRESSION_ERR)c(414)95 b(error)46 +b(uncompressing)f(image)48 3152 y(BAD_DATE)475 b(420)190 +b(error)46 b(in)h(date)g(or)g(time)g(conversion)48 3378 +y(PARSE_SYNTAX_ERR)91 b(431)190 b(syntax)46 b(error)g(in)i(parser)e +(expression)48 3491 y(PARSE_BAD_TYPE)187 b(432)j(expression)45 +b(did)i(not)g(evaluate)e(to)i(desired)f(type)48 3604 +y(PARSE_LRG_VECTOR)91 b(433)190 b(vector)46 b(result)g(too)h(large)f +(to)i(return)e(in)h(array)48 3717 y(PARSE_NO_OUTPUT)139 +b(434)190 b(data)47 b(parser)f(failed)g(not)h(sent)f(an)h(out)g(column) +48 3830 y(PARSE_BAD_COL)235 b(435)190 b(bad)47 b(data)f(encounter)g +(while)g(parsing)g(column)48 3942 y(PARSE_BAD_OUTPUT)91 +b(436)190 b(Output)46 b(file)h(not)g(of)g(proper)f(type)48 +4168 y(ANGLE_TOO_BIG)235 b(501)190 b(celestial)45 b(angle)i(too)f +(large)h(for)g(projection)48 4281 y(BAD_WCS_VAL)331 b(502)190 +b(bad)47 b(celestial)e(coordinate)g(or)i(pixel)g(value)48 +4394 y(WCS_ERROR)427 b(503)190 b(error)46 b(in)h(celestial)f +(coordinate)f(calculation)48 4507 y(BAD_WCS_PROJ)283 +b(504)190 b(unsupported)45 b(type)h(of)h(celestial)f(projection)48 +4620 y(NO_WCS_KEY)379 b(505)190 b(celestial)45 b(coordinate)g(keywords) +h(not)h(found)48 4733 y(APPROX_WCS_KEY)187 b(506)j(approximate)45 +b(wcs)i(keyword)e(values)h(were)h(returned)p eop +%%Trailer +end +userdict /end-hook known{end-hook}if +%%EOF diff --git a/pkg/tbtables/cfitsio/cfitsio.tex b/pkg/tbtables/cfitsio/cfitsio.tex new file mode 100644 index 00000000..6375fdbf --- /dev/null +++ b/pkg/tbtables/cfitsio/cfitsio.tex @@ -0,0 +1,9422 @@ +\documentclass[11pt]{book} +\input{html.sty} +\htmladdtonavigation + {\begin{rawhtml} + FITSIO Home + \end{rawhtml}} +\oddsidemargin=0.00in +\evensidemargin=0.00in +\textwidth=6.5in +%\topmargin=0.0in +\textheight=8.75in +\parindent=0cm +\parskip=0.2cm +\begin{document} +\pagenumbering{roman} + +\begin{titlepage} +\normalsize +\vspace*{4.0cm} +\begin{center} +{\Huge \bf CFITSIO User's Reference Guide}\\ +\end{center} +\medskip +\medskip +\begin{center} +{\LARGE \bf An Interface to FITS Format Files}\\ +\end{center} +\begin{center} +{\LARGE \bf for C Programmers}\\ +\end{center} +\medskip +\medskip +\begin{center} +{\Large Version 2.5 \\} +\end{center} +\bigskip +\vskip 2.5cm +\begin{center} +{HEASARC\\ +Code 662\\ +Goddard Space Flight Center\\ +Greenbelt, MD 20771\\ +USA} +\end{center} + +\vfill +\bigskip +\begin{center} +{\Large December 2004\\} +\end{center} +\vfill +\end{titlepage} + +\clearpage + +\tableofcontents +\chapter{Introduction } +\pagenumbering{arabic} + + +\section{ A Brief Overview} + +CFITSIO is a machine-independent library of routines for reading and +writing data files in the FITS (Flexible Image Transport System) data +format. It can also read IRAF format image files and raw binary data +arrays by converting them on the fly into a virtual FITS format file. +This library is written in ANSI C and provides a powerful yet simple +interface for accessing FITS files which will run on most commonly used +computers and workstations. CFITSIO supports all the features +described in the official NOST definition of the FITS format and can +read and write all the currently defined types of extensions, including +ASCII tables (TABLE), Binary tables (BINTABLE) and IMAGE extensions. +The CFITSIO routines insulate the programmer from having to deal with +the complicated formatting details in the FITS file, however, it is +assumed that users have a general knowledge about the structure and +usage of FITS files. + +CFITSIO also contains a set of Fortran callable wrapper routines which +allow Fortran programs to call the CFITSIO routines. See the companion +``FITSIO User's Guide'' for the definition of the Fortran subroutine +calling sequences. These wrappers replace the older Fortran FITSIO +library which is no longer supported. + +The CFITSIO package was initially developed by the HEASARC (High Energy +Astrophysics Science Archive Research Center) at the NASA Goddard Space +Flight Center to convert various existing and newly acquired +astronomical data sets into FITS format and to further analyze data +already in FITS format. New features continue to be added to CFITSIO +in large part due to contributions of ideas or actual code from +users of the package. The Integral Science Data Center in Switzerland, +and the XMM/ESTEC project in The Netherlands made especially significant +contributions that resulted in many of the new features that appeared +in v2.0 of CFITSIO. + + +\section{Sources of FITS Software and Information} + +The latest version of the CFITSIO source code, +documentation, and example programs are available on the World-Wide +Web or via anonymous ftp from: + +\begin{verbatim} + http://heasarc.gsfc.nasa.gov/fitsio + ftp://legacy.gsfc.nasa.gov/software/fitsio/c +\end{verbatim} + +Any questions, bug reports, or suggested enhancements related to the CFITSIO +package should be sent to the primary author: + +\begin{verbatim} + Dr. William Pence Telephone: (301) 286-4599 + HEASARC, Code 662 E-mail: pence@tetra.gsfc.nasa.gov + NASA/Goddard Space Flight Center + Greenbelt, MD 20771, USA +\end{verbatim} +This User's Guide assumes that readers already have a general +understanding of the definition and structure of FITS format files. +Further information about FITS formats is available from the FITS Support +Office at {\tt http://fits.gsfc.nasa.gov}. In particular, the +'NOST FITS Standard' gives the authoritative definition of the FITS data +format, and the `FITS User's Guide' provides additional historical background +and practical advice on using FITS files. + +The HEASARC also provides a very sophisticated FITS file analysis +program called `Fv' which can be used to display and edit the contents +of any FITS file as well as construct new FITS files from scratch. The +display functions in Fv allow users to interactively adjust the +brightness and contrast of images, pan, zoom, and blink images, and +measure the positions and brightnesses of objects within images. FITS +tables can be displayed like a spread sheet, and then modified using +powerful calculator and sorting functions. Fv is freely available for +most Unix platforms, Mac PCs, and Windows PCs. +CFITSIO users may also be interested in the FTOOLS package of programs +that can be used to manipulate and analyze FITS format files. +Fv and FTOOLS are available from their respective Web sites at: + +\begin{verbatim} + http://fv.gsfc.nasa.gov + http://heasarc.gsfc.nasa.gov/ftools +\end{verbatim} + + +\section{Acknowledgements} + +The development of the powerful features in CFITSIO was made +possible through collaborations with many people or organizations from +around the world. The following in particular have made especially +significant contributions: + +Programmers from the Integral Science Data Center, Switzerland (namely, +Jurek Borkowski, Bruce O'Neel, and Don Jennings), designed the concept +for the plug-in I/O drivers that was introduced with CFITSIO 2.0. The +use of `drivers' greatly simplified the low-level I/O, which in turn +made other new features in CFITSIO (e.g., support for compressed FITS +files and support for IRAF format image files) much easier to +implement. Jurek Borkowski wrote the Shared Memory driver, and Bruce +O'Neel wrote the drivers for accessing FITS files over the network +using the FTP, HTTP, and ROOT protocols. + +The ISDC also provided the template parsing routines (written by Jurek +Borkowski) and the hierarchical grouping routines (written by Don +Jennings). The ISDC DAL (Data Access Layer) routines are layered on +top of CFITSIO and make extensive use of these features. + +Uwe Lammers (XMM/ESA/ESTEC, The Netherlands) designed the +high-performance lexical parsing algorithm that is used to do +on-the-fly filtering of FITS tables. This algorithm essentially +pre-compiles the user-supplied selection expression into a form that +can be rapidly evaluated for each row. Peter Wilson (RSTX, NASA/GSFC) +then wrote the parsing routines used by CFITSIO based on Lammers' +design, combined with other techniques such as the CFITSIO iterator +routine to further enhance the data processing throughput. This effort +also benefited from a much earlier lexical parsing routine that was +developed by Kent Blackburn (NASA/GSFC). More recently, Craig Markwardt +(NASA/GSFC) implemented additional functions (median, average, stddev) +and other enhancements to the lexical parser. + +The CFITSIO iterator function is loosely based on similar ideas +developed for the XMM Data Access Layer. + +Peter Wilson (RSTX, NASA/GSFC) wrote the complete set of +Fortran-callable wrappers for all the CFITSIO routines, which in turn +rely on the CFORTRAN macro developed by Burkhard Burow. + +The syntax used by CFITSIO for filtering or binning input FITS files is +based on ideas developed for the AXAF Science Center Data Model by +Jonathan McDowell, Antonella Fruscione, Aneta Siemiginowska and Bill +Joye. See http://heasarc.gsfc.nasa.gov/docs/journal/axaf7.html for +further description of the AXAF Data Model. + +The file decompression code were taken directly from the gzip (GNU zip) +program developed by Jean-loup Gailly and others. + +The new compressed image data format (where the image is tiled and +the compressed byte stream from each tile is stored in a binary table) +was implemented in collaboration with Richard White (STScI), Perry +Greenfield (STScI) and Doug Tody (NOAO). + +Doug Mink (SAO) provided the routines for converting IRAF format +images into FITS format. + +In addition, many other people have made valuable contributions to the +development of CFITSIO. These include (with apologies to others that may +have inadvertently been omitted): + +Steve Allen, Carl Akerlof, Keith Arnaud, Morten Krabbe Barfoed, Kent +Blackburn, G Bodammer, Romke Bontekoe, Lucio Chiappetti, Keith Costorf, +Robin Corbet, John Davis, Richard Fink, Ning Gan, Emily Greene, Gretchen +Green, Joe Harrington, Cheng Ho, Phil Hodge, Jim Ingham, Yoshitaka +Ishisaki, Diab Jerius, Mark Levine, Todd Karakaskian, Edward King, +Scott Koch, Claire Larkin, Rob Managan, Eric Mandel, Richard Mathar, +John Mattox, Carsten Meyer, Emi Miyata, Stefan Mochnacki, Mike Noble, +Oliver Oberdorf, Clive Page, Arvind Parmar, Jeff Pedelty, Tim Pearson, +Philippe Prugniel, Maren Purves, Scott Randall, Chris Rogers, Arnold Rots, +Barry Schlesinger, Robin Stebbins, Andrew Szymkowiak, Allyn Tennant, +Peter Teuben, James Theiler, Doug Tody, Shiro Ueno, Steve Walton, Archie +Warnock, Alan Watson, Dan Whipple, Wim Wimmers, Peter Young, Jianjun Xu, +and Nelson Zarate. + + +\section{Legal Stuff} + +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. +(However, see the restriction on the use of the gzip compression code, +below). + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER." + +The file compress.c contains (slightly modified) source code that +originally came from gzip-1.2.4, copyright (C) 1992-1993 by Jean-loup +Gailly. This gzip code is distributed under the GNU General Public +License and thus requires that any software that uses the CFITSIO +library (which in turn uses the gzip code) must conform to the +provisions in the GNU General Public License. A copy of the GNU +license is included at the beginning of compress.c file. + +An alternate version of the compress.c file (called +compress\_alternate.c) is provided for users who want to use the CFITSIO +library but are unwilling or unable to publicly release their software +under the terms of the GNU General Public License. This alternate +version contains non-functional stubs for the file compression and +uncompression routines used by CFITSIO. Replace the file `compress.c' +with `compress\_alternate.c' before compiling the CFITSIO library. This +will produce a version of CFITSIO which does not support reading or +writing compressed FITS files but is otherwise identical to the +standard version. + +\chapter{ Creating the CFITSIO Library } + + +\section{Building the Library} + +The CFITSIO code is contained in about 40 C source files (*.c) and header +files (*.h). On VAX/VMS systems 2 assembly-code files (vmsieeed.mar and +vmsieeer.mar) are also needed. + +CFITSIO has currently been tested on the following platforms: + +\begin{verbatim} + OPERATING SYSTEM COMPILER + Sun OS gcc and cc (3.0.1) + Sun Solaris gcc and cc + Silicon Graphics IRIX gcc and cc + Silicon Graphics IRIX64 MIPS + Dec Alpha OSF/1 gcc and cc + DECstation Ultrix gcc + Dec Alpha OpenVMS cc + DEC VAX/VMS gcc and cc + HP-UX gcc + IBM AIX gcc + Linux gcc + MkLinux DR3 + Windows 95/98/NT Borland C++ V4.5 + Windows 95/98/NT/ME/XP Microsoft/Compaq Visual C++ v5.0, v6.0 + Windows 95/98/NT Cygwin gcc + MacOS 7.1 or greater Metrowerks 10.+ + MacOS-X 10.1 or greater cc (gcc) +\end{verbatim} +CFITSIO will probably run on most other Unix platforms. Cray +supercomputers are currently not supported. + + +\subsection{Unix Systems} + +The CFITSIO library is built on Unix systems by typing: + +\begin{verbatim} + > ./configure [--prefix=/target/installation/path] + > make (or 'make shared') + > make install (this step is optional) +\end{verbatim} +at the operating system prompt. The configure command customizes the +Makefile for the particular system, then the `make' command compiles the +source files and builds the library. Type `./configure' and not simply +`configure' to ensure that the configure script in the current directory +is run and not some other system-wide configure script. The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, + +\begin{verbatim} + > ./configure --prefix=/usr1/local +\end{verbatim} +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include files to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +The 'make shared' option builds a shared or dynamic version of the +CFITSIO library. When using the shared library the executable code is +not copied into your program at link time and instead the program +locates the necessary library code at run time, normally through +LD\_LIBRARY\_PATH or some other method. The advantages of using a shared +library are: + +\begin{verbatim} + 1. Less disk space if you build more than 1 program + 2. Less memory if more than one copy of a program using the shared + library is running at the same time since the system is smart + enough to share copies of the shared library at run time. + 3. Possibly easier maintenance since a new version of the shared + library can be installed without relinking all the software + that uses it (as long as the subroutine names and calling + sequences remain unchanged). + 4. No run-time penalty. +\end{verbatim} +The disadvantages are: + +\begin{verbatim} + 1. More hassle at runtime. You have to either build the programs + specially or have LD_LIBRARY_PATH set right. + 2. There may be a slight start up penalty, depending on where you are + reading the shared library and the program from and if your CPU is + either really slow or really heavily loaded. +\end{verbatim} + +On Mac OS X platforms the 'make shared' command works like on other +UNIX platforms, but a .dylib file will be created instead of .so. If +installed in a nonstandard location, add its location to the +DYLD\_LIBRARY\_PATH environment variable so that the library can be found +at run time. + +On HP/UX systems, the environment variable CFLAGS should be set +to -Ae before running configure to enable "extended ANSI" features. + +By default, a set of Fortran-callable wrapper routines are +also built and included in the CFITSIO library. If these wrapper +routines are not needed (i.e., the CFITSIO library will not +be linked to any Fortran applications which call FITSIO subroutines) +then they may be omitted from the build by typing 'make all-nofitsio' +instead of simply typing 'make'. This will reduce the size +of the CFITSIO library slightly. + +Most 32-bit operating systems have only supported disk files up to 2.1GB +(2**31 bytes) in size. Starting with version 2.1 of CFITSIO, FITS files +larger than this limit (up to 6 terabytes) can be read and written on +platforms that support large files (e.g., at least some LINUX platforms +and Solaris). To enable this +feature, CFITSIO must be compiled with the '-D\_LARGEFILE\_SOURCE' and +`-D\_FILE\_OFFSET\_BITS=64' +compiler flags. Some platforms may also require the `-D\_LARGE\_FILES' +compiler flag. It appears that in most cases it is not necessary to +also include these compiler flags when compiling programs that link to +the CFITSIO library. See the `CFITSIO Size Limitations' +section in Chapter 4 for further details. + +It may not be possible to staticly link programs that use CFITSIO on +some platforms (namely, on Solaris 2.6) due to the network drivers +(which provide FTP and HTTP access to FITS files). It is possible to +make both a dynamic and a static version of the CFITSIO library, but +network file access will not be possible using the static version. + + +\subsection{VMS} + +On VAX/VMS and ALPHA/VMS systems the make\_gfloat.com command file may +be executed to build the cfitsio.olb object library using the default +G-floating point option for double variables. The make\_dfloat.com and +make\_ieee.com files may be used instead to build the library with the +other floating point options. Note that the getcwd function that is +used in the group.c module may require that programs using CFITSIO be +linked with the ALPHA\$LIBRARY:VAXCRTL.OLB library. See the example +link line in the next section of this document. + + +\subsection{Windows PCs} + +A precompiled DLL version of CFITSIO is available for IBM-PC users of +the Borland or Microsoft Visual C++ compilers in the files +cfitsiodll\_2xxx\_borland.zip and cfitsiodll\_2xxx\_vcc.zip, where +'2xxx' represents the current release number. These zip archives also +contains other files and instructions on how to use the CFITSIO DLL +library. + +The CFITSIO library may also be built from the source code using the +makefile.bc or makefile.vcc files. Finally, the makepc.bat file gives +an example of building CFITSIO with the Borland C++ v4.5 compiler +using older DOS commands. + + +\subsection{Macintosh PCs} + +When building on Mac OS-X, users should follow the Unix instructions, +above. + +The classic MacOS version (OS 9 or earlier) of the CFITSIO library can +be built by (1) un binhex and unstuff cfitsio\_mac.sit.hqx, (2) put +CFitsioPPC.mcp in the cfitsio directory, and (3) load CFitsioPPC.mcp +into CodeWarrior Pro 5 and make. This builds the CFITSIO library for +PPC. There are also targets for both the test program and the speed +test program. + +To use the MacOS port you can add Cfitsio PPC.lib to your CodeWarrior +Pro 5 project. Note that this only has been tested for the PPC and +probably won't work on 68k Macs. + + + +\section{Testing the Library} + +The CFITSIO library should be tested by building and running +the testprog.c program that is included with the release. +On Unix systems, type: + +\begin{verbatim} + % make testprog + % testprog > testprog.lis + % diff testprog.lis testprog.out + % cmp testprog.fit testprog.std +\end{verbatim} + On VMS systems, +(assuming cc is the name of the C compiler command), type: + +\begin{verbatim} + $ cc testprog.c + $ link testprog, cfitsio/lib, alpha$library:vaxcrtl/lib + $ run testprog +\end{verbatim} +The test program should produce a FITS file called `testprog.fit' +that is identical to the `testprog.std' FITS file included with this +release. The diagnostic messages (which were piped to the file +testprog.lis in the Unix example) should be identical to the listing +contained in the file testprog.out. The 'diff' and 'cmp' commands +shown above should not report any differences in the files. (There +may be some minor format differences, such as the presence or +absence of leading zeros, or 3 digit exponents in numbers, +which can be ignored). + +The Fortran wrappers in CFITSIO may be tested with the testf77 +program on Unix systems with: + +\begin{verbatim} + % f77 -o testf77 testf77.f -L. -lcfitsio -lnsl -lsocket + or + % f77 -f -o testf77 testf77.f -L. -lcfitsio (under SUN O/S) + or + % f77 -o testf77 testf77.f -Wl,-L. -lcfitsio -lm -lnsl -lsocket (HP/UX) + + % testf77 > testf77.lis + % diff testf77.lis testf77.out + % cmp testf77.fit testf77.std +\end{verbatim} +On machines running SUN O/S, Fortran programs must be compiled with the +'-f' option to force double precision variables to be aligned on 8-byte +boundarys to make the fortran-declared variables compatible with C. A +similar compiler option may be required on other platforms. Failing to +use this option may cause the program to crash on FITSIO routines that +read or write double precision variables. + +Also note that on some systems, the output listing of the testf77 +program may differ slightly from the testf77.std template, if leading +zeros are not printed by default before the decimal point when using F +format. + +A few other utility programs are included with CFITSIO; the first four +of this programs can be compiled an linked by typing `make +program\_name' where `program\_name' is the actual name of the program: + +\begin{verbatim} + speed - measures the maximum throughput (in MB per second) + for writing and reading FITS files with CFITSIO. + + listhead - lists all the header keywords in any FITS file + + fitscopy - copies any FITS file (especially useful in conjunction + with the CFITSIO's extended input filename syntax). + + cookbook - a sample program that performs common read and + write operations on a FITS file. + + iter_a, iter_b, iter_c - examples of the CFITSIO iterator routine +\end{verbatim} + + +\section{Linking Programs with CFITSIO} + +When linking applications software with the CFITSIO library, several +system libraries usually need to be specified on the link command +line. On Unix systems, the most reliable way to determine what +libraries are required is to type 'make testprog' and see what +libraries the configure script has added. The typical libraries that +need to be added are -lm (the math library) and -lnsl and -lsocket +(needed only for FTP and HTTP file access). These latter 2 libraries +are not needed on VMS and Windows platforms, because FTP file access is +not currently supported on those platforms. + +Note that when upgrading to a newer version of CFITSIO it is usually +necessary to recompile, as well as relink, the programs that use CFITSIO, +because the definitions in fitsio.h often change. + + +\section{Getting Started with CFITSIO} + +In order to effectively use the CFITSIO library it is recommended that +new users begin by reading the ``CFITSIO Quick Start Guide''. It +contains all the basic information needed to write programs that +perform most types of operations on FITS files. The set of example +FITS utility programs that are available from the CFITSIO web site are +also very useful for learning how to use CFITSIO. To learn even more +about the capabilities of the CFITSIO library the following steps are +recommended: + +1. Read the following short `FITS Primer' chapter for an overview of +the structure of FITS files. + +2. Review the Programming Guidelines in Chapter 4 to become familiar +with the conventions used by the CFITSIO interface. + +3. Refer to the cookbook.c, listhead.c, and fitscopy.c programs that +are included with this release for examples of routines that perform +various common FITS file operations. Type 'make program\_name' to +compile and link these programs on Unix systems. + +4. Write a simple program to read or write a FITS file using the Basic +Interface routines described in Chapter 5. + +5. Scan through the more specialized routines that are described in +the following chapters to become familiar with the functionality that +they provide. + + +\section{Example Program} + +The following listing shows an example of how to use the CFITSIO +routines in a C program. Refer to the cookbook.c program that is +included with the CFITSIO distribution for other example routines. + +This program creates a new FITS file, containing a FITS image. An +`EXPOSURE' keyword is written to the header, then the image data are +written to the FITS file before closing the FITS file. + +\begin{verbatim} +#include "fitsio.h" /* required by every program that uses CFITSIO */ +main() +{ + fitsfile *fptr; /* pointer to the FITS file; defined in fitsio.h */ + int status, ii, jj; + long fpixel = 1, naxis = 2, nelements, exposure; + long naxes[2] = { 300, 200 }; /* image is 300 pixels wide by 200 rows */ + short array[200][300]; + + status = 0; /* initialize status before calling fitsio routines */ + fits_create_file(&fptr, "testfile.fits", &status); /* create new file */ + + /* Create the primary array image (16-bit short integer pixels */ + fits_create_img(fptr, SHORT_IMG, naxis, naxes, &status); + + /* Write a keyword; must pass the ADDRESS of the value */ + exposure = 1500.; + fits_update_key(fptr, TLONG, "EXPOSURE", &exposure, + "Total Exposure Time", &status); + + /* Initialize the values in the image with a linear ramp function */ + for (jj = 0; jj < naxes[1]; jj++) + for (ii = 0; ii < naxes[0]; ii++) + array[jj][ii] = ii + jj; + + nelements = naxes[0] * naxes[1]; /* number of pixels to write */ + + /* Write the array of integers to the image */ + fits_write_img(fptr, TSHORT, fpixel, nelements, array[0], &status); + + fits_close_file(fptr, &status); /* close the file */ + + fits_report_error(stderr, status); /* print out any error messages */ + return( status ); +} +\end{verbatim} + +\chapter{ A FITS Primer } + +This section gives a brief overview of the structure of FITS files. +Users should refer to the documentation available from the NOST, as +described in the introduction, for more detailed information on FITS +formats. + +FITS was first developed in the late 1970's as a standard data +interchange format between various astronomical observatories. Since +then FITS has become the standard data format supported by most +astronomical data analysis software packages. + +A FITS file consists of one or more Header + Data Units (HDUs), where +the first HDU is called the `Primary HDU', or `Primary Array'. The +primary array contains an N-dimensional array of pixels, such as a 1-D +spectrum, a 2-D image, or a 3-D data cube. Five different primary +data types are supported: Unsigned 8-bit bytes, 16 and 32-bit signed +integers, and 32 and 64-bit floating point reals. FITS also has a +convention for storing 16 and 32-bit unsigned integers (see the later +section entitled `Unsigned Integers' for more details). The primary HDU +may also consist of only a header with a null array containing no +data pixels. + +Any number of additional HDUs may follow the primary array; these +additional HDUs are called FITS `extensions'. There are currently 3 +types of extensions defined by the FITS standard: + +\begin{itemize} +\item + Image Extension - a N-dimensional array of pixels, like in a primary array +\item + ASCII Table Extension - rows and columns of data in ASCII character format +\item + Binary Table Extension - rows and columns of data in binary representation +\end{itemize} + +In each case the HDU consists of an ASCII Header Unit followed by an optional +Data Unit. For historical reasons, each Header or Data unit must be an +exact multiple of 2880 8-bit bytes long. Any unused space is padded +with fill characters (ASCII blanks or zeros). + +Each Header Unit consists of any number of 80-character keyword records +or `card images' which have the +general form: + +\begin{verbatim} + KEYNAME = value / comment string + NULLKEY = / comment: This keyword has no value +\end{verbatim} +The keyword names may be up to 8 characters long and can only contain +uppercase letters, the digits 0-9, the hyphen, and the underscore +character. The keyword name is (usually) followed by an equals sign and +a space character (= ) in columns 9 - 10 of the record, followed by the +value of the keyword which may be either an integer, a floating point +number, a character string (enclosed in single quotes), or a boolean +value (the letter T or F). A keyword may also have a null or undefined +value if there is no specified value string, as in the second example, above + +The last keyword in the header is always the `END' keyword which has no +value or comment fields. There are many rules governing the exact +format of a keyword record (see the NOST FITS Standard) so it is better +to rely on standard interface software like CFITSIO to correctly +construct or to parse the keyword records rather than try to deal +directly with the raw FITS formats. + +Each Header Unit begins with a series of required keywords which depend +on the type of HDU. These required keywords specify the size and +format of the following Data Unit. The header may contain other +optional keywords to describe other aspects of the data, such as the +units or scaling values. Other COMMENT or HISTORY keywords are also +frequently added to further document the data file. + +The optional Data Unit immediately follows the last 2880-byte block in +the Header Unit. Some HDUs do not have a Data Unit and only consist of +the Header Unit. + +If there is more than one HDU in the FITS file, then the Header Unit of +the next HDU immediately follows the last 2880-byte block of the +previous Data Unit (or Header Unit if there is no Data Unit). + +The main required keywords in FITS primary arrays or image extensions are: +\begin{itemize} +\item +BITPIX -- defines the data type of the array: 8, 16, 32, -32, -64 for +unsigned 8--bit byte, 16--bit signed integer, 32--bit signed integer, +32--bit IEEE floating point, and 64--bit IEEE double precision floating +point, respectively. +\item +NAXIS -- the number of dimensions in the array, usually 0, 1, 2, 3, or 4. +\item +NAXISn -- (n ranges from 1 to NAXIS) defines the size of each dimension. +\end{itemize} + +FITS tables start with the keyword XTENSION = `TABLE' (for ASCII +tables) or XTENSION = `BINTABLE' (for binary tables) and have the +following main keywords: +\begin{itemize} +\item +TFIELDS -- number of fields or columns in the table +\item +NAXIS2 -- number of rows in the table +\item +TTYPEn -- for each column (n ranges from 1 to TFIELDS) gives the +name of the column +\item +TFORMn -- the data type of the column +\item +TUNITn -- the physical units of the column (optional) +\end{itemize} + +Users should refer to the FITS Support Office at {\tt http://fits.gsfc.nasa.gov} +for futher information about the FITS format and related software +packages. + + +\chapter{ Programming Guidelines } + + +\section{CFITSIO Definitions} + +Any program that uses the CFITSIO interface must include the fitsio.h +header file with the statement + +\begin{verbatim} + #include "fitsio.h" +\end{verbatim} +This header file contains the prototypes for all the CFITSIO user +interface routines as well as the definitions of various constants used +in the interface. It also defines a C structure of type `fitsfile' +that is used by CFITSIO to store the relevant parameters that define +the format of a particular FITS file. Application programs must define +a pointer to this structure for each FITS file that is to be opened. +This structure is initialized (i.e., memory is allocated for the +structure) when the FITS file is first opened or created with the +fits\_open\_file or fits\_create\_file routines. This fitsfile pointer +is then passed as the first argument to every other CFITSIO routine +that operates on the FITS file. Application programs must not directly +read or write elements in this fitsfile structure because the +definition of the structure may change in future versions of CFITSIO. + +A number of symbolic constants are also defined in fitsio.h for the +convenience of application programmers. Use of these symbolic +constants rather than the actual numeric value will help to make the +source code more readable and easier for others to understand. + +\begin{verbatim} +String Lengths, for use when allocating character arrays: + + #define FLEN_FILENAME 1025 /* max length of a filename */ + #define FLEN_KEYWORD 72 /* max length of a keyword */ + #define FLEN_CARD 81 /* max length of a FITS header card */ + #define FLEN_VALUE 71 /* max length of a keyword value string */ + #define FLEN_COMMENT 73 /* max length of a keyword comment string */ + #define FLEN_ERRMSG 81 /* max length of a CFITSIO error message */ + #define FLEN_STATUS 31 /* max length of a CFITSIO status text string */ + + Note that FLEN_KEYWORD is longer than the nominal 8-character keyword + name length because the HIERARCH convention supports longer keyword names. + +Access modes when opening a FITS file: + + #define READONLY 0 + #define READWRITE 1 + +BITPIX data type code values for FITS images: + + #define BYTE_IMG 8 /* 8-bit unsigned integers */ + #define SHORT_IMG 16 /* 16-bit signed integers */ + #define LONG_IMG 32 /* 32-bit signed integers */ + #define FLOAT_IMG -32 /* 32-bit single precision floating point */ + #define DOUBLE_IMG -64 /* 64-bit double precision floating point */ + + The following 4 data type codes are also supported by CFITSIO: + #define LONGLONG_IMG 64 /* 64-bit long signed integers */ + #define SBYTE_IMG 10 /* 8-bit signed integers, equivalent to */ + /* BITPIX = 8, BSCALE = 1, BZERO = -128 */ + #define USHORT_IMG 20 /* 16-bit unsigned integers, equivalent to */ + /* BITPIX = 16, BSCALE = 1, BZERO = 32768 */ + #define ULONG_IMG 40 /* 32-bit unsigned integers, equivalent to */ + /* BITPIX = 32, BSCALE = 1, BZERO = 2147483648 */ + +Codes for the data type of binary table columns and/or for the +data type of variables when reading or writing keywords or data: + + DATATYPE TFORM CODE + #define TBIT 1 /* 'X' */ + #define TBYTE 11 /* 8-bit unsigned byte, 'B' */ + #define TLOGICAL 14 /* logicals (int for keywords */ + /* and char for table cols 'L' */ + #define TSTRING 16 /* ASCII string, 'A' */ + #define TSHORT 21 /* signed short, 'I' */ + #define TINT32BIT 41 /* signed 32-bit int, 'J' */ + #define TLONG 41 /* signed long, */ + #define TFLOAT 42 /* single precision float, 'E' */ + #define TDOUBLE 82 /* double precision float, 'D' */ + #define TCOMPLEX 83 /* complex (pair of floats) 'C' */ + #define TDBLCOMPLEX 163 /* double complex (2 doubles) 'M' */ + + The following data type codes are also supported by CFITSIO: + #define TINT 31 /* int */ + #define TSBYTE 12 /* 8-bit signed byte, 'S' */ + #define TUINT 30 /* unsigned int 'V' */ + #define TUSHORT 20 /* unsigned short 'U' */ + #define TULONG 40 /* unsigned long */ + #define TLONGLONG 81 /* 64-bit long signed integer 'K' */ + +HDU type code values (value returned when moving to new HDU): + + #define IMAGE_HDU 0 /* Primary Array or IMAGE HDU */ + #define ASCII_TBL 1 /* ASCII table HDU */ + #define BINARY_TBL 2 /* Binary table HDU */ + #define ANY_HDU -1 /* matches any type of HDU */ + +Column name and string matching case-sensitivity: + + #define CASESEN 1 /* do case-sensitive string match */ + #define CASEINSEN 0 /* do case-insensitive string match */ + +Logical states (if TRUE and FALSE are not already defined): + + #define TRUE 1 + #define FALSE 0 + +Values to represent undefined floating point numbers: + + #define FLOATNULLVALUE -9.11912E-36F + #define DOUBLENULLVALUE -9.1191291391491E-36 + +Image compression algorithm definitions + + #define RICE_1 11 + #define GZIP_1 21 + #define PLIO_1 31 +\end{verbatim} + + +\section{Current Header Data Unit (CHDU)} + +The concept of the Current Header and Data Unit, or CHDU, is +fundamental to the use of the CFITSIO library. A simple FITS image may +only contain a single Header and Data unit (HDU), but in general FITS +files can contain multiple Header Data Units (also known as +`extensions'), concatenated one after the other in the file. The user +can specify which HDU should be initially opened at run time by giving +the HDU name or number after the root file name. For example, +'myfile.fits[4]' opens the 5th HDU in the file (note that the numbering +starts with 0), and 'myfile.fits[EVENTS] opens the HDU with the name +'EVENTS' (as defined by the EXTNAME or HDUNAME keywords). If no HDU is +specified then CFITSIO opens the first HDU (the primary array) by +default. The CFITSIO routines which read and write data only operate +within the opened HDU, Other CFITSIO routines are provided to move to +and open any other existing HDU within the FITS file or to append or +insert new HDUs in the FITS file. + + +\section{Function Names and Variable Datatypes} + +Most of the CFITSIO routines have both a short name as well as a +longer descriptive name. The short name is only 5 or 6 characters long +and is similar to the subroutine name in the Fortran-77 version of +FITSIO. The longer name is more descriptive and it is recommended that +it be used instead of the short name to more clearly document the +source code. + +Many of the CFITSIO routines come in families which differ only in the +data type of the associated parameter(s). The data type of these +routines is indicated by the suffix of the routine name. The short +routine names have a 1 or 2 character suffix (e.g., 'j' in 'ffpkyj') +while the long routine names have a 4 character or longer suffix +as shown in the following table: + +\begin{verbatim} + Long Short Data + Names Names Type + ----- ----- ---- + _bit x bit + _byt b unsigned byte + _sbyt sb signed byte + _sht i short integer + _lng j long integer + _lnglng jj 8-byte LONGLONG integer (see note below) + _usht ui unsigned short integer + _ulng uj unsigned long integer + _uint uk unsigned int integer + _int k int integer + _flt e real exponential floating point (float) + _fixflt f real fixed-decimal format floating point (float) + _dbl d double precision real floating-point (double) + _fixdbl g double precision fixed-format floating point (double) + _cmp c complex reals (pairs of float values) + _fixcmp fc complex reals, fixed-format floating point + _dblcmp m double precision complex (pairs of double values) + _fixdblcmp fm double precision complex, fixed-format floating point + _log l logical (int) + _str s character string +\end{verbatim} + +The logical data type corresponds to `int' for logical keyword values, +and `byte' for logical binary table columns. In other words, the value +when writing a logical keyword must be stored in an `int' variable, and +must be stored in a `char' array when reading or writing to `L' columns +in a binary table. Inplicit data type conversion is not supported for +logical table columns, but is for keywords, so a logical keyword may be +read and cast to any numerical data type; a returned value = 0 +indicates false, and any other value = true. + +The `int' data type may be 2 bytes long on some IBM PC compatible +systems and is usually 4 bytes long on most other systems. Some 64-bit +machines, however, like the Dec Alpha/OSF, define the `short', `int', +and `long' integer data types to be 2, 4, and 8 bytes long, +respectively. The FITS standard only supports 2 and 4 byte integer +data types, so CFITSIO internally converts between 4 and 8 bytes when +reading or writing `long' integers on Alpha/OSF systems. + +The 8-byte 'LONGLONG' integer data type is supported on most platforms. +CFITSIO defines the LONGLONG data type to be equivalent to 'long long' +on most Unix platforms and on Mac OS-X. Since most Windows compilers don't +support the 'long long' data type, LONGLONG is defined instead to be +equivalent to '\_\_int64'. If the compiler does not support a 8-byte +integer data type then LONGLONG is defined to be equivalent to 'long'. +Note that the C format specifier to print out these long integer values +is "\%lld" on most unix machines, except on OSF platforms where "\%ld" +must be used. On Windows platform that have the \_\_int64 data type, +the format specifier is "\%INT64d". + +When dealing with the FITS byte data type it is important to remember +that the raw values (before any scaling by the BSCALE and BZERO, or +TSCALn and TZEROn keyword values) in byte arrays (BITPIX = 8) or byte +columns (TFORMn = 'B') are interpreted as unsigned bytes with values +ranging from 0 to 255. Some C compilers define a 'char' variable as +signed, so it is important to explicitly declare a numeric char +variable as 'unsigned char' to avoid any ambiguity + +One feature of the CFITSIO routines is that they can operate on a `X' +(bit) column in a binary table as though it were a `B' (byte) column. +For example a `11X' data type column can be interpreted the same as a +`2B' column (i.e., 2 unsigned 8-bit bytes). In some instances, it can +be more efficient to read and write whole bytes at a time, rather than +reading or writing each individual bit. + +The complex and double precision complex data types are not directly +supported in ANSI C so these data types should be interpreted as pairs +of float or double values, respectively, where the first value in each +pair is the real part, and the second is the imaginary part. + + +\section{Support for Unsigned Integers and Signed Bytes} + +Although FITS does not directly support unsigned integers as one of its +fundamental data types, FITS can still be used to efficiently store +unsigned integer data values in images and binary tables. The +convention used in FITS files is to store the unsigned integers as +signed integers with an associated offset (specified by the BZERO or +TZEROn keyword). For example, to store unsigned 16-bit integer values +in a FITS image the image would be defined as a signed 16-bit integer +(with BITPIX keyword = SHORT\_IMG = 16) with the keywords BSCALE = 1.0 +and BZERO = 32768. Thus the unsigned values of 0, 32768, and 65535, +for example, are physically stored in the FITS image as -32768, 0, and +32767, respectively; CFITSIO automatically adds the BZERO offset to +these values when they are read. Similarly, in the case of unsigned +32-bit integers the BITPIX keyword would be equal to LONG\_IMG = 32 and +BZERO would be equal to 2147483648 (i.e. 2 raised to the 31st power). + +The CFITSIO interface routines will efficiently and transparently apply +the appropriate offset in these cases so in general application +programs do not need to be concerned with how the unsigned values are +actually stored in the FITS file. As a convenience for users, CFITSIO +has several predefined constants for the value of BITPIX (USHORT\_IMG, +ULONG\_IMG) and for the TFORMn value in the case of binary tables (`U' +and `V') which programmers can use when creating FITS files containing +unsigned integer values. The following code fragment illustrates how +to write a FITS 1-D primary array of unsigned 16-bit integers: + +\begin{verbatim} + unsigned short uarray[100]; + int naxis, status; + long naxes[10], group, firstelem, nelements; + ... + status = 0; + naxis = 1; + naxes[0] = 100; + fits_create_img(fptr, USHORT_IMG, naxis, naxes, &status); + + firstelem = 1; + nelements = 100; + fits_write_img(fptr, TUSHORT, firstelem, nelements, + uarray, &status); + ... +\end{verbatim} +In the above example, the 2nd parameter in fits\_create\_img tells +CFITSIO to write the header keywords appropriate for an array of 16-bit +unsigned integers (i.e., BITPIX = 16 and BZERO = 32768). Then the +fits\_write\_img routine writes the array of unsigned short integers +(uarray) into the primary array of the FITS file. Similarly, a 32-bit +unsigned integer image may be created by setting the second parameter +in fits\_create\_img equal to `ULONG\_IMG' and by calling the +fits\_write\_img routine with the second parameter = TULONG to write +the array of unsigned long image pixel values. + +An analogous set of routines are available for reading or writing unsigned +integer values and signed byte values in a FITS binary table extension. +When specifying the TFORMn keyword value which defines the format of a +column, CFITSIO recognized 3 additional data type codes besides those +already defined in the FITS standard: `U' meaning a 16-bit unsigned +integer column, `V' for a 32-bit unsigned integer column, and 'S' +for a signed byte column. These non-standard data type codes are not +actually written into the FITS file but instead are just used internally +within CFITSIO. The following code fragment illustrates how to use +these features: + +\begin{verbatim} + unsigned short uarray[100]; + unsigned int varray[100]; + + int colnum, tfields, status; + long nrows, firstrow, firstelem, nelements, pcount; + + char extname[] = "Test_table"; /* extension name */ + + /* define the name, data type, and physical units for the 2 columns */ + char *ttype[] = { "Col_1", "Col_2", "Col_3" }; + char *tform[] = { "1U", "1V", "1S"}; /* special CFITSIO codes */ + char *tunit[] = { " ", " ", " " }; + ... + + /* write the header keywords */ + status = 0; + nrows = 1; + tfields = 3 + pcount = 0; + fits_create_tbl(fptr, BINARY_TBL, nrows, tfields, ttype, tform, + tunit, extname, &status); + + /* write the unsigned shorts to the 1st column */ + colnum = 1; + firstrow = 1; + firstelem = 1; + nelements = 100; + fits_write_col(fptr, TUSHORT, colnum, firstrow, firstelem, + nelements, uarray, &status); + + /* now write the unsigned longs to the 2nd column */ + colnum = 2; + fits_write_col(fptr, TUINT, colnum, firstrow, firstelem, + nelements, varray, &status); + ... +\end{verbatim} +Note that the non-standard TFORM values for the 3 columns, `U' and `V', +tell CFITSIO to write the keywords appropriate for unsigned 16-bit and +unsigned 32-bit integers, respectively (i.e., TFORMn = '1I' and TZEROn += 32678 for unsigned 16-bit integers, and TFORMn = '1J' and TZEROn = +2147483648 for unsigned 32-bit integers). The 'S' TFORMn value tells +CFITSIO to write the keywords appropriate for a signed 8-bit byte column +with TFORMn = '1B' and TZEROn = -128. The calls to fits\_write\_col +then write the arrays of unsigned integer values to the columns. + + +\section{Dealing with Character Strings} + +The character string values in a FITS header or in an ASCII column in a +FITS table extension are generally padded out with non-significant +space characters (ASCII 32) to fill up the header record or the column +width. When reading a FITS string value, the CFITSIO routines will +strip off these non-significant trailing spaces and will return a +null-terminated string value containing only the significant +characters. Leading spaces in a FITS string are considered +significant. If the string contains all blanks, then CFITSIO will +return a single blank character, i.e, the first blank is considered to +be significant, since it distinguishes the string from a null or +undefined string, but the remaining trailing spaces are not +significant. + +Similarly, when writing string values to a FITS file the +CFITSIO routines expect to get a null-terminated string as input; +CFITSIO will pad the string with blanks if necessary when writing it +to the FITS file. + +When calling CFITSIO routines that return a character string it is +vital that the size of the char array be large enough to hold the +entire string of characters, otherwise CFITSIO will overwrite whatever +memory locations follow the char array, possibly causing the program to +execute incorrectly. This type of error can be difficult to debug, so +programmers should always ensure that the char arrays are allocated +enough space to hold the longest possible string, {\bf including} the +terminating NULL character. The fitsio.h file contains the following +defined constants which programmers are strongly encouraged to use +whenever they are allocating space for char arrays: + +\begin{verbatim} +#define FLEN_FILENAME 1025 /* max length of a filename */ +#define FLEN_KEYWORD 72 /* max length of a keyword */ +#define FLEN_CARD 81 /* length of a FITS header card */ +#define FLEN_VALUE 71 /* max length of a keyword value string */ +#define FLEN_COMMENT 73 /* max length of a keyword comment string */ +#define FLEN_ERRMSG 81 /* max length of a CFITSIO error message */ +#define FLEN_STATUS 31 /* max length of a CFITSIO status text string */ +\end{verbatim} +For example, when declaring a char array to hold the value string +of FITS keyword, use the following statement: + +\begin{verbatim} + char value[FLEN_VALUE]; +\end{verbatim} +Note that FLEN\_KEYWORD is longer than needed for the nominal 8-character +keyword name because the HIERARCH convention supports longer keyword names. + + +\section{Implicit Data Type Conversion} + +The CFITSIO routines that read and write numerical data can perform +implicit data type conversion. This means that the data type of the +variable or array in the program does not need to be the same as the +data type of the value in the FITS file. Data type conversion is +supported for numerical and string data types (if the string contains a +valid number enclosed in quotes) when reading a FITS header keyword +value and for numeric values when reading or writing values in the +primary array or a table column. CFITSIO returns status = +NUM\_OVERFLOW if the converted data value exceeds the range of the +output data type. Implicit data type conversion is not supported +within binary tables for string, logical, complex, or double complex +data types. + +In addition, any table column may be read as if it contained string values. +In the case of numeric columns the returned string will be formatted +using the TDISPn display format if it exists. + + +\section{Data Scaling} + +When reading numerical data values in the primary array or a +table column, the values will be scaled automatically by the BSCALE and +BZERO (or TSCALn and TZEROn) header values if they are +present in the header. The scaled data that is returned to the reading +program will have + +\begin{verbatim} + output value = (FITS value) * BSCALE + BZERO +\end{verbatim} +(a corresponding formula using TSCALn and TZEROn is used when reading +from table columns). In the case of integer output values the floating +point scaled value is truncated to an integer (not rounded to the +nearest integer). The fits\_set\_bscale and fits\_set\_tscale routines +(described in the `Advanced' chapter) may be used to override the +scaling parameters defined in the header (e.g., to turn off the scaling +so that the program can read the raw unscaled values from the FITS +file). + +When writing numerical data to the primary array or to a table column +the data values will generally be automatically inversely scaled by the +value of the BSCALE and BZERO (or TSCALn and TZEROn) keyword values if +they they exist in the header. These keywords must have been written +to the header before any data is written for them to have any immediate +effect. One may also use the fits\_set\_bscale and fits\_set\_tscale +routines to define or override the scaling keywords in the header +(e.g., to turn off the scaling so that the program can write the raw +unscaled values into the FITS file). If scaling is performed, the +inverse scaled output value that is written into the FITS file will +have + +\begin{verbatim} + FITS value = ((input value) - BZERO) / BSCALE +\end{verbatim} +(a corresponding formula using TSCALn and TZEROn is used when +writing to table columns). Rounding to the nearest integer, rather +than truncation, is performed when writing integer data types to the +FITS file. + + +\section{Support for IEEE Special Values} + +The ANSI/IEEE-754 floating-point number standard defines certain +special values that are used to represent such quantities as +Not-a-Number (NaN), denormalized, underflow, overflow, and infinity. +(See the Appendix in the NOST FITS standard or the NOST FITS User's +Guide for a list of these values). The CFITSIO routines that read +floating point data in FITS files recognize these IEEE special values +and by default interpret the overflow and infinity values as being +equivalent to a NaN, and convert the underflow and denormalized values +into zeros. In some cases programmers may want access to the raw IEEE +values, without any modification by CFITSIO. This can be done by +calling the fits\_read\_img or fits\_read\_col routines while +specifying 0.0 as the value of the NULLVAL parameter. This will force +CFITSIO to simply pass the IEEE values through to the application +program without any modification. This is not fully supported on +VAX/VMS machines, however, where there is no easy way to bypass the +default interpretation of the IEEE special values. + + +\section{Error Status Values and the Error Message Stack} + +Nearly all the CFITSIO routines return an error status value +in 2 ways: as the value of the last parameter in the function call, +and as the returned value of the function itself. This provides +some flexibility in the way programmers can test if an error +occurred, as illustrated in the following 2 code fragments: + +\begin{verbatim} + if ( fits_write_record(fptr, card, &status) ) + printf(" Error occurred while writing keyword."); + +or, + + fits_write_record(fptr, card, &status); + if ( status ) + printf(" Error occurred while writing keyword."); +\end{verbatim} +A listing of all the CFITSIO status code values is given at the end of +this document. Programmers are encouraged to use the symbolic +mnemonics (defined in fitsio.h) rather than the actual integer status +values to improve the readability of their code. + +The CFITSIO library uses an `inherited status' convention for the +status parameter which means that if a routine is called with a +positive input value of the status parameter as input, then the routine +will exit immediately without changing the value of the status +parameter. Thus, if one passes the status value returned from each +CFITSIO routine as input to the next CFITSIO routine, then whenever an +error is detected all further CFITSIO processing will cease. This +convention can simplify the error checking in application programs +because it is not necessary to check the value of the status parameter +after every single CFITSIO routine call. If a program contains a +sequence of several CFITSIO calls, one can just check the status value +after the last call. Since the returned status values are generally +distinctive, it should be possible to determine which routine +originally returned the error status. + +CFITSIO also maintains an internal stack of error messages +(80-character maximum length) which in many cases provide a more +detailed explanation of the cause of the error than is provided by the +error status number alone. It is recommended that the error message +stack be printed out whenever a program detects a CFITSIO error. The +function fits\_report\_error will print out the entire error message +stack, or alternatively one may call fits\_read\_errmsg to get the +error messages one at a time. + + +\section{Variable-Length Arrays in Binary Tables} + +CFITSIO provides easy-to-use support for reading and writing data in +variable length fields of a binary table. The variable length columns +have TFORMn keyword values of the form `1Pt(len)' where `t' is the +data type code (e.g., I, J, E, D, etc.) and `len' is an integer +specifying the maximum length of the vector in the table. If the value +of `len' is not specified when the table is created (e.g., if the TFORM +keyword value is simply specified as '1PE' instead of '1PE(400) ), then +CFITSIO will automatically scan the table when it is closed to +determine the maximum length of the vector and will append this value +to the TFORMn value. + +The same routines that read and write data in an ordinary fixed length +binary table extension are also used for variable length fields, +however, the routine parameters take on a slightly different +interpretation as described below. + +All the data in a variable length field is written into an area called +the `heap' which follows the main fixed-length FITS binary table. The +size of the heap, in bytes, is specified by the PCOUNT keyword in the +FITS header. When creating a new binary table, the initial value of +PCOUNT should usually be set to zero. CFITSIO will recompute the size +of the heap as the data is written and will automatically update the +PCOUNT keyword value when the table is closed. When writing variable +length data to a table, CFITSIO will automatically extend the size +of the heap area if necessary, so that any following HDUs do not +get overwritten. + +By default the heap data area starts immediately after the last row of +the fixed-length table. This default starting location may be +overridden by the THEAP keyword, but this is not recommended. +If additional rows of data are added to the table, CFITSIO will +automatically shift the the heap down to make room for the new +rows, but it is obviously be more efficient to initially +create the table with the necessary number of blank rows, so that +the heap does not needed to be constantly moved. + +When writing to a variable length field the entire array of values for +a given row of the table must be written with a single call to +fits\_write\_col. The total length of the array is given by nelements ++ firstelem - 1. Additional elements cannot be appended to an existing +vector at a later time since any attempt to do so will simply overwrite +all the previously written data. Note also that the new data will be +written to a new area of the heap and the heap space used by the +previous write cannot be reclaimed. For this reason each row of a +variable length field should only be written once. An exception to +this general rule occurs when setting elements of an array as +undefined. One must first write a dummy value into the array with +fits\_write\_col, and then call fits\_write\_col\_nul to flag the +desired elements as undefined. (Do not use the fits\_write\_colnull +routines with variable length fields). Note that the rows of a table, +whether fixed or variable length, do not have to be written +consecutively and may be written in any order. + +When writing to a variable length ASCII character field (e.g., TFORM = +'1PA') only a single character string can be written. The `firstelem' +and `nelements' parameter values in the fits\_write\_col routine are +ignored and the number of characters to write is simply determined by +the length of the input null-terminated character string. + +The fits\_write\_descript routine is useful in situations where +multiple rows of a variable length column have the identical array of +values. One can simply write the array once for the first row, and +then use fits\_write\_descript to write the same descriptor values into +the other rows; all the rows will then point to the same storage +location thus saving disk space. + +When reading from a variable length array field one can only read as +many elements as actually exist in that row of the table; reading does +not automatically continue with the next row of the table as occurs +when reading an ordinary fixed length table field. Attempts to read +more than this will cause an error status to be returned. One can +determine the number of elements in each row of a variable column with +the fits\_read\_descript routine. + + +\section{Multiple Access to the Same FITS File} + +CFITSIO supports simultaneous read and write access to multiple HDUs in +the same FITS file. Thus, one can open the same FITS file twice within +a single program and move to 2 different HDUs in the file, and then +read and write data or keywords to the 2 extensions just as if one were +accessing 2 completely separate FITS files. Since in general it is +not possible to physically open the same file twice and then expect to +be able to simultaneously (or in alternating succession) write to 2 +different locations in the file, CFITSIO recognizes when the file to be +opened (in the call to fits\_open\_file) has already been opened and +instead of actually opening the file again, just logically links the +new file to the old file. (This only applies if the file is opened +more than once within the same program, and does not prevent the same +file from being simultaneously opened by more than one program). Then +before CFITSIO reads or writes to either (logical) file, it makes sure +that any modifications made to the other file have been completely +flushed from the internal buffers to the file. Thus, in principle, one +could open a file twice, in one case pointing to the first extension +and in the other pointing to the 2nd extension and then write data to +both extensions, in any order, without danger of corrupting the file, +There may be some efficiency penalties in doing this however, since +CFITSIO has to flush all the internal buffers related to one file +before switching to the other, so it would still be prudent to +minimize the number of times one switches back and forth between doing +I/O to different HDUs in the same file. + + +\section{When the Final Size of the FITS HDU is Unknown} + +It is not required to know the total size of a FITS data array or table +before beginning to write the data to the FITS file. In the case of +the primary array or an image extension, one should initially create +the array with the size of the highest dimension (largest NAXISn +keyword) set to a dummy value, such as 1. Then after all the data have +been written and the true dimensions are known, then the NAXISn value +should be updated using the fits\_update\_key routine before moving to +another extension or closing the FITS file. + +When writing to FITS tables, CFITSIO automatically keeps track of the +highest row number that is written to, and will increase the size of +the table if necessary. CFITSIO will also automatically insert space +in the FITS file if necessary, to ensure that the data 'heap', if it +exists, and/or any additional HDUs that follow the table do not get +overwritten as new rows are written to the table. + +As a general rule it is best to specify the initial number of rows = 0 +when the table is created, then let CFITSIO keep track of the number of +rows that are actually written. The application program should not +manually update the number of rows in the table (as given by the NAXIS2 +keyword) since CFITSIO does this automatically. If a table is +initially created with more than zero rows, then this will usually be +considered as the minimum size of the table, even if fewer rows are +actually written to the table. Thus, if a table is initially created +with NAXIS2 = 20, and CFITSIO only writes 10 rows of data before +closing the table, then NAXIS2 will remain equal to 20. If however, 30 +rows of data are written to this table, then NAXIS2 will be increased +from 20 to 30. The one exception to this automatic updating of the +NAXIS2 keyword is if the application program directly modifies the +value of NAXIS2 (up or down) itself just before closing the table. In this +case, CFITSIO does not update NAXIS2 again, since it assumes that the +application program must have had a good reason for changing the value +directly. This is not recommended, however, and is only provided for +backward compatibility with software that initially creates a table +with a large number of rows, than decreases the NAXIS2 value to the +actual smaller value just before closing the table. + + +\section{CFITSIO Size Limitations} + +CFITSIO places very few restrictions on the size of FITS files that it +reads or writes. There are a few limits, however, that may affect +some extreme cases: + +1. The maximum number of FITS files that may be simultaneously opened +by CFITSIO is set by NMAXFILES as defined in fitsio2.h. It is currently +set = 300 by default. CFITSIO will allocate about 80 * NMAXFILES bytes +of memory for internal use. Note that the underlying C compiler or +operating system, may have a smaller limit on the number of opened files. +The C symbolic constant FOPEN\_MAX is intended to define the maximum +number of files that may open at once (including any other text or +binary files that may be open, not just FITS files). On some systems it +has been found that gcc supports a maximum of 255 opened files. + +Note that opening and operating on many FITS files simultaneously in +parallel may be less efficient than operating on smaller groups of files +in series. CFITSIO only has NIOBUF number of internal buffers (set = 40 +by default) that are used for temporary storage of the most recent data +records that have been read or written in the FITS files. If the number +of opened files is greater than NIOBUF, then CFITSIO may waste more time +flushing and re-reading or re-writing the same records in the FITS files. + +2. By default, CFITSIO can handle FITS files up to 2.1 GB in size (2**31 +bytes). This file size limit is often imposed by 32-bit operating +systems. More recently, as 64-bit operating systems become more common, an +industry-wide standard (at least on Unix systems) has been developed to +support larger sized files (see http://ftp.sas.com/standards/large.file/). +Starting with version 2.1 of CFITSIO, larger FITS files up to 6 terabytes +in size may be read and written on supported platforms. In order +to support these larger files, CFITSIO must be compiled with the +'-D\_LARGEFILE\_SOURCE' and `-D\_FILE\_OFFSET\_BITS=64' compiler flags. +Some platforms may also require the `-D\_LARGE\_FILES' compiler flag. + This causes the compiler to allocate 8-bytes instead of +4-bytes for the `off\_t' data type that is used to store file offset +positions. It appears that in most cases it is not necessary to +also include these compiler flags when compiling programs that link to +the CFITSIO library. + +If CFITSIO is compiled with the -D\_LARGEFILE\_SOURCE +and -D\_FILE\_OFFSET\_BITS=64 flags on a +platform that supports large files, then it can read and write FITS +files that contain up to 2**31 2880-byte FITS records, or approximately +6 terabytes in size. It is still required that the value of the NAXISn +and PCOUNT keywords in each extension be within the range of a signed +4-byte integer (max value = 2,147,483,648). Thus, each dimension of an +image (given by the NAXISn keywords), the total width of a table +(NAXIS1 keyword), the number of rows in a table (NAXIS2 keyword), and +the total size of the variable-length array heap in binary tables +(PCOUNT keyword) must be less than this limit. + +Currently, support for large files within CFITSIO has been tested +on the Linux, Solaris, and IBM AIX operating systems. + +\chapter{Basic CFITSIO Interface Routines } + +This chapter describes the basic routines in the CFITSIO user interface +that provide all the functions normally needed to read and write most +FITS files. It is recommended that these routines be used for most +applications and that the more advanced routines described in the +next chapter only be used in special circumstances when necessary. + +The following conventions are used in this chapter in the description +of each function: + +1. Most functions have 2 names: a long descriptive name and a short +concise name. Both names are listed on the first line of the following +descriptions, separated by a slash (/) character. Programmers may use +either name in their programs but the long names are recommended to +help document the code and make it easier to read. + +2. A right arrow symbol ($>$) is used in the function descriptions to +separate the input parameters from the output parameters in the +definition of each routine. This symbol is not actually part of the C +calling sequence. + +3. The function parameters are defined in more detail in the +alphabetical listing in Appendix B. + +4. The first argument in almost all the functions is a pointer to a +structure of type `fitsfile'. Memory for this structure is allocated +by CFITSIO when the FITS file is first opened or created and is freed +when the FITS file is closed. + +5. The last argument in almost all the functions is the error status +parameter. It must be equal to 0 on input, otherwise the function will +immediately exit without doing anything. A non-zero output value +indicates that an error occurred in the function. In most cases the +status value is also returned as the value of the function itself. + + +\section{CFITSIO Error Status Routines} + + +\begin{description} +\item[1 ] Return a descriptive text string (30 char max.) corresponding to + a CFITSIO error status code.\label{ffgerr} +\end{description} + +\begin{verbatim} + void fits_get_errstatus / ffgerr (int status, > char *err_text) +\end{verbatim} + +\begin{description} +\item[2 ] Return the top (oldest) 80-character error message from the + internal CFITSIO stack of error messages and shift any remaining + messages on the stack up one level. Call this routine + repeatedly to get each message in sequence. The function returns + a value = 0 and a null error message when the error stack is empty. +\label{ffgmsg} +\end{description} + +\begin{verbatim} + int fits_read_errmsg / ffgmsg (char *err_msg) +\end{verbatim} + +\begin{description} +\item[3 ] Print out the error message corresponding to the input status + value and all the error messages on the CFITSIO stack to the specified + file stream (normally to stdout or stderr). If the input + status value = 0 then this routine does nothing. +\label{ffrprt} +\end{description} + +\begin{verbatim} + void fits_report_error / ffrprt (FILE *stream, > status) +\end{verbatim} + +\begin{description} +\item[4 ]The fits\_write\_errmark routine puts an invisible marker on the + CFITSIO error stack. The fits\_clear\_errmark routine can then be + used to delete any more recent error messages on the stack, back to + the position of the marker. This preserves any older error messages + on the stack. The fits\_clear\_errmsg routine simply clears all the + messages (and marks) from the stack. These routines are called + without any arguments. +\label{ffpmrk} \label{ffcmsg} +\end{description} + +\begin{verbatim} + void fits_write_errmark / ffpmrk (void) + void fits_clear_errmark / ffcmrk (void) + void fits_clear_errmsg / ffcmsg (void) +\end{verbatim} + + +\section{FITS File Access Routines} + + +\begin{description} +\item[1 ] Open an existing data file. \label{ffopen} + + +\begin{verbatim} +int fits_open_file / ffopen + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_diskfile / ffdkopen + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_data / ffdopn + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_table / fftopn + (fitsfile **fptr, char *filename, int iomode, > int *status) + +int fits_open_image / ffiopn + (fitsfile **fptr, char *filename, int iomode, > int *status) +\end{verbatim} + +The iomode parameter determines the read/write access allowed in the +file and can have values of READONLY (0) or READWRITE (1). The filename +parameter gives the name of the file to be opened, followed by an +optional argument giving the name or index number of the extension +within the FITS file that should be moved to and opened (e.g., +\verb-myfile.fits+3- or \verb-myfile.fits[3]- moves to the 3rd extension within +the file, and \verb-myfile.fits[events]- moves to the extension with the +keyword EXTNAME = 'EVENTS'). + +The fits\_open\_diskfile routine is similar to the fits\_open\_file routine +except that it does not support the extended filename syntax in the input +file name. This routine simply tries to open the specified input file +on magnetic disk. This routine is mainly for use in cases where the +filename (or directory path) contains square or curly bracket characters +that would confuse the extended filename parser. + +The fits\_open\_data routine is similar to the fits\_open\_file routine +except that it will move to the first HDU containing significant data, +if a HDU name or number to open was not explicitly specified as +part of the filename. In this case, it will look for the first +IMAGE HDU with NAXIS > 0, or the first table that does not contain the +strings `GTI' (Good Time Interval extension) or `OBSTABLE' in the +EXTNAME keyword value. + +The fits\_open\_table and fits\_open\_image routines are similar to +fits\_open\_data except they will move to the first significant table +HDU or image HDU in the file, respectively, if a HDU name or +number is not specified as part of the filename. + +IRAF images (.imh format files) and raw binary data arrays may also be +opened with READONLY access. CFITSIO will automatically test if the +input file is an IRAF image, and if, so will convert it on the fly into +a virtual FITS image before it is opened by the application program. +If the input file is a raw binary data array of numbers, then the data type +and dimensions of the array must be specified in square brackets +following the name of the file (e.g. 'rawfile.dat[i512,512]' opens a +512 x 512 short integer image). See the `Extended File Name Syntax' +chapter for more details on how to specify the raw file name. The raw +file is converted on the fly into a virtual FITS image in memory that +is then opened by the application program with READONLY access. + +Programs can read the input file from the 'stdin' file stream if a dash +character ('-') is given as the filename. Files can also be opened over +the network using FTP or HTTP protocols by supplying the appropriate URL +as the filename. + +The input file can be modified in various ways to create a virtual file +(usually stored in memory) that is then opened by the application +program by supplying a filtering or binning specifier in square brackets +following the filename. Some of the more common filtering methods are +illustrated in the following paragraphs, but users should refer to the +'Extended File Name Syntax' chapter for a complete description of +the full file filtering syntax. + +When opening an image, a rectangular subset of the physical image may be +opened by listing the first and last pixel in each dimension (and +optional pixel skipping factor): + +\begin{verbatim} +myimage.fits[101:200,301:400] +\end{verbatim} +will create and open a 100x100 pixel virtual image of that section of +the physical image, and \verb+myimage.fits[*,-*]+ opens a virtual image +that is the same size as the physical image but has been flipped in +the vertical direction. + +When opening a table, the filtering syntax can be used to add or delete +columns or keywords in the virtual table: +\verb-myfile.fits[events][col !time; PI = PHA*1.2]- opens a virtual table in which the TIME column +has been deleted and a new PI column has been added with a value 1.2 +times that of the PHA column. Similarly, one can filter a table to keep +only those rows that satisfy a selection criterion: +\verb-myfile.fits[events][pha > 50]- creates and opens a virtual table +containing only those rows with a PHA value greater than 50. A large +number of boolean and mathematical operators can be used in the +selection expression. One can also filter table rows using 'Good Time +Interval' extensions, and spatial region filters as in +\verb-myfile.fits[events][gtifilter()]- and +\verb-myfile.fits[events][regfilter( "stars.rng")]-. + +Finally, table columns may be binned or histogrammed to generate a +virtual image. For example, \verb-myfile.fits[events][bin (X,Y)=4]- will +result in a 2-dimensional image calculated by binning the X and Y +columns in the event table with a bin size of 4 in each dimension. The +TLMINn and TLMAXn keywords will be used by default to determine the +range of the image. + +A single program can open the same FITS file more than once and then +treat the resulting fitsfile pointers as though they were completely +independent FITS files. Using this facility, a program can open a FITS +file twice, move to 2 different extensions within the file, and then + read and write data in those extensions in any order. +\end{description} + + +\begin{description} +\item[2 ] Create and open a new empty output FITS file. \label{ffinit} + + +\begin{verbatim} +int fits_create_file / ffinit + (fitsfile **fptr, char *filename, > int *status) + +int fits_create_diskfile / ffdkinit + (fitsfile **fptr, char *filename, > int *status) +\end{verbatim} + +An error will be returned if the specified file already exists, unless +the filename is prefixed with an exclamation point (!). In that case +CFITSIO will overwrite (delete) any existing file with the same name. +Note that the exclamation point is a special UNIX character so if +it is used on the command line it must be preceded by a backslash to +force the UNIX shell to accept the character as part of the filename. + +The output file will be written to the 'stdout' file stream if a dash +character ('-') or the string 'stdout' is given as the filename. Similarly, +'-.gz' or 'stdout.gz' will cause the file to be gzip compressed before +it is written out to the stdout stream. + +Optionally, the name of a template file that is used to define the +structure of the new file may be specified in parentheses following the +output file name. The template file may be another FITS file, in which +case the new file, at the time it is opened, will be an exact copy of +the template file except that the data structures (images and tables) +will be filled with zeros. Alternatively, the template file may be an +ASCII format text file containing directives that define the keywords to be +created in each HDU of the file. See the 'Extended File Name Syntax' + section for a complete description of the template file syntax. + +The fits\_create\_diskfile routine is similar to the fits\_create\_file routine +except that it does not support the extended filename syntax in the input +file name. This routine simply tries to create the specified file +on magnetic disk. This routine is mainly for use in cases where the +filename (or directory path) contains square or curly bracket characters + that would confuse the extended filename parser. +\end{description} + + + +\begin{description} +\item[3 ] Close a previously opened FITS file. The first routine simply +closes the file, whereas the second one also DELETES THE FILE, which +can be useful in cases where a FITS file has been partially created, +but then an error occurs which prevents it from being completed. + \label{ffclos} \label{ffdelt} +\end{description} + +\begin{verbatim} + int fits_close_file / ffclos (fitsfile *fptr, > int *status) + + int fits_delete_file / ffdelt (fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ]Return the name, I/O mode (READONLY or READWRITE), and/or the file +type (e.g. 'file://', 'ftp://') of the opened FITS file. \label{ffflnm} + \label{ffflmd} \label{ffurlt} +\end{description} + +\begin{verbatim} + int fits_file_name / ffflnm (fitsfile *fptr, > char *filename, int *status) + + int fits_file_mode / ffflmd (fitsfile *fptr, > int *iomode, int *status) + + int fits_url_type / ffurlt (fitsfile *fptr, > char *urltype, int *status) +\end{verbatim} + +\section{HDU Access Routines} + +The following functions perform operations on Header-Data Units (HDUs) +as a whole. + + +\begin{description} +\item[1 ] Move to a different HDU in the file. The first routine moves to a + specified absolute HDU number (starting with 1 for the primary + array) in the FITS file, and the second routine moves a relative + number HDUs forward or backward from the current HDU. A null + pointer may be given for the hdutype parameter if it's value is not + needed. The third routine moves to the (first) HDU which has the + specified extension type and EXTNAME and EXTVER keyword values (or + HDUNAME and HDUVER keywords). The hdutype parameter may have a + value of IMAGE\_HDU, ASCII\_TBL, BINARY\_TBL, or ANY\_HDU where + ANY\_HDU means that only the extname and extver values will be used + to locate the correct extension. If the input value of extver is 0 + then the EXTVER keyword is ignored and the first HDU with a + matching EXTNAME (or HDUNAME) keyword will be found. If no + matching HDU is found in the file then the current HDU will remain + unchanged and a status = BAD\_HDU\_NUM will be returned. + \label{ffmahd} \label{ffmrhd} \label{ffmnhd} +\end{description} + +\begin{verbatim} + int fits_movabs_hdu / ffmahd + (fitsfile *fptr, int hdunum, > int *hdutype, int *status) + + int fits_movrel_hdu / ffmrhd + (fitsfile *fptr, int nmove, > int *hdutype, int *status) + + int fits_movnam_hdu / ffmnhd + (fitsfile *fptr, int hdutype, char *extname, int extver, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Return the total number of HDUs in the FITS file. + The current HDU remains unchanged. \label{ffthdu} +\end{description} + +\begin{verbatim} + int fits_get_num_hdus / ffthdu + (fitsfile *fptr, > int *hdunum, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Return the number of the current HDU (CHDU) in the FITS file (where + the primary array = 1). This function returns the HDU number + rather than a status value. \label{ffghdn} +\end{description} + +\begin{verbatim} + int fits_get_hdu_num / ffghdn + (fitsfile *fptr, > int *hdunum) +\end{verbatim} + +\begin{description} +\item[4 ] Return the type of the current HDU in the FITS file. The possible + values for hdutype are: IMAGE\_HDU, ASCII\_TBL, or BINARY\_TBL. \label{ffghdt} +\end{description} + +\begin{verbatim} + int fits_get_hdu_type / ffghdt + (fitsfile *fptr, > int *hdutype, int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Copy all or part of the HDUs in the FITS file associated with infptr + and append them to the end of the FITS file associated with + outfptr. If 'previous' is true (not 0), then any HDUs preceding + the current HDU in the input file will be copied to the output + file. Similarly, 'current' and 'following' determine whether the + current HDU, and/or any following HDUs in the input file will be + copied to the output file. Thus, if all 3 parameters are true, then the + entire input file will be copied. On exit, the current HDU in + the input file will be unchanged, and the last HDU in the output + file will be the current HDU. \label{ffcpfl} +\end{description} + +\begin{verbatim} + int fits_copy_file / ffcpfl + (fitsfile *infptr, fitsfile *outfptr, int previous, int current, + int following, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Copy the current HDU from the FITS file associated with infptr and append it + to the end of the FITS file associated with outfptr. Space may be + reserved for MOREKEYS additional keywords in the output header. \label{ffcopy} +\end{description} + +\begin{verbatim} + int fits_copy_hdu / ffcopy + (fitsfile *infptr, fitsfile *outfptr, int morekeys, > int *status) +\end{verbatim} + +\begin{description} +\item[7 ] Copy the header (and not the data) from the CHDU associated with infptr + to the CHDU associated with outfptr. If the current output HDU + is not completely empty, then the CHDU will be closed and a new + HDU will be appended to the output file. An empty output data unit + will be created with all values initially = 0). \label{ffcphd} +\end{description} + +\begin{verbatim} + int fits_copy_header / ffcphd + (fitsfile *infptr, fitsfile *outfptr, > int *status) +\end{verbatim} + +\begin{description} +\item[8 ] Delete the CHDU in the FITS file. Any following HDUs will be shifted + forward in the file, to fill in the gap created by the deleted + HDU. In the case of deleting the primary array (the first HDU in + the file) then the current primary array will be replace by a null + primary array containing the minimum set of required keywords and + no data. If there are more extensions in the file following the + one that is deleted, then the the CHDU will be redefined to point + to the following extension. If there are no following extensions + then the CHDU will be redefined to point to the previous HDU. The + output hdutype parameter returns the type of the new CHDU. A null + pointer may be given for + hdutype if the returned value is not needed. \label{ffdhdu} +\end{description} + +\begin{verbatim} + int fits_delete_hdu / ffdhdu + (fitsfile *fptr, > int *hdutype, int *status) +\end{verbatim} + +\section{Header Keyword Read/Write Routines} + +These routines read or write keywords in the Current Header Unit +(CHU). Wild card characters (*, ?, or \#) may be used when specifying +the name of the keyword to be read: a '?' will match any single +character at that position in the keyword name and a '*' will match any +length (including zero) string of characters. The '\#' character will +match any consecutive string of decimal digits (0 - 9). When a wild +card is used the routine will only search for a match from the current +header position to the end of the header and will not resume the search +from the top of the header back to the original header position as is +done when no wildcards are included in the keyword name. The +fits\_read\_record routine may be used to set the starting position +when doing wild card searchs. A status value of KEY\_NO\_EXIST is +returned if the specified keyword to be read is not found in the +header. + + +\subsection{Keyword Reading Routines} + + +\begin{description} +\item[1 ] Return the number of existing keywords (not counting the + END keyword) and the amount of space currently available for more + keywords. It returns morekeys = -1 if the header has not yet been + closed. Note that CFITSIO will dynamically add space if required + when writing new keywords to a header so in practice there is no + limit to the number of keywords that can be added to a header. A + null pointer may be entered for the morekeys parameter if it's + value is not needed. \label{ffghsp} +\end{description} + +\begin{verbatim} + int fits_get_hdrspace / ffghsp + (fitsfile *fptr, > int *keysexist, int *morekeys, int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Return the specified keyword. In the first routine, + the datatype parameter specifies the desired returned data type of the + keyword value and can have one of the following symbolic constant + values: TSTRING, TLOGICAL (== int), TBYTE, TSHORT, TUSHORT, TINT, + TUINT, TLONG, TULONG, TFLOAT, TDOUBLE, TCOMPLEX, and TDBLCOMPLEX. + Within the context of this routine, TSTRING corresponds to a + 'char*' data type, i.e., a pointer to a character array. Data type + conversion will be performed for numeric values if the keyword + value does not have the same data type. If the value of the keyword + is undefined (i.e., the value field is blank) then an error status + = VALUE\_UNDEFINED will be returned. + + The second routine returns the keyword value as a character string + (a literal copy of what is in the value field) regardless of the + intrinsic data type of the keyword. The third routine returns + the entire 80-character header record of the keyword. + + If a NULL comment pointer is supplied then the comment string + will not be returned. \label{ffgky} \label{ffgkey} \label{ffgcrd} +\end{description} + +\begin{verbatim} + int fits_read_key / ffgky + (fitsfile *fptr, int datatype, char *keyname, > DTYPE *value, + char *comment, int *status) + + int fits_read_keyword / ffgkey + (fitsfile *fptr, char *keyname, > char *value, char *comment, + int *status) + + int fits_read_card / ffgcrd + (fitsfile *fptr, char *keyname, > char *card, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Return the nth header record in the CHU. The first keyword + in the header is at keynum = 1; if keynum = 0 then these routines + simply reset the internal CFITSIO pointer to the beginning of the header + so that subsequent keyword operations will start at the top of the + header (e.g., prior to searching for keywords using wild cards in + the keyword name). The first routine returns the entire + 80-character header record, while the second routine parses the + record and returns the name, value, and comment fields as separate + character strings. If a NULL comment pointer is given on input, + then the comment string will not be + returned. \label{ffgrec} \label{ffgkyn} +\end{description} + +\begin{verbatim} + int fits_read_record / ffgrec + (fitsfile *fptr, int keynum, > char *card, int *status) + + int fits_read_keyn / ffgkyn + (fitsfile *fptr, int keynum, > char *keyname, char *value, + char *comment, int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Return the next keyword whose name matches one of the strings in + 'inclist' but does not match any of the strings in 'exclist'. + The strings in inclist and exclist may contain wild card characters + (*, ?, and \#) as described at the beginning of this section. + This routine searches from the current header position to the + end of the header, only, and does not continue the search from + the top of the header back to the original position. The current + header position may be reset with the ffgrec routine. Note + that nexc may be set = 0 if there are no keywords to be excluded. + This routine returns status = KEY\_NO\_EXIST if a matching + keyword is not found. \label{ffgnxk} +\end{description} + +\begin{verbatim} + int fits_find_nextkey / ffgnxk + (fitsfile *fptr, char **inclist, int ninc, char **exclist, + int nexc, > char *card, int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Return the physical units string from an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are enclosed in square brackets in the + beginning of the keyword comment field. A null string is returned + if no units are defined for the keyword. \label{ffgunt} +\end{description} + +\begin{verbatim} + VELOCITY= 12.3 / [km/s] orbital speed + + int fits_read_key_unit / ffgunt + (fitsfile *fptr, char *keyname, > char *unit, int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Concatenate the header keywords in the CHDU into a single long + string of characters. This provides a convenient way of passing + all or part of the header information in a FITS HDU to other subroutines. + Each 80-character fixed-length keyword record is appended to the + output character string, in order, with no intervening separator or + terminating characters. The last header record is terminated with + a NULL character. This routine allocates memory for the returned + character array, so the calling program must free the memory when + finished. + + Selected keywords may be excluded from the returned character string. + If the second parameter (nocomments) is TRUE (nonzero) then any + COMMENT, HISTORY, or blank keywords in the header will not be copied + to the output string. + + The 'exclist' parameter may be used to supply a list of keywords + that are to be excluded from the output character string. Wild card + characters (*, ?, and \#) may be used in the excluded keyword names. + If no additional keywords are to be excluded, then set nexc = 0 and + specify NULL for the the **header parameter. \label{ffhdr2str} +\end{description} + +\begin{verbatim} + int fits_hdr2str + (fitsfile *fptr, int nocomments, char **exclist, int nexc, + > char **header, int *nkeys, int *status) +\end{verbatim} + + +\subsection{Keyword Writing Routines} + + +\begin{description} +\item[1 ] Write a keyword of the appropriate data type into the + CHU. The first routine simply appends a new keyword whereas the + second routine will update the value and comment fields of the + keyword if it already exists, otherwise it appends a new + keyword. Note that the address to the value, and not the value + itself, must be entered. The datatype parameter specifies the + data type of the keyword value with one of the following values: + TSTRING, TLOGICAL (== int), TBYTE, TSHORT, TUSHORT, TINT, TUINT, + TLONG, TULONG, TFLOAT, TDOUBLE. Within the context of this + routine, TSTRING corresponds to a 'char*' data type, i.e., a pointer + to a character array. A null pointer may be entered for the + comment parameter in which case the keyword comment + field will be unmodified or left blank. \label{ffpky} \label{ffuky} +\end{description} + +\begin{verbatim} + int fits_write_key / ffpky + (fitsfile *fptr, int datatype, char *keyname, DTYPE *value, + char *comment, > int *status) + + int fits_update_key / ffuky + (fitsfile *fptr, int datatype, char *keyname, DTYPE *value, + char *comment, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Write a keyword with a null or undefined value (i.e., the + value field in the keyword is left blank). The first routine + simply appends a new keyword whereas the second routine will update + the value and comment fields of the keyword if it already exists, + otherwise it appends a new keyword. A null pointer may be + entered for the comment parameter in which case the keyword + comment + field will be unmodified or left blank. \label{ffpkyu} \label{ffukyu} +\end{description} + +\begin{verbatim} + int fits_write_key_null / ffpkyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) + + int fits_update_key_null / ffukyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Write (append) a COMMENT or HISTORY keyword to the CHU. The comment or + history string will be continued over multiple keywords if it is longer + than 70 characters. \label{ffpcom} \label{ffphis} +\end{description} + +\begin{verbatim} + int fits_write_comment / ffpcom + (fitsfile *fptr, char *comment, > int *status) + + int fits_write_history / ffphis + (fitsfile *fptr, char *history, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Write the DATE keyword to the CHU. The keyword value will contain + the current system date as a character string in 'yyyy-mm-ddThh:mm:ss' + format. If a DATE keyword already exists in the header, then this + routine will simply update the keyword value with the current date. + \label{ffpdat} +\end{description} + +\begin{verbatim} + int fits_write_date / ffpdat + (fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ]Write a user specified keyword record into the CHU. This is + a low--level routine which can be used to write any arbitrary + record into the header. The record must conform to the all + the FITS format requirements. \label{ffprec} +\end{description} + +\begin{verbatim} + int fits_write_record / ffprec + (fitsfile *fptr, char *card, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ]Update an 80-character record in the CHU. If a keyword with the input + name already exists, then it is overwritten by the value of card. This + could modify the keyword name as well as the value and comment fields. + If the keyword doesn't already exist then a new keyword card is appended + to the header. \label{ffucrd} +\end{description} + +\begin{verbatim} + int fits_update_card / ffucrd + (fitsfile *fptr, char *keyname, char *card, > int *status) +\end{verbatim} + + +\begin{description} +\item[7 ] Modify (overwrite) the comment field of an existing keyword. \label{ffmcom} +\end{description} + +\begin{verbatim} + int fits_modify_comment / ffmcom + (fitsfile *fptr, char *keyname, char *comment, > int *status) +\end{verbatim} + + +\begin{description} +\item[8 ] Write the physical units string into an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are enclosed in square brackets in the + beginning of the keyword comment field. \label{ffpunt} +\end{description} + +\begin{verbatim} + VELOCITY= 12.3 / [km/s] orbital speed + + int fits_write_key_unit / ffpunt + (fitsfile *fptr, char *keyname, char *unit, > int *status) +\end{verbatim} + +\begin{description} +\item[9 ] Rename an existing keyword, preserving the current value + and comment fields. \label{ffmnam} +\end{description} + +\begin{verbatim} + int fits_modify_name / ffmnam + (fitsfile *fptr, char *oldname, char *newname, > int *status) +\end{verbatim} + +\begin{description} +\item[10] Delete a keyword record. The space occupied by + the keyword is reclaimed by moving all the following header records up + one row in the header. The first routine deletes a keyword at a + specified position in the header (the first keyword is at position 1), + whereas the second routine deletes a specifically named keyword. + Wild card characters may be used when specifying the name of the keyword + to be deleted. \label{ffdrec} \label{ffdkey} +\end{description} + +\begin{verbatim} + int fits_delete_record / ffdrec + (fitsfile *fptr, int keynum, > int *status) + + int fits_delete_key / ffdkey + (fitsfile *fptr, char *keyname, > int *status) +\end{verbatim} + +\section{Primary Array or IMAGE Extension I/O Routines} + +These routines read or write data values in the primary data array (i.e., +the first HDU in a FITS file) or an IMAGE extension. There are also +routines to get information about the data type and size of the image. +Users should also read the following chapter on the CFITSIO iterator +function which provides a more `object oriented' method of reading and +writing images. The iterator function is a little more complicated to +use, but the advantages are that it usually takes less code to perform +the same operation, and the resulting program oftens runs faster because +the FITS files are read and written using the most efficient block size. + +C programmers should note that the ordering of arrays in FITS files, and +hence in all the CFITSIO calls, is more similar to the dimensionality +of arrays in Fortran rather than C. For instance if a FITS image has +NAXIS1 = 100 and NAXIS2 = 50, then a 2-D array just large enough to hold +the image should be declared as array[50][100] and not as array[100][50]. + +The `datatype' parameter specifies the data type of the `nulval' and +`array' pointers and can have one of the following values: TBYTE, +TSBYTE, TSHORT, TUSHORT, TINT, TUINT, TLONG, TLONGLONG, TULONG, TFLOAT, +TDOUBLE. Automatic data type conversion is performed if the data type +of the FITS array (as defined by the BITPIX keyword) differs from that +specified by 'datatype'. The data values are also automatically scaled +by the BSCALE and BZERO keyword values as they are being read or written +in the FITS array. + + +\begin{description} +\item[1 ] Get the data type or equivalent data type of the image. The + first routine returns the physical data type of the FITS image, as + given by the BITPIX keyword, with allowed values of BYTE\_IMG (8), + SHORT\_IMG (16), LONG\_IMG (32), FLOAT\_IMG (-32), and DOUBLE\_IMG + (-64). The second routine is similar, except that if the image pixel + values are scaled, with non-default values for the BZERO and BSCALE + keywords, then the routine will return the 'equivalent' data type + that is needed to store the scaled values. For example, if BITPIX + = 16 and BSCALE = 0.1 then the equivalent data type is FLOAT\_IMG. + Similarly if BITPIX = 16, BSCALE = 1, and BZERO = 32768, then the + the pixel values span the range of an unsigned short integer and + the returned data type will be USHORT\_IMG. \label{ffgidt} +\end{description} + +\begin{verbatim} + int fits_get_img_type / ffgidt + (fitsfile *fptr, > int *bitpix, int *status) + + int fits_get_img_equivtype / ffgiet + (fitsfile *fptr, > int *bitpix, int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Get the number of dimensions, and/or the size of + each dimension in the image . The number of axes in the image is + given by naxis, and the size of each dimension is given by the + naxes array (a maximum of maxdim dimensions will be returned). + \label{ffgidm} \label{ffgisz} \label{ffgipr} +\end{description} + +\begin{verbatim} + int fits_get_img_dim / ffgidm + (fitsfile *fptr, > int *naxis, int *status) + + int fits_get_img_size / ffgisz + (fitsfile *fptr, int maxdim, > long *naxes, int *status) + + int fits_get_img_param / ffgipr + (fitsfile *fptr, int maxdim, > int *bitpix, int *naxis, long *naxes, + int *status) +\end{verbatim} + +\begin{description} +\item[3 ]Create a new primary array or IMAGE extension with a specified + data type and size. If the FITS file is currently empty then a + primary array is created, otherwise a new IMAGE extension is + appended to the file. \label{ffcrim} +\end{description} + +\begin{verbatim} + int fits_create_img / ffcrim + ( fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Write a rectangular subimage (or the whole image) to the FITS data + array. The fpixel and lpixel arrays give the coordinates of the + first (lower left corner) and last (upper right corner) pixels in + FITS image to be written to. \label{ffpss} +\end{description} + +\begin{verbatim} + int fits_write_subset / ffpss + (fitsfile *fptr, int datatype, long *fpixel, long *lpixel, + DTYPE *array, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Write pixels into the FITS data array. 'fpixel' is an array of + length NAXIS which gives the coordinate of the starting pixel to be + written to, such that fpixel[0] is in the range 1 to NAXIS1, + fpixel[1] is in the range 1 to NAXIS2, etc. The first routine + simply writes the array of pixels to the FITS file (doing data type + conversion if necessary) whereas the second routine will substitute + the appropriate FITS null value for any elements which are equal to + the input value of nulval (note that this parameter gives the + address of the null value, not the null value itself). For integer + FITS arrays, the FITS null value is defined by the BLANK keyword (an + error is returned if the BLANK keyword doesn't exist). For floating + point FITS arrays the special IEEE NaN (Not-a-Number) value will be + written into the FITS file. If a null pointer is entered for + nulval, then the null value is ignored and this routine behaves + the same as fits\_write\_pix. \label{ffppx} \label{ffppxn} +\end{description} + +\begin{verbatim} + int fits_write_pix / ffppx + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + DTYPE *array, int *status); + + int fits_write_pixnull / ffppxn + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + DTYPE *array, DTYPE *nulval, > int *status); +\end{verbatim} + +\begin{description} +\item[6 ] Set FITS data array elements equal to the appropriate null pixel + value. For integer FITS arrays, the FITS null value is defined by + the BLANK keyword (an error is returned if the BLANK keyword + doesn't exist). For floating point FITS arrays the special IEEE NaN + (Not-a-Number) value will be written into the FITS file. Note that + 'firstelem' is a scalar giving the offset to the first pixel to be + written in the equivalent 1-dimensional array of image pixels. \label{ffpprn} +\end{description} + +\begin{verbatim} + int fits_write_null_img / ffpprn + (fitsfile *fptr, long firstelem, long nelements, > int *status) +\end{verbatim} + +\begin{description} +\item[7 ] Read a rectangular subimage (or the whole image) from the FITS + data array. The fpixel and lpixel arrays give the coordinates of + the first (lower left corner) and last (upper right corner) pixels + to be read from the FITS image. Undefined FITS array elements will + be returned with a value = *nullval, (note that this parameter + gives the address of the null value, not the null value itself) + unless nulval = 0 or *nulval = 0, in which case no checks for + undefined pixels will be performed. \label{ffgsv} +\end{description} + +\begin{verbatim} + int fits_read_subset / ffgsv + (fitsfile *fptr, int datatype, long *fpixel, long *lpixel, long *inc, + DTYPE *nulval, > DTYPE *array, int *anynul, int *status) +\end{verbatim} + +\begin{description} +\item[8 ] Read pixels from the FITS data array. 'fpixel' is the starting + pixel location and is an array of length NAXIS such that fpixel[0] + is in the range 1 to NAXIS1, fpixel[1] is in the range 1 to NAXIS2, + etc. The nelements parameter specifies the number of pixels to + read. If fpixel is set to the first pixel, and nelements is set + equal to the NAXIS1 value, then this routine would read the first + row of the image. Alternatively, if nelements is set equal to + NAXIS1 * NAXIS2 then it would read an entire 2D image, or the first + plane of a 3-D datacube. + + The first routine will return any undefined pixels in the FITS array + equal to the value of *nullval (note that this parameter gives the + address of the null value, not the null value itself) unless nulval + = 0 or *nulval = 0, in which case no checks for undefined pixels + will be performed. The second routine is similar except that any + undefined pixels will have the corresponding nullarray element set + equal to TRUE (= 1). \label{ffgpxv} \label{ffgpxf} +\end{description} + +\begin{verbatim} + int fits_read_pix / ffgpxv + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + DTYPE *nulval, > DTYPE *array, int *anynul, int *status) + + int fits_read_pixnull / ffgpxf + (fitsfile *fptr, int datatype, long *fpixel, long nelements, + > DTYPE *array, char *nullarray, int *anynul, int *status) +\end{verbatim} + +\section{Image Compression} + +CFITSIO now transparently supports 2 types of image compression: + +1) The entire FITS file may be externally compressed with the gzip or +Unix compress algorithm, producing a *.gz or *.Z file, respectively. +When reading compressed files of this type, CFITSIO first uncompresses +the entire file into memory before performing the requested read +operations. Output files can be directly written in the gzip +compressed format if the user-specified filename ends with `.gz'. In +this case, CFITSIO initially writes the uncompressed file in memory and +then compresses it and writes it to disk when the FITS file is closed, +thus saving user disk space. Read and write access to these compressed +FITS files is generally quite fast; the main limitation is that there +must be enough available memory (or swap space) to hold the entire +uncompressed FITS file. + +2) CFITSIO also supports a newer image compression format in which the +image is divided into a grid of rectangular tiles, and each tile of +pixels is individually compressed. The compressed tiles are stored in +rows of a variable length array column in a FITS binary table, but +CFITSIO recognizes that the binary table extension contains an image +and treats it as if it were an IMAGE extension. This tile-compressed +format is especially well suited for compressing very large images +because a) the FITS header keywords remain uncompressed for rapid read +access, and because b) it is possible to extract and uncompress +sections of the image without having to uncompress the entire image. +This format is also much more effective in compressing floating point +images (using a lossy compression algorithm) than simply compressing +the image using gzip or compress. + +A detailed description of this format is available at: + +\begin{verbatim} +http://heasarc.gsfc.nasa.gov/docs/software/fitsio/ + compression/compress_image.html +\end{verbatim} + +The N-dimensional FITS image can be divided into any +desired rectangular grid of compression tiles. By default the tiles +are chosen to correspond to the rows of the image, each containing +NAXIS1 pixels. For example, a 800 x 800 x 4 pixel data cube would be +divided in to 3200 tiles containing 800 pixels each by default. +Alternatively, this data cube could be divided into 256 tiles that are each +100 X 100 X 1 pixels in size, or 4 tiles containing 800 x 800 X 1 +pixels, or a single tile containing the entire data cube. Note that +the image dimensions are not required to be an integer multiple of the +tile dimensions, so, for example, this data cube could also be divided +into 250 X 200 pixel tiles, in which case the last tile in each row +would only contain 50 X 200 pixels. + +Currently, 3 image compression algorithms are supported: Rice, GZIP, +and PLIO. Rice and GZIP are general purpose algorithms that can be +used to compress almost any image. The PLIO algorithm, on the other +hand, is more specialized and was developed for use in IRAF to store +pixel data quality masks. It is designed to only work on images +containing positive integers with values up to about 2**24. Other +image compression algorithms may be supported in the future. + +The 3 supported image compression algorithms are all 'loss-less' when +applied to integer FITS images; the pixel values are preserved exactly +with no loss of information during the compression and uncompression +process. Floating point FITS images (which have BITPIX = -32 or -64) +are first quantized into scaled integer pixel values before being +compressed. This technique produces much higher compression factors +than simply using GZIP to compress the image, but it also means that +the original floating value pixel values may not be precisely returned +when the image is uncompressed. When done properly, this only discards +the 'noise' from the floating point values without losing any +significant information. The amount of noise that is discarded can be +controlled by the 'noise\_bits' compression parameter. + +No special action is required to read tile-compressed images because +all the CFITSIO routines that read normal uncompressed FITS images can +also read images in the tile-compressed format; CFITSIO essentially +treats the binary table that contains the compressed tiles as if +it were an IMAGE extension. + +When creating (writing) a new image with CFITSIO, a normal uncompressed +FITS primary array or IMAGE extension will be written unless the +tile-compressed format has been specified in 1 of 2 possible ways: + +1) At run time, when specifying the name of the output FITS file to be +created at run time, the user can indicate that images should be +written in tile-compressed format by enclosing the compression +parameters in square brackets following the root disk file name. The +`imcopy' example program that included with the CFITSIO distribution +can be used for this purpose to compress or uncompress images. Here +are some examples of the extended file name syntax for specifying +tile-compressed output images: + +\begin{verbatim} + myfile.fit[compress] - use the default compression algorithm (Rice) + and the default tile size (row by row) + + myfile.fit[compress GZIP] - use the specified compression algorithm; + myfile.fit[compress Rice] only the first letter of the algorithm + myfile.fit[compress PLIO] name is required. + + myfile.fit[compress R 100,100] - use Rice compression and + 100 x 100 pixel tile size + + myfile.fit[compress R 100,100;2] - as above, and also use noisebits = 2 +\end{verbatim} + +2) Before calling the CFITSIO routine to write the image header +keywords (e.g., fits\_create\_image) the programmer can call the +routines described below to specify the compression algorithm and the +tiling pattern that is to be used. There are 3 routines for specifying +the various compression parameters and 3 corresponding routines to +return the current values of the parameters: +\label{ffsetcomp} \label{ffgetcomp} + +\begin{verbatim} + int fits_set_compression_type(fitsfile *fptr, int comptype, int *status) + int fits_set_tile_dim(fitsfile *fptr, int ndim, long *tilesize, int *status) + int fits_set_noise_bits(fitsfile *fptr, int noisebits, int *status) + + int fits_get_compression_type(fitsfile *fptr, int *comptype, int *status) + int fits_get_tile_dim(fitsfile *fptr, int ndim, long *tilesize, int *status) + int fits_get_noise_bits(fitsfile *fptr, int *noisebits, int *status) +\end{verbatim} +3 symbolic constants are defined for use as the value of the +`comptype' parameter: GZIP\_1, RICE\_1, or PLIO\_1. Entering NULL for +comptype will turn off the tile-compression and cause normal FITS +images to be written. + +The 'noisebits' parameter is only used when compressing floating point +images. The default value is 4. Decreasing the value of noisebits +will improve the overall compression efficiency at the expense of +losing more information. + +A small example program called 'imcopy' is included with CFITSIO that +can be used to compress (or uncompress) any FITS image. This +program can be used to experiment with the various compression options +on existing FITS images as shown in these examples: + +\begin{verbatim} +1) imcopy infile.fit 'outfile.fit[compress]' + + This will use the default compression algorithm (Rice) and the + default tile size (row by row) + +2) imcopy infile.fit 'outfile.fit[compress GZIP]' + + This will use the GZIP compression algorithm and the default + tile size (row by row). The allowed compression algorithms are + Rice, GZIP, and PLIO. Only the first letter of the algorithm + name needs to be specified. + +3) imcopy infile.fit 'outfile.fit[compress G 100,100]' + + This will use the GZIP compression algorithm and 100 X 100 pixel + tiles. + +4) imcopy infile.fit 'outfile.fit[compress R 100,100; 4]' + + This will use the Rice compression algorithm, 100 X 100 pixel + tiles, and noise_bits = 4 (assuming the input image has a + floating point data type). Decreasing the value of noisebits + will improve the overall compression efficiency at the expense + of losing more information. + +5) imcopy infile.fit outfile.fit + + If the input file is in tile-compressed format, then it will be + uncompressed to the output file. Otherwise, it simply copies + the input image to the output image. + +6) imcopy 'infile.fit[1001:1500,2001:2500]' outfile.fit + + This extracts a 500 X 500 pixel section of the much larger + input image (which may be in tile-compressed format). The + output is a normal uncompressed FITS image. + +7) imcopy 'infile.fit[1001:1500,2001:2500]' outfile.fit.gz + + Same as above, except the output file is externally compressed + using the gzip algorithm. + +\end{verbatim} + +\section{ASCII and Binary Table Routines} + +These routines perform read and write operations on columns of data in +FITS ASCII or Binary tables. Note that in the following discussions, +the first row and column in a table is at position 1 not 0. + +Users should also read the following chapter on the CFITSIO iterator +function which provides a more `object oriented' method of reading and +writing table columns. The iterator function is a little more +complicated to use, but the advantages are that it usually takes less +code to perform the same operation, and the resulting program oftens +runs faster because the FITS files are read and written using the most +efficient block size. + + +\subsection{Create New Table} + + +\begin{description} +\item[1 ]Create a new ASCII or bintable table extension. If + the FITS file is currently empty then a dummy primary array will be + created before appending the table extension to it. The tbltype + parameter defines the type of table and can have values of + ASCII\_TBL or BINARY\_TBL. The naxis2 parameter gives the initial + number of rows to be created in the table, and should normally be + set = 0. CFITSIO will automatically increase the size of the table + as additional rows are written. A non-zero number of rows may be + specified to reserve space for that many rows, even if a fewer + number of rows will be written. The tunit and extname parameters + are optional and a null pointer may be given if they are not + defined. The FITS Standard recommends that only letters, digits, + and the underscore character be used in column names (the ttype + parameter) with no embedded spaces. Trailing blank characters are + not significant. It is recommended that all the column names in a + given table be unique within the first 8 characters, and strongly + recommended that the names be + unique within the first 16 characters. \label{ffcrtb} +\end{description} + +\begin{verbatim} + int fits_create_tbl / ffcrtb + (fitsfile *fptr, int tbltype, long naxis2, int tfields, char *ttype[], + char *tform[], char *tunit[], char *extname, int *status) +\end{verbatim} + +\subsection{Column Information Routines} + + +\begin{description} +\item[1 ] Get the number of rows or columns in the current FITS table. + The number of rows is given by the NAXIS2 keyword and the + number of columns is given by the TFIELDS keyword in the header + of the table. \label{ffgnrw} +\end{description} + +\begin{verbatim} + int fits_get_num_rows / ffgnrw + (fitsfile *fptr, > long *nrows, int *status); + + int fits_get_num_cols / ffgncl + (fitsfile *fptr, > int *ncols, int *status); +\end{verbatim} + + +\begin{description} +\item[2 ] Get the table column number (and name) of the column whose name +matches an input template name. If casesen = CASESEN then the column +name match will be case-sensitive, whereas if casesen = CASEINSEN then +the case will be ignored. As a general rule, the column names should +be treated as case INsensitive. + +The input column name template may be either the exact name of the +column to be searched for, or it may contain wild card characters (*, +?, or \#), or it may contain the integer number of the desired column +(with the first column = 1). The `*' wild card character matches any +sequence of characters (including zero characters) and the `?' +character matches any single character. The \# wildcard will match any +consecutive string of decimal digits (0-9). If more than one column +name in the table matches the template string, then the first match is +returned and the status value will be set to COL\_NOT\_UNIQUE as a +warning that a unique match was not found. To find the other cases +that match the template, call the routine again leaving the input +status value equal to COL\_NOT\_UNIQUE and the next matching name will +then be returned. Repeat this process until a status = +COL\_NOT\_FOUND is returned. + +The FITS Standard recommends that only letters, digits, and the +underscore character be used in column names (with no embedded +spaces). Trailing blank characters are not significant. It is +recommended that all the column names in a given table be unique within +the first 8 characters, and strongly recommended that the names be + unique within the first 16 characters. \label{ffgcno} \label{ffgcnn} +\end{description} + +\begin{verbatim} + int fits_get_colnum / ffgcno + (fitsfile *fptr, int casesen, char *templt, > int *colnum, + int *status) + + int fits_get_colname / ffgcnn + (fitsfile *fptr, int casesen, char *templt, > char *colname, + int *colnum, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Return the data type, vector repeat value, and the width in bytes + of a column in an ASCII or binary table. Allowed values for the + data type in ASCII tables are: TSTRING, TSHORT, TLONG, TFLOAT, and + TDOUBLE. Binary tables also support these types: TLOGICAL, TBIT, + TBYTE, TCOMPLEX and TDBLCOMPLEX. The negative of the data type code + value is returned if it is a variable length array column. Note + that in the case of a 'J' 32-bit integer binary table column, this + routine will return data type = TINT32BIT (which in fact is + equivalent to TLONG). With most current C compilers, a value in a + 'J' column has the same size as an 'int' variable, and may not be + equivalent to a 'long' variable, which is 64-bits long on an + increasing number of compilers. + + The 'repeat' parameter returns the vector repeat count on the binary + table TFORMn keyword value. (ASCII table columns always have repeat + = 1). The 'width' parameter returns the width in bytes of a single + column element (e.g., a '10D' binary table column will have width = + 8, an ASCII table 'F12.2' column will have width = 12, and a binary + table'60A' character string column will have width = 60); Note that + this routine supports the local convention for specifying arrays of + fixed length strings within a binary table character column using + the syntax TFORM = 'rAw' where 'r' is the total number of characters + (= the width of the column) and 'w' is the width of a unit string + within the column. Thus if the column has TFORM = '60A12' then this + means that each row of the table contains 5 12-character substrings + within the 60-character field, and thus in this case this routine will + return typecode = TSTRING, repeat = 60, and width = 12. The number + of substings in any binary table character string field can be + calculated by (repeat/width). A null pointer may be given for any of + the output parameters that are not needed. + + The second routine, fit\_get\_eqcoltype is similar except that in + the case of scaled integer columns it returns the 'equivalent' data + type that is needed to store the scaled values, and not necessarily + the physical data type of the unscaled values as stored in the FITS + table. For example if a '1I' column in a binary table has TSCALn = + 1 and TZEROn = 32768, then this column effectively contains unsigned + short integer values, and thus the returned value of typecode will + be TUSHORT, not TSHORT. Similarly, if a column has TTYPEn = '1I' + and TSCALn = 0.12, then the returned typecode + will be TFLOAT. \label{ffgtcl} +\end{description} + +\begin{verbatim} + int fits_get_coltype / ffgtcl + (fitsfile *fptr, int colnum, > int *typecode, long *repeat, + long *width, int *status) + + int fits_get_eqcoltype / ffeqty + (fitsfile *fptr, int colnum, > int *typecode, long *repeat, + long *width, int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Return the display width of a column. This is the length + of the string that will be returned by the fits\_read\_col routine + when reading the column as a formatted string. The display width is + determined by the TDISPn keyword, if present, otherwise by the data + type of the column. \label{ffgcdw} +\end{description} + +\begin{verbatim} + int fits_get_col_display_width / ffgcdw + (fitsfile *fptr, int colnum, > int *dispwidth, int *status) +\end{verbatim} + + +\begin{description} +\item[5 ] Return the number of and size of the dimensions of a table column in + a binary table. Normally this information is given by the TDIMn keyword, + but if this keyword is not present then this routine returns naxis = 1 + and naxes[0] equal to the repeat count in the TFORM keyword. \label{ffgtdm} +\end{description} + +\begin{verbatim} + int fits_read_tdim / ffgtdm + (fitsfile *fptr, int colnum, int maxdim, > int *naxis, + long *naxes, int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Decode the input TDIMn keyword string (e.g. '(100,200)') and return the + number of and size of the dimensions of a binary table column. If the input + tdimstr character string is null, then this routine returns naxis = 1 + and naxes[0] equal to the repeat count in the TFORM keyword. This routine + is called by fits\_read\_tdim. \label{ffdtdm} +\end{description} + +\begin{verbatim} + int fits_decode_tdim / ffdtdm + (fitsfile *fptr, char *tdimstr, int colnum, int maxdim, > int *naxis, + long *naxes, int *status) +\end{verbatim} + +\begin{description} +\item[7 ] Write a TDIMn keyword whose value has the form '(l,m,n...)' + where l, m, n... are the dimensions of a multidimension array + column in a binary table. \label{ffptdm} +\end{description} + +\begin{verbatim} + int fits_write_tdim / ffptdm + (fitsfile *fptr, int colnum, int naxis, long *naxes, > int *status) +\end{verbatim} + + +\subsection{Routines to Edit Rows or Columns} + + +\begin{description} +\item[1 ] Insert or delete rows in an ASCII or binary table. When inserting rows + all the rows following row FROW are shifted down by NROWS rows; if + FROW = 0 then the blank rows are inserted at the beginning of the + table. The first delete routine deletes NROWS consecutive rows + starting with row FIRSTROW. The second delete routine takes an + input string that lists the rows or row ranges (e.g., + '5-10,12,20-30'), whereas the third delete routine takes an input + integer array that specifies each individual row to be deleted. In + both latter cases, the input list of rows to delete must be sorted + in ascending order. These routines update the NAXIS2 keyword to + reflect the new number of rows in the + table. \label{ffirow} \label{ffdrow} \label{ffdrws} \label{ffdrrg} +\end{description} + +\begin{verbatim} + int fits_insert_rows / ffirow + (fitsfile *fptr, long firstrow, long nrows, > int *status) + + int fits_delete_rows / ffdrow + (fitsfile *fptr, long firstrow, long nrows, > int *status) + + int fits_delete_rowrange / ffdrrg + (fitsfile *fptr, char *rangelist, > int *status) + + int fits_delete_rowlist / ffdrws + (fitsfile *fptr, long *rowlist, long nrows, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Insert or delete column(s) in an ASCII or binary + table. When inserting, COLNUM specifies the column number that the + (first) new column should occupy in the table. NCOLS specifies how + many columns are to be inserted. Any existing columns from this + position and higher are shifted over to allow room for the new + column(s). The index number on all the following keywords will be + incremented or decremented if necessary to reflect the new position + of the column(s) in the table: TBCOLn, TFORMn, TTYPEn, TUNITn, + TNULLn, TSCALn, TZEROn, TDISPn, TDIMn, TLMINn, TLMAXn, TDMINn, + TDMAXn, TCTYPn, TCRPXn, TCRVLn, TCDLTn, TCROTn, + and TCUNIn. \label{fficol} \label{fficls} \label{ffdcol} +\end{description} + +\begin{verbatim} + int fits_insert_col / fficol + (fitsfile *fptr, int colnum, char *ttype, char *tform, + > int *status) + + int fits_insert_cols / fficls + (fitsfile *fptr, int colnum, int ncols, char **ttype, + char **tform, > int *status) + + int fits_delete_col / ffdcol(fitsfile *fptr, int colnum, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Copy a column from one HDU to another (or to the same HDU). If + create\_col = TRUE, then a new column will be inserted in the output + table, at position `outcolumn', otherwise the existing output column will + be overwritten (in which case it must have a compatible data type). + If outcolnum is greater than the number of column in the table, then + the new column will be appended to the end of the table. + Note that the first column in a table is at colnum = 1. + The standard indexed keywords that related to the column (e.g., TDISPn, + TUNITn, TCRPXn, TCDLTn, etc.) will also be copied. \label{ffcpcl} +\end{description} + +\begin{verbatim} + int fits_copy_col / ffcpcl + (fitsfile *infptr, fitsfile *outfptr, int incolnum, int outcolnum, + int create_col, > int *status); +\end{verbatim} + +\begin{description} +\item[4 ] Modify the vector length of a binary table column (e.g., + change a column from TFORMn = '1E' to '20E'). The vector + length may be increased or decreased from the current value. \label{ffmvec} +\end{description} + +\begin{verbatim} + int fits_modify_vector_len / ffmvec + (fitsfile *fptr, int colnum, long newveclen, > int *status) +\end{verbatim} + +\subsection{Read and Write Column Data Routines} + +The following routines write or read data values in the current ASCII +or binary table extension. If a write operation extends beyond the +current size of the table, then the number of rows in the table will +automatically be increased and the NAXIS2 keyword value will be +updated. Attempts to read beyond the end of the table will result in +an error. + +Automatic data type conversion is performed for numerical data types +(only) if the data type of the column (defined by the TFORMn keyword) +differs from the data type of the calling routine. ASCII and binary +tables support the following data type values: TSTRING, TBYTE, TSBYTE, TSHORT, +TUSHORT, TINT, TUINT, TLONG, TLONGLONG, TULONG, TFLOAT, or TDOUBLE. +Binary tables also support TLOGICAL (internally mapped to the `char' +data type), TCOMPLEX, and TDBLCOMPLEX. + +Note that within the context of these routines, the TSTRING data type +corresponds to a C 'char**' data type, i.e., a pointer to an array of +pointers to an array of characters. This is different from the keyword +reading and writing routines where TSTRING corresponds to a C 'char*' +data type, i.e., a single pointer to an array of characters. When +reading strings from a table, the char arrays obviously must have been +allocated long enough to hold the whole FITS table string. + +Numerical data values are automatically scaled by the TSCALn and TZEROn +keyword values (if they exist). + +In the case of binary tables with vector elements, the 'felem' +parameter defines the starting element (beginning with 1, not 0) within +the cell (a cell is defined as the intersection of a row and a column +and may contain a single value or a vector of values). The felem +parameter is ignored when dealing with ASCII tables. Similarly, in the +case of binary tables the 'nelements' parameter specifies the total +number of vector values to be read or written (continuing on subsequent +rows if required) and not the number of table cells. + + +\begin{description} +\item[1 ] Write elements into an ASCII or binary table column. +\end{description} + The first routine simply writes the array of values to the FITS file + (doing data type conversion if necessary) whereas the second routine + will substitute the appropriate FITS null value for all elements + which are equal to the input value of nulval (note that this + parameter gives the address of nulval, not the null value + itself). For integer columns the FITS null value is defined by the + TNULLn keyword (an error is returned if the keyword doesn't exist). + For floating point columns the special IEEE NaN (Not-a-Number) + value will be written into the FITS file. If a null pointer is + entered for nulval, then the null value is ignored and this routine + behaves the same as the first routine. The second routine must not + be used to write to variable length array columns. The third routine + simply writes undefined pixel values to the column. + \label{ffpcl} \label{ffpcn} \label{ffpclu} + +\begin{verbatim} + int fits_write_col / ffpcl + (fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelements, DTYPE *array, > int *status) + + int fits_write_colnull / ffpcn + (fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelements, DTYPE *array, DTYPE *nulval, + > int *status) + + int fits_write_col_null / ffpclu + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Read elements from an ASCII or binary table column. The data type + parameter specifies the data type of the `nulval' and `array' pointers; + Undefined array elements will be returned with a value = *nullval, + (note that this parameter gives the address of the null value, not the + null value itself) unless nulval = 0 or *nulval = 0, in which case + no checking for undefined pixels will be performed. The second + routine is similar except that any undefined pixels will have the + corresponding nullarray element set equal to TRUE (= 1). + + Any column, regardless of it's intrinsic data type, may be read as a + string. It should be noted however that reading a numeric column + as a string is 10 - 100 times slower than reading the same column + as a number due to the large overhead in constructing the formatted + strings. The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + data type of the column. The length of the returned strings (not + including the null terminating character) can be determined with + the fits\_get\_col\_display\_width routine. The following TDISPn + display formats are currently supported: + +\begin{verbatim} + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +\end{verbatim} + where w is the width in characters of the displayed values, m is the minimum + number of digits displayed, and d is the number of digits to the right of the + decimal. The .m field is optional. + \label{ffgcv} \label{ffgcf} +\end{description} + +\begin{verbatim} + int fits_read_col / ffgcv + (fitsfile *fptr, int datatype, int colnum, long firstrow, long firstelem, + long nelements, DTYPE *nulval, DTYPE *array, int *anynul, int *status) + + int fits_read_colnull / ffgcf + (fitsfile *fptr, int datatype, int colnum, long firstrow, long firstelem, + long nelements, DTYPE *array, char *nullarray, int *anynul, int *status) +\end{verbatim} + + +\subsection{Row Selection and Calculator Routines} + +These routines all parse and evaluate an input string containing a user +defined arithmetic expression. The first 3 routines select rows in a +FITS table, based on whether the expression evaluates to true (not +equal to zero) or false (zero). The other routines evaluate the +expression and calculate a value for each row of the table. The +allowed expression syntax is described in the row filter section in the +`Extended File Name Syntax' chapter of this document. The expression +may also be written to a text file, and the name of the file, prepended +with a '@' character may be supplied for the 'expr' parameter (e.g. +'@filename.txt'). The expression in the file can be arbitrarily +complex and extend over multiple lines of the file. Lines that begin +with 2 slash characters ('//') will be ignored and may be used to add +comments to the file. + + +\begin{description} +\item[1 ] Evaluate a boolean expression over the indicated rows, returning an + array of flags indicating which rows evaluated to TRUE/FALSE \label{fffrow} +\end{description} + +\begin{verbatim} + int fits_find_rows / fffrow + (fitsfile *fptr, char *expr, long firstrow, long nrows, + > long *n_good_rows, char *row_status, int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Find the first row which satisfies the input boolean expression \label{ffffrw} +\end{description} + +\begin{verbatim} + int fits_find_first_row / ffffrw + (fitsfile *fptr, char *expr, > long *rownum, int *status) +\end{verbatim} + +\begin{description} +\item[3 ]Evaluate an expression on all rows of a table. If the input and output +files are not the same, copy the TRUE rows to the output file. If the +files are the same, delete the FALSE rows (preserve the TRUE rows). \label{ffsrow} +\end{description} + +\begin{verbatim} + int fits_select_rows / ffsrow + (fitsfile *infptr, fitsfile *outfptr, char *expr, > int *status ) +\end{verbatim} + +\begin{description} +\item[4 ] Calculate an expression for the indicated rows of a table, returning +the results, cast as datatype (TSHORT, TDOUBLE, etc), in array. If +nulval==NULL, UNDEFs will be zeroed out. For vector results, the number +of elements returned may be less than nelements if nelements is not an +even multiple of the result dimension. Call fits\_test\_expr to obtain +the dimensions of the results. \label{ffcrow} +\end{description} + +\begin{verbatim} + int fits_calc_rows / ffcrow + (fitsfile *fptr, int datatype, char *expr, long firstrow, + long nelements, void *nulval, > void *array, int *anynul, int *status) +\end{verbatim} + +\begin{description} +\item[5 ]Evaluate an expression and write the result either to a column (if +the expression is a function of other columns in the table) or to a +keyword (if the expression evaluates to a constant and is not a +function of other columns in the table). In the former case, the +parName parameter is the name of the column (which may or may not already +exist) into which to write the results, and parInfo contains an +optional TFORM keyword value if a new column is being created. If a +TFORM value is not specified then a default format will be used, +depending on the expression. If the expression evaluates to a constant, +then the result will be written to the keyword name given by the +parName parameter, and the parInfo parameter may be used to supply an +optional comment for the keyword. If the keyword does not already +exist, then the name of the keyword must be preceded with a '\#' character, +otherwise the result will be written to a column with that name. + \label{ffcalc} +\end{description} + +\begin{verbatim} + int fits_calculator / ffcalc + (fitsfile *infptr, char *expr, fitsfile *outfptr, char *parName, + char *parInfo, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ] This calculator routine is similar to the previous routine, except +that the expression is only evaluated over the specified +row ranges. nranges specifies the number of row ranges, and firstrow +and lastrow give the starting and ending row number of each range. + \label{ffcalcrng} +\end{description} + +\begin{verbatim} + int fits_calculator_rng / ffcalc_rng + (fitsfile *infptr, char *expr, fitsfile *outfptr, char *parName, + char *parInfo, int nranges, long *firstrow, long *lastrow + > int *status) +\end{verbatim} + + +\begin{description} +\item[7 ]Evaluate the given expression and return information on the result. \label{fftexp} +\end{description} + +\begin{verbatim} + int fits_test_expr / fftexp + (fitsfile *fptr, char *expr, > int *datatype, long *nelem, int *naxis, + long *naxes, int *status) +\end{verbatim} + + + +\section{Utility Routines} + + +\subsection{File Checksum Routines} + +The following routines either compute or validate the checksums for the +CHDU. The DATASUM keyword is used to store the numerical value of the +32-bit, 1's complement checksum for the data unit alone. If there is +no data unit then the value is set to zero. The numerical value is +stored as an ASCII string of digits, enclosed in quotes, because the +value may be too large to represent as a 32-bit signed integer. The +CHECKSUM keyword is used to store the ASCII encoded COMPLEMENT of the +checksum for the entire HDU. Storing the complement, rather than the +actual checksum, forces the checksum for the whole HDU to equal zero. +If the file has been modified since the checksums were computed, then +the HDU checksum will usually not equal zero. These checksum keyword +conventions are based on a paper by Rob Seaman published in the +proceedings of the ADASS IV conference in Baltimore in November 1994 +and a later revision in June 1995. See Appendix B for the definition +of the parameters used in these routines. + + +\begin{description} +\item[1 ] Compute and write the DATASUM and CHECKSUM keyword values for the CHDU + into the current header. If the keywords already exist, their values + will be updated only if necessary (i.e., if the file + has been modified since the original keyword + values were computed). \label{ffpcks} +\end{description} + +\begin{verbatim} + int fits_write_chksum / ffpcks + (fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Update the CHECKSUM keyword value in the CHDU, assuming that the + DATASUM keyword exists and already has the correct value. This routine + calculates the new checksum for the current header unit, adds it to the + data unit checksum, encodes the value into an ASCII string, and writes + the string to the CHECKSUM keyword. \label{ffupck} +\end{description} + +\begin{verbatim} + int fits_update_chksum / ffupck + (fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Verify the CHDU by computing the checksums and comparing + them with the keywords. The data unit is verified correctly + if the computed checksum equals the value of the DATASUM + keyword. The checksum for the entire HDU (header plus data unit) is + correct if it equals zero. The output DATAOK and HDUOK parameters + in this routine are integers which will have a value = 1 + if the data or HDU is verified correctly, a value = 0 + if the DATASUM or CHECKSUM keyword is not present, or value = -1 + if the computed checksum is not correct. \label{ffvcks} +\end{description} + +\begin{verbatim} + int fits_verify_chksum / ffvcks + (fitsfile *fptr, > int *dataok, int *hduok, int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Compute and return the checksum values for the CHDU + without creating or modifying the + CHECKSUM and DATASUM keywords. This routine is used internally by + ffvcks, but may be useful in other situations as well. \label{ffgcks} +\end{description} + +\begin{verbatim} + int fits_get_chksum/ /ffgcks + (fitsfile *fptr, > unsigned long *datasum, unsigned long *hdusum, + int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Encode a checksum value + into a 16-character string. If complm is non-zero (true) then the 32-bit + sum value will be complemented before encoding. \label{ffesum} +\end{description} + +\begin{verbatim} + int fits_encode_chksum / ffesum + (unsigned long sum, int complm, > char *ascii); +\end{verbatim} + +\begin{description} +\item[6 ] Decode a 16-character checksum string into a unsigned long value. + If is non-zero (true). then the 32-bit sum value will be complemented + after decoding. The checksum value is also returned as the + value of the function. \label{ffdsum} +\end{description} + +\begin{verbatim} + unsigned long fits_decode_chksum / ffdsum + (char *ascii, int complm, > unsigned long *sum); +\end{verbatim} + + +\subsection{Date and Time Utility Routines} + +The following routines help to construct or parse the FITS date/time +strings. Starting in the year 2000, the FITS DATE keyword values (and +the values of other `DATE-' keywords) must have the form 'YYYY-MM-DD' +(date only) or 'YYYY-MM-DDThh:mm:ss.ddd...' (date and time) where the +number of decimal places in the seconds value is optional. These times +are in UTC. The older 'dd/mm/yy' date format may not be used for dates +after 01 January 2000. See Appendix B for the definition of the +parameters used in these routines. + + +\begin{description} +\item[1 ] Get the current system date. C already provides standard + library routines for getting the current date and time, + but this routine is provided for compatibility with + the Fortran FITSIO library. The returned year has 4 digits + (1999, 2000, etc.) \label{ffgsdt} +\end{description} + +\begin{verbatim} + int fits_get_system_date/ffgsdt + ( > int *day, int *month, int *year, int *status ) +\end{verbatim} + + +\begin{description} +\item[2 ] Get the current system date and time string ('YYYY-MM-DDThh:mm:ss'). +The time will be in UTC/GMT if available, as indicated by a returned timeref +value = 0. If the returned value of timeref = 1 then this indicates that +it was not possible to convert the local time to UTC, and thus the local +time was returned. +\end{description} + +\begin{verbatim} + int fits_get_system_time/ffgstm + (> char *datestr, int *timeref, int *status) +\end{verbatim} + + +\begin{description} +\item[3 ] Construct a date string from the input date values. If the year +is between 1900 and 1998, inclusive, then the returned date string will +have the old FITS format ('dd/mm/yy'), otherwise the date string will +have the new FITS format ('YYYY-MM-DD'). Use fits\_time2str instead + to always return a date string using the new FITS format. \label{ffdt2s} +\end{description} + +\begin{verbatim} + int fits_date2str/ffdt2s + (int year, int month, int day, > char *datestr, int *status) +\end{verbatim} + + +\begin{description} +\item[4 ] Construct a new-format date + time string ('YYYY-MM-DDThh:mm:ss.ddd...'). + If the year, month, and day values all = 0 then only the time is encoded + with format 'hh:mm:ss.ddd...'. The decimals parameter specifies how many + decimal places of fractional seconds to include in the string. If `decimals' + is negative, then only the date will be return ('YYYY-MM-DD'). +\end{description} + +\begin{verbatim} + int fits_time2str/fftm2s + (int year, int month, int day, int hour, int minute, double second, + int decimals, > char *datestr, int *status) +\end{verbatim} + + +\begin{description} +\item[5 ] Return the date as read from the input string, where the string may be +in either the old ('dd/mm/yy') or new ('YYYY-MM-DDThh:mm:ss' or +'YYYY-MM-DD') FITS format. Null pointers may be supplied for any + unwanted output date parameters. +\end{description} + +\begin{verbatim} + int fits_str2date/ffs2dt + (char *datestr, > int *year, int *month, int *day, int *status) +\end{verbatim} + + +\begin{description} +\item[6 ] Return the date and time as read from the input string, where the +string may be in either the old or new FITS format. The returned hours, +minutes, and seconds values will be set to zero if the input string +does not include the time ('dd/mm/yy' or 'YYYY-MM-DD') . Similarly, +the returned year, month, and date values will be set to zero if the +date is not included in the input string ('hh:mm:ss.ddd...'). Null +pointers may be supplied for any unwanted output date and time +parameters. +\end{description} + +\begin{verbatim} + int fits_str2time/ffs2tm + (char *datestr, > int *year, int *month, int *day, int *hour, + int *minute, double *second, int *status) +\end{verbatim} + + +\subsection{General Utility Routines} + +The following utility routines may be useful for certain applications. + + +\begin{description} +\item[1 ] Return the revision number of the CFITSIO library. + The revision number will be incremented with each new + release of CFITSIO. \label{ffvers} +\end{description} + +\begin{verbatim} + float fits_get_version / ffvers ( > float *version) +\end{verbatim} + +\begin{description} +\item[2 ] Write an 80-character message to the CFITSIO error stack. Application + programs should not normally write to the stack, but there may be + some situations where this is desirable. \label{ffpmsg} +\end{description} + +\begin{verbatim} + void fits_write_errmsg / ffpmsg (char *err_msg) +\end{verbatim} + +\begin{description} +\item[3 ] Convert a character string to uppercase (operates in place). \label{ffupch} +\end{description} + +\begin{verbatim} + void fits_uppercase / ffupch (char *string) +\end{verbatim} + +\begin{description} +\item[4 ] Compare the input template string against the reference string + to see if they match. The template string may contain wildcard + characters: '*' will match any sequence of characters (including + zero characters) and '\%' will match any single character in the + reference string. If casesen = CASESEN = TRUE then the match will be + case sensitive, otherwise the case of the letters will be ignored + if casesen = CASEINSEN = FALSE. The returned MATCH parameter will be + TRUE if the 2 strings match, and EXACT will be TRUE if the match is + exact (i.e., if no wildcard characters were used in the match). + Both strings must be 68 characters or less in length. \label{ffcmps} +\end{description} + +\begin{verbatim} + void fits_compare_str / ffcmps + (char *templt, char *string, int casesen, > int *match, int *exact) +\end{verbatim} + +\begin{description} +\item[5 ]Split a string containing a list of names (typically file names or column + names) into individual name tokens by a sequence of calls to + fits\_split\_names. The names in the list must be delimited by a comma + and/or spaces. This routine ignores spaces and commas that occur + within parentheses, brackets, or curly brackets. It also strips any + leading and trailing blanks from the returned name. + + This routine is similar to the ANSI C 'strtok' function: + + The first call to fits\_split\_names has a non-null input string. + It finds the first name in the string and terminates it by overwriting + the next character of the string with a null terminator and returns a + pointer to the name. Each subsequent call, indicated by a NULL value + of the input string, returns the next name, searching from just past + the end of the previous name. It returns NULL when no further names + are found. \label{splitnames} +\end{description} + +\begin{verbatim} + char *fits_split_names(char *namelist) +\end{verbatim} + The following example shows how a string would be split into 3 names: + +\begin{verbatim} + myfile[1][bin (x,y)=4], file2.fits file3.fits + ^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^ ^^^^^^^^^^ + 1st name 2nd name 3rd name +\end{verbatim} + +\begin{description} +\item[6 ] Test that the keyword name contains only legal characters (A-Z,0-9, + hyphen, and underscore) or that the keyword record contains only legal + printable ASCII characters \label{fftkey} \label{fftrec} +\end{description} + +\begin{verbatim} + int fits_test_keyword / fftkey (char *keyname, > int *status) + + int fits_test_record / fftrec (char *card, > int *status) +\end{verbatim} + +\begin{description} +\item[7 ] Test whether the current header contains any NULL (ASCII 0) characters. + These characters are illegal in the header, but they will go undetected + by most of the CFITSIO keyword header routines, because the null is + interpreted as the normal end-of-string terminator. This routine returns + the position of the first null character in the header, or zero if there + are no nulls. For example a returned value of 110 would indicate that + the first NULL is located in the 30th character of the second keyword + in the header (recall that each header record is 80 characters long). + Note that this is one of the few CFITSIO routines in which the returned + value is not necessarily equal to the status value). + \label{ffnchk} +\end{description} + +\begin{verbatim} + int fits_null_check / ffnchk (char *card, > int *status) +\end{verbatim} + +\begin{description} +\item[8 ] Parse a header keyword record and return the name of the keyword, + and the length of the name. + The keyword name normally occupies the first 8 characters of the + record, except under the HIERARCH convention where the name can + be up to 70 characters in length. \label{ffgknm} +\end{description} + +\begin{verbatim} + int fits_get_keyname / ffgknm + (char *card, > char *keyname, int *keylength, int *status) +\end{verbatim} + +\begin{description} +\item[9 ] Parse a header keyword record, returning the value (as + a literal character string) and comment strings. If the keyword has no + value (columns 9-10 not equal to '= '), then a null value string is + returned and the comment string is set equal to column 9 - 80 of the + input string. \label{ffpsvc} +\end{description} + +\begin{verbatim} + int fits_parse_value / ffpsvc + (char *card, > char *value, char *comment, int *status) +\end{verbatim} + +\begin{description} +\item[10] Construct an array indexed keyword name (ROOT + nnn). + This routine appends the sequence number to the root string to create + a keyword name (e.g., 'NAXIS' + 2 = 'NAXIS2') \label{ffkeyn} +\end{description} + +\begin{verbatim} + int fits_make_keyn / ffkeyn + (char *keyroot, int value, > char *keyname, int *status) +\end{verbatim} + +\begin{description} +\item[11] Construct a sequence keyword name (n + ROOT). + This routine concatenates the sequence number to the front of the + root string to create a keyword name (e.g., 1 + 'CTYP' = '1CTYP') \label{ffnkey} +\end{description} + +\begin{verbatim} + int fits_make_nkey / ffnkey + (int value, char *keyroot, > char *keyname, int *status) +\end{verbatim} + +\begin{description} +\item[12] Determine the data type of a keyword value string. This routine + parses the keyword value string to determine its data type. + Returns 'C', 'L', 'I', 'F' or 'X', for character string, logical, + integer, floating point, or complex, respectively. \label{ffdtyp} +\end{description} + +\begin{verbatim} + int fits_get_keytype / ffdtyp + (char *value, > char *dtype, int *status) +\end{verbatim} + +\begin{description} +\item[13] Return the class of an input header record. The record is classified + into one of the following categories (the class values are + defined in fitsio.h). Note that this is one of the few CFITSIO + routines that does not return a status value. \label{ffgkcl} +\end{description} + +\begin{verbatim} + Class Value Keywords + TYP_STRUC_KEY 10 SIMPLE, BITPIX, NAXIS, NAXISn, EXTEND, BLOCKED, + GROUPS, PCOUNT, GCOUNT, END + XTENSION, TFIELDS, TTYPEn, TBCOLn, TFORMn, THEAP, + and the first 4 COMMENT keywords in the primary array + that define the FITS format. + TYP_CMPRS_KEY 20 The experimental keywords used in the compressed + image format ZIMAGE, ZCMPTYPE, ZNAMEn, ZVALn, + ZTILEn, ZBITPIX, ZNAXISn, ZSCALE, ZZERO, ZBLANK + TYP_SCAL_KEY 30 BSCALE, BZERO, TSCALn, TZEROn + TYP_NULL_KEY 40 BLANK, TNULLn + TYP_DIM_KEY 50 TDIMn + TYP_RANG_KEY 60 TLMINn, TLMAXn, TDMINn, TDMAXn, DATAMIN, DATAMAX + TYP_UNIT_KEY 70 BUNIT, TUNITn + TYP_DISP_KEY 80 TDISPn + TYP_HDUID_KEY 90 EXTNAME, EXTVER, EXTLEVEL, HDUNAME, HDUVER, HDULEVEL + TYP_CKSUM_KEY 100 CHECKSUM, DATASUM + TYP_WCS_KEY 110 CTYPEn, CUNITn, CRVALn, CRPIXn, CROTAn, CDELTn + CDj_is, PVj_ms, LONPOLEs, LATPOLEs + TCTYPn, TCTYns, TCUNIn, TCUNns, TCRVLn, TCRVns, TCRPXn, + TCRPks, TCDn_k, TCn_ks, TPVn_m, TPn_ms, TCDLTn, TCROTn + jCTYPn, jCTYns, jCUNIn, jCUNns, jCRVLn, jCRVns, iCRPXn, + iCRPns, jiCDn, jiCDns, jPVn_m, jPn_ms, jCDLTn, jCROTn + (i,j,m,n are integers, s is any letter) + TYP_REFSYS_KEY 120 EQUINOXs, EPOCH, MJD-OBSs, RADECSYS, RADESYSs + TYP_COMM_KEY 130 COMMENT, HISTORY, (blank keyword) + TYP_CONT_KEY 140 CONTINUE + TYP_USER_KEY 150 all other keywords + + int fits_get_keyclass / ffgkcl (char *card) +\end{verbatim} + +\begin{description} +\item[14] Parse the 'TFORM' binary table column format string. + This routine parses the input TFORM character string and returns the + integer data type code, the repeat count of the field, and, in the case + of character string fields, the length of the unit string. See Appendix + B for the allowed values for the returned typecode parameter. A + null pointer may be given for any output parameters that are not needed. \label{ffbnfm} +\end{description} + +\begin{verbatim} + int fits_binary_tform / ffbnfm + (char *tform, > int *typecode, long *repeat, long *width, + int *status) +\end{verbatim} + +\begin{description} +\item[15] Parse the 'TFORM' keyword value that defines the column format in + an ASCII table. This routine parses the input TFORM character + string and returns the data type code, the width of the column, + and (if it is a floating point column) the number of decimal places + to the right of the decimal point. The returned data type codes are + the same as for the binary table, with the following + additional rules: integer columns that are between 1 and 4 characters + wide are defined to be short integers (code = TSHORT). Wider integer + columns are defined to be regular integers (code = TLONG). Similarly, + Fixed decimal point columns (with TFORM = 'Fw.d') are defined to + be single precision reals (code = TFLOAT) if w is between 1 and 7 characters + wide, inclusive. Wider 'F' columns will return a double precision + data code (= TDOUBLE). 'Ew.d' format columns will have datacode = TFLOAT, + and 'Dw.d' format columns will have datacode = TDOUBLE. A null + pointer may be given for any output parameters that are not needed. \label{ffasfm} +\end{description} + +\begin{verbatim} + int fits_ascii_tform / ffasfm + (char *tform, > int *typecode, long *width, int *decimals, + int *status) +\end{verbatim} + +\begin{description} +\item[16] Calculate the starting column positions and total ASCII table width + based on the input array of ASCII table TFORM values. The SPACE input + parameter defines how many blank spaces to leave between each column + (it is recommended to have one space between columns for better human + readability). \label{ffgabc} +\end{description} + +\begin{verbatim} + int fits_get_tbcol / ffgabc + (int tfields, char **tform, int space, > long *rowlen, + long *tbcol, int *status) +\end{verbatim} + +\begin{description} +\item[17] Parse a template header record and return a formatted 80-character string + suitable for appending to (or deleting from) a FITS header file. + This routine is useful for parsing lines from an ASCII template file + and reformatting them into legal FITS header records. The formatted + string may then be passed to the fits\_write\_record, ffmcrd, or + fits\_delete\_key routines + to append or modify a FITS header record. \label{ffgthd} +\end{description} + +\begin{verbatim} + int fits_parse_template / ffgthd + (char *templt, > char *card, int *keytype, int *status) +\end{verbatim} + The input templt character string generally should contain 3 tokens: + (1) the KEYNAME, (2) the VALUE, and (3) the COMMENT string. The + TEMPLATE string must adhere to the following format: + + +\begin{description} +\item[- ] The KEYNAME token must begin in columns 1-8 and be a maximum of 8 + characters long. A legal FITS keyword name may only + contain the characters A-Z, 0-9, and '-' (minus sign) and + underscore. This routine will automatically convert any lowercase + characters to uppercase in the output string. If the first 8 characters + of the template line are + blank then the remainder of the line is considered to be a FITS comment + (with a blank keyword name). +\end{description} + + +\begin{description} +\item[- ] The VALUE token must be separated from the KEYNAME token by one or more + spaces and/or an '=' character. The data type of the VALUE token + (numeric, logical, or character string) is automatically determined + and the output CARD string is formatted accordingly. The value + token may be forced to be interpreted as a string (e.g. if it is a + string of numeric digits) by enclosing it in single quotes. +\end{description} + + +\begin{description} +\item[- ] The COMMENT token is optional, but if present must be separated from + the VALUE token by at least one blank space and a '/' character. +\end{description} + + +\begin{description} +\item[- ] One exception to the above rules is that if the first non-blank + character in the first 8 characters of the template string is a + minus sign ('-') followed + by a single token, or a single token followed by an equal sign, + then it is interpreted as the name of a keyword which is to be + deleted from the FITS header. +\end{description} + + +\begin{description} +\item[- ] The second exception is that if the template string starts with + a minus sign and is followed by 2 tokens (without an equals sign between + them) then the second token + is interpreted as the new name for the keyword specified by + first token. In this case the old keyword name (first token) + is returned in characters 1-8 of the returned CARD string, and + the new keyword name (the second token) is returned in characters + 41-48 of the returned CARD string. These old and new names + may then be passed to the ffmnam routine which will change + the keyword name. +\end{description} + + The keytype output parameter indicates how the returned CARD string + should be interpreted: + +\begin{verbatim} + keytype interpretation + ------- ------------------------------------------------- + -2 Rename the keyword with name = the first 8 characters of CARD + to the new name given in characters 41 - 48 of CARD. + + -1 delete the keyword with this name from the FITS header. + + 0 append the CARD string to the FITS header if the + keyword does not already exist, otherwise update + the keyword value and/or comment field if is already exists. + + 1 This is a HISTORY or COMMENT keyword; append it to the header + + 2 END record; do not explicitly write it to the FITS file. +\end{verbatim} + EXAMPLES: The following lines illustrate valid input template strings: + +\begin{verbatim} + INTVAL 7 / This is an integer keyword + RVAL 34.6 / This is a floating point keyword + EVAL=-12.45E-03 / This is a floating point keyword in exponential notation + lval F / This is a boolean keyword + This is a comment keyword with a blank keyword name + SVAL1 = 'Hello world' / this is a string keyword + SVAL2 '123.5' this is also a string keyword + sval3 123+ / this is also a string keyword with the value '123+ ' + # the following template line deletes the DATE keyword + - DATE + # the following template line modifies the NAME keyword to OBJECT + - NAME OBJECT +\end{verbatim} + +\begin{description} +\item[18] Parse the input string containing a list of rows or row ranges, and + return integer arrays containing the first and last row in each + range. For example, if rowlist = "3-5, 6, 8-9" then it will + return numranges = 3, rangemin = 3, 6, 8 and rangemax = 5, 6, 9. + At most, 'maxranges' number of ranges will be returned. 'maxrows' + is the maximum number of rows in the table; any rows or ranges + larger than this will be ignored. The rows must be specified in + increasing order, and the ranges must not overlap. A minus sign + may be use to specify all the rows to the upper or lower bound, so + "50-" means all the rows from 50 to the end of the table, and "-" + means all the rows in the table, from 1 - maxrows. + \label{ffrwrg} +\end{description} + +\begin{verbatim} + int fits_parse_range / ffrwrg(char *rowlist, long maxrows, int maxranges, > + int *numranges, long *rangemin, long *rangemax, int *status) +\end{verbatim} + +\begin{description} +\item[19] Check that the Header fill bytes (if any) are all blank. These are the bytes + that may follow END keyword and before the beginning of data unit, + or the end of the HDU if there is no data unit. + \label{ffchfl} +\end{description} + +\begin{verbatim} + int ffchfl(fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[20] Check that the Data fill bytes (if any) are all zero (for IMAGE or + BINARY Table HDU) or all blanks (for ASCII table HDU). These file + bytes may be located after the last valid data byte in the HDU and + before the physical end of the HDU. + \label{ffcdfl} +\end{description} + +\begin{verbatim} + int ffcdfl(fitsfile *fptr, > int *status) +\end{verbatim} + +\chapter{ The CFITSIO Iterator Function } + +The fits\_iterate\_data function in CFITSIO provides a unique method of +executing an arbitrary user-supplied `work' function that operates on +rows of data in FITS tables or on pixels in FITS images. Rather than +explicitly reading and writing the FITS images or columns of data, one +instead calls the CFITSIO iterator routine, passing to it the name of +the user's work function that is to be executed along with a list of +all the table columns or image arrays that are to be passed to the work +function. The CFITSIO iterator function then does all the work of +allocating memory for the arrays, reading the input data from the FITS +file, passing them to the work function, and then writing any output +data back to the FITS file after the work function exits. Because +it is often more efficient to process only a subset of the total table +rows at one time, the iterator function can determine the optimum +amount of data to pass in each iteration and repeatly call the work +function until the entire table been processed. + +For many applications this single CFITSIO iterator function can +effectively replace all the other CFITSIO routines for reading or +writing data in FITS images or tables. Using the iterator has several +important advantages over the traditional method of reading and writing +FITS data files: + +\begin{itemize} +\item +It cleanly separates the data I/O from the routine that operates on +the data. This leads to a more modular and `object oriented' +programming style. + +\item +It simplifies the application program by eliminating the need to allocate +memory for the data arrays and eliminates most of the calls to the CFITSIO +routines that explicitly read and write the data. + +\item +It ensures that the data are processed as efficiently as possible. +This is especially important when processing tabular data since +the iterator function will calculate the most efficient number +of rows in the table to be passed at one time to the user's work +function on each iteration. + +\item +Makes it possible for larger projects to develop a library of work +functions that all have a uniform calling sequence and are all +independent of the details of the FITS file format. + +\end{itemize} + +There are basically 2 steps in using the CFITSIO iterator function. +The first step is to design the work function itself which must have a +prescribed set of input parameters. One of these parameters is a +structure containing pointers to the arrays of data; the work function +can perform any desired operations on these arrays and does not need to +worry about how the input data were read from the file or how the +output data get written back to the file. + +The second step is to design the driver routine that opens all the +necessary FITS files and initializes the input parameters to the +iterator function. The driver program calls the CFITSIO iterator +function which then reads the data and passes it to the user's work +function. + +The following 2 sections describe these steps in more detail. There +are also several example programs included with the CFITSIO +distribution which illustrate how to use the iterator function. + + +\section{The Iterator Work Function} + +The user-supplied iterator work function must have the following set of +input parameters (the function can be given any desired name): + + +\begin{verbatim} + int user_fn( long totaln, long offset, long firstn, long nvalues, + int narrays, iteratorCol *data, void *userPointer ) +\end{verbatim} + +\begin{itemize} + +\item + totaln -- the total number of table rows or image pixels + that will be passed to the work function + during 1 or more iterations. + +\item + offset -- the offset applied to the first table row or image + pixel to be passed to the work function. In other + words, this is the number of rows or pixels that + are skipped over before starting the iterations. If + offset = 0, then all the table rows or image pixels + will be passed to the work function. + +\item + firstn -- the number of the first table row or image pixel + (starting with 1) that is being passed in this + particular call to the work function. + +\item + nvalues -- the number of table rows or image pixels that are + being passed in this particular call to the work + function. nvalues will always be less than or + equal to totaln and will have the same value on + each iteration, except possibly on the last + call which may have a smaller value. + +\item + narrays -- the number of arrays of data that are being passed + to the work function. There is one array for each + image or table column. + +\item + *data -- array of structures, one for each + column or image. Each structure contains a pointer + to the array of data as well as other descriptive + parameters about that array. + +\item + *userPointer -- a user supplied pointer that can be used + to pass ancillary information from the driver function + to the work function. + This pointer is passed to the CFITSIO iterator function + which then passes it on to the + work function without any modification. + It may point to a single number, to an array of values, + to a structure containing an arbitrary set of parameters + of different types, + or it may be a null pointer if it is not needed. + The work function must cast this pointer to the + appropriate data type before using it it. +\end{itemize} + +The totaln, offset, narrays, data, and userPointer parameters are +guaranteed to have the same value on each iteration. Only firstn, +nvalues, and the arrays of data pointed to by the data structures may +change on each iterative call to the work function. + +Note that the iterator treats an image as a long 1-D array of pixels +regardless of it's intrinsic dimensionality. The total number of +pixels is just the product of the size of each dimension, and the order +of the pixels is the same as the order that they are stored in the FITS +file. If the work function needs to know the number and size of the +image dimensions then these parameters can be passed via the +userPointer structure. + +The iteratorCol structure is currently defined as follows: + +\begin{verbatim} +typedef struct /* structure for the iterator function column information */ +{ + /* structure elements required as input to fits_iterate_data: */ + + fitsfile *fptr; /* pointer to the HDU containing the column or image */ + int colnum; /* column number in the table; ignored for images */ + char colname[70]; /* name (TTYPEn) of the column; null for images */ + int datatype; /* output data type (converted if necessary) */ + int iotype; /* type: InputCol, InputOutputCol, or OutputCol */ + + /* output structure elements that may be useful for the work function: */ + + void *array; /* pointer to the array (and the null value) */ + long repeat; /* binary table vector repeat value; set */ + /* equal to 1 for images */ + long tlmin; /* legal minimum data value, if any */ + long tlmax; /* legal maximum data value, if any */ + char unit[70]; /* physical unit string (BUNIT or TUNITn) */ + char tdisp[70]; /* suggested display format; null if none */ + +} iteratorCol; +\end{verbatim} + +Instead of directly reading or writing the elements in this structure, +it is recommended that programmers use the access functions that are +provided for this purpose. + +The first five elements in this structure must be initially defined by +the driver routine before calling the iterator routine. The CFITSIO +iterator routine uses this information to determine what column or +array to pass to the work function, and whether the array is to be +input to the work function, output from the work function, or both. +The CFITSIO iterator function fills in the values of the remaining +structure elements before passing it to the work function. + +The array structure element is a pointer to the actual data array and +it must be cast to the correct data type before it is used. The +`repeat' structure element give the number of data values in each row +of the table, so that the total number of data values in the array is +given by repeat * nvalues. In the case of image arrays and ASCII +tables, repeat will always be equal to 1. When the data type is a +character string, the array pointer is actually a pointer to an array +of string pointers (i.e., char **array). The other output structure +elements are provided for convenience in case that information is +needed within the work function. Any other information may be passed +from the driver routine to the work function via the userPointer +parameter. + +Upon completion, the work routine must return an integer status value, +with 0 indicating success and any other value indicating an error which +will cause the iterator function to immediately exit at that point. Return status +values in the range 1 -- 1000 should be avoided since these are +reserved for use by CFITSIO. A return status value of -1 may be used to +force the CFITSIO iterator function to stop at that point and return +control to the driver routine after writing any output arrays to the +FITS file. CFITSIO does not considered this to be an error condition, +so any further processing by the application program will continue normally. + + +\section{The Iterator Driver Function} + +The iterator driver function must open the necessary FITS files and +position them to the correct HDU. It must also initialize the following +parameters in the iteratorCol structure (defined above) for each +column or image before calling the CFITSIO iterator function. +Several `constructor' routines are provided in CFITSIO for this +purpose. + +\begin{itemize} +\item + *fptr -- The fitsfile pointer to the table or image. +\item +colnum -- the number of the column in the table. This value is ignored + in the case of images. If colnum equals 0, then the column name + will be used to identify the column to be passed to the + work function. + +\item +colname -- the name (TTYPEn keyword) of the column. This is + only required if colnum = 0 and is ignored for images. +\item +datatype -- The desired data type of the array to be passed to the + work function. For numerical data the data type does + not need to be the same as the actual data type in the + FITS file, in which case CFITSIO will do the conversion. + Allowed values are: TSTRING, TLOGICAL, TBYTE, TSBYTE, TSHORT, TUSHORT, + TINT, TLONG, TULONG, TFLOAT, TDOUBLE. If the input + value of data type equals 0, then the existing + data type of the column or image will be used without + any conversion. + +\item +iotype -- defines whether the data array is to be input to the + work function (i.e, read from the FITS file), or output + from the work function (i.e., written to the FITS file) or + both. Allowed values are InputCol, OutputCol, or InputOutputCol. + Variable-length array columns are supported as InputCol or + InputOutputCol types, but may not be used for an OutputCol type. +\end{itemize} + +After the driver routine has initialized all these parameters, it +can then call the CFITSIO iterator function: + + +\begin{verbatim} + int fits_iterate_data(int narrays, iteratorCol *data, long offset, + long nPerLoop, int (*workFn)( ), void *userPointer, int *status); +\end{verbatim} + +\begin{itemize} +\item + + narrays -- the number of columns or images that are to be passed + to the work function. +\item + *data -- pointer to array of structures containing information + about each column or image. + +\item + offset -- if positive, this number of rows at the + beginning of the table (or pixels in the image) + will be skipped and will not be passed to the work + function. + +\item + nPerLoop - specifies the number of table rows (or number of + image pixels) that are to be passed to the work + function on each iteration. If nPerLoop = 0 + then CFITSIO will calculate the optimum number + for greatest efficiency. + If nPerLoop is negative, then all the rows + or pixels will be passed at one time, and the work + function will only be called once. If any variable + length arrays are being processed, then the nPerLoop + value is ignored, and the iterator will always process + one row of the table at a time. + +\item + *workFn - the name (actually the address) of the work function + that is to be called by fits\_iterate\_data. + +\item + *userPointer - this is a user supplied pointer that can be used + to pass ancillary information from the driver routine + to the work function. It may point to a single number, + an array, or to a structure containing an arbitrary set + of parameters. + +\item + *status - The CFITSIO error status. Should = 0 on input; + a non-zero output value indicates an error. +\end{itemize} + +When fits\_iterate\_data is called it first allocates memory to hold +all the requested columns of data or image pixel arrays. It then reads +the input data from the FITS tables or images into the arrays then +passes the structure with pointers to these data arrays to the work +function. After the work function returns, the iterator function +writes any output columns of data or images back to the FITS files. It +then repeats this process for any remaining sets of rows or image +pixels until it has processed the entire table or image or until the +work function returns a non-zero status value. The iterator then frees +the memory that it initially allocated and returns control to the +driver routine that called it. + + +\section{Guidelines for Using the Iterator Function} + +The totaln, offset, firstn, and nvalues parameters that are passed to +the work function are useful for determining how much of the data has +been processed and how much remains left to do. On the very first call +to the work function firstn will be equal to offset + 1; the work +function may need to perform various initialization tasks before +starting to process the data. Similarly, firstn + nvalues - 1 will be +equal to totaln on the last iteration, at which point the work function +may need to perform some clean up operations before exiting for the +last time. The work function can also force an early termination of +the iterations by returning a status value = -1. + +The narrays and iteratorCol.datatype arguments allow the work function +to double check that the number of input arrays and their data types +have the expected values. The iteratorCol.fptr and iteratorCol.colnum +structure elements can be used if the work function needs to read or +write the values of other keywords in the FITS file associated with +the array. This should generally only be done during the +initialization step or during the clean up step after the last set of +data has been processed. Extra FITS file I/O during the main +processing loop of the work function can seriously degrade the speed of +the program. + +If variable-length array columns are being processed, then the iterator +will operate on one row of the table at a time. In this case the +the repeat element in the interatorCol structure will be set equal to +the number of elements in the current row that is being processed. + +One important feature of the iterator is that the first element in each +array that is passed to the work function gives the value that is used +to represent null or undefined values in the array. The real data then +begins with the second element of the array (i.e., array[1], not +array[0]). If the first array element is equal to zero, then this +indicates that all the array elements have defined values and there are +no undefined values. If array[0] is not equal to zero, then this +indicates that some of the data values are undefined and this value +(array[0]) is used to represent them. In the case of output arrays +(i.e., those arrays that will be written back to the FITS file by the +iterator function after the work function exits) the work function must +set the first array element to the desired null value if necessary, +otherwise the first element should be set to zero to indicate that +there are no null values in the output array. CFITSIO defines 2 +values, FLOATNULLVALUE and DOUBLENULLVALUE, that can be used as default +null values for float and double data types, respectively. In the case +of character string data types, a null string is always used to +represent undefined strings. + +In some applications it may be necessary to recursively call the iterator +function. An example of this is given by one of the example programs +that is distributed with CFITSIO: it first calls a work function that +writes out a 2D histogram image. That work function in turn calls +another work function that reads the `X' and `Y' columns in a table to +calculate the value of each 2D histogram image pixel. Graphically, the +program structure can be described as: + +\begin{verbatim} + driver --> iterator --> work1_fn --> iterator --> work2_fn +\end{verbatim} + +Finally, it should be noted that the table columns or image arrays that +are passed to the work function do not all have to come from the same +FITS file and instead may come from any combination of sources as long +as they have the same length. The length of the first table column or +image array is used by the iterator if they do not all have the same +length. + + +\section{Complete List of Iterator Routines} + +All of the iterator routines are listed below. Most of these routines +do not have a corresponding short function name. + + +\begin{description} +\item[1 ] Iterator `constructor' functions that set + the value of elements in the iteratorCol structure + that define the columns or arrays. These set the fitsfile + pointer, column name, column number, datatype, and iotype, + respectively. The last 2 routines allow all the parameters + to be set with one function call (one supplies the column + name, the other the column number). \label{ffiterset} +\end{description} + + +\begin{verbatim} + int fits_iter_set_file(iteratorCol *col, fitsfile *fptr); + + int fits_iter_set_colname(iteratorCol *col, char *colname); + + int fits_iter_set_colnum(iteratorCol *col, int colnum); + + int fits_iter_set_datatype(iteratorCol *col, int datatype); + + int fits_iter_set_iotype(iteratorCol *col, int iotype); + + int fits_iter_set_by_name(iteratorCol *col, fitsfile *fptr, + char *colname, int datatype, int iotype); + + int fits_iter_set_by_num(iteratorCol *col, fitsfile *fptr, + int colnum, int datatype, int iotype); +\end{verbatim} + +\begin{description} +\item[2 ] Iterator `accessor' functions that return the value of the + element in the iteratorCol structure + that describes a particular data column or array \label{ffiterget} +\end{description} + +\begin{verbatim} + fitsfile * fits_iter_get_file(iteratorCol *col); + + char * fits_iter_get_colname(iteratorCol *col); + + int fits_iter_get_colnum(iteratorCol *col); + + int fits_iter_get_datatype(iteratorCol *col); + + int fits_iter_get_iotype(iteratorCol *col); + + void * fits_iter_get_array(iteratorCol *col); + + long fits_iter_get_tlmin(iteratorCol *col); + + long fits_iter_get_tlmax(iteratorCol *col); + + long fits_iter_get_repeat(iteratorCol *col); + + char * fits_iter_get_tunit(iteratorCol *col); + + char * fits_iter_get_tdisp(iteratorCol *col); +\end{verbatim} + +\begin{description} +\item[3 ] The CFITSIO iterator function \label{ffiter} +\end{description} + +\begin{verbatim} + int fits_iterate_data(int narrays, iteratorCol *data, long offset, + long nPerLoop, + int (*workFn)( long totaln, long offset, long firstn, + long nvalues, int narrays, iteratorCol *data, + void *userPointer), + void *userPointer, + int *status); +\end{verbatim} + +\chapter{ Celestial Coordinate System Routines } + +The FITS community has adopted a set of keyword conventions that define +the transformations needed to convert between pixel locations in an +image and the corresponding celestial coordinates on the sky, or more +generally, that define world coordinates that are to be associated with +any pixel location in an n-dimensional FITS array. CFITSIO is distributed +with a couple of self-contained World Coordinate System (WCS) routines, +however, these routines DO NOT support all the latest WCS conventions, +so it is STRONGLY RECOMMENDED that software developers use a more robust +external WCS library. Several recommended libraries are: + + +\begin{verbatim} + WCSLIB - supported by Mark Calabretta + WCSTools - supported by Doug Mink + AST library - developed by the U.K. Starlink project +\end{verbatim} + +More information about the WCS keyword conventions and links to all of +these WCS libraries can be found on the FITS Support Office web site at +http://fits.gsfc.nasa.gov under the WCS link. + +The functions provided in these external WCS libraries will need +access to the WCS information contained in the FITS file headers. +One convenient way to pass this information to the extermal library is +to use the fits\_hdr2str routine in CFITSIO (defined below) to copy the +header keywords into one long string, and then pass this string to an +interface routine in the external library that will extract +the necessary WCS information (e.g., see the astFitsChan and astPutCards +routines in the Starlink AST library). + + +\begin{description} +\item[1 ] Concatenate the header keywords in the CHDU into a single long + string of characters. Each 80-character fixed-length keyword + record is appended to the output character string, in order, with + no intervening separator or terminating characters. The last header + record is terminated with a NULL character. This routine allocates + memory for the returned character array, so the calling program must + free the memory when finished. + + Selected keywords may be excluded from the returned character string. + If the second parameter (nocomments) is TRUE (nonzero) then any + COMMENT, HISTORY, or blank keywords in the header will not be copied + to the output string. + + The 'exclist' parameter may be used to supply a list of keywords + that are to be excluded from the output character string. Wild card + characters (*, ?, and \#) may be used in the excluded keyword names. + If no additional keywords are to be excluded, then set nexc = 0 and + specify NULL for the the **header parameter. \label{hdr2str} +\end{description} + +\begin{verbatim} + int fits_hdr2str + (fitsfile *fptr, int nocomments, char **exclist, int nexc, + > char **header, int *nkeys, int *status) +\end{verbatim} + + +\section{ Self-contained WCS Routines} + +The following routines DO NOT support the more recent WCS conventions +that have been approved as part of the FITS standard. Consequently, +the following routines ARE NOW DEPRECATED. It is STRONGLY RECOMMENDED +that software developers not use these routines, and instead use an +external WCS library, as described in the previous section. + +These routines are included mainly for backward compatibility with +existing software. They support the following standard map +projections: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, and -AIT (these are the +legal values for the coordtype parameter). These routines are based +on similar functions in Classic AIPS. All the angular quantities are +given in units of degrees. + + +\begin{description} +\item[1 ] Get the values of the basic set of standard FITS celestial coordinate + system keywords from the header of a FITS image (i.e., the primary + array or an IMAGE extension). These values may then be passed to + the fits\_pix\_to\_world and fits\_world\_to\_pix routines that + perform the coordinate transformations. If any or all of the WCS + keywords are not present, then default values will be returned. If + the first coordinate axis is the declination-like coordinate, then + this routine will swap them so that the longitudinal-like coordinate + is returned as the first axis. + + If the file uses the newer 'CDj\_i' WCS transformation matrix + keywords instead of old style 'CDELTn' and 'CROTA2' keywords, then + this routine will calculate and return the values of the equivalent + old-style keywords. Note that the conversion from the new-style + keywords to the old-style values is sometimes only an + approximation, so if the approximation is larger than an internally + defined threshold level, then CFITSIO will still return the + approximate WCS keyword values, but will also return with status = + APPROX\_WCS\_KEY, to warn the calling program that approximations + have been made. It is then up to the calling program to decide + whether the approximations are sufficiently accurate for the + particular application, or whether more precise WCS transformations + must be performed using new-style WCS keywords directly. \label{ffgics} +\end{description} + +\begin{verbatim} + int fits_read_img_coord / ffgics + (fitsfile *fptr, > double *xrefval, double *yrefval, + double *xrefpix, double *yrefpix, double *xinc, double *yinc, + double *rot, char *coordtype, int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Get the values of the standard FITS celestial coordinate system + keywords from the header of a FITS table where the X and Y (or RA + and DEC) coordinates are stored in 2 separate columns of the table + (as in the Event List table format that is often used by high energy + astrophysics missions). These values may then be passed to the + fits\_pix\_to\_world and fits\_world\_to\_pix routines that perform + the coordinate transformations. \label{ffgtcs} +\end{description} + +\begin{verbatim} + int fits_read_tbl_coord / ffgtcs + (fitsfile *fptr, int xcol, int ycol, > double *xrefval, + double *yrefval, double *xrefpix, double *yrefpix, double *xinc, + double *yinc, double *rot, char *coordtype, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Calculate the celestial coordinate corresponding to the input + X and Y pixel location in the image. \label{ffwldp} +\end{description} + +\begin{verbatim} + int fits_pix_to_world / ffwldp + (double xpix, double ypix, double xrefval, double yrefval, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *coordtype, > double *xpos, double *ypos, + int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Calculate the X and Y pixel location corresponding to the input + celestial coordinate in the image. \label{ffxypx} +\end{description} + +\begin{verbatim} + int fits_world_to_pix / ffxypx + (double xpos, double ypos, double xrefval, double yrefval, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *coordtype, > double *xpix, double *ypix, + int *status) +\end{verbatim} + + +\chapter{ Hierarchical Grouping Routines } + +These functions allow for the creation and manipulation of FITS HDU +Groups, as defined in "A Hierarchical Grouping Convention for FITS" by +Jennings, Pence, Folk and Schlesinger ( http: +//adfwww.gsfc.nasa.gov/other/convert/group.html ). A group is a +collection of HDUs whose association is defined by a {\it grouping +table}. HDUs which are part of a group are referred to as {\it member +HDUs} or simply as {\it members}. Grouping table member HDUs may +themselves be grouping tables, thus allowing for the construction of +open-ended hierarchies of HDUs. + +Grouping tables contain one row for each member HDU. The grouping table +columns provide identification information that allows applications to +reference or "point to" the member HDUs. Member HDUs are expected, but +not required, to contain a set of GRPIDn/GRPLCn keywords in their +headers for each grouping table that they are referenced by. In this +sense, the GRPIDn/GRPLCn keywords "link" the member HDU back to its +Grouping table. Note that a member HDU need not reside in the same FITS +file as its grouping table, and that a given HDU may be referenced by +up to 999 grouping tables simultaneously. + +Grouping tables are implemented as FITS binary tables with up to six +pre-defined column TTYPEn values: 'MEMBER\_XTENSION', 'MEMBER\_NAME', +'MEMBER\_VERSION', 'MEMBER\_POSITION', 'MEMBER\_URI\_TYPE' and 'MEMBER\_LOCATION'. +The first three columns allow member HDUs to be identified by reference to +their XTENSION, EXTNAME and EXTVER keyword values. The fourth column allows +member HDUs to be identified by HDU position within their FITS file. +The last two columns identify the FITS file in which the member HDU resides, +if different from the grouping table FITS file. + +Additional user defined "auxiliary" columns may also be included with any +grouping table. When a grouping table is copied or modified the presence of +auxiliary columns is always taken into account by the grouping support +functions; however, the grouping support functions cannot directly +make use of this data. + +If a grouping table column is defined but the corresponding member HDU +information is unavailable then a null value of the appropriate data type +is inserted in the column field. Integer columns (MEMBER\_POSITION, +MEMBER\_VERSION) are defined with a TNULLn value of zero (0). Character field +columns (MEMBER\_XTENSION, MEMBER\_NAME, MEMBER\_URI\_TYPE, MEMBER\_LOCATION) +utilize an ASCII null character to denote a null field value. + +The grouping support functions belong to two basic categories: those that +work with grouping table HDUs (ffgt**) and those that work with member HDUs +(ffgm**). Two functions, fits\_copy\_group() and fits\_remove\_group(), have the +option to recursively copy/delete entire groups. Care should be taken when +employing these functions in recursive mode as poorly defined groups could +cause unpredictable results. The problem of a grouping table directly or +indirectly referencing itself (thus creating an infinite loop) is protected +against; in fact, neither function will attempt to copy or delete an HDU +twice. + + +\section{Grouping Table Routines} + + +\begin{description} +\item[1 ]Create (append) a grouping table at the end of the current FITS file + pointed to by fptr. The grpname parameter provides the grouping table + name (GRPNAME keyword value) and may be set to NULL if no group name + is to be specified. The grouptype parameter specifies the desired + structure of the grouping table and may take on the values: + GT\_ID\_ALL\_URI (all columns created), GT\_ID\_REF (ID by reference columns), + GT\_ID\_POS (ID by position columns), GT\_ID\_ALL (ID by reference and + position columns), GT\_ID\_REF\_URI (ID by reference and FITS file URI + columns), and GT\_ID\_POS\_URI (ID by position and FITS file URI columns). \label{ffgtcr} +\end{description} + +\begin{verbatim} + int fits_create_group / ffgtcr + (fitsfile *fptr, char *grpname, int grouptype, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ]Create (insert) a grouping table just after the CHDU of the current FITS + file pointed to by fptr. All HDUs below the the insertion point will be + shifted downwards to make room for the new HDU. The grpname parameter + provides the grouping table name (GRPNAME keyword value) and may be set to + NULL if no group name is to be specified. The grouptype parameter specifies + the desired structure of the grouping table and may take on the values: + GT\_ID\_ALL\_URI (all columns created), GT\_ID\_REF (ID by reference columns), + GT\_ID\_POS (ID by position columns), GT\_ID\_ALL (ID by reference and + position columns), GT\_ID\_REF\_URI (ID by reference and FITS file URI + columns), and GT\_ID\_POS\_URI (ID by position and FITS file URI columns) \label{ffgtis}. +\end{description} + +\begin{verbatim} + int fits_insert_group / ffgtis + (fitsfile *fptr, char *grpname, int grouptype, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ]Change the structure of an existing grouping table pointed to by + gfptr. The grouptype parameter (see fits\_create\_group() for valid + parameter values) specifies the new structure of the grouping table. This + function only adds or removes grouping table columns, it does not add + or delete group members (i.e., table rows). If the grouping table already + has the desired structure then no operations are performed and function + simply returns with a (0) success status code. If the requested structure + change creates new grouping table columns, then the column values for all + existing members will be filled with the null values appropriate to the + column type. \label{ffgtch} +\end{description} + +\begin{verbatim} + int fits_change_group / ffgtch + (fitsfile *gfptr, int grouptype, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ]Remove the group defined by the grouping table pointed to by gfptr, and + optionally all the group member HDUs. The rmopt parameter specifies the + action to be taken for + all members of the group defined by the grouping table. Valid values are: + OPT\_RM\_GPT (delete only the grouping table) and OPT\_RM\_ALL (recursively + delete all HDUs that belong to the group). Any groups containing the + grouping table gfptr as a member are updated, and if rmopt == OPT\_RM\_GPT + all members have their GRPIDn and GRPLCn keywords updated accordingly. + If rmopt == OPT\_RM\_ALL, then other groups that contain the deleted members + of gfptr are updated to reflect the deletion accordingly. \label{ffgtrm} +\end{description} + +\begin{verbatim} + int fits_remove_group / ffgtrm + (fitsfile *gfptr, int rmopt, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ]Copy (append) the group defined by the grouping table pointed to by infptr, + and optionally all group member HDUs, to the FITS file pointed to by + outfptr. The cpopt parameter specifies the action to be taken for all + members of the group infptr. Valid values are: OPT\_GCP\_GPT (copy only + the grouping table) and OPT\_GCP\_ALL (recursively copy ALL the HDUs that + belong to the group defined by infptr). If the cpopt == OPT\_GCP\_GPT then + the members of infptr have their GRPIDn and GRPLCn keywords updated to + reflect the existence of the new grouping table outfptr, since they now + belong to the new group. If cpopt == OPT\_GCP\_ALL then the new + grouping table outfptr only contains pointers to the copied member HDUs + and not the original member HDUs of infptr. Note that, when + cpopt == OPT\_GCP\_ALL, all members of the group defined by infptr will be + copied to a single FITS file pointed to by outfptr regardless of their + file distribution in the original group. \label{ffgtcp} +\end{description} + +\begin{verbatim} + int fits_copy_group / ffgtcp + (fitsfile *infptr, fitsfile *outfptr, int cpopt, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Merge the two groups defined by the grouping table HDUs infptr and outfptr + by combining their members into a single grouping table. All member HDUs + (rows) are copied from infptr to outfptr. If mgopt == OPT\_MRG\_COPY then + infptr continues to exist unaltered after the merge. If the mgopt == + OPT\_MRG\_MOV then infptr is deleted after the merge. In both cases, + the GRPIDn and GRPLCn keywords of the member HDUs are updated accordingly. \label{ffgtmg} +\end{description} + +\begin{verbatim} + int fits_merge_groups / ffgtmg + (fitsfile *infptr, fitsfile *outfptr, int mgopt, > int *status) +\end{verbatim} + +\begin{description} +\item[7 ]"Compact" the group defined by grouping table pointed to by gfptr. The + compaction is achieved by merging (via fits\_merge\_groups()) all direct + member HDUs of gfptr that are themselves grouping tables. The cmopt + parameter defines whether the merged grouping table HDUs remain after + merging (cmopt == OPT\_CMT\_MBR) or if they are deleted after merging + (cmopt == OPT\_CMT\_MBR\_DEL). If the grouping table contains no direct + member HDUs that are themselves grouping tables then this function + does nothing. Note that this function is not recursive, i.e., only the + direct member HDUs of gfptr are considered for merging. \label{ffgtcm} +\end{description} + +\begin{verbatim} + int fits_compact_group / ffgtcm + (fitsfile *gfptr, int cmopt, > int *status) +\end{verbatim} + +\begin{description} +\item[8 ]Verify the integrity of the grouping table pointed to by gfptr to make + sure that all group members are accessible and that all links to other + grouping tables are valid. The firstfailed parameter returns the member + ID (row number) of the first member HDU to fail verification (if positive + value) or the first group link to fail (if negative value). If gfptr is + successfully verified then firstfailed contains a return value of 0. \label{ffgtvf} +\end{description} + +\begin{verbatim} + int fits_verify_group / ffgtvf + (fitsfile *gfptr, > long *firstfailed, int *status) +\end{verbatim} + +\begin{description} +\item[9 ] Open a grouping table that contains the member HDU pointed to by mfptr. + The grouping table to open is defined by the grpid parameter, which + contains the keyword index value of the GRPIDn/GRPLCn keyword(s) that + link the member HDU mfptr to the grouping table. If the grouping table + resides in a file other than the member HDUs file then an attempt is + first made to open the file readwrite, and failing that readonly. A + pointer to the opened grouping table HDU is returned in gfptr. + + Note that it is possible, although unlikely and undesirable, for the + GRPIDn/GRPLCn keywords in a member HDU header to be non-continuous, e.g., + GRPID1, GRPID2, GRPID5, GRPID6. In such cases, the grpid index value + specified in the function call shall identify the (grpid)th GRPID value. + In the above example, if grpid == 3, then the group specified by GRPID5 + would be opened. \label{ffgtop} +\end{description} + +\begin{verbatim} + int fits_open_group / ffgtop + (fitsfile *mfptr, int group, > fitsfile **gfptr, int *status) +\end{verbatim} + +\begin{description} +\item[10] Add a member HDU to an existing grouping table pointed to by gfptr. + The member HDU may either be pointed to mfptr (which must be positioned + to the member HDU) or, if mfptr == NULL, identified by the hdupos parameter + (the HDU position number, Primary array == 1) if both the grouping table + and the member HDU reside in the same FITS file. The new member HDU shall + have the appropriate GRPIDn and GRPLCn keywords created in its header. + Note that if the member HDU is already a member of the group then it will + not be added a second time. \label{ffgtam} +\end{description} + +\begin{verbatim} + int fits_add_group_member / ffgtam + (fitsfile *gfptr, fitsfile *mfptr, int hdupos, > int *status) +\end{verbatim} + + +\section{Group Member Routines} + + +\begin{description} +\item[1 ] Return the number of member HDUs in a grouping table gfptr. The number + member HDUs is just the NAXIS2 value (number of rows) of the grouping + table. \label{ffgtnm} +\end{description} + +\begin{verbatim} + int fits_get_num_members / ffgtnm + (fitsfile *gfptr, > long *nmembers, int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Return the number of groups to which the HDU pointed to by mfptr is + linked, as defined by the number of GRPIDn/GRPLCn keyword records that + appear in its header. Note that each time this function is called, the + indices of the GRPIDn/GRPLCn keywords are checked to make sure they + are continuous (ie no gaps) and are re-enumerated to eliminate gaps if + found. \label{ffgmng} +\end{description} + +\begin{verbatim} + int fits_get_num_groups / ffgmng + (fitsfile *mfptr, > long *nmembers, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Open a member of the grouping table pointed to by gfptr. The member to + open is identified by its row number within the grouping table as given + by the parameter 'member' (first member == 1) . A fitsfile pointer to + the opened member HDU is returned as mfptr. Note that if the member HDU + resides in a FITS file different from the grouping table HDU then the + member file is first opened readwrite and, failing this, opened readonly. \label{ffgmop} +\end{description} + +\begin{verbatim} + int fits_open_member / ffgmop + (fitsfile *gfptr, long member, > fitsfile **mfptr, int *status) +\end{verbatim} + +\begin{description} +\item[4 ]Copy (append) a member HDU of the grouping table pointed to by gfptr. + The member HDU is identified by its row number within the grouping table + as given by the parameter 'member' (first member == 1). The copy of the + group member HDU will be appended to the FITS file pointed to by mfptr, + and upon return mfptr shall point to the copied member HDU. The cpopt + parameter may take on the following values: OPT\_MCP\_ADD which adds a new + entry in gfptr for the copied member HDU, OPT\_MCP\_NADD which does not add + an entry in gfptr for the copied member, and OPT\_MCP\_REPL which replaces + the original member entry with the copied member entry. \label{ffgmcp} +\end{description} + +\begin{verbatim} + int fits_copy_member / ffgmcp + (fitsfile *gfptr, fitsfile *mfptr, long member, int cpopt, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ]Transfer a group member HDU from the grouping table pointed to by + infptr to the grouping table pointed to by outfptr. The member HDU to + transfer is identified by its row number within infptr as specified by + the parameter 'member' (first member == 1). If tfopt == OPT\_MCP\_ADD then + the member HDU is made + a member of outfptr and remains a member of infptr. If tfopt == OPT\_MCP\_MOV + then the member HDU is deleted from infptr after the transfer to outfptr. \label{ffgmtf} +\end{description} + +\begin{verbatim} + int fits_transfer_member / ffgmtf + (fitsfile *infptr, fitsfile *outfptr, long member, int tfopt, + > int *status) +\end{verbatim} + +\begin{description} +\item[6 ]Remove a member HDU from the grouping table pointed to by gfptr. The + member HDU to be deleted is identified by its row number in the grouping + table as specified by the parameter 'member' (first member == 1). The rmopt + parameter may take on the following values: OPT\_RM\_ENTRY which + removes the member HDU entry from the grouping table and updates the + member's GRPIDn/GRPLCn keywords, and OPT\_RM\_MBR which removes the member + HDU entry from the grouping table and deletes the member HDU itself. \label{ffgmrm} +\end{description} + +\begin{verbatim} + int fits_remove_member / ffgmrm + (fitsfile *fptr, long member, int rmopt, > int *status) +\end{verbatim} + +\chapter{ Specialized CFITSIO Interface Routines } + +The basic interface routines described previously are recommended +for most uses, but the routines described in this chapter +are also available if necessary. Some of these routines perform more +specialized function that cannot easily be done with the basic +interface routines while others duplicate the functionality of the +basic routines but have a slightly different calling sequence. +See Appendix B for the definition of each function parameter. + + +\section{FITS File Access Routines} + + +\begin{description} +\item[1 ] Open an existing FITS file residing in core computer memory. This +routine is analogous to fits\_open\_file. The 'filename' is +currently ignored by this routine and may be any arbitrary string. In +general, the application must have preallocated an initial block of +memory to hold the FITS file prior to calling this routine: 'memptr' +points to the starting address and 'memsize' gives the initial size of +the block of memory. 'mem\_realloc' is a pointer to an optional +function that CFITSIO can call to allocate additional memory, if needed +(only if mode = READWRITE), and is modeled after the standard C +'realloc' function; a null pointer may be given if the initial +allocation of memory is all that will be required (e.g., if the file is +opened with mode = READONLY). The 'deltasize' parameter may be used to +suggest a minimum amount of additional memory that should be allocated +during each call to the memory reallocation function. By default, +CFITSIO will reallocate enough additional space to hold the entire +currently defined FITS file (as given by the NAXISn keywords) or 1 FITS +block (= 2880 bytes), which ever is larger. Values of deltasize less +than 2880 will be ignored. Since the memory reallocation operation can +be computationally expensive, allocating a larger initial block of +memory, and/or specifying a larger deltasize value may help to reduce +the number of reallocation calls and make the application program run + faster. \label{ffomem} +\end{description} + +\begin{verbatim} + int fits_open_memfile / ffomem + (fitsfile **fptr, const char *filename, int mode, void **memptr, + size_t *memsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Create a new FITS file residing in core computer memory. This +routine is analogous to fits\_create\_file. In general, the +application must have preallocated an initial block of memory to hold +the FITS file prior to calling this routine: 'memptr' points to the +starting address and 'memsize' gives the initial size of the block of +memory. 'mem\_realloc' is a pointer to an optional function that +CFITSIO can call to allocate additional memory, if needed, and is +modeled after the standard C 'realloc' function; a null pointer may be +given if the initial allocation of memory is all that will be +required. The 'deltasize' parameter may be used to suggest a minimum +amount of additional memory that should be allocated during each call +to the memory reallocation function. By default, CFITSIO will +reallocate enough additional space to hold 1 FITS block (= 2880 bytes) +and values of deltasize less than 2880 will be ignored. Since the +memory reallocation operation can be computationally expensive, +allocating a larger initial block of memory, and/or specifying a larger +deltasize value may help to reduce the number of reallocation calls +and make the application program run + faster. \label{ffimem} +\end{description} + +\begin{verbatim} + int fits_create_memfile / ffimem + (fitsfile **fptr, void **memptr, + size_t *memsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Reopen a FITS file that was previously opened with + fits\_open\_file or fits\_create\_file. The new fitsfile + pointer may then be treated as a separate file, and one may + simultaneously read or write to 2 (or more) different extensions in + the same file. The fits\_open\_file routine (above) automatically + detects cases where a previously opened file is being opened again, + and then internally call fits\_reopen\_file, so programs should rarely + need to explicitly call this routine. +\label{ffreopen} +\end{description} + +\begin{verbatim} + int fits_reopen_file / ffreopen + (fitsfile *openfptr, fitsfile **newfptr, > int *status) +\end{verbatim} + + +\begin{description} +\item[4 ] Create a new FITS file, using a template file to define its + initial size and structure. The template may be another FITS HDU + or an ASCII template file. If the input template file name pointer + is null, then this routine behaves the same as fits\_create\_file. + The currently supported format of the ASCII template file is described + under the fits\_parse\_template routine (in the general Utilities + section) +\label{fftplt} +\end{description} + +\begin{verbatim} + int fits_create_template / fftplt + (fitsfile **fptr, char *filename, char *tpltfile > int *status) +\end{verbatim} + + +\begin{description} +\item[5 ] Parse the input filename or URL into its component parts: the file +type (file://, ftp://, http://, etc), the base input file name, the +name of the output file that the input file is to be copied to prior +to opening, the HDU or extension specification, the filtering +specifier, the binning specifier, and the column specifier. Null +strings will be returned for any components that are not present + in the input file name. \label{ffiurl} +\end{description} + +\begin{verbatim} + int fits_parse_input_url / ffiurl + (char *filename, > char *filetype, char *infile, char *outfile, char + *extspec, char *filter, char *binspec, char *colspec, int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Parse the input filename and return the HDU number that would be +moved to if the file were opened with fits\_open\_file. The returned +HDU number begins with 1 for the primary array, so for example, if the +input filename = `myfile.fits[2]' then hdunum = 3 will be returned. +CFITSIO does not open the file to check if the extension actually +exists if an extension number is specified. If an extension name is +included in the file name specification (e.g. `myfile.fits[EVENTS]' +then this routine will have to open the FITS file and look for the +position of the named extension, then close file again. This is not +possible if the file is being read from the stdin stream, and an error +will be returned in this case. If the filename does not specify an +explicit extension (e.g. 'myfile.fits') then hdunum = -99 will be +returned, which is functionally equivalent to hdunum = 1. This routine +is mainly used for backward compatibility in the ftools software +package and is not recommended for general use. It is generally better +and more efficient to first open the FITS file with fits\_open\_file, +then use fits\_get\_hdu\_num to determine which HDU in the file has +been opened, rather than calling fits\_parse\_input\_url followed by a +call to fits\_open\_file. + \label{ffextn} +\end{description} + +\begin{verbatim} + int fits_parse_extnum / ffextn + (char *filename, > int *hdunum, int *status) +\end{verbatim} + +\begin{description} +\item[7 ]Parse the input file name and return the root file name. The root +name includes the file type if specified, (e.g. 'ftp://' or 'http://') +and the full path name, to the extent that it is specified in the input +filename. It does not include the HDU name or number, or any filtering +specifications. + \label{ffrtnm} +\end{description} + +\begin{verbatim} + int fits_parse_rootname / ffrtnm + (char *filename, > char *rootname, int *status); +\end{verbatim} + +\begin{description} +\item[8 ]Test if the input file or a compressed version of the file (with +a .gz, .Z, .z, or .zip extension) exists on disk. The returned value of +the 'exists' parameter will have 1 of the 4 following values: + +\begin{verbatim} + 2: the file does not exist, but a compressed version does exist + 1: the disk file does exist + 0: neither the file nor a compressed version of the file exist + -1: the input file name is not a disk file (could be a ftp, http, + smem, or mem file, or a file piped in on the STDIN stream) +\end{verbatim} + + \label{ffexist} +\end{description} + +\begin{verbatim} + int fits_file_exists / ffexist + (char *filename, > int *exists, int *status); +\end{verbatim} + +\begin{description} +\item[9 ]Flush any internal buffers of data to the output FITS file. These + routines rarely need to be called, but can be useful in cases where + other processes need to access the same FITS file in real time, + either on disk or in memory. These routines also help to ensure + that if the application program subsequently aborts then the FITS + file will have been closed properly. The first routine, + fits\_flush\_file is more rigorous and completely closes, then + reopens, the current HDU, before flushing the internal buffers, thus + ensuring that the output FITS file is identical to what would be + produced if the FITS was closed at that point (i.e., with a call to + fits\_close\_file). The second routine, fits\_flush\_buffer simply + flushes the internal CFITSIO buffers of data to the output FITS + file, without updating and closing the current HDU. This is much + faster, but there may be circumstances where the flushed file does + not completely reflect the final state of the file as it will exist + when the file is actually closed. + + A typical use of these routines would be to flush the state of a + FITS table to disk after each row of the table is written. It is + recommend that fits\_flush\_file be called after the first row is + written, then fits\_flush\_buffer may be called after each + subsequent row is written. Note that this latter routine will not + automatically update the NAXIS2 keyword which records the number of + rows of data in the table, so this keyword must be explicitly + updated by the application program after each row is written. + \label{ffflus} +\end{description} + +\begin{verbatim} + int fits_flush_file / ffflus + (fitsfile *fptr, > int *status) + + int fits_flush_buffer / ffflsh + (fitsfile *fptr, 0, > int *status) + + (Note: The second argument must be 0). +\end{verbatim} + + +\section{HDU Access Routines} + + +\begin{description} +\item[1 ] Get the byte offsets in the FITS file to the start of the header + and the start and end of the data in the CHDU. The difference + between headstart and dataend equals the size of the CHDU. If the + CHDU is the last HDU in the file, then dataend is also equal to the + size of the entire FITS file. Null pointers may be input for any + of the address parameters if their values are not needed. The + fits\_get\_hduaddr routine is obsolete and should no longer be + used. The newer fits\_get\_hduoff routine uses the 'off\_t' + data type which can support offsets in large files greater than + 2.1GB in size. \label{ffghad} +\end{description} + +\begin{verbatim} + int fits_get_hduoff / ffghof + (fitsfile *fptr, > off_t *headstart, off_t *datastart, off_t *dataend, + int *status) + + int fits_get_hduaddr / ffghad (OBSOLETE routine) + (fitsfile *fptr, > long *headstart, long *datastart, long *dataend, + int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Create (append) a new empty HDU at the end of the FITS file. + This is now the CHDU but it is completely empty and has + no header keywords. It is recommended that fits\_create\_img or + fits\_create\_tbl be used instead of this routine. \label{ffcrhd} +\end{description} + +\begin{verbatim} + int fits_create_hdu / ffcrhd + (fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Insert a new IMAGE extension immediately following the CHDU, or + insert a new Primary Array at the beginning of the file. Any + following extensions in the file will be shifted down to make room + for the new extension. If the CHDU is the last HDU in the file + then the new image extension will simply be appended to the end of + the file. One can force a new primary array to be inserted at the + beginning of the FITS file by setting status = PREPEND\_PRIMARY prior + to calling the routine. In this case the old primary array will be + converted to an IMAGE extension. The new extension (or primary + array) will become the CHDU. Refer to Chapter 9 for a list of + pre-defined bitpix values. \label{ffiimg} +\end{description} + +\begin{verbatim} + int fits_insert_img / ffiimg + (fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Insert a new ASCII or binary table extension immediately following the CHDU. + Any following extensions will be shifted down to make room for the + new extension. If there are no other following extensions then the + new table extension will simply be appended to the end of the + file. If the FITS file is currently empty then this routine will + create a dummy primary array before appending the table to it. The + new extension will become the CHDU. The tunit and extname + parameters are optional and a null pointer may be given if they are + not defined. When inserting an ASCII table with + fits\_insert\_atbl, a null pointer may given for the *tbcol + parameter in which case each column of the table will be separated + by a single space character. Similarly, if the input value of + rowlen is 0, then CFITSIO will calculate the default rowlength + based on the tbcol and ttype values. When inserting a binary table + with fits\_insert\_btbl, if there are following extensions in the + file and if the table contains variable length array columns then + pcount must specify the expected final size of the data heap, + otherwise pcount must = 0. \label{ffitab} \label{ffibin} +\end{description} + +\begin{verbatim} + int fits_insert_atbl / ffitab + (fitsfile *fptr, long rowlen, long nrows, int tfields, char *ttype[], + long *tbcol, char *tform[], char *tunit[], char *extname, > int *status) + + int fits_insert_btbl / ffibin + (fitsfile *fptr, long nrows, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Modify the size, dimensions, and/or data type of the current + primary array or image extension. If the new image, as specified + by the input arguments, is larger than the current existing image + in the FITS file then zero fill data will be inserted at the end + of the current image and any following extensions will be moved + further back in the file. Similarly, if the new image is + smaller than the current image then any following extensions + will be shifted up towards the beginning of the FITS file + and the image data will be truncated to the new size. + This routine rewrites the BITPIX, NAXIS, and NAXISn keywords + with the appropriate values for the new image. \label{ffrsim} +\end{description} + +\begin{verbatim} + int fits_resize_img / ffrsim + (fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Copy the data (and not the header) from the CHDU associated with infptr + to the CHDU associated with outfptr. This will overwrite any data + previously in the output CHDU. This low level routine is used by + fits\_copy\_hdu, but it may also be useful in certain application programs + that want to copy the data from one FITS file to another but also + want to modify the header keywords. The required FITS header keywords + which define the structure of the HDU must be written to the + output CHDU before calling this routine. \label{ffcpdt} +\end{description} + +\begin{verbatim} + int fits_copy_data / ffcpdt + (fitsfile *infptr, fitsfile *outfptr, > int *status) +\end{verbatim} + +\begin{description} +\item[7 ] This routine forces CFITSIO to rescan the current header keywords that + define the structure of the HDU (such as the NAXIS and BITPIX + keywords) so that it reinitializes the internal buffers that + describe the HDU structure. This routine is useful for + reinitializing the structure of an HDU if any of the required + keywords (e.g., NAXISn) have been modified. In practice it should + rarely be necessary to call this routine because CFITSIO + internally calls it in most situations. \label{ffrdef} +\end{description} + +\begin{verbatim} + int fits_set_hdustruc / ffrdef + (fitsfile *fptr, > int *status) (DEPRECATED) +\end{verbatim} + +\section{Specialized Header Keyword Routines} + + +\subsection{Header Information Routines} + + +\begin{description} +\item[1 ] Reserve space in the CHU for MOREKEYS more header keywords. + This routine may be called to allocate space for additional keywords + at the time the header is created (prior to writing any data). + CFITSIO can dynamically add more space to the header when needed, + however it is more efficient to preallocate the required space + if the size is known in advance. \label{ffhdef} +\end{description} + +\begin{verbatim} + int fits_set_hdrsize / ffhdef + (fitsfile *fptr, int morekeys, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Return the number of keywords in the header (not counting the END + keyword) and the current position + in the header. The position is the number of the keyword record that + will be read next (or one greater than the position of the last keyword + that was read). A value of 1 is returned if the pointer is + positioned at the beginning of the header. \label{ffghps} +\end{description} + +\begin{verbatim} + int fits_get_hdrpos / ffghps + (fitsfile *fptr, > int *keysexist, int *keynum, int *status) +\end{verbatim} + + +\subsection{Read and Write the Required Keywords} + + +\begin{description} +\item[1 ] Write the primary header or IMAGE extension keywords into the CHU. + The simpler fits\_write\_imghdr routine is equivalent to calling + fits\_write\_grphdr with the default values of simple = TRUE, pcount + = 0, gcount = 1, and extend = TRUE. The PCOUNT, GCOUNT and EXTEND + keywords are not required in the primary header and are only written + if pcount is not equal to zero, gcount is not equal to zero or one, + and if extend is TRUE, respectively. When writing to an IMAGE + extension, the SIMPLE and EXTEND parameters are ignored. It is + recommended that fits\_create\_image or fits\_create\_tbl be used + instead of these routines to write the + required header keywords. \label{ffphpr} \label{ffphps} +\end{description} + +\begin{verbatim} + int fits_write_imghdr / ffphps + (fitsfile *fptr, int bitpix, int naxis, long *naxes, > int *status) + + int fits_write_grphdr / ffphpr + (fitsfile *fptr, int simple, int bitpix, int naxis, long *naxes, + long pcount, long gcount, int extend, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Write the ASCII table header keywords into the CHU. The optional + TUNITn and EXTNAME keywords are written only if the input pointers + are not null. A null pointer may given for the + *tbcol parameter in which case a single space will be inserted + between each column of the table. Similarly, if rowlen is + given = 0, then CFITSIO will calculate the default rowlength based on + the tbcol and ttype values. \label{ffphtb} +\end{description} + +\begin{verbatim} + int fits_write_atblhdr / ffphtb + (fitsfile *fptr, long rowlen, long nrows, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, char *extname, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Write the binary table header keywords into the CHU. The optional + TUNITn and EXTNAME keywords are written only if the input pointers + are not null. The pcount parameter, which specifies the + size of the variable length array heap, should initially = 0; + CFITSIO will automatically update the PCOUNT keyword value if any + variable length array data is written to the heap. The TFORM keyword + value for variable length vector columns should have the form 'Pt(len)' + or '1Pt(len)' where `t' is the data type code letter (A,I,J,E,D, etc.) + and `len' is an integer specifying the maximum length of the vectors + in that column (len must be greater than or equal to the longest + vector in the column). If `len' is not specified when the table is + created (e.g., the input TFORMn value is just '1Pt') then CFITSIO will + scan the column when the table is first closed and will append the + maximum length to the TFORM keyword value. Note that if the table + is subsequently modified to increase the maximum length of the vectors + then the modifying program is responsible for also updating the TFORM + keyword value. \label{ffphbn} +\end{description} + +\begin{verbatim} + int fits_write_btblhdr / ffphbn + (fitsfile *fptr, long nrows, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Read the required keywords from the CHDU (image or table). When + reading from an IMAGE extension the SIMPLE and EXTEND parameters are + ignored. A null pointer may be supplied for any of the returned + parameters that are not needed. \label{ffghpr} \label{ffghtb} \label{ffghbn} +\end{description} + +\begin{verbatim} + int fits_read_imghdr / ffghpr + (fitsfile *fptr, int maxdim, > int *simple, int *bitpix, int *naxis, + long *naxes, long *pcount, long *gcount, int *extend, int *status) + + int fits_read_atblhdr / ffghtb + (fitsfile *fptr,int maxdim, > long *rowlen, long *nrows, + int *tfields, char **ttype, long *tbcol, char **tform, char **tunit, + char *extname, int *status) + + int fits_read_btblhdr / ffghbn + (fitsfile *fptr, int maxdim, > long *nrows, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + long *pcount, int *status) +\end{verbatim} + +\subsection{Write Keyword Routines} + +These routines simply append a new keyword to the header and do not +check to see if a keyword with the same name already exists. In +general it is preferable to use the fits\_update\_key routine to ensure +that the same keyword is not written more than once to the header. See +Appendix B for the definition of the parameters used in these +routines. + + + +\begin{description} +\item[1 ] Write (append) a new keyword of the appropriate data type into the CHU. + A null pointer may be entered for the comment parameter, which + will cause the comment field of the keyword to be left blank. The + flt, dbl, cmp, and dblcmp versions of this routine have the added + feature that if the 'decimals' parameter is negative, then the 'G' + display format rather then the 'E' format will be used when + constructing the keyword value, taking the absolute value of + 'decimals' for the precision. This will suppress trailing zeros, + and will use a fixed format rather than an exponential format, + depending on the magnitude of the value. \label{ffpkyx} +\end{description} + +\begin{verbatim} + int fits_write_key_str / ffpkys + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status) + + int fits_write_key_[log, lng] / ffpky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_write_key_[flt, dbl, fixflg, fixdbl] / ffpky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_write_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffpk[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Write (append) a string valued keyword into the CHU which may be longer + than 68 characters in length. This uses the Long String Keyword + convention that is described in the`Local FITS Conventions' section + in Chapter 4. Since this uses a non-standard FITS convention to + encode the long keyword string, programs which use this routine + should also call the fits\_write\_key\_longwarn routine to add some + COMMENT keywords to warn users of the FITS file that this + convention is being used. The fits\_write\_key\_longwarn routine + also writes a keyword called LONGSTRN to record the version of the + longstring convention that has been used, in case a new convention + is adopted at some point in the future. If the LONGSTRN keyword + is already present in the header, then fits\_write\_key\_longwarn + will + simply return without doing anything. \label{ffpkls} \label{ffplsw} +\end{description} + +\begin{verbatim} + int fits_write_key_longstr / ffpkls + (fitsfile *fptr, char *keyname, char *longstr, char *comment, + > int *status) + + int fits_write_key_longwarn / ffplsw + (fitsfile *fptr, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Write (append) a numbered sequence of keywords into the CHU. The + starting index number (nstart) must be greater than 0. One may + append the same comment to every keyword (and eliminate the need + to have an array of identical comment strings, one for each keyword) by + including the ampersand character as the last non-blank character in the + (first) COMMENTS string parameter. This same string + will then be used for the comment field in all the keywords. + One may also enter a null pointer for the comment parameter to + leave the comment field of the keyword blank. \label{ffpknx} +\end{description} + +\begin{verbatim} + int fits_write_keys_str / ffpkns + (fitsfile *fptr, char *keyroot, int nstart, int nkeys, + char **value, char **comment, > int *status) + + int fits_write_keys_[log, lng] / ffpkn[lj] + (fitsfile *fptr, char *keyroot, int nstart, int nkeys, + DTYPE *numval, char **comment, int *status) + + int fits_write_keys_[flt, dbl, fixflg, fixdbl] / ffpkne[edfg] + (fitsfile *fptr, char *keyroot, int nstart, int nkey, + DTYPE *numval, int decimals, char **comment, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ]Copy an indexed keyword from one HDU to another, modifying + the index number of the keyword name in the process. For example, + this routine could read the TLMIN3 keyword from the input HDU + (by giving keyroot = `TLMIN' and innum = 3) and write it to the + output HDU with the keyword name TLMIN4 (by setting outnum = 4). + If the input keyword does not exist, then this routine simply + returns without indicating an error. \label{ffcpky} +\end{description} + +\begin{verbatim} + int fits_copy_key / ffcpky + (fitsfile *infptr, fitsfile *outfptr, int innum, int outnum, + char *keyroot, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ]Write (append) a `triple precision' keyword into the CHU in F28.16 format. + The floating point keyword value is constructed by concatenating the + input integer value with the input double precision fraction value + (which must have a value between 0.0 and 1.0). The ffgkyt routine should + be used to read this keyword value, because the other keyword reading + routines will not preserve the full precision of the value. \label{ffpkyt} +\end{description} + +\begin{verbatim} + int fits_write_key_triple / ffpkyt + (fitsfile *fptr, char *keyname, long intval, double frac, + char *comment, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ]Write keywords to the CHDU that are defined in an ASCII template file. + The format of the template file is described under the fits\_parse\_template + routine. \label{ffpktp} +\end{description} + +\begin{verbatim} + int fits_write_key_template / ffpktp + (fitsfile *fptr, const char *filename, > int *status) +\end{verbatim} + +\subsection{Insert Keyword Routines} + +These insert routines are somewhat less efficient than the `update' or +`write' keyword routines because the following keywords in the header +must be shifted down to make room for the inserted keyword. See +Appendix B for the definition of the parameters used in these +routines. + + +\begin{description} +\item[1 ] Insert a new keyword record into the CHU at the specified position + (i.e., immediately preceding the (keynum)th keyword in the header.) + \label{ffirec} +\end{description} + +\begin{verbatim} + int fits_insert_record / ffirec + (fitsfile *fptr, int keynum, char *card, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Insert a new keyword into the CHU. The new keyword is inserted + immediately following the last keyword that has been read from the + header. The `longstr' version has the same functionality as the + `str' version except that it also supports the local long string + keyword convention for strings longer than 68 characters. A null + pointer may be entered for the comment parameter which will cause + the comment field to be left blank. The flt, dbl, cmp, and dblcmp + versions of this routine have the added + feature that if the 'decimals' parameter is negative, then the 'G' + display format rather then the 'E' format will be used when + constructing the keyword value, taking the absolute value of + 'decimals' for the precision. This will suppress trailing zeros, + and will use a fixed format rather than an exponential format, + depending on the magnitude of the value. \label{ffikyx} +\end{description} + +\begin{verbatim} + int fits_insert_card / ffikey + (fitsfile *fptr, char *card, > &status) + + int fits_insert_key_[str, longstr] / ffi[kys, kls] + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status) + + int fits_insert_key_[log, lng] / ffiky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_insert_key_[flt, fixflt, dbl, fixdbl] / ffiky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_insert_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffik[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Insert a new keyword with an undefined, or null, value into the CHU. + The value string of the keyword is left blank in this case. \label{ffikyu} +\end{description} + +\begin{verbatim} + int fits_insert_key_null / ffikyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) +\end{verbatim} + + +\subsection{Read Keyword Routines} + +Wild card characters may be used when specifying the name of the +keyword to be read. + + +\begin{description} +\item[1 ] Read a keyword value (with the appropriate data type) and comment from + the CHU. If a NULL comment pointer is given on input, then the comment + string will not be returned. If the value of the keyword is not defined + (i.e., the value field is blank) then an error status = VALUE\_UNDEFINED + will be returned and the input value will not be changed (except that + ffgkys will reset the value to a null string). + \label{ffgkyx} \label{ffgkls} +\end{description} + +\begin{verbatim} + int fits_read_key_str / ffgkys + (fitsfile *fptr, char *keyname, > char *value, char *comment, + int *status); + + NOTE: after calling the following routine, programs must explicitly free + the memory allocated for 'longstr' after it is no longer needed. + + int fits_read_key_longstr / ffgkls + (fitsfile *fptr, char *keyname, > char **longstr, char *comment, + int *status) + + int fits_read_key_[log, lng, flt, dbl, cmp, dblcmp] / ffgky[ljedcm] + (fitsfile *fptr, char *keyname, > DTYPE *numval, char *comment, + int *status) + +\end{verbatim} + +\begin{description} +\item[2 ] Read a sequence of indexed keyword values (e.g., NAXIS1, NAXIS2, ...). + The input starting index number (nstart) must be greater than 0. + If the value of any of the keywords is not defined (i.e., the value + field is blank) then an error status = VALUE\_UNDEFINED will be + returned and the input value for the undefined keyword(s) will not + be changed. These routines do not support wild card characters in + the root name. If there are no indexed keywords in the header with + the input root name then these routines do not return a non-zero + status value and instead simply return nfound = 0. \label{ffgknx} +\end{description} + +\begin{verbatim} + int fits_read_keys_str / ffgkns + (fitsfile *fptr, char *keyname, int nstart, int nkeys, + > char **value, int *nfound, int *status) + + int fits_read_keys_[log, lng, flt, dbl] / ffgkn[ljed] + (fitsfile *fptr, char *keyname, int nstart, int nkeys, + > DTYPE *numval, int *nfound, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Read the value of a floating point keyword, returning the integer and + fractional parts of the value in separate routine arguments. + This routine may be used to read any keyword but is especially + useful for reading the 'triple precision' keywords written by ffpkyt. + \label{ffgkyt} +\end{description} + +\begin{verbatim} + int fits_read_key_triple / ffgkyt + (fitsfile *fptr, char *keyname, > long *intval, double *frac, + char *comment, int *status) +\end{verbatim} + +\subsection{Modify Keyword Routines} + +These routines modify the value of an existing keyword. An error is +returned if the keyword does not exist. Wild card characters may be +used when specifying the name of the keyword to be modified. See +Appendix B for the definition of the parameters used in these +routines. + + +\begin{description} +\item[1 ] Modify (overwrite) the nth 80-character header record in the CHU. \label{ffmrec} +\end{description} + +\begin{verbatim} + int fits_modify_record / ffmrec + (fitsfile *fptr, int keynum, char *card, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Modify (overwrite) the 80-character header record for the named keyword + in the CHU. This can be used to overwrite the name of the keyword as + well as its value and comment fields. \label{ffmcrd} +\end{description} + +\begin{verbatim} + int fits_modify_card / ffmcrd + (fitsfile *fptr, char *keyname, char *card, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Modify the value and comment fields of an existing keyword in the CHU. + The `longstr' version has the same functionality as the `str' + version except that it also supports the local long string keyword + convention for strings longer than 68 characters. Optionally, one + may modify only the value field and leave the comment field + unchanged by setting the input COMMENT parameter equal to the + ampersand character (\&) or by entering a null pointer for the + comment parameter. The flt, dbl, cmp, and dblcmp versions of this + routine have the added feature that if the 'decimals' parameter is + negative, then the 'G' display format rather then the 'E' format + will be used when constructing the keyword value, taking the + absolute value of 'decimals' for the precision. This will suppress + trailing zeros, and will use a fixed format rather than an + exponential format, + depending on the magnitude of the value. \label{ffmkyx} +\end{description} + +\begin{verbatim} + int fits_modify_key_[str, longstr] / ffm[kys, kls] + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status); + + int fits_modify_key_[log, lng] / ffmky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_modify_key_[flt, dbl, fixflt, fixdbl] / ffmky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_modify_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffmk[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Modify the value of an existing keyword to be undefined, or null. + The value string of the keyword is set to blank. + Optionally, one may leave the comment field unchanged by setting the + input COMMENT parameter equal to + the ampersand character (\&) or by entering a null pointer. \label{ffmkyu} +\end{description} + +\begin{verbatim} + int fits_modify_key_null / ffmkyu + (fitsfile *fptr, char *keyname, char *comment, > int *status) +\end{verbatim} + +\subsection{Update Keyword Routines} + + +\begin{description} +\item[1 ] These update routines modify the value, and optionally the comment field, + of the keyword if it already exists, otherwise the new keyword is + appended to the header. A separate routine is provided for each + keyword data type. The `longstr' version has the same functionality + as the `str' version except that it also supports the local long + string keyword convention for strings longer than 68 characters. A + null pointer may be entered for the comment parameter which will + leave the comment field unchanged or blank. The flt, dbl, cmp, and + dblcmp versions of this routine have the added feature that if the + 'decimals' parameter is negative, then the 'G' display format + rather then the 'E' format will be used when constructing the + keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a fixed + format rather than an exponential format, + depending on the magnitude of the value. \label{ffukyx} +\end{description} + +\begin{verbatim} + int fits_update_key_[str, longstr] / ffu[kys, kls] + (fitsfile *fptr, char *keyname, char *value, char *comment, + > int *status) + + int fits_update_key_[log, lng] / ffuky[lj] + (fitsfile *fptr, char *keyname, DTYPE numval, char *comment, + > int *status) + + int fits_update_key_[flt, dbl, fixflt, fixdbl] / ffuky[edfg] + (fitsfile *fptr, char *keyname, DTYPE numval, int decimals, + char *comment, > int *status) + + int fits_update_key_[cmp, dblcmp, fixcmp, fixdblcmp] / ffuk[yc,ym,fc,fm] + (fitsfile *fptr, char *keyname, DTYPE *numval, int decimals, + char *comment, > int *status) +\end{verbatim} + + +\section{Define Data Scaling and Undefined Pixel Parameters} + +These routines set or modify the internal parameters used by CFITSIO +to either scale the data or to represent undefined pixels. Generally +CFITSIO will scale the data according to the values of the BSCALE and +BZERO (or TSCALn and TZEROn) keywords, however these routines may be +used to override the keyword values. This may be useful when one wants +to read or write the raw unscaled values in the FITS file. Similarly, +CFITSIO generally uses the value of the BLANK or TNULLn keyword to +signify an undefined pixel, but these routines may be used to override +this value. These routines do not create or modify the corresponding +header keyword values. See Appendix B for the definition of the +parameters used in these routines. + + +\begin{description} +\item[1 ] Reset the scaling factors in the primary array or image extension; does + not change the BSCALE and BZERO keyword values and only affects the + automatic scaling performed when the data elements are written/read + to/from the FITS file. When reading from a FITS file the returned + data value = (the value given in the FITS array) * BSCALE + BZERO. + The inverse formula is used when writing data values to the FITS + file. \label{ffpscl} +\end{description} + +\begin{verbatim} + int fits_set_bscale / ffpscl + (fitsfile *fptr, double scale, double zero, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Reset the scaling parameters for a table column; does not change + the TSCALn or TZEROn keyword values and only affects the automatic + scaling performed when the data elements are written/read to/from + the FITS file. When reading from a FITS file the returned data + value = (the value given in the FITS array) * TSCAL + TZERO. The + inverse formula is used when writing data values to the FITS file. + \label{fftscl} +\end{description} + +\begin{verbatim} + int fits_set_tscale / fftscl + (fitsfile *fptr, int colnum, double scale, double zero, + > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Define the integer value to be used to signify undefined pixels in the + primary array or image extension. This is only used if BITPIX = 8, 16, + or 32. This does not create or change the value of the BLANK keyword in + the header. \label{ffpnul} +\end{description} + +\begin{verbatim} + int fits_set_imgnull / ffpnul + (fitsfile *fptr, long nulval, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Define the string to be used to signify undefined pixels in + a column in an ASCII table. This does not create or change the value + of the TNULLn keyword. \label{ffsnul} +\end{description} + +\begin{verbatim} + int fits_set_atblnull / ffsnul + (fitsfile *fptr, int colnum, char *nulstr, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Define the value to be used to signify undefined pixels in + an integer column in a binary table (where TFORMn = 'B', 'I', or 'J'). + This does not create or change the value of the TNULLn keyword. + \label{fftnul} +\end{description} + +\begin{verbatim} + int fits_set_btblnull / fftnul + (fitsfile *fptr, int colnum, long nulval, > int *status) +\end{verbatim} + + +\section{Specialized FITS Primary Array or IMAGE Extension I/O Routines} + +These routines read or write data values in the primary data array +(i.e., the first HDU in the FITS file) or an IMAGE extension. +Automatic data type conversion is performed for if the data type of the +FITS array (as defined by the BITPIX keyword) differs from the data +type of the array in the calling routine. The data values are +automatically scaled by the BSCALE and BZERO header values as they are +being written or read from the FITS array. Unlike the basic routines +described in the previous chapter, most of these routines specifically +support the FITS random groups format. See Appendix B for the +definition of the parameters used in these routines. + +The more primitive reading and writing routines (i. e., ffppr\_, +ffppn\_, ffppn, ffgpv\_, or ffgpf\_) simply treat the primary array as +a long 1-dimensional array of pixels, ignoring the intrinsic +dimensionality of the array. When dealing with a 2D image, for +example, the application program must calculate the pixel offset in the +1-D array that corresponds to any particular X, Y coordinate in the +image. C programmers should note that the ordering of arrays in FITS +files, and hence in all the CFITSIO calls, is more similar to the +dimensionality of arrays in Fortran rather than C. For instance if a +FITS image has NAXIS1 = 100 and NAXIS2 = 50, then a 2-D array just +large enough to hold the image should be declared as array[50][100] and +not as array[100][50]. + +For convenience, higher-level routines are also provided to specificly +deal with 2D images (ffp2d\_ and ffg2d\_) and 3D data cubes (ffp3d\_ +and ffg3d\_). The dimensionality of the FITS image is passed by the +naxis1, naxis2, and naxis3 parameters and the declared dimensions of +the program array are passed in the dim1 and dim2 parameters. Note +that the dimensions of the program array may be larger than the +dimensions of the FITS array. For example if a FITS image with NAXIS1 += NAXIS2 = 400 is read into a program array which is dimensioned as 512 +x 512 pixels, then the image will just fill the lower left corner of +the array with pixels in the range 1 - 400 in the X an Y directions. +This has the effect of taking a contiguous set of pixel value in the +FITS array and writing them to a non-contiguous array in program memory +(i.e., there are now some blank pixels around the edge of the image in +the program array). + +The most general set of routines (ffpss\_, ffgsv\_, and ffgsf\_) may be +used to transfer a rectangular subset of the pixels in a FITS +N-dimensional image to or from an array which has been declared in the +calling program. The fpixel and lpixel parameters are integer arrays +which specify the starting and ending pixel coordinate in each dimension +(starting with 1, not 0) of the FITS image that is to be read or +written. It is important to note that these are the starting and +ending pixels in the FITS image, not in the declared array in the +program. The array parameter in these routines is treated simply as a +large one-dimensional array of the appropriate data type containing the +pixel values; The pixel values in the FITS array are read/written +from/to this program array in strict sequence without any gaps; it is +up to the calling routine to correctly interpret the dimensionality of +this array. The two FITS reading routines (ffgsv\_ and ffgsf\_ ) also +have an `inc' parameter which defines the data sampling interval in +each dimension of the FITS array. For example, if inc[0]=2 and +inc[1]=3 when reading a 2-dimensional FITS image, then only every other +pixel in the first dimension and every 3rd pixel in the second +dimension will be returned to the 'array' parameter. + +Two types of routines are provided to read the data array which differ in +the way undefined pixels are handled. The first type of routines (e.g., +ffgpv\_) simply return an array of data elements in which undefined +pixels are set equal to a value specified by the user in the `nulval' +parameter. An additional feature of these routines is that if the user +sets nulval = 0, then no checks for undefined pixels will be performed, +thus reducing the amount of CPU processing. The second type of routines +(e.g., ffgpf\_) returns the data element array and, in addition, a char +array that indicates whether the value of the corresponding data pixel +is undefined (= 1) or defined (= 0). The latter type of routines may +be more convenient to use in some circumstances, however, it requires +an additional array of logical values which can be unwieldy when working +with large data arrays. + + +\begin{description} +\item[1 ] Write elements into the FITS data array. + \label{ffppr} \label{ffpprx} \label{ffppn} \label{ffppnx} +\end{description} + +\begin{verbatim} + int fits_write_img / ffppr + (fitsfile *fptr, int datatype, long firstelem, long nelements, + DTYPE *array, int *status); + + int fits_write_img_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffppr[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + DTYPE *array, > int *status); + + int fits_write_imgnull / ffppn + (fitsfile *fptr, int datatype, long firstelem, long nelements, + DTYPE *array, DTYPE *nulval, > int *status); + + int fits_write_imgnull_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffppn[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, + long nelements, DTYPE *array, DTYPE nulval, > int *status); +\end{verbatim} + +\begin{description} +\item[2 ]Set data array elements as undefined. \label{ffppru} +\end{description} + +\begin{verbatim} + int fits_write_img_null / ffppru + (fitsfile *fptr, long group, long firstelem, long nelements, + > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Write values into group parameters. This routine only applies + to the `Random Grouped' FITS format which has been used for + applications in radio interferometry, but is officially deprecated + for future use. \label{ffpgpx} +\end{description} + +\begin{verbatim} + int fits_write_grppar_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffpgp[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + > DTYPE *array, int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Write a 2-D or 3-D image into the data array. \label{ffp2dx} \label{ffp3dx} +\end{description} + +\begin{verbatim} + int fits_write_2d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffp2d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long dim1, long naxis1, + long naxis2, DTYPE *array, > int *status) + + int fits_write_3d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffp3d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long dim1, long dim2, + long naxis1, long naxis2, long naxis3, DTYPE *array, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Write an arbitrary data subsection into the data array. \label{ffpssx} +\end{description} + +\begin{verbatim} + int fits_write_subset_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffpss[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, DTYPE *array, > int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Read elements from the FITS data array. + \label{ffgpv} \label{ffgpvx} \label{ffgpf} \label{ffgpfx} +\end{description} + +\begin{verbatim} + int fits_read_img / ffgpv + (fitsfile *fptr, int datatype, long firstelem, long nelements, + DTYPE *nulval, > DTYPE *array, int *anynul, int *status) + + int fits_read_img_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgpv[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + DTYPE nulval, > DTYPE *array, int *anynul, int *status) + + int fits_read_imgnull / ffgpf + (fitsfile *fptr, int datatype, long firstelem, long nelements, + > DTYPE *array, char *nullarray, int *anynul, int *status) + + int fits_read_imgnull_[byt, sht, usht, int, uint, lng, ulng, flt, dbl] / + ffgpf[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + > DTYPE *array, char *nullarray, int *anynul, int *status) +\end{verbatim} + +\begin{description} +\item[7 ] Read values from group parameters. This routine only applies + to the `Random Grouped' FITS format which has been used for + applications in radio interferometry, but is officially deprecated + for future use. \label{ffggpx} +\end{description} + +\begin{verbatim} + int fits_read_grppar_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffggp[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, long firstelem, long nelements, + > DTYPE *array, int *status) +\end{verbatim} + +\begin{description} +\item[8 ] Read 2-D or 3-D image from the data array. Undefined + pixels in the array will be set equal to the value of 'nulval', + unless nulval=0 in which case no testing for undefined pixels will + be performed. \label{ffg2dx} \label{ffg3dx} +\end{description} + +\begin{verbatim} + int fits_read_2d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffg2d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, DTYPE nulval, long dim1, long naxis1, + long naxis2, > DTYPE *array, int *anynul, int *status) + + int fits_read_3d_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffg3d[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, long group, DTYPE nulval, long dim1, + long dim2, long naxis1, long naxis2, long naxis3, + > DTYPE *array, int *anynul, int *status) +\end{verbatim} + +\begin{description} +\item[9 ] Read an arbitrary data subsection from the data array. + \label{ffgsvx} \label{ffgsfx} +\end{description} + +\begin{verbatim} + int fits_read_subset_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsv[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int group, int naxis, long *naxes, + long *fpixel, long *lpixel, long *inc, DTYPE nulval, + > DTYPE *array, int *anynul, int *status) + + int fits_read_subsetnull_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsf[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int group, int naxis, long *naxes, + long *fpixel, long *lpixel, long *inc, > DTYPE *array, + char *nullarray, int *anynul, int *status) +\end{verbatim} + + +\section{Specialized FITS ASCII and Binary Table Routines} + + +\subsection{General Column Routines} + + +\begin{description} +\item[1 ] Get information about an existing ASCII or binary table column. A null + pointer may be given for any of the output parameters that are not + needed. DATATYPE is a character string which returns the data type + of the column as defined by the TFORMn keyword (e.g., 'I', 'J','E', + 'D', etc.). In the case of an ASCII character column, typecode + will have a value of the form 'An' where 'n' is an integer + expressing the width of the field in characters. For example, if + TFORM = '160A8' then ffgbcl will return typechar='A8' and + repeat=20. All the returned parameters are scalar quantities. + \label{ffgacl} \label{ffgbcl} +\end{description} + +\begin{verbatim} + int fits_get_acolparms / ffgacl + (fitsfile *fptr, int colnum, > char *ttype, long *tbcol, + char *tunit, char *tform, double *scale, double *zero, + char *nulstr, char *tdisp, int *status) + + int fits_get_bcolparms / ffgbcl + (fitsfile *fptr, int colnum, > char *ttype, char *tunit, + char *typechar, long *repeat, double *scale, double *zero, + long *nulval, char *tdisp, int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Return optimal number of rows to read or write at one time for + maximum I/O efficiency. Refer to the + ``Optimizing Code'' section in Chapter 5 for more discussion on how + to use this routine. \label{ffgrsz} +\end{description} + +\begin{verbatim} + int fits_get_rowsize / ffgrsz + (fitsfile *fptr, long *nrows, *status) +\end{verbatim} + +\begin{description} +\item[3 ] Define the zero indexed byte offset of the 'heap' measured from + the start of the binary table data. By default the heap is assumed + to start immediately following the regular table data, i.e., at + location NAXIS1 x NAXIS2. This routine is only relevant for + binary tables which contain variable length array columns (with + TFORMn = 'Pt'). This routine also automatically writes + the value of theap to a keyword in the extension header. This + routine must be called after the required keywords have been + written (with ffphbn) + but before any data is written to the table. \label{ffpthp} +\end{description} + +\begin{verbatim} + int fits_write_theap / ffpthp + (fitsfile *fptr, long theap, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Test the contents of the binary table variable array heap, returning + the size of the heap, the number of unused bytes that are not currently + pointed to by any of the descriptors, and the number of bytes which are + pointed to by multiple descriptors. It also returns valid = FALSE if + any of the descriptors point to invalid addresses out of range of the + heap. \label{fftheap} +\end{description} + +\begin{verbatim} + int fits_test_heap / fftheap + (fitsfile *fptr, > long *heapsize, long *unused, long *overlap, + int *validheap, int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Re-pack the vectors in the binary table variable array heap to recover + any unused space. Normally, when a vector in a variable length + array column is rewritten the previously written array remains in + the heap as wasted unused space. This routine will repack the + arrays that are still in use, thus eliminating any bytes in the + heap that are no longer in use. Note that if several vectors point + to the same bytes in the heap, then this routine will make + duplicate copies of the bytes for each vector, which will actually + expand the size of the heap. \label{ffcmph} +\end{description} + +\begin{verbatim} + int fits_compress_heap / ffcmph + (fitsfile *fptr, > int *status) +\end{verbatim} + + +\subsection{Low-Level Table Access Routines} + +The following 2 routines provide low-level access to the data in ASCII +or binary tables and are mainly useful as an efficient way to copy all +or part of a table from one location to another. These routines simply +read or write the specified number of consecutive bytes in an ASCII or +binary table, without regard for column boundaries or the row length in +the table. These routines do not perform any machine dependent data +conversion or byte swapping. See Appendix B for the definition of the +parameters used in these routines. + + +\begin{description} +\item[1 ] Read or write a consecutive array of bytes from an ASCII or binary + table \label{ffgtbb} \label{ffptbb} +\end{description} + +\begin{verbatim} + int fits_read_tblbytes / ffgtbb + (fitsfile *fptr, long firstrow, long firstchar, long nchars, + > unsigned char *values, int *status) + + int fits_write_tblbytes / ffptbb + (fitsfile *fptr, long firstrow, long firstchar, long nchars, + unsigned char *values, > int *status) +\end{verbatim} + + +\subsection{Write Column Data Routines} + + +\begin{description} +\item[1 ] Write elements into an ASCII or binary table column (in the CDU). + The data type of the array is implied by the suffix of the + routine name. \label{ffpcls} +\end{description} + +\begin{verbatim} + int fits_write_col_str / ffpcls + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, char **array, > int *status) + + int fits_write_col_[log,byt,sht,usht,int,uint,lng,ulng,lnglng,flt,dbl,cmp,dblcmp] / + ffpcl[l,b,i,ui,k,uk,j,uj,jj,e,d,c,m] + (fitsfile *fptr, int colnum, long firstrow, + long firstelem, long nelements, DTYPE *array, > int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Write elements into an ASCII or binary table column + substituting the appropriate FITS null value for any elements that + are equal to the nulval parameter. This routines must not be used to + write to variable length array columns. \label{ffpcnx} +\end{description} + +\begin{verbatim} + int fits_write_colnull_[log, byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffpcn[l,b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, DTYPE *array, DTYPE nulval, > int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Write string elements into a binary table column (in the CDU) + substituting the FITS null value for any elements that + are equal to the nulstr string. This routine must NOT be + used to write to variable length array columns. \label{ffpcns} +\end{description} + +\begin{verbatim} + int fits_write_colnull_str / ffpcns + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, char **array, char *nulstr, > int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Write bit values into a binary byte ('B') or bit ('X') table column (in + the CDU). Larray is an array of characters corresponding to the + sequence of bits to be written. If an element of larray is true + (not equal to zero) then the corresponding bit in the FITS table is + set to 1, otherwise the bit is set to 0. The 'X' column in a FITS + table is always padded out to a multiple of 8 bits where the bit + array starts with the most significant bit of the byte and works + down towards the 1's bit. For example, a '4X' array, with the + first bit = 1 and the remaining 3 bits = 0 is equivalent to the 8-bit + unsigned byte decimal value of 128 ('1000 0000B'). In the case of + 'X' columns, CFITSIO can write to all 8 bits of each byte whether + they are formally valid or not. Thus if the column is defined as + '4X', and one calls ffpclx with firstbit=1 and nbits=8, then all + 8 bits will be written into the first byte (as opposed to writing + the first 4 bits into the first row and then the next 4 bits into + the next row), even though the last 4 bits of each byte are formally + not defined and should all be set = 0. It should also be noted that + it is more efficient to write 'X' columns an entire byte at a time, + instead of bit by bit. Any of the CFITSIO routines that write to + columns (e.g. fits\_write\_col\_byt) may be used for this purpose. + These routines will interpret 'X' columns as though they were 'B' + columns (e.g., '1X' through '8X' is equivalent + to '1B', and '9X' through '16X' is equivalent to '2B'). \label{ffpclx} +\end{description} + +\begin{verbatim} + int fits_write_col_bit / ffpclx + (fitsfile *fptr, int colnum, long firstrow, long firstbit, + long nbits, char *larray, > int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Write the descriptor for a variable length column in a binary table. + This routine can be used in conjunction with ffgdes to enable + 2 or more arrays to point to the same storage location to save + storage space if the arrays are identical. \label{ffpdes} +\end{description} + +\begin{verbatim} + int fits_write_descript / ffpdes + (fitsfile *fptr, int colnum, long rownum, long repeat, + long offset, > int *status) +\end{verbatim} + +\subsection{Read Column Data Routines} + +Two types of routines are provided to get the column data which differ +in the way undefined pixels are handled. The first set of routines +(ffgcv) simply return an array of data elements in which undefined +pixels are set equal to a value specified by the user in the 'nullval' +parameter. If nullval = 0, then no checks for undefined pixels will be +performed, thus increasing the speed of the program. The second set of +routines (ffgcf) returns the data element array and in addition a +logical array of flags which defines whether the corresponding data +pixel is undefined. See Appendix B for the definition of the +parameters used in these routines. + + Any column, regardless of it's intrinsic data type, may be read as a + string. It should be noted however that reading a numeric column as + a string is 10 - 100 times slower than reading the same column as a number + due to the large overhead in constructing the formatted strings. + The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + data type of the column. The length of the returned strings (not + including the null terminating character) can be determined with + the fits\_get\_col\_display\_width routine. The following TDISPn + display formats are currently supported: + +\begin{verbatim} + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +\end{verbatim} + where w is the width in characters of the displayed values, m is + the minimum number of digits displayed, and d is the number of + digits to the right of the decimal. The .m field is optional. + + +\begin{description} +\item[1 ] Read elements from an ASCII or binary table column (in the CDU). These + routines return the values of the table column array elements. Undefined + array elements will be returned with a value = nulval, unless nulval = 0 + (or = ' ' for ffgcvs) in which case no checking for undefined values will + be performed. The ANYF parameter is set to true if any of the returned + elements are undefined. \label{ffgcvx} +\end{description} + +\begin{verbatim} + int fits_read_col_str / ffgcvs + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, char *nulstr, > char **array, int *anynul, + int *status) + + int fits_read_col_[log,byt,sht,usht,int,uint,lng,ulng, lnglng, flt, dbl, cmp, dblcmp] / + ffgcv[l,b,i,ui,k,uk,j,uj,jj,e,d,c,m] + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, DTYPE nulval, > DTYPE *array, int *anynul, + int *status) +\end{verbatim} + +\begin{description} +\item[2 ] Read elements and null flags from an ASCII or binary table column (in the + CHDU). These routines return the values of the table column array elements. + Any undefined array elements will have the corresponding nullarray element + set equal to TRUE. The anynul parameter is set to true if any of the + returned elements are undefined. \label{ffgcfx} +\end{description} + +\begin{verbatim} + int fits_read_colnull_str / ffgcfs + (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelements, > char **array, char *nullarray, int *anynul, + int *status) + + int fits_read_colnull_[log,byt,sht,usht,int,uint,lng,ulng,lnglng,flt,dbl,cmp,dblcmp] / + ffgcf[l,b,i,ui,k,uk,j,uj,jj,e,d,c,m] + (fitsfile *fptr, int colnum, long firstrow, + long firstelem, long nelements, > DTYPE *array, + char *nullarray, int *anynul, int *status) +\end{verbatim} + +\begin{description} +\item[3 ] Read an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Undefined pixels + in the array will be set equal to the value of 'nulval', + unless nulval=0 in which case no testing for undefined pixels will + be performed. The first and last rows in the table to be read + are specified by fpixel(naxis+1) and lpixel(naxis+1), and hence + are treated as the next higher dimension of the FITS N-dimensional + array. The INC parameter specifies the sampling interval in + each dimension between the data elements that will be returned. \label{ffgsvx2} +\end{description} + +\begin{verbatim} + int fits_read_subset_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsv[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int colnum, int naxis, long *naxes, long *fpixel, + long *lpixel, long *inc, DTYPE nulval, > DTYPE *array, int *anynul, + int *status) +\end{verbatim} + +\begin{description} +\item[4 ] Read an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Any Undefined + pixels in the array will have the corresponding 'nullarray' + element set equal to TRUE. The first and last rows in the table + to be read are specified by fpixel(naxis+1) and lpixel(naxis+1), + and hence are treated as the next higher dimension of the FITS + N-dimensional array. The INC parameter specifies the sampling + interval in each dimension between the data elements that will be + returned. \label{ffgsfx2} +\end{description} + +\begin{verbatim} + int fits_read_subsetnull_[byt, sht, usht, int, uint, lng, ulng, lnglng, flt, dbl] / + ffgsf[b,i,ui,k,uk,j,uj,jj,e,d] + (fitsfile *fptr, int colnum, int naxis, long *naxes, + long *fpixel, long *lpixel, long *inc, > DTYPE *array, + char *nullarray, int *anynul, int *status) +\end{verbatim} + +\begin{description} +\item[5 ] Read bit values from a byte ('B') or bit (`X`) table column (in the + CDU). Larray is an array of logical values corresponding to the + sequence of bits to be read. If larray is true then the + corresponding bit was set to 1, otherwise the bit was set to 0. + The 'X' column in a FITS table is always padded out to a multiple + of 8 bits where the bit array starts with the most significant bit + of the byte and works down towards the 1's bit. For example, a + '4X' array, with the first bit = 1 and the remaining 3 bits = 0 is + equivalent to the 8-bit unsigned byte value of 128. + Note that in the case of 'X' columns, CFITSIO can read all 8 bits + of each byte whether they are formally valid or not. Thus if the + column is defined as '4X', and one calls ffgcx with firstbit=1 and + nbits=8, then all 8 bits will be read from the first byte (as + opposed to reading the first 4 bits from the first row and then the + first 4 bits from the next row), even though the last 4 bits of + each byte are formally not defined. It should also be noted that + it is more efficient to read 'X' columns an entire byte at a time, + instead of bit by bit. Any of the CFITSIO routines that read + columns (e.g. fits\_read\_col\_byt) may be used for this + purpose. These routines will interpret 'X' columns as though they + were 'B' columns (e.g., '8X' is equivalent to '1B', and '16X' is + equivalent to '2B'). \label{ffgcx} +\end{description} + +\begin{verbatim} + int fits_read_col_bit / ffgcx + (fitsfile *fptr, int colnum, long firstrow, long firstbit, + long nbits, > char *larray, int *status) +\end{verbatim} + +\begin{description} +\item[6 ] Read any consecutive set of bits from an 'X' or 'B' column and + interpret them as an unsigned n-bit integer. nbits must be less + than 16 or 32 in ffgcxui and ffgcxuk, respectively. If nrows + is greater than 1, then the same set of bits will be read from + each row, starting with firstrow. The bits are numbered with + 1 = the most significant bit of the first element of the column. + \label{ffgcxui} +\end{description} + +\begin{verbatim} + int fits_read_col_bit_[usht, uint] / ffgcx[ui,uk] + (fitsfile *fptr, int colnum, long firstrow, long, nrows, + long firstbit, long nbits, > DTYPE *array, int *status) +\end{verbatim} + +\begin{description} +\item[7 ] Return the descriptor for a variable length column in a binary table. + The descriptor consists of 2 integer parameters: the number of elements + in the array and the starting offset relative to the start of the heap. + The first routine returns a single descriptor whereas the second routine + returns the descriptors for a range of rows in the table. + \label{ffgdes} +\end{description} + +\begin{verbatim} + int fits_read_descript / ffgdes + (fitsfile *fptr, int colnum, long rownum, > long *repeat, + long *offset, int *status) + + int fits_read_descripts / ffgdess + (fitsfile *fptr, int colnum, long firstrow, long nrows > long *repeat, + long *offset, int *status) +\end{verbatim} + +\chapter{ Extended File Name Syntax } + + +\section{Overview} + +CFITSIO supports an extended syntax when specifying the name of the +data file to be opened or created that includes the following +features: + +\begin{itemize} +\item +CFITSIO can read IRAF format images which have header file names that +end with the '.imh' extension, as well as reading and writing FITS +files, This feature is implemented in CFITSIO by first converting the +IRAF image into a temporary FITS format file in memory, then opening +the FITS file. Any of the usual CFITSIO routines then may be used to +read the image header or data. Similarly, raw binary data arrays can +be read by converting them on the fly into virtual FITS images. + +\item +FITS files on the internet can be read (and sometimes written) using the FTP, +HTTP, or ROOT protocols. + +\item +FITS files can be piped between tasks on the stdin and stdout streams. + +\item +FITS files can be read and written in shared memory. This can +potentially achieve better data I/O performance compared to reading and +writing the same FITS files on magnetic disk. + +\item +Compressed FITS files in gzip or Unix COMPRESS format can be directly read. + +\item +Output FITS files can be written directly in compressed gzip format, +thus saving disk space. + +\item +FITS table columns can be created, modified, or deleted 'on-the-fly' as +the table is opened by CFITSIO. This creates a virtual FITS file containing +the modifications that is then opened by the application program. + +\item +Table rows may be selected, or filtered out, on the fly when the table +is opened by CFITSIO, based on an user-specified expression. +Only rows for which the expression evaluates to 'TRUE' are retained +in the copy of the table that is opened by the application program. + +\item +Histogram images may be created on the fly by binning the values in +table columns, resulting in a virtual N-dimensional FITS image. The +application program then only sees the FITS image (in the primary +array) instead of the original FITS table. +\end{itemize} + +The latter 3 table filtering features in particular add very powerful +data processing capabilities directly into CFITSIO, and hence into +every task that uses CFITSIO to read or write FITS files. For example, +these features transform a very simple program that just copies an +input FITS file to a new output file (like the `fitscopy' program that +is distributed with CFITSIO) into a multipurpose FITS file processing +tool. By appending fairly simple qualifiers onto the name of the input +FITS file, the user can perform quite complex table editing operations +(e.g., create new columns, or filter out rows in a table) or create +FITS images by binning or histogramming the values in table columns. +In addition, these functions have been coded using new state-of-the art +algorithms that are, in some cases, 10 - 100 times faster than previous +widely used implementations. + +Before describing the complete syntax for the extended FITS file names +in the next section, here are a few examples of FITS file names that +give a quick overview of the allowed syntax: + +\begin{itemize} +\item +{\tt myfile.fits}: the simplest case of a FITS file on disk in the current +directory. + +\item +{\tt myfile.imh}: opens an IRAF format image file and converts it on the +fly into a temporary FITS format image in memory which can then be read with +any other CFITSIO routine. + +\item +{\tt rawfile.dat[i512,512]}: opens a raw binary data array (a 512 x 512 +short integer array in this case) and converts it on the fly into a +temporary FITS format image in memory which can then be read with any +other CFITSIO routine. + +\item +{\tt myfile.fits.gz}: if this is the name of a new output file, the '.gz' +suffix will cause it to be compressed in gzip format when it is written to +disk. + +\item +{\tt myfile.fits.gz[events, 2]}: opens and uncompresses the gzipped file +myfile.fits then moves to the extension with the keywords EXTNAME += 'EVENTS' and EXTVER = 2. + +\item +{\tt -}: a dash (minus sign) signifies that the input file is to be read +from the stdin file stream, or that the output file is to be written to +the stdout stream. + +\item +{\tt ftp://legacy.gsfc.nasa.gov/test/vela.fits}: FITS files in any ftp +archive site on the internet may be directly opened with read-only +access. + +\item +{\tt http://legacy.gsfc.nasa.gov/software/test.fits}: any valid URL to a +FITS file on the Web may be opened with read-only access. + +\item +{\tt root://legacy.gsfc.nasa.gov/test/vela.fits}: similar to ftp access +except that it provides write as well as read access to the files +across the network. This uses the root protocol developed at CERN. + +\item +{\tt shmem://h2[events]}: opens the FITS file in a shared memory segment and +moves to the EVENTS extension. + +\item +{\tt mem://}: creates a scratch output file in core computer memory. The +resulting 'file' will disappear when the program exits, so this +is mainly useful for testing purposes when one does not want a +permanent copy of the output file. + +\item +{\tt myfile.fits[3; Images(10)]}: opens a copy of the image contained in the +10th row of the 'Images' column in the binary table in the 3th extension +of the FITS file. The virtual file that is opened by the application just +contains this single image in the primary array. + +\item +{\tt myfile.fits[1:512:2, 1:512:2]}: opens a section of the input image +ranging from the 1st to the 512th pixel in X and Y, and selects every +second pixel in both dimensions, resulting in a 256 x 256 pixel input image +in this case. + +\item +{\tt myfile.fits[EVENTS][col Rad = sqrt(X**2 + Y**2)]}: creates and opens +a virtual file on the fly that is identical to +myfile.fits except that it will contain a new column in the EVENTS +extension called 'Rad' whose value is computed using the indicated +expression which is a function of the values in the X and Y columns. + +\item +{\tt myfile.fits[EVENTS][PHA > 5]}: creates and opens a virtual FITS +files that is identical to 'myfile.fits' except that the EVENTS table +will only contain the rows that have values of the PHA column greater +than 5. In general, any arbitrary boolean expression using a C or +Fortran-like syntax, which may combine AND and OR operators, +may be used to select rows from a table. + +\item +{\tt myfile.fits[EVENTS][bin (X,Y)=1,2048,4]}: creates a temporary FITS +primary array image which is computed on the fly by binning (i.e, +computing the 2-dimensional histogram) of the values in the X and Y +columns of the EVENTS extension. In this case the X and Y coordinates +range from 1 to 2048 and the image pixel size is 4 units in both +dimensions, so the resulting image is 512 x 512 pixels in size. + +\item +The final example combines many of these feature into one complex +expression (it is broken into several lines for clarity): + +\begin{verbatim} + ftp://legacy.gsfc.nasa.gov/data/sample.fits.gz[EVENTS] + [col phacorr = pha * 1.1 - 0.3][phacorr >= 5.0 && phacorr <= 14.0] + [bin (X,Y)=32] +\end{verbatim} +In this case, CFITSIO (1) copies and uncompresses the FITS file from +the ftp site on the legacy machine, (2) moves to the 'EVENTS' +extension, (3) calculates a new column called 'phacorr', (4) selects +the rows in the table that have phacorr in the range 5 to 14, and +finally (5) bins the remaining rows on the X and Y column coordinates, +using a pixel size = 32 to create a 2D image. All this processing is +completely transparent to the application program, which simply sees +the final 2-D image in the primary array of the opened file. +\end{itemize} + +The full extended CFITSIO FITS file name can contain several different +components depending on the context. These components are described in +the following sections: + +\begin{verbatim} +When creating a new file: + filetype://BaseFilename(templateName)[compress] + +When opening an existing primary array or image HDU: + filetype://BaseFilename(outName)[HDUlocation][ImageSection] + +When opening an existing table HDU: + filetype://BaseFilename(outName)[HDUlocation][colFilter][rowFilter][binSpec] +\end{verbatim} +The filetype, BaseFilename, outName, HDUlocation, and ImageSection +components, if present, must be given in that order, but the colFilter, +rowFilter, and binSpec specifiers may follow in any order. Regardless +of the order, however, the colFilter specifier, if present, will be +processed first by CFITSIO, followed by the rowFilter specifier, and +finally by the binSpec specifier. + + +\section{Filetype} + +The type of file determines the medium on which the file is located +(e.g., disk or network) and, hence, which internal device driver is used by +CFITSIO to read and/or write the file. Currently supported types are + +\begin{verbatim} + file:// - file on local magnetic disk (default) + ftp:// - a readonly file accessed with the anonymous FTP protocol. + It also supports ftp://username:password@hostname/... + for accessing password-protected ftp sites. + http:// - a readonly file accessed with the HTTP protocol. It + does not support username:password like the ftp driver. + Proxy HTTP survers are supported using the http_proxy + environment variable. + root:// - uses the CERN root protocol for writing as well as + reading files over the network. + shmem:// - opens or creates a file which persists in the computer's + shared memory. + mem:// - opens a temporary file in core memory. The file + disappears when the program exits so this is mainly + useful for test purposes when a permanent output file + is not desired. +\end{verbatim} +If the filetype is not specified, then type file:// is assumed. +The double slashes '//' are optional and may be omitted in most cases. + + +\subsection{Notes about HTTP proxy servers} + +A proxy HTTP server may be used by defining the address (URL) and port +number of the proxy server with the http\_proxy environment variable. +For example + +\begin{verbatim} + setenv http_proxy http://heasarc.gsfc.nasa.gov:3128 +\end{verbatim} +will cause CFITSIO to use port 3128 on the heasarc proxy server whenever +reading a FITS file with HTTP. + + +\subsection{Notes about the root filetype} + +The original rootd server can be obtained from: +\verb-ftp://root.cern.ch/root/rootd.tar.gz- +but, for it to work correctly with CFITSIO one has to use a modified +version which supports a command to return the length of the file. +This modified version is available in rootd subdirectory +in the CFITSIO ftp area at + +\begin{verbatim} + ftp://legacy.gsfc.nasa.gov/software/fitsio/c/root/rootd.tar.gz. +\end{verbatim} + +This small server is started either by inetd when a client requests a +connection to a rootd server or by hand (i.e. from the command line). +The rootd server works with the ROOT TNetFile class. It allows remote +access to ROOT database files in either read or write mode. By default +TNetFile assumes port 432 (which requires rootd to be started as root). +To run rootd via inetd add the following line to /etc/services: + +\begin{verbatim} + rootd 432/tcp +\end{verbatim} +and to /etc/inetd.conf, add the following line: + +\begin{verbatim} + rootd stream tcp nowait root /user/rdm/root/bin/rootd rootd -i +\end{verbatim} +Force inetd to reread its conf file with \verb+kill -HUP +. +You can also start rootd by hand running directly under your private +account (no root system privileges needed). For example to start +rootd listening on port 5151 just type: \verb+rootd -p 5151+ +Notice that no \& is needed. Rootd will go into background by itself. + +\begin{verbatim} + Rootd arguments: + -i says we were started by inetd + -p port# specifies a different port to listen on + -d level level of debug info written to syslog + 0 = no debug (default) + 1 = minimum + 2 = medium + 3 = maximum +\end{verbatim} +Rootd can also be configured for anonymous usage (like anonymous ftp). +To setup rootd to accept anonymous logins do the following (while being +logged in as root): + +\begin{verbatim} + - Add the following line to /etc/passwd: + + rootd:*:71:72:Anonymous rootd:/var/spool/rootd:/bin/false + + where you may modify the uid, gid (71, 72) and the home directory + to suite your system. + + - Add the following line to /etc/group: + + rootd:*:72:rootd + + where the gid must match the gid in /etc/passwd. + + - Create the directories: + + mkdir /var/spool/rootd + mkdir /var/spool/rootd/tmp + chmod 777 /var/spool/rootd/tmp + + Where /var/spool/rootd must match the rootd home directory as + specified in the rootd /etc/passwd entry. + + - To make writeable directories for anonymous do, for example: + + mkdir /var/spool/rootd/pub + chown rootd:rootd /var/spool/rootd/pub +\end{verbatim} +That's all. Several additional remarks: you can login to an anonymous +server either with the names "anonymous" or "rootd". The password should +be of type user@host.do.main. Only the @ is enforced for the time +being. In anonymous mode the top of the file tree is set to the rootd +home directory, therefore only files below the home directory can be +accessed. Anonymous mode only works when the server is started via +inetd. + + +\subsection{Notes about the shmem filetype:} + +Shared memory files are currently supported on most Unix platforms, +where the shared memory segments are managed by the operating system +kernel and `live' independently of processes. They are not deleted (by +default) when the process which created them terminates, although they +will disappear if the system is rebooted. Applications can create +shared memory files in CFITSIO by calling: + +\begin{verbatim} + fit_create_file(&fitsfileptr, "shmem://h2", &status); +\end{verbatim} +where the root `file' names are currently restricted to be 'h0', 'h1', +'h2', 'h3', etc., up to a maximum number defined by the the value of +SHARED\_MAXSEG (equal to 16 by default). This is a prototype +implementation of the shared memory interface and a more robust +interface, which will have fewer restrictions on the number of files +and on their names, may be developed in the future. + +When opening an already existing FITS file in shared memory one calls +the usual CFITSIO routine: + +\begin{verbatim} + fits_open_file(&fitsfileptr, "shmem://h7", mode, &status) +\end{verbatim} +The file mode can be READWRITE or READONLY just as with disk files. +More than one process can operate on READONLY mode files at the same +time. CFITSIO supports proper file locking (both in READONLY and +READWRITE modes), so calls to fits\_open\_file may be locked out until +another other process closes the file. + +When an application is finished accessing a FITS file in a shared +memory segment, it may close it (and the file will remain in the +system) with fits\_close\_file, or delete it with fits\_delete\_file. +Physical deletion is postponed until the last process calls +ffclos/ffdelt. fits\_delete\_file tries to obtain a READWRITE lock on +the file to be deleted, thus it can be blocked if the object was not +opened in READWRITE mode. + +A shared memory management utility program called `smem', is included +with the CFITSIO distribution. It can be built by typing `make smem'; +then type `smem -h' to get a list of valid options. Executing smem +without any options causes it to list all the shared memory segments +currently residing in the system and managed by the shared memory +driver. To get a list of all the shared memory objects, run the system +utility program `ipcs [-a]'. + + +\section{Base Filename} + +The base filename is the name of the file optionally including the +director/subdirectory path, and in the case of `ftp', `http', and `root' +filetypes, the machine identifier. Examples: + +\begin{verbatim} + myfile.fits + !data.fits + /data/myfile.fits + fits.gsfc.nasa.gov/ftp/sampledata/myfile.fits.gz +\end{verbatim} + +When creating a new output file on magnetic disk (of type file://) if +the base filename begins with an exclamation point (!) then any +existing file with that same basename will be deleted prior to creating +the new FITS file. Otherwise if the file to be created already exists, +then CFITSIO will return an error and will not overwrite the existing +file. Note that the exclamation point, '!', is a special UNIX +character, so if it is used on the command line rather than entered at +a task prompt, it must be preceded by a backslash to force the UNIX +shell to pass it verbatim to the application program. + +If the output disk file name ends with the suffix '.gz', then CFITSIO +will compress the file using the gzip compression algorithm before +writing it to disk. This can reduce the amount of disk space used by +the file. Note that this feature requires that the uncompressed file +be constructed in memory before it is compressed and written to disk, +so it can fail if there is insufficient available memory. + +An input FITS file may be compressed with the gzip or Unix compress +algorithms, in which case CFITSIO will uncompress the file on the fly +into a temporary file (in memory or on disk). Compressed files may +only be opened with read-only permission. When specifying the name of +a compressed FITS file it is not necessary to append the file suffix +(e.g., `.gz' or `.Z'). If CFITSIO cannot find the input file name +without the suffix, then it will automatically search for a compressed +file with the same root name. In the case of reading ftp and http type +files, CFITSIO generally looks for a compressed version of the file +first, before trying to open the uncompressed file. By default, +CFITSIO copies (and uncompressed if necessary) the ftp or http FITS +file into memory on the local machine before opening it. This will +fail if the local machine does not have enough memory to hold the whole +FITS file, so in this case, the output filename specifier (see the next +section) can be used to further control how CFITSIO reads ftp and http +files. + +If the input file is an IRAF image file (*.imh file) then CFITSIO will +automatically convert it on the fly into a virtual FITS image before it +is opened by the application program. IRAF images can only be opened +with READONLY file access. + +Similarly, if the input file is a raw binary data array, then CFITSIO +will convert it on the fly into a virtual FITS image with the basic set +of required header keywords before it is opened by the application +program (with READONLY access). In this case the data type and +dimensions of the image must be specified in square brackets following +the filename (e.g. rawfile.dat[ib512,512]). The first character (case +insensitive) defines the data type of the array: + +\begin{verbatim} + b 8-bit unsigned byte + i 16-bit signed integer + u 16-bit unsigned integer + j 32-bit signed integer + r or f 32-bit floating point + d 64-bit floating point +\end{verbatim} +An optional second character specifies the byte order of the array +values: b or B indicates big endian (as in FITS files and the native +format of SUN UNIX workstations and Mac PCs) and l or L indicates +little endian (native format of DEC OSF workstations and IBM PCs). If +this character is omitted then the array is assumed to have the native +byte order of the local machine. These data type characters are then +followed by a series of one or more integer values separated by commas +which define the size of each dimension of the raw array. Arrays with +up to 5 dimensions are currently supported. Finally, a byte offset to +the position of the first pixel in the data file may be specified by +separating it with a ':' from the last dimension value. If omitted, it +is assumed that the offset = 0. This parameter may be used to skip +over any header information in the file that precedes the binary data. +Further examples: + +\begin{verbatim} + raw.dat[b10000] 1-dimensional 10000 pixel byte array + raw.dat[rb400,400,12] 3-dimensional floating point big-endian array + img.fits[ib512,512:2880] reads the 512 x 512 short integer array in + a FITS file, skipping over the 2880 byte header +\end{verbatim} + +One special case of input file is where the filename = `-' (a dash or +minus sign) or 'stdin' or 'stdout', which signifies that the input file +is to be read from the stdin stream, or written to the stdout stream if +a new output file is being created. In the case of reading from stdin, +CFITSIO first copies the whole stream into a temporary FITS file (in +memory or on disk), and subsequent reading of the FITS file occurs in +this copy. When writing to stdout, CFITSIO first constructs the whole +file in memory (since random access is required), then flushes it out +to the stdout stream when the file is closed. In addition, if the +output filename = '-.gz' or 'stdout.gz' then it will be gzip compressed +before being written to stdout. + +This ability to read and write on the stdin and stdout steams allows +FITS files to be piped between tasks in memory rather than having to +create temporary intermediate FITS files on disk. For example if task1 +creates an output FITS file, and task2 reads an input FITS file, the +FITS file may be piped between the 2 tasks by specifying + +\begin{verbatim} + task1 - | task2 - +\end{verbatim} +where the vertical bar is the Unix piping symbol. This assumes that the 2 +tasks read the name of the FITS file off of the command line. + + +\section{Output File Name when Opening an Existing File} + +An optional output filename may be specified in parentheses immediately +following the base file name to be opened. This is mainly useful in +those cases where CFITSIO creates a temporary copy of the input FITS +file before it is opened and passed to the application program. This +happens by default when opening a network FTP or HTTP-type file, when +reading a compressed FITS file on a local disk, when reading from the +stdin stream, or when a column filter, row filter, or binning specifier +is included as part of the input file specification. By default this +temporary file is created in memory. If there is not enough memory to +create the file copy, then CFITSIO will exit with an error. In these +cases one can force a permanent file to be created on disk, instead of +a temporary file in memory, by supplying the name in parentheses +immediately following the base file name. The output filename can +include the '!' clobber flag. + +Thus, if the input filename to CFITSIO is: +\verb+file1.fits.gz(file2.fits)+ +then CFITSIO will uncompress `file1.fits.gz' into the local disk file +`file2.fits' before opening it. CFITSIO does not automatically delete +the output file, so it will still exist after the application program +exits. + +The output filename "mem://" is also allowed, which will write the +output file into memory, and also allow write access to the file. This +'file' will disappear when it is closed, but this may be useful for +some applications which only need to modify a temporary copy of the file. + +In some cases, several different temporary FITS files will be created +in sequence, for instance, if one opens a remote file using FTP, then +filters rows in a binary table extension, then create an image by +binning a pair of columns. In this case, the remote file will be +copied to a temporary local file, then a second temporary file will be +created containing the filtered rows of the table, and finally a third +temporary file containing the binned image will be created. In cases +like this where multiple files are created, the outfile specifier will +be interpreted the name of the final file as described below, in descending +priority: + +\begin{itemize} +\item +as the name of the final image file if an image within a single binary +table cell is opened or if an image is created by binning a table column. +\item +as the name of the file containing the filtered table if a column filter +and/or a row filter are specified. +\item +as the name of the local copy of the remote FTP or HTTP file. +\item +as the name of the uncompressed version of the FITS file, if a +compressed FITS file on local disk has been opened. +\item +otherwise, the output filename is ignored. +\end{itemize} + +The output file specifier is useful when reading FTP or HTTP-type +FITS files since it can be used to create a local disk copy of the file +that can be reused in the future. If the output file name = `*' then a +local file with the same name as the network file will be created. +Note that CFITSIO will behave differently depending on whether the +remote file is compressed or not as shown by the following examples: +\begin{itemize} +\item +\verb+ftp://remote.machine/tmp/myfile.fits.gz(*)+ - the remote compressed +file is copied to the local compressed file `myfile.fits.gz', which +is then uncompressed in local memory before being opened and passed +to the application program. + +\item +\verb+ftp://remote.machine/tmp/myfile.fits.gz(myfile.fits)+ - the +remote compressed file is copied and uncompressed into the local file +`myfile.fits'. This example requires less local memory than the +previous example since the file is uncompressed on disk instead of in +memory. + +\item +\verb+ftp://remote.machine/tmp/myfile.fits(myfile.fits.gz)+ - this will +usually produce an error since CFITSIO itself cannot compress files. +\end{itemize} + +The exact behavior of CFITSIO in the latter case depends on the type of +ftp server running on the remote machine and how it is configured. In +some cases, if the file `myfile.fits.gz' exists on the remote machine, +then the server will copy it to the local machine. In other cases the +ftp server will automatically create and transmit a compressed version +of the file if only the uncompressed version exists. This can get +rather confusing, so users should use a certain amount of caution when +using the output file specifier with FTP or HTTP file types, to make +sure they get the behavior that they expect. + + +\section{Template File Name when Creating a New File} + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described in the following Template Files chapter. + + +\section{Image Tile-Compression Specification} + +When specifying the name of the output FITS file to be created, the +user can indicate that images should be written in tile-compressed +format (see section 5.5, ``Primary Array or IMAGE Extension I/O +Routines'') by enclosing the compression parameters in square brackets +following the root disk file name. Here are some examples of the +syntax for specifying tile-compressed output images: + +\begin{verbatim} + myfile.fit[compress] - use Rice algorithm and default tile size + + myfile.fit[compress GZIP] - use the specified compression algorithm; + myfile.fit[compress Rice] only the first letter of the algorithm + myfile.fit[compress PLIO] name is required. + + myfile.fit[compress Rice 100,100] - use 100 x 100 pixel tile size + myfile.fit[compress Rice 100,100;2] - as above, and use noisebits = 2 +\end{verbatim} + + +\section{HDU Location Specification} + +The optional HDU location specifier defines which HDU (Header-Data +Unit, also known as an `extension') within the FITS file to initially +open. It must immediately follow the base file name (or the output +file name if present). If it is not specified then the first HDU (the +primary array) is opened. The HDU location specifier is required if +the colFilter, rowFilter, or binSpec specifiers are present, because +the primary array is not a valid HDU for these operations. The HDU may +be specified either by absolute position number, starting with 0 for +the primary array, or by reference to the HDU name, and optionally, the +version number and the HDU type of the desired extension. The location +of an image within a single cell of a binary table may also be +specified, as described below. + +The absolute position of the extension is specified either by enclosed +the number in square brackets (e.g., `[1]' = the first extension +following the primary array) or by preceded the number with a plus sign +(`+1'). To specify the HDU by name, give the name of the desired HDU +(the value of the EXTNAME or HDUNAME keyword) and optionally the +extension version number (value of the EXTVER keyword) and the +extension type (value of the XTENSION keyword: IMAGE, ASCII or TABLE, +or BINTABLE), separated by commas and all enclosed in square brackets. +If the value of EXTVER and XTENSION are not specified, then the first +extension with the correct value of EXTNAME is opened. The extension +name and type are not case sensitive, and the extension type may be +abbreviated to a single letter (e.g., I = IMAGE extension or primary +array, A or T = ASCII table extension, and B = binary table BINTABLE +extension). If the HDU location specifier is equal to `[PRIMARY]' or +`[P]', then the primary array (the first HDU) will be opened. + +FITS images are most commonly stored in the primary array or an image +extension, but images can also be stored as a vector in a single cell +of a binary table (i.e. each row of the vector column contains a +different image). Such an image can be opened with CFITSIO by +specifying the desired column name and the row number after the binary +table HDU specifier as shown in the following examples. The column name +is separated from the HDU specifier by a semicolon and the row number +is enclosed in parentheses. In this case CFITSIO copies the image from +the table cell into a temporary primary array before it is opened. The +application program then just sees the image in the primary array, +without any extensions. The particular row to be opened may be +specified either by giving an absolute integer row number (starting +with 1 for the first row), or by specifying a boolean expression that +evaluates to TRUE for the desired row. The first row that satisfies +the expression will be used. The row selection expression has the same +syntax as described in the Row Filter Specifier section, below. + + Examples: + +\begin{verbatim} + myfile.fits[3] - open the 3rd HDU following the primary array + myfile.fits+3 - same as above, but using the FTOOLS-style notation + myfile.fits[EVENTS] - open the extension that has EXTNAME = 'EVENTS' + myfile.fits[EVENTS, 2] - same as above, but also requires EXTVER = 2 + myfile.fits[events,2,b] - same, but also requires XTENSION = 'BINTABLE' + myfile.fits[3; images(17)] - opens the image in row 17 of the 'images' + column in the 3rd extension of the file. + myfile.fits[3; images(exposure > 100)] - as above, but opens the image + in the first row that has an 'exposure' column value + greater than 100. +\end{verbatim} + + +\section{Image Section} + +A virtual file containing a rectangular subsection of an image can be +extracted and opened by specifying the range of pixels (start:end) +along each axis to be extracted from the original image. One can also +specify an optional pixel increment (start:end:step) for each axis of +the input image. A pixel step = 1 will be assumed if it is not +specified. If the start pixel is larger then the end pixel, then the +image will be flipped (producing a mirror image) along that dimension. +An asterisk, '*', may be used to specify the entire range of an axis, +and '-*' will flip the entire axis. The input image can be in the +primary array, in an image extension, or contained in a vector cell of +a binary table. In the later 2 cases the extension name or number must +be specified before the image section specifier. + + Examples: + +\begin{verbatim} + myfile.fits[1:512:2, 2:512:2] - open a 256x256 pixel image + consisting of the odd numbered columns (1st axis) and + the even numbered rows (2nd axis) of the image in the + primary array of the file. + + myfile.fits[*, 512:256] - open an image consisting of all the columns + in the input image, but only rows 256 through 512. + The image will be flipped along the 2nd axis since + the starting pixel is greater than the ending pixel. + + myfile.fits[*:2, 512:256:2] - same as above but keeping only + every other row and column in the input image. + + myfile.fits[-*, *] - copy the entire image, flipping it along + the first axis. + + myfile.fits[3][1:256,1:256] - opens a subsection of the image that + is in the 3rd extension of the file. + + myfile.fits[4; images(12)][1:10,1:10] - open an image consisting + of the first 10 pixels in both dimensions. The original + image resides in the 12th row of the 'images' vector + column in the table in the 4th extension of the file. +\end{verbatim} + +When CFITSIO opens an image section it first creates a temporary file +containing the image section plus a copy of any other HDUs in the +file. This temporary file is then opened by the application program, +so it is not possible to write to or modify the input file when +specifying an image section. Note that CFITSIO automatically updates +the world coordinate system keywords in the header of the image +section, if they exist, so that the coordinate associated with each +pixel in the image section will be computed correctly. + + +\section{Column and Keyword Filtering Specification} + +The optional column/keyword filtering specifier is used to modify the +column structure and/or the header keywords in the HDU that was +selected with the previous HDU location specifier. This filtering +specifier must be enclosed in square brackets and can be distinguished +from a general row filter specifier (described below) by the fact that +it begins with the string 'col ' and is not immediately followed by an +equals sign. The original file is not changed by this filtering +operation, and instead the modifications are made on a copy of the +input FITS file (usually in memory), which also contains a copy of all +the other HDUs in the file. This temporary file is passed to the +application program and will persist only until the file is closed or +until the program exits, unless the outfile specifier (see above) is +also supplied. + +The column/keyword filter can be used to perform the following +operations. More than one operation may be specified by separating +them with semi-colons. + +\begin{itemize} + +\item +Copy only a specified list of columns columns to the filtered input file. +The list of column name should be separated by semi-colons. Wild card +characters may be used in the column names to match multiple columns. +If the expression contains both a list of columns to be included and +columns to be deleted, then all the columns in the original table +except the explicitly deleted columns will appear in the filtered +table (i.e., there is no need to explicitly list the columns to +be included if any columns are being deleted). + +\item +Delete a column or keyword by listing the name preceded by a minus sign +or an exclamation mark (!), e.g., '-TIME' will delete the TIME column +if it exists, otherwise the TIME keyword. An error is returned if +neither a column nor keyword with this name exists. Note that the +exclamation point, '!', is a special UNIX character, so if it is used +on the command line rather than entered at a task prompt, it must be +preceded by a backslash to force the UNIX shell to ignore it. + +\item +Rename an existing column or keyword with the syntax 'NewName == +OldName'. An error is returned if neither a column nor keyword with +this name exists. + +\item +Append a new column or keyword to the table. To create a column, +give the new name, optionally followed by the data type in parentheses, +followed by a single equals sign and an expression to be used to +compute the value (e.g., 'newcol(1J) = 0' will create a new 32-bit +integer column called 'newcol' filled with zeros). The data type is +specified using the same syntax that is allowed for the value of the +FITS TFORMn keyword (e.g., 'I', 'J', 'E', 'D', etc. for binary tables, +and 'I8', F12.3', 'E20.12', etc. for ASCII tables). If the data type is +not specified then an appropriate data type will be chosen depending on +the form of the expression (may be a character string, logical, bit, long +integer, or double column). An appropriate vector count (in the case +of binary tables) will also be added if not explicitly specified. + +When creating a new keyword, the keyword name must be preceded by a +pound sign '\#', and the expression must evaluate to a scalar +(i.e., cannot have a column name in the expression). The comment +string for the keyword may be specified in parentheses immediately +following the keyword name (instead of supplying a data type as in +the case of creating a new column). + +\item +Recompute (overwrite) the values in an existing column or keyword by +giving the name followed by an equals sign and an arithmetic +expression. +\end{itemize} + +The expression that is used when appending or recomputing columns or +keywords can be arbitrarily complex and may be a function of other +header keyword values and other columns (in the same row). The full +syntax and available functions for the expression are described below +in the row filter specification section. + + +For complex or commonly used operations, one can also place the +operations into an external text file and import it into the column +filter using the syntax '[col @filename.txt]'. The operations can +extend over multiple lines of the file, but multiple operations must +still be separated by semicolons. Any lines in the external text file +that begin with 2 slash characters ('//') will be ignored and may be +used to add comments into the file. + +Examples: + +\begin{verbatim} + [col Time;rate] - only the Time and rate columns will + appear in the filtered input file. + + [col Time;*raw] - include the Time column and any other + columns whose name ends with 'raw'. + + [col -TIME; Good == STATUS] - deletes the TIME column and + renames the status column to 'Good' + + [col PI=PHA * 1.1 + 0.2] - creates new PI column from PHA values + + [col rate = rate/exposure] - recomputes the rate column by dividing + it by the EXPOSURE keyword value. +\end{verbatim} + + +\section{Row Filtering Specification} + + When entering the name of a FITS table that is to be opened by a + program, an optional row filter may be specified to select a subset + of the rows in the table. A temporary new FITS file is created on + the fly which contains only those rows for which the row filter + expression evaluates to true. (The primary array and any other + extensions in the input file are also copied to the temporary + file). The original FITS file is closed and the new virtual file + is opened by the application program. The row filter expression is + enclosed in square brackets following the file name and extension + name (e.g., 'file.fits[events][GRADE==50]' selects only those rows + where the GRADE column value equals 50). When dealing with tables + where each row has an associated time and/or 2D spatial position, + the row filter expression can also be used to select rows based on + the times in a Good Time Intervals (GTI) extension, or on spatial + position as given in a SAO-style region file. + + +\subsection{General Syntax} + + The row filtering expression can be an arbitrarily complex series + of operations performed on constants, keyword values, and column + data taken from the specified FITS TABLE extension. The expression + must evaluate to a boolean value for each row of the table, where + a value of FALSE means that the row will be excluded. + + For complex or commonly used filters, one can place the expression + into a text file and import it into the row filter using the syntax + '[@filename.txt]'. The expression can be arbitrarily complex and + extend over multiple lines of the file. Any lines in the external + text file that begin with 2 slash characters ('//') will be ignored + and may be used to add comments into the file. + + Keyword and column data are referenced by name. Any string of + characters not surrounded by quotes (ie, a constant string) or + followed by an open parentheses (ie, a function name) will be + initially interpreted as a column name and its contents for the + current row inserted into the expression. If no such column exists, + a keyword of that name will be searched for and its value used, if + found. To force the name to be interpreted as a keyword (in case + there is both a column and keyword with the same name), precede the + keyword name with a single pound sign, '\#', as in '\#NAXIS2'. Due to + the generalities of FITS column and keyword names, if the column or + keyword name contains a space or a character which might appear as + an arithmetic term then inclose the name in '\$' characters as in + \$MAX PHA\$ or \#\$MAX-PHA\$. Names are case insensitive. + + To access a table entry in a row other than the current one, follow + the column's name with a row offset within curly braces. For + example, 'PHA\{-3\}' will evaluate to the value of column PHA, 3 rows + above the row currently being processed. One cannot specify an + absolute row number, only a relative offset. Rows that fall outside + the table will be treated as undefined, or NULLs. + + Boolean operators can be used in the expression in either their + Fortran or C forms. The following boolean operators are available: + +\begin{verbatim} + "equal" .eq. .EQ. == "not equal" .ne. .NE. != + "less than" .lt. .LT. < "less than/equal" .le. .LE. <= =< + "greater than" .gt. .GT. > "greater than/equal" .ge. .GE. >= => + "or" .or. .OR. || "and" .and. .AND. && + "negation" .not. .NOT. ! "approx. equal(1e-7)" ~ +\end{verbatim} + +Note that the exclamation +point, '!', is a special UNIX character, so if it is used on the +command line rather than entered at a task prompt, it must be preceded +by a backslash to force the UNIX shell to ignore it. + + The expression may also include arithmetic operators and functions. + Trigonometric functions use radians, not degrees. The following + arithmetic operators and functions can be used in the expression + (function names are case insensitive). A null value will be returned + in case of illegal operations such as divide by zero, sqrt(negative) + log(negative), log10(negative), arccos(.gt. 1), arcsin(.gt. 1). + + +\begin{verbatim} + "addition" + "subtraction" - + "multiplication" * "division" / + "negation" - "exponentiation" ** ^ + "absolute value" abs(x) "cosine" cos(x) + "sine" sin(x) "tangent" tan(x) + "arc cosine" arccos(x) "arc sine" arcsin(x) + "arc tangent" arctan(x) "arc tangent" arctan2(x,y) + "hyperbolic cos" cosh(x) "hyperbolic sin" sinh(x) + "hyperbolic tan" tanh(x) "round to nearest int" round(x) + "round down to int" floor(x) "round up to int" ceil(x) + "exponential" exp(x) "square root" sqrt(x) + "natural log" log(x) "common log" log10(x) + "modulus" i % j "random # [0.0,1.0)" random() + "minimum" min(x,y) "maximum" max(x,y) + "cumulative sum" accum(x) "sequential difference" seqdiff(x) + "if-then-else" b?x:y +\end{verbatim} + + An alternate syntax for the min and max functions has only a single + argument which should be a vector value (see below). The result + will be the minimum/maximum element contained within the vector. + + The accum(x) function forms the cumulative sum of x, element by element. + Vector columns are supported simply by performing the summation process + through all the values. Null values are treated as 0. The seqdiff(x) + function forms the sequential difference of x, element by element. + The first value of seqdiff is the first value of x. A single null + value in x causes a pair of nulls in the output. The seqdiff and + accum functions are functional inverses, i.e., seqdiff(accum(x)) == x + as long as no null values are present. + + The following type casting operators are available, where the + inclosing parentheses are required and taken from the C language + usage. Also, the integer to real casts values to double precision: + +\begin{verbatim} + "real to integer" (int) x (INT) x + "integer to real" (float) i (FLOAT) i +\end{verbatim} + + In addition, several constants are built in for use in numerical + expressions: + + +\begin{verbatim} + #pi 3.1415... #e 2.7182... + #deg #pi/180 #row current row number + #null undefined value #snull undefined string +\end{verbatim} + + A string constant must be enclosed in quotes as in 'Crab'. The + "null" constants are useful for conditionally setting table values + to a NULL, or undefined, value (eg., "col1==-99 ? \#NULL : col1"). + + There is also a function for testing if two values are close to + each other, i.e., if they are "near" each other to within a user + specified tolerance. The arguments, value\_1 and value\_2 can be + integer or real and represent the two values who's proximity is + being tested to be within the specified tolerance, also an integer + or real: + +\begin{verbatim} + near(value_1, value_2, tolerance) +\end{verbatim} + When a NULL, or undefined, value is encountered in the FITS table, + the expression will evaluate to NULL unless the undefined value is + not actually required for evaluation, e.g. "TRUE .or. NULL" + evaluates to TRUE. The following two functions allow some NULL + detection and handling: + +\begin{verbatim} + "a null value?" ISNULL(x) + "define a value for null" DEFNULL(x,y) +\end{verbatim} + The former + returns a boolean value of TRUE if the argument x is NULL. The + later "defines" a value to be substituted for NULL values; it + returns the value of x if x is not NULL, otherwise it returns the + value of y. + + + + +\subsection{Bit Masks} + + Bit masks can be used to select out rows from bit columns (TFORMn = + \#X) in FITS files. To represent the mask, binary, octal, and hex + formats are allowed: + + +\begin{verbatim} + binary: b0110xx1010000101xxxx0001 + octal: o720x1 -> (b111010000xxx001) + hex: h0FxD -> (b00001111xxxx1101) +\end{verbatim} + + In all the representations, an x or X is allowed in the mask as a + wild card. Note that the x represents a different number of wild + card bits in each representation. All representations are case + insensitive. + + To construct the boolean expression using the mask as the boolean + equal operator described above on a bit table column. For example, + if you had a 7 bit column named flags in a FITS table and wanted + all rows having the bit pattern 0010011, the selection expression + would be: + + +\begin{verbatim} + flags == b0010011 + or + flags .eq. b10011 +\end{verbatim} + + It is also possible to test if a range of bits is less than, less + than equal, greater than and greater than equal to a particular + boolean value: + + +\begin{verbatim} + flags <= bxxx010xx + flags .gt. bxxx100xx + flags .le. b1xxxxxxx +\end{verbatim} + + Notice the use of the x bit value to limit the range of bits being + compared. + + It is not necessary to specify the leading (most significant) zero + (0) bits in the mask, as shown in the second expression above. + + Bit wise AND, OR and NOT operations are also possible on two or + more bit fields using the '\&'(AND), '$|$'(OR), and the '!'(NOT) + operators. All of these operators result in a bit field which can + then be used with the equal operator. For example: + + +\begin{verbatim} + (!flags) == b1101100 + (flags & b1000001) == bx000001 +\end{verbatim} + + Bit fields can be appended as well using the '+' operator. Strings + can be concatenated this way, too. + + +\subsection{Vector Columns} + + Vector columns can also be used in building the expression. No + special syntax is required if one wants to operate on all elements + of the vector. Simply use the column name as for a scalar column. + Vector columns can be freely intermixed with scalar columns or + constants in virtually all expressions. The result will be of the + same dimension as the vector. Two vectors in an expression, though, + need to have the same number of elements and have the same + dimensions. The only places a vector column cannot be used (for + now, anyway) are the SAO region functions and the NEAR boolean + function. + + Arithmetic and logical operations are all performed on an element by + element basis. Comparing two vector columns, eg "COL1 == COL2", + thus results in another vector of boolean values indicating which + elements of the two vectors are equal. + + Eight functions are available that operate on a vector and return a + scalar result: + +\begin{verbatim} + "minimum" MIN(V) "maximum" MAX(V) + "average" AVERAGE(V) "median" MEDIAN(V) + "sumation" SUM(V) "standard deviation" STDDEV(V) + "# of values" NELEM(V) "# of non-null values" NVALID(V) +\end{verbatim} + where V represents the name of a vector column or a manually + constructed vector using curly brackets as described below. The + first 6 of these functions ignore any null values in the vector when + computing the result. + + The SUM function literally sums all the elements in x, returning a + scalar value. If V is a boolean vector, SUM returns the number + of TRUE elements. The NELEM function returns the number of elements + in vector V whereas NVALID return the number of non-null elements in + the vector. (NELEM also operates on bit and string columns, + returning their column widths.) As an example, to test whether all + elements of two vectors satisfy a given logical comparison, one can + use the expression + +\begin{verbatim} + SUM( COL1 > COL2 ) == NELEM( COL1 ) +\end{verbatim} + + which will return TRUE if all elements of COL1 are greater than + their corresponding elements in COL2. + + To specify a single element of a vector, give the column name + followed by a comma-separated list of coordinates enclosed in + square brackets. For example, if a vector column named PHAS exists + in the table as a one dimensional, 256 component list of numbers + from which you wanted to select the 57th component for use in the + expression, then PHAS[57] would do the trick. Higher dimensional + arrays of data may appear in a column. But in order to interpret + them, the TDIMn keyword must appear in the header. Assuming that a + (4,4,4,4) array is packed into each row of a column named ARRAY4D, + the (1,2,3,4) component element of each row is accessed by + ARRAY4D[1,2,3,4]. Arrays up to dimension 5 are currently + supported. Each vector index can itself be an expression, although + it must evaluate to an integer value within the bounds of the + vector. Vector columns which contain spaces or arithmetic operators + must have their names enclosed in "\$" characters as with + \$ARRAY-4D\$[1,2,3,4]. + + A more C-like syntax for specifying vector indices is also + available. The element used in the preceding example alternatively + could be specified with the syntax ARRAY4D[4][3][2][1]. Note the + reverse order of indices (as in C), as well as the fact that the + values are still ones-based (as in Fortran -- adopted to avoid + ambiguity for 1D vectors). With this syntax, one does not need to + specify all of the indices. To extract a 3D slice of this 4D + array, use ARRAY4D[4]. + + Variable-length vector columns are not supported. + + Vectors can be manually constructed within the expression using a + comma-separated list of elements surrounded by curly braces ('\{\}'). + For example, '\{1,3,6,1\}' is a 4-element vector containing the values + 1, 3, 6, and 1. The vector can contain only boolean, integer, and + real values (or expressions). The elements will be promoted to the + highest data type present. Any elements which are themselves + vectors, will be expanded out with each of its elements becoming an + element in the constructed vector. + + +\subsection{Good Time Interval Filtering} + + A common filtering method involves selecting rows which have a time + value which lies within what is called a Good Time Interval or GTI. + The time intervals are defined in a separate FITS table extension + which contains 2 columns giving the start and stop time of each + good interval. The filtering operation accepts only those rows of + the input table which have an associated time which falls within + one of the time intervals defined in the GTI extension. A high + level function, gtifilter(a,b,c,d), is available which evaluates + each row of the input table and returns TRUE or FALSE depending + whether the row is inside or outside the good time interval. The + syntax is + +\begin{verbatim} + gtifilter( [ "gtifile" [, expr [, "STARTCOL", "STOPCOL" ] ] ] ) + or + gtifilter( [ 'gtifile' [, expr [, 'STARTCOL', 'STOPCOL' ] ] ] ) +\end{verbatim} + where each "[]" demarks optional parameters. Note that the quotes + around the gtifile and START/STOP column are required. Either single + or double quotes may be used. In cases where this expression is + entered on the Unix command line, enclose the entire expression in + double quotes, and then use single quotes within the expression to + enclose the 'gtifile' and other terms. It is also usually possible + to do the reverse, and enclose the whole expression in single quotes + and then use double quotes within the expression. The gtifile, + if specified, can be blank ("") which will mean to use the first + extension with the name "*GTI*" in the current file, a plain + extension specifier (eg, "+2", "[2]", or "[STDGTI]") which will be + used to select an extension in the current file, or a regular + filename with or without an extension specifier which in the latter + case will mean to use the first extension with an extension name + "*GTI*". Expr can be any arithmetic expression, including simply + the time column name. A vector time expression will produce a + vector boolean result. STARTCOL and STOPCOL are the names of the + START/STOP columns in the GTI extension. If one of them is + specified, they both must be. + + In its simplest form, no parameters need to be provided -- default + values will be used. The expression "gtifilter()" is equivalent to + +\begin{verbatim} + gtifilter( "", TIME, "*START*", "*STOP*" ) +\end{verbatim} + This will search the current file for a GTI extension, filter the + TIME column in the current table, using START/STOP times taken from + columns in the GTI extension with names containing the strings + "START" and "STOP". The wildcards ('*') allow slight variations in + naming conventions such as "TSTART" or "STARTTIME". The same + default values apply for unspecified parameters when the first one + or two parameters are specified. The function automatically + searches for TIMEZERO/I/F keywords in the current and GTI + extensions, applying a relative time offset, if necessary. + + +\subsection{Spatial Region Filtering} + + Another common filtering method selects rows based on whether the + spatial position associated with each row is located within a given + 2-dimensional region. The syntax for this high-level filter is + +\begin{verbatim} + regfilter( "regfilename" [ , Xexpr, Yexpr [ , "wcs cols" ] ] ) +\end{verbatim} + where each "[]" demarks optional parameters. The region file name + is required and must be enclosed in quotes. The remaining + parameters are optional. The region file is an ASCII text file + which contains a list of one or more geometric shapes (circle, + ellipse, box, etc.) which defines a region on the celestial sphere + or an area within a particular 2D image. The region file is + typically generated using an image display program such as fv/POW + (distribute by the HEASARC), or ds9 (distributed by the Smithsonian + Astrophysical Observatory). Users should refer to the documentation + provided with these programs for more details on the syntax used in + the region files. + + In its simpliest form, (e.g., regfilter("region.reg") ) the + coordinates in the default 'X' and 'Y' columns will be used to + determine if each row is inside or outside the area specified in + the region file. Alternate position column names, or expressions, + may be entered if needed, as in + +\begin{verbatim} + regfilter("region.reg", XPOS, YPOS) +\end{verbatim} + Region filtering can be applied most unambiguously if the positions + in the region file and in the table to be filtered are both give in + terms of absolute celestial coordinate units. In this case the + locations and sizes of the geometric shapes in the region file are + specified in angular units on the sky (e.g., positions given in + R.A. and Dec. and sizes in arcseconds or arcminutes). Similarly, + each row of the filtered table will have a celestial coordinate + associated with it. This association is usually implemented using + a set of so-called 'World Coordinate System' (or WCS) FITS keywords + that define the coordinate transformation that must be applied to + the values in the 'X' and 'Y' columns to calculate the coordinate. + + Alternatively, one can perform spatial filtering using unitless + 'pixel' coordinates for the regions and row positions. In this + case the user must be careful to ensure that the positions in the 2 + files are self-consistent. A typical problem is that the region + file may be generated using a binned image, but the unbinned + coordinates are given in the event table. The ROSAT events files, + for example, have X and Y pixel coordinates that range from 1 - + 15360. These coordinates are typically binned by a factor of 32 to + produce a 480x480 pixel image. If one then uses a region file + generated from this image (in image pixel units) to filter the + ROSAT events file, then the X and Y column values must be converted + to corresponding pixel units as in: + +\begin{verbatim} + regfilter("rosat.reg", X/32.+.5, Y/32.+.5) +\end{verbatim} + Note that this binning conversion is not necessary if the region + file is specified using celestial coordinate units instead of pixel + units because CFITSIO is then able to directly compare the + celestial coordinate of each row in the table with the celestial + coordinates in the region file without having to know anything + about how the image may have been binned. + + The last "wcs cols" parameter should rarely be needed. If supplied, + this string contains the names of the 2 columns (space or comma + separated) which have the associated WCS keywords. If not supplied, + the filter will scan the X and Y expressions for column names. + If only one is found in each expression, those columns will be + used, otherwise an error will be returned. + + These region shapes are supported (names are case insensitive): + +\begin{verbatim} + Point ( X1, Y1 ) <- One pixel square region + Line ( X1, Y1, X2, Y2 ) <- One pixel wide region + Polygon ( X1, Y1, X2, Y2, ... ) <- Rest are interiors with + Rectangle ( X1, Y1, X2, Y2, A ) | boundaries considered + Box ( Xc, Yc, Wdth, Hght, A ) V within the region + Diamond ( Xc, Yc, Wdth, Hght, A ) + Circle ( Xc, Yc, R ) + Annulus ( Xc, Yc, Rin, Rout ) + Ellipse ( Xc, Yc, Rx, Ry, A ) + Elliptannulus ( Xc, Yc, Rinx, Riny, Routx, Routy, Ain, Aout ) + Sector ( Xc, Yc, Amin, Amax ) +\end{verbatim} + where (Xc,Yc) is the coordinate of the shape's center; (X\#,Y\#) are + the coordinates of the shape's edges; Rxxx are the shapes' various + Radii or semimajor/minor axes; and Axxx are the angles of rotation + (or bounding angles for Sector) in degrees. For rotated shapes, the + rotation angle can be left off, indicating no rotation. Common + alternate names for the regions can also be used: rotbox = box; + rotrectangle = rectangle; (rot)rhombus = (rot)diamond; and pie + = sector. When a shape's name is preceded by a minus sign, '-', + the defined region is instead the area *outside* its boundary (ie, + the region is inverted). All the shapes within a single region + file are OR'd together to create the region, and the order is + significant. The overall way of looking at region files is that if + the first region is an excluded region then a dummy included region + of the whole detector is inserted in the front. Then each region + specification as it is processed overrides any selections inside of + that region specified by previous regions. Another way of thinking + about this is that if a previous excluded region is completely + inside of a subsequent included region the excluded region is + ignored. + + The positional coordinates may be given either in pixel units, + decimal degrees or hh:mm:ss.s, dd:mm:ss.s units. The shape sizes + may be given in pixels, degrees, arcminutes, or arcseconds. Look + at examples of region file produced by fv/POW or ds9 for further + details of the region file format. + + There are three functions that are primarily for use with SAO region + files and the FSAOI task, but they can be used directly. They + return a boolean true or false depending on whether a two + dimensional point is in the region or not: + +\begin{verbatim} + "point in a circular region" + circle(xcntr,ycntr,radius,Xcolumn,Ycolumn) + + "point in an elliptical region" + ellipse(xcntr,ycntr,xhlf_wdth,yhlf_wdth,rotation,Xcolumn,Ycolumn) + + "point in a rectangular region" + box(xcntr,ycntr,xfll_wdth,yfll_wdth,rotation,Xcolumn,Ycolumn) + + where + (xcntr,ycntr) are the (x,y) position of the center of the region + (xhlf_wdth,yhlf_wdth) are the (x,y) half widths of the region + (xfll_wdth,yfll_wdth) are the (x,y) full widths of the region + (radius) is half the diameter of the circle + (rotation) is the angle(degrees) that the region is rotated with + respect to (xcntr,ycntr) + (Xcoord,Ycoord) are the (x,y) coordinates to test, usually column + names + NOTE: each parameter can itself be an expression, not merely a + column name or constant. +\end{verbatim} + + +\subsection{Example Row Filters} + +\begin{verbatim} + [ binary && mag <= 5.0] - Extract all binary stars brighter + than fifth magnitude (note that + the initial space is necessary to + prevent it from being treated as a + binning specification) + + [#row >= 125 && #row <= 175] - Extract row numbers 125 through 175 + + [IMAGE[4,5] .gt. 100] - Extract all rows that have the + (4,5) component of the IMAGE column + greater than 100 + + [abs(sin(theta * #deg)) < 0.5] - Extract all rows having the + absolute value of the sine of theta + less than a half where the angles + are tabulated in degrees + + [SUM( SPEC > 3*BACKGRND )>=1] - Extract all rows containing a + spectrum, held in vector column + SPEC, with at least one value 3 + times greater than the background + level held in a keyword, BACKGRND + + [VCOL=={1,4,2}] - Extract all rows whose vector column + VCOL contains the 3-elements 1, 4, and + 2. + + [@rowFilter.txt] - Extract rows using the expression + contained within the text file + rowFilter.txt + + [gtifilter()] - Search the current file for a GTI + extension, filter the TIME + column in the current table, using + START/STOP times taken from + columns in the GTI extension + + [regfilter("pow.reg")] - Extract rows which have a coordinate + (as given in the X and Y columns) + within the spatial region specified + in the pow.reg region file. + + [regfilter("pow.reg", Xs, Ys)] - Same as above, except that the + Xs and Ys columns will be used to + determine the coordinate of each + row in the table. +\end{verbatim} + + +\section{ Binning or Histogramming Specification} + +The optional binning specifier is enclosed in square brackets and can +be distinguished from a general row filter specification by the fact +that it begins with the keyword 'bin' not immediately followed by an +equals sign. When binning is specified, a temporary N-dimensional FITS +primary array is created by computing the histogram of the values in +the specified columns of a FITS table extension. After the histogram +is computed the input FITS file containing the table is then closed and +the temporary FITS primary array is opened and passed to the +application program. Thus, the application program never sees the +original FITS table and only sees the image in the new temporary file +(which has no additional extensions). Obviously, the application +program must be expecting to open a FITS image and not a FITS table in +this case. + +The data type of the FITS histogram image may be specified by appending +'b' (for 8-bit byte), 'i' (for 16-bit integers), 'j' (for 32-bit +integer), 'r' (for 32-bit floating points), or 'd' (for 64-bit double +precision floating point) to the 'bin' keyword (e.g. '[binr X]' +creates a real floating point image). If the data type is not +explicitly specified then a 32-bit integer image will be created by +default, unless the weighting option is also specified in which case +the image will have a 32-bit floating point data type by default. + +The histogram image may have from 1 to 4 dimensions (axes), depending +on the number of columns that are specified. The general form of the +binning specification is: + +\begin{verbatim} + [bin{bijrd} Xcol=min:max:binsize, Ycol= ..., Zcol=..., Tcol=...; weight] +\end{verbatim} +in which up to 4 columns, each corresponding to an axis of the image, +are listed. The column names are case insensitive, and the column +number may be given instead of the name, preceded by a pound sign +(e.g., [bin \#4=1:512]). If the column name is not specified, then +CFITSIO will first try to use the 'preferred column' as specified by +the CPREF keyword if it exists (e.g., 'CPREF = 'DETX,DETY'), otherwise +column names 'X', 'Y', 'Z', and 'T' will be assumed for each of the 4 +axes, respectively. In cases where the column name could be confused +with an arithmetic expression, enclose the column name in parentheses to +force the name to be interpreted literally. + +Each column name may be followed by an equals sign and then the lower +and upper range of the histogram, and the size of the histogram bins, +separated by colons. Spaces are allowed before and after the equals +sign but not within the 'min:max:binsize' string. The min, max and +binsize values may be integer or floating point numbers, or they may be +the names of keywords in the header of the table. If the latter, then +the value of that keyword is substituted into the expression. + +Default values for the min, max and binsize quantities will be +used if not explicitly given in the binning expression as shown +in these examples: + +\begin{verbatim} + [bin x = :512:2] - use default minimum value + [bin x = 1::2] - use default maximum value + [bin x = 1:512] - use default bin size + [bin x = 1:] - use default maximum value and bin size + [bin x = :512] - use default minimum value and bin size + [bin x = 2] - use default minimum and maximum values + [bin x] - use default minimum, maximum and bin size + [bin 4] - default 2-D image, bin size = 4 in both axes + [bin] - default 2-D image +\end{verbatim} +CFITSIO will use the value of the TLMINn, TLMAXn, and TDBINn keywords, +if they exist, for the default min, max, and binsize, respectively. If +they do not exist then CFITSIO will use the actual minimum and maximum +values in the column for the histogram min and max values. The default +binsize will be set to 1, or (max - min) / 10., whichever is smaller, +so that the histogram will have at least 10 bins along each axis. + +A shortcut notation is allowed if all the columns/axes have the same +binning specification. In this case all the column names may be listed +within parentheses, followed by the (single) binning specification, as +in: + +\begin{verbatim} + [bin (X,Y)=1:512:2] + [bin (X,Y) = 5] +\end{verbatim} + +The optional weighting factor is the last item in the binning specifier +and, if present, is separated from the list of columns by a +semi-colon. As the histogram is accumulated, this weight is used to +incremented the value of the appropriated bin in the histogram. If the +weighting factor is not specified, then the default weight = 1 is +assumed. The weighting factor may be a constant integer or floating +point number, or the name of a keyword containing the weighting value. +Or the weighting factor may be the name of a table column in which case +the value in that column, on a row by row basis, will be used. + +In some cases, the column or keyword may give the reciprocal of the +actual weight value that is needed. In this case, precede the weight +keyword or column name by a slash '/' to tell CFITSIO to use the +reciprocal of the value when constructing the histogram. + +For complex or commonly used histograms, one can also place its +description into a text file and import it into the binning +specification using the syntax [bin @filename.txt]. The file's +contents can extend over multiple lines, although it must still +conform to the no-spaces rule for the min:max:binsize syntax and each +axis specification must still be comma-separated. Any lines in the +external text file that begin with 2 slash characters ('//') will be +ignored and may be used to add comments into the file. + + Examples: + + +\begin{verbatim} + [bini detx, dety] - 2-D, 16-bit integer histogram + of DETX and DETY columns, using + default values for the histogram + range and binsize + + [bin (detx, dety)=16; /exposure] - 2-D, 32-bit real histogram of DETX + and DETY columns with a bin size = 16 + in both axes. The histogram values + are divided by the EXPOSURE keyword + value. + + [bin time=TSTART:TSTOP:0.1] - 1-D lightcurve, range determined by + the TSTART and TSTOP keywords, + with 0.1 unit size bins. + + [bin pha, time=8000.:8100.:0.1] - 2-D image using default binning + of the PHA column for the X axis, + and 1000 bins in the range + 8000. to 8100. for the Y axis. + + [bin @binFilter.txt] - Use the contents of the text file + binFilter.txt for the binning + specifications. + +\end{verbatim} +\chapter{Template Files } + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described in the following sections. + + +\section{Detailed Template Line Format} + +The format of each ASCII template line closely follows the format of a +FITS keyword record: + +\begin{verbatim} + KEYWORD = KEYVALUE / COMMENT +\end{verbatim} +except that free format may be used (e.g., the equals sign may appear +at any position in the line) and TAB characters are allowed and are +treated the same as space characters. The KEYVALUE and COMMENT fields +are optional. The equals sign character is also optional, but it is +recommended that it be included for clarity. Any template line that +begins with the pound '\#' character is ignored by the template parser +and may be use to insert comments into the template file itself. + +The KEYWORD name field is limited to 8 characters in length and only +the letters A-Z, digits 0-9, and the hyphen and underscore characters +may be used, without any embedded spaces. Lowercase letters in the +template keyword name will be converted to uppercase. Leading spaces +in the template line preceding the keyword name are generally ignored, +except if the first 8 characters of a template line are all blank, then +the entire line is treated as a FITS comment keyword (with a blank +keyword name) and is copied verbatim into the FITS header. + +The KEYVALUE field may have any allowed FITS data type: character +string, logical, integer, real, complex integer, or complex real. The +character string values need not be enclosed in single quote characters +unless they are necessary to distinguish the string from a different +data type (e.g. 2.0 is a real but '2.0' is a string). The keyword has +an undefined (null) value if the template record only contains blanks +following the "=" or between the "=" and the "/" comment field +delimiter. + +String keyword values longer than 68 characters (the maximum length +that will fit in a single FITS keyword record) are permitted using the +CFITSIO long string convention. They can either be specified as a +single long line in the template, or by using multiple lines where the +continuing lines contain the 'CONTINUE' keyword, as in this example: + +\begin{verbatim} + LONGKEY = 'This is a long string value that is contin&' + CONTINUE 'ued over 2 records' / comment field goes here +\end{verbatim} +The format of template lines with CONTINUE keyword is very strict: 3 +spaces must follow CONTINUE and the rest of the line is copied verbatim +to the FITS file. + +The start of the optional COMMENT field must be preceded by "/", which +is used to separate it from the keyword value field. Exceptions are if +the KEYWORD name field contains COMMENT, HISTORY, CONTINUE, or if the +first 8 characters of the template line are blanks. + +More than one Header-Data Unit (HDU) may be defined in the template +file. The start of an HDU definition is denoted with a SIMPLE or +XTENSION template line: + +1) SIMPLE begins a Primary HDU definition. SIMPLE may only appear as +the first keyword in the template file. If the template file begins +with XTENSION instead of SIMPLE, then a default empty Primary HDU is +created, and the template is then assumed to define the keywords +starting with the first extension following the Primary HDU. + +2) XTENSION marks the beginning of a new extension HDU definition. The +previous HDU will be closed at this point and processing of the next +extension begins. + + +\section{Auto-indexing of Keywords} + +If a template keyword name ends with a "\#" character, it is said to be +'auto-indexed'. Each "\#" character will be replaced by the current +integer index value, which gets reset = 1 at the start of each new HDU +in the file (or 7 in the special case of a GROUP definition). The +FIRST indexed keyword in each template HDU definition is used as the +'incrementor'; each subsequent occurrence of this SAME keyword will +cause the index value to be incremented. This behavior can be rather +subtle, as illustrated in the following examples in which the TTYPE +keyword is the incrementor in both cases: + +\begin{verbatim} + TTYPE# = TIME + TFORM# = 1D + TTYPE# = RATE + TFORM# = 1E +\end{verbatim} +will create TTYPE1, TFORM1, TTYPE2, and TFORM2 keywords. But if the +template looks like, + +\begin{verbatim} + TTYPE# = TIME + TTYPE# = RATE + TFORM# = 1D + TFORM# = 1E +\end{verbatim} +this results in a FITS files with TTYPE1, TTYPE2, TFORM2, and TFORM2, +which is probably not what was intended! + + +\section{Template Parser Directives} + +In addition to the template lines which define individual keywords, the +template parser recognizes 3 special directives which are each preceded +by the backslash character: \verb+ \include, \group+, and \verb+ \end+. + +The 'include' directive must be followed by a filename. It forces the +parser to temporarily stop reading the current template file and begin +reading the include file. Once the parser reaches the end of the +include file it continues parsing the current template file. Include +files can be nested, and HDU definitions can span multiple template +files. + +The start of a GROUP definition is denoted with the 'group' directive, +and the end of a GROUP definition is denoted with the 'end' directive. +Each GROUP contains 0 or more member blocks (HDUs or GROUPs). Member +blocks of type GROUP can contain their own member blocks. The GROUP +definition itself occupies one FITS file HDU of special type (GROUP +HDU), so if a template specifies 1 group with 1 member HDU like: + +\begin{verbatim} +\group +grpdescr = 'demo' +xtension bintable +# this bintable has 0 cols, 0 rows +\end +\end{verbatim} +then the parser creates a FITS file with 3 HDUs : + +\begin{verbatim} +1) dummy PHDU +2) GROUP HDU (has 1 member, which is bintable in HDU number 3) +3) bintable (member of GROUP in HDU number 2) +\end{verbatim} +Technically speaking, the GROUP HDU is a BINTABLE with 6 columns. Applications +can define additional columns in a GROUP HDU using TFORMn and TTYPEn +(where n is 7, 8, ....) keywords or their auto-indexing equivalents. + +For a more complicated example of a template file using the group directives, +look at the sample.tpl file that is included in the CFITSIO distribution. + + +\section{Formal Template Syntax} + +The template syntax can formally be defined as follows: + +\begin{verbatim} + TEMPLATE = BLOCK [ BLOCK ... ] + + BLOCK = { HDU | GROUP } + + GROUP = \GROUP [ BLOCK ... ] \END + + HDU = XTENSION [ LINE ... ] { XTENSION | \GROUP | \END | EOF } + + LINE = [ KEYWORD [ = ] ] [ VALUE ] [ / COMMENT ] + + X ... - X can be present 1 or more times + { X | Y } - X or Y + [ X ] - X is optional +\end{verbatim} + +At the topmost level, the template defines 1 or more template blocks. Blocks +can be either HDU (Header Data Unit) or a GROUP. For each block the parser +creates 1 (or more for GROUPs) FITS file HDUs. + + + +\section{Errors} + +In general the fits\_execute\_template() function tries to be as atomic +as possible, so either everything is done or nothing is done. If an +error occurs during parsing of the template, fits\_execute\_template() +will (try to) delete the top level BLOCK (with all its children if any) +in which the error occurred, then it will stop reading the template file +and it will return with an error. + + +\section{Examples} + +1. This template file will create a 200 x 300 pixel image, with 4-byte +integer pixel values, in the primary HDU: + +\begin{verbatim} + SIMPLE = T + BITPIX = 32 + NAXIS = 2 / number of dimensions + NAXIS1 = 100 / length of first axis + NAXIS2 = 200 / length of second axis + OBJECT = NGC 253 / name of observed object +\end{verbatim} +The allowed values of BITPIX are 8, 16, 32, -32, or -64, +representing, respectively, 8-bit integer, 16-bit integer, 32-bit +integer, 32-bit floating point, or 64 bit floating point pixels. + +2. To create a FITS table, the template first needs to include +XTENSION = TABLE or BINTABLE to define whether it is an ASCII or binary +table, and NAXIS2 to define the number of rows in the table. Two +template lines are then needed to define the name (TTYPEn) and FITS data +format (TFORMn) of the columns, as in this example: + +\begin{verbatim} + xtension = bintable + naxis2 = 40 + ttype# = Name + tform# = 10a + ttype# = Npoints + tform# = j + ttype# = Rate + tunit# = counts/s + tform# = e +\end{verbatim} +The above example defines a null primary array followed by a 40-row +binary table extension with 3 columns called 'Name', 'Npoints', and +'Rate', with data formats of '10A' (ASCII character string), '1J' +(integer) and '1E' (floating point), respectively. Note that the other +required FITS keywords (BITPIX, NAXIS, NAXIS1, PCOUNT, GCOUNT, TFIELDS, +and END) do not need to be explicitly defined in the template because +their values can be inferred from the other keywords in the template. +This example also illustrates that the templates are generally +case-insensitive (the keyword names and TFORMn values are converted to +upper-case in the FITS file) and that string keyword values generally +do not need to be enclosed in quotes. + +\chapter{ Local FITS Conventions } + +CFITSIO supports several local FITS conventions which are not +defined in the official NOST FITS standard and which are not +necessarily recognized or supported by other FITS software packages. +Programmers should be cautious about using these features, especially +if the FITS files that are produced are expected to be processed by +other software systems which do not use the CFITSIO interface. + + +\section{64-Bit Long Integers} + +CFITSIO can read and write FITS images or table columns containing +64-bit integer data values. This data type is not recognized in the +official FITS Standard definition document, but it is likely that FITS +will eventually support this data type, especially as computers that +run 64-bit operating systems become more common. Support for reading +and writing 64-bit integers in CFITSIO can be controlled with the +\#define statement at the beginning of the fitsio2.h file by setting +SUPPORT\_64BIT\_INTEGERS to 1 (enable) or 0 (disable). + +Under the convention used by CFITSIO, FITS 64-bit images have BITPIX = +64, and the 64-bit binary table columns have TFORMn = 'K'. The use of +these data types on platforms where the size of a 'long' (or 'longlong') +integer = 8 bytes is rather intuitive. CFITSIO will write 64-bit +'long' variable values to the FITS file and read them back into 'long' +variables just as one would expect. CFITSIO also supports implicit +data type conversion between 64-bit integer images and columns and any +other supported data type, although some loss of numerical precision or +numerical overflow is likely in this case. + +The situation is more difficult on 32-bit computing platforms that do +not support an intrinsic 64-bit integer data type. In this case it is +not possible to return the full 64 precision of the FITS data values when +reading the values into a program variable. CFITSIO will still +convert the 64-bit integer values into any other supported data type; +the 64-bit double data type is probably the most useful in this case. +It only provides about 52-bits of precision in the mantissa, however, +so some lose of precision is possible. + + +\section{Long String Keyword Values.} + +The length of a standard FITS string keyword is limited to 68 +characters because it must fit entirely within a single FITS header +keyword record. In some instances it is necessary to encode strings +longer than this limit, so CFITSIO supports a local convention in which +the string value is continued over multiple keywords. This +continuation convention uses an ampersand character at the end of each +substring to indicate that it is continued on the next keyword, and the +continuation keywords all have the name CONTINUE without an equal sign +in column 9. The string value may be continued in this way over as many +additional CONTINUE keywords as is required. The following lines +illustrate this continuation convention which is used in the value of +the STRKEY keyword: + +\begin{verbatim} +LONGSTRN= 'OGIP 1.0' / The OGIP Long String Convention may be used. +STRKEY = 'This is a very long string keyword&' / Optional Comment +CONTINUE ' value that is continued over 3 keywords in the & ' +CONTINUE 'FITS header.' / This is another optional comment. +\end{verbatim} +It is recommended that the LONGSTRN keyword, as shown here, always be +included in any HDU that uses this longstring convention as a warning +to any software that must read the keywords. A routine called fits\_write\_key\_longwarn +has been provided in CFITSIO to write this keyword if it does not +already exist. + +This long string convention is supported by the following CFITSIO +routines: + +\begin{verbatim} + fits_write_key_longstr - write a long string keyword value + fits_insert_key_longstr - insert a long string keyword value + fits_modify_key_longstr - modify a long string keyword value + fits_update_key_longstr - modify a long string keyword value + fits_read_key_longstr - read a long string keyword value + fits_delete_key - delete a keyword +\end{verbatim} +The fits\_read\_key\_longstr routine is unique among all the CFITSIO +routines in that it internally allocates memory for the long string +value; all the other CFITSIO routines that deal with arrays require +that the calling program pre-allocate adequate space to hold the array +of data. Consequently, programs which use the fits\_read\_key\_longstr +routine must be careful to free the allocated memory for the string +when it is no longer needed. + +The following 2 routines also have limited support for this long string +convention, + +\begin{verbatim} + fits_modify_key_str - modify an existing string keyword value + fits_update_key_str - update a string keyword value +\end{verbatim} +in that they will correctly overwrite an existing long string value, +but the new string value is limited to a maximum of 68 characters in +length. + +The more commonly used CFITSIO routines to write string valued keywords +(fits\_update\_key and fits\_write\_key) do not support this long +string convention and only support strings up to 68 characters in +length. This has been done deliberately to prevent programs from +inadvertently writing keywords using this non-standard convention +without the explicit intent of the programmer or user. The +fits\_write\_key\_longstr routine must be called instead to write long +strings. This routine can also be used to write ordinary string values +less than 68 characters in length. + + +\section{Arrays of Fixed-Length Strings in Binary Tables} + +The definition of the FITS binary table extension format does not +provide a simple way to specify that a character column contains an +array of fixed-length strings. To support this feature, CFITSIO uses a +local convention for the format of the TFORMn keyword value of the form +'rAw' where 'r' is an integer specifying the total width in characters +of the column, and 'w' is an integer specifying the (fixed) length of +an individual unit string within the vector. For example, TFORM1 = +'120A10' would indicate that the binary table column is 120 characters +wide and consists of 12 10-character length strings. This convention +is recognized by the CFITSIO routines that read or write strings in +binary tables. The Binary Table definition document specifies that +other optional characters may follow the data type code in the TFORM +keyword, so this local convention is in compliance with the +FITS standard although other FITS readers may not +recognize this convention. + +The Binary Table definition document that was approved by the IAU in +1994 contains an appendix describing an alternate convention for +specifying arrays of fixed or variable length strings in a binary table +character column (with the form 'rA:SSTRw/nnn)'. This appendix was not +officially voted on by the IAU and hence is still provisional. CFITSIO +does not currently support this proposal. + + +\section{Keyword Units Strings} + +One limitation of the current FITS Standard is that it does not define +a specific convention for recording the physical units of a keyword +value. The TUNITn keyword can be used to specify the physical units of +the values in a table column, but there is no analogous convention for +keyword values. The comment field of the keyword is often used for +this purpose, but the units are usually not specified in a well defined +format that FITS readers can easily recognize and extract. + +To solve this problem, CFITSIO uses a local convention in which the +keyword units are enclosed in square brackets as the first token in the +keyword comment field; more specifically, the opening square bracket +immediately follows the slash '/' comment field delimiter and a single +space character. The following examples illustrate keywords that use +this convention: + + +\begin{verbatim} +EXPOSURE= 1800.0 / [s] elapsed exposure time +V_HELIO = 16.23 / [km s**(-1)] heliocentric velocity +LAMBDA = 5400. / [angstrom] central wavelength +FLUX = 4.9033487787637465E-30 / [J/cm**2/s] average flux +\end{verbatim} + +In general, the units named in the IAU(1988) Style Guide are +recommended, with the main exception that the preferred unit for angle +is 'deg' for degrees. + +The fits\_read\_key\_unit and fits\_write\_key\_unit routines in +CFITSIO read and write, respectively, the keyword unit strings in an +existing keyword. + + +\section{HIERARCH Convention for Extended Keyword Names} + +CFITSIO supports the HIERARCH keyword convention which allows keyword +names that are longer then 8 characters and may contain the full range +of printable ASCII text characters. This convention +was developed at the European Southern Observatory (ESO) to support +hierarchical FITS keyword such as: + +\begin{verbatim} +HIERARCH ESO INS FOCU POS = -0.00002500 / Focus position +\end{verbatim} +Basically, this convention uses the FITS keyword 'HIERARCH' to indicate +that this convention is being used, then the actual keyword name +({\tt'ESO INS FOCU POS'} in this example) begins in column 10 and can +contain any printable ASCII text characters, including spaces. The +equals sign marks the end of the keyword name and is followed by the +usual value and comment fields just as in standard FITS keywords. +Further details of this convention are described at +http://arcdev.hq.eso.org/dicb/dicd/dic-1-1.4.html (search for +HIERARCH). + +This convention allows a much broader range of keyword names +than is allowed by the FITS Standard. Here are more examples +of such keywords: + +\begin{verbatim} +HIERARCH LongKeyword = 47.5 / Keyword has > 8 characters, and mixed case +HIERARCH XTE$TEMP = 98.6 / Keyword contains the '$' character +HIERARCH Earth is a star = F / Keyword contains embedded spaces +\end{verbatim} +CFITSIO will transparently read and write these keywords, so application +programs do not in general need to know anything about the specific +implementation details of the HIERARCH convention. In particular, +application programs do not need to specify the `HIERARCH' part of the +keyword name when reading or writing keywords (although it +may be included if desired). When writing a keyword, CFITSIO first +checks to see if the keyword name is legal as a standard FITS keyword +(no more than 8 characters long and containing only letters, digits, or +a minus sign or underscore). If so it writes it as a standard FITS +keyword, otherwise it uses the hierarch convention to write the +keyword. The maximum keyword name length is 67 characters, which +leaves only 1 space for the value field. A more practical limit is +about 40 characters, which leaves enough room for most keyword values. +CFITSIO returns an error if there is not enough room for both the +keyword name and the keyword value on the 80-character card, except for +string-valued keywords which are simply truncated so that the closing +quote character falls in column 80. In the current implementation, +CFITSIO preserves the case of the letters when writing the keyword +name, but it is case-insensitive when reading or searching for a +keyword. The current implementation allows any ASCII text character +(ASCII 32 to ASCII 126) in the keyword name except for the '=' +character. A space is also required on either side of the equal sign. + + +\section{Tile-Compressed Image Format} + +CFITSIO supports a convention for compressing n-dimensional images and +storing the resulting byte stream in a variable-length column in a FITS +binary table. The general principle used in this convention is to +first divide the n-dimensional image into a rectangular grid of +subimages or `tiles'. Each tile is then compressed as a continuous +block of data, and the resulting compressed byte stream is stored in a +row of a variable length column in a FITS binary table. By dividing the +image into tiles it is generally possible to extract and uncompress +subsections of the image without having to uncompress the whole image. +The default tiling pattern treats each row of a 2-dimensional image (or +higher dimensional cube) as a tile, such that each tile contains NAXIS1 +pixels. Any other rectangular tiling pattern may also be defined. In +the case of relatively small images it may be sufficient to compress +the entire image as a single tile, resulting in an output binary table +with 1 row. In the case of 3-dimensional data cubes, it may be +advantageous to treat each plane of the cube as a separate tile if +application software typically needs to access the cube on a plane by +plane basis. + +See section 5.6 ``Image Compression'' +for more information on using this tile-compressed image format. + +\chapter{ Optimizing Programs } + +CFITSIO has been carefully designed to obtain the highest possible +speed when reading and writing FITS files. In order to achieve the +best performance, however, application programmers must be careful to +call the CFITSIO routines appropriately and in an efficient sequence; +inappropriate usage of CFITSIO routines can greatly slow down the +execution speed of a program. + +The maximum possible I/O speed of CFITSIO depends of course on the type +of computer system that it is running on. As a rough guide, the +current generation of workstations can achieve speeds of 2 -- 10 MB/s +when reading or writing FITS images and similar, or slightly slower +speeds with FITS binary tables. Reading of FITS files can occur at +even higher rates (30MB/s or more) if the FITS file is still cached in +system memory following a previous read or write operation on the same +file. To more accurately predict the best performance that is possible +on any particular system, a diagnostic program called ``speed.c'' is +included with the CFITSIO distribution which can be run to +approximately measure the maximum possible speed of writing and reading +a test FITS file. + +The following 2 sections provide some background on how CFITSIO +internally manages the data I/O and describes some strategies that may +be used to optimize the processing speed of software that uses +CFITSIO. + + +\section{How CFITSIO Manages Data I/O} + +Many CFITSIO operations involve transferring only a small number of +bytes to or from the FITS file (e.g, reading a keyword, or writing a +row in a table); it would be very inefficient to physically read or +write such small blocks of data directly in the FITS file on disk, +therefore CFITSIO maintains a set of internal Input--Output (IO) +buffers in RAM memory that each contain one FITS block (2880 bytes) of +data. Whenever CFITSIO needs to access data in the FITS file, it first +transfers the FITS block containing those bytes into one of the IO +buffers in memory. The next time CFITSIO needs to access bytes in the +same block it can then go to the fast IO buffer rather than using a +much slower system disk access routine. The number of available IO +buffers is determined by the NIOBUF parameter (in fitsio2.h) and is +currently set to 40 by default. + +Whenever CFITSIO reads or writes data it first checks to see if that +block of the FITS file is already loaded into one of the IO buffers. +If not, and if there is an empty IO buffer available, then it will load +that block into the IO buffer (when reading a FITS file) or will +initialize a new block (when writing to a FITS file). If all the IO +buffers are already full, it must decide which one to reuse (generally +the one that has been accessed least recently), and flush the contents +back to disk if it has been modified before loading the new block. + +The one major exception to the above process occurs whenever a large +contiguous set of bytes are accessed, as might occur when reading or +writing a FITS image. In this case CFITSIO bypasses the internal IO +buffers and simply reads or writes the desired bytes directly in the +disk file with a single call to a low-level file read or write +routine. The minimum threshold for the number of bytes to read or +write this way is set by the MINDIRECT parameter and is currently set +to 3 FITS blocks = 8640 bytes. This is the most efficient way to read +or write large chunks of data and can achieve IO transfer rates of +5 -- 10MB/s or greater. Note that this fast direct IO process is not +applicable when accessing columns of data in a FITS table because the +bytes are generally not contiguous since they are interleaved by the +other columns of data in the table. This explains why the speed for +accessing FITS tables is generally slower than accessing +FITS images. + +Given this background information, the general strategy for efficiently +accessing FITS files should be apparent: when dealing with FITS +images, read or write large chunks of data at a time so that the direct +IO mechanism will be invoked; when accessing FITS headers or FITS +tables, on the other hand, once a particular FITS block has been +loading into one of the IO buffers, try to access all the needed +information in that block before it gets flushed out of the IO buffer. +It is important to avoid the situation where the same FITS block is +being read then flushed from a IO buffer multiple times. + +The following section gives more specific suggestions for optimizing +the use of CFITSIO. + + +\section{Optimization Strategies} + +1. When dealing with a FITS primary array or IMAGE extension, it is +more efficient to read or write large chunks of the image at a time +(at least 3 FITS blocks = 8640 bytes) so that the direct IO mechanism +will be used as described in the previous section. Smaller chunks of +data are read or written via the IO buffers, which is somewhat less +efficient because of the extra copy operation and additional +bookkeeping steps that are required. In principle it is more efficient +to read or write as big an array of image pixels at one time as +possible, however, if the array becomes so large that the operating +system cannot store it all in RAM, then the performance may be degraded +because of the increased swapping of virtual memory to disk. + +2. When dealing with FITS tables, the most important efficiency factor +in the software design is to read or write the data in the FITS file in +a single pass through the file. An example of poor program design +would be to read a large, 3-column table by sequentially reading the +entire first column, then going back to read the 2nd column, and +finally the 3rd column; this obviously requires 3 passes through the +file which could triple the execution time of an IO limited program. +For small tables this is not important, but when reading multi-megabyte +sized tables these inefficiencies can become significant. The more +efficient procedure in this case is to read or write only as many rows +of the table as will fit into the available internal IO buffers, then +access all the necessary columns of data within that range of rows. +Then after the program is completely finished with the data in those +rows it can move on to the next range of rows that will fit in the +buffers, continuing in this way until the entire file has been +processed. By using this procedure of accessing all the columns of a +table in parallel rather than sequentially, each block of the FITS file +will only be read or written once. + +The optimal number of rows to read or write at one time in a given +table depends on the width of the table row, on the number of IO +buffers that have been allocated in CFITSIO, and also on the number of +other FITS files that are open at the same time (since one IO buffer is +always reserved for each open FITS file). The CFITSIO Iterator routine +will automatically use the optimal-sized buffer, but there is also a +CFITSIO routine that will return the optimal number of rows for a given +table: fits\_get\_rowsize. It is not critical to use exactly the +value of nrows returned by this routine, as long as one does not exceed +it. Using a very small value however can also lead to poor performance +because of the overhead from the larger number of subroutine calls. + +The optimal number of rows returned by fits\_get\_rowsize is valid only +as long as the application program is only reading or writing data in +the specified table. Any other calls to access data in the table +header or in any other FITS file would cause additional blocks of data +to be loaded into the IO buffers displacing data from the original +table, and should be avoided during the critical period while the table +is being read or written. + +Occasionally it is necessary to simultaneously access more than one +FITS table, for example when transferring values from an input table to +an output table. In cases like this, one should call +fits\_get\_rowsize to get the optimal number of rows for each table +separately, than reduce the number of rows proportionally. For +example, if the optimal number of rows in the input table is 3600 and +is 1400 in the output table, then these values should be cut in half to +1800 and 700, respectively, if both tables are going to be accessed at +the same time. + +3. Use the CFITSIO Iterator routine. This routine provides a +more `object oriented' way of reading and writing FITS files +which automatically uses the most appropriate data buffer size +to achieve the maximum I/O throughput. + +4. Use binary table extensions rather than ASCII table +extensions for better efficiency when dealing with tabular data. The +I/O to ASCII tables is slower because of the overhead in formatting or +parsing the ASCII data fields and because ASCII tables are about twice +as large as binary tables with the same information content. + +5. Design software so that it reads the FITS header keywords in the +same order in which they occur in the file. When reading keywords, +CFITSIO searches forward starting from the position of the last keyword +that was read. If it reaches the end of the header without finding the +keyword, it then goes back to the start of the header and continues the +search down to the position where it started. In practice, as long as +the entire FITS header can fit at one time in the available internal IO +buffers, then the header keyword access will be very fast and it makes +little difference which order they are accessed. + +6. Avoid the use of scaling (by using the BSCALE and BZERO or TSCAL and +TZERO keywords) in FITS files since the scaling operations add to the +processing time needed to read or write the data. In some cases it may +be more efficient to temporarily turn off the scaling (using fits\_set\_bscale or +fits\_set\_tscale) and then read or write the raw unscaled values in the FITS +file. + +7. Avoid using the `implicit data type conversion' capability in +CFITSIO. For instance, when reading a FITS image with BITPIX = -32 +(32-bit floating point pixels), read the data into a single precision +floating point data array in the program. Forcing CFITSIO to convert +the data to a different data type can slow the program. + +8. Where feasible, design FITS binary tables using vector column +elements so that the data are written as a contiguous set of bytes, +rather than as single elements in multiple rows. For example, it is +faster to access the data in a table that contains a single row +and 2 columns with TFORM keywords equal to '10000E' and '10000J', than +it is to access the same amount of data in a table with 10000 rows +which has columns with the TFORM keywords equal to '1E' and '1J'. In +the former case the 10000 floating point values in the first column are +all written in a contiguous block of the file which can be read or +written quickly, whereas in the second case each floating point value +in the first column is interleaved with the integer value in the second +column of the same row so CFITSIO has to explicitly move to the +position of each element to be read or written. + +9. Avoid the use of variable length vector columns in binary tables, +since any reading or writing of these data requires that CFITSIO first +look up or compute the starting address of each row of data in the +heap. + +10. When copying data from one FITS table to another, it is faster to +transfer the raw bytes instead of reading then writing each column of +the table. The CFITSIO routines fits\_read\_tblbytes and +fits\_write\_tblbytes will perform low-level reads or writes of any +contiguous range of bytes in a table extension. These routines can be +used to read or write a whole row (or multiple rows for even greater +efficiency) of a table with a single function call. These routines +are fast because they bypass all the usual data scaling, error checking +and machine dependent data conversion that is normally done by CFITSIO, +and they allow the program to write the data to the output file in +exactly the same byte order. For these same reasons, these routines +can corrupt the FITS data file if used incorrectly because no +validation or machine dependent conversion is performed by these +routines. These routines are only recommended for optimizing critical +pieces of code and should only be used by programmers who thoroughly +understand the internal format of the FITS tables they are reading or +writing. + +11. Another strategy for improving the speed of writing a FITS table, +similar to the previous one, is to directly construct the entire byte +stream for a whole table row (or multiple rows) within the application +program and then write it to the FITS file with +fits\_write\_tblbytes. This avoids all the overhead normally present +in the column-oriented CFITSIO write routines. This technique should +only be used for critical applications because it makes the code more +difficult to understand and maintain, and it makes the code more system +dependent (e.g., do the bytes need to be swapped before writing to the +FITS file?). + +12. Finally, external factors such as the type of magnetic disk +controller (SCSI or IDE), the size of the disk cache, the average seek +speed of the disk, the amount of disk fragmentation, and the amount of +RAM available on the system can all have a significant impact on +overall I/O efficiency. For critical applications, a system +administrator should review the proposed system hardware to identify any +potential I/O bottlenecks. + + +\appendix +\chapter{Index of Routines } +\begin{tabular}{lr} +fits\_add\_group\_member & \pageref{ffgtam} \\ +fits\_ascii\_tform & \pageref{ffasfm} \\ +fits\_binary\_tform & \pageref{ffbnfm} \\ +fits\_calculator & \pageref{ffcalc} \\ +fits\_calculator\_rng & \pageref{ffcalcrng} \\ +fits\_calc\_rows & \pageref{ffcrow} \\ +fits\_change\_group & \pageref{ffgtch} \\ +fits\_clear\_errmark & \pageref{ffpmrk} \\ +fits\_clear\_errmsg & \pageref{ffcmsg} \\ +fits\_close\_file & \pageref{ffclos} \\ +fits\_compact\_group & \pageref{ffgtcm} \\ +fits\_compare\_str & \pageref{ffcmps} \\ +fits\_compress\_heap & \pageref{ffcmph} \\ +fits\_copy\_col & \pageref{ffcpcl} \\ +fits\_copy\_data & \pageref{ffcpdt} \\ +fits\_copy\_file & \pageref{ffcpfl} \\ +fits\_copy\_group & \pageref{ffgtcp} \\ +fits\_copy\_hdu & \pageref{ffcopy} \\ +fits\_copy\_header & \pageref{ffcphd} \\ +fits\_copy\_key & \pageref{ffcpky} \\ +fits\_copy\_member & \pageref{ffgmcp} \\ +fits\_create\_diskfile & \pageref{ffinit} \\ +fits\_create\_file & \pageref{ffinit} \\ +fits\_create\_group & \pageref{ffgtcr} \\ +fits\_create\_hdu & \pageref{ffcrhd} \\ +fits\_create\_img & \pageref{ffcrim} \\ +fits\_create\_memfile & \pageref{ffimem} \\ +fits\_create\_tbl & \pageref{ffcrtb} \\ +fits\_create\_template & \pageref{fftplt} \\ +fits\_date2str & \pageref{ffdt2s} \\ +fits\_decode\_chksum & \pageref{ffdsum} \\ +fits\_decode\_tdim & \pageref{ffdtdm} \\ + +\end{tabular} +\begin{tabular}{lr} +fits\_delete\_col & \pageref{ffdcol} \\ +fits\_delete\_file & \pageref{ffdelt} \\ +fits\_delete\_hdu & \pageref{ffdhdu} \\ +fits\_delete\_key & \pageref{ffdkey} \\ +fits\_delete\_record & \pageref{ffdrec} \\ +fits\_delete\_rowlist & \pageref{ffdrws} \\ +fits\_delete\_rowrange & \pageref{ffdrrg} \\ +fits\_delete\_rows & \pageref{ffdrow} \\ +fits\_encode\_chksum & \pageref{ffesum} \\ +fits\_file\_exists & \pageref{ffexist} \\ +fits\_file\_mode & \pageref{ffflmd} \\ +fits\_file\_name & \pageref{ffflnm} \\ +fits\_find\_first\_row & \pageref{ffffrw} \\ +fits\_find\_nextkey & \pageref{ffgnxk} \\ +fits\_find\_rows & \pageref{fffrow} \\ +fits\_flush\_buffer & \pageref{ffflus} \\ +fits\_flush\_file & \pageref{ffflus} \\ +fits\_get\_acolparms & \pageref{ffgacl} \\ +fits\_get\_bcolparms & \pageref{ffgbcl} \\ +fits\_get\_chksum & \pageref{ffgcks} \\ +fits\_get\_col\_display\_width & \pageref{ffgcdw} \\ +fits\_get\_colname & \pageref{ffgcnn} \\ +fits\_get\_colnum & \pageref{ffgcno} \\ +fits\_get\_coltype & \pageref{ffgtcl} \\ +fits\_get\_compression\_type & \pageref{ffgetcomp} \\ +fits\_get\_eqcoltype & \pageref{ffgtcl} \\ +fits\_get\_errstatus & \pageref{ffgerr} \\ +fits\_get\_hdrpos & \pageref{ffghps} \\ +fits\_get\_hdrspace & \pageref{ffghsp} \\ +fits\_get\_hdu\_num & \pageref{ffghdn} \\ +fits\_get\_hdu\_type & \pageref{ffghdt} \\ +fits\_get\_hduaddr & \pageref{ffghad} \\ +\end{tabular} +\begin{tabular}{lr} +fits\_get\_hduoff & \pageref{ffghad} \\ +fits\_get\_img\_dim & \pageref{ffgidm} \\ +fits\_get\_img\_equivtype & \pageref{ffgidt} \\ +fits\_get\_img\_param & \pageref{ffgipr} \\ +fits\_get\_img\_size & \pageref{ffgisz} \\ +fits\_get\_img\_type & \pageref{ffgidt} \\ +fits\_get\_keyclass & \pageref{ffgkcl} \\ +fits\_get\_keyname & \pageref{ffgknm} \\ +fits\_get\_keytype & \pageref{ffdtyp} \\ +fits\_get\_noise\_bits & \pageref{ffgetcomp} \\ +fits\_get\_num\_cols & \pageref{ffgnrw} \\ +fits\_get\_num\_groups & \pageref{ffgmng} \\ +fits\_get\_num\_hdus & \pageref{ffthdu} \\ +fits\_get\_num\_members & \pageref{ffgtnm} \\ +fits\_get\_num\_rows & \pageref{ffgnrw} \\ +fits\_get\_rowsize & \pageref{ffgrsz} \\ +fits\_get\_system\_time & \pageref{ffdt2s} \\ +fits\_get\_tile\_dim & \pageref{ffgetcomp} \\ +fits\_get\_tbcol & \pageref{ffgabc} \\ +fits\_get\_version & \pageref{ffvers} \\ +fits\_hdr2str & \pageref{ffhdr2str}, \pageref{hdr2str} \\ +fits\_insert\_atbl & \pageref{ffitab} \\ +fits\_insert\_btbl & \pageref{ffibin} \\ +fits\_insert\_col & \pageref{fficol} \\ +fits\_insert\_cols & \pageref{fficls} \\ +fits\_insert\_group & \pageref{ffgtis} \\ +fits\_insert\_img & \pageref{ffiimg} \\ +fits\_insert\_key\_null & \pageref{ffikyu} \\ +fits\_insert\_key\_TYP & \pageref{ffikyx} \\ +fits\_insert\_record & \pageref{ffirec} \\ +fits\_insert\_rows & \pageref{ffirow} \\ +fits\_iterate\_data & \pageref{ffiter} \\ +\end{tabular} +\newpage +\begin{tabular}{lr} +fits\_make\_keyn & \pageref{ffkeyn} \\ +fits\_make\_nkey & \pageref{ffnkey} \\ +fits\_merge\_groups & \pageref{ffgtmg} \\ +fits\_modify\_card & \pageref{ffmcrd} \\ +fits\_modify\_comment & \pageref{ffmcom} \\ +fits\_modify\_key\_null & \pageref{ffmkyu} \\ +fits\_modify\_key\_TYP & \pageref{ffmkyx} \\ +fits\_modify\_name & \pageref{ffmnam} \\ +fits\_modify\_record & \pageref{ffmrec} \\ +fits\_modify\_vector\_len & \pageref{ffmvec} \\ +fits\_movabs\_hdu & \pageref{ffmahd} \\ +fits\_movnam\_hdu & \pageref{ffmnhd} \\ +fits\_movrel\_hdu & \pageref{ffmrhd} \\ +fits\_null\_check & \pageref{ffnchk} \\ +fits\_open\_data & \pageref{ffopen} \\ +fits\_open\_diskfile & \pageref{ffopen} \\ +fits\_open\_file & \pageref{ffopen} \\ +fits\_open\_image & \pageref{ffopen} \\ +fits\_open\_table & \pageref{ffopen} \\ +fits\_open\_group & \pageref{ffgtop} \\ +fits\_open\_member & \pageref{ffgmop} \\ +fits\_open\_memfile & \pageref{ffomem} \\ +fits\_parse\_extnum & \pageref{ffextn} \\ +fits\_parse\_input\_url & \pageref{ffiurl} \\ +fits\_parse\_range & \pageref{ffrwrg} \\ +fits\_parse\_rootname & \pageref{ffrtnm} \\ +fits\_parse\_template & \pageref{ffgthd} \\ +fits\_parse\_value & \pageref{ffpsvc} \\ +fits\_pix\_to\_world & \pageref{ffwldp} \\ +fits\_read\_2d\_TYP & \pageref{ffg2dx} \\ +fits\_read\_3d\_TYP & \pageref{ffg3dx} \\ +fits\_read\_atblhdr & \pageref{ffghtb} \\ +fits\_read\_btblhdr & \pageref{ffghbn} \\ +fits\_read\_card & \pageref{ffgcrd} \\ +fits\_read\_col & \pageref{ffgcv} \\ +fits\_read\_col\_bit\_ & \pageref{ffgcx} \\ +fits\_read\_col\_TYP & \pageref{ffgcvx} \\ +fits\_read\_colnull & \pageref{ffgcf} \\ +fits\_read\_colnull\_TYP & \pageref{ffgcfx} \\ +fits\_read\_descript & \pageref{ffgdes} \\ +fits\_read\_descripts & \pageref{ffgdes} \\ +fits\_read\_errmsg & \pageref{ffgmsg} \\ +fits\_read\_grppar\_TYP & \pageref{ffggpx} \\ +fits\_read\_img & \pageref{ffgpv} \\ +fits\_read\_img\_coord & \pageref{ffgics} \\ +fits\_read\_img\_TYP & \pageref{ffgpvx} \\ +fits\_read\_imghdr & \pageref{ffghpr} \\ + +\end{tabular} +\begin{tabular}{lr} +fits\_read\_imgnull & \pageref{ffgpf} \\ +fits\_read\_imgnull\_TYP & \pageref{ffgpfx} \\ +fits\_read\_key & \pageref{ffgky} \\ +fits\_read\_key\_longstr & \pageref{ffgkls} \\ +fits\_read\_key\_triple & \pageref{ffgkyt} \\ +fits\_read\_key\_unit & \pageref{ffgunt} \\ +fits\_read\_key\_TYP & \pageref{ffgkyx} \\ +fits\_read\_keyn & \pageref{ffgkyn} \\ +fits\_read\_keys\_TYP & \pageref{ffgknx} \\ +fits\_read\_keyword & \pageref{ffgkey} \\ +fits\_read\_pix & \pageref{ffgpxv} \\ +fits\_read\_pixnull & \pageref{ffgpxf} \\ +fits\_read\_record & \pageref{ffgrec} \\ +fits\_read\_subset\_TYP & \pageref{ffgsvx} \pageref{ffgsvx2}\\ +fits\_read\_subsetnull\_TYP & \pageref{ffgsfx} \pageref{ffgsfx2} \\ +fits\_read\_tbl\_coord & \pageref{ffgtcs} \\ +fits\_read\_tblbytes & \pageref{ffgtbb} \\ +fits\_read\_tdim & \pageref{ffgtdm} \\ +fits\_remove\_group & \pageref{ffgtrm} \\ +fits\_remove\_member & \pageref{ffgmrm} \\ +fits\_reopen\_file & \pageref{ffreopen} \\ +fits\_report\_error & \pageref{ffrprt} \\ +fits\_resize\_img & \pageref{ffrsim} \\ +fits\_select\_rows & \pageref{ffsrow} \\ +fits\_set\_atblnull & \pageref{ffsnul} \\ +fits\_set\_bscale & \pageref{ffpscl} \\ +fits\_set\_btblnull & \pageref{fftnul} \\ +fits\_set\_compression\_type & \pageref{ffsetcomp} \\ +fits\_set\_hdrsize & \pageref{ffhdef} \\ +fits\_set\_hdustruc & \pageref{ffrdef} \\ +fits\_set\_imgnull & \pageref{ffpnul} \\ +fits\_set\_noise\_bits & \pageref{ffsetcomp} \\ +fits\_set\_tile\_dim & \pageref{ffsetcomp} \\ +fits\_set\_tscale & \pageref{fftscl} \\ +fits\_split\_names & \pageref{splitnames} \\ +fits\_str2date & \pageref{ffdt2s} \\ +fits\_str2time & \pageref{ffdt2s} \\ +fits\_test\_expr & \pageref{fftexp} \\ +fits\_test\_heap & \pageref{fftheap} \\ +fits\_test\_keyword & \pageref{fftkey} \\ +fits\_test\_record & \pageref{fftrec} \\ +fits\_time2str & \pageref{ffdt2s} \\ +fits\_transfer\_member & \pageref{ffgmtf} \\ +fits\_update\_card & \pageref{ffucrd} \\ +fits\_update\_chksum & \pageref{ffupck} \\ +fits\_update\_key & \pageref{ffuky} \\ +fits\_update\_key\_null & \pageref{ffukyu} \\ +fits\_update\_key\_TYP & \pageref{ffukyx} \\ +\end{tabular} +\begin{tabular}{lr} + +fits\_uppercase & \pageref{ffupch} \\ +fits\_url\_type & \pageref{ffurlt} \\ +fits\_verify\_chksum & \pageref{ffvcks} \\ +fits\_verify\_group & \pageref{ffgtvf} \\ +fits\_world\_to\_pix & \pageref{ffxypx} \\ +fits\_write\_2d\_TYP & \pageref{ffp2dx} \\ +fits\_write\_3d\_TYP & \pageref{ffp3dx} \\ +fits\_write\_atblhdr & \pageref{ffphtb} \\ +fits\_write\_btblhdr & \pageref{ffphbn} \\ +fits\_write\_chksum & \pageref{ffpcks} \\ +fits\_write\_col & \pageref{ffpcl} \\ +fits\_write\_col\_bit & \pageref{ffpclx} \\ +fits\_write\_col\_TYP & \pageref{ffpcls} \\ +fits\_write\_col\_null & \pageref{ffpclu} \\ +fits\_write\_colnull & \pageref{ffpcn} \\ +fits\_write\_colnull\_TYP & \pageref{ffpcnx} \\ +fits\_write\_comment & \pageref{ffpcom} \\ +fits\_write\_date & \pageref{ffpdat} \\ +fits\_write\_descript & \pageref{ffpdes} \\ +fits\_write\_errmark & \pageref{ffpmrk} \\ +fits\_write\_errmsg & \pageref{ffpmsg} \\ +fits\_write\_grphdr & \pageref{ffphpr} \\ +fits\_write\_grppar\_TYP & \pageref{ffpgpx} \\ +fits\_write\_history & \pageref{ffphis} \\ +fits\_write\_img & \pageref{ffppr} \\ +fits\_write\_img\_null & \pageref{ffppru} \\ +fits\_write\_img\_TYP & \pageref{ffpprx} \\ +fits\_write\_imghdr & \pageref{ffphps} \\ +fits\_write\_imgnull & \pageref{ffppn} \\ +fits\_write\_imgnull\_TYP & \pageref{ffppnx} \\ +fits\_write\_key & \pageref{ffpky} \\ +fits\_write\_key\_longstr & \pageref{ffpkls} \\ +fits\_write\_key\_longwarn & \pageref{ffplsw} \\ +fits\_write\_key\_null & \pageref{ffpkyu} \\ +fits\_write\_key\_template & \pageref{ffpktp} \\ +fits\_write\_key\_triple & \pageref{ffpkyt} \\ +fits\_write\_key\_unit & \pageref{ffpunt} \\ +fits\_write\_key\_TYP & \pageref{ffpkyx} \\ +fits\_write\_keys\_TYP & \pageref{ffpknx} \\ +fits\_write\_null\_img & \pageref{ffpprn} \\ +fits\_write\_pix & \pageref{ffppx} \\ +fits\_write\_pixnull & \pageref{ffppxn} \\ +fits\_write\_record & \pageref{ffprec} \\ +fits\_write\_subset & \pageref{ffpss} \\ +fits\_write\_subset\_TYP & \pageref{ffpssx} \\ +fits\_write\_tblbytes & \pageref{ffptbb} \\ +fits\_write\_tdim & \pageref{ffptdm} \\ +fits\_write\_theap & \pageref{ffpthp} \\ +\end{tabular} +\newpage + +\begin{tabular}{lr} +ffasfm & \pageref{ffasfm} \\ +ffbnfm & \pageref{ffbnfm} \\ +ffcalc & \pageref{ffcalc} \\ +ffcalc\_rng & \pageref{ffcalcrng} \\ +ffclos & \pageref{ffclos} \\ +ffcmph & \pageref{ffcmph} \\ +ffcmps & \pageref{ffcmps} \\ +ffcmrk & \pageref{ffpmrk} \\ +ffcmsg & \pageref{ffcmsg} \\ +ffcopy & \pageref{ffcopy} \\ +ffcpcl & \pageref{ffcpcl} \\ +ffcpdt & \pageref{ffcpdt} \\ +ffcpfl & \pageref{ffcpfl} \\ +ffcphd & \pageref{ffcphd} \\ +ffcpky & \pageref{ffcpky} \\ +ffcrhd & \pageref{ffcrhd} \\ +ffcrim & \pageref{ffcrim} \\ +ffcrow & \pageref{ffcrow} \\ +ffcrtb & \pageref{ffcrtb} \\ +ffdcol & \pageref{ffdcol} \\ +ffdelt & \pageref{ffdelt} \\ +ffdhdu & \pageref{ffdhdu} \\ +ffdkey & \pageref{ffdkey} \\ +ffdkinit & \pageref{ffinit} \\ +ffdkopen & \pageref{ffopen} \\ +ffdopn & \pageref{ffopen} \\ +ffdrec & \pageref{ffdrec} \\ +ffdrow & \pageref{ffdrow} \\ +ffdrrg & \pageref{ffdrrg} \\ +ffdrws & \pageref{ffdrws} \\ +ffdsum & \pageref{ffdsum} \\ +ffdt2s & \pageref{ffdt2s} \\ +ffdtdm & \pageref{ffdtdm} \\ +ffdtyp & \pageref{ffdtyp} \\ +ffeqty & \pageref{ffgtcl} \\ +ffesum & \pageref{ffesum} \\ +ffexest & \pageref{ffexist} \\ +ffextn & \pageref{ffextn} \\ +ffffrw & \pageref{ffffrw} \\ +ffflmd & \pageref{ffflmd} \\ +ffflnm & \pageref{ffflnm} \\ +ffflsh & \pageref{ffflus} \\ +ffflus & \pageref{ffflus} \\ +fffrow & \pageref{fffrow} \\ +ffg2d\_ & \pageref{ffg2dx} \\ +ffg3d\_ & \pageref{ffg3dx} \\ +ffgabc & \pageref{ffgabc} \\ +\end{tabular} +\begin{tabular}{lr} +ffgacl & \pageref{ffgacl} \\ +ffgbcl & \pageref{ffgbcl} \\ +ffgcdw & \pageref{ffgcdw} \\ +ffgcf & \pageref{ffgcf} \\ +ffgcf\_ & \pageref{ffgcfx} \\ +ffgcks & \pageref{ffgcks} \\ +ffgcnn & \pageref{ffgcnn} \\ +ffgcno & \pageref{ffgcno} \\ +ffgcrd & \pageref{ffgcrd} \\ +ffgcv & \pageref{ffgcv} \\ +ffgcv\_ & \pageref{ffgcvx} \\ +ffgcx & \pageref{ffgcx} \\ +ffgdes & \pageref{ffgdes} \\ +ffgdess & \pageref{ffgdes} \\ +ffgerr & \pageref{ffgerr} \\ +ffggp\_ & \pageref{ffggpx} \\ +ffghad & \pageref{ffghad} \\ +ffghbn & \pageref{ffghbn} \\ +ffghdn & \pageref{ffghdn} \\ +ffghdt & \pageref{ffghdt} \\ +ffghof & \pageref{ffghad} \\ +ffghpr & \pageref{ffghpr} \\ +ffghps & \pageref{ffghps} \\ +ffghsp & \pageref{ffghsp} \\ +ffghtb & \pageref{ffghtb} \\ +ffgics & \pageref{ffgics} \\ +ffgidm & \pageref{ffgidm} \\ +ffgidt & \pageref{ffgidt} \\ +ffgiet & \pageref{ffgidt} \\ +ffgipr & \pageref{ffgipr} \\ +ffgisz & \pageref{ffgisz} \\ +ffgkcl & \pageref{ffgkcl} \\ +ffgkey & \pageref{ffgkey} \\ +ffgkls & \pageref{ffgkls} \\ +ffgkn\_ & \pageref{ffgknx} \\ +ffgknm & \pageref{ffgknm} \\ +ffgky & \pageref{ffgky} \\ +ffgkyn & \pageref{ffgkyn} \\ +ffgkyt & \pageref{ffgkyt} \\ +ffgky\_ & \pageref{ffgkyx} \\ +ffgmcp & \pageref{ffgmcp} \\ +ffgmng & \pageref{ffgmng} \\ +ffgmop & \pageref{ffgmop} \\ +ffgmrm & \pageref{ffgmrm} \\ +ffgmsg & \pageref{ffgmsg} \\ +ffgmtf & \pageref{ffgmtf} \\ +ffgncl & \pageref{ffgnrw} \\ + +\end{tabular} +\begin{tabular}{lr} +ffgnrw & \pageref{ffgnrw} \\ +ffgnxk & \pageref{ffgnxk} \\ +ffgpf & \pageref{ffgpf} \\ +ffgpf\_ & \pageref{ffgpfx} \\ +ffgpv & \pageref{ffgpv} \\ +ffgpv\_ & \pageref{ffgpvx} \\ +ffgpxv & \pageref{ffgpxv} \\ +ffgpxf & \pageref{ffgpxf} \\ +ffgrec & \pageref{ffgrec} \\ +ffgrsz & \pageref{ffgrsz} \\ +ffgsdt & \pageref{ffdt2s} \\ +ffgsf\_ & \pageref{ffgsfx} \pageref{ffgsfx2} \\ +ffgstm & \pageref{ffdt2s} \\ +ffgsv\_ & \pageref{ffgsvx} \pageref{ffgsvx2}\\ +ffgtam & \pageref{ffgtam} \\ +ffgtbb & \pageref{ffgtbb} \\ +ffgtch & \pageref{ffgtch} \\ +ffgtcl & \pageref{ffgtcl} \\ +ffgtcm & \pageref{ffgtcm} \\ +ffgtcp & \pageref{ffgtcp} \\ +ffgtcr & \pageref{ffgtcr} \\ +ffgtcs & \pageref{ffgtcs} \\ +ffgtdm & \pageref{ffgtdm} \\ +ffgthd & \pageref{ffgthd} \\ +ffgtis & \pageref{ffgtis} \\ +ffgtmg & \pageref{ffgtmg} \\ +ffgtnm & \pageref{ffgtnm} \\ +ffgtop & \pageref{ffgtop} \\ +ffgtrm & \pageref{ffgtrm} \\ +ffgtvf & \pageref{ffgtvf} \\ +ffgunt & \pageref{ffgunt} \\ +ffhdef & \pageref{ffhdef} \\ +ffibin & \pageref{ffibin} \\ +fficls & \pageref{fficls} \\ +fficol & \pageref{fficol} \\ +ffiimg & \pageref{ffiimg} \\ +ffikls & \pageref{ffikyx} \\ +ffikyu & \pageref{ffikyu} \\ +ffiky\_ & \pageref{ffikyx} \\ +ffimem & \pageref{ffimem} \\ +ffinit & \pageref{ffinit} \\ +ffiopn & \pageref{ffopen} \\ +ffirec & \pageref{ffirec} \\ +ffirow & \pageref{ffirow} \\ +ffitab & \pageref{ffitab} \\ +ffiter & \pageref{ffiter} \\ +ffiurl & \pageref{ffiurl} \\ + +\end{tabular} +\begin{tabular}{lr} +ffkeyn & \pageref{ffkeyn} \\ +ffmahd & \pageref{ffmahd} \\ +ffmcom & \pageref{ffmcom} \\ +ffmcrd & \pageref{ffmcrd} \\ +ffmkls & \pageref{ffmkyx} \\ +ffmkyu & \pageref{ffmkyu} \\ +ffmky\_ & \pageref{ffmkyx} \\ +ffmnam & \pageref{ffmnam} \\ +ffmnhd & \pageref{ffmnhd} \\ +ffmrec & \pageref{ffmrec} \\ +ffmrhd & \pageref{ffmrhd} \\ +ffmvec & \pageref{ffmvec} \\ +ffnchk & \pageref{ffnchk} \\ +ffnkey & \pageref{ffnkey} \\ +ffomem & \pageref{ffomem} \\ +ffopen & \pageref{ffopen} \\ +ffp2d\_ & \pageref{ffp2dx} \\ +ffp3d\_ & \pageref{ffp3dx} \\ +ffpcks & \pageref{ffpcks} \\ +ffpcl & \pageref{ffpcl} \\ +ffpcls & \pageref{ffpcls} \\ +ffpcl\_ & \pageref{ffpclx} \\ +ffpclu & \pageref{ffpclu} \\ +ffpcn & \pageref{ffpcn} \\ +ffpcn\_ & \pageref{ffpcnx} \\ +ffpcom & \pageref{ffpcom} \\ +ffpdat & \pageref{ffpdat} \\ +ffpdes & \pageref{ffpdes} \\ +ffpgp\_ & \pageref{ffpgpx} \\ +ffphbn & \pageref{ffphbn} \\ +ffphis & \pageref{ffphis} \\ +ffphpr & \pageref{ffphpr} \\ +ffphps & \pageref{ffphps} \\ +ffphtb & \pageref{ffphtb} \\ +ffpkls & \pageref{ffpkls} \\ +ffpkn\_ & \pageref{ffpknx} \\ +ffpktp & \pageref{ffpktp} \\ +ffpky & \pageref{ffpky} \\ +ffpkyt & \pageref{ffpkyt} \\ +ffpkyu & \pageref{ffpkyu} \\ +ffpky\_ & \pageref{ffpkyx} \\ +ffplsw & \pageref{ffplsw} \\ +ffpmrk & \pageref{ffpmrk} \\ +ffpmsg & \pageref{ffpmsg} \\ +ffpnul & \pageref{ffpnul} \\ +ffppn & \pageref{ffppn} \\ +ffppn\_ & \pageref{ffppnx} \\ + +\end{tabular} +\begin{tabular}{lr} +ffppr & \pageref{ffppr} \\ +ffpprn & \pageref{ffpprn} \\ +ffppru & \pageref{ffppru} \\ +ffppr\_ & \pageref{ffpprx} \\ +ffppx & \pageref{ffppx} \\ +ffppxn & \pageref{ffppxn} \\ +ffprec & \pageref{ffprec} \\ +ffpscl & \pageref{ffpscl} \\ +ffpss & \pageref{ffpss} \\ +ffpss\_ & \pageref{ffpssx} \\ +ffpsvc & \pageref{ffpsvc} \\ +ffptbb & \pageref{ffptbb} \\ +ffptdm & \pageref{ffptdm} \\ +ffpthp & \pageref{ffpthp} \\ +ffpunt & \pageref{ffpunt} \\ +ffrdef & \pageref{ffrdef} \\ +ffreopen & \pageref{ffreopen} \\ +ffrprt & \pageref{ffrprt} \\ +ffrsim & \pageref{ffrsim} \\ +ffrtnm & \pageref{ffrtnm} \\ +ffrwrg & \pageref{ffrwrg} \\ +ffs2dt & \pageref{ffdt2s} \\ +ffs2tm & \pageref{ffdt2s} \\ +ffsnul & \pageref{ffsnul} \\ +ffsrow & \pageref{ffsrow} \\ +fftexp & \pageref{fftexp} \\ +ffthdu & \pageref{ffthdu} \\ +fftheap & \pageref{fftheap} \\ +fftkey & \pageref{fftkey} \\ +fftm2s & \pageref{ffdt2s} \\ +fftnul & \pageref{fftnul} \\ +fftopn & \pageref{ffopen} \\ +fftplt & \pageref{fftplt} \\ +fftrec & \pageref{fftrec} \\ +fftscl & \pageref{fftscl} \\ +ffucrd & \pageref{ffucrd} \\ +ffukls & \pageref{ffukyx} \\ +ffuky & \pageref{ffuky} \\ +ffukyu & \pageref{ffukyu} \\ +ffuky\_ & \pageref{ffukyx} \\ +ffupch & \pageref{ffupch} \\ +ffupck & \pageref{ffupck} \\ +ffurlt & \pageref{ffurlt} \\ +ffvcks & \pageref{ffvcks} \\ +ffvers & \pageref{ffvers} \\ +ffwldp & \pageref{ffwldp} \\ +ffxypx & \pageref{ffxypx} \\ +\end{tabular} + + + +\chapter{Parameter Definitions } + +\begin{verbatim} +anynul - set to TRUE (=1) if any returned values are undefined, else FALSE +array - array of numerical data values to read or write +ascii - encoded checksum string +binspec - the input table binning specifier +bitpix - bits per pixel. The following symbolic mnemonics are predefined: + BYTE_IMG = 8 (unsigned char) + SHORT_IMG = 16 (signed short integer) + LONG_IMG = 32 (signed long integer) + LONGLONG_IMG = 64 (signed long 64-bit integer) + FLOAT_IMG = -32 (float) + DOUBLE_IMG = -64 (double). + The LONGLONG_IMG type is experimental and is not officially + recognized in the FITS Standard document. + Two additional values, USHORT_IMG and ULONG_IMG are also available + for creating unsigned integer images. These are equivalent to + creating a signed integer image with BZERO offset keyword values + of 32768 or 2147483648, respectively, which is the convention that + FITS uses to store unsigned integers. +card - header record to be read or written (80 char max, null-terminated) +casesen - CASESEN (=1) for case-sensitive string matching, else CASEINSEN (=0) +cmopt - grouping table "compact" option parameter. Allowed values are: + OPT_CMT_MBR and OPT_CMT_MBR_DEL. +colname - name of the column (null-terminated) +colnum - column number (first column = 1) +colspec - the input file column specification; used to delete, create, or rename + table columns +comment - the keyword comment field (72 char max, null-terminated) +complm - should the checksum be complemented? +comptype - compression algorithm to use: GZIP_1, RICE_1, or PLIO_1 +coordtype- type of coordinate projection (-SIN, -TAN, -ARC, -NCP, + -GLS, -MER, or -AIT) +cpopt - grouping table copy option parameter. Allowed values are: + OPT_GCP_GPT, OPT_GCP_MBR, OPT_GCP_ALL, OPT_MCP_ADD, OPT_MCP_NADD, + OPT_MCP_REPL, amd OPT_MCP_MOV. +create_col- If TRUE, then insert a new column in the table, otherwise + overwrite the existing column. +current - if TRUE, then the current HDU will be copied +dataok - was the data unit verification successful (=1) or + not (= -1). Equals zero if the DATASUM keyword is not present. +datasum - 32-bit 1's complement checksum for the data unit +dataend - address (in bytes) of the end of the HDU +datastart- address (in bytes) of the start of the data unit +datatype - specifies the data type of the value. Allowed value are: TSTRING, + TLOGICAL, TBYTE, TSBYTE, TSHORT, TUSHORT, TINT, TUINT, TLONG, TULONG, + TFLOAT, TDOUBLE, TCOMPLEX, and TDBLCOMPLEX +datestr - FITS date/time string: 'YYYY-MM-DDThh:mm:ss.ddd', 'YYYY-MM-dd', + or 'dd/mm/yy' +day - calendar day (UTC) (1-31) +decimals - number of decimal places to be displayed +deltasize - increment for allocating more memory +dim1 - declared size of the first dimension of the image or cube array +dim2 - declared size of the second dimension of the data cube array +dispwidth - display width of a column = length of string that will be read +dtype - data type of the keyword ('C', 'L', 'I', 'F' or 'X') + C = character string + L = logical + I = integer + F = floating point number + X = complex, e.g., "(1.23, -4.56)" +err_msg - error message on the internal stack (80 chars max) +err_text - error message string corresponding to error number (30 chars max) +exact - TRUE (=1) if the strings match exactly; + FALSE (=0) if wildcards are used +exclist - array of pointers to keyword names to be excluded from search +exists - flag indicating whether the file or compressed file exists on disk +expr - boolean or arithmetic expression +extend - TRUE (=1) if FITS file may have extensions, else FALSE (=0) +extname - value of the EXTNAME keyword (null-terminated) +extspec - the extension or HDU specifier; a number or name, version, and type +extver - value of the EXTVER keyword = integer version number +filename - full name of the FITS file, including optional HDU and filtering specs +filetype - type of file (file://, ftp://, http://, etc.) +filter - the input file filtering specifier +firstchar- starting byte in the row (first byte of row = 1) +firstfailed - member HDU ID (if positive) or grouping table GRPIDn index + value (if negative) that failed grouping table verification. +firstelem- first element in a vector (ignored for ASCII tables) +firstrow - starting row number (first row of table = 1) +following- if TRUE, any HDUs following the current HDU will be copied +fpixel - coordinate of the first pixel to be read or written in the + FITS array. The array must be of length NAXIS and have values such + that fpixel[0] is in the range 1 to NAXIS1, fpixel[1] is in the + range 1 to NAXIS2, etc. +fptr - pointer to a 'fitsfile' structure describing the FITS file. +frac - factional part of the keyword value +gcount - number of groups in the primary array (usually = 1) +gfptr - fitsfile* pointer to a grouping table HDU. +group - GRPIDn/GRPLCn index value identifying a grouping table HDU, or + data group number (=0 for non-grouped data) +grouptype - Grouping table parameter that specifies the columns to be + created in a grouping table HDU. Allowed values are: GT_ID_ALL_URI, + GT_ID_REF, GT_ID_POS, GT_ID_ALL, GT_ID_REF_URI, and GT_ID_POS_URI. +grpname - value to use for the GRPNAME keyword value. +hdunum - sequence number of the HDU (Primary array = 1) +hduok - was the HDU verification successful (=1) or + not (= -1). Equals zero if the CHECKSUM keyword is not present. +hdusum - 32 bit 1's complement checksum for the entire CHDU +hdutype - type of HDU: IMAGE_HDU (=0), ASCII_TBL (=1), or BINARY_TBL (=2) +header - returned character string containing all the keyword records +headstart- starting address (in bytes) of the CHDU +heapsize - size of the binary table heap, in bytes +history - the HISTORY keyword comment string (70 char max, null-terminated) +hour - hour within day (UTC) (0 - 23) +inc - sampling interval for pixels in each FITS dimension +inclist - array of pointers to matching keyword names +incolnum - input column number; range = 1 to TFIELDS +infile - the input filename, including path if specified +infptr - pointer to a 'fitsfile' structure describing the input FITS file. +intval - integer part of the keyword value +iomode - file access mode: either READONLY (=0) or READWRITE (=1) +keyname - name of a keyword (8 char max, null-terminated) +keynum - position of keyword in header (1st keyword = 1) +keyroot - root string for the keyword name (5 char max, null-terminated) +keysexist- number of existing keyword records in the CHU +keytype - header record type: -1=delete; 0=append or replace; + 1=append; 2=this is the END keyword +longstr - arbitrarily long string keyword value (null-terminated) +lpixel - coordinate of the last pixel to be read or written in the + FITS array. The array must be of length NAXIS and have values such + that lpixel[0] is in the range 1 to NAXIS1, lpixel[1] is in the + range 1 to NAXIS2, etc. +match - TRUE (=1) if the 2 strings match, else FALSE (=0) +maxdim - maximum number of values to return +member - row number of a grouping table member HDU. +memptr - pointer to the a FITS file in memory +mem_realloc - pointer to a function for reallocating more memory +memsize - size of the memory block allocated for the FITS file +mfptr - fitsfile* pointer to a grouping table member HDU. +mgopt - grouping table merge option parameter. Allowed values are: + OPT_MRG_COPY, and OPT_MRG_MOV. +minute - minute within hour (UTC) (0 - 59) +month - calendar month (UTC) (1 - 12) +morekeys - space in the header for this many more keywords +n_good_rows - number of rows evaluating to TRUE +namelist - string containing a comma or space delimited list of names +naxes - size of each dimension in the FITS array +naxis - number of dimensions in the FITS array +naxis1 - length of the X/first axis of the FITS array +naxis2 - length of the Y/second axis of the FITS array +naxis3 - length of the Z/third axis of the FITS array +nchars - number of characters to read or write +nelements- number of data elements to read or write +newfptr - returned pointer to the reopened file +newveclen- new value for the column vector repeat parameter +nexc - number of names in the exclusion list (may = 0) +nfound - number of keywords found (highest keyword number) +nkeys - number of keywords in the sequence +ninc - number of names in the inclusion list +nmembers - Number of grouping table members (NAXIS2 value). +nmove - number of HDUs to move (+ or -), relative to current position +nocomments - if equal to TRUE, then no commentary keywords will be copied +noisebits- number of bits to ignore when compressing floating point images +nrows - number of rows in the table +nstart - first integer value +nullarray- set to TRUE (=1) if corresponding data element is undefined +nulval - numerical value to represent undefined pixels +nulstr - character string used to represent undefined values in ASCII table +numval - numerical data value, of the appropriate data type +offset - byte offset in the heap to the first element of the vector +openfptr - pointer to a currently open FITS file +overlap - number of bytes in the binary table heap pointed to by more than 1 + descriptor +outcolnum- output column number; range = 1 to TFIELDS + 1 +outfile - and optional output filename; the input file will be copied to this prior + to opening the file +outfptr - pointer to a 'fitsfile' structure describing the output FITS file. +pcount - value of the PCOUNT keyword = size of binary table heap +previous - if TRUE, any previous HDUs in the input file will be copied. +repeat - length of column vector (e.g. 12J); == 1 for ASCII table +rmopt - grouping table remove option parameter. Allowed values are: + OPT_RM_GPT, OPT_RM_ENTRY, OPT_RM_MBR, and OPT_RM_ALL. +rootname - root filename, minus any extension or filtering specifications +rot - celestial coordinate rotation angle (degrees) +rowlen - length of a table row, in characters or bytes +rowlist - sorted list of row numbers to be deleted from the table +rownum - number of the row (first row = 1) +rowrange - list of rows or row ranges: '3,6-8,12,56-80' or '500-' +row_status - array of True/False results for each row that was evaluated +scale - linear scaling factor; true value = (FITS value) * scale + zero +second - second within minute (0 - 60.9999999999) (leap second!) +simple - TRUE (=1) if FITS file conforms to the Standard, else FALSE (=0) +space - number of blank spaces to leave between ASCII table columns +status - returned error status code (0 = OK) +sum - 32 bit unsigned checksum value +tbcol - byte position in row to start of column (1st col has tbcol = 1) +tdisp - Fortran style display format for the table column +tdimstr - the value of the TDIMn keyword +templt - template string used in comparison (null-terminated) +tfields - number of fields (columns) in the table +tfopt - grouping table member transfer option parameter. Allowed values are: + OPT_MCP_ADD, and OPT_MCP_MOV. +tform - format of the column (null-terminated); allowed values are: + ASCII tables: Iw, Aw, Fww.dd, Eww.dd, or Dww.dd + Binary tables: rL, rX, rB, rI, rJ, rA, rAw, rE, rD, rC, rM + where 'w'=width of the field, 'd'=no. of decimals, 'r'=repeat count. + Variable length array columns are denoted by a '1P' before the data type + character (e.g., '1PJ'). When creating a binary table, 2 addition tform + data type codes are recognized by CFITSIO: 'rU' and 'rV' for unsigned + 16-bit and unsigned 32-bit integer, respectively. + +theap - zero indexed byte offset of starting address of the heap + relative to the beginning of the binary table data +tilesize - array of length NAXIS that specifies the dimensions of + the image compression tiles +ttype - label or name for table column (null-terminated) +tunit - physical unit for table column (null-terminated) +typechar - symbolic code of the table column data type +typecode - data type code of the table column. The negative of + the value indicates a variable length array column. + Datatype typecode Mnemonic + bit, X 1 TBIT + byte, B 11 TBYTE + logical, L 14 TLOGICAL + ASCII character, A 16 TSTRING + short integer, I 21 TSHORT + integer, J 41 TINT32BIT + long long integer, K 81 TLONGLONG + real, E 42 TFLOAT + double precision, D 82 TDOUBLE + complex, C 83 TCOMPLEX + double complex, M 163 TDBLCOMPLEX + The TLONGLONG column type is experimental and is not + recognized in the official FITS Standard document +unit - the physical unit string (e.g., 'km/s') for a keyword +unused - number of unused bytes in the binary table heap +urltype - the file type of the FITS file (file://, ftp://, mem://, etc.) +validheap- returned value = FALSE if any of the variable length array + address are outside the valid range of addresses in the heap +value - the keyword value string (70 char max, null-terminated) +version - current version number of the CFITSIO library +width - width of the character string field +xcol - number of the column containing the X coordinate values +xinc - X axis coordinate increment at reference pixel (deg) +xpix - X axis pixel location +xpos - X axis celestial coordinate (usually RA) (deg) +xrefpix - X axis reference pixel array location +xrefval - X axis coordinate value at the reference pixel (deg) +ycol - number of the column containing the X coordinate values +year - calendar year (e.g. 1999, 2000, etc) +yinc - Y axis coordinate increment at reference pixel (deg) +ypix - y axis pixel location +ypos - y axis celestial coordinate (usually DEC) (deg) +yrefpix - Y axis reference pixel array location +yrefval - Y axis coordinate value at the reference pixel (deg) +zero - scaling offset; true value = (FITS value) * scale + zero +\end{verbatim} + +\chapter{CFITSIO Error Status Codes } + +The following table lists all the error status codes used by CFITSIO. +Programmers are encouraged to use the symbolic mnemonics (defined in +the file fitsio.h) rather than the actual integer status values to +improve the readability of their code. + +\begin{verbatim} + Symbolic Const Value Meaning + -------------- ----- ----------------------------------------- + 0 OK, no error + SAME_FILE 101 input and output files are the same + TOO_MANY_FILES 103 tried to open too many FITS files at once + FILE_NOT_OPENED 104 could not open the named file + FILE_NOT_CREATED 105 could not create the named file + WRITE_ERROR 106 error writing to FITS file + END_OF_FILE 107 tried to move past end of file + READ_ERROR 108 error reading from FITS file + FILE_NOT_CLOSED 110 could not close the file + ARRAY_TOO_BIG 111 array dimensions exceed internal limit + READONLY_FILE 112 Cannot write to readonly file + MEMORY_ALLOCATION 113 Could not allocate memory + BAD_FILEPTR 114 invalid fitsfile pointer + NULL_INPUT_PTR 115 NULL input pointer to routine + SEEK_ERROR 116 error seeking position in file + + BAD_URL_PREFIX 121 invalid URL prefix on file name + TOO_MANY_DRIVERS 122 tried to register too many IO drivers + DRIVER_INIT_FAILED 123 driver initialization failed + NO_MATCHING_DRIVER 124 matching driver is not registered + URL_PARSE_ERROR 125 failed to parse input file URL + RANGE_PARSE_ERROR 126 parse error in range list + + SHARED_BADARG 151 bad argument in shared memory driver + SHARED_NULPTR 152 null pointer passed as an argument + SHARED_TABFULL 153 no more free shared memory handles + SHARED_NOTINIT 154 shared memory driver is not initialized + SHARED_IPCERR 155 IPC error returned by a system call + SHARED_NOMEM 156 no memory in shared memory driver + SHARED_AGAIN 157 resource deadlock would occur + SHARED_NOFILE 158 attempt to open/create lock file failed + SHARED_NORESIZE 159 shared memory block cannot be resized at the moment + + HEADER_NOT_EMPTY 201 header already contains keywords + KEY_NO_EXIST 202 keyword not found in header + KEY_OUT_BOUNDS 203 keyword record number is out of bounds + VALUE_UNDEFINED 204 keyword value field is blank + NO_QUOTE 205 string is missing the closing quote + BAD_KEYCHAR 207 illegal character in keyword name or card + BAD_ORDER 208 required keywords out of order + NOT_POS_INT 209 keyword value is not a positive integer + NO_END 210 couldn't find END keyword + BAD_BITPIX 211 illegal BITPIX keyword value + BAD_NAXIS 212 illegal NAXIS keyword value + BAD_NAXES 213 illegal NAXISn keyword value + BAD_PCOUNT 214 illegal PCOUNT keyword value + BAD_GCOUNT 215 illegal GCOUNT keyword value + BAD_TFIELDS 216 illegal TFIELDS keyword value + NEG_WIDTH 217 negative table row size + NEG_ROWS 218 negative number of rows in table + COL_NOT_FOUND 219 column with this name not found in table + BAD_SIMPLE 220 illegal value of SIMPLE keyword + NO_SIMPLE 221 Primary array doesn't start with SIMPLE + NO_BITPIX 222 Second keyword not BITPIX + NO_NAXIS 223 Third keyword not NAXIS + NO_NAXES 224 Couldn't find all the NAXISn keywords + NO_XTENSION 225 HDU doesn't start with XTENSION keyword + NOT_ATABLE 226 the CHDU is not an ASCII table extension + NOT_BTABLE 227 the CHDU is not a binary table extension + NO_PCOUNT 228 couldn't find PCOUNT keyword + NO_GCOUNT 229 couldn't find GCOUNT keyword + NO_TFIELDS 230 couldn't find TFIELDS keyword + NO_TBCOL 231 couldn't find TBCOLn keyword + NO_TFORM 232 couldn't find TFORMn keyword + NOT_IMAGE 233 the CHDU is not an IMAGE extension + BAD_TBCOL 234 TBCOLn keyword value < 0 or > rowlength + NOT_TABLE 235 the CHDU is not a table + COL_TOO_WIDE 236 column is too wide to fit in table + COL_NOT_UNIQUE 237 more than 1 column name matches template + BAD_ROW_WIDTH 241 sum of column widths not = NAXIS1 + UNKNOWN_EXT 251 unrecognizable FITS extension type + UNKNOWN_REC 252 unknown record; 1st keyword not SIMPLE or XTENSION + END_JUNK 253 END keyword is not blank + BAD_HEADER_FILL 254 Header fill area contains non-blank chars + BAD_DATA_FILL 255 Illegal data fill bytes (not zero or blank) + BAD_TFORM 261 illegal TFORM format code + BAD_TFORM_DTYPE 262 unrecognizable TFORM data type code + BAD_TDIM 263 illegal TDIMn keyword value + BAD_HEAP_PTR 264 invalid BINTABLE heap pointer is out of range + + BAD_HDU_NUM 301 HDU number < 1 + BAD_COL_NUM 302 column number < 1 or > tfields + NEG_FILE_POS 304 tried to move to negative byte location in file + NEG_BYTES 306 tried to read or write negative number of bytes + BAD_ROW_NUM 307 illegal starting row number in table + BAD_ELEM_NUM 308 illegal starting element number in vector + NOT_ASCII_COL 309 this is not an ASCII string column + NOT_LOGICAL_COL 310 this is not a logical data type column + BAD_ATABLE_FORMAT 311 ASCII table column has wrong format + BAD_BTABLE_FORMAT 312 Binary table column has wrong format + NO_NULL 314 null value has not been defined + NOT_VARI_LEN 317 this is not a variable length column + BAD_DIMEN 320 illegal number of dimensions in array + BAD_PIX_NUM 321 first pixel number greater than last pixel + ZERO_SCALE 322 illegal BSCALE or TSCALn keyword = 0 + NEG_AXIS 323 illegal axis length < 1 + + NOT_GROUP_TABLE 340 Grouping function error + HDU_ALREADY_MEMBER 341 + MEMBER_NOT_FOUND 342 + GROUP_NOT_FOUND 343 + BAD_GROUP_ID 344 + TOO_MANY_HDUS_TRACKED 345 + HDU_ALREADY_TRACKED 346 + BAD_OPTION 347 + IDENTICAL_POINTERS 348 + BAD_GROUP_ATTACH 349 + BAD_GROUP_DETACH 350 + + NGP_NO_MEMORY 360 malloc failed + NGP_READ_ERR 361 read error from file + NGP_NUL_PTR 362 null pointer passed as an argument. + Passing null pointer as a name of + template file raises this error + NGP_EMPTY_CURLINE 363 line read seems to be empty (used + internally) + NGP_UNREAD_QUEUE_FULL 364 cannot unread more then 1 line (or single + line twice) + NGP_INC_NESTING 365 too deep include file nesting (infinite + loop, template includes itself ?) + NGP_ERR_FOPEN 366 fopen() failed, cannot open template file + NGP_EOF 367 end of file encountered and not expected + NGP_BAD_ARG 368 bad arguments passed. Usually means + internal parser error. Should not happen + NGP_TOKEN_NOT_EXPECT 369 token not expected here + + BAD_I2C 401 bad int to formatted string conversion + BAD_F2C 402 bad float to formatted string conversion + BAD_INTKEY 403 can't interpret keyword value as integer + BAD_LOGICALKEY 404 can't interpret keyword value as logical + BAD_FLOATKEY 405 can't interpret keyword value as float + BAD_DOUBLEKEY 406 can't interpret keyword value as double + BAD_C2I 407 bad formatted string to int conversion + BAD_C2F 408 bad formatted string to float conversion + BAD_C2D 409 bad formatted string to double conversion + BAD_DATATYPE 410 illegal datatype code value + BAD_DECIM 411 bad number of decimal places specified + NUM_OVERFLOW 412 overflow during data type conversion + DATA_COMPRESSION_ERR 413 error compressing image + DATA_DECOMPRESSION_ERR 414 error uncompressing image + + BAD_DATE 420 error in date or time conversion + + PARSE_SYNTAX_ERR 431 syntax error in parser expression + PARSE_BAD_TYPE 432 expression did not evaluate to desired type + PARSE_LRG_VECTOR 433 vector result too large to return in array + PARSE_NO_OUTPUT 434 data parser failed not sent an out column + PARSE_BAD_COL 435 bad data encounter while parsing column + PARSE_BAD_OUTPUT 436 Output file not of proper type + + ANGLE_TOO_BIG 501 celestial angle too large for projection + BAD_WCS_VAL 502 bad celestial coordinate or pixel value + WCS_ERROR 503 error in celestial coordinate calculation + BAD_WCS_PROJ 504 unsupported type of celestial projection + NO_WCS_KEY 505 celestial coordinate keywords not found + APPROX_WCS_KEY 506 approximate wcs keyword values were returned +\end{verbatim} +\end{document} + diff --git a/pkg/tbtables/cfitsio/cfitsio.toc b/pkg/tbtables/cfitsio/cfitsio.toc new file mode 100644 index 00000000..6a396d85 --- /dev/null +++ b/pkg/tbtables/cfitsio/cfitsio.toc @@ -0,0 +1,118 @@ +\contentsline {chapter}{\numberline {1}Introduction }{1} +\contentsline {section}{\numberline {1.1} A Brief Overview}{1} +\contentsline {section}{\numberline {1.2}Sources of FITS Software and Information}{1} +\contentsline {section}{\numberline {1.3}Acknowledgements}{2} +\contentsline {section}{\numberline {1.4}Legal Stuff}{3} +\contentsline {chapter}{\numberline {2} Creating the CFITSIO Library }{5} +\contentsline {section}{\numberline {2.1}Building the Library}{5} +\contentsline {subsection}{\numberline {2.1.1}Unix Systems}{5} +\contentsline {subsection}{\numberline {2.1.2}VMS}{7} +\contentsline {subsection}{\numberline {2.1.3}Windows PCs}{7} +\contentsline {subsection}{\numberline {2.1.4}Macintosh PCs}{7} +\contentsline {section}{\numberline {2.2}Testing the Library}{8} +\contentsline {section}{\numberline {2.3}Linking Programs with CFITSIO}{9} +\contentsline {section}{\numberline {2.4}Getting Started with CFITSIO}{9} +\contentsline {section}{\numberline {2.5}Example Program}{10} +\contentsline {chapter}{\numberline {3} A FITS Primer }{13} +\contentsline {chapter}{\numberline {4} Programming Guidelines }{15} +\contentsline {section}{\numberline {4.1}CFITSIO Definitions}{15} +\contentsline {section}{\numberline {4.2}Current Header Data Unit (CHDU)}{17} +\contentsline {section}{\numberline {4.3}Function Names and Variable Datatypes}{18} +\contentsline {section}{\numberline {4.4}Support for Unsigned Integers and Signed Bytes}{19} +\contentsline {section}{\numberline {4.5}Dealing with Character Strings}{21} +\contentsline {section}{\numberline {4.6}Implicit Data Type Conversion}{22} +\contentsline {section}{\numberline {4.7}Data Scaling}{22} +\contentsline {section}{\numberline {4.8}Support for IEEE Special Values}{23} +\contentsline {section}{\numberline {4.9}Error Status Values and the Error Message Stack}{23} +\contentsline {section}{\numberline {4.10}Variable-Length Arrays in Binary Tables}{24} +\contentsline {section}{\numberline {4.11}Multiple Access to the Same FITS File}{25} +\contentsline {section}{\numberline {4.12}When the Final Size of the FITS HDU is Unknown}{26} +\contentsline {section}{\numberline {4.13}CFITSIO Size Limitations}{26} +\contentsline {chapter}{\numberline {5}Basic CFITSIO Interface Routines }{29} +\contentsline {section}{\numberline {5.1}CFITSIO Error Status Routines}{29} +\contentsline {section}{\numberline {5.2}FITS File Access Routines}{30} +\contentsline {section}{\numberline {5.3}HDU Access Routines}{33} +\contentsline {section}{\numberline {5.4}Header Keyword Read/Write Routines}{35} +\contentsline {subsection}{\numberline {5.4.1}Keyword Reading Routines}{35} +\contentsline {subsection}{\numberline {5.4.2}Keyword Writing Routines}{37} +\contentsline {section}{\numberline {5.5}Primary Array or IMAGE Extension I/O Routines}{39} +\contentsline {section}{\numberline {5.6}Image Compression}{42} +\contentsline {section}{\numberline {5.7}ASCII and Binary Table Routines}{45} +\contentsline {subsection}{\numberline {5.7.1}Create New Table}{45} +\contentsline {subsection}{\numberline {5.7.2}Column Information Routines}{46} +\contentsline {subsection}{\numberline {5.7.3}Routines to Edit Rows or Columns}{48} +\contentsline {subsection}{\numberline {5.7.4}Read and Write Column Data Routines}{50} +\contentsline {subsection}{\numberline {5.7.5}Row Selection and Calculator Routines}{51} +\contentsline {section}{\numberline {5.8}Utility Routines}{53} +\contentsline {subsection}{\numberline {5.8.1}File Checksum Routines}{53} +\contentsline {subsection}{\numberline {5.8.2}Date and Time Utility Routines}{54} +\contentsline {subsection}{\numberline {5.8.3}General Utility Routines}{56} +\contentsline {chapter}{\numberline {6} The CFITSIO Iterator Function }{63} +\contentsline {section}{\numberline {6.1}The Iterator Work Function}{64} +\contentsline {section}{\numberline {6.2}The Iterator Driver Function}{66} +\contentsline {section}{\numberline {6.3}Guidelines for Using the Iterator Function}{67} +\contentsline {section}{\numberline {6.4}Complete List of Iterator Routines}{68} +\contentsline {chapter}{\numberline {7} Celestial Coordinate System Routines }{71} +\contentsline {section}{\numberline {7.1} Self-contained WCS Routines}{72} +\contentsline {chapter}{\numberline {8} Hierarchical Grouping Routines }{75} +\contentsline {section}{\numberline {8.1}Grouping Table Routines}{76} +\contentsline {section}{\numberline {8.2}Group Member Routines}{78} +\contentsline {chapter}{\numberline {9} Specialized CFITSIO Interface Routines }{81} +\contentsline {section}{\numberline {9.1}FITS File Access Routines}{81} +\contentsline {section}{\numberline {9.2}HDU Access Routines}{84} +\contentsline {section}{\numberline {9.3}Specialized Header Keyword Routines}{86} +\contentsline {subsection}{\numberline {9.3.1}Header Information Routines}{86} +\contentsline {subsection}{\numberline {9.3.2}Read and Write the Required Keywords}{86} +\contentsline {subsection}{\numberline {9.3.3}Write Keyword Routines}{88} +\contentsline {subsection}{\numberline {9.3.4}Insert Keyword Routines}{90} +\contentsline {subsection}{\numberline {9.3.5}Read Keyword Routines}{91} +\contentsline {subsection}{\numberline {9.3.6}Modify Keyword Routines}{92} +\contentsline {subsection}{\numberline {9.3.7}Update Keyword Routines}{93} +\contentsline {section}{\numberline {9.4}Define Data Scaling and Undefined Pixel Parameters}{94} +\contentsline {section}{\numberline {9.5}Specialized FITS Primary Array or IMAGE Extension I/O Routines}{95} +\contentsline {section}{\numberline {9.6}Specialized FITS ASCII and Binary Table Routines}{99} +\contentsline {subsection}{\numberline {9.6.1}General Column Routines}{99} +\contentsline {subsection}{\numberline {9.6.2}Low-Level Table Access Routines}{100} +\contentsline {subsection}{\numberline {9.6.3}Write Column Data Routines}{100} +\contentsline {subsection}{\numberline {9.6.4}Read Column Data Routines}{102} +\contentsline {chapter}{\numberline {10} Extended File Name Syntax }{105} +\contentsline {section}{\numberline {10.1}Overview}{105} +\contentsline {section}{\numberline {10.2}Filetype}{108} +\contentsline {subsection}{\numberline {10.2.1}Notes about HTTP proxy servers}{108} +\contentsline {subsection}{\numberline {10.2.2}Notes about the root filetype}{108} +\contentsline {subsection}{\numberline {10.2.3}Notes about the shmem filetype:}{110} +\contentsline {section}{\numberline {10.3}Base Filename}{111} +\contentsline {section}{\numberline {10.4}Output File Name when Opening an Existing File}{113} +\contentsline {section}{\numberline {10.5}Template File Name when Creating a New File}{114} +\contentsline {section}{\numberline {10.6}Image Tile-Compression Specification}{114} +\contentsline {section}{\numberline {10.7}HDU Location Specification}{115} +\contentsline {section}{\numberline {10.8}Image Section}{116} +\contentsline {section}{\numberline {10.9}Column and Keyword Filtering Specification}{117} +\contentsline {section}{\numberline {10.10}Row Filtering Specification}{118} +\contentsline {subsection}{\numberline {10.10.1}General Syntax}{119} +\contentsline {subsection}{\numberline {10.10.2}Bit Masks}{121} +\contentsline {subsection}{\numberline {10.10.3}Vector Columns}{122} +\contentsline {subsection}{\numberline {10.10.4}Good Time Interval Filtering}{123} +\contentsline {subsection}{\numberline {10.10.5}Spatial Region Filtering}{124} +\contentsline {subsection}{\numberline {10.10.6}Example Row Filters}{126} +\contentsline {section}{\numberline {10.11} Binning or Histogramming Specification}{127} +\contentsline {chapter}{\numberline {11}Template Files }{131} +\contentsline {section}{\numberline {11.1}Detailed Template Line Format}{131} +\contentsline {section}{\numberline {11.2}Auto-indexing of Keywords}{132} +\contentsline {section}{\numberline {11.3}Template Parser Directives}{133} +\contentsline {section}{\numberline {11.4}Formal Template Syntax}{133} +\contentsline {section}{\numberline {11.5}Errors}{134} +\contentsline {section}{\numberline {11.6}Examples}{134} +\contentsline {chapter}{\numberline {12} Local FITS Conventions }{137} +\contentsline {section}{\numberline {12.1}64-Bit Long Integers}{137} +\contentsline {section}{\numberline {12.2}Long String Keyword Values.}{138} +\contentsline {section}{\numberline {12.3}Arrays of Fixed-Length Strings in Binary Tables}{139} +\contentsline {section}{\numberline {12.4}Keyword Units Strings}{139} +\contentsline {section}{\numberline {12.5}HIERARCH Convention for Extended Keyword Names}{140} +\contentsline {section}{\numberline {12.6}Tile-Compressed Image Format}{140} +\contentsline {chapter}{\numberline {13} Optimizing Programs }{143} +\contentsline {section}{\numberline {13.1}How CFITSIO Manages Data I/O}{143} +\contentsline {section}{\numberline {13.2}Optimization Strategies}{144} +\contentsline {chapter}{\numberline {A}Index of Routines }{147} +\contentsline {chapter}{\numberline {B}Parameter Definitions }{151} +\contentsline {chapter}{\numberline {C}CFITSIO Error Status Codes }{157} diff --git a/pkg/tbtables/cfitsio/cfitsio_mac.sit.hqx b/pkg/tbtables/cfitsio/cfitsio_mac.sit.hqx new file mode 100644 index 00000000..0a3dbdfb --- /dev/null +++ b/pkg/tbtables/cfitsio/cfitsio_mac.sit.hqx @@ -0,0 +1 @@ +(This file must be converted with BinHex 4.0) :$f0QDA4cD@pIE@&M,R0TG!"6594%8dP8)3#3"%11!*!%4HY6593K!!%!!%11FNa KG3*6!*!$&ZlZ)#!,BfCTG(0TEepYB@-!N"AR#BB"&J!9!U)"eJ#3!`-!N!q'!!! $([q3"!2JYCR`K,@Cp[N!N!8"mK%!N!C$#2r`rrJ!!-0!!!"0Y`!0$N0'DA4cD@p 38%-ZE@0`!*!4Da3*KJ#3$aB!!$i$!*!$&[q3"%e08(*$9dP&!3#[H%fHYCRfmJ# 3"3(U0!#3"Md0!!"9XJ#3"[8H"[LUJEpCRC+&h2,Qp5XR2!PhHq4S2H%,ApKQqmJ LNkpp8AlddNfr[1A)MP#1Tai![I"-haEmadlZiRN5eLh2&pPQYb@hMpc#pMQahU[ MjF@A)`YEb',mbF)EN!#&l)[`r)9RmFZHm#-lbAEK#qr)l6MKLpjbR($&#Ur-Vr0 fK0r#Ma`RA-)l22Q&,13AFTY-&L1cK5jN"9K($6SEG(C1mZ4R0R4JEhDp%a[NjC! $GhCHIV6,b@DM((4ffHR#LbqH!ph[phRj4[C&&ShX)r[YiRdmbHkebmMq[(KN$cV cFa#2l)[X86b,,-plB#b!Vl2VCAikk,fqbH,(bq[*l53meJ,!&[`"jhIkI5f1'd% 3,!Q#dUUJp-!lJY+$p5"BH5ma(bKeP6LDVcDZZdeKNN4a8UiQm9CAbqCLA5QIqP[ XPi0Jl8H#i"hHrpUqXi,J3lqkj2T6Yh"H2r[XNdTd(rB03A$L`5"Bk[dc2RMIZPh "b@rE'34[ackdki2h"FF(`H@c#NqI)P4GS[!F,Pp*9ei&5TqF6!e5'Z+9D"fM`h3 SKb"@J#a`!MD',FIf`[E'9Q$lB2YLqf(lBdr#RS`GJ$d&1a!l&(XDGKKf1,B5HcV f$1`)l*RBNGLcX'GMcm'HKld!Hb&f0$D-(B3GV&F8@iSYXeH9XJm!'S'I``l"RSX p(cX+1aCEK4f((@pf`QYP)SqYmP[j5"8[%qfa(pAKIHX%hY3A6jljZ2T8+l$Y9P+ 9ZSABJ5Ud2KH'fm*+)da6PhC[$C1M&eJq8#d2EIU0kPcTFK1[N!#9EL'@!Z3P+,c -9icR6L[c8`j9I`iR[I25%D#SDkA4H$YaNp&-Gc1XG32c$IHfjC@#kiCLM)K%k9U d0C!!+Y"B$PJ09iKRp+T'ImNm&#%J!p"afpL5RV[@,,R`mrF[ZH#ElqrD[qq5V[h AhHR6KErIYIm6PcaA6"*I""A*,da(Ij9Gqfr-+elX!'`CYKcE#pX2#j!!mKDmMrF f[!P[`aGVCh(5hqLkFX8[lETZ[FY'fki@68BZ'4rrPF(qU1%Ur52RpBmU,(M&e-r [ZMjp9qrk4M`40Y,amE22fMMRMCjalUk29a)ACUirLCZM'DkYiq-#6)e-2)$BNji $[H19,-l5)CG-ZI*`jkGdGbVIp'Te-(q&F1rJqXfekDJZ"VeXY&TjXIkPJR"+B'p X,f`j0LE!&GXAfcq[XZ"cN!$HrL9`cYkY)A1@E%VP'l5+hlRcbk0[mTDf2KX`YaX e[DrL-$5@ED`1G2ZkcR%$Fa@`J+rA8&Ll`)9ePk4(B5"I%%P5e4$j5bD8ZL99"C' %"%)')C`36FJTK2"&@%JPj,)HqlYBb1JU,136iJN"K@"#6L'VI1!b4*@kJP$@BGG L4Gh4a",#Z4rl8L`BHMX@BVS-#r0EJEd4Za,lHpJef*Z`P0R0f&Z`eGL*@0jl&aD -K&[`XMABGGK*f-RBLl$)*TGJT`JBa8l$6XI1`0CLRiqGLGf"[3%,JGq$I3N@rVF HHkYa$AMM[GJAB+r&3Z`KlK"pb2NXib@3!(k)1%)!K2[P15X)"&GM)IQ)!4"pq!T #!&`#-@!$&R5![%2Qlm4HJpf%I4lfaGM0@05cV9J)r6EXE1`Fl+ABZGKjf-Z`ml% ,X*GM&f,"JLZ`,m3ZaYiPU$4)UGRfhGJP@0',!Vq$[4Ul&,YDF#,f+Zc[B+r%hS0 YCr+j6bUTE-2`KTkK[Zkqc5UCjSmUeDA%`6[rejF4)l,TiR`brVA3*Hm,%a+b-,* 3m2Vmm)Grm!5eR`CPMk%khMkK4`-Vr9'@4R'j@Uf8aebD5H$HN!#%3R@q1)AA(!- ,*PeY!S[6i&1kHG`*(+DSEhGqHe)rN3YqQb2j1!RK3Fcr%)dV5eHAPR@*'(UI%,* )f"hrVb$680&UjfB4V1HqC*df[aL&i!5iCF2hhkV$Xr!4rp,Nc`R6Uq!!q&D2TeQ B,2,38L0LY!''CqYC[k2Ei6&eaif6jJX[#J$6`Cm+2mfIND*raNQlmN!cYD6qDhR iehPEAiE`T##&'[YlPQU9DGfVFiN+aG3d"p9Cr"U,Il(jejT5GAfZ@k+UQ[MRfAQ c2FC,l,`Pec"4*3dBEV-mfqdq1r+cj1VIXf&dS&`T9q*@'MGFZEpRl,pCY8HMYE" hS,I"43%j5H+E+PXTX"5C[L@5"*hjT*ck(p+-T'pPA6eAME"lC``ZA"'DN9&,k4l 3V35k$q"r4B!'5-[V2ffqh+G,[2'9A[C+-mQ4Hce6diRfMY3c"p(TcH-lB&51Ndq [$2IfR9iq[EGRV)IMSS(+Q"TA(#UI-kB[e`fL%R@hP1SR6VjaNXdRhjpH,Bp,dX- 85VFXPH*+Ve+iDrm(e&0&Ve"NH8pG[9G[aNDV88Xp2hqKFUUVaZSTqNGXbG"!4Xq 8bTZ'GimiHUU8),CXb,ASJe,U*bV2S1[LSrHS&biT)+AqS0jakVLrZJPI4G4Sb2F KI(e'Ym6dEDP[iqYl396Ar5"4rBELEIL#kKRV6eqQj!ZUEqNNA2)f3I8iREc$9HK &#UVhD8!MdYX%2iA[&-[h-AbRCT8ahLri(A`$XmE&p*Q&T$F-LPS9hLDN(V6"PDa ",eG)Z[q3!%E()H'(e&meY,&XP$Z&e&pfQ[Lcq2i3hl$H*#3qp(Pm`mH5N!#qYG" Am9@Z)&"m2m3RI@k)kQ(eJCh4UMYU+kbqY4'4VK%i6Ve5CrSqeV#8FGk"12VGk!r $pa!(5f(#AqC!2adqDY(fiN@NcG"I4`Pc2VpVrar!jb2U@EXJ1+&1r868mdCr(MR S4k1h$YmIF"MYm5$bjrM'H$b)2)"[V-H$b02iUM`H409R0XlM395pGH-p(N69qcA "id&8Me[Ym5#UrVf*(JqLYq#VmAJ3r5+q54i2SUV,b4i2BY+4,[*i%"0ZAHca)#E "i"+2"c(edNhap4h6@dleH"$6@dlcH"#l(Crdl9&rXDrMQf(jrN8BD2#J4$ed-cd HP+JAF*E(Ja,9j@b2"bAUmC[MmD"%IAQAHM`S89h1pAK3mL9mmc`HP$b+lc+2"k8 5$HCl2#K92b5pGG,69kSq3hVXj+e,e50*Vaep[26@JFY5ck9-Cp#pGb+2P0l"'5b @[X(5KcR6FbFpJDA2F1DY"&r+K$(df8Q2AjNN#RV[D)AQE[4,#T%S8lI3e4Hj5kR 4-Y@Pp!U'`BNbeHAbJ@DEZLN6hUqSELU$ifArJ1rDLi,cHEpb[HA+4PY[@*lhGPD [8FYJZIM%kNEj21URA2fAer@A"lKRZCT**#re9hiG[M8HrmVr'YpDMhrPUX[Vam+ %ZLNAaXM!MNTk+hZT6h$pU-Y)dNYeZD'-8hc8aNBh'X*EHUQ2%8iL$6Qpe)F)&i" Z[)8$[!2I"cR3qiM[#3kf@kUh-'EEijG)[ZNYE"A9X6Fb@1qmVr06Tk9I`3FhZQ& UEINqI25GlR`m&i&k#f0f5C38hr[`lHETjEkpralI(QT,F+Zh4QcFL'STp95KZVa THQd2H&#KZYbl*48Z93J,ETDL+6lHlKDAPDRV#YAPmrhp+X4ME[AhUp#dNaHdfa( [A[(2q&iS495S%lfKYjhILAMR2Z*aq`+5L`pFS2F5HJ@hi!haJ@(dkq*l0`GkGI( "AH"Sq,l,!Ei$(D-h&@k)MjjFqPcaJ5P`,RcdfG)ELZr9(+K(I1!@ICriU(AH&Kr FL$jKB)aq9[J12VJ42Dri`$,H#Kq#*Afdq(kI!p0,m,fI`rhQq`+(9jM[D3k[p,l qkUGpPIRJ%16(4mm`Ei@2IPfCQ+*pVqG!MH0$#RfYq6l2!4c$pkmFb!-9T5rh!I2 "Ym"Y69(PS&[6a8H0[G&m$h*iNrR!@VJN[Up`J"FE1!m%0jZ2AQ[i1$kDcmL2Mcj TX!iIp3b'ib2[@mhh%3j[-aqm"$b"*S0rEcFII2%GjU-Iq*hQJr[#FI"4jqmb(hF $0r"pQ!1F%4riqV$hR5)qqKlc`6RIDcl`'mc%4rr`RjL2HRl%I0bCZXEhF3l`1(` #[`(K#45(RZX2Q)qHG$J&2[UBVAapUM$ecmd(VX%&m&&,F(Cme"rk!ckd"pj6[S' 5T)R&"pHKM["4hr"@I1!([!mI[%dQlfJIZ)$QJ)qhi`haJAr`GhcJabHmEj!!qVi rD6l`$jc("liqEMjkh)@(D"pi*ra%qkM$6jX2[Jk'ii0,`8IN'b`"L9Kmp,6rMIR SdIjEmr&qi"Xqm)Lh`NHGJ+[ii)*Ip,iK`Sm[Q3m0!Nk+$rjNCh)-%Ik"DILS[kq D$hcL,[LS5HS1hcFiJ#(b$C@fK#D!$r`!Zr$4RdiHI25pIp0mF",d%(aJ)PL"MjV mP[QHj2"YlcY0'XChc%G0`hI``5HrCcii#6`,(aJRlGRDalYc&rQ'5926ij6%"ip mbRa`EMJ12ZB4r,2ji#(8*Mk`$#d#(l8"*XJhA'm2VmG(EF&Pm-(RIQ3qCK[)j#E YJdZBKS2!,i06RZ3hR$VaY-&+HR)BCD0pdVR!U!cY%rk[V(HP%TkZE,j&*4LJV21 m%La6[PFR8+BfY1iRhqQ3!"5PZ32iC,k#XZ&"Ti-V5[L-6rLRm[e$J90d*p-E&$K &8kUBJB#21m%aj6Z$'+8q&(`bld'*fq)6,UM8RB42hPjTlJ3qiA)U*d[L%kaAiT, i"&18Y"hj4R"rTEN(q%6c8MD$B!6m@`N(m%R6K4)1ia0m9H+-q)5V+"0J4i#$5V- Em%QY+XePN!$[61+91#!qi@G+I!fID"h+jPbF#6iTm3Km`Tq8G#eme"ED*Ml"%@A khdMH9jRq0e,eD[@rNHKH-J(0q!5cPI!"Rf#U-[e[*&a#L42K%ka4QVdKheR5)Uh qGaEDJM,plbcTY,U[4Ac#GC8d"(c#Se6HkL)q`@@Pq4[bRDekdYd[iT2l+'N#q%5 I8MB)kQc9+0SJ2Z($5[-hm)&2k$Ri")Z9jQl)G`ieVc4r!jr-he$5ar#*0UE`Dap B`P`1I033A!DIm#*Pc86RJ*8UEp!@D96U5QPZ"ci4UT4`(KmD0CS92Z(j5T`&Rr! pC6hIjm)IP'CNb(FH'+5N1H160e,Lb2L%IfZY'jr`HbAZL8riZC)`KSpDK,2J%`k JT2R)GciiSU6riC2l+r%&I05LkB31R)NHSD6ri411UU6ri42HSU6rbAH"-"KHJ%p U3%Nc`3IfS2rK%ae(L8[L%be!5DI&*aa5D9B)2[#-H4hbA3Jf+Fe9`3G1S,AL%`e 'LI2L%ae%5EI%*aa4L8[L!hIYh+C4F!1PH5li`(+d3Aab0bAY!Kpe3lm"2Y%[P$J M2Z'd5[UEI+-e$3JY!TpJNl*T1+1&$I!eI+*Y+G2r4ZXH9[mE$3G@T[q0d6fXrMG '2!$p%"mD-9S%2UN6C3eBBlL2N[D,$fjN1pI(L"m`4`DID!R+QN2'S%FScB("ar[ "fI%*MeALJ2L%[bPV[KX,$e(LFIJ%aj8d0(b#IFSDmmH#"8VD&$jk)Y#kmFPE+-e N`5HkQa*ra`GqfbEqX@J$b[5rX@J0b[5rXA"eCIVI@''`eIr'`L&eMiCm9A!YCIT I&Ca%QIjA*IbcqPq9"K0BrDq+qP5Qre@T&Uhq9i@ZSdcrUd,E8UEr9D'c+02rUX4 6VIih6K1BV2ih$JkM62mETlYDr@mFpDa-raY(,QAkhcLpYpAraSN6@2e[($aFQIi h(XkQ62mE,jjKpEra`L5VrifRaT6TIq24pC6TIq24UT6TIq24!*6TIq09deErQb# 1CI@r#F*1Urp08(eBr@q#kX2UIa1)9kEr64"rYIVI"(36CITIYDCH@[f['JkT62q VKQmSdrqUK3G@rkY@69MpVaTG6jRq9bd-X2TIY6LheImQ`Vf9kAm6iA[+p,q*F!p PqYp%m@1Vrde869[pEb*kRc,pEk,iK0Ar*UVQV2jA)kjMpEmDiBI9rfVJ)FVd[aV a4D[reBMh@2f[4M9YpEmD0#aPqPm01SXbr@q5F06UIj2%JDcq0dPFfHTrNm"LCIV I*1'heImQkAj@rjXNc,$khb6d(@Akhf6a2k[r6BDl+Y2r*N[RX2VIC$#DbCY1Q3r PUGI)m,#a8r0&eSpX0(SE@2U'3ph*@k+**%a%KDVl"`Elb$c1cZ2Y2-(1ARb0R6I Cq@)lAf,R+ADHDZGTGTjZjaPfVVAc6$[2X[0X1mqamk9fRQ[RHADqc-lclEc!cTI EHD'G&pQjbXjAf(Q*RCIDq8SlAfARCADqfXlAf(QjR9IBq9SlVl6c+MZ[Y[0eGUk cmaSlVlAcHMY[X20'R4QRD2eEl,c9cY[X[(fKRS1[ca[ejqI&[%PGB)%ZZdBr1rG I5+G1BX"G+P[)XT6EZCHGbaDbPLe9`a@6MlL#66"J)8(jm[PHGbm&F`R9mMIP+G6 199HAPTr8cMVT@ppq8Y6+bT16mQpH03NBV@I5Bq8CNqdX16B3XA9FTSpccS'T%Dd 6a6TlfeeId-ZiA,F#p%CIKPll'2SfFYB3,HI`iJ#3!-`NXe%!81m40qN5ekU4Bcd c8mf`B!e[$H-fRA!IC'YVU"C)YdX4Y03&l6V*83$Z@a"ea3aSG0B-SN-(%cXH1`& EMDh"EX*HM,d%1`A,hJ(6X01a-l#ef*PBV@1*RB1p&$XA1`pl'ABqGJ(fFZa#l#* X&IB+l",X8Zb9f+Z`bl"ABkr",XHZ`&k,ABPGK9f0[3jEKef$ABYGMpf!hBMG)U! AZ`flAB43E"!E`SDa6F``*bPZAcaQVT!!#f(B[NrMM8l@TEAGAJP@lE`m1'lANU" mmEU6ejkQMR$h,Iph+Fb86idDE*i)l`JB3"QDfphM1@``eKN`"GY&mECQP3(DCC& 5D)qPlCDf@YTMDBZP(CD''0TZDBHPcC!!pN,D#QQ*T4@@&PKDAfPjTG@9&PGD@fP TTC@9'U$eN!#@3eS0D6'N$C2f5pSZDEHNMC-f6GSYDE1N[C)f6pSiDDpNE!MM3KJ 63SXPVC@d90*+53XPVC1d60)U5BXNVC'dJc*+K"%LM!jKC!JYXE6#dJ*,kbXYYE6 -d[T+bbZYVV6FdP*,UbXYN!#d2Y,b5,XVEDkdYp,@5MXVEDbdVp+f5VXUEDUdjY) @56XNEC!!M$pTfN(&@aQ#m3@-,@"F!@-6')[!Z!*[0aA'%M#1J$%%6EZQ-&l!@qH "-3+-9fKDhB(fFpV1D6HRcCcfGGV6D61R[CbfFYVED9rheQI`eQ9)VXS!2D)Yh&[ c)ENq"'h`Y(V6iZfY'q'Y%m+S$'3e2BP8V,GALaf*%Grki0Lq,ibZB'3&SbVS&'0 -"H-T["eJ[,8N''-!@$-@JE%(b48I'*X!BKpDpB%a!i`AS(Z-F3+-%8#@C)3!S`- B'F#S!-E)b2JBhHl2k"K'aL!m-'U'N6'-LQ&8#Qh"Y-VbCV6MmfkdS20fM)TK4)b -2p(M0'3X$+-dp!J0aX)`GS*DCK3-)f!BrF,)&aReSXF2b,JE4Q``@S14'S`BB*` 'Bc4S#kFGR$C`fVpTqkEPR*CbfVjTpkE0QjCd@XYT+DIeR(C[fVaTlkDYQhCZfVK ThkCYQhCY@YTT@DGGQcCYfV0TbkBGQcCXfU0TLkBGQMCSfTpT[DDeQ[CRfTjTGkB eQaCV@UYT`DEYQACRfTaTEkDYQACQfTKTAkCYQGCZ@VGT@kCGQ6CPfT0T5kBGQI% XM'9K(!)M@4M&`SJA4VJ`LS84,)aHB33-ia-BmD&l4aM43#XiidBBad(E-f-!"(F CYm*S$dCk-'k&-5Z-@'$%#U09'+R#+"9'U$#HJ6%bM2aJe!FM2KM"`(J2aRS`KS2 a'icGB0`')cdBfF'i$FCX-&k$N4q-lQ#X"b-f'+h"5!e'D6"#Jp%CM-aJ9!BM-KL 0`8J-4Q%`!S24&ibmB03&Bd)BFm&i#mCD--j#Ml&Jc)q-pp%M*aMY`dJI4J8a#SL 42ScbBB32Sd!BT`'2BI3'A)C4([!B4[N``SIa'A!D'G[$'"BpIS@a2B`'J'm`USI a#Y!#16#+4ir!B2b#m"l'XM#1K6%AM',4)eJB9F#S%PVA'Bh*q!hDj)@6-)U#F4' -L@!m"+-X'%R"+!T'9M!QJ[%3M)@JCB!a%)arB1`$iaiBmm!S$%CG-1D"m3k-G@# F!f-F[2%0MS)2rM2k16(CU!5M$ZalURYfpJNEUH*SqmBHf[c'ai8a"rBp!lkHEL0 b('hI1*(94Pbiim#q*lma1hZhM8&cXRdZXadr4,pU@[Y"cm$pfHF%DFjdKFb`pkU MH5Upr4`8A5*Lk$Uid6E,1l"-95+9lNcSbD1l&hVbk!k(RMad39aEj+&,BQq4Kmk *L88H1JPULMad)H`UmS#TZiXmG#rX+I,3q6#Tb%2Aa13L$jd9&a9jk,kiZ-K$KmB P44kk0kB8HHM`Q&VNS3YN@T%(pA9kNBFZNKP&(MT0DSXmG+2-,2,3XA*VNBHZPPP &(P6&'iSmG-IX,2,33I1#)JmG0V1,2(6Kc#Rbd+PcDC'(ETkj44kkIHB9HHJ)ZUc )3pI3r#)2R88,LMadF&eHj+(lDf'4Kik3!%9&(VU1VLMbd('fZ-K$pp4Y44kkS*B 8HHKkfeINSIYNDC'(lT8VLcaddYeHj+(ElUSL$aej0aGjk0DlXmK$4ppG44kkrZi ZmY!CH-qL!Zpp1)m$k(2,,8VMVYR"bUf`E&rk5br5U1BQAcTK2PdCMSIkG-p8)c- bjAMD2(-r@##5KrlrB88HCJ--,r)`,f$S5hRL%'TA(kdXmM"[B0P,#N3b$l-)4QR 2S)C)rGPamcS2X`Xb(45qdkcjSdUeC*C2I2eV58KIXPRcCmI5+Mh3CXfIG41G+4C b[90jDUXa2G"QcCrYH@Z,@I1RVUd9AS,IiES$rAh-QMm,`MCeDYEmf65c$(ABV2Q M5P&UpaiDCXY4qmfD2lZA9EAbMelcCdCBQfDjd-H8Cee@4CN+D6C"T4YC6aG"Q+H 1VrNcJRZIiHm6*PE2Zj!![[Z`9$lQBB$'c"SC5CjbZcGpj9,cBFhaJ)",$hjBXaA S,qpI+KhhY1@4qSbSpTLE)HH)HX6T-jHHqmJ'lR1"ca04Qa4c0)3$4$5MK(NDV!M %h)l4j)RCIHbD$a(09V"V2N4jUm!j0,a('5GjTZ8KMQi%ZqC$9!SMA5Tb[qK[Fjp URbHUf5,-jC!![[@SjT6B04qLQJNa5H9[lc0jZU3kL!QrQ0NKq@*kViZe"T(N'6C rlfEFNf92jAh#c,[XUcc"rGH[mrH4&GGNKGLeE[N'YhepVpX@eIapYZIe,HjebeN Kad5Z@miU30C9ASNEF9)UYHV+)b[Ul$dRMbJID'ec#@X,LDpda)80bl-Z8jkkLBC EXE&GCmhA4G'-d'9"11d'aK4AbXT%UK6QH(Cp[4)hfkrMjV@0b,@bJGi961rDcCS lXeTCFZQ+8LPeqEh&bIX3*50jBqrUl8X5(N&#PV'5d2C5+9QQ2(YQF1[Vl-iI41T K%I8!CkJ-6JM[,j@@hZTakR+Rp`rZrkMLi5M%rq@K(LQTXbYmrEbalHXRF+IU4ee @ZTcYa9E6ec4HGj-mebQ2HNrT[F69-4,[qHCESac1JPY&JL9[U'JJYpPhNLR"68K !2ekU*mqK32Y5YrCiYEF%U01"(lX%aMBjLp4R*pNh`(30PeNVqUmqGdeMJ92P@c! kd,GbS*@jT-95Al0QfNK(khkiq@VR0pIjY+2FM'e&iecl[[c1GCd,"mD#ffkfMC) 8qiia14*5-KdCH0SC+frl@([P,BpFP8rm(FSSViUK[JdE%D*Z'4dE1CAckk[9@0, C"dHLZPUX2a%kl@SAH)KiE[AerSCfPJXm-6DN84Q"JpSQ9'jBK[Dj#ch[&,@&LAp 8lm!Bm@TYlq#`KV60MQSCpe)M[8QX)@+VMP[B86XFjF-0p8j!iDhj!%1plia#STD MhRp+aTd0+G[H4M,q6-4ZZbr22Se8X$[8l-[($EJS0[6dR@N*mTQ&,ZeH9@khca( )&Fh1,rU-*iM1(j,2lY6PJ2X!"6TZG2q(E"AUT-1&a'E9UmHM9T4&B52Dm6pXmMR GI[8iC(KVe++jcK&4)rqjDh-kU20,l1cUU&J&S'Y,NL-pCA4+Z`+kd`k[e@4fDY9 ITCT'6b33P,D5rpVVblAb49JC)0Qc[@[,$lZfDCD3!,"d,lF$i6[3TY'FiaGhFXj -3XQ0Gfhph#C5KrYfp4Uhh"3qedCcjh-AFYaqhLL9%`q%m4Q2IYS@bTEa'BrqK4E I&CmGRr(S*br4q)bcY1f$Zf4m4T!!@BP#V3bj!PPGCT!!Gq6EQ'AYYDYAEf9)bDL ddqUZaFh9l55ZGfTCZRTVIAVefGeRVkl(YA4ef)jX-A$(b'IQ*0#r`jb%dNAZjL3 X'"eF'fahbA4D(Xh#9Me-kVBjlFf+VD`Q$[cF`Gl!ejF[F'(G*BZ83BQ2#c'2#h@ eiG(bD+IGC[bdbidpq,J3@V4ZVNU*HP30AC!!YQJKMpZQIk*PZd!rIc#!hJ0EG*2 Y8dQSV9aF+Cp66Q28RiZLlr8DKK8Xakl!ASYGL9f&ABfp$PZ(AB0GLef2hB$GL0f #hBVGKQ8VRZkEHTY!R)JJp2SpXXefX*0H[dFZCqX5[pI[NI6HP6Gmqm'hD'GDPhU [RkYQ9T[$p3X1Imhf(T*pJ4CqDpeKIK!F[PGl8l[-2KI[,#Dhh+5q30IVmj9XcI3 $@9+,N!$C!i0p$0,SBqHqkdFfDP012R856DqTE#(,8QlRAREZ[C!!Y@bTfJ2T$Z3 +*'!e06p"qI,4YQ2B!QQm&(+(@&qL8E$KhlIcAIlX[F@*"-,iGaGYLdh6jh`Crfl feVCEDbrS0,)Sk)m54KiXF9009J!-V2AA&'@NFU#Tm8'bfrCP`9"edf(hM,$4L1- @-k@fY)1K6HA+kXUCCrT%bmV9-+f&MGblf1d)URhpKe1R(S#eZH81@q*0FG+SGpH J,22,P@lb92D(Umk0aYI8hpV08qLiaCe@&M8G`5DN,Y[#1CjVp1&FmK`YYf$1L9l AMaa,"SBhEPB@(CYk&aN%%9Kl0++T,NJ5Ih[VY'q29qcdY"PXVJchca@!MN[8Jdj UAiX,aPm[lY@#`2U`jKCH2&N-bDcQ2Ef)KZH63Y22P`UDh6-@V"ebbC3V$a2EN!" 4JJpNE,f'9aT0"4N[1hZa908hKc5PS6UD3jV5m)V0)C12EQMSqldCDC*NpNZ62l) M39)TIE%[QG!2@p1CR+3$9k"Yl54Mf$E&mQadYHQddm5eVKjPYEKKRShe$KiZXPB UcYTJbPQdFDbCmi#9aT0)XfR1ml`jcqBj6q)@2)Eal*P2ZFGbERDAiYJDeleM4mF H`$Ki!12K!Bb("c!HEQ-mA-CiH!$M5Gb#"c!HRYYk%XRe8iM,[!"iZUf6Cpqe2@c $AGILZUQ@GV*)3EZT-JRDJ+ZTiRHT$,R,MYT032r5@U--6QT)mV*Hf!ae(BENlA5 T(LBp#kQfNfCaXhb4Zh4lR066S+G@)j-JrHiYD6!@JTk3!+IG@G5D5Z&5d#Tj*Zf GdBNDGE5mh8QB"VhD%(5$5mSqCm$c"KD`P*ab6HeH&LBYIj'P9Dkic6@#JC(bF"Z XPh9hGJE',q*CV6qHPRHVMHYZ[@[P[TP4UN@rYV,iT54,2#SZ)5,Q[$2HbXUAPV$ B@`Yc5pab3a*hfX+(RHd`59dLZ,SaE)a2(R*S!-0"a@k-+"KG90ZR*l$LZMlCPJM qV'ZV%rEK%Dh6HREj))Y'*0f8K*1UD(&Yi8SEQ9qB`!J5l(468BbN%E$F!JUl1S+ SJeLmYPCl'EhhcXc-KrVS[56Z*$9A(NXF,3,a!VEF5aI2R%Bm33%Q+R46F`&-GM5 L@'jahG!*bAU,5Q!RLhhDU'@p[B1$clrAaM"apHITLeP@T#',af*p)XK9#+'9Ifl ,!MAF5E+YFEB`rm660dl+P3VcbCUSJ59,KYkYPRh@1`ehlEr`9XkX64S*MKr@-Y1 X@LS,C1L2*F'paJ9@5#eTD#eUXk5dV-L[2`4X6`9Kr9E@M1@l&mZJ8li(X$*QS%6 $%Gk,VE#iMf,l((`NU(2q'VE[a&Dj!XpLq`9[r$Xp)rGRK9KmJr,he-0EP0C326R 1%bVT)U`25`i@+QIe9h`XhbdM$A3q9RJG'2bH4LbShm)hU*dV,@SA"ePK9IYHcQ' )q@4PRm#E'r"bmE(dh'RXc5ip)HTfI-0q0MLCqP*I`$GF1l'+lh-F+VQS[*&kc0H DZYV@Lch$"#-'3Bm)lRJ,F8(G8eCFr3&E!J@erLUV`C+$qM[,Vd`De*,KCr[pMi* kVA1#%fqLI64i&Ejc[4i8[)EcHGVi6AbmdrPqilIJjr"GB(Ik,!G@A-A(ficLIP* 6`Ar$0pSM48Je1FDV6b&KJeh*0D5&jKP2MBmPbPNi(jrFd9[*0E5$`i5HUXC5K+l %9leqFideB%-I%,B)S5I(UcR8j*X3"CCSa-3NeB[ihXlC6UB+#4XZ#Zii$8`+I4E IaG5(e&Y)Up8bAS)FRq%`KIH6@JSpM'qUAi3PT(I9qTMiRZ6!Zq%$5eL&&VJ$5r4 VL!p-B@PkI&,EHM&kI+a$5`hL3beP$9amV"2,%[2iZ!q,bZ160pI,b10MZA8@MXF (AK+,$qaKFAKm9"M,`H0l)3I`#KmeEAZ-`X*1&RR(pcS1LmhhS'%b[SFiX*`l2M# *"GcaIB3$li!2!'@4GRaIi-#bl2LqaB&Da[F$$Lbp$J@J2X!FI'!Sq)N2hX##k[M !!TC3adFGk0%KiZ-GHA0ma,!`1Mj'V0Q&Db,##4BrahFA"`hfiJ-EE$Y,4'r-dZI ihX@"2LamImV"$Lk*h-2"-*(!mF)!kJZI`%)!h0'qTcR!Ck!c[+XGp4CP[9h0Ar# "`CBb4B9jGP1qU0E,K52J!hGXNdj8p8mM'6lUdfUe8G@2V!QXIEb['Bm51%&[FC2 jL,'E@dA&NfifhpdFU!YmVq"JPGbS10UYjRXV"pEfaFGUZq!'2M$b0[0pR)-G2K- 94YT9L+1UHcJ1[LFi[-Kmm"+`@VkBq-mGjQ0GAeB3aXGk[#mf(eJ'4Z'MYPRY&aq e4#hMidej6hcFl4lc`32fQimhVMFIY8iX2YB2&PkNIAr&!5k'MbfU`%0m2q4`RrF j,MkNqG%LL(i%[P%(pMh926[lK(%(4pXh&M'Q#4I'(0Mh$$cXG1-@MVC[($*'%bl FF@$INpqBREhli+*ZZ2#bI*ZR"Pai+AcKEE1cepkjL"XU1'G(HTYQ'HI+jjiEkHf H(c9C0fRp@$*UXSl4cmP4NhA@`Z8dqDaZ1NVVVGSb5(kf2dVRS6*HhM@h3'YUXmC i9XP$i,e&([TrlL[bX*lKX0IbR&K4I!kBmI41ZB(6hQJX2F"TmT(KA6CSpT!!"Ki DTqR(0-2fc)3Y%jFFf*@)5)hY5S5PKddP3QfACb+!k9kqemliLNFN*RfCN!$8[#m 6XLaUMHKa8N&lejahj,f)Q$96Fcb+M0p,ABV3YMFM029Q"(L[j$EkJX'*'q,@XI( 3DQLSZJK!ac$MPQ6`90fV$FMpr&bSiaq0,02EEC[RFr`HYF2[YaP"Z8rQI2+`(6P U'qQ2jR8FZXHmVFPN0rECGf@`f)*0&CYRGE`q&Sq1f)bXirGBfVGjV(YLBGHFjLm eCEEYdrIBQ$ArVrMe2CL5r&bpkRX8X*1TZ-9[q8"9Drhm&Mp!i194fqD9(ApA'4& YCeJGVrZGD@)c[SlIJfp8V3&,2[kZqKjk*YlaHaKqcqcE0VScC2%*TV0JD0!Qhq@ qaLR3"epqdH#2%1E`2C`"$'AKq4Iq'$NEaPQhISi+TP2!cY3SlSjlR(rQBJ(hk(b 3!*rHS`1!Ihk2)T)IZBFXd["rY@qBkI&kKERVHa4HSf(UH[ipGM#)f"&`Ml@[[Qc aA4P&k0fM(BPqHSmGVl,6iV['lq%%B1lk(VZF6DEmcHHHB0`bK,KVL%VMV2r@EeI @@56J(RbM+**Rhj@4UVibIc"*E2%*jZkSB+C1!14d+b$9SDpVKTEl3p14Tfelq@F dRG`ph#DUmc%Y*PXG[p"LZZja9)[TZXG4,DEl(NHdQ1)ph!YD60Ylr%U,b6hX-eT -m4j(YCLfDra5LqQkac%YjZ"&A!4D6'F1ZkG(amF5(m@lTKIpD2kF(jT1&SKqSHR N%GmCS1N8aelfV`aZY&Rj[rRSVh&2G&'i!lSIA#IG"PZ1-5rTHU@c+0(lf[$&'BT lSQ[KHUemHI`cpcL1`('QA'$FrriHlT[ZKpf,!Bb'PfE[FHH8&lUbddAp(ia!,Y* 4dFFB3GFpMM+#VRXF4I,ZHaa"mZ)pMQP9EIIiP9D9Hj!!Cj!!XhL2SmMCGSeI)QI A2BjT93F[%Vp(3Bk4HqKT#Zdjc$hd+R,CMdZX5ifmjr1i!638IBr#i'4INFJMQYa $9R&T[mI#LDdr[SGlGUTjFY&!GmVRSTYUIZ)10-f'lCG9[M0B%1@PC('jb4BXPb0 V62mNAeJj##l)8YH6JqdZQ8l,SeRBUSG*rG!+km6+hLakRf`4GkkRdD1ZlT*&bU$ %ai@Sa`AGdV@NdaEAF,Qa"amA3MNZ10b3!+$Kmh%KY[MXp$`VRlK@#Z#%Gf%R@2M !#@E#BUNR[K(kL&kLA$-LGK9hc(d+@0JD4Uh&RUT3aS[%1&ic[d9m5Vq)1b921FH ZEH-PLVNP`iXm[6QH9Z6T`h&SNBFK3*9&R[iFVhiT6hbVHiNkLH10Vp@&5$kIi6# S9'V9e8NY[X&C0@3D6@JP[L%0laZV0icJ8k8P'j3(Rm3a*@EBdVk'DkB-[5*SmhR ,H[XUSkA5H@[bqlcZQT-ICjPLh[BRXrrbR[RhNErXZlH@5YIZprF1RM`lqp4Q3Xr %MX5HK@AKBZEMMH$jcV(h18re+IB-,$1&,X"HL"f&(8fH-CDR#MX11ail!FZFQSR B'ZcTj*PNH5l#ASaP`#*,)c""4pifm'lXD[*iGF'XYKAB99LQK6-CD41@'YK-RLf @"dD`(FXXTaZ`G+%c*BJ"3#[*XmIbh)6GLi9C#Xr81&CLY4NQ6kRP!EGX5@YX!RF UX1"+Ar,dXcc81h8f!(X+pP6X308f45jj"PZHSF)YXFa"C-)4%hpRBDGJTj0RYZ@ j&(X*PL%YFl(cX-`eBi,b![*S("!I`iHZ`#l'-U0a+IC+l&ABUH4CCRQZ`5iAAL5 "5*Vf`cNJbDXE[(MYRH!&G6!02"J[j%TZ0a,2drMa5)(JjV1#kkkrPraPj"'mN6a 5%HSA5mHVU'kE9I`$`L2UMI[GAb*4iMl[2QFbrfl$Ip[Xi92LI4iiDal2IR$l[q2 C!ffl$r([1aS[q9qQr2(h14$r6VZIi1*69j)RD(Pi3M#!HZ(p)PerqYAbrqZ"pN0 acXqHR,jKG!#&EPXD0eajU02)SV@96TV&cI*&lY,YF9*2AdJa[9Cc+(Z,`Qc,Lr& ,3rS!GjG(ACC&VDNA8ma'%U`F#Y[YPa2-k%50HVP[*NYJcFha6!QSMHYZ[@Zp($i c5K%Jec8RT$kfjE"#69[dSL6HkQVCLf@LUA&Fh-aQ@"BQVCIIZ,Cr5+T8Fq6FNI* `1iZDdBlrZ*ZH#E1`Nl8l,ck1$XmrRSkrDZL&8,q68`TmQfZmN!$%m[RfelFTfTq ITX"m#40H,''rVl!Y@MSQXU'j!M(p,,N#N!#qQBlAed*&4`C8`[cMqb*L@l6hH[C FQ52Ur)LpV9-*UpG-(i0d%Z3!RHJ11#G"(X`*cd%jd9NJpi*c'1"PD#N8,lDeb(9 4j!%m%Am3[h4m-hJ6Pi0ZSV2!(3r12PJVD"0BJ'a5G!#fRb$hh&Q`pS)lbc3$e&j X'UEMJCPbb%%dd6Q!*VSGRSR2JV-AR(R+*$#RJZ@e1Q'B"$NB*VS$KNQ3!)GK`R- `6(3@KVhJA(el'9U+`S[0&88HKK2a"h&*acI$-(%j'#Bk#m2ai1b$YF)`J38B*N8 ($2X*FXqGK@%[Z,0--c$XaDCK1"kB+BFF$"1GJf'Lff'Bq#`-Hm'CTmc#m1bHX@- `6))F$"2G!F-Nb--`i6NB*MS,`ej`VVkp$#e&iFAQLL)2`iRiJlLNijYKQ,JF$"1 GKH&iF2E"@Q'B`!)-Nk)$K[d%ZHI1`V!Ah&QQ'4MfBY-`(!r-P%-1KSR1`6$4l6" -I"D'[H$-8ak!i4jCULK-p8K6AH*88CiU#&5(*+T1NDSJ8h8,9Ge598kX+XT9Km@ P(RQT4f!U5%b(4+C1Q5N[0"@NTU,B9*5EHU5IS[M6)rpd#8"&#DJJ!Kf5J6U&S)) 8e#d'GFY"18'S+!NG&R"k**`H%DFJia`5FMUPR,bB8j!!FiU#6P(5kC&ALJ*,Mm6 5*E)8CCD#d(*)DZN8@`Tb5lIJdLfjj%5ASZab@#6TN8PkK*+#9(*),1Q85r+#58% b+BSQ4GQNd-a4E1I)0h4d0bJ8@K3kQa3+E3S&GEbSMqF9mQl&Yk$jGUUq"Gfh)$F @"FHmj0JYS49%Y%iC,5ZN0DmEPqCF,6P5T+XP342VDXR43,YD-U4i9dZ#*2(+a+F )35D*,CG-H%Hp0*!!Veb+1,&T6@(S9dYSLRqe*%K#86Dqp3RR,L33-'T*IS$GY@4 *%V0-I&FKqY3X%`ihbmEQLc6&cPS5T1KC-X&5Pc)IDfFmPB609l%aP5J,N!#T,1d SQ8U8JmT8QLaHTV*N3$1G*&Z`k8c09C[1d9+H$F@9!p,Q2+eSfT!!j`#NTZ+cZ*V +NJ(A!dQk(VJ&CP-*1V%fP5S$Z1NN4iUi$AV61CV`pd##BK&NN6L9*3[(5pU1$@, *e3('ITSX&2XjfS(B6j1$B6p*&S6p("N)ENb4VGh'2-f9fjLKT5b6TC5$hR5@9Z" 0CMN!Zhjd&R6p("R)E8T4H03@Z2A$1m(@6j5"fXB8KiUe$@BE-c5"E&0ijl0R!GE 2NB9AM`l2G"1GU5QAP$dbYZDB29CpK9$VkTXIYUBk)A1m-aPQaV9M[,e40XlRk*! !9aSeYCB859%Y%cpVTZC!,e(6mLr[bfqCm#k@e&jrU83(Lr!!l@bYa(5D6$Nf-,K m6EBNkQEUqHT-jFQ8D$T*4jfQXa@*EkCLI8"YVpFNJ@bYeLE1dPUVM8NbPCSN![N k2C!!TNMVmMAUCmP8D'1+M[TXc0A*PlTVFffYpTp5!CPke!,5("%-b(4)-b"2Mfa !QL0!3kCZMF(,dX0F[93GaHJPkDR(3hT$)P%"Qh5LGY9"ef%"HXR4)dk3!1B35-I cG1JBm5cG*A-%p-Pd60JJea'1i'IU+F9Z[F6,FK4iZP36,dP11)PRk+UH([Q%0$d #*@N1XbB5G4-R,mY4lZ5PkbUFBMr3NVL6e&aj,('-`Zc3LKCh@S$R3E%(AM#R%8m !)Ch0,2J1*q,G1K+P1(cf&3r+,Le2QHjSq1RYZaieV6GdC22jErCG@m5*PPGY&)U 2hE[V44XjHMVAXYlH`F(RRmq%0(&e%jALj5DNLB1EU!DqE@*5h0U%T'ZL-Fc5Da1 9T0+*L"4l5B5e[E62RK-"(ZlDPfpJaFQJ11fb3BEY'ZF"[QILNM`X%G(mDUfeR!K 0[CT(Xha[kJe6p-Q%T+L5#@QN45BS5B%5%@QkN`KYHc1Ip53#@SRIaM"ap9FJe-4 hL%FQ48ie-[%GFT&*NGH*6)+F3'6L1e'q-8H,HQ45C'@M4(L1YLGbG(+$4*i@HTU )cPGYZi58c("3X,!CQN8M%eR38%b5V0#4##q@5MH05Z6*P8UVpZ'(jUSSThDBq*c -BH,Ep3f6)5YX*-)l&Be%RN1&NT%m%Y%(Ud(QDVF6!F)lH3!CmM5!m%i@3)Cf%N" mRJ-3AU!!U45Y$)!-13,J4HG"c8Y4+&8[6@ZPHX'j3Zh!rN5#0ZMA#9U3!*r!)[# 6)iIlAR5K3RT3hdZ6VC!!JjJIMmc@6Kla#Fm$2Z%GH%q#(0ald3@dpp,de%F@kle JV`UF5CqkYUj&(,HQfC&Y*BDcbH-T1iPVh+PS2PXTaK6AZ)1R@XAK(1,BcY(r2[A (@Lc4h#rdMr0aRbG1hd2ZPi`V[B`P"HcpNR'Vf1kap-&QPZpiP0bNmX-FRLD1R3r mZ0$6(#UE@ASNRp*D"[DGN[IVp4AZFN'cR4k*@r)P&MqFhmbQMVa6@&XqpZAH[,G r[jRD&Z,6cDc"HbAM*[`CprZckL$cQ82Iiqhe0TAb$IiDKe(YK+e$3RGp"KpE9FT h$aZaK!Gmh2YlP-2Q1eHA0h%2[4IID"phhkFiR1RMIU)FGLAr)GTUXFc(rGd`2MD [*0rM(1l0im,R2S52E5cPZeml,mccq4l8FMKX)mQ9EeqS*hq,K'dIeM+9YLlpZ-M 0(2CCAITaBH'%9cGqA&5EC`keZ[(MpYdbAamIdhD6GSZ2I3r1emFfE9eTGiLkij6 jqRMdER`,I0aGfJV5eXG,@IBaS+dhLI[#I(eFYaiI'e-5pr@jqJMYH4)I@e6+GlH fac6e%4j66E+GTP6kcSmXe)'r(QL81SlAJ4mArZK#25AcIA#K2[bi'2H,eiFI0dL EE*Vk#&qKQVEiqe%``pC(q'HZ*X$Z$R'UDXM84rJbl49P0h9mA*KNkL0mP6E*[0& i!29UkL0mm4I`X8%RqIjk(Mp'DKm0kJ+mCpF*@aq[%TEFl12k#*pUmVLq2a$'[F4 `p`dFH[Zi4l3Tk*hfVYqIbpG[ac*m$rLiJF*eQqq*hIM),eqrlmlIljZ2iRZ2MqZ [c8C0[RklKB[[pA&pYEQRHHr!pi9re"h[)AK[hcY`81rdQ)ql6(R0H`Iq4MjUJAZ `SjTjlm"REX)((`'R(jkrhkHI`XHpL101jRiUqD3+eF60qrVmrCl8Qhl-lXe@4HC qUNGepR'lamUjq`9M[4re5(f$8qCq`6F+Ym!%q9CqFqjq`HekXdrjZ$fU$h1ri)l 2iK-HT2%*(Q0`)R,5,q$lQ[%RkRb`MhZ0DSLkNqq2`0Q5YSm,kLfqlH2HIJHBGV+ 2Up,Z(YraeiL#0j9rjH0@LdYqeqjh,cEQmH16fZ6dHmEcK'F%l"jVK5AJ!h(ic(Y (hUQY8rr*iUM4#Rq2KiAh6eUp2U6,QlK(YENV03,ZISR$&"rhT,C#IFTi*29XlK' jm6&m2c4FNHeFe8-qVYHr%N#0JarJE#prMbm+qm!Vm!Rq8HAcVEJ0(cRPZi8kL&4 ph$4aPAme(JchXMMp0['-Ic-H`#DTDqcHi-(6aVHNEVckZ&YFlNIfIY5cVBpc2SE [aclZC'fiqL&r[fq)GpUY5%qqKhFGk11qqNrc&,C#m3rkHfb$0hLVcFD%XjCrI"q I-ZifK)e6JeB(Ei&2H#[6KS9h&PGQ82G+'#*IL6BZ+S1AJcXq[jQ+$K%U+epXpkr aCNVEbI*dXMeV++qRf1i9TjVq!-6GKkq[MkZ(@bYK[RbIH"rjq[ZiNm!QTBeQ`8Z iKHB0XGhh8@2+0Q)j9CaEmiEBqjk&HbPY2-XlNIF-Rkm5,&$'ef2S&UEqBVY[)*F b[PkLYp4i'G[p1Ef0jHX$a&%d(XGfGm(2e&NqVPceq6`Ipa%`5)%cZQlJ*b90pLT ,e)Cq*p&[!KpUKNGhAbX4(cEhVYr-9VNUhrK9q,&XH4YHjq1Q28#FfE&CR3l[-$J GfhX&@mFUEE[+m`S1'Cb1lAN%A&6#4[P1S`i-6XIfDQPETHeKjCXcAkreer2f#Vp q$lQIVBrkc@b4Ue4he-dr(-+Rf0irr#*aXTbXcJIqDGb0lGd%cLREb(B''mmDr)l Y$H"-5Y[CNNq`bZ"hE1m0ZJFEfa)(cl6hH#Am4QQ,@qLmE'aVm$Zfjbkp"j[Gb[F DX0$L5[e[`Qf8YYQ&(m#A0*l&pYccF@'-LGXXc$"i8lm6V85*Ji$Im(jlMhI`4SS Dj(XGA-6JI@c2RGmLMXf#jAX6ZSc&TrSEU3QPlAQTErL$a[[BRZpG54akMRbRL0F Ch0Vr-&LSE11AQ2L*`DhpGi%T5TbD1RMPI2fK"5MHAlp6R0r(p[kPhS-YGZ8E*Yc 4r##fG`IF58PMNDm@hF6`JpMH')kUT)2"ekN6c3pLHem(Pe2DJ"IHrm3KIL$i)4L Pa#APfiM@B[L"h%0d,28QidrS$JCIpcm+*e$D(*JiH*jp[dAS@1TYaZGiAiYc`IZ *XlVA32&JJkreTm+TP1PHmm!2Lkre[`kI8kClKD89fAZ-q50mFKGJlA,UfI$Df0j 2#!2Bh&MLVJ)$,&lZ[d[Da'Gph%e`"3m[[k)D%icPQi9qjZ(PD186rBV[IYl9`m[ TUPIi(Hq"eQMIqir&rG!*LB2[fATpC!mqZ$rm$lbf1,G!R"`p3Ei9UN@,Pkq(f`@ NGj%2($&iZIpCm$)JIB!ikX2HBk5`!&iXheid#3m[2kbDrRXIYdFkVF@jkQ[*`CE $8$MZBqYl`+IaIGR(E8AImI"bJIL0h8`iV$UhpbMrAAaImA%28cm@,qY6m@2"+,l h``-p[(`[R&qCRMTEqT("brTedP$J&q#Ik+mHAMi'Pe@fi9G)R0lJCAdGV89*2k3 1@1h-eTr@@RKciQK0X2AhQ',3#H@l9RU"`F[pMdQMK0m"0E)KQBHA&G*DV)Dm5hU (aFYDD3bm!lL1CQ$`X[l0dNVJ0I+pkX[cH$Ri6`K!db$IQqIamR%d+D80RAQR""q Y[dEB)abCEr!#AXj%Te&k%rPZ%kjB[0`RIX`fd2!Ep%',Pj23m*9d@RJ'HN1*jrF 2`1(9Z)rl!,JFbHXlF0a"Z*Db4@0,a31Y(V!6M&#f#QaIEE&XiL)R`&'9l8Sd8"K QimD+hjKGM03PB*9h[he`"LAq+mGedS00A138DPMC)T,$a5[X[GmRhQ#hqjUR,C* Yh2IJR-TfcC`R,,4a6iQAQ&fE9%6GH[Hq(Crb1U[DaqE0hVfMD!E+G0D9iZ[fr5k rN6LVXki8cl$hqaal-bRMlCY9ccEZafJJbVDT'b3F2kNC(qfV#1FiC2@5Z&lqr`d !"8PMEfi0D@p38%-ZE@0`!*!4H$-*KJ#3$iB!!$q)!*!$&J#3"'PMEfj038063!# eQI#%YCR`K!!!!HB!N!B"&3#3""F@!*!)JE)4!!JF[-XKL%Vqkr)IQ(qRr&[Nla6 hDYcMFCFjq"YaTmHeLN[2GdpFcRaEjcXYAk0m21qMq8VPh6[[,ARVj-h+FeLHar* XRZHi20im2E`Aj5RJ6I0HR2Y9EqIFjhU,j8l,I9eZP$XeGilF20HCZF[QV*!!Frm F0q9-c,&GMVGcP-Pa@1aj14V(GSQp1qE4f25BR@-hL'NEFkrRVTMdQ%GLYiSj-,D qXmMT%0kG+6`p!r+B3c"H,b-CF*54$%p[fY"-D$T(Emh-i#$Rk@eK'$HR8'ZQ(!T cYqY-%A+HIQQ%K@(XR2`ZdLmbcpr'-b3U-8II58AYQIfMclTCrUa,aK5GkLJ8DZY dYLC!(J4+k5cqV!ZZX3#3!`d0$&*&384045j0B@028f0`!*!4KZB*KJ#3$Mi$!!" $(J#3!aErN!4849K8G(4iG!%!VZP",E@CpXm!!!'X!!!%5`#3!md!!!*C*YQfB3# 3"M&!%3!)(1ad#')JLFI%1Rb*Jij4$SQpPB0bK,62fc8T)G'Ij216P-l"P'KkQ)V "9!65Xe)GTD5H!!J3)B2Y3fARKLIIKp0[UTHYN!"1TZXCRhC&(mcFBpDR'HL$*'B bTRkDJEjBKM3rJcd9[(l15!U(i9GF#&#aYR)HIf+0dbT$lV2bl"JXUUC$EZHE"al 2iakBaArh`'Q21'8UXp'm)bLH6D%Jj*ZT4*peCGa0ec5-ImP4+,3"j!m%ZqTYqZ6 3G)IlBUBS06Yib'K"cmeeX!8+SJ#!)!1BM"JC-!+`$L,X(*!!!I2)5Sk5@mQapmK 4)jc-'!()lfAi9c`$q#LHiJRk%3`%F23LI'9'RJd))mKJ"$&X*HX$!2R!j-"86Di hP&T,(j5qZD143lS3BL2ThP2PI'XI5AP$NipTUQ[5Y8[4mDG"DGPqH44E5H18D(G GRYhHlZ5J4h+q)$f2NA("kX4KNAR[25[cBc!alGMBre3)MJ2G"UBhKAa3RC@#L!k YLdqqiJYGlkUJ`N*eRJ92AV,"NXVII@4++M3fa6*3F@STdf5#C'1L-A!6e&"Bmk- i@SYrMNqP%#KPLKKmkB3@RNJV6mT!k,10E!"'#$la2"5TmcHT!P5IN3-mIH58Q96 #$lKPhbr8+NLf&J("!%4ND4QlQ0dA*j@UqNA-l&mPQMPd'+DhCae+d4&89pQj2k, C$*%#4#&Sih`6FaYB&mlVIM,@B(82mSImU#!"I(BSTA4f0&K[0Bhpe#"`31l*&!Q GjeQd21Fj9$,cK*Z5-6*A$6f@S"H0)mXXp68BV-T,`8&6,QpI3ZUC1dK"1cN)G&H &59X*!0YIFKAPj&eMT@k&q-$'e8kVj0K(+E'e@DqffpAjf3A41$Y%i#mMa'&E0V( @dUZSC--2ZAjm2YUCDYGEa'#3!%!*lImdGq`IE-J"rMa-*q8HPC2dkekJ#P#K3!U 6KaS80)bpFKkS&H0D+KTFM!Makqek*cDEeIVmVlaVp`MSlqK9EiHF[1p`(jN120# 90cC%kk9BRkifTk[eqXJhZ,jECVAm"V`IMITMrqNXlklhKl[p$@hPqZ48LRmK)3Y MCQPdFfP[AfeKB`#3&JQ'!4B!&3+L!GB!N!-"!!!rL!#3"aB!N!1'!!!$([q3"!2 JYCR`K,@Cp[N!N!8"mK%!N!C#Q2r`rrJ!!-0!!!!3DBZi!!!: \ No newline at end of file diff --git a/pkg/tbtables/cfitsio/cfortran.doc b/pkg/tbtables/cfitsio/cfortran.doc new file mode 100644 index 00000000..6c6f4b3a --- /dev/null +++ b/pkg/tbtables/cfitsio/cfortran.doc @@ -0,0 +1,2051 @@ +/* cfortran.doc 4.3 */ +/* www-zeus.desy.de/~burow OR anonymous ftp@zebra.desy.de */ +/* Burkhard Burow burow@desy.de 1990 - 1998. */ + + + cfortran.h : Interfacing C or C++ and FORTRAN + +Supports: Alpha and VAX VMS, Alpha OSF, DECstation and VAX Ultrix, IBM RS/6000, + Silicon Graphics, Sun, CRAY, Apollo, HP9000, LynxOS, Convex, Absoft, + f2c, g77, NAG f90, PowerStation Fortran with Visual C++, NEC SX-4, + Portland Group. + +C and C++ are generally equivalent as far as cfortran.h is concerned. +Unless explicitly noted otherwise, mention of C implicitly includes C++. +C++ compilers tested include: + SunOS> CC +p +w # Clean compiles. + IRIX> CC # Clean compiles. + IRIX> CC -fullwarn # Still some warnings to be overcome. + GNU> g++ -Wall # Compiles are clean, other than warnings for unused + # cfortran.h static routines. + +N.B.: The best documentation on interfacing C or C++ and Fortran is in + the chapter named something like 'Interfacing C and Fortran' + to be found in the user's guide of almost every Fortran compiler. + Understanding this information for one or more Fortran compilers + greatly clarifies the aims and actions of cfortran.h. + Such a chapter generally also addresses issues orthogonal to cfortran.h, + for example the order of array indices, the index of the first element, + as well as compiling and linking issues. + + +0 Short Summary of the Syntax Required to Create the Interface +-------------------------------------------------------------- + +e.g. Prototyping a FORTRAN subroutine for C: + +/* PROTOCCALLSFSUBn is optional for C, but mandatory for C++. */ + + PROTOCCALLSFSUB2(SUB_NAME,sub_name,STRING,PINT) +#define SUB_NAME(A,B) CCALLSFSUB2(SUB_NAME,sub_name,STRING,PINT, A,B) + + ^ - - + number of arguments _____| | STRING BYTE PBYTE BYTEV(..)| + / | STRINGV DOUBLE PDOUBLE DOUBLEV(..)| + / | PSTRING FLOAT PFLOAT FLOATV(..)| + types of arguments ____ / | PNSTRING INT PINT INTV(..)| + \ | PPSTRING LOGICAL PLOGICAL LOGICALV(..)| + \ | PSTRINGV LONG PLONG LONGV(..)| + \ | ZTRINGV SHORT PSHORT SHORTV(..)| + | PZTRINGV ROUTINE PVOID SIMPLE | + - - + + +e.g. Prototyping a FORTRAN function for C: +/* PROTOCCALLSFFUNn is mandatory for both C and C++. */ +PROTOCCALLSFFUN1(INT,FUN_NAME,fun_name,STRING) +#define FUN_NAME(A) CCALLSFFUN1(FUN_NAME,fun_name,STRING, A) + +e.g. calling FUN_NAME from C: {int a; a = FUN_NAME("hello");} + + +e.g. Creating a FORTRAN-callable wrapper for + a C function returning void, with a 7 dimensional integer array argument: + [Not supported from C++.] +FCALLSCSUB1(csub_name,CSUB_NAME,csub_name,INTVVVVVVV) + + +e.g. Creating a FORTRAN-callable wrapper for other C functions: +FCALLSCFUN1(STRING,cfun_name,CFUN_NAME,cfun_name,INT) + [ ^-- BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, VOID + are other types returned by functions. ] + + +e.g. COMMON BLOCKs: +FORTRAN: common /fcb/ v,w,x + character *(13) v, w(4), x(3,2) +C: +typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF; +#define FCB COMMON_BLOCK(FCB,fcb) +COMMON_BLOCK_DEF(FCB_DEF,FCB); +FCB_DEF FCB; /* Define, i.e. allocate memory, in exactly one *.c file. */ + +e.g. accessing FCB in C: printf("%.13s",FCB.v); + + + +I Introduction +-------------- + +cfortran.h is an easy-to-use powerful bridge between C and FORTRAN. +It provides a completely transparent, machine independent interface between +C and FORTRAN routines (= subroutines and/or functions) and global data, +i.e. structures and COMMON blocks. + +The complete cfortran.h package consists of 4 files: the documentation in +cfortran.doc, the engine cfortran.h, examples in cfortest.c and +cfortex.f/or. [cfortex.for under VMS, cfortex.f on other machines.] + +The cfortran.h package continues to be developed. The most recent version is +available via www at http://www-zeus.desy.de/~burow +or via anonymous ftp at zebra.desy.de (131.169.2.244). + +The examples may be run using one of the following sets of instructions: + +N.B. Unlike earlier versions, cfortran.h 3.0 and later versions + automatically uses the correct ANSI ## or pre-ANSI /**/ + preprocessor operator as required by the C compiler. + +N.B. As a general rule when trying to determine how to link C and Fortran, + link a trivial Fortran program using the Fortran compilers verbose option, + in order to see how the Fortran compiler drives the linker. e.g. + unix> cat f.f + END + unix> f77 -v f.f + .. lots of info. follows ... + +N.B. If using a C main(), i.e. Fortran PROGRAM is not entry of the executable, + and if the link bombs with a complaint about + a missing "MAIN" (e.g. MAIN__, MAIN_, f90_main or similar), + then Fortran has hijacked the entry point to the executable + and wishes to call the rest of the executable via "MAIN". + This can usually be satisfied by doing e.g. 'cc -Dmain=MAIN__ ...' + but often kills the command line arguments in argv and argc. + The f77 verbose option, usually -v, may point to a solution. + + +RS/6000> # Users are strongly urged to use f77 -qextname and cc -Dextname +RS/6000> # Use -Dextname=extname if extname is a symbol used in the C code. +RS/6000> xlf -c -qextname cfortex.f +RS/6000> cc -c -Dextname cfortest.c +RS/6000> xlf -o cfortest cfortest.o cfortex.o && cfortest + +DECFortran> #Only DECstations with DECFortran for Ultrix RISC Systems. +DECFortran> cc -c -DDECFortran cfortest.c +DECFortran> f77 -o cfortest cfortest.o cfortex.f && cfortest + +IRIX xxxxxx 5.2 02282015 IP20 mips +MIPS> # DECstations and Silicon Graphics using the MIPS compilers. +MIPS> cc -o cfortest cfortest.c cfortex.f -lI77 -lU77 -lF77 && cfortest +MIPS> # Can also let f77 drive linking, e.g. +MIPS> cc -c cfortest.c +MIPS> f77 -o cfortest cfortest.o cfortex.f && cfortest + +Apollo> # Some 'C compiler 68K Rev6.8' break. [See Section II o) Notes: Apollo] +Apollo> f77 -c cfortex.f && cc -o cfortest cfortest.c cfortex.o && cfortest + +VMS> define lnk$library sys$library:vaxcrtl +VMS> cc cfortest.c +VMS> fortran cfortex.for +VMS> link/exec=cfortest cfortest,cfortex +VMS> run cfortest + +OSF1 xxxxxx V3.0 347 alpha +Alpha/OSF> # Probably better to let cc drive linking, e.g. +Alpha/OSF> f77 -c cfortex.f +Alpha/OSF> cc -o cfortest cfortest.c cfortex.o -lUfor -lfor -lFutil -lots -lm +Alpha/OSF> cfortest +Alpha/OSF> # Else may need 'cc -Dmain=MAIN__' to let f77 drive linking. + +Sun> # Some old cc(1) need a little help. [See Section II o) Notes: Sun] +Sun> f77 -o cfortest cfortest.c cfortex.f -lc -lm && cfortest +Sun> # Some older f77 may require 'cc -Dmain=MAIN_'. + +CRAY> cft77 cfortex.f +CRAY> cc -c cfortest.c +CRAY> segldr -o cfortest.e cfortest.o cfortex.o +CRAY> ./cfortest.e + +NEC> cc -c -Xa cfortest.c +NEC> f77 -o cfortest cfortest.o cfortex.f && cfortest + +VAX/Ultrix/cc> # For cc on VAX Ultrix only, do the following once to cfortran.h. +VAX/Ultrix/cc> mv cfortran.h cftmp.h && grep -v "^#pragma" cfortran.h + +VAX/Ultrix/f77> # In the following, 'CC' is either 'cc' or 'gcc -ansi'. NOT'vcc' +VAX/Ultrix/f77> CC -c -Dmain=MAIN_ cfortest.c +VAX/Ultrix/f77> f77 -o cfortest cfortex.f cfortest.o && cfortest + +LynxOS> # In the following, 'CC' is either 'cc' or 'gcc -ansi'. +LynxOS> # Unfortunately cc is easily overwhelmed by cfortran.h, +LynxOS> # and won't compile some of the cfortest.c demos. +LynxOS> f2c -R cfortex.f +LynxOS> CC -Dlynx -o cfortest cfortest.c cfortex.c -lf2c && cfortest + +HP9000> # Tested with HP-UX 7.05 B 9000/380 and with A.08.07 A 9000/730 +HP9000> # CC may be either 'c89 -Aa' or 'cc -Aa' +HP9000> # Depending on the compiler version, you may need to include the +HP9000> # option '-tp,/lib/cpp' or worse, you'll have to stick to the K&R C. +HP9000> # [See Section II o) Notes: HP9000] +HP9000> # Users are strongly urged to use f77 +ppu and cc -Dextname +HP9000> # Use -Dextname=extname if extname is a symbol used in the C code. +HP9000> CC -Dextname -c cfortest.c +HP9000> f77 +ppu cfortex.f -o cfortest cfortest.o && cfortest +HP9000> # Older f77 may need +HP9000> f77 -c cfortex.f +HP9000> CC -o cfortest cfortest.c cfortex.o -lI77 -lF77 && cfortest + +HP0000> # If old-style f77 +800 compiled objects are required: +HP9000> # #define hpuxFortran800 +HP9000> cc -c -Aa -DhpuxFortran800 cfortest.c +HP9000> f77 +800 -o cfortest cfortest.o cfortex.f + +f2c> # In the following, 'CC' is any C compiler. +f2c> f2c -R cfortex.f +f2c> CC -o cfortest -Df2cFortran cfortest.c cfortex.c -lf2c && cfortest + +Portland Group $ # Presumably other C compilers also work. +Portland Group $ pgcc -DpgiFortran -c cfortest.c +Portland Group $ pgf77 -o cfortest cfortex.f cfortest.o && cfortest + +NAGf90> # cfortex.f is distributed with Fortran 77 style comments. +NAGf90> # To convert to f90 style comments do the following once to cfortex.f: +NAGf90> mv cfortex.f cf_temp.f && sed 's/^C/\!/g' cf_temp.f > cfortex.f +NAGf90> # In the following, 'CC' is any C compiler. +NAGf90> CC -c -DNAGf90Fortran cfortest.c +NAGf90> f90 -o cfortest cfortest.o cfortex.f && cfortest + +PC> # On a PC with PowerStation Fortran and Visual_C++ +PC> cl /c cftest.c +PC> fl32 cftest.obj cftex.for + +GNU> # GNU Fortran +GNU> # See Section VI caveat on using 'gcc -traditional'. +GNU> gcc -ansi -Wall -O -c -Df2cFortran cfortest.c +GNU> g77 -ff2c -o cfortest cfortest.o cfortex.f && cfortest + +AbsoftUNIX> # Absoft Fortran for all UNIX based operating systems. +AbsoftUNIX> # e.g. Linux or Next on Intel or Motorola68000. +AbsoftUNIX> # Absoft f77 -k allows Fortran routines to be safely called from C. +AbsoftUNIX> gcc -ansi -Wall -O -c -DAbsoftUNIXFortran cfortest.c +AbsoftUNIX> f77 -k -o cfortest cfortest.o cfortex.f && cfortest + +AbsoftPro> # Absoft Pro Fortran for MacOS +AbsoftPro> # Use #define AbsoftProFortran + +CLIPPER> # INTERGRAPH CLIX using CLIPPER C and Fortran compilers. +CLIPPER> # N.B. - User, not cfortran.h, is responsible for +CLIPPER> # f77initio() and f77uninitio() if required. +CLIPPER> # - LOGICAL values are not mentioned in CLIPPER doc.s, +CLIPPER> # so they may not yet be correct in cfortran.h. +CLIPPER> # - K&R mode (-knr or Ac=knr) breaks FLOAT functions +CLIPPER> # (see CLIPPER doc.s) and cfortran.h does not fix it up. +CLIPPER> # [cfortran.h ok for old sun C which made the same mistake.] +CLIPPER> acc cfortest.c -c -DCLIPPERFortran +CLIPPER> af77 cfortex.f cfortest.o -o cfortest + + +By changing the SELECTion ifdef of cfortest.c and recompiling one can try out +a few dozen different few-line examples. + + + +The benefits of using cfortran.h include: +1. Machine/OS/compiler independent mixing of C and FORTRAN. + +2. Identical (within syntax) calls across languages, e.g. +C FORTRAN + CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.) +/* C*/ + HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.); + +3. Each routine need only be set up once in its lifetime. e.g. +/* Setting up a FORTRAN routine to be called by C. + ID,...,VMX are merely the names of arguments. + These tags must be unique w.r.t. each other but are otherwise arbitrary. */ +PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT) +#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \ + CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \ + ID,CHTITLE,NX,XMI,XMA,VMX) + +4. Source code is NOT required for the C routines exported to FORTRAN, nor for + the FORTRAN routines imported to C. In fact, routines are most easily + prototyped using the information in the routines' documentation. + +5. Routines, and the code calling them, can be coded naturally in the language + of choice. C routines may be coded with the natural assumption of being + called only by C code. cfortran.h does all the required work for FORTRAN + code to call C routines. Similarly it also does all the work required for C + to call FORTRAN routines. Therefore: + - C programmers need not embed FORTRAN argument passing mechanisms into + their code. + - FORTRAN code need not be converted into C code. i.e. The honed and + time-honored FORTRAN routines are called by C. + +6. cfortran.h is a single ~1700 line C include file; portable to most + remaining, if not all, platforms. + +7. STRINGS and VECTORS of STRINGS along with the usual simple arguments to + routines are supported as are functions returning STRINGS or numbers. Arrays + of pointers to strings and values of structures as C arguments, will soon be + implemented. After learning the machinery of cfortran.h, users can expand + it to create custom types of arguments. [This requires no modification to + cfortran.h, all the preprocessor directives required to implement the + custom types can be defined outside cfortran.h] + +8. cfortran.h requires each routine to be exported to be explicitly set up. + While is usually only be done once in a header file it would be best if + applications were required to do no work at all in order to cross languages. + cfortran.h's simple syntax could be a convenient back-end for a program + which would export FORTRAN or C routines directly from the source code. + + + ----- + +Example 1 - cfortran.h has been used to make the C header file hbook.h, + which then gives any C programmer, e.g. example.c, full and + completely transparent access to CERN's HBOOK library of routines. + Each HBOOK routine required about 3 lines of simple code in + hbook.h. The example also demonstrates how FORTRAN common blocks + are defined and used. + +/* hbook.h */ +#include "cfortran.h" + : +PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT) +#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \ + CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \ + ID,CHTITLE,NX,XMI,XMA,VMX) + : +/* end hbook.h */ + +/* example.c */ +#include "hbook.h" + : +typedef struct { + int lines; + int status[SIZE]; + float p[SIZE]; /* momentum */ +} FAKE_DEF; +#define FAKE COMMON_BLOCK(FAKE,fake) +COMMON_BLOCK_DEF(FAKE_DEF,FAKE); + : +main () +{ + : + HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.); +/* c.f. the call in FORTRAN: + CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.) +*/ + : + FAKE.p[7]=1.0; + : +} + +N.B. i) The routine is language independent. + ii) hbook.h is machine independent. + iii) Applications using routines via cfortran.h are machine independent. + + ----- + +Example 2 - Many VMS System calls are most easily called from FORTRAN, but + cfortran.h now gives that ease in C. + +#include "cfortran.h" + +PROTOCCALLSFSUB3(LIB$SPAWN,lib$spawn,STRING,STRING,STRING) +#define LIB$SPAWN(command,input_file,output_file) \ + CCALLSFSUB3(LIB$SPAWN,lib$spawn,STRING,STRING,STRING, \ + command,input_file,output_file) + +main () +{ +LIB$SPAWN("set term/width=132","",""); +} + +Obviously the cfortran.h command above could be put into a header file along +with the description of the other system calls, but as this example shows, it's +not much hassle to set up cfortran.h for even a single call. + + ----- + +Example 3 - cfortran.h and the source cstring.c create the cstring.obj library + which gives FORTRAN access to all the functions in C's system + library described by the system's C header file string.h. + +C EXAMPLE.FOR + PROGRAM EXAMPLE + DIMENSION I(20), J(30) + : + CALL MEMCPY(I,J,7) + : + END + +/* cstring.c */ +#include /* string.h prototypes memcpy() */ +#include "cfortran.h" + + : +FCALLSCSUB3(memcpy,MEMCPY,memcpy,PVOID,PVOID,INT) + : + + +The simplicity exhibited in the above example exists for many but not all +machines. Note 4. of Section II ii) details the limitations and describes tools +which try to maintain the best possible interface when FORTRAN calls C +routines. + + ----- + + +II Using cfortran.h +------------------- + +The user is asked to look at the source files cfortest.c and cfortex.f +for clarification by example. + +o) Notes: + +o Specifying the Fortran compiler + cfortran.h generates interfaces for the default Fortran compiler. The default +can be overridden by defining, + . in the code, e.g.: #define NAGf90Fortran + OR . in the compile directive, e.g.: unix> cc -DNAGf90Fortran +one of the following before including cfortran.h: + NAGf90Fortran f2cFortran hpuxFortran apolloFortran sunFortran + IBMR2Fortran CRAYFortran mipsFortran DECFortran vmsFortran + CONVEXFortran PowerStationFortran AbsoftUNIXFortran + SXFortran pgiFortran AbsoftProFortran +This also allows crosscompilation. +If wanted, NAGf90Fortran, f2cFortran, DECFortran, AbsoftUNIXFortran, +AbsoftProFortran and pgiFortran must be requested by the user. + +o /**/ + cfortran.h (ab)uses the comment kludge /**/ when the ANSI C preprocessor +catenation operator ## doesn't exist. In at least MIPS C, this kludge is +sensitive to blanks surrounding arguments to macros. + Therefore, for applications using non-ANSI C compilers, the argtype_i, +routine_name, routine_type and common_block_name arguments to the +PROTOCCALLSFFUNn, CCALLSFSUB/FUNn, FCALLSCSUB/FUNn and COMMON_BLOCK macros +--- MUST NOT --- be followed by any white space characters such as +blanks, tabs or newlines. + +o LOGICAL + FORTRAN LOGICAL values of .TRUE. and .FALSE. do not agree with the C +representation of TRUE and FALSE on all machines. cfortran.h does the +conversion for LOGICAL and PLOGICAL arguments and for functions returning +LOGICAL. Users must convert arrays of LOGICALs from C to FORTRAN with the +C2FLOGICALV(array_name, elements_in_array); macro. Similarly, arrays of LOGICAL +values may be converted from the FORTRAN into C representation by using +F2CLOGICALV(array_name, elements_in_array); + + When C passes or returns LOGICAL values to FORTRAN, by default cfortran.h +only makes the minimal changes required to the value. [e.g. Set/Unset the +single relevant bit or do nothing for FORTRAN compilers which use 0 as FALSE +and treat all other values as TRUE.] Therefore cfortran.h will pass LOGICALs +to FORTRAN which do not have an identical representation to .TRUE. or .FALSE. +This is fine except for abuses of FORTRAN/77 in the style of: + logical l + if (l .eq. .TRUE.) ! (1) +instead of the correct: + if (l .eqv. .TRUE.) ! (2) +or: + if (l) ! (3) +For FORTRAN code which treats LOGICALs from C in the method of (1), +LOGICAL_STRICT must be defined before including cfortran.h, either in the +code, "#define LOGICAL_STRICT", or compile with "cc -DLOGICAL_STRICT". +There is no reason to use LOGICAL_STRICT for FORTRAN code which does not do (1). +At least the IBM's xlf and the Apollo's f77 do not even allow code along the +lines of (1). + + DECstations' DECFortran and MIPS FORTRAN compilers use different internal +representations for LOGICAL values. [Both compilers are usually called f77, +although when both are installed on a single machine the MIPS' one is usually +renamed. (e.g. f772.1 for version 2.10.)] cc doesn't know which FORTRAN +compiler is present, so cfortran.h assumes MIPS f77. To use cc with DECFortran +define the preprocessor constant 'DECFortran'. +e.g. i) cc -DDECFortran -c the_code.c + or ii) #define DECFortran /* in the C code or add to cfortran.h. */ + + MIPS f77 [SGI and DECstations], f2c, and f77 on VAX Ultrix treat +.eqv./.neqv. as .eq./.ne.. Therefore, for these compilers, LOGICAL_STRICT is +defined by default in cfortran.h. [The Sun and HP compilers have not been +tested, so they may also require LOGICAL_STRICT as the default.] + +o SHORT and BYTE + They are irrelevant for the CRAY where FORTRAN has no equivalent to C's short. +Similarly BYTE is irrelevant for f2c and for VAX Ultrix f77 and fort. The +author has tested SHORT and BYTE with a modified cfortest.c/cfortex.f on all +machines supported except for the HP9000 and the Sun. + + BYTE is a signed 8-bit quantity, i.e. values are -128 to 127, on all machines +except for the SGI [at least for MIPS Computer Systems 2.0.] On the SGI it is +an unsigned 8-bit quantity, i.e. values are 0 to 255, although the SGI 'FORTRAN +77 Programmers Guide' claims BYTE is signed. Perhaps MIPS 2.0 is dated, since +the DECstations using MIPS 2.10 f77 have a signed BYTE. + + To minimize the difficulties of signed and unsigned BYTE, cfortran.h creates +the type 'INTEGER_BYTE' to agree with FORTRAN's BYTE. Users may define +SIGNED_BYTE or UNSIGNED_BYTE, before including cfortran.h, to specify FORTRAN's +BYTE. If neither is defined, cfortran.h assumes SIGNED_BYTE. + +o CRAY + The type DOUBLE in cfortran.h corresponds to FORTRAN's DOUBLE PRECISION. + The type FLOAT in cfortran.h corresponds to FORTRAN's REAL. + +On a classic CRAY [i.e. all models except for the t3e]: +( 64 bit) C float == C double == Fortran REAL +(128 bit) C long double == Fortran DOUBLE PRECISION +Therefore when moving a mixed C and FORTRAN app. to/from a classic CRAY, +either the C code will have to change, +or the FORTRAN code and cfortran.h declarations will have to change. +DOUBLE_PRECISION is a cfortran.h macro which provides the former option, +i.e. the C code is automatically changed. +DOUBLE_PRECISION is 'long double' on classic CRAY and 'double' elsewhere. +DOUBLE_PRECISION thus corresponds to FORTRAN's DOUBLE PRECISION +on all machines, including classic CRAY. + +On a classic CRAY with the fortran compiler flag '-dp': +Fortran DOUBLE PRECISION thus is also the faster 64bit type. +(This switch is often used since the application is usually satisfied by + 64 bit precision and the application needs the speed.) +DOUBLE_PRECISION is thus not required in this case, +since the classic CRAY behaves like all other machines. +If DOUBLE_PRECISION is used nonetheless, then on the classic CRAY +the default cfortran.h behavior must be overridden, +for example by the C compiler option '-DDOUBLE_PRECISION=double'. + +On a CRAY t3e: +(32 bit) C float == Fortran Unavailable +(64 bit) C double == C long double == Fortran REAL == Fortran DOUBLE PRECISION +Notes: +- (32 bit) is available as Fortran REAL*4 and + (64 bit) is available as Fortran REAL*8. + Since cfortran.h is all about more portability, not about less portability, + the use of the nonstandard REAL*4 and REAL*8 is strongly discouraged. +- Fortran DOUBLE PRECISION is folded to REAL with the following warning: + 'DOUBLE PRECISION is not supported on this platform. REAL will be used.' + Similarly, Fortran REAL*16 is mapped to REAL*8 with a warning. +This behavior differs from that of other machines, including the classic CRAY. +FORTRAN_REAL is thus introduced for the t3e, +just as DOUBLE_PRECISION is introduced for the classic CRAY. +FORTRAN_REAL is 'double' on t3e and 'float' elsewhere. +FORTRAN_REAL thus corresponds to FORTRAN's REAL on all machines, including t3e. + + +o f2c + f2c, by default promotes REAL functions to double. cfortran.h does not (yet) +support this, so the f2c -R option must be used to turn this promotion off. + +o f2c +[Thanks to Dario Autiero for pointing out the following.] +f2c has a strange feature in that either one or two underscores are appended +to a Fortran name of a routine or common block, +depending on whether or not the original name contains an underscore. + + S.I. Feldman et al., "A fortran to C converter", + Computing Science Technical Report No. 149. + + page 2, chapter 2: INTERLANGUAGE conventions + ........... + To avoid conflict with the names of library routines and with names that + f2c generates, + Fortran names may have one or two underscores appended. Fortran names are + forced to lower case (unless the -U option described in Appendix B is in + effect); external names, i.e. the names of fortran procedures and common + blocks, have a single underscore appended if they do not contain any + underscore and have a pair of underscores appended if they do contain + underscores. Thus fortran subroutines names ABC, A_B_C and A_B_C_ result + in C functions named abc_, a_b_c__ and a_b_c___. + ........... + +cfortran.h is unable to change the naming convention on a name by name basis. +Fortran routine and common block names which do not contain an underscore +are unaffected by this feature. +Names which do contain an underscore may use the following work-around: + +/* First 2 lines are a completely standard cfortran.h interface + to the Fortran routine E_ASY . */ + PROTOCCALLSFSUB2(E_ASY,e_asy, PINT, INT) +#define E_ASY(A,B) CCALLSFSUB2(E_ASY,e_asy, PINT, INT, A, B) +#ifdef f2cFortran +#define e_asy_ e_asy__ +#endif +/* Last three lines are a work-around for the strange f2c naming feature. */ + +o NAG f90 + The Fortran 77 subset of Fortran 90 is supported. Extending cfortran.h to +interface C with all of Fortran 90 has not yet been examined. + The NAG f90 library hijacks the main() of any program and starts the user's +program with a call to: void f90_main(void); +While this in itself is only a minor hassle, a major problem arises because +NAG f90 provides no mechanism to access command line arguments. + At least version 'NAGWare f90 compiler Version 1.1(334)' appended _CB to +common block names instead of the usual _. To fix, add this to cfortran.h: +#ifdef old_NAG_f90_CB_COMMON +#define COMMON_BLOCK CFC_ /* for all other Fortran compilers */ +#else +#define COMMON_BLOCK(UN,LN) _(LN,_CB) +#endif + +o RS/6000 + Using "xlf -qextname ...", which appends an underscore, '_', to all FORTRAN +external references, requires "cc -Dextname ..." so that cfortran.h also +generates these underscores. +Use -Dextname=extname if extname is a symbol used in the C code. +The use of "xlf -qextname" is STRONGLY ENCOURAGED, since it allows for +transparent naming schemes when mixing C and Fortran. + +o HP9000 + Using "f77 +ppu ...", which appends an underscore, '_', to all FORTRAN +external references, requires "cc -Dextname ..." so that cfortran.h also +generates these underscores. +Use -Dextname=extname if extname is a symbol used in the C code. +The use of "f77 +ppu" is STRONGLY ENCOURAGED, since it allows for +transparent naming schemes when mixing C and Fortran. + + At least one release of the HP /lib/cpp.ansi preprocessor is broken and will +go into an infinite loop when trying to process cfortran.h with the +## catenation operator. The K&R version of cfortran.h must then be used and the +K&R preprocessor must be specified. e.g. + HP9000> cc -Aa -tp,/lib/cpp -c source.c +The same problem with a similar solution exists on the Apollo. +An irrelevant error message '0: extraneous name /usr/include' will appear for +each source file due to another HP bug, and can be safely ignored. +e.g. 'cc -v -c -Aa -tp,/lib/cpp cfortest.c' will show that the driver passes +'-I /usr/include' instead of '-I/usr/include' to /lib/cpp + +On some machines the above error causes compilation to stop; one must then use +K&R C, as with old HP compilers which don't support function prototyping. +cfortran.h has to be informed that K&R C is to being used, e.g. +HP9000> cc -D__CF__KnR -c source.c + +o AbsoftUNIXFortran +By default, cfortran.h follows the default AbsoftUNIX/ProFortran and prepends _C +to each COMMON BLOCK name. To override the cfortran.h behavior +#define COMMON_BLOCK(UN,LN) before #including cfortran.h. +[Search for COMMON_BLOCK in cfortran.h for examples.] + +o Apollo +On at least one release, 'C compiler 68K Rev6.8(168)', the default C +preprocessor, from cc -A xansi or cc -A ansi, enters an infinite loop when +using cfortran.h. This Apollo bug can be circumvented by using: + . cc -DANSI_C_preprocessor=0 to force use of /**/, instead of '##'. + AND . The pre-ANSI preprocessor, i.e. use cc -Yp,/usr/lib +The same problem with a similar solution exists on the HP. + +o Sun +Old versions of cc(1), say <~1986, may require help for cfortran.h applications: + . #pragma may not be understood, hence cfortran.h and cfortest.c may require + sun> mv cfortran.h cftmp.h && grep -v "^#pragma" cfortran.h + sun> mv cfortest.c cftmp.c && grep -v "^#pragma" cfortest.c + . Old copies of math.h may not include the following from a newer math.h. + [For an ancient math.h on a 386 or sparc, get similar from a new math.h.] + #ifdef mc68000 /* 5 lines Copyright (c) 1988 by Sun Microsystems, Inc. */ + #define FLOATFUNCTIONTYPE int + #define RETURNFLOAT(x) return (*(int *)(&(x))) + #define ASSIGNFLOAT(x,y) *(int *)(&x) = y + #endif + +o CRAY, Sun, Apollo [pre 6.8 cc], VAX Ultrix and HP9000 + Only FORTRAN routines with less than 15 arguments can be prototyped for C, +since these compilers don't allow more than 31 arguments to a C macro. This can +be overcome, [see Section IV], with access to any C compiler without this +limitation, e.g. gcc, on ANY machine. + +o VAX Ultrix + vcc (1) with f77 is not supported. Although: +VAXUltrix> f77 -c cfortex.f +VAXUltrix> vcc -o cfortest cfortest.c cfortex.o -lI77 -lU77 -lF77 && cfortest +will link and run. However, the FORTRAN standard I/O is NOT merged with the +stdin and stdout of C, and instead uses the files fort.6 and fort.5. For vcc, +f77 can't drive the linking, as for gcc and cc, since vcc objects must be +linked using lk (1). f77 -v doesn't tell much, and without VAX Ultrix manuals, +the author can only wait for the info. required. + + fort (1) is not supported. Without VAX Ultrix manuals the author cannot +convince vcc/gcc/cc and fort to generate names of routines and COMMON blocks +that match at the linker, lk (1). i.e. vcc/gcc/cc prepend a single underscore +to external references, e.g. NAME becomes _NAME, while fort does not modify the +references. So ... either fort has prepend an underscore to external +references, or vcc/gcc/cc have to generate unmodified names. man 1 fort +mentions JBL, is JBL the only way? + +o VAX VMS C + The compiler 'easily' exhausts its table space and generates: +%CC-F-BUGCHECK, Compiler bug check during parser phase . + Submit an SPR with a problem description. + At line number 777 in DISK:[DIR]FILE.C;1. +where the line given, '777', includes a call across C and FORTRAN via +cfortran.h, usually with >7 arguments and/or very long argument expressions. +This SPR can be staved off, with the simple modification to cfortran.h, such +that the relevant CCALLSFSUBn (or CCALLSFFUNn or FCALLSCFUNn) is not +cascaded up to CCALLSFSUB14, and instead has its own copy of the contents of +CCALLSFSUB14. [If these instructions are not obvious after examining cfortran.h +please contact the author.] +[Thanks go to Mark Kyprianou (kyp@stsci.edu) for this solution.] + +o Mips compilers + e.g. DECstations and SGI, require applications with a C main() and calls to +GETARG(3F), i.e. FORTRAN routines returning the command line arguments, to use +two macros as shown: + : +CF_DECLARE_GETARG; /* This must be external to all routines. */ + : +main(int argc, char *argv[]) +{ + : +CF_SET_GETARG(argc,argv); /* This must precede any calls to GETARG(3F). */ + : +} +The macros are null and benign on all other systems. Sun's GETARG(3F) also +doesn't work with a generic C main() and perhaps a workaround similar to the +Mips' one exists. + +o Alpha/OSF +Using the DEC Fortran and the DEC C compilers of DEC OSF/1 [RT] V1.2 (Rev. 10), +Fortran, when called from C, has occasional trouble using a routine received as +a dummy argument. + +e.g. In the following the Fortran routine 'e' will crash when it tries to use + the C routine 'c' or the Fortran routine 'f'. + The example works on other systems. + +C FORTRAN /* C */ + integer function f() #include + f = 2 int f_(); + return int e_(int (*u)()); + end + int c(){ return 1;} + integer function e(u) int d (int (*u)()) { return u();} + integer u + external u main() + e=u() { /* Calls to d work. */ + return printf("d (c ) returns %d.\n",d (c )); + end printf("d (f_) returns %d.\n",d (f_)); + /* Calls to e_ crash. */ + printf("e_(c ) returns %d.\n",e_(c )); + printf("e_(f_) returns %d.\n",e_(f_)); + } + +Solutions to the problem are welcomed! +A kludge which allows the above example to work correctly, requires an extra +argument to be given when calling the dummy argument function. +i.e. Replacing 'e=u()' by 'e=u(1)' allows the above example to work. + + +o The FORTRAN routines are called using macro expansions, therefore the usual +caveats for expressions in arguments apply. The expressions to the routines may +be evaluated more than once, leading to lower performance and in the worst case +bizarre bugs. + +o For those who wish to use cfortran.h in large applications. [See Section IV.] +This release is intended to make it easy to get applications up and running. +This implies that applications are not as efficient as they could be: +- The current mechanism is inefficient if a single header file is used to + describe a large library of FORTRAN functions. Code for a static wrapper fn. + is generated in each piece of C source code for each FORTRAN function + specified with the CCALLSFFUNn statement, irrespective of whether or not the + function is ever called. +- Code for several static utility routines internal to cfortran.h is placed + into any source code which #includes cfortran.h. These routines should + probably be in a library. + + +i) Calling FORTRAN routines from C: + -------------------------------- + +The FORTRAN routines are defined by one of the following two instructions: + +for a SUBROUTINE: +/* PROTOCCALLSFSUBn is optional for C, but mandatory for C++. */ +PROTOCCALLSFSUBn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) +#define Routine_name(argname_1,..,argname_n) \ +CCALLSFSUBn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n, \ + argname_1,..,argname_n) + +for a FUNCTION: +PROTOCCALLSFFUNn(routine_type,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) +#define Routine_name(argname_1,..,argname_n) \ +CCALLSFFUNn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n, \ + argname_1,..,argname_n) + +Where: +'n' = 0->14 [SUBROUTINE's ->27] (easily expanded in cfortran.h to > 14 [27]) is + the number of arguments to the routine. +Routine_name = C name of the routine (IN UPPER CASE LETTERS).[see 2.below] +ROUTINE_NAME = FORTRAN name of the routine (IN UPPER CASE LETTERS). +routine_name = FORTRAN name of the routine (IN lower case LETTERS). +routine_type = the type of argument returned by FORTRAN functions. + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING, VOID. + [Instead of VOID one would usually use CCALLSFSUBn. + VOID forces a wrapper function to be used.] +argtype_i = the type of argument passed to the FORTRAN routine and must be + consistent in the definition and prototyping of the routine s.a. + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING. + For vectors, i.e. 1 dim. arrays use + = BYTEV, DOUBLEV, FLOATV, INTV, LOGICALV, LONGV, SHORTV, + STRINGV, ZTRINGV. + For vectors of vectors, i.e. 2 dim. arrays use + = BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV. + For n-dim. arrays, 1<=n<=7 [7 is the maximum in Fortran 77], + = BYTEV..nV's..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, + LONGV..V, SHORTV..V. + N.B. Array dimensions and types are checked by the C compiler. + For routines changing the values of an argument, the keyword is + prepended by a 'P'. + = PBYTE, PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSHORT, + PSTRING, PSTRINGV, PZTRINGV. + For EXTERNAL procedures passed as arguments use + = ROUTINE. + For exceptional arguments which require no massaging to fit the + argument passing mechanisms use + = PVOID. + The argument is cast and passed as (void *). + Although PVOID could be used to describe all array arguments on + most (all?) machines , it shouldn't be because the C compiler + can no longer check the type and dimension of the array. +argname_i = any valid unique C tag, but must be consistent in the definition + as shown. + +Notes: + +1. cfortran.h may be expanded to handle a more argument type. To suppport new +arguments requiring complicated massaging when passed between Fortran and C, +the user will have to understand cfortran.h and follow its code and mechanisms. + +To define types requiring little or no massaging when passed between Fortran +and C, the pseudo argument type SIMPLE may be used. +For a user defined type called 'newtype', the definitions required are: + +/* The following 7 lines are required verbatim. + 'newtype' is the name of the new user defined argument type. +*/ +#define newtype_cfV( T,A,B,F) SIMPLE_cfV(T,A,B,F) +#define newtype_cfSEP(T, B) SIMPLE_cfSEP(T,B) +#define newtype_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z) +#define newtype_cfSTR(N,T,A,B,C,D,E) SIMPLE_cfSTR(N,T,A,B,C,D,E) +#define newtype_cfCC( T,A,B) SIMPLE_cfCC(T,A,B) +#define newtype_cfAA( T,A,B) newtype_cfB(T,A) /* Argument B not used. */ +#define newtype_cfU( T,A) newtype_cfN(T,A) + +/* 'parameter_type(A)' is a declaration for 'A' and describes the type of the +parameter expected by the Fortran function. This type will be used in the +prototype for the function, if using ANSI C, and to declare the argument used +by the intermediate function if calling a Fortran FUNCTION. +Valid 'parameter_type(A)' include: int A + void (*A)() + double A[17] +*/ +#define newtype_cfN( T,A) parameter_type(A) /* Argument T not used. */ + +/* Before any argument of the new type is passed to the Fortran routine, it may +be massaged as given by 'massage(A)'. +*/ +#define newtype_cfB( T,A) massage(A) /* Argument T not used. */ + +An example of a simple user defined type is given cfortex.f and cfortest.c. +Two uses of SIMPLE user defined types are [don't show the 7 verbatim #defines]: + +/* Pass the address of a structure, using a type called PSTRUCT */ +#define PSTRUCT_cfN( T,A) void *A +#define PSTRUCT_cfB( T,A) (void *) &(A) + +/* Pass an integer by value, (not standard F77 ), using a type called INTVAL */ +#define INTVAL_cfN( T,A) int A +#define INTVAL_cfB( T,A) (A) + +[If using VAX VMS, surrounding the #defines with "#pragma (no)standard" allows + the %CC-I-PARAMNOTUSED messages to be avoided.] + +Upgrades to cfortran.h try to be, and have been, backwards compatible. This +compatibility cannot be offered to user defined types. SIMPLE user defined +types are less of a risk since they require so little effort in their creation. +If a user defined type is required in more than one C header file of interfaces +to libraries of Fortran routines, good programming practice, and ease of code +maintenance, suggests keeping any user defined type within a single file which +is #included as required. To date, changes to the SIMPLE macros were introduced +in versions 2.6, 3.0 and 3.2 of cfortran.h. + + +2. Routine_name is the name of the macro which the C programmer will use in +order to call a FORTRAN routine. In theory Routine_name could be any valid and +unique name, but in practice, the name of the FORTRAN routine in UPPER CASE +works everywhere and would seem to be an obvious choice. + + +3. + +cfortran.h encourages the exact specification of the type and dimension of +array parameters because it allows the C compiler to detect errors in the +arguments when calling the routine. + +cfortran.h does not strictly require the exact specification since the argument +is merely the address of the array and is passed on to the calling routine. +Any array parameter could be declared as PVOID, but this circumvents +C's compiletime ability to check the correctness of arguments and is therefore +discouraged. + +Passing the address of these arguments implies that PBYTEV, PFLOATV, ... , +PDOUBLEVV, ... don't exist in cfortran.h, since by default the routine and the +calling code share the same array, i.e. the same values at the same memory +location. + +These comments do NOT apply to arrays of (P)S/ZTRINGV. For these parameters, +cfortran.h passes a massaged copy of the array to the routine. When the routine +returns, S/ZTRINGV ignores the copy, while PS/ZTRINGV replaces the calling +code's original array with copy, which may have been modified by the called +routine. + + +4. (P)STRING(V): +- STRING - If the argument is a fixed length character array, e.g. char ar[8];, +the string is blank, ' ', padded on the right to fill out the array before +being passed to the FORTRAN routine. The useful size of the string is the same +in both languages, e.g. ar[8] is passed as character*7. If the argument is a +pointer, the string cannot be blank padded, so the length is passed as +strlen(argument). On return from the FORTRAN routine, pointer arguments are not +disturbed, but arrays have the terminating '\0' replaced to its original +position. i.e. The padding blanks are never visible to the C code. + +- PSTRING - The argument is massaged as with STRING before being passed to the +FORTRAN routine. On return, the argument has all trailing blanks removed, +regardless of whether the argument was a pointer or an array. + +- (P)STRINGV - Passes a 1- or 2-dimensional char array. e.g. char a[7],b[6][8]; +STRINGV may thus also pass a string constant, e.g. "hiho". +(P)STRINGV does NOT pass a pointer, e.g. char *, to either a 1- or a +2-dimensional array, since it cannot determine the array dimensions. +A pointer can only be passed using (P)ZTRINGV. +N.B. If a C routine receives a character array argument, e.g. char a[2][3], + such an argument is actually a pointer and my thus not be passed by + (P)STRINGV. Instead (P)ZTRINGV must be used. + +- STRINGV - The elements of the argument are copied into space malloc'd, and +each element is padded with blanks. The useful size of each element is the same +in both languages. Therefore char bb[6][8]; is equivalent to character*7 bb(6). +On return from the routine the malloc'd space is simply released. + +- PSTRINGV - Since FORTRAN has no trailing '\0', elements in an array of +strings are contiguous. Therefore each element of the C array is padded with +blanks and strip out C's trailing '\0'. After returning from the routine, the +trailing '\0' is reinserted and kill the trailing blanks in each element. + +- SUMMARY: STRING(V) arguments are blank padded during the call to the FORTRAN +routine, but remain original in the C code. (P)STRINGV arguments are blank +padded for the FORTRAN call, and after returning from FORTRAN trailing blanks +are stripped off. + + +5. (P)ZTRINGV: +- (P)ZTRINGV - is identical to (P)STRINGV, +except that the dimensions of the array of strings is explicitly specified, +which thus also allows a pointer to be passed. +(P)ZTRINGV can thus pass a 1- or 2-dimensional char array, e.g. char b[6][8], +or it can pass a pointer to such an array, e.g. char *p;. +ZTRINGV may thus also pass a string constant, e.g. "hiho". +If passing a 1-dimensional array, routine_name_ELEMS_j (see below) must be 1. +[Users of (P)ZTRINGV should examine cfortest.c for examples.]: + +- (P)ZTRINGV must thus be used instead of (P)STRINGV whenever sizeof() +can't be used to determine the dimensions of the array of string or strings. +e.g. when calling FORTRAN from C with a char * received by C as an argument. + +- There is no (P)ZTRING type, since (P)ZTRINGV can pass a 1-dimensional +array or a pointer to such an array, e.g. char a[7], *b; +If passing a 1-dimensional array, routine_name_ELEMS_j (see below) must be 1. + +- To specify the numbers of elements, +routine_name_ELEMS_j and routine_name_ELEMLEN_j must be defined as shown below +before interfacing the routine with CCALLSFSUBn, PROTOCCALLSFFUNn, etc. + +#define routine_name_ELEMS_j ZTRINGV_ARGS(k) + [..ARGS for subroutines, ..ARGF for functions.] +or +#define routine_name_ELEMS_j ZTRINGV_NUM(l) +Where: routine_name is as above. + j [1-n], is the argument being specifying. + k [1-n], the value of the k'th argument is the dynamic number + of elements for argument j. The k'th argument must be + of type BYTE, DOUBLE, FLOAT, INT, LONG or SHORT. + l the number of elements for argument j. This must be an + integer constant available at compile time. + i.e. it is static. + +- Similarly to specify the useful length, [i.e. don't count C's trailing '\0',] +of each element: +#define routine_name_ELEMLEN_j ZTRINGV_ARGS(m) + [..ARGS for subroutines, ..ARGF for functions.] +or +#define routine_name_ELEMLEN_j ZTRINGV_NUM(q) +Where: m [1-n], as for k but this is the length of each element. + q as for l but this is the length of each element. + + +6. ROUTINE +The argument is an EXTERNAL procedure. + +When C passes a routine to Fortran, the language of the function must be +specified as follows: [The case of some_*_function must be given as shown.] + +When C passes a C routine to a Fortran: + FORTRAN_ROUTINE(arg1, .... , + C_FUNCTION(SOME_C_FUNCTION,some_c_function), + ...., argn); + +and similarly when C passes a Fortran routine to Fortran: + FORTRAN_ROUTINE(arg1, .... , + FORTRAN_FUNCTION(SOME_FORT_FUNCTION,some_fort_function), + ...., argn); + +If fcallsc has been redefined; the same definition of fcallsc used when creating +the wrapper for 'some_c_function' must also be defined when C_FUNCTION is used. +See ii) 4. of this section for when and how to redefine fcallsc. + +ROUTINE was introduced with cfortran.h version 2.6. Earlier versions of +cfortran.h used PVOID to pass external procedures as arguments. Using PVOID for +this purpose is no longer recommended since it won't work 'as is' for +apolloFortran, hpuxFortran800, AbsoftUNIXFortran, AbsoftProFortran. + +7. CRAY only: +In a given piece of source code, where FFUNC is any FORTRAN routine, +FORTRAN_FUNCTION(FFUNC,ffunc) +disallows a previous +#define FFUNC(..) CCALLSFSUBn(FFUNC,ffunc,...) [ or CCALLSFFUNn] +in order to make the UPPER CASE FFUNC callable from C. +#define Ffunc(..) ... is OK though, as are obviously any other names. + + +ii) Calling C routines from FORTRAN: + -------------------------------- + +Each of the following two statements to export a C routine to FORTRAN create +FORTRAN 'wrappers', written in C, which must be compiled and linked along with +the original C routines and with the FORTRAN calling code. + +FORTRAN callable 'wrappers' may also be created for C macros. i.e. in this +section, the term 'C function' may be replaced by 'C macro'. + +for C functions returning void: +FCALLSCSUBn( Routine_name,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) + +for all other C functions: +FCALLSCFUNn(routine_type,Routine_name,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) + +Where: +'n' = 0->27 (easily expanded to > 27) stands for the number of arguments to the + routine. +Routine_name = the C name of the routine. [see 9. below] +ROUTINE_NAME = the FORTRAN name of the routine (IN UPPER CASE LETTERS). +routine_name = the FORTRAN name of the routine (IN lower case LETTERS). +routine_type = the type of argument returned by C functions. + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING, VOID. + [Instead of VOID, FCALLSCSUBn is recommended.] +argtype_i = the type of argument passed to the FORTRAN routine and must be + consistent in the definition and prototyping of the routine + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING. + For vectors, i.e. 1 dim. arrays use + = BYTEV, DOUBLEV, FLOATV, INTV, LOGICALV, LONGV, SHORTV, STRINGV. + For vectors of vectors, 2 dim. arrays use + = BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV. + For n-dim. arrays use + = BYTEV..nV's..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, + LONGV..V, SHORTV..V. + For routines changing the values of an argument, the keyword is + prepended by a 'P'. + = PBYTE, PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSHORT, + PSTRING, PNSTRING, PPSTRING, PSTRINGV. + For EXTERNAL procedures passed as arguments use + = ROUTINE. + For exceptional arguments which require no massaging to fit the + argument passing mechanisms use + = PVOID. + The argument is cast and passed as (void *). + + +Notes: + +0. For Fortran calling C++ routines, C++ does NOT easily allow support for: + STRINGV. + BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV. + BYTEV..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, LONGV..V, SHORTV..V. +Though there are ways to get around this restriction, +the restriction is not serious since these types are unlikely to be used as +arguments for a C++ routine. + +1. FCALLSCSUB/FUNn expect that the routine to be 'wrapped' has been properly +prototyped, or at least declared. + + +2. cfortran.h may be expanded to handle a new argument type not already among +the above. + + +3. + +cfortran.h encourages the exact specification of the type and dimension of +array parameters because it allows the C compiler to detect errors in the +arguments when declaring the routine using FCALLSCSUB/FUNn, assuming the +routine to be 'wrapped' has been properly prototyped. + +cfortran.h does not strictly require the exact specification since the argument +is merely the address of the array and is passed on to the calling routine. +Any array parameter could be declared as PVOID, but this circumvents +C's compiletime ability to check the correctness of arguments and is therefore +discouraged. + +Passing the address of these arguments implies that PBYTEV, PFLOATV, ... , +PDOUBLEVV, ... don't exist in cfortran.h, since by default the routine and the +calling code share the same array, i.e. the same values at the same memory +location. + +These comments do NOT apply to arrays of (P)STRINGV. For these parameters, +cfortran.h passes a massaged copy of the array to the routine. When the routine +returns, STRINGV ignores the copy, while PSTRINGV replaces the calling +code's original array with copy, which may have been modified by the called +routine. + + +4. (P(N))STRING arguments have any trailing blanks removed before being passed +to C, the same holds true for each element in (P)STRINGV. Space is malloc'd in +all cases big enough to hold the original string (elements) as well as C's +terminating '\0'. i.e. The useful size of the string (elements) is the same in +both languages. P(N)STRING(V) => the string (elements) will be copied from the +malloc'd space back into the FORTRAN bytes. If one of the two escape mechanisms +mentioned below for PNSTRING has been used, the copying back to FORTRAN is +obviously not relevant. + + +5. (PN)STRING's, [NOT PSTRING's nor (P)STRINGV's,] behavior may be overridden +in two cases. In both cases PNSTRING and STRING behave identically. + +a) If a (PN)STRING argument's first 4 bytes are all the NUL character, +i.e. '\0\0\0\0' the NULL pointer is passed to the C routine. + +b) If the characters of a (PN)STRING argument contain at least one HEX-00, i.e. +the NUL character, i.e. C strings' terminating '\0', the address of the string +is simply passed to the C routine. i.e. The argument is treated in this case as +it would be with PPSTRING, to which we refer the reader for more detail. + +Mechanism a) overrides b). Therefore, to use this mechanism to pass the NULL +string, "", to C, the first character of the string must obviously be the NUL +character, but of the first 4 characters in the string, at least one must not +be HEX-00. + +Example: +C FORTRAN /* C */ + character*40 str #include "cfortran.h" +C Set up a NULL as : void cs(char *s) {if (s) printf("%s.\n",s);} +C i) 4 NUL characters. FCALLSCSUB1(cs,CS,cs,STRING) +C ii) NULL pointer. + character*4 NULL + NULL = CHAR(0)//CHAR(0)//CHAR(0)//CHAR(0) + + data str/'just some string'/ + +C Passing the NULL pointer to cs. + call cs(NULL) +C Passing a copy of 'str' to cs. + call cs(str) +C Passing address of 'str' to cs. Trailing blanks NOT killed. + str(40:) = NULL + call cs(str) + end + +Strings passed from Fortran to C via (PN)STRING must not have undefined +contents, otherwise undefined behavior will result, since one of the above two +escape mechanisms may occur depending on the contents of the string. + +This is not be a problem for STRING arguments, which are read-only in the C +routine and hence must have a well defined value when being passed in. + +PNSTRING arguments require special care. Even if they are write-only in the C +routine, PNSTRING's above two escape mechanisms require that the value of the +argument be well defined when being passed in from Fortran to C. Therefore, +unless one or both of PNSTRING's escape mechanisms are required, PSTRING should +be used instead of PNSTRING. +Prior to version 2.8, PSTRING did have the above two escape mechanisms, +but they were removed from PSTRING to allow strings with undefined contents to +be passed in. PNSTRING behaves like the old PSTRING. +[Thanks go to Paul Dubois (dubios@icf.llnl.gov) for pointing out that PSTRING + must allow for strings with undefined contents to be passed in.] + +Example: +C FORTRAN /* C */ + character*10 s,sn #include "cfortran.h" + void ps(char *s) {strcpy(s,"hello");} +C Can call ps with undef. s. FCALLSCSUB1(ps,PS,ps,PSTRING) + call ps(s) FCALLSCSUB1(ps,PNS,pns,PNSTRING) + print *,s,'=s' + +C Can't call pns with undef. s. +C e.g. If first 4 bytes of s were +C "\0\0\0\0", ps would try +C to copy to NULL because +C of PNSTRING mechanism. + sn = "" + call pns(sn) + print *,sn,'=sn' + + end + + +6. PPSTRING +The address of the string argument is simply passed to the C routine. Therefore +the C routine and the FORTRAN calling code share the same string at the same +memory location. If the C routine modifies the string, the string will also be +modified for the FORTRAN calling code. +The user is responsible for negociating the differences in representation of a +string in Fortran and in C, i.e. the differences are not automatically resolved +as they are for (P(N)STRING(V). +This mechanism is provided for two reasons: + - Some C routines require the string to exist at the given memory location, + after the C routine has exited. Recall that for the usual (P(N)STRING(V) + mechanism, a copy of the FORTRAN string is given to the C routine, and this + copy ceases to exist after returning to the FORTRAN calling code. + - This mechanism can save runtime CPU cycles over (P(N)STRING(V), since it + does not perform their malloc, copy and kill trailing blanks of the string + to be passed. + Only in a small minority of cases does the potential benefit of the saved + CPU cycles outweigh the programming effort required to manually resolve + the differences in representation of a string in Fortran and in C. + +For arguments passed via PPSTRING, the argument passed may also be an array of +strings. + + +7. ROUTINE +ANSI C requires that the type of the value returned by the routine be known, +For all ROUTINE arguments passed from Fortran to C, the type of ROUTINE is +specified by defining a cast as follows: + +#undef ROUTINE_j +#define ROUTINE_j (cast) +where: + j [1-n], is the argument being specifying. + (cast) is a cast matching that of the argument expected by the C + function protoytpe for which a wrapper is being defined. + +e.g. To create a Fortran wrapper for qsort(3C): +#undef ROUTINE_4 +#define ROUTINE_4 (int (*)(void *,void *)) +FCALLSCSUB4(qsort,FQSORT,fqsort,PVOID,INT,INT,ROUTINE) + +In order to maintain backward compatibility, cfortran.h defines a generic cast +for ROUTINE_1, ROUTINE_2, ..., ROUTINE_27. The user's definition is therefore +strictly required only for DEC C, which at the moment is the only compiler +which insists on the correct cast for pointers to functions. + +When using the ROUTINE argument inside some Fortran code: +- it is difficult to pass a C routine as the parameter, + since in many Fortran implementations, + Fortran has no access to the normal C namespace. + e.g. For most UNIX, + Fortran implicitly only has access to C routines ending in _. + If the calling Fortran code receives the routine as a parameter + it can of course easily pass it along. +- if a Fortran routine is passed directly as the parameter, + the called C routine must call the parameter routine + using the Fortran argument passing conventions. +- if a Fortran routine is to be passed as the parameter, + but if Fortran can be made to pass a C routine as the parameter, + then it may be best to pass a C-callable wrapper for the Fortran routine. + The called C routine is thus spared all Fortran argument passing conventions. + cfortran.h can be used to create such a C-callable wrapper + to the parameter Fortran routine. + +ONLY PowerStationFortran: +This Fortran provides no easy way to pass a Fortran routine as an argument to a +C routine. The problem arises because in Fortran the stack is cleared by the +called routine, while in C/C++ it is cleared by the caller. +The C/C++ stack clearing behavior can be changed to that of Fortran by using +stdcall__ in the function prototype. The stdcall__ cannot be applied in this +case since the called C routine expects the ROUTINE parameter to be a C routine +and does not know that it should apply stdcall__. +In principle the cfortran.h generated Fortran callable wrapper for the called C +routine should be able to massage the ROUTINE argument such that stdcall__ is +performed, but it is not yet known how this could be easily done. + + +8. THE FOLLOWING INSTRUCTIONS ARE NOT REQUIRED FOR VAX VMS + ------------ +(P)STRINGV information [NOT required for VAX VMS]: cfortran.h cannot convert +the FORTRAN vector of STRINGS to the required C vector of STRINGS without +explicitly knowing the number of elements in the vector. The application must +do one of the following for each (P)STRINGV argument in a routine before that +routine's FCALLSCFUNn/SUBn is called: + +#define routine_name_STRV_Ai NUM_ELEMS(j) + or +#define routine_name_STRV_Ai NUM_ELEM_ARG(k) + or +#define routine_name_STRV_Ai TERM_CHARS(l,m) + +where: routine_name is as above. + i [i=1->n.] specifies the argument number of a STRING VECTOR. + j would specify a fixed number of elements. + k [k=1->n. k!=i] would specify an integer argument which specifies the + number of elements. + l [char] the terminating character at the beginning of an + element, indicating to cfortran.h that the preceding + elements in the vector are the valid ones. + m [m=1-...] the number of terminating characters required to appear + at the beginning of the terminating string element. + The terminating element is NOT passed on to + the C routine. + +e.g. #define ce_STRV_A1 TERM_CHARS(' ',2) + FCALLSCSUB1(ce,CE,ce,STRINGV) + +cfortran.h will pass on all elements, in the 1st and only argument to the C +routine ce, of the STRING VECTOR until, but not including, the first string +element beginning with 2 blank, ' ', characters. + + +9. INSTRUCTIONS REQUIRED ONLY FOR FORTRAN COMPILERS WHICH GENERATE + ------------- + ROUTINE NAMES WHICH ARE UNDISTINGUISHABLE FROM C ROUTINE NAMES + i.e. VAX VMS + AbsoftUNIXFortran (AbsoftProFortran ok, since it uses Uppercase names.) + HP9000 if not using the +ppu option of f77 + IBM RS/6000 if not using the -qextname option of xlf + Call them the same_namespace compilers. + +FCALLSCSUBn(...) and FCALLSCFUNn(...), when compiled, are expanded into +'wrapper' functions, so called because they wrap around the original C +functions and interface the format of the original C functions' arguments and +return values with the format of the FORTRAN call. + +Ideally one wants to be able to call the C routine from FORTRAN using the same +name as the original C name. This is not a problem for FORTRAN compilers which +append an underscore, '_', to the names of routines, since the original C +routine has the name 'name', and the FORTRAN wrapper is called 'name_'. +Similarly, if the FORTRAN compiler generates upper case names for routines, the +original C routine 'name' can have a wrapper called 'NAME', [Assuming the C +routine name is not in upper case.] For these compilers, e.g. Mips, CRAY, IBM +RS/6000 'xlf -qextname', HP-UX 'f77 +ppu', the naming of the wrappers is done +automatically. + +For same_namespace compilers things are not as simple, but cfortran.h tries to +provide tools and guidelines to minimize the costs involved in meeting their +constraints. The following two options can provide same_namespace compilers +with distinct names for the wrapper and the original C function. + +These compilers are flagged by cfortran.h with the CF_SAME_NAMESPACE constant, +so that the change in the C name occurs only when required. + +For the remainder of the discussion, routine names generated by FORTRAN +compilers are referred to in lower case, these names should be read as upper +case for the appropriate compilers. + + +HP9000: (When f77 +ppu is not used.) +f77 has a -U option which forces uppercase external names to be generated. +Unfortunately, cc does not handle recursive macros. Hence, if one wished to use +-U for separate C and FORTRAN namespaces, one would have to adopt a different +convention of naming the macros which allow C to call FORTRAN subroutines. +(Functions are not a problem.) The macros are currently the uppercase of the +original FORTRAN name, and would have to be changed to lower case or mixed +case, or to a different name. (Lower case would of course cause conflicts on +many other machines.) Therefore, it is suggested that f77 -U not be used, and +instead that Option a) or Option b) outlined below be used. + + +VAX/VMS: +For the name used by FORTRAN in calling a C routine to be the same as that of +the C routine, the source code of the C routine is required. A preprocessor +directive can then force the C compiler to generate a different name for the C +routine. +e.g. #if defined(vms) + #define name name_ + #endif + void name() {printf("name: was called.\n");} + FCALLSCSUB0(name,NAME,name) + +In the above, the C compiler generates the original routine with the name +'name_' and a wrapper called 'NAME'. This assumes that the name of the routine, +as seen by the C programmer, is not in upper case. The VAX VMS linker is not +case sensitive, allowing cfortran.h to export the upper case name as the +wrapper, which then doesn't conflict with the routine name in C. Since the IBM, +HP and AbsoftUNIXFortran platforms have case sensitive linkers +this technique is not available to them. + +The above technique is required even if the C name is in mixed case, see +Option a) for the other compilers, but is obviously not required when +Option b) is used. + + +Option a) Mixed Case names for the C routines to be called by FORTRAN. + +If the original C routines have mixed case names, there are no name space +conflicts. + +Nevertheless for VAX/VMS, the technique outlined above must also used. + + +Option b) Modifying the names of C routines when used by FORTRAN: + +The more robust naming mechanism, which guarantees portability to all machines, +'renames' C routines when called by FORTRAN. Indeed, one must change the names +on same_namespace compilers when FORTRAN calls C routines for which the source +is unavailable. [Even when the source is available, renaming may be preferable +to Option a) for large libraries of C routines.] + +Obviously, if done for a single type of machine, it must be done for all +machines since the names of routines used in FORTRAN code cannot be easily +redefined for different machines. + +The simplest way to achieve this end is to do explicitly give the modified +FORTRAN name in the FCALLSCSUBn(...) and FCALLSCFUNn(...) declarations. e.g. + +FCALLSCSUB0(name,CFNAME,cfname) + +This allows FORTRAN to call the C routine 'name' as 'cfname'. Any name can of +course be used for a given routine when it is called from FORTRAN, although +this is discouraged due to the confusion it is sure to cause. e.g. Bizarre, +but valid and allowing C's 'call_back' routine to be called from FORTRAN as +'abcd': + +FCALLSCSUB0(call_back,ABCD,abcd) + + +cfortran.h also provides preprocessor directives for a systematic 'renaming' of +the C routines when they are called from FORTRAN. This is done by redefining +the fcallsc macro before the FCALLSCSUB/FUN/n declarations as follows: + +#undef fcallsc +#define fcallsc(UN,LN) preface_fcallsc(CF,cf,UN,LN) + +FCALLSCSUB0(hello,HELLO,hello) + +Will cause C's routine 'hello' to be known in FORTRAN as 'cfhello'. Similarly +all subsequent FCALLSCSUB/FUN/n declarations will generate wrappers to allow +FORTRAN to call C with the C routine's name prefaced by 'cf'. The following has +the same effect, with subsequent FCALLSCSUB/FUN/n's appending the modifier to +the original C routines name. + +#undef fcallsc +#define fcallsc(UN,LN) append_fcallsc(Y,y,UN,LN) + +FCALLSCSUB0(Xroutine,ROUTINE,routine) + +Hence, C's Xroutine is called from FORTRAN as: + CALL XROUTINEY() + +The original behavior of FCALLSCSUB/FUN/n, where FORTRAN routine names are left +identical to those of C, is returned using: + +#undef fcallsc +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) + + +In C, when passing a C routine, i.e. its wrapper, as an argument to a FORTRAN +routine, the FORTRAN name declared is used and the correct fcallsc must be in +effect. E.g. Passing 'name' and 'routine' of the above examples to the FORTRAN +routines, FT1 and FT2, respectively: + +/* This might not be needed if fcallsc is already orig_fcallsc. */ +#undef fcallsc +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +FT1(C_FUNCTION(CFNAME,cfname)); + +#undef fcallsc +#define fcallsc(UN,LN) append_fcallsc(Y,y,UN,LN) +FT1(C_FUNCTION(XROUTINE,xroutine)); + +If the names of C routines are modified when used by FORTRAN, fcallsc would +usually be defined once in a header_file.h for the application. This definition +would then be used and be valid for the entire application and fcallsc would at +no point need to be redefined. + + +ONCE AGAIN: THE DEFINITIONS, INSTRUCTIONS, DECLARATIONS AND DIFFICULTIES +DESCRIBED HERE, NOTE 9. of II ii), +APPLY ONLY FOR VAX VMS, + IBM RS/6000 WITHOUT THE -qextname OPTION FOR xlf, OR + HP-UX WITHOUT THE +ppu OPTION FOR f77 + AbsoftUNIXFortran +AND APPLY ONLY WHEN CREATING WRAPPERS WHICH ENABLE FORTRAN TO CALL C ROUTINES. + + + +iii) Using C to manipulate FORTRAN COMMON BLOCKS: + ------------------------------------------------------- + +FORTRAN common blocks are set up with the following three constructs: + +1. +#define Common_block_name COMMON_BLOCK(COMMON_BLOCK_NAME,common_block_name) + +Common_block_name is in UPPER CASE. +COMMON_BLOCK_NAME is in UPPER CASE. +common_block_name is in lower case. +[Common_block_name actually follows the same 'rules' as Routine_name in Note 2. + of II i).] This construct exists to ensure that C code accessing the common +block is machine independent. + +2. +COMMON_BLOCK_DEF(TYPEDEF_OF_STRUCT, Common_block_name); + +where +typedef { ... } TYPEDEF_OF_STRUCT; +declares the structure which maps on to the common block. The #define of +Common_block_name must come before the use of COMMON_BLOCK_DEF. + +3. +In exactly one of the C source files, storage should be set aside for the +common block with the definition: + +TYPEDEF_OF_STRUCT Common_block_name; + +The above definition may have to be omitted on some machines for a common block +which is initialized by Fortran BLOCK DATA or is declared with a smaller size +in the C routines than in the Fortran routines. + +The rules for common blocks are not well defined when linking/loading a mixture +of C and Fortran, but the following information may help resolve problems. + +From the 2nd or ANSI ed. of K&R C, p.31, last paragraph: +i) + An external variable must be defined, exactly once, outside of any function; + this sets aside storage for it. +ii) + The variable must also be declared in each function that wants to access it; + ... + The declaration ... may be implicit from context. + +In Fortran, every routine says 'common /bar/ foo', +i.e. part ii) of the above, but there's no part i) requirement. +cc/ld on some machines don't require i) either. +Therefore, when handling Fortran, and sometimes C, +the loader/linker must automagically set aside storage for common blocks. + +Some loaders, including at least one for the CRAY, turn off the +'automagically set aside storage' capability for Fortran common blocks, +if any C object declares that common block. +Therefore, C code should define, i.e. set aside storage, +for the the common block as shown above. + +e.g. +C Fortran + common /fcb/ v,w,x + character *(13) v, w(4), x(3,2) + +/* C */ +typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF; +#define Fcb COMMON_BLOCK(FCB,fcb) +COMMON_BLOCK_DEF(FCB_DEF,Fcb); +FCB_DEF Fcb; /* Definition, which sets aside storage for Fcb, */ + /* may appear in at most one C source file. */ + + +C programs can place a string (or a multidimensional array of strings) into a +FORTRAN common block using the following call: + +C2FCBSTR( CSTR, FSTR,DIMENSIONS); + +where: + +CSTR is a pointer to the first element of C's copy of the string (array). + The C code must use a duplicate of, not the original, common block string, + because the FORTRAN common block does not allocate space for C strings' + terminating '\0'. + +FSTR is a pointer to the first element of the string (array) in the common + block. + +DIMENSIONS is the number of dimensions of string array. + e.g. char a[10] has DIMENSIONS=0. + char aa[10][17] has DIMENSIONS=1. + etc... + +C2FCBSTR will copy the string (array) from CSTR to FSTR, padding with blanks, +' ', the trailing characters as required. C2FCBSTR uses DIMENSIONS and FSTR to +determine the lengths of the individual string elements and the total number of +elements in the string array. + +Note that: +- the number of string elements in CSTR and FSTR are identical. +- for arrays of strings, the useful lengths of strings in CSTR and FSTR must be + the same. i.e. CSTR elements each have 1 extra character to accommodate the + terminating '\0'. +- On most non-ANSI compilers, the DIMENSION argument cannot be prepended by any + blanks. + + +FCB2CSTR( FSTR, CSTR,DIMENSIONS) + +is the inverse of C2FCBSTR, and shares the same arguments and caveats. +FCB2CSTR copies each string element of FSTR to CSTR, minus FORTRAN strings' +trailing blanks. + + +cfortran.h USERS ARE STRONGLY URGED TO EXAMINE THE COMMON BLOCK EXAMPLES IN +cfortest.c AND cfortex.f. The use of strings in common blocks is +demonstrated, along with a suggested way for C to imitate FORTRAN EQUIVALENCE'd +variables. + + + ===> USERS OF CFORTRAN.H NEED READ NO FURTHER <=== + + +III Some Musings +---------------- + +cfortran.h is simple enough to be used by the most basic of applications, i.e. +making a single C/FORTRAN routine available to the FORTRAN/C programmers. Yet +cfortran.h is powerful enough to easily make entire C/FORTRAN libraries +available to FORTRAN/C programmers. + + +cfortran.h is the ideal tool for FORTRAN libraries which are being (re)written +in C, but are to (continue to) support FORTRAN users. It allows the routines to +be written in 'natural C', without having to consider the FORTRAN argument +passing mechanisms of any machine. It also allows C code accessing these +rewritten routines, to use the C entry point. Without cfortran.h, one risks the +perverse practice of C code calling a C function using FORTRAN argument passing +mechanisms! + + +Perhaps the philosophy and mechanisms of cfortran.h could be used and extended +to create other language bridges such as ADAFORTRAN, CPASCAL, COCCAM, etc. + + +The code generation machinery inside cfortran.h, i.e. the global structure is +quite good, being clean and workable as seen by its ability to meet the needs +and constraints of many different compilers. Though the individual instructions +of the A..., C..., T..., R... and K... tables deserve to be cleaned up. + + + +IV Getting Serious with cfortran.h +----------------------------------- + +cfortran.h is set up to be as simple as possible for the casual user. While +this ease of use will always be present, 'hooks', i.e. preprocessor directives, +are required in cfortran.h so that some of the following 'inefficiencies' can +be eliminated if they cause difficulties: + +o cfortran.h contains a few small routines for string manipulation. These +routines are declared static and are included and compiled in all source code +which uses cfortran.h. Hooks should be provided in cfortran.h to create an +object file of these routines, allowing cfortran.h to merely prototypes +these routines in the application source code. This is the only 'problem' which +afflicts both halves of cfortran.h. The remaining discussion refers to the C +calls FORTRAN half only. + +o Similar to the above routines, cfortran.h generates code for a 'wrapper' +routine for each FUNCTION exported from FORTRAN. Again cfortran.h needs +preprocessor directives to create a single object file of these routines, +and to merely prototype them in the applications. + +o Libraries often contain hundreds of routines. While the preprocessor makes +quick work of generating the required interface code from cfortran.h and the +application.h's, it may be convenient for very large stable libraries to have +final_application.h's which already contain the interface code, i.e. these +final_application.h's would not require cfortran.h. [The convenience can be +imagined for the VAX VMS CC compiler which has a fixed amount of memory for +preprocessor directives. Not requiring cfortran.h, with its hundreds of +directives, could help prevent this compiler from choking on its internal +limits quite so often.] + +With a similar goal in mind, cfortran.h defines 100's of preprocessor +directives. There is always the potential that these will clash with other tags +in the users code, so final_applications.h, which don't require cfortran.h, +also provide the solution. + +In the same vein, routines with more than 14 arguments can not be interfaced by +cfortran.h with compilers which limit C macros to 31 arguments. To resolve this +difficulty, final_application.h's can be created on a compiler without this +limitation. + +Therefore, new machinery is required to do: + +application.h + cfortran.h => final_application.h + +The following example may help clarify the means and ends: + +If the following definition of the HBOOK1 routine, the /*commented_out_part*/, +is passed through the preprocessor [perhaps #undefing and #defining preprocessor +constants if creating an application.h for compiler other than that of the +preprocessor being used, e.g. cpp -Umips -DCRAY ... ] : + +#include "cfortran.h" +PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT) +/*#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \*/ + CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \ + ID,CHTITLE,NX,XMI,XMA,VMX) + +A function prototype is produced by the PROTOCCALLSFSUB6(...). +Interface code is produced, based on the 'variables', +ID,CHTITLE,NX,XMI,XMA,VMX, which will correctly massage a HBOOK1 call. +Therefore, adding the #define line: + +'prototype code' +#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \ + 'interface code'(ID,CHTITLE,NX,XMI,XMA,VMX) + +which is placed into final_application.h. + +The only known limitation of the above method does not allow the 'variable' +names to include B1,B2,...,B9,BA,BB,... + +Obviously the machinery to automatically generate final_applications.h from +cfortran.h and applications.h needs more than just some preprocessor +directives, but a fairly simple unix shell script should be sufficient. Any +takers? + + + +V Machine Dependencies of cfortran.h +------------------------------------ + +Porting cfortran.h applications, e.g. the hbook.h and cstring.c mentioned +above, to other machines is trivial since they are machine independent. Porting +cfortran.h requires a solid knowledge of the new machines C preprocessor, and +its FORTRAN argument passing mechanisms. Logically cfortran.h exists as two +halves, a "C CALLS FORTRAN" and a "FORTRAN CALLS C" utility. In some cases it +may be perfectly reasonable to port only 'one half' of cfortran.h onto a new +system. + + +The lucky programmer porting cfortran.h to a new machine, must discover the +FORTRAN argument passing mechanisms. A safe starting point is to assume that +variables and arrays are simply passed by reference, but nothing is guaranteed. +Strings, and n-dimensional arrays of strings are a different story. It is +doubtful that any systems do it quite like VAX VMS does it, so that a UNIX or +f2c versions may provide an easier starting point. + + +cfortran.h uses and abuses the preprocessor's ## operator. Although the ## +operator does not exist in many compilers, many kludges do. cfortran.h uses +/**/ with no space allowed between the slashes, '/', and the macros or tags +to be concatenated. e.g. +#define concat(a,b) a/**/b /* works*/ +main() +{ + concat(pri,ntf)("hello"); /* e.g. */ +} +N.B. On some compilers without ##, /**/ may also not work. The author may be +able to offer alternate kludges. + + + +VI Bugs in vendors C compilers and other curiosities +---------------------------------------------------- + +1. ULTRIX xxxxxx 4.3 1 RISC + +Condolences to long suffering ultrix users! +DEC supplies a working C front end for alpha/OSF, but not for ultrix. + +From K&R ANSI C p. 231: + ultrix> cat cat.c + #define cat(x, y) x ## y + #define xcat(x,y) cat(x,y) + cat(cat(1,2),3) + xcat(xcat(1,2),3) + ultrix> cc -E cat.c + 123 <---- Should be: cat(1,2)3 + 123 <---- Correct. + ultrix> + +The problem for cfortran.h, preventing use of -std and -std1: + ultrix> cat c.c + #define cat(x, y) x ## y + #define xcat(x,y) cat(x,y) + #define AB(X) X+X + #define C(E,F,G) cat(E,F)(G) + #define X(E,F,G) xcat(E,F)(G) + C(A,B,2) + X(A,B,2) + ultrix> cc -std1 -E c.c + 2+2 + AB (2) <---- ????????????? + ultrix> + ultrix> cc -std0 -E c.c + 2+2 + AB(2) <---- ????????????? + ultrix> + +Due to further ultrix preprocessor problems, +for all definitions of definitions with arguments, +cfortran.h >= 3.0 includes the arguments and recommends the same, +even though it is not required by ANSI C. +e.g. Users are advised to do + #define fcallsc(UN,LN) orig_fcallsc(UN,LN) +instead of + #define fcallsc orig_fcallsc +since ultrix fails to properly preprocess the latter example. +CRAY used to (still does?) occasionally trip up on this problem. + + +2. ConvexOS convex C210 11.0 convex + +In a program with a C main, output to LUN=6=* from Fortran goes into +$pwd/fort.6 instead of stdout. Presumably, a magic incantation can be called +from the C main in order to properly initialize the Fortran I/O. + + +3. SunOS 5.3 Generic_101318-69 sun4m sparc + +The default data and code alignments produced by cc, gcc and f77 are compatible. +If deviating from the defaults, consistent alignment options must be used +across all objects compiled by cc and f77. [Does gcc provide such options?] + + +4. SunOS 5.3 Generic_101318-69 sun4m sparc with cc: SC3.0.1 13 Jul 1994 + or equivalently + ULTRIX 4.4 0 RISC using cc -oldc + are K&R C preprocessors that suffer from infinite loop macros, e.g. + + zedy03> cat src.c + #include "cfortran.h" + PROTOCCALLSFFUN1(INT,FREV,frev, INTV) + #define FREV(A1) CCALLSFFUN1( FREV,frev, INTV, A1) + /* To avoid the problem, deletete these ---^^^^--- spaces. */ + main() { static int a[] = {1,2}; FREV(a); return EXIT_SUCCESS; } + + zedy03> cc -c -Xs -v -DMAX_PREPRO_ARGS=31 -D__CF__KnR src.c + "src.c", line 4: FREV: actuals too long + "src.c", line 4: FREV: actuals too long + .... 3427 more lines of the same message + "src.c", line 4: FREV: actuals too long + cc : Fatal error in /usr/ccs/lib/cpp + Segmentation fault (core dumped) + + +5. Older sun C compilers + +To link to f77 objects, older sun C compilers require the math.h macros: + +#define RETURNFLOAT(x) { union {double _d; float _f; } _kluge; \ + _kluge._f = (x); return _kluge._d; } +#define ASSIGNFLOAT(x,y) { union {double _d; float _f; } _kluge; \ + _kluge._d = (y); x = _kluge._f; } + +Unfortunately, in at least some copies of the sun math.h, the semi-colon +for 'float _f;' is left out, leading to compiler warnings. + +The solution is to correct math.h, or to change cfortran.h to #define +RETURNFLOAT(x) and ASSIGNFLOAT(x,y) instead of including math.h. + + +6. gcc version 2.6.3 and probably all other versions as well + +Unlike all other C compilers supported by cfortran.h, +'gcc -traditional' promotes to double all functions returning float +as demonstrated bu the following example. + +/* m.c */ +#include +int main() { FLOAT_FUNCTION d(); float f; f = d(); printf("%f\n",f); return 0; } + +/* d.c */ +float d() { return -123.124; } + +burow[29] gcc -c -traditional d.c +burow[30] gcc -DFLOAT_FUNCTION=float m.c d.o && a.out +0.000000 +burow[31] gcc -DFLOAT_FUNCTION=double m.c d.o && a.out +-123.124001 +burow[32] + +Thus, 'gcc -traditional' is not supported by cfortran.h. +Support would require the same RETURNFLOAT, etc. macro machinery +present in old sun math.h, before sun gave up the same promotion. + + +7. CRAY + +At least some versions of the t3e and t3d C preprocessor are broken +in the fashion described below. +At least some versions of the t90 C preprocessor do not have this problem. + +On the CRAY, all Fortran names are converted to uppercase. +Generally the uppercase name is also used for the macro interface +created by cfortran.h. + +For example, in the following interface, +EASY is both the name of the macro in the original C code +and EASY is the name of the resulting function to be called. + +#define EASY(A,B) CCALLSFSUB2(EASY,easy, PINT, INTV, A, B) + +The fact that a macro called EASY() expands to a function called EASY() +is not a problem for a working C preprocessor. +From Kernighan and Ritchie, 2nd edition, p.230: + + In both kinds of macro, the replacement token sequence is repeatedly + rescanned for more identifiers. However, once a given identifier has been + replaced in a given expansion, it is not replaced if it turns up again during + rescanning; instead it is left unchanged. + +Unfortunately, some CRAY preprocessors are broken and don't obey the above rule. +A work-around is for the user to NOT use the uppercase name +of the name of the macro interface provided by cfortran.h. For example: + +#define Easy(A,B) CCALLSFSUB2(EASY,easy, PINT, INTV, A, B) + +Luckily, the above work-around is not required since the following +work-around within cfortran.h also circumvents the bug: + + /* (UN), not UN, is required in order to get around CRAY preprocessor bug.*/ + #define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ + +Aside: The Visual C++ compiler is happy with UN, but barfs on (UN), + so either (UN) causes nonstandard C/C++ or Visual C++ is broken. + + +VII History and Acknowledgements +-------------------------------- + +1.0 - Supports VAX VMS using C 3.1 and FORTRAN 5.4. Oct. '90. +1.0 - Supports Silicon Graphics w. Mips Computer 2.0 f77 and cc. Feb. '91. + [Port of C calls FORTRAN half only.] +1.1 - Supports Mips Computer System 2.0 f77 and cc. Mar. '91. + [Runs on at least: Silicon Graphics IRIX 3.3.1 + DECstations with Ultrix V4.1] +1.2 - Internals made simpler, smaller, faster, stronger. May '91. + - Mips version works on IBM RS/6000, this is now called the unix version. +1.3 - UNIX and VAX VMS versions are merged into a single cfortran.h. July '91. + - C can help manipulate (arrays of) strings in FORTRAN common blocks. + - Dimensions of string arrays arguments can be explicit. + - Supports Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. + +2.0 - Improved code generation machinery creates K&R or ANSI C. Aug. '91. + - Supports Sun, CRAY. f2c with vcc on VAX Ultrix. + - cfortran.h macros now require routine and COMMON block names in both + upper and lower case. No changes required to applications though. + - PROTOCCALLSFSUBn is eliminated, with no loss to cfortran.h performance. + - Improved tools and guidelines for naming C routines called by FORTRAN. +2.1 - LOGICAL correctly supported across all machines. Oct. '91. + - Improved support for DOUBLE PRECISION on the CRAY. + - HP9000 fully supported. + - VAX Ultrix cc or gcc with f77 now supported. +2.2 - SHORT, i.e. INTEGER*2, and BYTE now supported. Dec. '91. + - LOGICAL_STRICT introduced. More compact and robust internal tables. + - typeV and typeVV for type = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG,SHORT. + - FORTRAN passing strings and NULL pointer to C routines improved. +2.3 - Extraneous arguments removed from many internal tables. May '92. + - Introduce pseudo argument type SIMPLE for user defined types. + - LynxOS using f2c supported. (Tested with LynxOS 2.0 386/AT.) +2.4 - Separation of internal C and Fortran compilation directives. Oct. '92. + - f2c and NAG f90 supported on all machines. +2.5 - Minor mod.s to source and/or doc for HP9000, f2c, and NAG f90. Nov. '92. +2.6 - Support external procedures as arguments with type ROUTINE. Dec. '92. +2.7 - Support Alpha VMS. Support HP9000 f77 +ppu Jan. '93. + - Support arrays with up to 7 dimensions. + - Minor mod. of Fortran NULL to C via (P)STRING. + - Specify the type of ROUTINE passed from Fortran to C [ANSI C requirement.] + - Macros never receive a null parameter [RS/6000 requirement.] +2.8 - PSTRING for Fortran calls C no longer provides escape to pass April'93. + NULL pointer nor to pass address of original string. + PNSTRING introduced with old PSTRING's behavior. + PPSTRING introduced to always pass original address of string. + - Support Alpha/OSF. + - Document that common blocks used in C should be declared AND defined. + +3.0 - Automagic handling of ANSI ## versus K&R /**/ preprocessor op. March'95. + - Less chance of name space collisions between cfortran.h and other codes. + - SIMPLE macros, supporting user defined types, have changed names. +3.1 - Internal macro name _INT not used. Conflicted with IRIX 5.3. May '95. + - SunOS, all versions, should work out of the box. + - ZTRINGV_ARGS|F(k) may no longer point to a PDOUBLE or PFLOAT argument. + - ConvexOS 11.0 supported. +3.2 - __hpux no longer needs to be restricted to MAX_PREPRO_ARGS=31. Oct. '95. + - PSTRING bug fixed. + - ZTRINGV_ARGS|F(k) may not point to a PBYTE,PINT,PLONG or PSHORT argument. + - (P)ZTRINGV machinery improved. Should lead to fewer compiler warnings. + (P)ZTRINGV no longer limits recursion or the nesting of routines. + - SIMPLE macros, supporting user defined types, have changed slightly. +3.3 - Supports PowerStation Fortran with Visual C++. Nov. '95. + - g77 should work using f2cFortran, though no changes made for it. + - (PROTO)CCALLSFFUN10 extended to (PROTO)CCALLSFFUN14. + - FCALLSCFUN10 and SUB10 extended to FCALLSCFUN14 and SUB14. +3.4 - C++ supported, Dec. '95. + but it required the reintroduction of PROTOCCALLSFSUBn for users. + - HP-UX f77 +800 supported. +3.5 - Absoft UNIX Fortran supported. Sept.'96. +3.6 - Minor corrections to cfortran.doc. Oct. '96. + - Fixed bug for 15th argument. [Thanks to Tom Epperly at Aspen Tech.] + - For AbsoftUNIXFortran, obey default of prepending _C to COMMON BLOCK name. + - Fortran calling C with ROUTINE argument fixed and cleaned up. +3.7 - Circumvent IBM and HP "null argument" preprocessor warning. Oct. '96 +3.8 - (P)STRINGV and (P)ZTRINGV can pass a 1- or 2-dim. char array. Feb. '97 + (P)ZTRINGV thus effectively also provides (P)ZTRING. + - (P)ZTRINGV accepts a (char *) pointer. +3.9 - Bug fixed for *VVVVV. May '97 + - f2c: Work-around for strange underscore-dependent naming feature. + - NEC SX-4 supported. + - CRAY: LOGICAL conversion uses _btol and _ltob from CRAY's fortran.h. + - CRAY: Avoid bug of some versions of the C preprocessor. + - CRAY T3E: FORTRAN_REAL introduced. + +4.0 - new/delete now used for C++. malloc/free still used for C. Jan. '98 + - FALSE no longer is defined by cfortran.h . + - Absoft Pro Fortran for MacOS supported. +4.1 - COMMA and COLON no longer are defined by cfortran.h . April'98 + - Bug fixed when 10th arg. or beyond is a string. + [Rob Lucchesi of NASA-Goddard pointed out this bug.] + - CCALLSFSUB/FUN extended from 14 to 27 arguments. + - Workaround SunOS CC 4.2 cast bug. [Thanks to Savrak SAR of CERN.] +4.2 - Portland Group needs -DpgiFortran . [Thank George Lai of NASA.] June '98 +4.3 - (PROTO)CCALLSFSUB extended from 20 to 27 arguments. July '98 + + +['Support' implies these and more recent releases of the respective + OS/compilers/linkers can be used with cfortran.h. + Earlier releases may also work.] + + +Acknowledgements: +- CERN very generously sponsored a week in 1994 for me to work on cfortran.h. +- M.L.Luvisetto (Istituto Nazionale Fisica Nucleare - Centro Nazionale + Analisi Fotogrammi, Bologna, Italy) provided all the support for the port to + the CRAY. Marisa's encouragement and enthusiasm was also much appreciated. +- J.Bunn (CERN) supported the port to PowerStation Fortran with Visual C++. +- Paul Schenk (UC Riverside, CERN PPE/OPAL) in June 1993 extended cfortran.h 2.7 + to have C++ call Fortran. This was the starting point for full C++ in 3.4. +- Glenn P.Davis of University Corp. for Atmospheric Research (UCAR) / Unidata + supported the NEC SX-4 port and helped understand the CRAY. +- Tony Goelz of Absoft Corporation ported cfortran.h to Absoft. +- Though cfortran.h has been created in my 'copious' free time, I thank + NSERC for their generous support of my grad. student and postdoc years. +- Univ.Toronto, DESY, CERN and others have provided time on their computers. + + +THIS PACKAGE, I.E. CFORTRAN.H, THIS DOCUMENT, AND THE CFORTRAN.H EXAMPLE +PROGRAMS ARE PROPERTY OF THE AUTHOR WHO RESERVES ALL RIGHTS. THIS PACKAGE AND +THE CODE IT PRODUCES MAY BE FREELY DISTRIBUTED WITHOUT FEES, SUBJECT TO THE +FOLLOWING RESTRICTIONS: +- YOU MUST ACCOMPANY ANY COPIES OR DISTRIBUTION WITH THIS (UNALTERED) NOTICE. +- YOU MAY NOT RECEIVE MONEY FOR THE DISTRIBUTION OR FOR ITS MEDIA + (E.G. TAPE, DISK, COMPUTER, PAPER.) +- YOU MAY NOT PREVENT OTHERS FROM COPYING IT FREELY. +- YOU MAY NOT DISTRIBUTE MODIFIED VERSIONS WITHOUT CLEARLY DOCUMENTING YOUR + CHANGES AND NOTIFYING THE AUTHOR. +- YOU MAY NOT MISREPRESENTED THE ORIGIN OF THIS SOFTWARE, EITHER BY EXPLICIT + CLAIM OR BY OMISSION. + +THE INTENT OF THE ABOVE TERMS IS TO ENSURE THAT THE CFORTRAN.H PACKAGE NOT BE +USED FOR PROFIT MAKING ACTIVITIES UNLESS SOME ROYALTY ARRANGEMENT IS ENTERED +INTO WITH ITS AUTHOR. + +THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST +OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. THE AUTHOR IS NOT RESPONSIBLE +FOR ANY SUPPORT OR SERVICE OF THE CFORTRAN.H PACKAGE. + + Burkhard Burow + burow@desy.de + +P.S. Your comments and questions are welcomed and usually promptly answered. + +VAX VMS and Ultrix, Alpha, OSF, Silicon Graphics (SGI), DECstation, Mips RISC, +Sun, CRAY, Convex, IBM RS/6000, Apollo DomainOS, HP, LynxOS, f2c, NAG, Absoft, +NEC SX-4, PowerStation and Visual C++ are registered trademarks of their +respective owners. + +/* end: cfortran.doc */ diff --git a/pkg/tbtables/cfitsio/cfortran.h b/pkg/tbtables/cfitsio/cfortran.h new file mode 100644 index 00000000..abdeb430 --- /dev/null +++ b/pkg/tbtables/cfitsio/cfortran.h @@ -0,0 +1,2397 @@ +/* cfortran.h 4.4_cernlib2002 */ +/* http://www-zeus.desy.de/~burow/cfortran/ */ +/* Burkhard Burow burow@desy.de 1990 - 2002. */ + +#ifndef __CFORTRAN_LOADED +#define __CFORTRAN_LOADED + +/* + THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU + SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING, + MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE. +*/ + +/******* + Modifications: + Oct 1997: Changed symbol name extname to appendus (PDW/HSTX) + (Conflicted with a common variable name in FTOOLS) + Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX) + Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat + single strings as vectors with single elements + Nov 1999: If macintoxh defined, also define f2cfortran (for Mac OS-X) + Apr 2000: If WIN32 defined, also define PowerStationFortran and + VISUAL_CPLUSPLUS (Visual C++) + Jun 2000: If __GNUC__ and linux defined, also define f2cFortran + (linux/gcc environment detection) + Apr 2002: If __CYGWIN__ is defined, also define f2cFortran + Nov 2002: If __APPLE__ defined, also define f2cfortran (for Mac OS-X) + *******/ +/* + Avoid symbols already used by compilers and system *.h: + __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c + + */ + + +/* First prepare for the C compiler. */ + +#ifndef ANSI_C_preprocessor /* i.e. user can override. */ +#ifdef __CF__KnR +#define ANSI_C_preprocessor 0 +#else +#ifdef __STDC__ +#define ANSI_C_preprocessor 1 +#else +#define _cfleft 1 +#define _cfright +#define _cfleft_cfright 0 +#define ANSI_C_preprocessor _cfleft/**/_cfright +#endif +#endif +#endif + +#if ANSI_C_preprocessor +#define _0(A,B) A##B +#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */ +#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */ +#define _3(A,B,C) _(A,_(B,C)) +#else /* if it turns up again during rescanning. */ +#define _(A,B) A/**/B +#define _2(A,B) A/**/B +#define _3(A,B,C) A/**/B/**/C +#endif + +#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__)) +#define VAXUltrix +#endif + +#include /* NULL [in all machines stdio.h] */ +#include /* strlen, memset, memcpy, memchr. */ +#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) ) +#include /* malloc,free */ +#else +#include /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/ +#ifdef apollo +#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */ +#endif +#endif + +#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx)) +#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */ + /* Manually define __CF__KnR for HP if desired/required.*/ +#endif /* i.e. We will generate Kernighan and Ritchie C. */ +/* Note that you may define __CF__KnR before #include cfortran.h, in order to +generate K&R C instead of the default ANSI C. The differences are mainly in the +function prototypes and declarations. All machines, except the Apollo, work +with either style. The Apollo's argument promotion rules require ANSI or use of +the obsolete std_$call which we have not implemented here. Hence on the Apollo, +only C calling FORTRAN subroutines will work using K&R style.*/ + + +/* Remainder of cfortran.h depends on the Fortran compiler. */ + +#if defined(CLIPPERFortran) || defined(pgiFortran) +#define f2cFortran +#endif + +/* VAX/VMS does not let us \-split long #if lines. */ +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran)) +/* If no Fortran compiler is given, we choose one for the machines we know. */ +#if defined(lynx) || defined(VAXUltrix) +#define f2cFortran /* Lynx: Only support f2c at the moment. + VAXUltrix: f77 behaves like f2c. + Support f2c or f77 with gcc, vcc with f2c. + f77 with vcc works, missing link magic for f77 I/O.*/ +#endif +#if defined(WIN32) && !defined(__CYGWIN__) /* 04/13/00 DM: Add these lines for NT */ +#define PowerStationFortran /* with PowerStationFortran and and Visual C++ */ +#define VISUAL_CPLUSPLUS +#endif +#if defined(g77Fortran) /* 11/03/97 PDW */ +#define f2cFortran +#endif +#if defined(__CYGWIN__) /* 04/11/02 LEB */ +#define f2cFortran +#endif +#if defined(__GNUC__) && defined(linux) /* 06/21/00 PDW */ +#define f2cFortran +#endif +#if defined(macintosh) /* 11/1999 */ +#define f2cFortran +#endif +#if defined(__APPLE__) /* 11/2002 */ +#define f2cFortran +#endif +#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */ +#define hpuxFortran /* Should also allow hp9000s7/800 use.*/ +#endif +#if defined(apollo) +#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */ +#endif +#if defined(sun) || defined(__sun) +#define sunFortran +#endif +#if defined(_IBMR2) +#define IBMR2Fortran +#endif +#if defined(_CRAY) +#define CRAYFortran /* _CRAYT3E also defines some behavior. */ +#endif +#if defined(_SX) +#define SXFortran +#endif +#if defined(mips) || defined(__mips) +#define mipsFortran +#endif +#if defined(vms) || defined(__vms) +#define vmsFortran +#endif +#if defined(__alpha) && defined(__unix__) +#define DECFortran +#endif +#if defined(__convex__) +#define CONVEXFortran +#endif +#if defined(VISUAL_CPLUSPLUS) +#define PowerStationFortran +#endif +#endif /* ...Fortran */ +#endif /* ...Fortran */ + +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran)) +/* If your compiler barfs on ' #error', replace # with the trigraph for # */ + #error "cfortran.h: Can't find your environment among:\ + - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \ + - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \ + - VAX VMS CC 3.1 and FORTRAN 5.4. \ + - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \ + - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \ + - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \ + - CRAY \ + - NEC SX-4 SUPER-UX \ + - CONVEX \ + - Sun \ + - PowerStation Fortran with Visual C++ \ + - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \ + - LynxOS: cc or gcc with f2c. \ + - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \ + - f77 with vcc works; but missing link magic for f77 I/O. \ + - NO fort. None of gcc, cc or vcc generate required names.\ + - f2c : Use #define f2cFortran, or cc -Df2cFortran \ + - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \ + - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \ + - Absoft Pro Fortran: Use #define AbsoftProFortran \ + - Portland Group Fortran: Use #define pgiFortran" +/* Compiler must throw us out at this point! */ +#endif +#endif + + +#if defined(VAXC) && !defined(__VAXC) +#define OLD_VAXC +#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */ +#endif + +/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */ + +#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus) +#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#else +#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran) +#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */ +#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ +#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */ +#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */ +#endif +#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */ +#else /* For following machines one may wish to change the fcallsc default. */ +#define CF_SAME_NAMESPACE +#ifdef vmsFortran +#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */ + /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/ + /* because VAX/VMS doesn't do recursive macros. */ +#define orig_fcallsc(UN,LN) UN +#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */ +#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#endif /* vmsFortran */ +#endif /* CRAYFortran PowerStationFortran */ +#endif /* ....Fortran */ + +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN)) +#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p)) + +#define C_FUNCTION(UN,LN) fcallsc(UN,LN) +#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN) + +#ifndef COMMON_BLOCK +#ifndef CONVEXFortran +#ifndef CLIPPERFortran +#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)) +#define COMMON_BLOCK(UN,LN) CFC_(UN,LN) +#else +#define COMMON_BLOCK(UN,LN) _(_C,LN) +#endif /* AbsoftUNIXFortran or AbsoftProFortran */ +#else +#define COMMON_BLOCK(UN,LN) _(LN,__) +#endif /* CLIPPERFortran */ +#else +#define COMMON_BLOCK(UN,LN) _3(_,LN,_) +#endif /* CONVEXFortran */ +#endif /* COMMON_BLOCK */ + +#ifndef DOUBLE_PRECISION +#if defined(CRAYFortran) && !defined(_CRAYT3E) +#define DOUBLE_PRECISION long double +#else +#define DOUBLE_PRECISION double +#endif +#endif + +#ifndef FORTRAN_REAL +#if defined(CRAYFortran) && defined(_CRAYT3E) +#define FORTRAN_REAL double +#else +#define FORTRAN_REAL float +#endif +#endif + +#ifdef CRAYFortran +#ifdef _CRAY +#include +#else +#include "fortran.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */ +/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/ +#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine + arg.'s have been declared float *, or double *. */ +#else +#define FLOATVVVVVVV_cfPP +#define VOIDP +#endif + +#ifdef vmsFortran +#if defined(vms) || defined(__vms) +#include +#else +#include "descrip.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#endif + +#ifdef sunFortran +#if defined(sun) || defined(__sun) +#include /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */ +#else +#include "math.h" /* i.e. if crosscompiling assume user has file. */ +#endif +/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3, + * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in + * , since sun C no longer promotes C float return values to doubles. + * Therefore, only use them if defined. + * Even if gcc is being used, assume that it exhibits the Sun C compiler + * behavior in order to be able to use *.o from the Sun C compiler. + * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc. + */ +#endif + +#ifndef apolloFortran +#define COMMON_BLOCK_DEF(DEFINITION, NAME) DEFINITION NAME +#define CF_NULL_PROTO +#else /* HP doesn't understand #elif. */ +/* Without ANSI prototyping, Apollo promotes float functions to double. */ +/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */ +#define CF_NULL_PROTO ... +#ifndef __CF__APOLLO67 +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME __attribute((__section(NAME))) +#else +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME #attribute[section(NAME)] +#endif +#endif + +#ifdef __cplusplus +#undef CF_NULL_PROTO +#define CF_NULL_PROTO ... +#endif + + +#ifndef USE_NEW_DELETE +#ifdef __cplusplus +#define USE_NEW_DELETE 1 +#else +#define USE_NEW_DELETE 0 +#endif +#endif +#if USE_NEW_DELETE +#define _cf_malloc(N) new char[N] +#define _cf_free(P) delete[] P +#else +#define _cf_malloc(N) (char *)malloc(N) +#define _cf_free(P) free(P) +#endif + +#ifdef mipsFortran +#define CF_DECLARE_GETARG int f77argc; char **f77argv +#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV +#else +#define CF_DECLARE_GETARG +#define CF_SET_GETARG(ARGC,ARGV) +#endif + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define AcfCOMMA , +#define AcfCOLON ; + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES USED WITHIN CFORTRAN.H */ + +#define _cfMIN(A,B) (As) { /* Need this to handle NULL string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally +points to the terminating '\0' of s, but may actually point to anywhere in s. +s's new '\0' will be placed at e or earlier in order to remove any trailing t's. +If es) { /* Watch out for neg. length string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* Note the following assumes that any element which has t's to be chopped off, +does indeed fill the entire element. */ +#ifndef __CF__KnR +static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t) +#else +static char *vkill_trailing( cstr, elem_len, sizeofcstr, t) + char* cstr; int elem_len; int sizeofcstr; char t; +#endif +{ int i; +for (i=0; i= 4.3 gives message: + zow35> cc -c -DDECFortran cfortest.c + cfe: Fatal: Out of memory: cfortest.c + zow35> + Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine + if using -Aa, otherwise we have a problem. + */ +#ifndef MAX_PREPRO_ARGS +#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR))) +#define MAX_PREPRO_ARGS 31 +#else +#define MAX_PREPRO_ARGS 99 +#endif +#endif + +#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +/* In addition to explicit Absoft stuff, only Absoft requires: + - DEFAULT coming from _cfSTR. + DEFAULT could have been called e.g. INT, but keep it for clarity. + - M term in CFARGT14 and CFARGT14FS. + */ +#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0) +#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0) +#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0) +#define DEFAULT_cfABSOFT1 +#define LOGICAL_cfABSOFT1 +#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING +#define DEFAULT_cfABSOFT2 +#define LOGICAL_cfABSOFT2 +#define STRING_cfABSOFT2 ,unsigned D0 +#define DEFAULT_cfABSOFT3 +#define LOGICAL_cfABSOFT3 +#define STRING_cfABSOFT3 ,D0 +#else +#define ABSOFT_cf1(T0) +#define ABSOFT_cf2(T0) +#define ABSOFT_cf3(T0) +#endif + +/* _Z introduced to cicumvent IBM and HP silly preprocessor warning. + e.g. "Macro CFARGT14 invoked with a null argument." + */ +#define _Z + +#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) +#define CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \ + S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \ + S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27) + +#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \ + F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \ + M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + +#if !(defined(PowerStationFortran)||defined(hpuxFortran800)) +/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields: + SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c + "c.c", line 406: warning: argument mismatch + Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok. + Behavior is most clearly seen in example: + #define A 1 , 2 + #define C(X,Y,Z) x=X. y=Y. z=Z. + #define D(X,Y,Z) C(X,Y,Z) + D(x,A,z) + Output from preprocessor is: x = x . y = 1 . z = 2 . + #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +*/ +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \ + F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \ + M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + +#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \ + S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \ + S(TB,11) S(TC,12) S(TD,13) S(TE,14) +#if MAX_PREPRO_ARGS>31 +#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \ + F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \ + S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \ + S(TH,17) S(TI,18) S(TJ,19) S(TK,20) +#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \ + F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \ + F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \ + S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \ + S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \ + S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \ + S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27) +#endif +#else +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) +#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \ + F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \ + F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \ + F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27) + +#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \ + F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) +#if MAX_PREPRO_ARGS>31 +#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \ + F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \ + F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) +#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \ + F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \ + F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \ + F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \ + F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27) +#endif +#endif + + +#define PROTOCCALLSFSUB1( UN,LN,T1) \ + PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) + +#define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0) +#define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0) + + +#ifndef FCALLSC_QUALIFIER +#ifdef VISUAL_CPLUSPLUS +#define FCALLSC_QUALIFIER __stdcall +#else +#define FCALLSC_QUALIFIER +#endif +#endif + +#ifdef __cplusplus +#define CFextern extern "C" +#else +#define CFextern extern +#endif + + +#ifdef CFSUBASFUN +#define PROTOCCALLSFSUB0(UN,LN) \ + PROTOCCALLSFFUN0( VOID,UN,LN) +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\ + PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#else +/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after + #include-ing cfortran.h if calling the FORTRAN wrapper within the same + source code where the wrapper is created. */ +#define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))(); +#ifndef __CF__KnR +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ); +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) ); +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ); +#else +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + PROTOCCALLSFSUB0(UN,LN) +#endif +#endif + + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + + +#define CCALLSFSUB1( UN,LN,T1, A1) \ + CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \ + CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#ifdef __cplusplus +#define CPPPROTOCLSFSUB0( UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#else +#define CPPPROTOCLSFSUB0(UN,LN) \ + PROTOCCALLSFSUB0(UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#endif + +#ifdef CFSUBASFUN +#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) +#else +/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */ +#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \ + CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \ + ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \ + ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \ + ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \ + CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \ + WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0) +#endif + + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0) +#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0) +#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0) +#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0) +#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) +#else +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \ + VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \ + CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \ + ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \ + ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \ + CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \ + WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \ + WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0) +#endif +#endif /* MAX_PREPRO_ARGS */ + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0) +#define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0) +#define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0) +#define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0) +#define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0) +#define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) +#else +#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \ + VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \ + VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \ + VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \ + CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \ + ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \ + ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \ + ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \ + ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \ + CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \ + WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \ + WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \ + WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0) +#endif +#endif /* MAX_PREPRO_ARGS */ + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */ + +/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN + function is called. Therefore, especially for creator's of C header files + for large FORTRAN libraries which include many functions, to reduce + compile time and object code size, it may be desirable to create + preprocessor directives to allow users to create code for only those + functions which they use. */ + +/* The following defines the maximum length string that a function can return. + Of course it may be undefine-d and re-define-d before individual + PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived + from the individual machines' limits. */ +#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE + +/* The following defines a character used by CFORTRAN.H to flag the end of a + string coming out of a FORTRAN routine. */ +#define CFORTRAN_NON_CHAR 0x7F + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA) +#define __SEP_0(TN,cfCOMMA) +#define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0) +#define INT_cfSEP(T,B) _(A,B) +#define INTV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define PINT_cfSEP(T,B) INT_cfSEP(T,B) +#define PVOID_cfSEP(T,B) INT_cfSEP(T,B) +#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B) +#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B) +#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/ +#define STRING_cfSEP(T,B) INT_cfSEP(T,B) +#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) + +#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE) +#ifdef OLD_VAXC +#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */ +#else +#define INTEGER_BYTE signed char /* default */ +#endif +#else +#define INTEGER_BYTE unsigned char +#endif +#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE +#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION +#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL +#define INTVVVVVVV_cfTYPE int +#define LOGICALVVVVVVV_cfTYPE int +#define LONGVVVVVVV_cfTYPE long +#define SHORTVVVVVVV_cfTYPE short +#define PBYTE_cfTYPE INTEGER_BYTE +#define PDOUBLE_cfTYPE DOUBLE_PRECISION +#define PFLOAT_cfTYPE FORTRAN_REAL +#define PINT_cfTYPE int +#define PLOGICAL_cfTYPE int +#define PLONG_cfTYPE long +#define PSHORT_cfTYPE short + +#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A) +#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V) +#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W) +#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X) +#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y) +#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z) + +#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0) +#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z) +#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0) +#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0) +#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0) +#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0) +#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0) +#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0) +#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0) +#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +/*CRAY coughs on the first, + i.e. the usual trouble of not being able to + define macros to macros with arguments. + New ultrix is worse, it coughs on all such uses. + */ +/*#define SIMPLE_cfINT PVOID_cfINT*/ +#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define CF_0_cfINT(N,A,B,X,Y,Z) + + +#define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0) +#define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I) +#define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0) +#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A +#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A +#define PINT_cfU(T,A) _(T,_cfTYPE) * A +#define PVOID_cfU(T,A) void *A +#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO) +#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */ +#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */ +#define STRINGV_cfU(T,A) char *A +#define PSTRING_cfU(T,A) char *A +#define PSTRINGV_cfU(T,A) char *A +#define ZTRINGV_cfU(T,A) char *A +#define PZTRINGV_cfU(T,A) char *A + +/* VOID breaks U into U and UU. */ +#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A +#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */ +#define STRING_cfUU(T,A) char *A + + +#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A +#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A +#else +#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A +#endif +#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A +#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A +#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A +#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A + +#define BYTE_cfE INTEGER_BYTE A0; +#define DOUBLE_cfE DOUBLE_PRECISION A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfE FORTRAN_REAL A0; +#else +#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0; +#endif +#define INT_cfE int A0; +#define LOGICAL_cfE int A0; +#define LONG_cfE long A0; +#define SHORT_cfE short A0; +#define VOID_cfE +#ifdef vmsFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static fstring A0 = \ + {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\ + memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#else +#ifdef CRAYFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\ + memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING); +#else +/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; + * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */ +#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + memset(A0, CFORTRAN_NON_CHAR, \ + MAX_LEN_FORTRAN_FUNCTION_STRING); \ + *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#endif +#endif +/* ESTRING must use static char. array which is guaranteed to exist after + function returns. */ + +/* N.B.i) The diff. for 0 (Zero) and >=1 arguments. + ii)That the following create an unmatched bracket, i.e. '(', which + must of course be matched in the call. + iii)Commas must be handled very carefully */ +#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)( +#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)( +#ifdef vmsFortran +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0 +#else +#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0 +#else +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING +#endif +#endif + +#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN) +#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN) +#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/ + +#define BYTEVVVVVVV_cfPP +#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */ +#define DOUBLEVVVVVVV_cfPP +#define LOGICALVVVVVVV_cfPP +#define LONGVVVVVVV_cfPP +#define SHORTVVVVVVV_cfPP +#define PBYTE_cfPP +#define PINT_cfPP +#define PDOUBLE_cfPP +#define PLOGICAL_cfPP +#define PLONG_cfPP +#define PSHORT_cfPP +#define PFLOAT_cfPP FLOATVVVVVVV_cfPP + +#define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0) +#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A +#define INTV_cfB(T,A) A +#define INTVV_cfB(T,A) (A)[0] +#define INTVVV_cfB(T,A) (A)[0][0] +#define INTVVVV_cfB(T,A) (A)[0][0][0] +#define INTVVVVV_cfB(T,A) (A)[0][0][0][0] +#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0] +#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0] +#define PINT_cfB(T,A) _(T,_cfPP)&A +#define STRING_cfB(T,A) (char *) A +#define STRINGV_cfB(T,A) (char *) A +#define PSTRING_cfB(T,A) (char *) A +#define PSTRINGV_cfB(T,A) (char *) A +#define PVOID_cfB(T,A) (void *) A +#define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A +#define ZTRINGV_cfB(T,A) (char *) A +#define PZTRINGV_cfB(T,A) (char *) A + +#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0) +#define DEFAULT_cfS(M,I,A) +#define LOGICAL_cfS(M,I,A) +#define PLOGICAL_cfS(M,I,A) +#define STRING_cfS(M,I,A) ,sizeof(A) +#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \ + +secondindexlength(A)) +#define PSTRING_cfS(M,I,A) ,sizeof(A) +#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A) +#define ZTRINGV_cfS(M,I,A) +#define PZTRINGV_cfS(M,I,A) + +#define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0) +#define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0) +#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0) +#define H_CF_SPECIAL unsigned +#define HH_CF_SPECIAL +#define DEFAULT_cfH(M,I,A) +#define LOGICAL_cfH(S,U,B) +#define PLOGICAL_cfH(S,U,B) +#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B +#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define ZTRINGV_cfH(S,U,B) +#define PZTRINGV_cfH(S,U,B) + +/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */ +/* No spaces inside expansion. They screws up macro catenation kludge. */ +#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E) +#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E) +#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E) +#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E) +#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E) +#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E) +#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E) +#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E) +#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E) +#define CF_0_cfSTR(N,T,A,B,C,D,E) + +/* See ACF table comments, which explain why CCF was split into two. */ +#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I)) +#define DEFAULT_cfC(M,I,A,B,C) +#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A); +#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A); +#ifdef vmsFortran +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0')); + /* PSTRING_cfC to beware of array A which does not contain any \0. */ +#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \ + B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \ + memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1)); +#else +#define STRING_cfC(M,I,A,B,C) (B.nombre=A,B.clen=strlen(A), \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \ + (memset(B.nombre+B.clen,' ',C-B.clen-1),B.nombre[B.flen=C-1]='\0')); +#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \ + (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1)); +#endif + /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */ +#define STRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define PSTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define ZTRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) +#define PZTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) + +#define BYTE_cfCCC(A,B) &A +#define DOUBLE_cfCCC(A,B) &A +#if !defined(__CF__KnR) +#define FLOAT_cfCCC(A,B) &A + /* Although the VAX doesn't, at least the */ +#else /* HP and K&R mips promote float arg.'s of */ +#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */ +#endif /* use A here to pass the argument to FORTRAN. */ +#define INT_cfCCC(A,B) &A +#define LOGICAL_cfCCC(A,B) &A +#define LONG_cfCCC(A,B) &A +#define SHORT_cfCCC(A,B) &A +#define PBYTE_cfCCC(A,B) A +#define PDOUBLE_cfCCC(A,B) A +#define PFLOAT_cfCCC(A,B) A +#define PINT_cfCCC(A,B) A +#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */ +#define PLONG_cfCCC(A,B) A +#define PSHORT_cfCCC(A,B) A + +#define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I)) +#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define INTV_cfCC(T,A,B) A +#define INTVV_cfCC(T,A,B) A +#define INTVVV_cfCC(T,A,B) A +#define INTVVVV_cfCC(T,A,B) A +#define INTVVVVV_cfCC(T,A,B) A +#define INTVVVVVV_cfCC(T,A,B) A +#define INTVVVVVVV_cfCC(T,A,B) A +#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define PVOID_cfCC(T,A,B) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfCC(T,A,B) &A +#else +#define ROUTINE_cfCC(T,A,B) A +#endif +#define SIMPLE_cfCC(T,A,B) A +#ifdef vmsFortran +#define STRING_cfCC(T,A,B) &B.f +#define STRINGV_cfCC(T,A,B) &B +#define PSTRING_cfCC(T,A,B) &B +#define PSTRINGV_cfCC(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen) +#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen) +#define PSTRING_cfCC(T,A,B) _cptofcd(A,B) +#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen) +#else +#define STRING_cfCC(T,A,B) A +#define STRINGV_cfCC(T,A,B) B.fs +#define PSTRING_cfCC(T,A,B) A +#define PSTRINGV_cfCC(T,A,B) B.fs +#endif +#endif +#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B) +#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B) + +#define BYTE_cfX return A0; +#define DOUBLE_cfX return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfX return A0; +#else +#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0; +#endif +#define INT_cfX return A0; +#define LOGICAL_cfX return F2CLOGICAL(A0); +#define LONG_cfX return A0; +#define SHORT_cfX return A0; +#define VOID_cfX return ; +#if defined(vmsFortran) || defined(CRAYFortran) +#define STRING_cfX return kill_trailing( \ + kill_trailing(AA0,CFORTRAN_NON_CHAR),' '); +#else +#define STRING_cfX return kill_trailing( \ + kill_trailing( A0,CFORTRAN_NON_CHAR),' '); +#endif + +#define CFFUN(NAME) _(__cf__,NAME) + +/* Note that we don't use LN here, but we keep it for consistency. */ +#define CCALLSFFUN0(UN,LN) CFFUN(UN)() + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define CCALLSFFUN1( UN,LN,T1, A1) \ + CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \ + CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \ + BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \ + BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \ + SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \ + SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \ + SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \ + SCF(TD,LN,13,AD) SCF(TE,LN,14,AE)))) + +/* N.B. Create a separate function instead of using (call function, function +value here) because in order to create the variables needed for the input +arg.'s which may be const.'s one has to do the creation within {}, but these +can never be placed within ()'s. Therefore one must create wrapper functions. +gcc, on the other hand may be able to avoid the wrapper functions. */ + +/* Prototypes are needed to correctly handle the value returned correctly. N.B. +Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN +functions returning strings have extra arg.'s. Don't bother, since this only +causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn +for the same function in the same source code. Something done by the experts in +debugging only.*/ + +#define PROTOCCALLSFFUN0(F,UN,LN) \ +_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \ +static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)} + +#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0) +#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0) +#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */ + +#ifndef __CF__KnR +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \ + CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \ + WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)} +#else +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \ + CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \ + WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)} +#endif + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#if defined(vmsFortran) || defined(CRAYFortran) +#define DCF(TN,I) +#define DDCF(TN,I) +#define DDDCF(TN,I) +#else +#define DCF(TN,I) HCF(TN,I) +#define DDCF(TN,I) HHCF(TN,I) +#define DDDCF(TN,I) HHHCF(TN,I) +#endif + +#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0) +#define DEFAULT_cfQ(B) +#define LOGICAL_cfQ(B) +#define PLOGICAL_cfQ(B) +#define STRINGV_cfQ(B) char *B; unsigned int _(B,N); +#define STRING_cfQ(B) char *B=NULL; +#define PSTRING_cfQ(B) char *B=NULL; +#define PSTRINGV_cfQ(B) STRINGV_cfQ(B) +#define PNSTRING_cfQ(B) char *B=NULL; +#define PPSTRING_cfQ(B) + +#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */ +#define ROUTINE_orig *(void**)& +#else +#define ROUTINE_orig (void *) +#endif + +#define ROUTINE_1 ROUTINE_orig +#define ROUTINE_2 ROUTINE_orig +#define ROUTINE_3 ROUTINE_orig +#define ROUTINE_4 ROUTINE_orig +#define ROUTINE_5 ROUTINE_orig +#define ROUTINE_6 ROUTINE_orig +#define ROUTINE_7 ROUTINE_orig +#define ROUTINE_8 ROUTINE_orig +#define ROUTINE_9 ROUTINE_orig +#define ROUTINE_10 ROUTINE_orig +#define ROUTINE_11 ROUTINE_orig +#define ROUTINE_12 ROUTINE_orig +#define ROUTINE_13 ROUTINE_orig +#define ROUTINE_14 ROUTINE_orig +#define ROUTINE_15 ROUTINE_orig +#define ROUTINE_16 ROUTINE_orig +#define ROUTINE_17 ROUTINE_orig +#define ROUTINE_18 ROUTINE_orig +#define ROUTINE_19 ROUTINE_orig +#define ROUTINE_20 ROUTINE_orig +#define ROUTINE_21 ROUTINE_orig +#define ROUTINE_22 ROUTINE_orig +#define ROUTINE_23 ROUTINE_orig +#define ROUTINE_24 ROUTINE_orig +#define ROUTINE_25 ROUTINE_orig +#define ROUTINE_26 ROUTINE_orig +#define ROUTINE_27 ROUTINE_orig + +#define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I)) +#define BYTE_cfT(M,I,A,B,D) *A +#define DOUBLE_cfT(M,I,A,B,D) *A +#define FLOAT_cfT(M,I,A,B,D) *A +#define INT_cfT(M,I,A,B,D) *A +#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A) +#define LONG_cfT(M,I,A,B,D) *A +#define SHORT_cfT(M,I,A,B,D) *A +#define BYTEV_cfT(M,I,A,B,D) A +#define DOUBLEV_cfT(M,I,A,B,D) A +#define FLOATV_cfT(M,I,A,B,D) VOIDP A +#define INTV_cfT(M,I,A,B,D) A +#define LOGICALV_cfT(M,I,A,B,D) A +#define LONGV_cfT(M,I,A,B,D) A +#define SHORTV_cfT(M,I,A,B,D) A +#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/ +#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */ +#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */ +#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */ +#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */ +#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */ +#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVV_cfT(M,I,A,B,D) (void *)A +#define INTVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define PBYTE_cfT(M,I,A,B,D) A +#define PDOUBLE_cfT(M,I,A,B,D) A +#define PFLOAT_cfT(M,I,A,B,D) VOIDP A +#define PINT_cfT(M,I,A,B,D) A +#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) +#define PLONG_cfT(M,I,A,B,D) A +#define PSHORT_cfT(M,I,A,B,D) A +#define PVOID_cfT(M,I,A,B,D) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A) +#else +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A +#endif +/* A == pointer to the characters + D == length of the string, or of an element in an array of strings + E == number of elements in an array of strings */ +#define TTSTR( A,B,D) \ + ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' ')) +#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \ + memchr(A,'\0',D) ?A : TTSTR(A,B,D) +#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \ + vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' ')) +#ifdef vmsFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length , A->dsc$l_m[0]) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \ + num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A) +#else +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D) +#define PPSTRING_cfT(M,I,A,B,D) A +#endif +#endif +#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D) +#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D) +#define CF_0_cfT(M,I,A,B,D) + +#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0) +#define DEFAULT_cfR(A,B,D) +#define LOGICAL_cfR(A,B,D) +#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define STRING_cfR(A,B,D) if (B) _cf_free(B); +#define STRINGV_cfR(A,B,D) _cf_free(B); +/* A and D as defined above for TSTRING(V) */ +#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \ + (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B); +#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B); +#ifdef vmsFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length) +#else +#ifdef CRAYFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A)) +#else +#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D) +#endif +#endif +#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D) +#define PPSTRING_cfR(A,B,D) + +#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)( +#ifndef __CF__KnR +/* The void is req'd by the Apollo, to make this an ANSI function declaration. + The Apollo promotes K&R float functions to double. */ +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void +#ifdef vmsFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS +#else +#ifdef CRAYFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS +#else +#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0 +#endif +#endif +#endif +#else +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#endif +#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0 +#endif +#endif + +#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN) +#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN) +#ifndef __CF_KnR +#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN) +#endif +#define INT_cfF(UN,LN) INT_cfFZ(UN,LN) +#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN) +#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN) +#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN) +#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN) +#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN), + +#define INT_cfFF +#define VOID_cfFF +#ifdef vmsFortran +#define STRING_cfFF fstring *AS; +#else +#ifdef CRAYFortran +#define STRING_cfFF _fcd AS; +#else +#define STRING_cfFF char *AS; unsigned D0; +#endif +#endif + +#define INT_cfL A0= +#define STRING_cfL A0= +#define VOID_cfL + +#define INT_cfK +#define VOID_cfK +/* KSTRING copies the string into the position provided by the caller. */ +#ifdef vmsFortran +#define STRING_cfK \ + memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\ + AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \ + memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \ + AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0; +#else +#ifdef CRAYFortran +#define STRING_cfK \ + memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \ + _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \ + memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \ + _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0; +#else +#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \ + D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \ + ' ', D0-(A0==NULL?0:strlen(A0))):0; +#endif +#endif + +/* Note that K.. and I.. can't be combined since K.. has to access data before +R.., in order for functions returning strings which are also passed in as +arguments to work correctly. Note that R.. frees and hence may corrupt the +string. */ +#define BYTE_cfI return A0; +#define DOUBLE_cfI return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfI return A0; +#else +#define FLOAT_cfI RETURNFLOAT(A0); +#endif +#define INT_cfI return A0; +#ifdef hpuxFortran800 +/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */ +#define LOGICAL_cfI return ((A0)?1:0); +#else +#define LOGICAL_cfI return C2FLOGICAL(A0); +#endif +#define LONG_cfI return A0; +#define SHORT_cfI return A0; +#define STRING_cfI return ; +#define VOID_cfI return ; + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN) +#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1) +#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2) +#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3) +#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4) +#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5) +#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6) +#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) +#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) +#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) +#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) +#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) +#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) +#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) +#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) +#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) +#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) +#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) +#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) +#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) +#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) +#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) +#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) +#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) +#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) +#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + + +#define FCALLSCFUN1( T0,CN,UN,LN,T1) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0) +#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0) +#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) +#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0) +#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0) +#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0) + + +#ifndef __CF__KnR +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) } + +#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \ + { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \ + TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \ + TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \ + CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI) } + +#else +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \ + CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)} + +#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \ + CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \ + { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \ + TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \ + TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \ + CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI)} + +#endif + + +#endif /* __CFORTRAN_LOADED */ diff --git a/pkg/tbtables/cfitsio/changes.txt b/pkg/tbtables/cfitsio/changes.txt new file mode 100644 index 00000000..dceeb0fb --- /dev/null +++ b/pkg/tbtables/cfitsio/changes.txt @@ -0,0 +1,2521 @@ + Log of Changes Made to CFITSIO + + +Version 2.501 - 2 December 2004 + + New Routines: + + - added fits_open_diskfile and fits_create_diskfile routines that simply + open or create a FITS file with a specified name. CFITSIO does not + try to parse the name using the extended filename syntax. + + - 2 new C functions, CFITS2Unit and CUnit2FITS, were added to convert + between the C fitsfile pointer value and the Fortran unit number. + These functions may be useful in mixed language C and Fortran programs. + + Enhancements: + + - added the ability to recognize and open a compressed FITS file + (compressed with gzip or unix compress) on the stdin standard input + stream. + + - Craig Markwardt (GSFC) provided 2 more lexical parser functions: + accum(x) and seqdiff(x) that compute the cummulative sum and the + sequential difference of the values of x. + + - modified putcole.c and putcold.c so that when writing arrays of + pixels to the FITS image or column that contain null values, and + there are also numerical overflows when converting some of the + non-null values to the FITS values, CFITSIO will now ignore the + overflow error until after all the data have been written. Previously, + in some circumstances CFITSIO would have simply stopped writing any + data after the first overflow error. + + - modified fitsio2.h to try to eliminate compiler warning messages + on some platforms about the use of 'long long' constants when + defining the value of LONGLONG_MAX (whether to use L or LL + suffix). + + - modified region.c to support 'physical' regions in addition to + 'image', 'fk4', etc. + + - modified ffiurl (input filename parsing routine) to increase the + maximum allowed extension number that can be specified from 9999 + to 99999 (e.g. 'myfile.fits+99999') + + Bug Fixes: + + - added check to fits_create_template to force it to start with + the primary array in the template file, in case an extension + number was specified as part of the template FITS file name. + +Version 2.500 - 28 & 30 July 2004 + + New Routine: + + - fits_file_exists tests whether the specified input file, or a + compressed version of the file, exists on disk. + + Enhancements: + + - modified the way CFITSIO reads and writes data in COMPLEX ('C') and + DBLCOMPLEX 'M' columns. Now, in all cases, when referring to the + number of elements in the vector, or the value of the offset to a + particular element within the vector, CFITSIO considers each pair of + numbers (the imaginary and real parts) as a single element instead of + treating each single number as an element. In particular, this changes + the behavior of fits_write_col_null when writing to complex columns. + It also changes the length of the 'nullarray' vector in the + fits_read_colnull routine; it is now only 1/2 as long as before. + Each element of the nullarray is set = 1 if either the real or + imaginary parts of the corresponding complex value have a null + value.(this change was added to version 2.500 on 30 July). + + - Craig Markwardt, at GSFC, provided a number of significant enhancements + to the CFITSIO lexical parser that is used to evaluate expressions: + + - the parser now can operate on bit columns ('X') in a similar + way as for other numeric columns (e.g., 'B' or 'I' columns) + + - range checking has been implemented, so that the following + conditions return a Null value, rather than returning an error: + divide by zero, sqrt(negative), arccos(>1), arcsin(>1), + log(negative), log10(negative) + + - new vector functions: MEDIAN, AVERAGE, STDDEV, and + NVALID (returns the number of non-null values in the vector) + + - all the new functions (and SUM, MIN and MAX) ignore null values + + - modified the iterator to support variable-length array columns + + - modified configure to support AIX systems that have flock in a non- + standard location. + + - modified configure to remove the -D_FILE_OFFSET_BITS flag when running + on Mac Darwin systems. This caused conflicts with the Fortran + wrappers, and should only be needed in any case when using CFITSIO + to read/write FITS files greater than 2.1 GB in size. + + - modified fitsio2.h to support compilers that define LONG_LONG_MAX. + + - modified ffrsim (resize an existing image) so that it supports changing + the datatype to an unsigned integer image using the USHORT_IMG and + ULONG_IMG definitions. + + - modified the disk file driver (drvrfile.c) so that if an output + file is specified when opening an ordinary file (e.g. with the syntax + 'myfile.fits(outputfile.fits)' then it will make a copy of the file, + close the original file and open the copy. Previously, the + specified output file would be ignored unless the file was compressed. + + - modified f77_wrap.h and f77_wrap3.c to support the Fortran wrappers + on 64-bit AMD Opteron machines + + Bug fixes: + + - made small change to ffsrow in eval_f.c to avoid potential array + bounds overflow. + + - made small change to group.c to fix problem where an 'int' was + incorrectly being cast to a 'long'. + + - corrected a memory allocation error in the new fits_hdr2str routine + that was added in version 2.48 + + - The on-the-fly row-selection filtering would fail with a segfault + if the length of a table row (NAXIS1 value) was greater than + 500000 bytes. A small change to eval_f.c was required to fix this. + +Version 2.490 - 11 February 2004 + + Bug fixes: + + - fixed a bug that was introduced in the previous release, which caused + the CFITSIO parser to no longer move to a named extension when opening + a FITS file, e.g., when opening myfile.fit[events] CFITSIO would just + open the primary array instead of moving to the EVENTS extension. + + - new group.c file from the INTEGRAL Science Data Center. It fixes + a problem when you attach a child to a parent and they are both + is the same file, but, that parent contains groups in other files. + In certain cases the attach would not happen because it seemed that + the new child was already in the parent group. + + - fixed bug in fits_calculator_rng when performing a calculation + on a range of rows in a table, so that it does not reset the + value in all the other rows that are not in the range = 0. + + - modified fits_write_chksum so that it updates the TFORMn + keywords for any variable length vector table columns BEFORE + calculating the CHECKSUM values. Otherwise the CHECKSUM + value is invalidated when the HDU is subsequently closed. + +Version 2.480 - 28 January 2004 + + New Routines: + + - fits_get_img_equivtype - just like fits_get_img_type, except in + the case of scaled integer images, it returns the 'equivalent' + data type that is necessary to store the scaled data values. + + - fits_hdr2str copies all the header keywords in the current HDU + into a single long character string. This is a convenient method + of passing the header information to other subroutines. + The user may exclude any specified keywords from the list. + + Enhancements: + + - modified the filename parser so that it accepts extension + names that begin with digits, as in 'myfile.fits[123TEST]'. + In this case CFITSIO will try to open the extension with + EXTNAME = '123TEST' instead of trying to move to the 123rd + extension in the file. + + - the template keyword parser now preserves the comments on the + the mandatory FITS keywords if present, otherwise a standard + default comment is provided. + + - modified the ftp driver file (drvrnet.c) to overcome a timeout + or hangup problem caused by some firewall software at the user's + end (Thanks to Bruce O'Neel for this fix). + + - modified iraffits.c to incorporate Doug Mink's latest changes to + his wcstools library routines. The biggest change is that now + the actual image dimensions, rather than the physically stored + dimensions, are used when converting an IRAF file to FITS. + + Bug fixes: + + - when writing to ASCII FITS tables, the 'elemnum' parameter was + supposed to be ignored if it did not have the default value of 1. + In some cases however setting elemnum to a value other than 1 + could cause the wrong number of rows to be produced in the output + table. + + - If a cfitsio calculator expression was imported from a text file + (e.g. using the extended filename syntax 'file.fits[col @file.calc]') + and if any individual lines in that text file were greater than + 255 characters long, then a space character would be inserted + after the 255th character. This could corrupt the line if the space + was inserted within a column name or keyword name token. + +Version 2.480beta (used in the FTOOLS 5.3 release, 1 Nov 2003) + + New Routines: + + - fits_get_eqcoltype - just like fits_get_coltype, except in the + case of scaled integer columns, it returns the 'equivalent' + data type that is necessary to store the scaled data values. + + - fits_split_names - splits an input string containing a comma or + space delimited list of names (typically file names or column + names) into individual name tokens. + + Enhancements: + + - changed fhist in histo.c so that it can make histograms of ASCII + table columns as well as binary table columns (as long as they + contain numeric data). + + Bug fixes: + + - removed an erroneous reference to listhead.c in makefile.vcc, that is + used to build the cfitsio dll under Windows. This caused a 'main' + routine to be added to the library, which causes problems when linking + fortran programs to cfitsio under windows. + + - if an error occurs when opening for a 2nd time (with ffopen) a file that + is already open (e.g., the specified extension doesn't exist), and + if the file had been modified before attempting to reopen it, then + the modified buffers may not get written to disk and the internal + state of the file may become corrupted. ffclos was modified to + always set status=0 before calling ffflsh if the file has been + concurrently opened more than once. + +Version 2.470 - 18 August 2003 + + Enhancements: + + - defined 'TSBYTE' to represent the 'signed char' datatype (similar to + 'TBYTE' that represents the 'unsigned char' datatype) and added + support for this datatype to all the routines that read or write + data to a FITS image or table. This was implemented by adding 2 + new C source code files to the package: getcolsb.c and putcolsb.c. + + - Defined a new '1S' shorthand data code for a signed byted column in + a binary table. CFITSIO will write TFORMn = '1B' and + TZEROn = -128 in this case, which is the convention used to + store signed byte values in a 'B' type column. + + - in fitsio2.h, added test of whether `__x86_64__` is defined, to + support the new AMD Opteron 64-bit processor + + - modified configure to not use the -fast compiler flag on Solaris + platforms when using the proprietary Solaris cc compilar. This + flag causes compilation problems in eval_y.c (compiler just + hangs forever). + + Bug fixes: + + - In the special case of writing 0 elements to a vector table column + that contains 0 rows, ffgcpr no longer adds a blank row to the table. + + - added error checking code for cases where a ASCII string column + in a binary table is greater than 28800 characters wide, to avoid + going into an infinite loop. + + - the fits_get_col_display_width routine was incorrectly returning + width = 0 for a 'A' binary table column that did not have an + explicit vector length character. + +Version 2.460 - 20 May 2003 + + Enhancements: + + - modified the HTTP driver in drvrnet.c so that CFITSIO can read + FITS files via a proxy HTTP server. (This code was contributed by + Philippe Prugniel, Obs. de Lyon). To use this feature, the + 'http_proxy' environment variable must be defined with the + address (URL) and port number of the proxy server, i.e., + > setenv http_proxy http://heasarc.gsfc.nasa.gov:3128 + will use port 3128 on heasarc.gsfc.nasa.gov + + - suppressed some compiler warnings by casting a variable of + type 'size_t' to type 'int' in fftkey (in fitscore.c) and + iraftofits and irafrdimge (in iraffits.c). + +Version 2.450 - 30 April 2003 + + Enhancements: + + - modified the WCS keyword reading routine (ffgics) to support cases + where some of the CDi_j keywords are omitted (with an assumed + value = 0). + + - Made a change to http_open_network in drvrnet.c to add a 'Host: ' + string to the open request. This is required by newer HTTP 1.1 + servers (so-called virtual servers). + + - modified ffgcll (read logical table column) to return the illegal + character value itself if the FITS file contains a logical value that is + not equal to T, F or zero. Previously it treated this case the + same as if the FITS file value was = 0. + + - modified fits_movnam_hdu (ffmnhd) so that it will move to a tile- + compressed image (that is stored in a binary table) if the input + desired HDU type is BINARY_TBL as well as if the HDU type = IMAGE_HDU. + + Bug fixes: + + - in the routine that checks the data fill bytes (ffcdfl), the call + to ffmbyt should not ignore an EOF error when trying to read the bytes. + This is a little-used routine that is not called by any other CFITSIO + routine. + + - fits_copy_file was not reporting an error if it hit the End Of File + while copying the last extension in the input file to the output file. + + - fixed inconsistencies in the virtual file column filter parser + (ffedit_columns) to properly support expressions which create or + modify a keyword, instead of a column. Previously it was only possible + to modify keywords in a table extension (not an image), and the + keyword filtering could cause some of the table columns to not + get propagated into the virtual file. Also, spaces are now + allowed within the specified keyword comment field. + + - ffdtyp was incorrectly returning the data type of FITS keyword + values of the form '1E-09' (i.e., an exponential value without + a decimal point) as integer rather than floating point. + + - The enhancement in the previous 2.440 release to allow more files to be + opened at one time introduced a bug: if ffclos is called with + a non-zero status value, then any subsequent call to ffopen will likely + cause a segmentation fault. The fits_clear_Fptr routine was modified + to fix this. + + - rearranged the order of some computations in fits_resize_img so as + to not exceed the range of a 32-bit integer when dealing with + large images. + + - the template parser routine, ngp_read_xtension, was testing for + "ASCIITABLE" instead of "TABLE" as the XTENSION value of an ASCII + table, and it did not allow for optional trailing spaces in the IMAGE" + or "TABLE" string value. + +Version 2.440 - 8 January 2003 + + Enhancements: + + - modified the iterator function, ffiter, to operate on random + groups files. + + - decoupled the NIOBUF (= 40) parameter from the limit on the number + FITS files that can be opened, so that more files may be opened + without the overhead of having to increase the number of NIOBUF + buffers. A new NMAXFILES parameter is defined in fitsio2.h which sets + the maximum number of opened FITS files. It is set = 300 by default. + Note however, that the underlying compiler or operating system may + not allow this many files to be opened at one time. + + - updated the version of cfortran.h that is distributed with CFITSIO from + version 3.9 to version 4.4. This required changes to f77_wrap.h + and f77_wrap3.c. The original cfortran.h v4.4 file was modified + slightly to support CFITSIO and ftools (see comments in the header + of cfortran.h). + + - modified ffhist so that it copies all the non-structural keywords from + the original binary table header to the binned image header. + + - modified fits_get_keyclass so that it recognizes EXTNAME = + COMPRESSED_IMAGE as a special tile compression keyword. + + - modified Makefile.in to support the standard --prefix convention + for specifying the install target directory. + + Bug fixes: + + - in fits_decompress_img, needed to add a call to ffpscl to turn + off the BZERO and BSCALE scaline when reading the compressed image. + +Version 2.430 - 4 November 2002 + + Enhancements: + + - modified fits_create_hdu/ffcrhd so that it returns without doing + anything and does not generate an error if the current HDU is + already an empty HDU. There is no need in this case to append + a new empty HDU to the file. + + - new version of group.c (supplied by B. O'Neel at the ISDC) fixes 2 + limitations: 1 - Groups now have 256 characters rather than 160 + for the path lengths in the group tables. - ISDC SPR 1720. 2 - + Groups now can have backpointers longer than 68 chars using the long + string convention. - ISDC SPR 1738. + + - small change to f77_wrap.h and f77_wrap3.c to support the fortran + wrappers on SUN solaris 64-bit sparc systems (see also change to v2.033) + + - small change to find_column in eval_f.c to support unsigned long + columns in binary tables (with TZEROn = 2147483648.0) + + - small modification to cfortran.h to support Mac OS-X, (Darwin) + + Bug fixes: + + - When reading tile-compress images, the BSCALE and BZERO scaling + keywords were not being applied, if present. + + - Previous changes to the error message stack code caused the + tile compressed image routines to not clean up spurious error + messages properly. + + - fits_open_image was not skipping over null primary arrays. + +Version 2.420 - 19 July 2002 + + Enhancements: + + - modified the virtual filename parser to support exponential notation + when specifing the min, max or binsize in a binning specifier, as in: + myfile.fits[binr X=1:10:1.0E-01, Y=1:10:1.0E-01] + + - removed the limitation on the maximum number of HDUs in a FITS file + (limit used to be 1000 HDUs per file). Now any number of HDUs + can be written/read in a FITS file. (BUT files that have huge numbers + of HDUs can be difficult to manage and are not recommended); + + - modified grparser.c to support HIERARCH keywords, based on + code supplied by Richard Mathar (Max-Planck) + + - moved the ffflsh (fits_flush_buffer) from the private to the + public interface, since this routine may be useful for some + applications. It is much faster than ffflus. + + - small change to the definition of OFF_T in fitsio.h to support + large files on IBM AIX operating systems. + + Bug fixes: + + - fixed potential problem reading beyond array bounds in ffpkls. This + would not have affected the content of any previously generated FITS + files. + + - in the net driver code in drvrnet.c, the requested protocol string + was changed from "http/1.0" to "HTTP/1.0" to support apache 1.3.26. + + - When using the virtual file syntax to open a vector cell in a binary + table as if it were a primary array image, there was a bug + in fits_copy_image_cell which garbled the data if the vector + was more than 30000 bytes long. + + - fixed problem that caused fits_report_error to crash under Visual + C++ on Windows systems. The fix is to use the '/MD' switch + on the cl command line, or, in Visual Studio, under project + settings / C++ select use runtime library multithreaded DLL + + - modified ffpscl so it does not attempt to reset the scaling values + in the internal structure if the image is tile-compressed. + + - fixed multiple bugs in mem_rawfile_open which affected the case + where a raw binary file is read and converted on the fly into + a FITS file. + + - several small changes to group.c to suppress compiler warnings. + +Version 2.410 - 22 April 2002 (used in the FTOOLS 5.2 release) + + New Routines: + + - fits_open_data behaves similarly to fits_open_file except that it + also will move to the first HDU containing significant data if + and an explicit HDU name or number to open was not specified. + This is useful for automatically skipping over a null primary + array when opening the file. + + - fits_open_table and fits_open_image behaves similarly to + fits_open_data, except they move to the first table or image + HDU in the file, respectively. + + - fits_write_errmark and fits_clear_errmark routines can be use + to write an invisible marker to the CFITSIO error stack, and + then clear any more recent messages on the stack, back to + that mark. This preserves any older messages on the stack. + + - fits_parse_range utility routine parses a row list string + and returns integer arrays giving the min and max row in each + range. + + - fits_delete_rowrange deletes a specified list of rows or row + ranges. + + - fits_copy_file copies all or part of the HDUs in the input file + to the output file. + + - added fits_insert_card/ffikey to the publicly defined set + of routines (previously, it was a private routine). + + Enhancements: + + - changed the default numeric display format in ffgkys from 'E' format + to 'G' format, and changed the format for 'X' columns to a + string of 8 1s or 0s representing each bit value. + + - modified ffflsh so the system 'fflush' call is not made in cases + where the file was opened with 'READONLY' access. + + - modified the output filename parser so the "-.gz", and "stdout.gz" + now cause the output file to be initially created in memory, + and then compressed and written out to the stdout stream when + the file is closed. + + - modified the routines that delete rows from a table to also + update the variable length array heap, to remove any orphaned + data from the heap. + + - modified ffedit_columns so that wild card characters may be + used when specifying column names in the 'col' file filter + specifier (e.g., file.fits[col TIME; *RAW] will create a + virtual table contain only the TIME column and any other columns + whose name ends with 'RAW'). + + - modified the keyword classifier utility, fits_get_keyclass, to + support cases where the input string is just the keyword name, + not the entire 80-character card. + + - modified configure.in and configure to see if a proprietary + C compiler is available (e.g. 'cc'), and only use 'gcc' if not. + + - modified ffcpcl (copy columns from one table to another) so that + it also copies any WCS keywords related to that column. + + - included an alternate source file that can be used to replace + compress.c, which is distributed under the GNU General Public + License. The alternate file contains non-functional stubs for + the compression routines, which can be used to make a version of + CFITSIO that does not have the GPL restrictions (and is also less + functional since it cannot read or write compressed FITS files). + + - modifications to the iterator routine (ffiter) to support writing + tile compressed output images. + + - modified ffourl to support the [compress] qualifier when specifying + the optional output file name. E.g., file.fit(out.file[compress])[3] + + - modified imcomp_compress_tile to fully support implicit data type + conversion when writing to tile-compressed images. Previously, + one could not write a floating point array to an integer compressed + image. + + - increased the number of internal 2880-byte I/O buffers allocated + by CFITSIO from 25 to 40, in recognition of the larger amount + of memory available on typical machines today compared with + a few years ago. The number of buffers can be set by the user + with the NIOBUF parameter in fitsio2.h. (Setting this too large + can actually hurt performance). + + - modified the #if statements in fitsio2.h, f77_wrap.h and f77_wrap1.c + to support the new Itanium 64-bit Intel PC. + + - a couple minor modifications to fitsio.h needed to support the off_t + datatype on debian linux systems. + + - increased internal buffer sizes in ffshft and ffsrow to improve + the I/O performance. + + Bug fixes: + + - fits_get_keyclass could sometimes try to append to an unterminated + string, causing an overflow of a string array. + + - fits_create_template no longer worked because of improvements made + to other routines. Had to modify ffghdt to not try to rescan + the header keywords if the file is still empty and contains no + keywords yet. + + - ffrtnm, which returns the root filename, sometimes did not work + properly when testing if the 'filename+n' convention was used for + specifying an extension number. + + - fixed minor problem in the keyword template parsing routine, ffgthd + which in rare cases could cause an improperly terminated string to + be returned. + + - the routine to compare 2 strings, ffcmps, failed to find a match + in comparing strings like "*R" and "ERROR" where the match occurs + on the last character, but where the same matching character occurs + previously in the 2nd string. + + - the region file reading routine (ffrrgn) did not work correctly if + the region file (created by POW and perhaps other programs) had an + 'exclude' region (beginning with a '-' sign) as the first region + in the file. In this case all points outside the excluded region + should be accepted, but in fact no points were being accepted + in this case. + +Version 2.401 - 28 Jan 2002 + + - added the imcopy example program to the release (and Makefile) + + Bug fixes: + + - fixed typo in the imcompress code which affected compression + of 3D datacubes. + + - made small change to fficls (insert column) to allow colums with + TFORMn = '1PU' and '1PV' to be inserted in a binary table. The + 'U' and 'V' are codes only used within CFITSIO to represent unsigned + 16-bit and 32-bit integers; They get replaced by '1PI' and '1PJ' + respectively in the FITS table header, along with the appropriate + TZEROn keyword. + +Version 2.400 - 18 Jan 2002 + + (N.B.: Application programs must be recompiled, not just relinked + with the new CFITSIO library because of changes made to fitsio.h) + + New Routines: + + - fits_write_subset/ffpss writes a rectangular subset (or the whole + image) to a FITS image. + + - added a whole new family of routines to read and write arrays of + 'long long' integers (64-bit) to FITS images or table columns. The + new routine names all end in 'jj': ffpprjj, ffppnjj, ffp2djj, + ffp3djj, ffppssjj, ffpgpjj, ffpcljj, ffpcnjj. ffgpvjj, ffgpfjj, + ffg2djj, ffg3djj, ffgsvjj, ffgsfjj, ffggpjj, ffgcvjj, and ffgcfjj. + + - added a set of helper routines that are used in conjunction with + the new support for tiled image compression. 3 routines set the + parameters that should be used when CFITSIO compresses an image: + fits_set_compression_type + fits_set_tile_dim + fits_set_noise_bits + + 3 corresponding routines report back the current settings: + fits_get_compression_type + fits_get_tile_dim + fits_get_noise_bits + + Enhancements: + + - major enhancement was made to support writing to tile-compressed + images. In this format, the image is divided up into a rectangular + grid of tiles, and each tile of pixels is compressed individually + and stored in a row of a variable-length array column in a binary + table. CFITSIO has been able to transparently read this compressed + image format ever since version 2.1. Now all the CFITSIO image + writing routines also transparently support this format. There are + 2 ways to force CFITSIO to write compressed images: 1) call the + fits_set_compression_type routine before writing the image header + keywords, or 2), specify that the image should be compressed when + entering the name of the output FITS file, using a new extended + filename syntax. (examples: "myfile.fits[compress]" will use the + default compression parameters, and "myfile.fits[compress GZIP + 100,100] will use the GZIP compression algorithm with 100 x 100 + pixel tiles. + + - added new driver to support creating output .gz compressed fits + files. If the name of the output FITS file to be created ends with + '.gz' then CFITSIO will initially write the FITS file in memory and + then, when the FITS file is closed, CFITSIO will gzip the entire + file before writing it out to disk. + + - when over-writing vectors in a variable length array in a binary + table, if the new vector to be written is less than or equal to + the length of the previously written vector, then CFITSIO will now + reuse the existing space in the heap, rather than always appending + the new array to the end of the heap. + + - modified configure.in to support building cfitsio as a dynamic + library on Mac OS X. Use 'make shared' like on other UNIX platforms, + but a .dylib file will be created instead of .so. If installed in a + nonstandard location, add its location to the DYLD_LIBRARY_PATH + environment variable so that the library can be found at run time. + + - made various modifications to better support the 8-byte long integer + datatype on more platforms. The 'LONGLONG' datatype is typedef'ed + to equal 'long long' on most Unix platforms and MacOS, and equal + to '__int64' on Windows machines. + + - modified configure.in and makefile.in to better support cases + where the system has no Fortran compiler and thus the f77 wrapper + routines should not be compiled. + + - made small modification to eval.y and eval_y.f to get rid of warning + on some platforms about redefinition of the 'alloca'. + + Bug fixes: + + - other recent bug fixes in ffdblk (delete blocks) caused ffdhdu (delete + HDU) to fail when trying to replace the primary array with a null + primary array. + + - fixed bug that prevented inserting a new variable length column + into a table that already contained variable length data. + + - modified fits_delete_file so that it will delete the file even if + the input status value is not equal to zero. + + - in fits_resize_image, it was sometimes necessary to call ffrdef to + force the image structure to be defined. + + - modified the filename parser to support input files with names like: + "myfile.fits.gz(mem://tmp)" in which the url type is specified for + the output file but not for the input file itself. This required + modifications to ffiurl and ffrtnm. + +Version 2.301 - 7 Dec 2001 + + Enhancements: + + - modified the http file driver so that if the filename to be opened + contains a '?' character (most likely a cgi related string) then it + will not attempt to append a .gz or .Z as it would normally do. + + - added support for the '!' clobber character when specifying + the output disk file name in CFITSIO's extended filename syntax, e.g., + 'http://a.b.c.d/myfile.fits.gz(!outfile.fits)' + + - added new device driver which is used when opening a compressed FITS + file on disk by uncompressing it into memory with READWRITE + access. This happens when specifying an output filename + 'mem://'. + + - added 2 other device drivers to open http and ftp files in memory + with write access. + + - improved the error trapping and reporting in cases where program + attempts to write to a READONLY file (especially in cases where the + 'file' resides in memory, as is the case when opening an ftp or http + file. + + - modified the extended filename parser so that it is does not confuse + the bracket character '[' which is sometimes used in the root name + of files of type 'http://', as the start of an extname or row filter + expression. If the file is of type 'http://', the parser now + checks to see if the last character in the extended file name is + a ')' or ']'. If not, it does not try to parse the file name + any further. + + - improved the efficiency when writing FITS files in memory, by + initially allocating enough memory for the entire HDU when it is + created, rather than incrementally reallocing memory 2880 bytes + at a time (modified ffrhdu and mem_truncate). This change also + means that the program will fail much sooner if it cannot allocate + enough memory to hold the entire FITS HDU. + + Bug fixes: + + - There was an error in the definition of the Fortran ftphtb wrapper + routine (writes required ASCII table header keywords) that caused + it to fail on DEC OSF and other platforms where sizeof(long) = 8. + +Version 2.300 - 23 Oct 2001 + + New Routines: + + - fits_comp_img and fits_decomp_img are now fully supported and + documented. These routine compress and decompress, respective, + a FITS image using a new algorithm in which the image is first + divided into a grid of rectangular tiles, then the compressed byte + stream from each tile is stored in a row of a binary table. + CFITSIO can transparently read FITS images stored in this + compressed format. Compression ratios of 3 - 6 are typically + achieved. Large compression ratios are achieved for floating + point images by throwing away non-significant noise bits in the + pixel values. + + - fits_test_heap tests the integrity of the binary table heap and + returns statistics on the amount of unused space in the heap and + the amount of space that is pointed to by more than 1 descriptor. + + - fits_compress_heap which will reorder the arrays in the binary + table heap, recovering any unused space. + + Enhancements: + + - made substantial internal changes to the code to support FITS + files containing 64-bit integer data values. These files have + BITPIX = 64 or TFORMn = 'K'. This new feature in CFITSIO is + currently only enabled if SUPPORT_64BIT_INTEGERS is defined = 1 in + the beginning of the fitsio2.h file. By default support for + 64-bit integers is not enabled. + + - improved the ability to read and return a table column value as a + formatted string by supporting quasi-legal TDISPn values which + have a lowercase format code letter, and by completely ignoring + other unrecognizable TDISPn values. Previously, unrecognized + TDISPn values could cause zero length strings to be returned. + + - made fits_write_key_longstr more efficient when writing keywords + using the long string CONTINUE convention. It previously did not + use all the available space on each card when the string to be + written contained many single quote characters. + + - added a new "CFITSIO Quick Start Guide" which provides all the + basic information needed to write C programs using CFITSIO. + + - updated the standard COMMENT keywords that are written at the + beginning of every primary array to refer to the newly published + FITS Standard document in Astronomy and Astrophysics. + Note: because of this change, any FITS file created with this + version of CFITSIO will not be identical to the same file written + with a previous version of CFITSIO. + + - replaced the 2 routines in pliocomp.c with new versions provided by + D Tody and N Zarate. These routines compress/uncompress image pixels + using the IRAF pixel list compression algorithm. + + - modified fits_copy_hdu so that when copying a Primary Array + to an Image extension, the COMMENT cards which give the reference + to the A&A journal article about FITS are not copied. In the + inverse case the COMMENT keywords are inserted in the header. + + - modified configure and Makefile.in to add capability to build a + shared version of the CFITSIO library. Type 'make shared' or + 'make libcfitsio.so' to invoke this option. + + - disabled some uninformative error messages on the error stack: + 1) when calling ffclos (and then ffchdu) with input status > 0 + 2) when ffmahd tries to move beyond the end of file. + The returned status value remains the same as before, but the + annoying error messages no longer get written to the error stack. + + - The syntax for column filtering has been modified so that + if one only specifies a list of column names, then only those + columns will be copied into the output file. This provides a simple + way to make a copy of a table containing only a specified list of + columns. If the column specifier explicitly deletes a column, however, + than all the other columns will be copied to the filtered input + file, regardless of whether the columns were listed or not. + Similarly, if the expression specifies only a column to be modified + or created, then all the other columns in the table will be + copied. + + mytable.fit[1][col Time;Rate] - only the Time and Rate + columns will be copied to the filtered input file. + + mytable.fit[1][col -Time ] - all but the Time column are copied + to the filtered input file. + + mytable.fit[1][col Rate;-Time] - same as above. + + - changed a '#if defined' statement in f77_wrap.h and f77_wrap1.c + to support the fortran wrappers on 64-bit IBM/RS6000 systems + + - modified group.c so that when attaching one group (the child) to + another (the parent), check in each file for the existence of a + pointer to the other before adding the link. This is to prevent + multiple links from forming under all circumstances. + + - modified the filename parser to accept 'STDIN', 'stdin', + 'STDOUT' and 'stdout' in addition to '-' to mean read the + file from standard input or write to standard output. + + - Added support for reversing an axis when reading a subsection + of a compressed image using the extended filename syntax, as in + myfile.fits+1[-*, *] or myfile.fits+1[600:501,501:600] + + - When copying a compressed image to a uncompressed image, the + EXTNAME keyword is no longer copied if the value is equal to + 'COMPRESSED_IMAGE'. + + - slight change to the comment field of the DATE keyword to reflect + the fact that the Unix system date and time is not true UTC time. + + Bug fixes: + + - fits_write_key_longstr was not writing the keyword if a null + input string value was given. + + - writing data to a variable length column, if that binary table is not + the last HDU in the FITS file, might overwrite the following HDU. + Fixed this by changing the order of a couple operations in ffgcpr. + + - deleting a column from a table containing variable length columns + could cause the last few FITS blocks of the file to be reset = 0. + This bug occurred as a result of modifications to ffdblk in v2.202. + This mainly affects users of the 'compress_fits' utility + program. + + - fixed obscure problem when writing bits to a variable length 'B' + column. + + - when reading a subsection of an image, the BSCALE and BZERO pixel + scaling may not have been applied when reading image pixel values + (even though the scaling keywords were properly written in the + header). + + - fits_get_keyclass was not returning 'TYP_STRUCT_KEY' for the + END keyword. + +Version 2.204 - 26 July 2001 + + Bug fixes: + + - Re-write of fits_clean_url in group.c to solve various problems + with invalid bounds checking. + +Version 2.203 - 19 July 2001 (version in FTOOLS v5.1) + + Enhancements: + + - When a row selection or calculator expression is written in + an external file (and read by CFITSIO with the '@filename' syntax) + the file can now contain comment lines. The comment line must + begin with 2 slash characters as the first 2 characters on the + line. CFITSIO will ignore the entire line when reading the + expression. + + Bug fixes: + + - With previous versions of CFITSIO, the pixel values in a FITS + image could be read incorrectly in the following case: when + opening a subset of a FITS image (using the + 'filename.fits[Xmin:Xmax,Ymin:Ymax]' notation) on a PC linux, PC + Windows, or DEC OSF machine (but not on a SUN or Mac). This + problem only occurs when reading more than 8640 bytes of data + (2160 4-byte integers) at a time, and usually only occurs if the + reading program reads the pixel data immediately after opening the + file, without first reading any header keywords. This error would + cause strips of zero valued pixels to appear at semi-random + positions in the image, where each strip usually would be 2880 + bytes long. This problem does not affect cases where the input + subsetted image is simply copied to a new output FITS file. + + +Version 2.202 - 22 May 2001 + + Enhancements: + + - revised the logic in the routine that tests if a point is + within a region: if the first region is an excluded region, + then it implicitly assumes a prior include region covering + the entire detector. It also now supports cases where a + smaller include region is within a prior exclude region. + + - made enhancement to ffgclb (read bytes) so that it can + also read values from a logical column, returning an array + of 1s and 0s. + + - defined 2 new grouping error status values (349, 350) in + cfitsio.h and made minor changes to group.c to use these new + status values. + + - modified fits_open_file so that if it encounters an error while + trying to move to a user-specified extension (or select a subset + of the rows in an input table, or make a histogram of the + column values) it will close the input file instead of leaving + it open. + + - when using the extended filename syntax to filter the rows in + an input table, or create a histogram image from the values in + a table column, CFITSIO now writes HISTORY keywords in the + output file to document the filtering expression that was used. + + Bug fixes: + + - ffdblk (called by ffdrow) could overwrite the last FITS block(s) in + the file in some cases where one writes data to a variable length + column and then calls ffdrow to delete rows in the table. This + bug was similar to the ffiblk bug that was fixed in v2.033. + + - modified fits_write_col_null to fix a problem which under unusual + circumstances would cause a End-of-File error when trying to + read back the value in an ASCII string column, after initializing + if by writing a null value to it. + + - fixed obscure bug in the calculator function that caused an + error when trying to modify the value of a keyword in a HDU + that does not have a NAXIS2 keyword (e.g., a null primary array). + + - the iterator function (in putcol.c) had a bug when calculating + the optimum number rows to process in the case where the table + has very wide rows (>33120 bytes) and the calculator expression + involves columns from more than one FITS table. This could + cause an infinite loop in calls to the ffcalc calculator function. + + - fixed bug in ffmvec, which modifies the length of an + existing vector column in a binary table. If the vector + was reduced in length, the FITS file could sometimes be left + in a corrupted state, and in all cases the values in the remaining + vector elements of that column would be altered. + + - in drvrfile.c, replaced calls to fsetpos and fgetpos with + fseek and ftell (or fseeko and ftello) because the fpos_t + filetype used in fsetpos is incompatible with the off_t + filetype used in fseek, at least on some platforms (Linux 7.0). + (This fix was inserted into the V2.201 release on April 4). + + - added "#define fits_write_pixnull ffppxn" to longnam.h + +Version 2.201 - 15 March 2001 + + Enhancements + + - enhanced the keyword reading routines so that they will do + implicit datatype conversion from a string keyword value + to a numeric keyword value, if the string consist of a + valid number enclosed in quotes. For example, the keyword + mykey = '37.5' can be read by ffgkye. + + - modified ffiimg so that it is possible to insert a new + primary array at the beginning of the file. The original + primary array is then converted into an IMAGE extension. + + - modified ffcpdt (copy data unit) to support the case where + the data unit is being copied between 2 HDUs in the same file. + + - enhanced the fits_read_pix and fits_read_pixnull routines so + that they support the tiled image compression format that the + other image reading routines also support. + + - modified the Extended File Name syntax to also accept a + minus sign (-) as well as an exclamation point (!) as + the leading character when specifying a column or or keyword + to be deleted, as in [col -time] will delete the TIME column. + + - now completely support reading subimages, including pixel + increments in each dimension, for tile-compressed images + (where the compressed image tiles are stored in a binary + table). + + Bug fixes: + + - fixed confusion in the use of the fpos_t and off_t datatypes + in the fgetpos and fsetpos routines in drvrfile.c which caused + problems with the Windows VC++ compiler. (fpos_t is not + necessarily identical to off_t) + + - fixed a typo in the fits_get_url function in group.c which + caused problems when determining the relative URL to a compressed + FITS file. + + - included fitsio.h in the shared memory utility program, + smem.c, in order to define OFF_T. + + - fixed typo in the datatype of 'nullvalue' in ffgsvi, which caused + attempts to read subsections of a short integer tiled compressed + image to fail with a bus error. + + - fixed bug in ffdkey which sometimes worked incorrectly if one + tried to delete a nonexistent keyword beyond the end of the header. + + - fixed problem in fits_select_image_section when it writes a dummy + value to the last pixel of the section. If the image contains + scaled integer pixels, then in some cases the pixel value could end + up out of range. + + - fixed obscure bug in the ffpcn_ family of routines which gave + a floating exception when trying to write zero number of pixels to + a zero length array (why would anyone do this?) + +Version 2.200 - 26 Jan 2001 + + Enhancements + + - updated the region filtering code to support the latest region + file formats that are generated by the POW, SAOtng and ds9 + programs. Region positions may now be given in HH:MM:SS.s, + DD:MM:SS.s format, and region sizes may be given arcsec or arcmin + instead of only in pixel units. Also changed the logic so that if + multiple 'include' regions are specified in the region file, they + are ORed together, instead of ANDed, so that the filtering keeps + points that are located within any of the 'include' regions, not + just the intersection of the regions. + + - added support for reading raw binary data arrays by converting + them on the fly into virtual FITS files. + + - modified ffpmsg, which writes error messages to CFITSIO's internal + error stack, so that messages > 80 characters long will be wrapped + around into multiple 80 character messages, instead of just + being truncated at 80 characters. + + - modified the CFITSIO parser so that expression which involve + scaled integer columns get cast to double rather than int. + + - Modified the keyword template parsing routine, ffgthd, to + support the HIERARCH keyword. + + - modified ffainit and ffbinit so that they don't unnecessarily + allocate 0 bytes of memory if there are no columns (TFIELDS = 0) + in the table that is being opened. + + - modified fitsio2.h to support NetBSD on Alpha OSF platforms + (NetBSD does not define the '__unix__' symbol). + + - changed the way OFF_T is defined in fitsio.h for greater + portability. + + - changed drvrsmem.c so it is compiled only when HAVE_SHMEM_SERVICES + is defined in order to removed the conditional logic from the Makefile + + - reorganized the CFITSIO User's guide to make it + clearer and easier for new users to learn the basic routines. + + - fixed ffhdef (which reserves space for more header keywords) so + that is also updates the start position of the next HDU. This + affected the offset values returned by ffghof. + +Version 2.100 - 18 Oct 2000 + + Enhancements + + - made substantial modification to the code to support Large files, + i.e., files larger than 2**31 bytes = 2.1GB. FITS files up to + 6 terabytes in size may now be read and written on platforms + that support Large files (currently only Solaris). + + - modified ffpcom and ffphis, which write COMMENT and HISTORY + keywords, respectively, so that they now use columns 9 - 80, + instead of only columns 11 - 80. Previously, these routines + avoided using columns 9 and 10, but this is was unnecessarily + restrictive. + + - modified ffdhdu so that instead of refusing to delete the + primary array, it will replace the current primary array + with a null primary array containing the bare minimum of + required keywords and no data. + + New Routines + + - fits_read_pix, fits_read_pixnull, fits_read_subset, and fits_write_pix + routines were added to enable reading and writing of Large images, + with more than 2.1e9 pixels. These new routines are now recommended + as the basic routines for reading and writing all images. + + - fits_get_hduoff returns the byte offset in the file to + the start and end of the current HDU. This routine replaces the + now obsolete fits_get_hduaddr routine; it uses 'off_t' instead of + 'long' as the datatype of the arguments and can support offsets + in files greater than 2.1GB in size. + + Bug fixes: + + - fixed bug in fits_select_image_section that caused an integer + overflow when reading very large image sections (bigger than + 8192 x 8192 4-byte pixels). + + - improved ffptbb, the low-level table writing routine, so that + it will insert additional rows in the table if the table is + not already big enough. Previously it would have just over- + written any HDUs following the table in the FITS file. + + - fixed a bug in the fits_write_col_bit/ffpclx routine which + could not write to a bit 'X' column if that was the first column + in the table to be written to. This bug would not appear if + any other datatype column was written to first. + + - nonsensible (but still formally legal) binary table TFORM values + such as '8A15', or '1A8' or 'A8' would confuse CFITSIO and cause it + to return a 308 error. When parsing the TFORMn = 'rAw' value, + the ffbnfm routine has been modified to ignore the 'w' value in cases + where w > r. + + - fixed bug in the blsearch routine in iraffits.c which sometimes + caused an out-of-bounds string pointer to be returned when searching + for blank space in the header just before the 'END' keyword. + + - fixed minor problem in ffgtcr in group.c, which sometimes failed + while trying to move to the end of file before appending a + grouping table. + + - on Solaris, with Sun CC 5.0, one must check for '__unix' rather + than '__unix__' or 'unix' as it's symbol. Needed to modify this + in drvrfile.c in 3 places. + + - in ffextn, the FITS file would be left open if the named + extension doesn't exist, thus preventing the file from being + opened again later with write access. + + - fixed bug in ffiimg that would cause attempts to insert a new + image extension following a table extension, and in front of any + other type of extension, to fail. + +Version 2.037 - 6 July 2000 + + Enhancements + + - added support in the extended filename syntax for flipping + an image along any axis either by specifying a starting + section pixel number greater than the ending pixel number, + or by using '-*' to flip the whole axis. Examples: + "myfile.fits[1:100, 50:10]" or "myfile.fits[-*,*]". + + - when reading a section of an image with the extended filename + syntax (e.g. image.fits[1:100:2, 1:100:2), any CDi_j WCS keywords + will be updated if necessary to transfer the world coordinate + system from the imput image to the output image section. + + - on UNIX platforms, added support for filenames that begin + with "~/" or "~user/". The "~" symbol will get expanded + into a string that gives the user's home directory. + + - changed the filename parser to support disk file names that + begin with a minus sign. Previously, the leading minus sign would + cause CFITSIO to try to read/write the file from/to stdin/stdout. + + - modified the general fits_update_key routine, which writes + or updates a keyword value, to use the 'G' display format + instead of the 'E' format for floating point keyword values. + This will eliminate trailing zeros from appearing in the value. + + - added support for the "-CAR" celestial coordinate projection + in the ffwldp and ffxypx routines. The "-CAR" projection is + the default simplest possible linear projection. + + - added new fits_create_memfile/ffimem routine to create a new + fits file at a designated memory location. + + - ported f77_wrap.h and f77_wrap1.c so that the Fortran interface + wrappers work correctly on 64-bit SGI operating systems. In this + environment, C 'long's are 8-bytes long, but Fortran 'integers' + are still only 4-bytes long, so the words have to be converted + by the wrappers. + + - minor modification to cfortran.h to automatically detect when it + is running on a linux platform, and then define f2cFortran in that + case. This eliminates the need to define -Df2cFortran on the + command line. + + - modified group.c to support multiple "/" characters in + the path name of the file to be opened/created. + + - minor modifications to the parser (eval.y, eval_f.c, eval_y.c) + to a) add the unary '+' operator, and b) support copying the + TDIMn keyword from the input to the output image under certain + circumstances. + + - modified the lexical parser in eval_l.y and eval_l.c to + support #NULL and #SNULL constants which act to set the + value to Null. Support was also added for the C-conditional + expression: 'boolean ? trueVal : falseVal'. + + - small modification to eval_f.c to write an error message to + the error stack if numerical overflow occurs when evaluating + an expression. + + - configure and configure.in now support the egcs g77 compiler + on Linux platforms. + + Bug fixes: + + - fixed a significant bug when using the extended filename binning + syntax to generate a 2-dimensional image from a histogram of the + values in 2 table columns. This bug would cause table events that + should have been located in the row just below the bottom row of + the image (and thus should have been excluded from the histogram) + to be instead added into the first row of the image. Similarly, + the first plane of a 3-D or 4-D data cube would include the events + that should have been excluded as falling in the previous plane of + the cube. + + - fixed minor bug when parsing an extended filename that contains + nested pairs of square brackets (e.g., '[col newcol=oldcol[9]]'). + + - fixed bug when reading unsigned integer values from a table or + image with fits_read_col_uint/ffgcvuk. This bug only occurred on + systems like Digital Unix (now Tru64 Unix) in which 'long' + integers are 8 bytes long, and only when reading more than 7200 + elements at a time. This bug would generally cause the program to + crash with a segmentation fault. + + - modified ffgcpr to update 'heapstart' as well as 'numrows' when + writing more rows beyond the end of the table. heapstart + is needed to calculate if more space needs to be inserted in the + table when inserting columns into the table. + + - modified fficls (insert column), ffmvec, ffdrow and ffdcol to + not use the value of the NAXIS2 keyword as the number of rows + in the table, and instead use the value that is stored in + an internal structure, because the keyword value may not + be up to date. + + - Fixed bug in the iterator function that affected the handling + of null values in string columns in ASCII and binary tables. + + - Reading a subsample of pixels in very large images, (e.g., + file = myfile.fits[1:10000:10,1:10000:10], could cause a + long integer overflow (value > 2**31) in the computation of the + starting byte offset in the file, and cause a return error status + = 304 (negative byte address). This was fixed by changing the + order of the arithmetic operations in calculating the value of + 'readptr' in the ffgcli, ffgclj, ffgcle, ffgcld, etc. routines. + + - In version 2.031, a fix to prevent compressed files from being + opened with write privilege was implemented incorrectly. The fix + was intended to not allow a compressed FITS file to be opened + except when a local uncompressed copy of the file is being + produced (then the copy is opened with write access), but in fact + the opposite behavior occurred: Compressed files could be opened + with write access, EXCEPT when a local copy is produced. This + has been fixed in the mem_compress_open and file_compress_open + routines. + + - in iraffits.c, a global variable called 'val' caused multiply + defined symbols warning when linking cfitsio and IRAF libraries. + This was fixed by making 'val' a local variable within the + routine. + +Version 2.036 - 1 Feb 2000 + + - added 2 new generic routines, ffgpf and ffgcf which are analogous + to ffgpv and ffgcv but return an array of null flag values instead + of setting null pixels to a reserved value. + + - minor change to eval_y.c and eval.y to "define alloca malloc" + on all platforms, not just VMS. + + - added support for the unsigned int datatype (TUINT) in the + generic ffuky routine and changed ffpky so that unsigned ints + are cast to double instead of long before being written to + the header. + + - modified ffs2c so that if a null string is given as input then + a null FITS string (2 successive single quotes) will be returned. + Previously this routine would just return a string with a single + quote, which could cause an illegal keyword record to be written. + + - The file flush operation on Windows platforms apparently + changes the internal file position pointer (!) in violation of the + C standard. Put a patch into the file_flush routine to explicitly + seek back to the original file position. + + - changed the name of imcomp_get_compressed_image_parms to + imcomp_get_compressed_image_par to not exceed the 31 character + limit on some compilers. + + - modified the filename parser (which is used when moving to a + named HDU) to support EXTNAME values which contain embedded blanks. + + - modified drvrnet.c to deal with ftp compressed files better so + that even fits files returned from cgi queries which have the wrong + mime types and/or wrong types of file names should still decompress. + + - modified ffgics to reduce the tolerance for acceptable skewness + between the axes, and added a new warning return status = + APPROX_WCS_KEY in cases where there is significant skewness + between the axes. + + - fixed bug in ffgics that affected cases where the first coordinate + axis was DEC, not RA, and the image was a mirror image of the sky. + + - fixed bug in ffhist when trying to read the default binning + factor keyword, TDBIN. + + - modified ffhist so that is correctly computes the rotation angle + in a 2-D image if the first histogram column has a CROTA type + keyword but the 2nd column does not. + + - modified ffcpcl so that it preserves the comment fields on the + TTYPE and TFORM keywords when the column is copied to a new file. + + - make small change to configure.in to support FreeBSD Linux + by setting CFLAGS = -Df2cFortran instead of -Dg77Fortran. Then + regenerated configure with autoconf 2.13 instead of 2.12. + +Version 2.035 - 7 Dec 1999 (internal release only, FTOOLS 5.0.2) + + - added new routine called fits_get_keyclass/ffgkcl that returns + the general class of the keyword, e.g., required structural + keyword, WCS keyword, Comment keyword, etc. 15 classes of + keywords have been defined in fitsio.h + + - added new routine called fits_get_img_parm/ffgipr that is similar + to ffgphd but it only return the bitpix, naxis, and naxisn values. + + - added 3 new routines that support the long string keyword + convention: fits_insert_key_longstr, fits_modify_key_longstr + fits_update_key_longstr. + + - modified ffgphd which reads image header keywords to support + the new experimental compressed image format. + + - when opening a .Z compressed file, CFITSIO tries to allocate + memory equal to 3 times the file size, which may be excessive + in some cases. This was changed so that if the allocation fails, + then CFITSIO will try again to allocate only enough memory + equal to 1 times the file size. More memory will be allocated + later if this turns out to be too small. + + - improved the error checking in the fits_insert_key routine + to check for illegal characters in the keyword. + +Version 2.034 - 23 Nov 1999 + + - enhanced support for the new 'CD' matrix world coordinate system + keywords in the ffigics routine. This routine has been enhanced + to look for the new 'CD' keywords, if present, and convert them + back to the old CDELTn and CROTAn values, which are then returned. + The routine will also swap the WCS parameters for the 2 axes if + the declination-like axis is the first WCS axis. + + - modified ffphbn in putkey.c to support the 'U' and 'V" TFORM characters + (which represent unsigned short and unsigned int columns) in variable + length array columns. (previously only supported these types in + fixed length columns). + + - added checks when reading gzipped files to detect unexpected EOF. + Previously, the 'inflate_codes' routine would just sit in an infinite + loop if the file ended unexpectedly. + + - modified fits_verify_chksum/ffvcks so that checksum keywords with + a blank value string are treated as undefined, the same as + if the keyword did not exist at all. + + - fixed ffghtb and ffghbn so that they return the extname value + in cases where there are no columns in the table. + + - fixed bug in the ffgtwcs routine (this is a little utility + routine to aid in interfacing to Doug Mink's WCS routines); + it was not correctly padding the length of string-valued keywords + in the returned string. + + - fixed bug in 'iraffits.c' that prevented Type-2 IRAF images from + being correctly byte-swapped on PCs and DEC-OSF machines. + + - fixed tiny memory leak in irafncmp in iraffits.c. Only relevant when + reading IRAF .imh files. + + - fixed a bug (introduced in version 2.027) that caused the keyword + reading routines to sometimes not find a matching keyword if the + input name template used the '*' wildcard as the last character. + (e.g., if input name = 'COMMENT*' then it would not find the + 'COMMENT' keywords. (It would have found longer keywords like + 'COMMENTX' correctly). The fix required a minor change to ffgcrd + in getkey.c + + - modified the routine (ffswap8) that does byteswapping of + double precision numbers. Some linux systems have reported floating + point exceptions because they were trying to interpret the bytes + as a double before the bytes had been swapped. + + - fixed bug in the calculation of the position of the last byte + in the string of bits to be read in ffgcxuk and ffgcxui. This + bug generally caused no harm, but could cause the routine to + exit with an invalid error message about trying to read + beyond the size of the field. + + - If a unix machine did not have '__unix__', 'unix', or '__unix' + C preprocessor symbols defined, then CFITSIO would correctly open + one FITS file, but would not correctly open subsequent files. Instead + it would think that the same file was being opened multiple times. + This problem has only been seen on an IBM/AIX machine. The fits_path2url + and fits_url2path routines in group.c were modified to fix the problem. + + - fixed bug in group.c, which affected WINDOWS platforms only, that + caused programs to go into infinite loop when trying to open + certain files. + + - the ftrsim Fortran wrapper routine to ffrsim was not defined + correctly, which caused the naxis(2) value to be passed incorrectly + on Dec OSF machines, where sizeof(long) != sizeof(int). + +Version 2.033 - 17 Sept 1999 + + - New Feature: enhanced the row selection parser so that comparisons + between values in different rows of the table are allowed, and the + string comparisons with <, >, <=, and >= are supported. + + - added new routine the returns the name of the keyword in the + input keyword record string. The name is usually the first + 8 characters of the record, except if the HIERARCH convention + is being used in which case the name may be up to 67 characters + long. + + - added new routine called fits_null_check/ffnchk that checks to + see if the current header contains any null (ASCII 0) characters. + These characters are illegal in FITS headers, but they go undetected + by the other CFITSIO routines that read the header keywords. + + - the group.c file has been replaced with a new version as supplied + by the ISDC. The changes are mainly to support partial URLs and + absolute URLs more robustly. Host dependent directory paths are + now converted to true URLs before being read from/written to + grouping tables. + + - modified ffnmhd slightly so that it will move to the first extension + in which either the EXTNAME or the HDUNAME keyword is equal to the + user-specified name. Previously, it only checked for HDUNAME if + the EXTNAME keyword did not exist. + + - made small change to drvrnet.c so that it uncompress files + which end in .Z and .gz just as for ftp files. + + - rewrote ffcphd (copy header) to handle the case where the + input and output HDU are in the same physical FITS file. + + - fixed bug in how long string keyword values (using the CONTINUE + convention) were read. If the string keyword value ended in an + '&' character, then fits_read_key_longstr, fits_modify_key_str, + and fits_delete_key would interpret the following keyword as + a continuation, regardless of whether that keyword name was + 'CONTINUE' as required by this convention. There was also a bug + in that if the string keyword value was all blanks, then + fits_modify_key_str could in certain unusual cases think + that the keyword ended in an '&' and go into an infinite loop. + + - modified ffgpv so that it calls the higher level ffgpv_ routine + rather than directly calling the lower level ffgcl_ routine. This + change is needed to eventually support reading compressed images. + + - added 3 new routines to get the image datatype, image dimensions, + and image axes length. These support the case where the image is + compressed and stored in a binary table. + + - fixed bug in ffiblk that could sometimes cause it to insert a + new block in a file somewhere in the middle of the data, instead + of at the end of the HDU. This fortunately is a rare problem, + mainly only occurring in certain cases when inserting rows in a binary + table that contains variable length array data (i.e., has a heap). + + - modified fits_write_tdim so that it double checks the TFORMn + value directly if the column repeat count stored in the internal + structure is not equal to the product of all the dimensions. + + - fixed bug that prevented ffitab or ffibin from inserting a new + table after a null primary array (can't read NAXIS2 keyword). + Required a small change to ffrdef. + + - modified testprog.c so that it will continue to run even if + it cannot open or process the template file testprog.tpt. + + - modified the logic in lines 1182-1185 of grparser.c so that + it returns the correct status value in case of an error. + + - added test in fitsio2.h to see if __sparcv9 is defined; this + identifies a machine running Solaris 7 in 64-bit mode where + long integers are 64 bits long. + +Version 2.032 - 25 May 1999 + + - the distribution .tar file was changed so that all the files + will be untarred into a subdirectory by default instead of + into the current directory. + + - modified ffclos so that it always frees the space allocated by + the fptr pointer, even when another fptr points to the same file. + + - plugged a potential (but rare in practice) memory leak in ffpinit + + - fixed bug in all the ffp3d_ and ffg3d_ routines in cases where + the data cube that has been allocated in memory has more planes + than the data cube in the FITS file. + + - modified drvrsmem.c so that it allocates a small shared + memory segment only if CFITSIO tries to read or write a + FITS file in shared memory. Previously it always allocated + the segment whether it was needed or not. Also, this small + segment is removed if 0 shared memory segments remain in + the system. + + - put "static" in front of 7 DECLARE macros in compress.c + because these global variables were causing conflicts with other + applications programs that had variables with the same names. + + - modified ffasfm to return datatype = TDOUBLE instead of TFLOAT + if the ASCII table column has TFORMn = 'Ew.d' with d > 6. + + - modified the column reading routines to a) print out the offending + entry if an error occurs when trying to read a numeric ASCII table + column, and b) print out the column number that had the error + (the messages are written to CFITSIOs error stack) + + - major updates to the Fortran FITSIO User's Guide to include many + new functions that have been added to CFITSIO in the past year. + + - modified fitsio2.h so that the test for __D_FLOAT etc. is only + made on Alpha VMS machines, to avoid syntax errors on some other + platforms. + + - modified ffgthd so that it recognizes a floating point value + that uses the 'd' or 'D' exponent character. + + - removed the range check in fftm2s that returned an error if + 'decimals' was less than zero. A negative value is OK and is + used to return only the date and not the time in the string. + +Version 2.031 - 31 Mar 1999 + + - moved the code that updates the NAXIS2 and PCOUNT keywords from + ffchdu into the lower lever ffrdef routine. This ensures that + other routines which call ffrdef will correctly update these 2 + keywords if required. Otherwise, for instance, calling + fits_write_checksum before closing the HDU could cause the NAXIS2 + keyword (number of rows in the table) to not be updated. + + - fixed bug (introduced in version 2.030) when writing null values + to a primary array or image extension. If trying to set more + than 1 pixel to null at a time, then typically only 1 null would + be written. Also fixed related bug when writing null values to + rows in a table that are beyond the currently defined size of the + table (the size of the table was not being expanded properly). + + - enhanced the extended filename parser to support '*' in image + section specifiers, to mean use the whole range of the axis. + myfile.fits[*,1:100] means use the whole range of the first + axis and pixels 1 to 100 in the second axis. Also supports + an increment, as in myfile.fits[*:2, *:2] to use just the + odd numbered rows and columns. + + - modified fitscore.c to set the initial max size of the header, when + first reading it, to the current size of the file, rather than to + 2 x 10**9 to avoid rare cases where CFITSIO ends up writing a huge + file to disk. + + - modified file_compress_open so that it will not allow a compressed + FITS file to be opened with write access. Otherwise, a program + could write to the temporary copy of the uncompressed file, but + the modification would be lost when the program exits. + +Version 2.030 - 24 Feb 1999 + + - fixed bug in ffpclu when trying to write a null value to a row + beyond the current size of the table (wouldn't append new rows + like it should). + + - major new feature: enhanced the routines that read ASCII string + columns in tables so that they can read any table column, including + logical and numeric valued columns. The column values are returned + as a formatted string. The format is determined by the TDISPn + keyword if present, otherwise a default format based on the + datatype of the column is used. + + - new routine: fits_get_col_display_width/ffgcdw returns the length + of the formatted strings that will be returned by the routines that + read table columns as strings. + + - major new feature: added support for specifying an 'image section' + when opening an image: e.g, myfile.fits[1:512:2,2:512:2] to + open a 256x256 pixel image consisting of the odd columns and the + even numbered rows of the input image. + + - added supporting project files and instructions for building + CFITSIO under Windows NT with the Microsoft Visual C++ compiler. + + - changed the variable 'template' to 'templt' in testprog.c since + it conflicted with a reserved word on some compilers. + + - modified group.c to conditionally include sys/stat.h only on + unix platforms + + - fixed bug in the ffiter iterator function that caused it to always + pass 'firstn' = 1 to the work function when reading from the + primary array or IMAGE extension. It worked correctly for tables. + + - fixed bug in the template header keyword parser (ffgthd) in cases + where the input template line contains a logical valued keyword + (T or F) without any following comment string. It was previously + interpreting this as a string-valued keyword. + + - modified ffrhdu that reads and opens a new HDU, so that it + ignores any leading blank characters in the XTENSION name, e.g., + XTENSION= ' BINTABLE' will not cause any errors, even though + this technically violates the FITS Standard. + + - modified ffgtbp that reads the required table keywords to make + it more lenient and not exit with an error if the THEAP keyword + in binary tables cannot be read as an integer. Now it will + simply ignore this keyword if it cannot be read. + + - added test for 'WIN32' as well as '__WIN32__' in fitsio2.h, + eval.l and eval_l.c in a preprocessor statement. + + - changed definition of strcasecmp and strncasecmp in fitsio2.h, + eval.l and eval_l.c to conform to the function prototypes under + the Alpha VMS v7.1 compiler. + + - corrected the long function names in longnam.h for the new WCS + utility functions in wcssubs.c + +Version 2.029 - 11 Feb 1999 + + - fixed bug in the way NANs and underflows were being detected on + VAX and Alpha VMS machines. + + - enhanced the filename parser to distinguish between a VMS-style + directory name (e.g. disk:[directory]myfile.fits) and a CFITSIO + filter specifier at the end of the name. + + - modified ffgthd to support the HIERARCH convention for keyword + names that are longer than 8 characters or contain characters + that would be illegal in standard FITS keyword names. + + - modified the include statements in grparser.c so that malloc.h + and memory.h are only included on the few platforms that really + need them. + + - modified the file_read routine in drvrfile.c to ignore the last + record in the FITS file it it only contains a single character that + is equal to 0, 10 or 32. Text editors sometimes append a character + like this to the end of the file, so CFITSIO will ignore it and + treat it as if it had reached the end of file. + + - minor modifications to fitsio.h to help support the ROOT environment. + + - installed new version of group.c and group.h; the main change + is to support relative paths (e.g. "../filename") in the URLs + + - modified the histogramming routines so that it looks for the + default preferred column axes in a keyword of the form + CPREF = 'Xcol, Ycol' + instead of separate keywords of the form + CPREF1 = 'Xcol' + CPREF2 = 'Ycol' + + - fixed bug so that if the binning spec is just a single integer, + as in [bin 4] then this will be interpreted as meaning to make + a 2D histogram using the preferred or default axes, with the + integer taken as the binning factor in both axes. + +Version 2.028 - 27 Jan 1999 + + - if the TNULLn keyword value was outside the range of a 'I' or 'B' + column, an overflow would occur when setting the short or char + to the TNULLn value, leading to incorrect values being flagged as + being undefined. This has been fixed so that CFITSIO will ignore + TNULLn values that are beyond the range of the column data type. + + - changed a few instances of the string {"\0"} to {'\0'} in the + file groups.c + + - installed new version of the grparser.c file from the ISDC + + - added new WCS support routines (in wcssub.c) which make it easier + to call Doug Mink's WCSlib routines for converting between plate + and sky coordinates. The CFITSIO routines themselves never + call a WCSlib routine, so CFITSIO is not dependent on WCSlib. + + - modified ffopen so that if you use the extended filename + syntax to both select rows in a table and then bin columns into + a histogram, then CFITSIO will simply construct an array listing + the good row numbers to be used when making the histogram, + instead of making a whole new temporary FITS file containing + the selected rows. + + - modified ffgphd which parses the primary array header keywords + when opening a file, to not choke on minor format errors in + optional keywords. Otherwise, this prevents CFITSIO from + even opening the file. + + - changed a few more variable declarations in compress.c from global + to static. + +Version 2.027 - 12 Jan 1999 + + - modified the usage of the output filename specifier so that it, + a) gives the name of the binned image, if specified, else, + b) gives the name of column filtered and/or row filtered table, if + specified, else + c) is the name for a local copy of the ftp or http file, else, + d) is the name for the local uncompressed version of the compressed + FITS file, else, + e) the output filename is ignored. + + - fixed minor bug in ffcmps, when comparing 2 strings while using + a '*' wild card character. + + - fixed bug in ftgthd that affected cases where the template string + started with a minus sign and contained 2 tokens (to rename a + keyword). + + - added support for the HIERARCH keyword convention for reading + and writing keywords longer than 8 characters or that contain + ASCII characters not allowed in normal FITS keywords. + + - modified the extended filename syntax to support opening images + that are contained in a single cell of a binary table with syntax: + filename.fits[extname; col_name(row_expression)] + +Version 2.026 - 23 Dec 1998 + + - modified the group parser to: + a) support CFITSIO_INCLUDE_FILES environment variable, which can + point to the location of template files, and, + b) the FITS file parameter passed to the parser no longer has to point + to an empty file. If there are already HDUs in the file, then the + parser appends new HDUs to the end of the file. + + - make a small change to the drvrnet.c file to accommodate creating + a static version of the CFITSIO library. + + - added 2 new routines to read consecutive bits as an unsigned integer + from a Bit 'X' or Byte 'B' column (ffgcxui and ffgcxuk). + + - modified the logic for determining histogram boundaries in ffhisto + to add one more bin by default, to catch values that are right on + the upper boundary of the histogram, or are in the last partial bin. + + - modified cfitsio2.h to support the new Solaris 7 64-bit mode operating + system. + + - Add utility routine, CFits2Unit, to the Fortran wrappers which searches + the gFitsFiles array for a fptr, returning its element (Fortran unit + number), or allocating a new element if one doesn't already + exists... for C calling Fortran calling CFITSIO. + + - modified configure so that it does not use the compiler optimizer + when using gcc 2.8.x on Linux + + - (re)added the fitsio.* documentation files that describe the + Fortran-callable FITSIO interface to the C routines. + + - modified the lexical parser in eval_f.c to fix bug in null detections + and bug in ffsrow when nrows = 0. + + - modified ffcalc so that it creates a TNULLn keyword if appropriate + when a new column is created. Also fixed detection of OVERFLOWs + so that it ignores null values. + + - added hyperbolic trig and rounding functions to + the lexical parser in the eval* files. + + - improved error message that gets written when the group number is + out of range when reading a 'random groups' array. + + - added description of shared memory, grouping, and template parsing + error messages to ffgerr and to the User's Guide. Moved the error + code definitions from drvsmem.h to fitsio.h. + + - modified grparser.c to compile correctly on Alpha/OSF machines + + - modified drvrnet.c to eliminate compiler warnings + + - Modified Makefile.in to include targets for building all the sample + programs that are included with CFITSIO. + +Version 2.025 - 1 Dec 1998 + + - modified ffgphd and ffgtbp so that they ignores BLANK and TNULLn keywords + that do not have a valid integer value. Also, any error while reading + the BSCALE, BZERO, TSCALn, or TZEROn keywords will be ignored. + Previously, CFITSIO would have simply refused to read an HDU that had + such an invalid keyword. + + - modified the parser in eval_f.c to accept out of order times in GTIs + + - updated cfitsio_mac.sit.hqx to fix bad target parameters for Mac's + speed test program + + - modified template parser in grparser.c to: 1) not write GRPNAME keyword + twice, and 2) assign correct value for EXTVERS keyword. + + - fixed minor bugs in group.c; mainly would only affect users of the + INTEGRAL Data Access Layer. + + - temporarily removed the prototype for ffiwcs from fitsio.h until + full WCS support is added to CFITSIO in the near future. + + - modified the HTTP driver to send a User-Agent string: + HEASARC/CFITSIO/ + + - declared local variables in compress.c as 'static' to avoid + conflicts with other libraries. + +Version 2.024 - 9 Nov 1998 + + - added new function fits_url_type which returns the driver prefix string + associated with a particular FITS file pointer. + +Version 2.023 - 1 Nov 1998 - first full release of CFITSIO 2.0 + + - slightly modified the way real keyword values are formatted, to ensure + that it includes a decimal point. E.g., '1.0E-09' instead of '1E-09' + + - added new function to support template files when creating new FITS files. + + - support the TCROTn WCS keyword in tables, when reading the WCS keywords. + + - modified the iterator to support null values in logical columns in + binary tables. + + - fixed bug in iterator to support null values in integer columns in + ASCII tables. + + - changed the values for FLOATNULLVALUE and DOUBLENULLVALUE to make them + less likely to duplicate actual values in the data. + + - fixed major bug when freeing memory in the iterator function. It caused + mysterious crashes on a few platforms, but had no effect on most others. + + - added support for reading IRAF format image (.imh files) + + - added more error checking to return an error if the size of the FITS + file exceeds the largest value of a long integer (2.1 GB on 32-bit + platforms). + + - CFITSIO now will automatically insert space for additional table rows + or add space to the data heap, if one writes beyond the current end + of the table or heap. This prevents any HDUs which might follow + the current HDU from being overwritten. It is thus no longer necessary + to explicitly call fits_insert_rows before writing new rows of data + to the FITS file. + + - CFITSIO now automatically keeps track of the number of rows that have + been written to a FITS table, and updates the NAXIS2 keyword accordingly + when the table is closed. It is no longer necessary for the application + program to updated NAXIS2. + + - When reading from a FITS table, CFITSIO will now return an error if the + application tries to read beyond the end of the table. + + - added 2 routines to get the number of rows or columns in a table. + + - improved the undocumented feature that allows a '20A' column to be + read as though it were a '20B' column by fits_read_col_byt. + + - added overflow error checking when reading keywords. Previously, the + returned value could be silently truncated to the maximum allowed value + for that data type. Now an error status is returned whenever an + overflow occurs. + + - added new set of routines dealing with hierarchical groups of files. + These were provided by Don Jennings of the INTEGRAL Science Data Center. + + - added new URL parsing routines. + + - changed the calling sequence to ffghad (get HDU address) from + ffghad(fitsfile *fptr, > long *headstart, long *dataend) to + ffghad(fitsfile *fptr, > long *headstart, long datastart, + long *dataend, int *status) + + - major modification to support opening the same FITS file more + than once. Now one can open the same file multiple times and + read and write simultaneously to different HDUs within the file. + fits_open_file automatically detects if the file is already opened. + + - added the ability to clobber/overwrite an existing file + with the same name when creating a new output file. Just + preceed the output file name with '!' (an exclamation mark) + + - changed the ffpdat routine which writes the DATE keyword + to use the new 'YYYY-MM-DDThh:mm:ss' format. + + - added several new routines to create or parse the new date/time + format string. + + - changed ifdef for DECFortran in f77_wrap.h and f77_wrap1.c: + expanded to recognize Linux/Alpha + + - added new lexical parsing routines (from Peter Wilson): + eval_l.c, eval_y.c, eval_f.c, eval_defs.h, and eval_tab.h. + These are used when doing on-the-fly table row selections. + + - added new family of routines to support reading and writing + 'unsigned int' data type values in keywords, images or tables. + + - restructured all the putcol and getcol routines to provide + simpler and more robust support for machines which have + sizeof(long) = 8. Defined a new datatype INT32BIT which is + always 32 bits long (platform independent) and is used internally + in CFITSIO when reading or writing BITPIX = 32 images or 'J' + columns. This eliminated the need for specialize routines like + ffswaplong, ffunswaplong, and ffpacklong. + + - overhauled cfileio.c (and other files) to use loadable drivers for + doing data I/O to different devices. Now CFITSIO support network + access to ftp:// and http:// files, and to shared memory files. + + - removed the ffsmem routine and replaced it with ffomem. This will + only affect software that reads an existing file in core memory. + (written there by some other process). + + - modified all the ffgkn[] routines (get an array of keywords) so + that the 'nfound' parameter is = the number of keywords returned, + not the highest index value on the returned keywords. This makes + no difference if the starting index value to look for = 1. + This change is not backward compatible with previous versions + of CFITSIO, but is the way that FITSIO behaved. + + - added new error code = 1 for any application error external + to CFITSIO. Also reports "unknown error status" if the + value doesn't match a known CFITSIO error. + +Version 1.42 - 30 April 1998 (included in FTOOLS 4.1 release) + + - modified the routines which read a FITS float values into + a float array, or read FITS double values into a double array, + so that the array value is also explicitly set in addition + to setting the array of flag values, if the FITS value is a NaN. + This ensures that no NaN values get passed back to the calling + program, which can cause serious problems on some platforms (OSF). + + - added calls to ffrdef at the beginning of the insert + or delete rows or columns routines in editcol.c to make sure + that CFITSIO has correctly initialized the HDU information. + + - added new routine ffdrws to delete a list of rows in a table + + - added ffcphd to copy the header keywords from one hdu to another + + - made the anynul parameter in the ffgcl* routines optional + by first checking to see if the pointer is not null before + initializing it. + + - modified ffbinit and ffainit to ignore minor format + errors in header keywords so that cfitsio can at least + move to an extension that contains illegal keywords. + + - modified all the ffgcl* routines to simply return without + error if nelem = 0. + + - added check to ffclose to check the validity of the fitsfile + pointer before closing it. This should prevent program crashes + when someone tries to close the same file more than once. + + - replaced calls to strcmp and strncmp with macros FSTRCMP and + FSTRNCMP in a few places to improve performance when reading + header keywords (suggested by Mike Noble) + + Bug Fixes: + + - fixed typo in macro definition of error 504 in the file fitsio.h. + + - in ffopen, reserved space for 4 more characters in the input + file name in case a '.zip' suffix needs to be added. + + - small changes to ffpclx to fix problems when writing bit (X) data + columns beyond the current end of file. + + - fixed small bug in ffcrhd where a dummy pointer was not initialized + + - initialized the dummy variable in ffgcfe and ffgcfd which + was causing crashes under OSF in some cases. + + - increased the length of the allocated string ffgkls by 2 + to support the case of reading a numeric keyword as a string + which doesn't have the enclosing quote characters. + +Version 1.4 - 6 Feb 1998 + + - major restructuring of the CFITSIO User's Guide + + - added the new 'iterator' function. The fortran wrapper is + in f77_iter.c for now. + + - enhanced ffcrtb so that it writes a dummy primary array + if none currently exists before appending the table. + + - removed the ffgcl routine and replaced it with ffgcvl + + - modified ffpcnl to just take a single input null value instead + of an entire array of null value flags. + + - modified ffcmps and ffgnxk so that, for example, the string 'rate' + is not considered a match to the string 'rate2', and 'rate*' + is a match to the string 'rate'. + + - modified ffgrsz to also work with images, in which case + it returns the optimum number of pixels to process at + one time. + + - modified ffgthd to support null valued keywords + + - added a new source file 'f77_wrap.c' that includes all the + Fortran77 wrapper routines for calling CFITSIO. This will + eventually replace the Fortran FITSIO library. + + - added new routines: + ffppn - generic write primary array with null values + ffpprn - write null values to primary array + + ffuky - 'update' a keyword value, with any specified datatype. + + ffrprt - write out report of error status and error messages + ffiter - apply a user function iteratively to all the rows of a table + ffpkyc - write complex-valued keyword + ffpkym - write double complex-valued keyword + ffpkfc - write complex-valued keyword in fixed format + ffpkfm - write double complex-valued keyword in fixed format + + ffgkyc - read complex-valued keyword + ffgkym - read double complex-valued keyword + + ffmkyc - modify complex-valued keyword + ffmkym - modify double complex-valued keyword + ffmkfc - modify complex-valued keyword in fixed format + ffmkfm - modify double complex-valued keyword in fixed format + + ffukyc - update complex-valued keyword + ffukym - update double complex-valued keyword + ffukfc - update complex-valued keyword in fixed format + ffukfm - update double complex-valued keyword in fixed format + + ffikyc - insert complex-valued keyword + ffikym - insert double complex-valued keyword + ffikfc - insert complex-valued keyword in fixed format + ffikfm - insert double complex-valued keyword in fixed format + + ffpktp - write or modify keywords using ASCII template file + ffcpcl - copy a column from one table to another + ffcpky - copy an indexed keyword from one HDU to another + ffpcnl - write logical values, including nulls, to binary table + ffpcns - write string values, including nulls, to table + ffmnhd - move to HDU with given exttype, EXTNAME and EXTVERS values + ffthdu - return the total number of HDUs in the file + ffghdt - return the type of the CHDU + ffflnm - return the name of the open FITS file + ffflmd - return the mode of the file (READONLY or READWRITE) + + - modified ffmahd and ffmrhd (to move to a new extension) so that + a null pointer may be given for the returned HDUTYPE argument. + + - worked around a bug in the Mac CWpro2 compiler by changing all + the statements like "#if BYTESWAPPED == TRUE" to "if BYTESWAPPED". + + - modified ffitab (insert new ASCII table) to allow tables with + zero number of columns + + - modified Makefile.in and configure to define the -Dg77Fortran + CFLAGS variable on Linux platforms. This is needed to + compile the new f77_wrap.c file (which includes cfortran.h) + + Bug Fixes: + + - fixed small bug in ffgrz (get optimum row size) which sometimes + caused it to return slightly less than the maximum optimum size. + This bug would have done no harm to application programs. + + - fixed bug in ffpclk and ffgclk to add an 'else' case + if size of int is not equal to size of short or size of long. + + - added test to ffgkls to check if the input string is not null before + allocating memory for it. + +Version 1.32 - 21 November 1997 (internal release only) + + - fixed bug in the memory deallocation (free) statements + in the ffopen routine in the cfileio.c file. + + - modified ffgphd to tolerate minor violations of the FITS + standard in the format of the XTENSION = 'IMAGE ' + keyword when reading FITS files. Extra trailing spaces + are now allowed in the keyword value. (FITS standard + will be changed so that this is not a violation). + +Version 1.31 - 4 November 1997 (internal release only) + + Enhancements: + + - added support for directly reading compressed FITS files + by copying the algorithms from the gzip program. This + supports the Unix compress, gzip and pkzip algorithms. + + - modified ffiimg, ffitab, and ffibin (insert HDUs into + a FITS file) so that if the inserted HDU is at the end of + the FITS file, then it simply appends a new empty HDU + and writes the required keywords. This allows space + to be reserved for additional keywords in the header + if desired. + + - added the ffchfl and ffcdfl routines to check the header and + data fill values, for compatibility with the Fortran FITSIO + library. + + - added the ffgsdt routine to return the system date + for compatibility with the Fortran FITSIO library. + + - added a diagnostic error message (written to the error stack) + if the routines that read data from image or column fail. + + - modified ffgclb so that it simply copies the bytes from + an ASCII 'nA' or 'An' format column into the user's byte + array. Previously, CFITSIO would return an error when + trying to read an 'A' column with ffgclb. + + - modified ffpclb so that it simply copies the input array + of bytes to an ASCII 'nA' or 'An' format column. + Previously, CFITSIO would return an error when + trying to write to an 'A' column with ffpclb. + + Bug Fixes: + + - ffgkls was allocating one too few bytes when reading continued + string keyword values. + + - in testprog.c added code to properly free the memory that + had been allocated for string arrays. + + - corrected typographical errors in the User's Guide. + +Version 1.30 - 11 September 1997 + + - major overhaul to support reading and writing FITS files + in memory. The new routines fits_set_mem_buff and + fits_write_mem_buff have been added to initialize and + copy out the memory buffer, respectively. + + - added support for reading FITS files piped in on 'stdin' + and piped out on 'stdout'. Just specify the file name as '-' + when opening or creating the FITS file. + + - added support for 64-bit SGI IRIX machines. This required + adding routines to pack and unpack 32-bit integers into + 64-bit integers. + + - cleaned up the code that supports G_FLOAT and IEEE_FLOAT + on Alpha VMS systems. Now, the type of float is determined + at compile time, not run time. + + Bug Fixes: + + - replaced the malloc calls in the error message stack routines + with a static fixed size array. The malloc's cause more + problems than they solved, and were prone to cause memory + leaks if users don't clear the error message stack when + closing the FITS file. + + - when writing float or double keywords, test that the value + is not a special IEEE value such as a NaN. Some + compilers would write the string 'NaN' in this case into + the output value string. + + - fixed bug in ffiblk, to ignore EOF status return if it is + inserting blocks at the end of the file. + + - removed the 'l' from printf format string that is constructed + in the ffcfmt routine. This 'l' is non-standard and causes problems + with the Metrowerks compiler on a Mac. + + - the default null value in images was mistakenly being set + equal to NO_NULL = 314, rather than NULL_UNDEFINED = 1234554321 + in the ffgphd routine. + + - check status value in ffgkls to make sure the keyword exists + before allocating memory for the value string. + + - fixed the support for writing and reading unsigned long integer + keyword values in ffpky and ffgky by internally treating + the values as doubles. This required changes to ffc2r and + ffc2d as well. + + - added explicit cast to 'double' in one place in putcolb.c and + 6 places in pubcolui.c, to get rid of warning messages issued + by one compiler. + + - in ffbinit and ffainit, it is necessary to test that tfield > 0 + before trying to allocate memory with calloc. Otherwise, some + compilers return a null pointer which CFITSIO interprets to + mean the memory allocation failed. + + - had to explicitly cast the null buffer pointer to a char + pointer (cptr = (char *)buffer;) in 4 places in the buffers.c + file to satisfy a picky C++ compiler. + + - changed the test for an ALPHA VMS system to see if + '__VMS' is defined, rather than 'VMS'. The latter + is not defined by at least one C++ compiler. + + - modified ffpcls so that it can write a null string to + a variable length string column, without going into + an infinite loop. + + - fixed bug in ffgcfl that caused the 'next' variable to be + incremented twice. + + - fixed bug in ffgcpr that caused it write 2x the number of + complex elements into the descriptor when writing to + a complex or double complex variable length array column. + + - added call to ffrdef at the end of ffrsim to ensure that + the internal structures are updated to correspond to the + modified header keywords + +Version 1.25 - 7 July 1997 + + - improved the efficiency of the ffiblk routine, when inserting + more than one block into the file. + + - fixed bug in ffwend that in rare instances caused the beginning + of the following extension to be overwritten by blank fill. + + - added new routine to modify the size of an existing primary + array or image extension: fits_resize_img/ffrsim. + + - added support for null-valued keywords, e.g., keywords that + have no defined value. These keywords have an equal sign and + space in columns 9-10, but have not value string. Example: + KEYNAME = / null-valued keyword + Support for this feature required the following changes: + - modified ffpsvc to return a null value string without error + - modified ffc2[ilrd] to return error VALUE_UNDEFINED in this case + - modified ffgkn[sljed] to continue reading additional keywords + even if one or more keywords have undefined values. + - added 4 new routines: ffpkyu, ffikyu, ffmkyu, ffukyu to + write, insert, modify, or update an undefined keyword + + - a new makefile.os2 file was added, for building CFITSIO + on OS/2 systems. + + - modified ffgtkn so that if it finds an unexpected keyword + name, the returned error status = BAD_ORDER instead of + NOT_POS_INT. + + - added 2 new routines, fits_write_key_unit/ffpunt and + fits_read_key_unit/ffgunt to write/read the physical + units of a keyword value. These routines use a local + FITS convention for storing the units in square brackets + following the '/' comment field separator, as in: + VELOCITY= 12 / [km/s] orbit speed + The testprog.c program was modified to test these + new routines. + + - in the test of Alpha OSF/1 machines in fitsio2.h, + change 'defined(unix)' to 'defined(__unix__)' which + appears to be a more robust test. + + - remove test for linux environment variable from fitsio2.h + +Version 1.24 - 2 May 1997 + + - fixed bug in ffpbyt that incorrectly computed the current + location in the FITS file when writing > 10000 bytes. + + - changed the datatype of the 'nbytes' parameter in ffpbyt + from 'int' to 'long'. Made corresponding datatype change + to some internal variables in ffshft. + + - changed '(unsigned short *)' to '(short *)' in getcolui.c, and + changed '(unsigned long *)' to '(long *)' in getcoluj.c, to + work around problem with the VAX/VMS cc compiler. + +Version 1.23 - 24 April 1997 + + - modified ffcins and ffdins (in editcol.c) to simply return + without error if there are no (zero) rows in the table. + +Version 1.22 - 18 April 1997 + + - fixed bug in ffgcpr that caused it to think that all values were + undefined in ASCII tables columns that have TNULLn = ' ' + (i.e., the TNULLn keyword value is a string of blanks. + + - fixed bug in the ffgcl[bdeijk,ui,uj] family of routines + when parsing a numeric value in an ASCII table. The + returned values would have the decimal place shifted to + the left if the table field contained an explicit decimal + point followed by blanks. Example: in an F5.2 column, + the value '16. ' would be returned as 0.16. If the + trailing zeros were present, then cfitsio returned the + correct value (e.g., '16.00' returns 16.). + + - fixed another bug in the ffgcl[bdeijk,ui,uj] family of routines + that caused them to misread values in an ASCII table in rows + following an undefined value when all the values were read + at once in a single call to the routine. + +Version 1.21 - 26 March 1997 + + - added general support for reading and writing unsigned integer + keywords, images, and binary table column values. + + - fixed bug in the way the column number was used in ffgsve and + similar routines. This bug caused cfitsio to read (colnum - 1) + rather than the desired column. + + - fixed a bug in ftgkls that prevented it from reading more than one + continuation line of a long string keyword value. + + - fixed the definition of fits_write_longwarn in longnam.h + +Version 1.20 - 29 Jan 1997 + + - when creating a binary table with variable length vector columns, if the + calling routine does not specify a value for the maximum length of + the vector (e.g., TFORMn = '1PE(400)') then cfitsio will automatically + calculate the maximum value and append it to the TFORM value + when the binary table is first closed. + + - added the set of routines to do coordinate system transformations + + - added support for wildcards ('*', '?', and '#') in the input + keyword name when reading, modifying, or deleting keywords. + + - added new general keyword reading routine, ffgnxk, to return + the next keyword whose name matches a list of template names, + but does not match any names on a second template list. + + - modified ftgrec so that it simply moves to the beginning + of the header if the input keyword number = 0 + + - added check in ffdelt to make sure the input fits file pointer is + not already null + + - added check in ffcopy to make sure the output HDU does not + already contain any keywords (it must be empty). + + - modified ffgcls so that it does not test if each string column + value equals the null string value if the null string value + is longer than the width of the column. + + - fixed bug in ftgtdm that caused it to fail if the TDIMn + keyword did not exist in the FITS file + + - modified testprog.c to include tests of keyword wildcards + and the WCS coordinate transformation routines. + + - added a test for 'EMX' in fitsio2.h so that cfitsio builds + correctly on a PC running OS/2. + +Version 1.11 - 04 Dec 1996 + + - modified the testprog.c program that is included with the + distribution, so that the output FITS file is identical to + that produced by the Fortran FITSIO test program. + + - changed all instances of the 'extname' variable to 'extnm' + to avoid a conflict with the -Dextname switch in cfortran.h + on HP machines. + + - in all the routines like ffi4fi1, which convert an array + of values to integers just prior to writing them to the FITS + file, the integer value is now rounded to the nearest integer + rather than truncated. (ffi4fi1, ffi4fi2, ffi4fi4, etc) + + - changed ffgcfl (and hence ffgcl) so that the input value + of the logical array element is not changed if the corresponding + FITS value is undefined. + + - in ffgacl, the returned value of TBCOL was off by 1 (too small) + + - fixed the comment of EXTNAME keyword to read 'binary table' + instead of 'ASCII table' in the header of binary tables. + +Version 1.101 - 17 Nov 1996 + + - Made major I/O efficiency improvements by adding internal buffers + rather than directly reading or writing to disk. Access to + columns in binary tables is now 50 - 150 times faster. Access to + FITS image is also slightly faster. + + - made significant speed improvements when reading numerical data + in FITS ASCII tables by writing my own number parsing routines + rather than using the sscanf C library routine. This change + requires that the -lm argument now be included when linking + a program that calls cfitsio (under UNIX). + + - regrouped the source files into logically related sets of routines. + The Makefile now runs much faster since every single routine is + not split into a separate file. + + - now use the memcpy function, rather than a 'for' loop in several + places for added efficiency + + - redesigned the low-level binary table read and write routines + (ffpbytoff and ffgbytoff) for greater efficiency. + + - added a new error status: 103 = too many open FITS files. + + - added a 'extern "C"' statement around the function prototypes + in fitsio.h, to support use of cfitsio by C++ compilers. + + - fixed routines for writing or reading fixed-length substrings + within a binary table ASCII column, with TFORM values of + of the form 'rAw' where 'r' is the total width of the ASCII + column and 'w' is the width of a substring within the column. + + - no longer automatically rewrite the END card and following fill + values if they are already correct. + + - all the 'get keyword value and comment' routines have been changed + so that the comment is not returned if the input pointer is NULL. + + - added new routine to return the optimum number of tables rows + that should be read or written at one time for optimum efficiency. + + - modified the way numerical values in ASCII tables are parsed so + that embedded spaces in the value are ignored, and implicit + decimal points are now supported. (e.g, the string '123E 12' + in a 'E10.2' format column will be interpreted as 1.23 * 10**12). + + - modified ffpcl and ffgcl to support binary table columns of + all datatype (added logical, bit, complex, and double complex) + + - when writing numerical data to ASCII table columns, the ffpcl_ + routines now return an overflow error if a value is too large + to be expressed in the column format. + + - closed small memory leak in ffpcls. + + - initialized the 'incre' variable in ffgcpr to eliminate compiler warning. + +Version 1.04 - 17 Sept 1996 + + - added README.MacOS and cfitsio_mac.sit.hqx to the distribution + to support the Mac platforms. + + - fixed bug in ffpdfl that caused an EOF error (107) when a program + creates a new extension that is an exact multiple of 2880 bytes long, + AND the program does not write a value to the last element + in the table or image. + + - fixed bug in all the ffgsf* and ffgcv* routines which caused + core dumps when reading null values in a table. + +Version 1.03 - 20 August 1996 + + - added full support for reading and writing the C 'int' + data type. This was a problem on Alpha/OSF where short, + int, and long datatypes are 2, 4, and 8 bytes long, respectively. + + - cleaned up the code in the byte-swapping routines. + + - renamed the file 'longname.h' to 'longnam.h' to avoid conflict + with a file with the same name in another unrelated package. + +Version 1.02 - 15 August 1996 + + - ffgtbp was not correctly reading the THEAP keyword, hence would + not correctly read variable length data in binary tables if + the heap was not at the default starting location (i.e., + starting immediately after the fixed length table). + + - now force the cbuff variable in ffpcl_ and ffgcl_ to be + aligned on a double word boundary. Non-alignment can + cause program to crash on some systems. + +Version 1.01 - 12 August 1996 + + - initial public release diff --git a/pkg/tbtables/cfitsio/checksum.c b/pkg/tbtables/cfitsio/checksum.c new file mode 100644 index 00000000..3cde9951 --- /dev/null +++ b/pkg/tbtables/cfitsio/checksum.c @@ -0,0 +1,508 @@ +/* This file, checksum.c, contains the checksum-related routines in the */ +/* FITSIO library. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*------------------------------------------------------------------------*/ +int ffcsum(fitsfile *fptr, /* I - FITS file pointer */ + long nrec, /* I - number of 2880-byte blocks to sum */ + unsigned long *sum, /* IO - accumulated checksum */ + int *status) /* IO - error status */ +/* + Calculate a 32-bit 1's complement checksum of the FITS 2880-byte blocks. + This routine is based on the C algorithm developed by Rob + Seaman at NOAO that was presented at the 1994 ADASS conference, + published in the Astronomical Society of the Pacific Conference Series. + This uses a 32-bit 1's complement checksum in which the overflow bits + are permuted back into the sum and therefore all bit positions are + sampled evenly. +*/ +{ + long ii, jj; + unsigned short sbuf[1440]; + unsigned long hi, lo, hicarry, locarry; + + if (*status > 0) + return(*status); + /* + Sum the specified number of FITS 2880-byte records. This assumes that + the FITSIO file pointer points to the start of the records to be summed. + Read each FITS block as 1440 short values (do byte swapping if needed). + */ + for (jj = 0; jj < nrec; jj++) + { + ffgbyt(fptr, 2880, sbuf, status); + +#if BYTESWAPPED + + ffswap2( (short *)sbuf, 1440); /* reverse order of bytes in each value */ + +#endif + + hi = (*sum >> 16); + lo = *sum & 0xFFFF; + + for (ii = 0; ii < 1440; ii += 2) + { + hi += sbuf[ii]; + lo += sbuf[ii+1]; + } + + hicarry = hi >> 16; /* fold carry bits in */ + locarry = lo >> 16; + + while (hicarry | locarry) + { + hi = (hi & 0xFFFF) + locarry; + lo = (lo & 0xFFFF) + hicarry; + hicarry = hi >> 16; + locarry = lo >> 16; + } + + *sum = (hi << 16) + lo; + } + return(*status); +} +/*-------------------------------------------------------------------------*/ +void ffesum(unsigned long sum, /* I - accumulated checksum */ + int complm, /* I - = 1 to encode complement of the sum */ + char *ascii) /* O - 16-char ASCII encoded checksum */ +/* + encode the 32 bit checksum by converting every + 2 bits of each byte into an ASCII character (32 bit word encoded + as 16 character string). Only ASCII letters and digits are used + to encode the values (no ASCII punctuation characters). + + If complm=TRUE, then the complement of the sum will be encoded. + + This routine is based on the C algorithm developed by Rob + Seaman at NOAO that was presented at the 1994 ADASS conference, + published in the Astronomical Society of the Pacific Conference Series. +*/ +{ + unsigned int exclude[13] = { 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x40, + 0x5b, 0x5c, 0x5d, 0x5e, 0x5f, 0x60 }; + unsigned long mask[4] = { 0xff000000, 0xff0000, 0xff00, 0xff }; + + int offset = 0x30; /* ASCII 0 (zero) */ + + unsigned long value; + int byte, quotient, remainder, ch[4], check, ii, jj, kk; + char asc[32]; + + if (complm) + value = 0xFFFFFFFF - sum; /* complement each bit of the value */ + else + value = sum; + + for (ii = 0; ii < 4; ii++) + { + byte = (value & mask[ii]) >> (24 - (8 * ii)); + quotient = byte / 4 + offset; + remainder = byte % 4; + for (jj = 0; jj < 4; jj++) + ch[jj] = quotient; + + ch[0] += remainder; + + for (check = 1; check;) /* avoid ASCII punctuation */ + for (check = 0, kk = 0; kk < 13; kk++) + for (jj = 0; jj < 4; jj += 2) + if ((unsigned char) ch[jj] == exclude[kk] || + (unsigned char) ch[jj+1] == exclude[kk]) + { + ch[jj]++; + ch[jj+1]--; + check++; + } + + for (jj = 0; jj < 4; jj++) /* assign the bytes */ + asc[4*jj+ii] = ch[jj]; + } + + for (ii = 0; ii < 16; ii++) /* shift the bytes 1 to the right */ + ascii[ii] = asc[(ii+15)%16]; + + ascii[16] = '\0'; +} +/*-------------------------------------------------------------------------*/ +unsigned long ffdsum(char *ascii, /* I - 16-char ASCII encoded checksum */ + int complm, /* I - =1 to decode complement of the */ + unsigned long *sum) /* O - 32-bit checksum */ +/* + decode the 16-char ASCII encoded checksum into an unsigned 32-bit long. + If complm=TRUE, then the complement of the sum will be decoded. + + This routine is based on the C algorithm developed by Rob + Seaman at NOAO that was presented at the 1994 ADASS conference, + published in the Astronomical Society of the Pacific Conference Series. +*/ +{ + char cbuf[16]; + unsigned long hi = 0, lo = 0, hicarry, locarry; + int ii; + + /* remove the permuted FITS byte alignment and the ASCII 0 offset */ + for (ii = 0; ii < 16; ii++) + { + cbuf[ii] = ascii[(ii+1)%16]; + cbuf[ii] -= 0x30; + } + + for (ii = 0; ii < 16; ii += 4) + { + hi += (cbuf[ii] << 8) + cbuf[ii+1]; + lo += (cbuf[ii+2] << 8) + cbuf[ii+3]; + } + + hicarry = hi >> 16; + locarry = lo >> 16; + while (hicarry || locarry) + { + hi = (hi & 0xFFFF) + locarry; + lo = (lo & 0xFFFF) + hicarry; + hicarry = hi >> 16; + locarry = lo >> 16; + } + + *sum = (hi << 16) + lo; + if (complm) + *sum = 0xFFFFFFFF - *sum; /* complement each bit of the value */ + + return(*sum); +} +/*------------------------------------------------------------------------*/ +int ffpcks(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Create or update the checksum keywords in the CHDU. These keywords + provide a checksum verification of the FITS HDU based on the ASCII + coded 1's complement checksum algorithm developed by Rob Seaman at NOAO. +*/ +{ + char datestr[20], checksum[FLEN_VALUE], datasum[FLEN_VALUE]; + char comm[FLEN_COMMENT], chkcomm[FLEN_COMMENT], datacomm[FLEN_COMMENT]; + int tstatus; + long nrec; + OFF_T headstart, datastart, dataend; + unsigned long dsum, olddsum, sum; + double tdouble; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* generate current date string and construct the keyword comments */ + ffgstm(datestr, NULL, status); + strcpy(chkcomm, "HDU checksum updated "); + strcat(chkcomm, datestr); + strcpy(datacomm, "data unit checksum updated "); + strcat(datacomm, datestr); + + /* write the CHECKSUM keyword if it does not exist */ + tstatus = *status; + if (ffgkys(fptr, "CHECKSUM", checksum, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + strcpy(checksum, "0000000000000000"); + ffpkys(fptr, "CHECKSUM", checksum, chkcomm, status); + } + + /* write the DATASUM keyword if it does not exist */ + tstatus = *status; + if (ffgkys(fptr, "DATASUM", datasum, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + olddsum = 0; + ffpkys(fptr, "DATASUM", " 0", datacomm, status); + + /* set the CHECKSUM keyword as undefined, if it isn't already */ + if (strcmp(checksum, "0000000000000000") ) + { + strcpy(checksum, "0000000000000000"); + ffmkys(fptr, "CHECKSUM", checksum, chkcomm, status); + } + } + else + { + /* decode the datasum into an unsigned long variable */ + + /* olddsum = strtoul(datasum, 0, 10); doesn't work on SUN OS */ + + tdouble = atof(datasum); + olddsum = tdouble; + } + + /* close header: rewrite END keyword and following blank fill */ + /* and re-read the required keywords to determine the structure */ + if (ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->heapsize > 0) + ffuptf(fptr, status); /* update the variable length TFORM values */ + + /* write the correct data fill values, if they are not already correct */ + if (ffpdfl(fptr, status) > 0) + return(*status); + + /* calc size of data unit, in FITS 2880-byte blocks */ + if (ffghof(fptr, &headstart, &datastart, &dataend, status) > 0) + return(*status); + + nrec = (dataend - datastart) / 2880; + dsum = 0; + + if (nrec > 0) + { + /* accumulate the 32-bit 1's complement checksum */ + ffmbyt(fptr, datastart, REPORT_EOF, status); + if (ffcsum(fptr, nrec, &dsum, status) > 0) + return(*status); + } + + if (dsum != olddsum) + { + /* update the DATASUM keyword with the correct value */ + sprintf(datasum, "%lu", dsum); + ffmkys(fptr, "DATASUM", datasum, datacomm, status); + + /* set the CHECKSUM keyword as undefined, if it isn't already */ + if (strcmp(checksum, "0000000000000000") ) + { + strcpy(checksum, "0000000000000000"); + ffmkys(fptr, "CHECKSUM", checksum, chkcomm, status); + } + } + + if (strcmp(checksum, "0000000000000000") ) + { + /* check if CHECKSUM is still OK; move to the start of the header */ + ffmbyt(fptr, headstart, REPORT_EOF, status); + + /* accumulate the header checksum into the previous data checksum */ + nrec = (datastart - headstart) / 2880; + sum = dsum; + if (ffcsum(fptr, nrec, &sum, status) > 0) + return(*status); + + if (sum == 0 || sum == 0xFFFFFFFF) + return(*status); /* CHECKSUM is correct */ + + /* Zero the CHECKSUM and recompute the new value */ + ffmkys(fptr, "CHECKSUM", "0000000000000000", chkcomm, status); + } + + /* move to the start of the header */ + ffmbyt(fptr, headstart, REPORT_EOF, status); + + /* accumulate the header checksum into the previous data checksum */ + nrec = (datastart - headstart) / 2880; + sum = dsum; + if (ffcsum(fptr, nrec, &sum, status) > 0) + return(*status); + + /* encode the COMPLEMENT of the checksum into a 16-character string */ + ffesum(sum, TRUE, checksum); + + /* update the CHECKSUM keyword value with the new string */ + ffmkys(fptr, "CHECKSUM", checksum, "&", status); + + return(*status); +} +/*------------------------------------------------------------------------*/ +int ffupck(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Update the CHECKSUM keyword value. This assumes that the DATASUM + keyword exists and has the correct value. +*/ +{ + char datestr[20], chkcomm[FLEN_COMMENT], comm[FLEN_COMMENT]; + char checksum[FLEN_VALUE], datasum[FLEN_VALUE]; + int tstatus; + long nrec; + OFF_T headstart, datastart, dataend; + unsigned long sum, dsum; + double tdouble; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* generate current date string and construct the keyword comments */ + ffgstm(datestr, NULL, status); + strcpy(chkcomm, "HDU checksum updated "); + strcat(chkcomm, datestr); + + /* get the DATASUM keyword and convert it to a unsigned long */ + if (ffgkys(fptr, "DATASUM", datasum, comm, status) == KEY_NO_EXIST) + { + ffpmsg("DATASUM keyword not found (ffupck"); + return(*status); + } + + tdouble = atof(datasum); /* read as a double as a workaround */ + dsum = tdouble; + + /* get size of the HDU */ + if (ffghof(fptr, &headstart, &datastart, &dataend, status) > 0) + return(*status); + + /* get the checksum keyword, if it exists */ + tstatus = *status; + if (ffgkys(fptr, "CHECKSUM", checksum, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + strcpy(checksum, "0000000000000000"); + ffpkys(fptr, "CHECKSUM", checksum, chkcomm, status); + } + else + { + /* check if CHECKSUM is still OK */ + /* rewrite END keyword and following blank fill */ + if (ffwend(fptr, status) > 0) + return(*status); + + /* move to the start of the header */ + ffmbyt(fptr, headstart, REPORT_EOF, status); + + /* accumulate the header checksum into the previous data checksum */ + nrec = (datastart - headstart) / 2880; + sum = dsum; + if (ffcsum(fptr, nrec, &sum, status) > 0) + return(*status); + + if (sum == 0 || sum == 0xFFFFFFFF) + return(*status); /* CHECKSUM is already correct */ + + /* Zero the CHECKSUM and recompute the new value */ + ffmkys(fptr, "CHECKSUM", "0000000000000000", chkcomm, status); + } + + /* move to the start of the header */ + ffmbyt(fptr, headstart, REPORT_EOF, status); + + /* accumulate the header checksum into the previous data checksum */ + nrec = (datastart - headstart) / 2880; + sum = dsum; + if (ffcsum(fptr, nrec, &sum, status) > 0) + return(*status); + + /* encode the COMPLEMENT of the checksum into a 16-character string */ + ffesum(sum, TRUE, checksum); + + /* update the CHECKSUM keyword value with the new string */ + ffmkys(fptr, "CHECKSUM", checksum, "&", status); + + return(*status); +} +/*------------------------------------------------------------------------*/ +int ffvcks(fitsfile *fptr, /* I - FITS file pointer */ + int *datastatus, /* O - data checksum status */ + int *hdustatus, /* O - hdu checksum status */ + /* 1 verification is correct */ + /* 0 checksum keyword is not present */ + /* -1 verification not correct */ + int *status) /* IO - error status */ +/* + Verify the HDU by comparing the value of the computed checksums against + the values of the DATASUM and CHECKSUM keywords if they are present. +*/ +{ + int tstatus; + double tdouble; + unsigned long datasum, hdusum, olddatasum; + char chksum[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + *datastatus = -1; + *hdustatus = -1; + + tstatus = *status; + if (ffgkys(fptr, "CHECKSUM", chksum, comm, status) == KEY_NO_EXIST) + { + *hdustatus = 0; /* CHECKSUM keyword does not exist */ + *status = tstatus; + } + if (chksum[0] == '\0') + *hdustatus = 0; /* all blank checksum means it is undefined */ + + if (ffgkys(fptr, "DATASUM", chksum, comm, status) == KEY_NO_EXIST) + { + *datastatus = 0; /* DATASUM keyword does not exist */ + *status = tstatus; + } + if (chksum[0] == '\0') + *datastatus = 0; /* all blank checksum means it is undefined */ + + if ( *status > 0 || (!(*hdustatus) && !(*datastatus)) ) + return(*status); /* return if neither keywords exist */ + + /* convert string to unsigned long */ + + /* olddatasum = strtoul(chksum, 0, 10); doesn't work w/ gcc on SUN OS */ + /* sscanf(chksum, "%u", &olddatasum); doesn't work w/ cc on VAX/VMS */ + + tdouble = atof(chksum); /* read as a double as a workaround */ + olddatasum = tdouble; + + /* calculate the data checksum and the HDU checksum */ + if (ffgcks(fptr, &datasum, &hdusum, status) > 0) + return(*status); + + if (*datastatus) + if (datasum == olddatasum) + *datastatus = 1; + + if (*hdustatus) + if (hdusum == 0 || hdusum == 0xFFFFFFFF) + *hdustatus = 1; + + return(*status); +} +/*------------------------------------------------------------------------*/ +int ffgcks(fitsfile *fptr, /* I - FITS file pointer */ + unsigned long *datasum, /* O - data checksum */ + unsigned long *hdusum, /* O - hdu checksum */ + int *status) /* IO - error status */ + + /* calculate the checksums of the data unit and the total HDU */ +{ + long nrec; + OFF_T headstart, datastart, dataend; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* get size of the HDU */ + if (ffghof(fptr, &headstart, &datastart, &dataend, status) > 0) + return(*status); + + nrec = (dataend - datastart) / 2880; + + *datasum = 0; + + if (nrec > 0) + { + /* accumulate the 32-bit 1's complement checksum */ + ffmbyt(fptr, datastart, REPORT_EOF, status); + if (ffcsum(fptr, nrec, datasum, status) > 0) + return(*status); + } + + /* move to the start of the header and calc. size of header */ + ffmbyt(fptr, headstart, REPORT_EOF, status); + nrec = (datastart - headstart) / 2880; + + /* accumulate the header checksum into the previous data checksum */ + *hdusum = *datasum; + ffcsum(fptr, nrec, hdusum, status); + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/compress.c b/pkg/tbtables/cfitsio/compress.c new file mode 100644 index 00000000..7ae5a91b --- /dev/null +++ b/pkg/tbtables/cfitsio/compress.c @@ -0,0 +1,155 @@ +#include +#include + +/* ====================================================================== + +This file contains stubs for the compression and uncompression routines +that are contained in the source file compress.c. Those routines (in +compress.c) can only be used by software which adheres to the terms of +the GNU General Public License. Users who want to use CFITSIO but are +unwilling to release their code under the terms of the GNU General +Public License should replace the compress.c file with this current +file before building the CFITSIO library. This alternative version of +CFITSIO will behave the same as the standard version, except that it +will not support reading or writing of FITS files in compressed format. + +======================================================================== */ +/* prototype for the following functions */ + +void ffpmsg(const char *err_message); + +int uncompress2mem(char *filename, + FILE *diskfile, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +int uncompress2mem_from_mem( + char *inmemptr, + size_t inmemsize, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +int uncompress2file(char *filename, + FILE *indiskfile, + FILE *outdiskfile, + int *status); + +int compress2mem_from_mem( + char *inmemptr, + size_t inmemsize, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +int compress2file_from_mem( + char *inmemptr, + size_t inmemsize, + FILE *outdiskfile, + size_t *filesize, /* O - size of file, in bytes */ + int *status); +/*--------------------------------------------------------------------------*/ +int uncompress2mem(char *filename, /* name of input file */ + FILE *diskfile, /* I - file pointer */ + char **buffptr, /* IO - memory pointer */ + size_t *buffsize, /* IO - size of buffer, in bytes */ + void *(*mem_realloc)(void *p, size_t newsize), /* function */ + size_t *filesize, /* O - size of file, in bytes */ + int *status) /* IO - error status */ + +/* + Uncompress the file into memory. Fill whatever amount of memory has + already been allocated, then realloc more memory, using the supplied + input function, if necessary. +*/ +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support compressed files"); + return(*status = 414); +} +/*--------------------------------------------------------------------------*/ +int uncompress2mem_from_mem( + char *inmemptr, /* I - memory pointer to compressed bytes */ + size_t inmemsize, /* I - size of input compressed file */ + char **buffptr, /* IO - memory pointer */ + size_t *buffsize, /* IO - size of buffer, in bytes */ + void *(*mem_realloc)(void *p, size_t newsize), /* function */ + size_t *filesize, /* O - size of file, in bytes */ + int *status) /* IO - error status */ + +/* + Uncompress the file into memory. Fill whatever amount of memory has + already been allocated, then realloc more memory, using the supplied + input function, if necessary. +*/ +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support compressed files"); + return(*status = 414); +} +/*--------------------------------------------------------------------------*/ +int uncompress2file(char *filename, /* name of input file */ + FILE *indiskfile, /* I - input file pointer */ + FILE *outdiskfile, /* I - output file pointer */ + int *status) /* IO - error status */ + +/* + Uncompress the file into file. +*/ +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support compressed files"); + return(*status = 414); +} +/*--------------------------------------------------------------------------*/ +int compress2mem_from_mem( + char *inmemptr, /* I - memory pointer to uncompressed bytes */ + size_t inmemsize, /* I - size of input uncompressed file */ + char **buffptr, /* IO - memory pointer for compressed file */ + size_t *buffsize, /* IO - size of buffer, in bytes */ + void *(*mem_realloc)(void *p, size_t newsize), /* function */ + size_t *filesize, /* O - size of file, in bytes */ + int *status) /* IO - error status */ + +/* + Compress the file into memory. Fill whatever amount of memory has + already been allocated, then realloc more memory, using the supplied + input function, if necessary. +*/ +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support compressed files"); + return(*status = 413); +} +/*--------------------------------------------------------------------------*/ +int compress2file_from_mem( + char *inmemptr, /* I - memory pointer to uncompressed bytes */ + size_t inmemsize, /* I - size of input uncompressed file */ + FILE *outdiskfile, + size_t *filesize, /* O - size of file, in bytes */ + int *status) +/* + Compress the memory file into disk file. +*/ +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support compressed files"); + return(*status = 413); +} diff --git a/pkg/tbtables/cfitsio/compress.h b/pkg/tbtables/cfitsio/compress.h new file mode 100644 index 00000000..7e3c4066 --- /dev/null +++ b/pkg/tbtables/cfitsio/compress.h @@ -0,0 +1,212 @@ +/* compress.h -- definitions for the decompression routines used in CFITSIO */ + +/* Blatantly copied and modified from the original gzip-1.2.4 source code. */ + +#include +#include +#include +#include + +/* 'near' is only relevant for 16-bit PC with small memory model */ +# define near + +#if defined(VAXC) || defined(VMS) +# define RECORD_IO 1 +#else +# define RECORD_IO 0 +#endif + +#define get_char() get_byte() + +/* gzip.h -- common declarations for all gzip modules */ + +#define OF(args) args +typedef void *voidp; + +#define memzero(s, n) memset ((voidp)(s), 0, (n)) + +typedef unsigned char uch; +typedef unsigned short ush; +typedef unsigned long ulg; + +/* Return codes from gzip */ +#define OK 0 +#define ERROR 1 +#define WARNING 2 + +/* Compression methods (see algorithm.doc) */ +#define STORED 0 +#define COMPRESSED 1 +#define PACKED 2 +#define LZHED 3 +/* methods 4 to 7 reserved */ +#define DEFLATED 8 +#define MAX_METHODS 9 + +#define INBUFSIZ 0x8000 /* input buffer size */ +#define INBUF_EXTRA 64 /* required by unlzw() */ +#define OUTBUFSIZ 16384 /* output buffer size */ +#define OUTBUF_EXTRA 2048 /* required by unlzw() */ +#define DIST_BUFSIZE 0x8000 /* buffer for distances, see trees.c */ +#define WSIZE 0x8000 /* window size--must be a power of two, and */ + +#define DECLARE(type, array, size) type array[size] + +#define tab_suffix window +#define tab_prefix prev /* hash link (see deflate.c) */ +#define head (prev+WSIZE) /* hash head (see deflate.c) */ + +#define PACK_MAGIC "\037\036" /* Magic header for packed files */ +#define GZIP_MAGIC "\037\213" /* Magic header for gzip files, 1F 8B */ +#define OLD_GZIP_MAGIC "\037\236" /* Magic header for gzip 0.5 = freeze 1.x */ +#define LZH_MAGIC "\037\240" /* Magic header for SCO LZH Compress files*/ +#define LZW_MAGIC "\037\235" /* Magic header for lzw files, 1F 9D */ +#define PKZIP_MAGIC "\120\113\003\004" /* Magic header for pkzip files */ + +/* gzip flag byte */ +#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ +#define CONTINUATION 0x02 /* bit 1 set: continuation of multi-part gzip file */ +#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +#define COMMENT 0x10 /* bit 4 set: file comment present */ +#define ENCRYPTED 0x20 /* bit 5 set: file is encrypted */ +#define RESERVED 0xC0 /* bit 6,7: reserved */ + +#define MIN_MATCH 3 +#define MAX_MATCH 258 +#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +#define MAX_DIST (WSIZE-MIN_LOOKAHEAD) +#define translate_eol 0 /* no option -a yet */ + +#define get_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(0)) +#define try_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(1)) +#define put_ubyte(c) {window[outcnt++]=(uch)(c); if (outcnt==WSIZE)\ + flush_window();} + +/* Macros for getting two-byte and four-byte header values */ +#define SH(p) ((ush)(uch)((p)[0]) | ((ush)(uch)((p)[1]) << 8)) +#define LG(p) ((ulg)(SH(p)) | ((ulg)(SH((p)+2)) << 16)) + +/* Diagnostic functions */ +# define Assert(cond,msg) +# define Trace(x) +# define Tracev(x) +# define Tracevv(x) +# define Tracec(c,x) +# define Tracecv(c,x) + +/* lzw.h -- define the lzw functions. */ + +#ifndef BITS +# define BITS 16 +#endif +#define INIT_BITS 9 /* Initial number of bits per code */ +#define BIT_MASK 0x1f /* Mask for 'number of compression bits' */ +#define BLOCK_MODE 0x80 +#define LZW_RESERVED 0x60 /* reserved bits */ +#define CLEAR 256 /* flush the dictionary */ +#define FIRST (CLEAR+1) /* first free entry */ + +/* prototypes */ + +#define local static +void ffpmsg(const char *err_message); + +local int get_method OF((FILE *in)); + +local ulg updcrc OF((uch *s, unsigned n)); +local int fill_inbuf OF((int eof_ok)); +local void flush_outbuf OF((void)); +local void flush_window OF((void)); +local void write_buf OF((voidp buf, unsigned cnt)); +local void error OF((char *m)); +local ulg flush_block OF((char *buf, ulg stored_len, int eof)); +typedef int file_t; /* Do not use stdio */ +#define NO_FILE (-1) /* in memory compression */ +local int file_read OF((char *buf, unsigned size)); +local void send_bits OF((int value, int length)); +local unsigned bi_reverse OF((unsigned value, int length)); +local void bi_windup OF((void)); +local void copy_block OF((char *buf, unsigned len, int header)); +local int (*read_buf) OF((char *buf, unsigned size)); +local void lm_init OF((int pack_level, ush *flags)); +local ulg deflate OF((void)); +local void ct_init OF((ush *attr, int *method)); +local int ct_tally OF((int dist, int lc)); +local void bi_init OF((file_t zipfile)); + +#define put_byte(c) {outbuf[outcnt++]=(uch)(c); if (outcnt==OUTBUFSIZ)\ + flush_outbuf();} + +/* Output a 16 bit value, lsb first */ +#define put_short(w) \ +{ if (outcnt < OUTBUFSIZ-2) { \ + outbuf[outcnt++] = (uch) ((w) & 0xff); \ + outbuf[outcnt++] = (uch) ((ush)(w) >> 8); \ + } else { \ + put_byte((uch)((w) & 0xff)); \ + put_byte((uch)((ush)(w) >> 8)); \ + } \ +} + +/* Output a 32 bit value to the bit stream, lsb first */ +#define put_long(n) { \ + put_short((n) & 0xffff); \ + put_short(((ulg)(n)) >> 16); \ +} + +#define seekable() 0 /* force sequential output */ + +/* io.c */ +local void fillbuf OF((int n)); +local unsigned getbits OF((int n)); +local void init_getbits OF((void)); + +/* maketbl.c */ +local void make_table OF((int nchar, uch bitlen[], + int tablebits, ush table[])); + +/* huf.c */ +local void read_pt_len OF((int nn, int nbit, int i_special)); +local void read_c_len OF((void)); +local unsigned decode_c OF((void)); +local unsigned decode_p OF((void)); +local void huf_decode_start OF((void)); + +/* decode.c */ +local void decode_start OF((void)); +local unsigned decode OF((unsigned count, uch buffer[])); + +local int unlzh OF((FILE *in, FILE *out)); +local int unlzw OF((FILE *in, FILE *out)); + +local void read_tree OF((void)); +local void build_tree_unpack OF((void)); + +local int unpack OF((FILE *in, FILE *out)); +local int check_zipfile OF((FILE *in)); +local int unzip OF((FILE *in, FILE *out)); + +int (*work) OF((FILE *infile, FILE *outfile)) = unzip; /* function to call */ + +/* inflate.c */ +struct huft { + uch e; /* number of extra bits or operation */ + uch b; /* number of bits in this code or subcode */ + union { + ush n; /* literal, length base, or distance base */ + struct huft *t; /* pointer to next level of table */ + } v; +}; + +local int huft_build OF((unsigned *, unsigned, unsigned, ush *, ush *, + struct huft **, int *)); +local int huft_free OF((struct huft *)); +local int inflate_codes OF((struct huft *, struct huft *, int, int)); +local int inflate_stored OF((void)); +local int inflate_fixed OF((void)); +local int inflate_dynamic OF((void)); +local int inflate_block OF((int *)); +local int inflate OF((void)); + +/* end of compress.h include file */ diff --git a/pkg/tbtables/cfitsio/configure b/pkg/tbtables/cfitsio/configure new file mode 100755 index 00000000..f277be6a --- /dev/null +++ b/pkg/tbtables/cfitsio/configure @@ -0,0 +1,1886 @@ +#! /bin/sh + +# Guess values for system-dependent variables and create Makefiles. +# Generated automatically using autoconf version 2.13 +# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. + +# Defaults: +ac_help= +ac_default_prefix=/usr/local +# Any additions from configure.in: + +# Initialize some variables set by options. +# The variables have the same names as the options, with +# dashes changed to underlines. +build=NONE +cache_file=./config.cache +exec_prefix=NONE +host=NONE +no_create= +nonopt=NONE +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +target=NONE +verbose= +x_includes=NONE +x_libraries=NONE +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +# Initialize some other variables. +subdirs= +MFLAGS= MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} +# Maximum number of lines to put in a shell here document. +ac_max_here_lines=12 + +ac_prev= +for ac_option +do + + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + case "$ac_option" in + -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; + *) ac_optarg= ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case "$ac_option" in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir="$ac_optarg" ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build="$ac_optarg" ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file="$ac_optarg" ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir="$ac_optarg" ;; + + -disable-* | --disable-*) + ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + eval "enable_${ac_feature}=no" ;; + + -enable-* | --enable-*) + ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "enable_${ac_feature}='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix="$ac_optarg" ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he) + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat << EOF +Usage: configure [options] [host] +Options: [defaults in brackets after descriptions] +Configuration: + --cache-file=FILE cache test results in FILE + --help print this message + --no-create do not create output files + --quiet, --silent do not print \`checking...' messages + --version print the version of autoconf that created configure +Directory and file names: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [same as prefix] + --bindir=DIR user executables in DIR [EPREFIX/bin] + --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] + --libexecdir=DIR program executables in DIR [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data in DIR + [PREFIX/share] + --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data in DIR + [PREFIX/com] + --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] + --libdir=DIR object code libraries in DIR [EPREFIX/lib] + --includedir=DIR C header files in DIR [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] + --infodir=DIR info documentation in DIR [PREFIX/info] + --mandir=DIR man documentation in DIR [PREFIX/man] + --srcdir=DIR find the sources in DIR [configure dir or ..] + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM + run sed PROGRAM on installed program names +EOF + cat << EOF +Host type: + --build=BUILD configure for building on BUILD [BUILD=HOST] + --host=HOST configure for HOST [guessed] + --target=TARGET configure for TARGET [TARGET=HOST] +Features and packages: + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR +EOF + if test -n "$ac_help"; then + echo "--enable and --with options recognized:$ac_help" + fi + exit 0 ;; + + -host | --host | --hos | --ho) + ac_prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + host="$ac_optarg" ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir="$ac_optarg" ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir="$ac_optarg" ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir="$ac_optarg" ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir="$ac_optarg" ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir="$ac_optarg" ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir="$ac_optarg" ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir="$ac_optarg" ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix="$ac_optarg" ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix="$ac_optarg" ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix="$ac_optarg" ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name="$ac_optarg" ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir="$ac_optarg" ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir="$ac_optarg" ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site="$ac_optarg" ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir="$ac_optarg" ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir="$ac_optarg" ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target="$ac_optarg" ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers) + echo "configure generated by autoconf version 2.13" + exit 0 ;; + + -with-* | --with-*) + ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "with_${ac_package}='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`echo $ac_option|sed -e 's/-*without-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + eval "with_${ac_package}=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes="$ac_optarg" ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries="$ac_optarg" ;; + + -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + ;; + + *) + if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then + echo "configure: warning: $ac_option: invalid host type" 1>&2 + fi + if test "x$nonopt" != xNONE; then + { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } + fi + nonopt="$ac_option" + ;; + + esac +done + +if test -n "$ac_prev"; then + { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } +fi + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +# File descriptor usage: +# 0 standard input +# 1 file creation +# 2 errors and warnings +# 3 some systems may open it to /dev/tty +# 4 used on the Kubota Titan +# 6 checking for... messages and results +# 5 compiler messages saved in config.log +if test "$silent" = yes; then + exec 6>/dev/null +else + exec 6>&1 +fi +exec 5>./config.log + +echo "\ +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. +" 1>&5 + +# Strip out --no-create and --no-recursion so they do not pile up. +# Also quote any args containing shell metacharacters. +ac_configure_args= +for ac_arg +do + case "$ac_arg" in + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) ;; + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) + ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args $ac_arg" ;; + esac +done + +# NLS nuisances. +# Only set these to C if already set. These must not be set unconditionally +# because not all systems understand e.g. LANG=C (notably SCO). +# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +# Non-C LC_CTYPE values break the ctype check. +if test "${LANG+set}" = set; then LANG=C; export LANG; fi +if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo > confdefs.h + +# A filename unique to this package, relative to the directory that +# configure is in, which we can look for to find out if srcdir is correct. +ac_unique_file=fitscore.c + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_prog=$0 + ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` + test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + else + { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + fi +fi +srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` + +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + echo "loading site script $ac_site_file" + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + echo "loading cache $cache_file" + . $cache_file +else + echo "creating cache $cache_file" + > $cache_file +fi + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +ac_exeext= +ac_objext=o +if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then + # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. + if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then + ac_n= ac_c=' +' ac_t=' ' + else + ac_n=-n ac_c= ac_t= + fi +else + ac_n= ac_c='\c' ac_t= +fi + + + +#-------------------------------------------------------------------- +# Check "uname" to determine system type +#-------------------------------------------------------------------- +# Extract the first word of "uname", so it can be a program name with args. +set dummy uname; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:532: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_uname_found'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$uname_found"; then + ac_cv_prog_uname_found="$uname_found" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_uname_found="1" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_uname_found" && ac_cv_prog_uname_found="0" +fi +fi +uname_found="$ac_cv_prog_uname_found" +if test -n "$uname_found"; then + echo "$ac_t""$uname_found" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +if test $uname_found -eq 0 ; then + echo "cfitsio: No uname found; setting system type to unknown." + system="unknown" +else + system=`uname -s`-`uname -r` +fi + + +# Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:570: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="gcc" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:600: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_prog_rejected=no + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + break + fi + done + IFS="$ac_save_ifs" +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# -gt 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + set dummy "$ac_dir/$ac_word" "$@" + shift + ac_cv_prog_CC="$@" + fi +fi +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + if test -z "$CC"; then + case "`uname -s`" in + *win32* | *WIN32*) + # Extract the first word of "cl", so it can be a program name with args. +set dummy cl; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:651: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="cl" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + ;; + esac + fi + test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } +fi + +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 +echo "configure:683: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +cat > conftest.$ac_ext << EOF + +#line 694 "configure" +#include "confdefs.h" + +main(){return(0);} +EOF +if { (eval echo configure:699: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + ac_cv_prog_cc_works=yes + # If we can't run a trivial program, we are probably using a cross compiler. + if (./conftest; exit) 2>/dev/null; then + ac_cv_prog_cc_cross=no + else + ac_cv_prog_cc_cross=yes + fi +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + ac_cv_prog_cc_works=no +fi +rm -fr conftest* +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 +if test $ac_cv_prog_cc_works = no; then + { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } +fi +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 +echo "configure:725: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 +cross_compiling=$ac_cv_prog_cc_cross + +echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 +echo "configure:730: checking whether we are using GNU C" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then + ac_cv_prog_gcc=yes +else + ac_cv_prog_gcc=no +fi +fi + +echo "$ac_t""$ac_cv_prog_gcc" 1>&6 + +if test $ac_cv_prog_gcc = yes; then + GCC=yes +else + GCC= +fi + +ac_test_CFLAGS="${CFLAGS+set}" +ac_save_CFLAGS="$CFLAGS" +CFLAGS= +echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 +echo "configure:758: checking whether ${CC-cc} accepts -g" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + echo 'void f(){}' > conftest.c +if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then + ac_cv_prog_cc_g=yes +else + ac_cv_prog_cc_g=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 +if test "$ac_test_CFLAGS" = set; then + CFLAGS="$ac_save_CFLAGS" +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi + + +for ac_prog in f77 xlf cf77 gf77 g77 af77 ncf f2c +do +# Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:795: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_FC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$FC"; then + ac_cv_prog_FC="$FC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_FC="$ac_prog" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +FC="$ac_cv_prog_FC" +if test -n "$FC"; then + echo "$ac_t""$FC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +test -n "$FC" && break +done +test -n "$FC" || FC="nope" + +if test $FC = 'nope' ; then + echo "configure: warning: cfitsio: == No acceptable f77 found in \$PATH" 1>&2 + echo "configure: warning: cfitsio: == Cfitsio will be built without Fortran wrapper support" 1>&2 + FC= + F77_WRAPPERS= +else + CFORTRANFLAGS= + F77_WRAPPERS="\${FITSIO_SRC}" + echo $ac_n "checking whether we are using GNU Fortran""... $ac_c" 1>&6 + if test `$FC --version -c < /dev/null 2> /dev/null | grep -c GNU` -gt 0 -o \ + `$FC --version -c < /dev/null 2> /dev/null | grep -ic egcs` -gt 0 + then + echo "$ac_t""yes" 1>&6 + echo $ac_n "cfitsio: == Adding wrapper support for GNU Fortran""... $ac_c" 1>&6 + CFORTRANFLAGS="-Dg77Fortran" + echo "$ac_t"" done" 1>&6 + else + echo "$ac_t""no" 1>&6 + if test $FC = 'f2c' ; then + echo $ac_n "cfitsio: == Adding wrapper support for f2c""... $ac_c" 1>&6 + CFORTRANFLAGS="-Df2cFortran" + echo "$ac_t"" done" 1>&6 + fi + fi +fi + +# Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:854: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_RANLIB="ranlib" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" +fi +fi +RANLIB="$ac_cv_prog_RANLIB" +if test -n "$RANLIB"; then + echo "$ac_t""$RANLIB" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + +echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 +echo "configure:883: checking how to run the C preprocessor" >&5 +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then +if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + # This must be in double quotes, not single quotes, because CPP may get + # substituted into the Makefile and "${CC-cc}" will confuse make. + CPP="${CC-cc} -E" + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:904: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -E -traditional-cpp" + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:921: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -nologo -E" + cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:938: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP=/lib/cpp +fi +rm -f conftest* +fi +rm -f conftest* +fi +rm -f conftest* + ac_cv_prog_CPP="$CPP" +fi + CPP="$ac_cv_prog_CPP" +else + ac_cv_prog_CPP="$CPP" +fi +echo "$ac_t""$CPP" 1>&6 + +for ac_hdr in stdlib.h string.h math.h limits.h +do +ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +echo "configure:966: checking for $ac_hdr" >&5 +if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:976: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + rm -rf conftest* + eval "ac_cv_header_$ac_safe=yes" +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_header_$ac_safe=no" +fi +rm -f conftest* +fi +if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then + echo "$ac_t""yes" 1>&6 + ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` + cat >> confdefs.h <&6 +ANSI_HEADER=no +fi +done + +cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + PROTO=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + PROTO=no +fi +rm -f conftest* +if test $ANSI_HEADER = no -o $PROTO = no; then + echo " *********** WARNING: CFITSIO CONFIGURE FAILURE ************ " + echo "cfitsio: ANSI C environment NOT found. Aborting cfitsio configure." + if test $ANSI_HEADER = no; then + echo "cfitsio: You're missing a needed ANSI header file." + fi + if test $PROTO = no; then + echo "cfitsio: Your compiler can't do ANSI function prototypes." + fi + echo "cfitsio: You need an ANSI C compiler and all ANSI trappings" + echo "cfitsio: to build cfitsio. " + echo " ******************************************************* " + exit 0; +fi + +CFLAGS="$CFLAGS" +LIBPRE="" + +case $system in + Darwin-*) + # Darwin can be powerpc or i386 + ARCH=`uname -p` + EXT="darwin" + CFLAGS="$CFLAGS -D_FILE_OFFSET_BITS=64" + ;; + SunOS-4*) + ARCH="sun" + EXT="sun" + ;; + HP-UX-*) + ARCH="hp" + EXT="hpu" + if test "x$CFORTRANFLAGS" = x ; then + CFORTRANFLAGS="-Dappendus" + fi + CFLAGS="$CFLAGS -DPG_PPU" + LIBPRE="-Wl," + ;; + SunOS-5*) + ARCH="solaris" + EXT="sol" + if test "x$CFORTRANFLAGS" = x ; then + CFORTRANFLAGS="-Dsolaris" + fi + ;; + OSF1*) + ARCH="alpha" + EXT="osf" + ;; + IRIX*) + ARCH="sgi" + EXT="sgi" + CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS" + RANLIB="touch" + ;; + ULTRIX*) + ARCH="dec" + EXT="dec" + ;; + Linux*) + ARCH="linux" + EXT="lnx" + ;; + FREEBSD*|FreeBSD*) + ARCH="linux" + EXT="lnx" + ;; + CYGWIN*) + ARCH="cygwin" + EXT="cygwin" + CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS" + ;; + *) + echo "cfitsio: == Don't know what do do with $system" + ;; +esac + +CFLAGS="$CFLAGS $CFORTRANFLAGS" + +case $CC in + gcc) + GCCVERSION="`gcc -v 2>&1 | grep version`" + echo "cfitsio: == Using $GCCVERSION" + + + if test `echo $GCCVERSION | grep -c 'version 2\.[45678]\.'` -gt 0 + then + CFLAGS=`echo $CFLAGS | sed 's:-O[^ ]* *::'` + echo "configure: warning: This gcc is pretty old. Disabling optimization to be safe." 1>&2 + fi + + ;; + cc) + echo "cfitsio: Old CFLAGS is $CFLAGS" + CFLAGS=`echo $CFLAGS | sed -e "s/-g/-O/"` + case $system in + SunOS-5*) + CFLAGS="$CFLAGS -DHAVE_ALLOCA_H -DHAVE_POSIX_SIGNALS" + ;; + *) + echo "== No special changes for $system" + ;; + esac + echo "New CFLAGS is $CFLAGS" + ;; + *) + # Don't do anything now + ;; +esac + +# Shared library section +#------------------------------------------------------------------------------- +SHLIB_LD=: +SHLIB_SUFFIX=".so" +lhea_shlib_cflags= +case $EXT in + darwin) + SHLIB_LD="cc -dynamiclib" + SHLIB_SUFFIX=".dylib" + lhea_shlib_cflags="-fPIC -fno-common" + ;; + hpu) + SHLIB_LD="ld -b" + SHLIB_SUFFIX=".sl" + ;; + lnx|cygwin) + SHLIB_LD=":" + ;; + osf) + SHLIB_LD="ld -shared -expect_unresolved '*'" + LD_FLAGS="-taso" + ;; + sol) + SHLIB_LD="/usr/ccs/bin/ld -G" + lhea_shlib_cflags="-KPIC" + ;; + sgi) + SHLIB_LD="ld -shared -rdata_shared" + ;; + *) + echo "configure: warning: Unable to determine how to make a shared library" 1>&2 + ;; +esac +# Darwin uses gcc (=cc), but needs different flags (see above) +# if test "x$GCC" = xyes; then +if test "x$GCC" = xyes && test "x$EXT" != xdarwin; then + SHLIB_LD="$CC -shared" + lhea_shlib_cflags='-fPIC' +fi +if test "x$lhea_shlib_cflags" != x; then + CFLAGS="$CFLAGS $lhea_shlib_cflags" +fi + + + +# ================= test for the unix ftruncate function ================ + +echo $ac_n "checking "whether ftruncate works"""... $ac_c" 1>&6 +echo "configure:1179: checking "whether ftruncate works"" >&5 +cat > conftest.$ac_ext < + +int main() { + +ftruncate(0, 0); + +; return 0; } +EOF +if { (eval echo configure:1191: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + +cat >> confdefs.h <<\EOF +#define HAVE_FTRUNCATE 1 +EOF + +echo "$ac_t"""yes"" 1>&6 + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t"""no"" 1>&6 +fi +rm -f conftest* + +# --------------------------------------------------------- +# some systems define long long for 64-bit ints +# --------------------------------------------------------- + +echo $ac_n "checking "whether long long is defined"""... $ac_c" 1>&6 +echo "configure:1213: checking "whether long long is defined"" >&5 +cat > conftest.$ac_ext < + +int main() { + +long long filler; + +; return 0; } +EOF +if { (eval echo configure:1225: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + +cat >> confdefs.h <<\EOF +#define HAVE_LONGLONG 1 +EOF + +echo "$ac_t"""yes"" 1>&6 + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t"""no"" 1>&6 +fi +rm -f conftest* + +# ==================== SHARED MEMORY DRIVER SECTION ======================= +# +# 09-Mar-98 : modified by JB/ISDC +# 3 checks added to support autoconfiguration of shared memory +# driver. First generic check is made whether shared memory is supported +# at all, then 2 more specific checks are made (architecture dependent). +# Currently tested on : sparc-solaris, intel-linux, sgi-irix, dec-alpha-osf + +# ------------------------------------------------------------------------- +# check is System V IPC is supported on this machine +# ------------------------------------------------------------------------- + +echo $ac_n "checking "whether system V style IPC services are supported"""... $ac_c" 1>&6 +echo "configure:1255: checking "whether system V style IPC services are supported"" >&5 +cat > conftest.$ac_ext < +#include +#include + +int main() { + +shmat(0, 0, 0); +shmdt(0); +shmget(0, 0, 0); +semget(0, 0, 0); + +; return 0; } +EOF +if { (eval echo configure:1272: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + +cat >> confdefs.h <<\EOF +#define HAVE_SHMEM_SERVICES 1 +EOF + +my_shmem=\${SOURCES_SHMEM} +echo "$ac_t"""yes"" 1>&6 + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t"""no"" 1>&6 +fi +rm -f conftest* + + + +# ------------------------------------------------------------------------- +# some systems define flock_t, for others we have to define it ourselves +# ------------------------------------------------------------------------- + +echo $ac_n "checking "do we have flock_t defined"""... $ac_c" 1>&6 +echo "configure:1297: checking "do we have flock_t defined"" >&5 +cat > conftest.$ac_ext < + +int main() { + +flock_t filler; + +; return 0; } +EOF +if { (eval echo configure:1309: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + +cat >> confdefs.h <<\EOF +#define HAVE_FLOCK_T 1 +EOF + +echo "$ac_t"""yes"" 1>&6 + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t"""no"" 1>&6 +fi +rm -f conftest* + + +# ------------------------------------------------------------------------- +# there are some idiosyncrasies with semun defs (used in semxxx). Solaris +# does not define it at all +# ------------------------------------------------------------------------- + +echo $ac_n "checking "do we have union semun defined"""... $ac_c" 1>&6 +echo "configure:1333: checking "do we have union semun defined"" >&5 +cat > conftest.$ac_ext < +#include +#include + +int main() { + +union semun filler; + +; return 0; } +EOF +if { (eval echo configure:1347: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + +cat >> confdefs.h <<\EOF +#define HAVE_UNION_SEMUN 1 +EOF + +echo "$ac_t"""yes"" 1>&6 + +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + echo "$ac_t"""no"" 1>&6 +fi +rm -f conftest* + +# ==================== END OF SHARED MEMORY DRIVER SECTION ================ +# ================= test for the unix networking functions ================ + +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- +cfitsio_checkBoth=0 +echo $ac_n "checking for connect""... $ac_c" 1>&6 +echo "configure:1386: checking for connect" >&5 +if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char connect(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_connect) || defined (__stub___connect) +choke me +#else +connect(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1414: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_connect=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_connect=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cfitsio_checkSocket=0 +else + echo "$ac_t""no" 1>&6 +cfitsio_checkSocket=1 +fi + +if test "$cfitsio_checkSocket" = 1; then + echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6 +echo "configure:1436: checking for main in -lsocket" >&5 +ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lsocket $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + LIBS="$LIBS -lsocket" +else + echo "$ac_t""no" 1>&6 +cfitsio_checkBoth=1 +fi + +fi +if test "$cfitsio_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + echo $ac_n "checking for accept""... $ac_c" 1>&6 +echo "configure:1477: checking for accept" >&5 +if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char accept(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_accept) || defined (__stub___accept) +choke me +#else +accept(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1505: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_accept=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_accept=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cfitsio_checkNsl=0 +else + echo "$ac_t""no" 1>&6 +LIBS=$tk_oldLibs +fi + +fi +echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 +echo "configure:1527: checking for gethostbyname" >&5 +if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char gethostbyname(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) +choke me +#else +gethostbyname(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1555: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_gethostbyname=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_gethostbyname=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6 +echo "configure:1573: checking for main in -lnsl" >&5 +ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lnsl $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + LIBS="$LIBS -lnsl" +else + echo "$ac_t""no" 1>&6 +fi + +fi + + +cat >> confdefs.h <<\EOF +#define HAVE_NET_SERVICES 1 +EOF + + +# ==================== END OF unix networking SECTION ================ + + +trap '' 1 2 15 +cat > confcache <<\EOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs. It is not useful on other systems. +# If it contains results you don't want to keep, you may remove or edit it. +# +# By default, configure uses ./config.cache as the cache file, +# creating it if it does not exist already. You can give configure +# the --cache-file=FILE option to use a different cache file; that is +# what configure does when it calls configure scripts in +# subdirectories, so they share the cache. +# Giving --cache-file=/dev/null disables caching, for debugging configure. +# config.status only pays attention to the cache file if you give it the +# --recheck option to rerun configure. +# +EOF +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +(set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote substitution + # turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + -e "s/'/'\\\\''/g" \ + -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' + ;; + esac >> confcache +if cmp -s $cache_file confcache; then + : +else + if test -w $cache_file; then + echo "updating cache $cache_file" + cat confcache > $cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Any assignment to VPATH causes Sun make to only execute +# the first set of double-colon rules, so remove it if not needed. +# If there is a colon in the path, we need to keep it. +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' +fi + +trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +cat > conftest.defs <<\EOF +s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g +s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g +s%\[%\\&%g +s%\]%\\&%g +s%\$%$$%g +EOF +DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` +rm -f conftest.defs + + +# Without the "./", some shells look in PATH for config.status. +: ${CONFIG_STATUS=./config.status} + +echo creating $CONFIG_STATUS +rm -f $CONFIG_STATUS +cat > $CONFIG_STATUS </dev/null | sed 1q`: +# +# $0 $ac_configure_args +# +# Compiler output produced by configure, useful for debugging +# configure, is in ./config.log if it exists. + +ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" +for ac_option +do + case "\$ac_option" in + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" + exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; + -version | --version | --versio | --versi | --vers | --ver | --ve | --v) + echo "$CONFIG_STATUS generated by autoconf version 2.13" + exit 0 ;; + -help | --help | --hel | --he | --h) + echo "\$ac_cs_usage"; exit 0 ;; + *) echo "\$ac_cs_usage"; exit 1 ;; + esac +done + +ac_given_srcdir=$srcdir + +trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +EOF +cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF +$ac_vpsub +$extrasub +s%@SHELL@%$SHELL%g +s%@CFLAGS@%$CFLAGS%g +s%@CPPFLAGS@%$CPPFLAGS%g +s%@CXXFLAGS@%$CXXFLAGS%g +s%@FFLAGS@%$FFLAGS%g +s%@DEFS@%$DEFS%g +s%@LDFLAGS@%$LDFLAGS%g +s%@LIBS@%$LIBS%g +s%@exec_prefix@%$exec_prefix%g +s%@prefix@%$prefix%g +s%@program_transform_name@%$program_transform_name%g +s%@bindir@%$bindir%g +s%@sbindir@%$sbindir%g +s%@libexecdir@%$libexecdir%g +s%@datadir@%$datadir%g +s%@sysconfdir@%$sysconfdir%g +s%@sharedstatedir@%$sharedstatedir%g +s%@localstatedir@%$localstatedir%g +s%@libdir@%$libdir%g +s%@includedir@%$includedir%g +s%@oldincludedir@%$oldincludedir%g +s%@infodir@%$infodir%g +s%@mandir@%$mandir%g +s%@uname_found@%$uname_found%g +s%@CC@%$CC%g +s%@FC@%$FC%g +s%@RANLIB@%$RANLIB%g +s%@CPP@%$CPP%g +s%@GCCVERSION@%$GCCVERSION%g +s%@ARCH@%$ARCH%g +s%@LIBPRE@%$LIBPRE%g +s%@SHLIB_LD@%$SHLIB_LD%g +s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g +s%@F77_WRAPPERS@%$F77_WRAPPERS%g +s%@my_shmem@%$my_shmem%g + +CEOF +EOF + +cat >> $CONFIG_STATUS <<\EOF + +# Split the substitutions into bite-sized pieces for seds with +# small command number limits, like on Digital OSF/1 and HP-UX. +ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. +ac_file=1 # Number of current file. +ac_beg=1 # First line for current file. +ac_end=$ac_max_sed_cmds # Line after last line for current file. +ac_more_lines=: +ac_sed_cmds="" +while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file + else + sed "${ac_end}q" conftest.subs > conftest.s$ac_file + fi + if test ! -s conftest.s$ac_file; then + ac_more_lines=false + rm -f conftest.s$ac_file + else + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f conftest.s$ac_file" + else + ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" + fi + ac_file=`expr $ac_file + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_cmds` + fi +done +if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat +fi +EOF + +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case "$ac_file" in + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` + ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; + *) ac_file_in="${ac_file}.in" ;; + esac + + # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + + # Remove last slash and all that follows it. Not all systems have dirname. + ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` + if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then + # The file is in a subdirectory. + test ! -d "$ac_dir" && mkdir "$ac_dir" + ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" + # A "../" for each directory in $ac_dir_suffix. + ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` + else + ac_dir_suffix= ac_dots= + fi + + case "$ac_given_srcdir" in + .) srcdir=. + if test -z "$ac_dots"; then top_srcdir=. + else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; + /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; + *) # Relative path. + srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" + top_srcdir="$ac_dots$ac_given_srcdir" ;; + esac + + + echo creating "$ac_file" + rm -f "$ac_file" + configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." + case "$ac_file" in + *Makefile*) ac_comsub="1i\\ +# $configure_input" ;; + *) ac_comsub= ;; + esac + + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + sed -e "$ac_comsub +s%@configure_input@%$configure_input%g +s%@srcdir@%$srcdir%g +s%@top_srcdir@%$top_srcdir%g +" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file +fi; done +rm -f conftest.s* + +EOF +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF + +exit 0 +EOF +chmod +x $CONFIG_STATUS +rm -fr confdefs* $ac_clean_files +test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 + + +echo "$ac_t""" 1>&6 +echo "$ac_t"" Congratulations, Makefile update was successful." 1>&6 +echo "$ac_t"" You may want to run \"make\" now." 1>&6 +echo "$ac_t""" 1>&6 + diff --git a/pkg/tbtables/cfitsio/configure.in b/pkg/tbtables/cfitsio/configure.in new file mode 100644 index 00000000..5bbd92dc --- /dev/null +++ b/pkg/tbtables/cfitsio/configure.in @@ -0,0 +1,352 @@ +# +# configure.in for cfitsio +# +# /redshift/sgi6/lheavc/ftools/cfitsio/configure.in,v 3.4 1996/07/26 20:27:53 pence Exp +# +# copied from host and modified +# + +dnl Process this file with autoconf to produce a configure script. +AC_INIT(fitscore.c) + +#-------------------------------------------------------------------- +# Check "uname" to determine system type +#-------------------------------------------------------------------- +AC_PROGRAM_CHECK(uname_found, uname, 1, 0) +if test $uname_found -eq 0 ; then + echo "cfitsio: No uname found; setting system type to unknown." + system="unknown" +else + system=`uname -s`-`uname -r` +fi + + +dnl Checks for programs. +AC_PROG_CC + +AC_CHECK_PROGS(FC, f77 xlf cf77 gf77 g77 af77 ncf f2c , nope) +if test $FC = 'nope' ; then + AC_MSG_WARN(cfitsio: == No acceptable f77 found in \$PATH) + AC_MSG_WARN(cfitsio: == Cfitsio will be built without Fortran wrapper support) + FC= + F77_WRAPPERS= +else + CFORTRANFLAGS= + F77_WRAPPERS="\${FITSIO_SRC}" + echo $ac_n "checking whether we are using GNU Fortran""... $ac_c" 1>&6 + if test `$FC --version -c < /dev/null 2> /dev/null | grep -c GNU` -gt 0 -o \ + `$FC --version -c < /dev/null 2> /dev/null | grep -ic egcs` -gt 0 + then + echo "$ac_t""yes" 1>&6 + echo $ac_n "cfitsio: == Adding wrapper support for GNU Fortran""... $ac_c" 1>&6 + CFORTRANFLAGS="-Dg77Fortran" + echo "$ac_t"" done" 1>&6 + else + echo "$ac_t""no" 1>&6 + if test $FC = 'f2c' ; then + echo $ac_n "cfitsio: == Adding wrapper support for f2c""... $ac_c" 1>&6 + CFORTRANFLAGS="-Df2cFortran" + echo "$ac_t"" done" 1>&6 + fi + fi +fi + +AC_PROG_RANLIB + +dnl Checks for ANSI stdlib.h. +AC_CHECK_HEADERS(stdlib.h string.h math.h limits.h ,ANSI_HEADER=yes,ANSI_HEADER=no)dnl + +dnl Check if prototyping is allowed. +AC_TRY_COMPILE( , void d( int , double) , PROTO=yes, PROTO=no)dnl + +if test $ANSI_HEADER = no -o $PROTO = no; then + echo " *********** WARNING: CFITSIO CONFIGURE FAILURE ************ " + echo "cfitsio: ANSI C environment NOT found. Aborting cfitsio configure." + if test $ANSI_HEADER = no; then + echo "cfitsio: You're missing a needed ANSI header file." + fi + if test $PROTO = no; then + echo "cfitsio: Your compiler can't do ANSI function prototypes." + fi + echo "cfitsio: You need an ANSI C compiler and all ANSI trappings" + echo "cfitsio: to build cfitsio. " + echo " ******************************************************* " + exit 0; +fi + +CFLAGS="$CFLAGS" +LIBPRE="" + +case $system in + Darwin-*) + # Darwin can be powerpc or i386 + ARCH=`uname -p` + EXT="darwin" + CFLAGS="$CFLAGS -D_FILE_OFFSET_BITS=64" + ;; + SunOS-4*) + ARCH="sun" + EXT="sun" + ;; + HP-UX-*) + ARCH="hp" + EXT="hpu" + if test "x$CFORTRANFLAGS" = x ; then + CFORTRANFLAGS="-Dappendus" + fi + CFLAGS="$CFLAGS -DPG_PPU" + LIBPRE="-Wl," + ;; + SunOS-5*) + ARCH="solaris" + EXT="sol" + if test "x$CFORTRANFLAGS" = x ; then + CFORTRANFLAGS="-Dsolaris" + fi + ;; + OSF1*) + ARCH="alpha" + EXT="osf" + ;; + IRIX*) + ARCH="sgi" + EXT="sgi" + CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS" + RANLIB="touch" + ;; + ULTRIX*) + ARCH="dec" + EXT="dec" + ;; + Linux*) + ARCH="linux" + EXT="lnx" + ;; + FREEBSD*|FreeBSD*) + ARCH="linux" + EXT="lnx" + ;; + CYGWIN*) + ARCH="cygwin" + EXT="cygwin" + CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS" + ;; + *) + echo "cfitsio: == Don't know what do do with $system" + ;; +esac + +CFLAGS="$CFLAGS $CFORTRANFLAGS" + +case $CC in + gcc) + GCCVERSION="`gcc -v 2>&1 | grep version`" + echo "cfitsio: == Using $GCCVERSION" + AC_SUBST(GCCVERSION) + changequote(,) + if test `echo $GCCVERSION | grep -c 'version 2\.[45678]\.'` -gt 0 + then + CFLAGS=`echo $CFLAGS | sed 's:-O[^ ]* *::'` + AC_MSG_WARN(This gcc is pretty old. Disabling optimization to be safe.) + fi + changequote([,]) + ;; + cc) + echo "cfitsio: Old CFLAGS is $CFLAGS" + CFLAGS=`echo $CFLAGS | sed -e "s/-g/-O/"` + case $system in + SunOS-5*) + CFLAGS="$CFLAGS -DHAVE_ALLOCA_H -DHAVE_POSIX_SIGNALS" + ;; + *) + echo "== No special changes for $system" + ;; + esac + echo "New CFLAGS is $CFLAGS" + ;; + *) + # Don't do anything now + ;; +esac + +# Shared library section +#------------------------------------------------------------------------------- +SHLIB_LD=: +SHLIB_SUFFIX=".so" +lhea_shlib_cflags= +case $EXT in + darwin) + SHLIB_LD="cc -dynamiclib" + SHLIB_SUFFIX=".dylib" + lhea_shlib_cflags="-fPIC -fno-common" + ;; + hpu) + SHLIB_LD="ld -b" + SHLIB_SUFFIX=".sl" + ;; + lnx|cygwin) + SHLIB_LD=":" + ;; + osf) + SHLIB_LD="ld -shared -expect_unresolved '*'" + LD_FLAGS="-taso" + ;; + sol) + SHLIB_LD="/usr/ccs/bin/ld -G" + lhea_shlib_cflags="-KPIC" + ;; + sgi) + SHLIB_LD="ld -shared -rdata_shared" + ;; + *) + AC_MSG_WARN(Unable to determine how to make a shared library) + ;; +esac +# Darwin uses gcc (=cc), but needs different flags (see above) +# if test "x$GCC" = xyes; then +if test "x$GCC" = xyes && test "x$EXT" != xdarwin; then + SHLIB_LD="$CC -shared" + lhea_shlib_cflags='-fPIC' +fi +if test "x$lhea_shlib_cflags" != x; then + CFLAGS="$CFLAGS $lhea_shlib_cflags" +fi + +AC_SUBST(ARCH)dnl +AC_SUBST(CFLAGS)dnl +AC_SUBST(CC)dnl +AC_SUBST(FC)dnl +AC_SUBST(LIBPRE)dnl +AC_SUBST(SHLIB_LD)dnl +AC_SUBST(SHLIB_SUFFIX)dnl +AC_SUBST(F77_WRAPPERS) + +# ================= test for the unix ftruncate function ================ + +AC_MSG_CHECKING("whether ftruncate works") +AC_TRY_LINK([#include +], [ +ftruncate(0, 0); +], [ +AC_DEFINE(HAVE_FTRUNCATE) +AC_MSG_RESULT("yes") +], AC_MSG_RESULT("no") ) + +# --------------------------------------------------------- +# some systems define long long for 64-bit ints +# --------------------------------------------------------- + +AC_MSG_CHECKING("whether long long is defined") +AC_TRY_COMPILE([#include +], [ +long long filler; +], [ +AC_DEFINE(HAVE_LONGLONG) +AC_MSG_RESULT("yes") +], AC_MSG_RESULT("no") ) + +# ==================== SHARED MEMORY DRIVER SECTION ======================= +# +# 09-Mar-98 : modified by JB/ISDC +# 3 checks added to support autoconfiguration of shared memory +# driver. First generic check is made whether shared memory is supported +# at all, then 2 more specific checks are made (architecture dependent). +# Currently tested on : sparc-solaris, intel-linux, sgi-irix, dec-alpha-osf + +# ------------------------------------------------------------------------- +# check is System V IPC is supported on this machine +# ------------------------------------------------------------------------- + +AC_MSG_CHECKING("whether system V style IPC services are supported") +AC_TRY_LINK([#include +#include +#include +], [ +shmat(0, 0, 0); +shmdt(0); +shmget(0, 0, 0); +semget(0, 0, 0); +], [ +AC_DEFINE(HAVE_SHMEM_SERVICES) +my_shmem=\${SOURCES_SHMEM} +AC_MSG_RESULT("yes") +], AC_MSG_RESULT("no") ) + +AC_SUBST(my_shmem) + +# ------------------------------------------------------------------------- +# some systems define flock_t, for others we have to define it ourselves +# ------------------------------------------------------------------------- + +AC_MSG_CHECKING("do we have flock_t defined") +AC_TRY_COMPILE([#include +], [ +flock_t filler; +], [ +AC_DEFINE(HAVE_FLOCK_T) +AC_MSG_RESULT("yes") +], AC_MSG_RESULT("no") ) + + +# ------------------------------------------------------------------------- +# there are some idiosyncrasies with semun defs (used in semxxx). Solaris +# does not define it at all +# ------------------------------------------------------------------------- + +AC_MSG_CHECKING("do we have union semun defined") +AC_TRY_COMPILE( +[#include +#include +#include +], [ +union semun filler; +], [ +AC_DEFINE(HAVE_UNION_SEMUN) +AC_MSG_RESULT("yes") +], AC_MSG_RESULT("no") ) + +# ==================== END OF SHARED MEMORY DRIVER SECTION ================ +# ================= test for the unix networking functions ================ + +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- +cfitsio_checkBoth=0 +AC_CHECK_FUNC(connect, cfitsio_checkSocket=0, cfitsio_checkSocket=1) +if test "$cfitsio_checkSocket" = 1; then + AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", cfitsio_checkBoth=1) +fi +if test "$cfitsio_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + AC_CHECK_FUNC(accept, cfitsio_checkNsl=0, [LIBS=$tk_oldLibs]) +fi +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) + +AC_DEFINE(HAVE_NET_SERVICES) + +# ==================== END OF unix networking SECTION ================ + + +AC_OUTPUT(Makefile)dnl + + +AC_MSG_RESULT([]) +AC_MSG_RESULT([ Congratulations, Makefile update was successful.]) +AC_MSG_RESULT([ You may want to run \"make\" now.]) +AC_MSG_RESULT([]) + diff --git a/pkg/tbtables/cfitsio/cookbook.c b/pkg/tbtables/cfitsio/cookbook.c new file mode 100644 index 00000000..3b42ac61 --- /dev/null +++ b/pkg/tbtables/cfitsio/cookbook.c @@ -0,0 +1,571 @@ +#include +#include +#include + +/* + Every program which uses the CFITSIO interface must include the + the fitsio.h header file. This contains the prototypes for all + the routines and defines the error status values and other symbolic + constants used in the interface. +*/ +#include "fitsio.h" + +int main( void ); +void writeimage( void ); +void writeascii( void ); +void writebintable( void ); +void copyhdu( void ); +void selectrows( void ); +void readheader( void ); +void readimage( void ); +void readtable( void ); +void printerror( int status); + +int main() +{ +/************************************************************************* + This is a simple main program that calls the following routines: + + writeimage - write a FITS primary array image + writeascii - write a FITS ASCII table extension + writebintable - write a FITS binary table extension + copyhdu - copy a header/data unit from one FITS file to another + selectrows - copy selected row from one HDU to another + readheader - read and print the header keywords in every extension + readimage - read a FITS image and compute the min and max value + readtable - read columns of data from ASCII and binary tables + +**************************************************************************/ + + writeimage(); + writeascii(); + writebintable(); + copyhdu(); + selectrows(); + readheader(); + readimage(); + readtable(); + + printf("\nAll the cfitsio cookbook routines ran successfully.\n"); + return(0); +} +/*--------------------------------------------------------------------------*/ +void writeimage( void ) + + /******************************************************/ + /* Create a FITS primary array containing a 2-D image */ + /******************************************************/ +{ + fitsfile *fptr; /* pointer to the FITS file, defined in fitsio.h */ + int status, ii, jj; + long fpixel, nelements, exposure; + unsigned short *array[200]; + + /* initialize FITS image parameters */ + char filename[] = "atestfil.fit"; /* name for new FITS file */ + int bitpix = USHORT_IMG; /* 16-bit unsigned short pixel values */ + long naxis = 2; /* 2-dimensional image */ + long naxes[2] = { 300, 200 }; /* image is 300 pixels wide by 200 rows */ + + /* allocate memory for the whole image */ + array[0] = (unsigned short *)malloc( naxes[0] * naxes[1] + * sizeof( unsigned short ) ); + + /* initialize pointers to the start of each row of the image */ + for( ii=1; ii 0) + { + nbuffer = npixels; + if (npixels > buffsize) + nbuffer = buffsize; /* read as many pixels as will fit in buffer */ + + /* Note that even though the FITS images contains unsigned integer */ + /* pixel values (or more accurately, signed integer pixels with */ + /* a bias of 32768), this routine is reading the values into a */ + /* float array. Cfitsio automatically performs the datatype */ + /* conversion in cases like this. */ + + if ( fits_read_img(fptr, TFLOAT, fpixel, nbuffer, &nullval, + buffer, &anynull, &status) ) + printerror( status ); + + for (ii = 0; ii < nbuffer; ii++) { + if ( buffer[ii] < datamin ) + datamin = buffer[ii]; + + if ( buffer[ii] > datamax ) + datamax = buffer[ii]; + } + npixels -= nbuffer; /* increment remaining number of pixels */ + fpixel += nbuffer; /* next pixel to be read in image */ + } + + printf("\nMin and max image pixels = %.0f, %.0f\n", datamin, datamax); + + if ( fits_close_file(fptr, &status) ) + printerror( status ); + + return; +} +/*--------------------------------------------------------------------------*/ +void readtable( void ) + + /************************************************************/ + /* read and print data values from an ASCII or binary table */ + /************************************************************/ +{ + fitsfile *fptr; /* pointer to the FITS file, defined in fitsio.h */ + int status, hdunum, hdutype, nfound, anynull, ii; + long frow, felem, nelem, longnull, dia[6]; + float floatnull, den[6]; + char strnull[10], *name[6], *ttype[3]; + + char filename[] = "atestfil.fit"; /* name of existing FITS file */ + + status = 0; + + if ( fits_open_file(&fptr, filename, READONLY, &status) ) + printerror( status ); + + for (ii = 0; ii < 3; ii++) /* allocate space for the column labels */ + ttype[ii] = (char *) malloc(FLEN_VALUE); /* max label length = 69 */ + + for (ii = 0; ii < 6; ii++) /* allocate space for string column value */ + name[ii] = (char *) malloc(10); + + for (hdunum = 2; hdunum <= 3; hdunum++) /*read ASCII, then binary table */ + { + /* move to the HDU */ + if ( fits_movabs_hdu(fptr, hdunum, &hdutype, &status) ) + printerror( status ); + + if (hdutype == ASCII_TBL) + printf("\nReading ASCII table in HDU %d:\n", hdunum); + else if (hdutype == BINARY_TBL) + printf("\nReading binary table in HDU %d:\n", hdunum); + else + { + printf("Error: this HDU is not an ASCII or binary table\n"); + printerror( status ); + } + + /* read the column names from the TTYPEn keywords */ + fits_read_keys_str(fptr, "TTYPE", 1, 3, ttype, &nfound, &status); + + printf(" Row %10s %10s %10s\n", ttype[0], ttype[1], ttype[2]); + + frow = 1; + felem = 1; + nelem = 6; + strcpy(strnull, " "); + longnull = 0; + floatnull = 0.; + + /* read the columns */ + fits_read_col(fptr, TSTRING, 1, frow, felem, nelem, strnull, name, + &anynull, &status); + fits_read_col(fptr, TLONG, 2, frow, felem, nelem, &longnull, dia, + &anynull, &status); + fits_read_col(fptr, TFLOAT, 3, frow, felem, nelem, &floatnull, den, + &anynull, &status); + + for (ii = 0; ii < 6; ii++) + printf("%5d %10s %10ld %10.2f\n", ii + 1, name[ii], dia[ii], den[ii]); + } + + for (ii = 0; ii < 3; ii++) /* free the memory for the column labels */ + free( ttype[ii] ); + + for (ii = 0; ii < 6; ii++) /* free the memory for the string column */ + free( name[ii] ); + + if ( fits_close_file(fptr, &status) ) + printerror( status ); + + return; +} +/*--------------------------------------------------------------------------*/ +void printerror( int status) +{ + /*****************************************************/ + /* Print out cfitsio error messages and exit program */ + /*****************************************************/ + + + if (status) + { + fits_report_error(stderr, status); /* print error report */ + + exit( status ); /* terminate the program, returning error status */ + } + return; +} diff --git a/pkg/tbtables/cfitsio/cookbook.f b/pkg/tbtables/cfitsio/cookbook.f new file mode 100644 index 00000000..8becfdd2 --- /dev/null +++ b/pkg/tbtables/cfitsio/cookbook.f @@ -0,0 +1,772 @@ + program main + +C This is the FITSIO cookbook program that contains an annotated listing of +C various computer programs that read and write files in FITS format +C using the FITSIO subroutine interface. These examples are +C working programs which users may adapt and modify for their own +C purposes. This Cookbook serves as a companion to the FITSIO User's +C Guide that provides more complete documentation on all the +C available FITSIO subroutines. + +C Call each subroutine in turn: + + call writeimage + call writeascii + call writebintable + call copyhdu + call selectrows + call readheader + call readimage + call readtable + print * + print *,"All the fitsio cookbook routines ran successfully." + + end +C ************************************************************************* + subroutine writeimage + +C Create a FITS primary array containing a 2-D image + + integer status,unit,blocksize,bitpix,naxis,naxes(2) + integer i,j,group,fpixel,nelements,array(300,200) + character filename*80 + logical simple,extend + +C The STATUS parameter must be initialized before using FITSIO. A +C positive value of STATUS is returned whenever a serious error occurs. +C FITSIO uses an `inherited status' convention, which means that if a +C subroutine is called with a positive input value of STATUS, then the +C subroutine will exit immediately, preserving the status value. For +C simplicity, this program only checks the status value at the end of +C the program, but it is usually better practice to check the status +C value more frequently. + + status=0 + +C Name of the FITS file to be created: + filename='ATESTFILEZ.FITS' + +C Delete the file if it already exists, so we can then recreate it. +C The deletefile subroutine is listed at the end of this file. + call deletefile(filename,status) + +C Get an unused Logical Unit Number to use to open the FITS file. +C This routine is not required; programmers can choose any unused +C unit number to open the file. + call ftgiou(unit,status) + +C Create the new empty FITS file. The blocksize parameter is a +C historical artifact and the value is ignored by FITSIO. + blocksize=1 + call ftinit(unit,filename,blocksize,status) + +C Initialize parameters about the FITS image. +C BITPIX = 16 means that the image pixels will consist of 16-bit +C integers. The size of the image is given by the NAXES values. +C The EXTEND = TRUE parameter indicates that the FITS file +C may contain extensions following the primary array. + simple=.true. + bitpix=16 + naxis=2 + naxes(1)=300 + naxes(2)=200 + extend=.true. + +C Write the required header keywords to the file + call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status) + +C Initialize the values in the image with a linear ramp function + do j=1,naxes(2) + do i=1,naxes(1) + array(i,j)=i - 1 +j - 1 + end do + end do + +C Write the array to the FITS file. +C The last letter of the subroutine name defines the datatype of the +C array argument; in this case the 'J' indicates that the array has an +C integer*4 datatype. ('I' = I*2, 'E' = Real*4, 'D' = Real*8). +C The 2D array is treated as a single 1-D array with NAXIS1 * NAXIS2 +C total number of pixels. GROUP is seldom used parameter that should +C almost always be set = 1. + group=1 + fpixel=1 + nelements=naxes(1)*naxes(2) + call ftpprj(unit,group,fpixel,nelements,array,status) + +C Write another optional keyword to the header +C The keyword record will look like this in the FITS file: +C +C EXPOSURE= 1500 / Total Exposure Time +C + call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status) + +C The FITS file must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(unit, status) + call ftfiou(unit, status) + +C Check for any errors, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine writeascii + +C Create an ASCII table containing 3 columns and 6 rows. For convenience, +C the ASCII table extension is appended to the FITS image file created +C previously by the WRITEIMAGE subroutine. + + integer status,unit,readwrite,blocksize,tfields,nrows,rowlen + integer nspace,tbcol(3),diameter(6), colnum,frow,felem + real density(6) + character filename*40,extname*16 + character*16 ttype(3),tform(3),tunit(3),name(6) + data ttype/'Planet','Diameter','Density'/ + data tform/'A8','I6','F4.2'/ + data tunit/' ','km','g/cm'/ + data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/ + data diameter/4880,12112,12742,6800,143000,121000/ + data density/5.1,5.3,5.52,3.94,1.33,0.69/ + +C The STATUS parameter must always be initialized. + status=0 + +C Name of the FITS file to append the ASCII table to: + filename='ATESTFILEZ.FITS' + +C Get an unused Logical Unit Number to use to open the FITS file. + call ftgiou(unit,status) + +C Open the FITS file with write access. +C (readwrite = 0 would open the file with readonly access). + readwrite=1 + call ftopen(unit,filename,readwrite,blocksize,status) + +C FTCRHD creates a new empty FITS extension following the current +C extension and moves to it. In this case, FITSIO was initially +C positioned on the primary array when the FITS file was first opened, so +C FTCRHD appends an empty extension and moves to it. All future FITSIO +C calls then operate on the new extension (which will be an ASCII +C table). + call ftcrhd(unit,status) + +C define parameters for the ASCII table (see the above data statements) + tfields=3 + nrows=6 + extname='PLANETS_ASCII' + +C FTGABC is a convenient subroutine for calculating the total width of +C the table and the starting position of each column in an ASCII table. +C Any number of blank spaces (including zero) may be inserted between +C each column of the table, as specified by the NSPACE parameter. + nspace=1 + call ftgabc(tfields,tform,nspace,rowlen,tbcol,status) + +C FTPHTB writes all the required header keywords which define the +C structure of the ASCII table. NROWS and TFIELDS give the number of +C rows and columns in the table, and the TTYPE, TBCOL, TFORM, and TUNIT +C arrays give the column name, starting position, format, and units, +C respectively of each column. The values of the ROWLEN and TBCOL parameters +C were previously calculated by the FTGABC routine. + call ftphtb(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit, + & extname,status) + +C Write names to the first column, diameters to 2nd col., and density to 3rd +C FTPCLS writes the string values to the NAME column (column 1) of the +C table. The FTPCLJ and FTPCLE routines write the diameter (integer) and +C density (real) value to the 2nd and 3rd columns. The FITSIO routines +C are column oriented, so it is usually easier to read or write data in a +C table in a column by column order rather than row by row. + frow=1 + felem=1 + colnum=1 + call ftpcls(unit,colnum,frow,felem,nrows,name,status) + colnum=2 + call ftpclj(unit,colnum,frow,felem,nrows,diameter,status) + colnum=3 + call ftpcle(unit,colnum,frow,felem,nrows,density,status) + +C The FITS file must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(unit, status) + call ftfiou(unit, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine writebintable + +C This routine creates a FITS binary table, or BINTABLE, containing +C 3 columns and 6 rows. This routine is nearly identical to the +C previous WRITEASCII routine, except that the call to FTGABC is not +C needed, and FTPHBN is called rather than FTPHTB to write the +C required header keywords. + + integer status,unit,readwrite,blocksize,hdutype,tfields,nrows + integer varidat,diameter(6), colnum,frow,felem + real density(6) + character filename*40,extname*16 + character*16 ttype(3),tform(3),tunit(3),name(6) + data ttype/'Planet','Diameter','Density'/ + data tform/'8A','1J','1E'/ + data tunit/' ','km','g/cm'/ + data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/ + data diameter/4880,12112,12742,6800,143000,121000/ + data density/5.1,5.3,5.52,3.94,1.33,0.69/ + +C The STATUS parameter must always be initialized. + status=0 + +C Name of the FITS file to append the ASCII table to: + filename='ATESTFILEZ.FITS' + +C Get an unused Logical Unit Number to use to open the FITS file. + call ftgiou(unit,status) + +C Open the FITS file, with write access. + readwrite=1 + call ftopen(unit,filename,readwrite,blocksize,status) + +C Move to the last (2nd) HDU in the file (the ASCII table). + call ftmahd(unit,2,hdutype,status) + +C Append/create a new empty HDU onto the end of the file and move to it. + call ftcrhd(unit,status) + +C Define parameters for the binary table (see the above data statements) + tfields=3 + nrows=6 + extname='PLANETS_BINARY' + varidat=0 + +C FTPHBN writes all the required header keywords which define the +C structure of the binary table. NROWS and TFIELDS gives the number of +C rows and columns in the table, and the TTYPE, TFORM, and TUNIT arrays +C give the column name, format, and units, respectively of each column. + call ftphbn(unit,nrows,tfields,ttype,tform,tunit, + & extname,varidat,status) + +C Write names to the first column, diameters to 2nd col., and density to 3rd +C FTPCLS writes the string values to the NAME column (column 1) of the +C table. The FTPCLJ and FTPCLE routines write the diameter (integer) and +C density (real) value to the 2nd and 3rd columns. The FITSIO routines +C are column oriented, so it is usually easier to read or write data in a +C table in a column by column order rather than row by row. Note that +C the identical subroutine calls are used to write to either ASCII or +C binary FITS tables. + frow=1 + felem=1 + colnum=1 + call ftpcls(unit,colnum,frow,felem,nrows,name,status) + colnum=2 + call ftpclj(unit,colnum,frow,felem,nrows,diameter,status) + colnum=3 + call ftpcle(unit,colnum,frow,felem,nrows,density,status) + +C The FITS file must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(unit, status) + call ftfiou(unit, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine copyhdu + +C Copy the 1st and 3rd HDUs from the input file to a new FITS file + + integer status,inunit,outunit,readwrite,blocksize,morekeys,hdutype + character infilename*40,outfilename*40 + +C The STATUS parameter must always be initialized. + status=0 + +C Name of the FITS files: + infilename='ATESTFILEZ.FITS' + outfilename='BTESTFILEZ.FITS' + +C Delete the file if it already exists, so we can then recreate it +C The deletefile subroutine is listed at the end of this file. + call deletefile(outfilename,status) + +C Get unused Logical Unit Numbers to use to open the FITS files. + call ftgiou(inunit,status) + call ftgiou(outunit,status) + +C Open the input FITS file, with readonly access + readwrite=0 + call ftopen(inunit,infilename,readwrite,blocksize,status) + +C Create the new empty FITS file (value of blocksize is ignored) + blocksize=1 + call ftinit(outunit,outfilename,blocksize,status) + +C FTCOPY copies the current HDU from the input FITS file to the output +C file. The MOREKEY parameter allows one to reserve space for additional +C header keywords when the HDU is created. FITSIO will automatically +C insert more header space if required, so programmers do not have to +C reserve space ahead of time, although it is more efficient to do so if +C it is known that more keywords will be appended to the header. + morekeys=0 + call ftcopy(inunit,outunit,morekeys,status) + +C Append/create a new empty extension on the end of the output file + call ftcrhd(outunit,status) + +C Skip to the 3rd extension in the input file which in this case +C is the binary table created by the previous WRITEBINARY routine. + call ftmahd(inunit,3,hdutype,status) + +C FTCOPY now copies the binary table from the input FITS file +C to the output file. + call ftcopy(inunit,outunit,morekeys,status) + +C The FITS files must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. +C Giving -1 for the value of the first argument causes all previously +C allocated unit numbers to be released. + + call ftclos(inunit, status) + call ftclos(outunit, status) + call ftfiou(-1, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine selectrows + +C This routine copies selected rows from an input table into a new output +C FITS table. In this example all the rows in the input table that have +C a value of the DENSITY column less that 3.0 are copied to the output +C table. This program illustrates several generally useful techniques, +C including: +C how to locate the end of a FITS file +C how to create a table when the total number of rows in the table +C is not known until the table is completed +C how to efficiently copy entire rows from one table to another. + + integer status,inunit,outunit,readwrite,blocksize,hdutype + integer nkeys,nspace,naxes(2),nfound,colnum,frow,felem + integer noutrows,irow,temp(100),i + real nullval,density(6) + character infilename*40,outfilename*40,record*80 + logical exact,anynulls + +C The STATUS parameter must always be initialized. + status=0 + +C Names of the FITS files: + infilename='ATESTFILEZ.FITS' + outfilename='BTESTFILEZ.FITS' + +C Get unused Logical Unit Numbers to use to open the FITS files. + call ftgiou(inunit,status) + call ftgiou(outunit,status) + +C The input FITS file is opened with READONLY access, and the output +C FITS file is opened with WRITE access. + readwrite=0 + call ftopen(inunit,infilename,readwrite,blocksize,status) + readwrite=1 + call ftopen(outunit,outfilename,readwrite,blocksize,status) + +C move to the 3rd HDU in the input file (a binary table in this case) + call ftmahd(inunit,3,hdutype,status) + +C This do-loop illustrates how to move to the last extension in any FITS +C file. The call to FTMRHD moves one extension at a time through the +C FITS file until an `End-of-file' status value (= 107) is returned. + do while (status .eq. 0) + call ftmrhd(outunit,1,hdutype,status) + end do + +C After locating the end of the FITS file, it is necessary to reset the +C status value to zero and also clear the internal error message stack +C in FITSIO. The previous `End-of-file' error will have produced +C an unimportant message on the error stack which can be cleared with +C the call to the FTCMSG routine (which has no arguments). + + if (status .eq. 107)then + status=0 + call ftcmsg + end if + +C Create a new empty extension in the output file. + call ftcrhd(outunit,status) + +C Find the number of keywords in the input table header. + call ftghsp(inunit,nkeys,nspace,status) + +C This do-loop of calls to FTGREC and FTPREC copies all the keywords from +C the input to the output FITS file. Notice that the specified number +C of rows in the output table, as given by the NAXIS2 keyword, will be +C incorrect. This value will be modified later after it is known how many +C rows will be in the table, so it does not matter how many rows are specified +C initially. + do i=1,nkeys + call ftgrec(inunit,i,record,status) + call ftprec(outunit,record,status) + end do + +C FTGKNJ is used to get the value of the NAXIS1 and NAXIS2 keywords, +C which define the width of the table in bytes, and the number of +C rows in the table. + call ftgknj(inunit,'NAXIS',1,2,naxes,nfound,status) + +C FTGCNO gets the column number of the `DENSITY' column; the column +C number is needed when reading the data in the column. The EXACT +C parameter determines whether or not the match to the column names +C will be case sensitive. + exact=.false. + call ftgcno(inunit,exact,'DENSITY',colnum,status) + +C FTGCVE reads all 6 rows of data in the `DENSITY' column. The number +C of rows in the table is given by NAXES(2). Any null values in the +C table will be returned with the corresponding value set to -99 +C (= the value of NULLVAL). The ANYNULLS parameter will be set to TRUE +C if any null values were found while reading the data values in the table. + frow=1 + felem=1 + nullval=-99. + call ftgcve(inunit,colnum,frow,felem,naxes(2),nullval, + & density,anynulls,status) + +C If the density is less than 3.0, copy the row to the output table. +C FTGTBB and FTPTBB are low-level routines to read and write, respectively, +C a specified number of bytes in the table, starting at the specified +C row number and beginning byte within the row. These routines do +C not do any interpretation of the bytes, and simply pass them to or +C from the FITS file without any modification. This is a faster +C way of transferring large chunks of data from one FITS file to another, +C than reading and then writing each column of data individually. +C In this case an entire row of bytes (the row length is specified +C by the naxes(1) parameter) is transferred. The datatype of the +C buffer array (TEMP in this case) is immaterial so long as it is +C declared large enough to hold the required number of bytes. + noutrows=0 + do irow=1,naxes(2) + if (density(irow) .lt. 3.0)then + noutrows=noutrows+1 + call ftgtbb(inunit,irow,1,naxes(1),temp,status) + call ftptbb(outunit,noutrows,1,naxes(1),temp,status) + end if + end do + +C Update the NAXIS2 keyword with the correct no. of rows in the output file. +C After all the rows have been written to the output table, the +C FTMKYJ routine is used to overwrite the NAXIS2 keyword value with +C the correct number of rows. Specifying `\&' for the comment string +C tells FITSIO to keep the current comment string in the keyword and +C only modify the value. Because the total number of rows in the table +C was unknown when the table was first created, any value (including 0) +C could have been used for the initial NAXIS2 keyword value. + call ftmkyj(outunit,'NAXIS2',noutrows,'&',status) + +C The FITS files must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(inunit, status) + call ftclos(outunit, status) + call ftfiou(-1, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine readheader + +C Print out all the header keywords in all extensions of a FITS file + + integer status,unit,readwrite,blocksize,nkeys,nspace,hdutype,i,j + character filename*80,record*80 + +C The STATUS parameter must always be initialized. + status=0 + +C Get an unused Logical Unit Number to use to open the FITS file. + call ftgiou(unit,status) + +C name of FITS file + filename='ATESTFILEZ.FITS' + +C open the FITS file, with read-only access. The returned BLOCKSIZE +C parameter is obsolete and should be ignored. + readwrite=0 + call ftopen(unit,filename,readwrite,blocksize,status) + + j = 0 +100 continue + j = j + 1 + + print *,'Header listing for HDU', j + +C The FTGHSP subroutine returns the number of existing keywords in the +C current header data unit (CHDU), not counting the required END keyword, + call ftghsp(unit,nkeys,nspace,status) + +C Read each 80-character keyword record, and print it out. + do i = 1, nkeys + call ftgrec(unit,i,record,status) + print *,record + end do + +C Print out an END record, and a blank line to mark the end of the header. + if (status .eq. 0)then + print *,'END' + print *,' ' + end if + +C Try moving to the next extension in the FITS file, if it exists. +C The FTMRHD subroutine attempts to move to the next HDU, as specified by +C the second parameter. This subroutine moves by a relative number of +C HDUs from the current HDU. The related FTMAHD routine may be used to +C move to an absolute HDU number in the FITS file. If the end-of-file is +C encountered when trying to move to the specified extension, then a +C status = 107 is returned. + call ftmrhd(unit,1,hdutype,status) + + if (status .eq. 0)then +C success, so jump back and print out keywords in this extension + go to 100 + + else if (status .eq. 107)then +C hit end of file, so quit + status=0 + end if + +C The FITS file must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(unit, status) + call ftfiou(unit, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine readimage + +C Read a FITS image and determine the minimum and maximum pixel value. +C Rather than reading the entire image in +C at once (which could require a very large array), the image is read +C in pieces, 100 pixels at a time. + + integer status,unit,readwrite,blocksize,naxes(2),nfound + integer group,firstpix,nbuffer,npixels,i + real datamin,datamax,nullval,buffer(100) + logical anynull + character filename*80 + +C The STATUS parameter must always be initialized. + status=0 + +C Get an unused Logical Unit Number to use to open the FITS file. + call ftgiou(unit,status) + +C Open the FITS file previously created by WRITEIMAGE + filename='ATESTFILEZ.FITS' + readwrite=0 + call ftopen(unit,filename,readwrite,blocksize,status) + +C Determine the size of the image. + call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status) + +C Check that it found both NAXIS1 and NAXIS2 keywords. + if (nfound .ne. 2)then + print *,'READIMAGE failed to read the NAXISn keywords.' + return + end if + +C Initialize variables + npixels=naxes(1)*naxes(2) + group=1 + firstpix=1 + nullval=-999 + datamin=1.0E30 + datamax=-1.0E30 + + do while (npixels .gt. 0) +C read up to 100 pixels at a time + nbuffer=min(100,npixels) + + call ftgpve(unit,group,firstpix,nbuffer,nullval, + & buffer,anynull,status) + +C find the min and max values + do i=1,nbuffer + datamin=min(datamin,buffer(i)) + datamax=max(datamax,buffer(i)) + end do + +C increment pointers and loop back to read the next group of pixels + npixels=npixels-nbuffer + firstpix=firstpix+nbuffer + end do + + print * + print *,'Min and max image pixels = ',datamin,datamax + +C The FITS file must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(unit, status) + call ftfiou(unit, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine readtable + +C Read and print data values from an ASCII or binary table +C This example reads and prints out all the data in the ASCII and +C the binary tables that were previously created by WRITEASCII and +C WRITEBINTABLE. Note that the exact same FITSIO routines are +C used to read both types of tables. + + integer status,unit,readwrite,blocksize,hdutype,ntable + integer felem,nelems,nullj,diameter,nfound,irow,colnum + real nulle,density + character filename*40,nullstr*1,name*8,ttype(3)*10 + logical anynull + +C The STATUS parameter must always be initialized. + status=0 + +C Get an unused Logical Unit Number to use to open the FITS file. + call ftgiou(unit,status) + +C Open the FITS file previously created by WRITEIMAGE + filename='ATESTFILEZ.FITS' + readwrite=0 + call ftopen(unit,filename,readwrite,blocksize,status) + +C Loop twice, first reading the ASCII table, then the binary table + do ntable=2,3 + +C Move to the next extension + call ftmahd(unit,ntable,hdutype,status) + + print *,' ' + if (hdutype .eq. 1)then + print *,'Reading ASCII table in HDU ',ntable + else if (hdutype .eq. 2)then + print *,'Reading binary table in HDU ',ntable + end if + +C Read the TTYPEn keywords, which give the names of the columns + call ftgkns(unit,'TTYPE',1,3,ttype,nfound,status) + write(*,2000)ttype +2000 format(2x,"Row ",3a10) + +C Read the data, one row at a time, and print them out + felem=1 + nelems=1 + nullstr=' ' + nullj=0 + nulle=0. + do irow=1,6 +C FTGCVS reads the NAMES from the first column of the table. + colnum=1 + call ftgcvs(unit,colnum,irow,felem,nelems,nullstr,name, + & anynull,status) + +C FTGCVJ reads the DIAMETER values from the second column. + colnum=2 + call ftgcvj(unit,colnum,irow,felem,nelems,nullj,diameter, + & anynull,status) + +C FTGCVE reads the DENSITY values from the third column. + colnum=3 + call ftgcve(unit,colnum,irow,felem,nelems,nulle,density, + & anynull,status) + write(*,2001)irow,name,diameter,density +2001 format(i5,a10,i10,f10.2) + end do + end do + +C The FITS file must always be closed before exiting the program. +C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. + call ftclos(unit, status) + call ftfiou(unit, status) + +C Check for any error, and if so print out error messages. +C The PRINTERROR subroutine is listed near the end of this file. + if (status .gt. 0)call printerror(status) + end +C ************************************************************************* + subroutine printerror(status) + +C This subroutine prints out the descriptive text corresponding to the +C error status value and prints out the contents of the internal +C error message stack generated by FITSIO whenever an error occurs. + + integer status + character errtext*30,errmessage*80 + +C Check if status is OK (no error); if so, simply return + if (status .le. 0)return + +C The FTGERR subroutine returns a descriptive 30-character text string that +C corresponds to the integer error status number. A complete list of all +C the error numbers can be found in the back of the FITSIO User's Guide. + call ftgerr(status,errtext) + print *,'FITSIO Error Status =',status,': ',errtext + +C FITSIO usually generates an internal stack of error messages whenever +C an error occurs. These messages provide much more information on the +C cause of the problem than can be provided by the single integer error +C status value. The FTGMSG subroutine retrieves the oldest message from +C the stack and shifts any remaining messages on the stack down one +C position. FTGMSG is called repeatedly until a blank message is +C returned, which indicates that the stack is empty. Each error message +C may be up to 80 characters in length. Another subroutine, called +C FTCMSG, is available to simply clear the whole error message stack in +C cases where one is not interested in the contents. + call ftgmsg(errmessage) + do while (errmessage .ne. ' ') + print *,errmessage + call ftgmsg(errmessage) + end do + end +C ************************************************************************* + subroutine deletefile(filename,status) + +C A simple little routine to delete a FITS file + + integer status,unit,blocksize + character*(*) filename + +C Simply return if status is greater than zero + if (status .gt. 0)return + +C Get an unused Logical Unit Number to use to open the FITS file + call ftgiou(unit,status) + +C Try to open the file, to see if it exists + call ftopen(unit,filename,1,blocksize,status) + + if (status .eq. 0)then +C file was opened; so now delete it + call ftdelt(unit,status) + else if (status .eq. 103)then +C file doesn't exist, so just reset status to zero and clear errors + status=0 + call ftcmsg + else +C there was some other error opening the file; delete the file anyway + status=0 + call ftcmsg + call ftdelt(unit,status) + end if + +C Free the unit number for later reuse + call ftfiou(unit, status) + end diff --git a/pkg/tbtables/cfitsio/drvrfile.c b/pkg/tbtables/cfitsio/drvrfile.c new file mode 100644 index 00000000..516db58d --- /dev/null +++ b/pkg/tbtables/cfitsio/drvrfile.c @@ -0,0 +1,730 @@ +/* This file, drvrfile.c contains driver routines for disk files. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" + +#if defined(unix) || defined(__unix__) || defined(__unix) +#include /* needed in file_openfile */ + +#ifdef REPLACE_LINKS +#include +#include +#endif + +#endif + +#ifdef HAVE_FTRUNCATE +#include /* contains prototype of UNIX file truncate fn */ +#endif + +#define IO_SEEK 0 /* last file I/O operation was a seek */ +#define IO_READ 1 /* last file I/O operation was a read */ +#define IO_WRITE 2 /* last file I/O operation was a write */ + +static char file_outfile[FLEN_FILENAME]; + +typedef struct /* structure containing disk file structure */ +{ + FILE *fileptr; + OFF_T currentpos; + int last_io_op; +} diskdriver; + +static diskdriver handleTable[NMAXFILES]; /* allocate diskfile handle tables */ + +/*--------------------------------------------------------------------------*/ +int file_init(void) +{ + int ii; + + for (ii = 0; ii < NMAXFILES; ii++) /* initialize all empty slots in table */ + { + handleTable[ii].fileptr = 0; + } + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_setoptions(int options) +{ + /* do something with the options argument, to stop compiler warning */ + options = 0; + return(options); +} +/*--------------------------------------------------------------------------*/ +int file_getoptions(int *options) +{ + *options = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_getversion(int *version) +{ + *version = 10; + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_shutdown(void) +{ + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_open(char *filename, int rwmode, int *handle) +{ + FILE *diskfile; + int copyhandle, ii, status; + char recbuf[2880]; + size_t nread; + + /* + if an output filename has been specified as part of the input + file, as in "inputfile.fits(outputfile.fit)" then we have to + create the output file, copy the input to it, then reopen the + the new copy. + */ + + if (*file_outfile) + { + /* open the original file, with readonly access */ + status = file_openfile(filename, READONLY, &diskfile); + if (status) + return(status); + + /* create the output file */ + status = file_create(file_outfile,handle); + if (status) + { + ffpmsg("Unable to create output file for copy of input file:"); + ffpmsg(file_outfile); + return(status); + } + + /* copy the file from input to output */ + while(0 != (nread = fread(recbuf,1,2880, diskfile))) + { + status = file_write(*handle, recbuf, nread); + if (status) + return(status); + } + + /* close both files */ + fclose(diskfile); + copyhandle = *handle; + file_close(*handle); + *handle = copyhandle; /* reuse the old file handle */ + + /* reopen the new copy, with correct rwmode */ + status = file_openfile(file_outfile, rwmode, &diskfile); + + } + else + { + *handle = -1; + for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in table */ + { + if (handleTable[ii].fileptr == 0) + { + *handle = ii; + break; + } + } + + if (*handle == -1) + return(TOO_MANY_FILES); /* too many files opened */ + + /*open the file */ + status = file_openfile(filename, rwmode, &diskfile); + } + + handleTable[*handle].fileptr = diskfile; + handleTable[*handle].currentpos = 0; + handleTable[*handle].last_io_op = IO_SEEK; + + return(status); +} +/*--------------------------------------------------------------------------*/ +int file_openfile(char *filename, int rwmode, FILE **diskfile) +/* + lowest level routine to physically open a disk file +*/ +{ + char mode[4]; + +#if defined(unix) || defined(__unix__) || defined(__unix) + char tempname[512], *cptr, user[80]; + struct passwd *pwd; + int ii = 0; + +#if defined(REPLACE_LINKS) + struct stat stbuf; + int success = 0; + size_t n; + FILE *f1, *f2; + char buf[BUFSIZ]; +#endif + +#endif + + if (rwmode == READWRITE) + { + strcpy(mode, "r+b"); /* open existing file with read-write */ + } + else + { + strcpy(mode, "rb"); /* open existing file readonly */ + } + +#if MACHINE == ALPHAVMS || MACHINE == VAXVMS + /* specify VMS record structure: fixed format, 2880 byte records */ + /* but force stream mode access to enable random I/O access */ + *diskfile = fopen(filename, mode, "rfm=fix", "mrs=2880", "ctx=stm"); + +#elif defined(unix) || defined(__unix__) || defined(__unix) + + /* support the ~user/file.fits or ~/file.fits filenames in UNIX */ + + if (*filename == '~') + { + if (filename[1] == '/') + { + cptr = getenv("HOME"); + if (cptr) + { + strcpy(tempname, cptr); + strcat(tempname, filename+1); + } + else + { + strcpy(tempname, filename); + } + } + else + { + /* copy user name */ + cptr = filename+1; + while (*cptr && (*cptr != '/')) + { + user[ii] = *cptr; + cptr++; + ii++; + } + user[ii] = '\0'; + + /* get structure that includes name of user's home directory */ + pwd = getpwnam(user); + + /* copy user's home directory */ + strcpy(tempname, pwd->pw_dir); + strcat(tempname, cptr); + } + + *diskfile = fopen(tempname, mode); + } + else + { + /* don't need to expand the input file name */ + *diskfile = fopen(filename, mode); + +#if defined(REPLACE_LINKS) + + if (!(*diskfile) && (rwmode == READWRITE)) + { + /* failed to open file with READWRITE privilege. Test if */ + /* the file we are trying to open is a soft link to a file that */ + /* doesn't have write privilege. */ + + lstat(filename, &stbuf); + if ((stbuf.st_mode & S_IFMT) == S_IFLNK) /* is this a soft link? */ + { + if ((f1 = fopen(filename, "rb")) != 0) /* try opening READONLY */ + { + strcpy(tempname, filename); + strcat(tempname, ".TmxFil"); + if ((f2 = fopen(tempname, "wb")) != 0) /* create temp file */ + { + success = 1; + while ((n = fread(buf, 1, BUFSIZ, f1)) > 0) + { + /* copy linked file to local temporary file */ + if (fwrite(buf, 1, n, f2) != n) + { + success = 0; + break; + } + } + fclose(f2); + } + fclose(f1); + + if (success) + { + /* delete link and rename temp file to previous link name */ + remove(filename); + rename(tempname, filename); + + /* try once again to open the file with write access */ + *diskfile = fopen(filename, mode); + } + else + remove(tempname); /* clean up the failed copy */ + } + } + } +#endif + + } + +#else + + /* other non-UNIX machines */ + *diskfile = fopen(filename, mode); + +#endif + + if (!(*diskfile)) /* couldn't open file */ + { + return(FILE_NOT_OPENED); + } + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_create(char *filename, int *handle) +{ + FILE *diskfile; + int ii; + char mode[4]; + + *handle = -1; + for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in table */ + { + if (handleTable[ii].fileptr == 0) + { + *handle = ii; + break; + } + } + if (*handle == -1) + return(TOO_MANY_FILES); /* too many files opened */ + + strcpy(mode, "w+b"); /* create new file with read-write */ + + diskfile = fopen(filename, "r"); /* does file already exist? */ + + if (diskfile) + { + fclose(diskfile); /* close file and exit with error */ + return(FILE_NOT_CREATED); + } + +#if MACHINE == ALPHAVMS || MACHINE == VAXVMS + /* specify VMS record structure: fixed format, 2880 byte records */ + /* but force stream mode access to enable random I/O access */ + diskfile = fopen(filename, mode, "rfm=fix", "mrs=2880", "ctx=stm"); +#else + diskfile = fopen(filename, mode); +#endif + + if (!(diskfile)) /* couldn't create file */ + { + return(FILE_NOT_CREATED); + } + + handleTable[ii].fileptr = diskfile; + handleTable[ii].currentpos = 0; + handleTable[ii].last_io_op = IO_SEEK; + + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_truncate(int handle, OFF_T filesize) +/* + truncate the diskfile to a new smaller size +*/ +{ + +#ifdef HAVE_FTRUNCATE + int fdesc; + + fdesc = fileno(handleTable[handle].fileptr); + ftruncate(fdesc, filesize); + + handleTable[handle].currentpos = filesize; + handleTable[handle].last_io_op = IO_WRITE; + +#endif + + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_size(int handle, OFF_T *filesize) +/* + return the size of the file in bytes +*/ +{ + OFF_T position1; + FILE *diskfile; + + diskfile = handleTable[handle].fileptr; + +#if _FILE_OFFSET_BITS - 0 == 64 + +/* call the newer ftello and fseeko routines , which support */ +/* Large Files (> 2GB) if they are supported. */ + + position1 = ftello(diskfile); /* save current postion */ + if (position1 < 0) + return(SEEK_ERROR); + + if (fseeko(diskfile, 0, 2) != 0) /* seek to end of file */ + return(SEEK_ERROR); + + *filesize = ftello(diskfile); /* get file size */ + if (*filesize < 0) + return(SEEK_ERROR); + + if (fseeko(diskfile, position1, 0) != 0) /* seek back to original pos */ + return(SEEK_ERROR); + +#else + + position1 = ftell(diskfile); /* save current postion */ + if (position1 < 0) + return(SEEK_ERROR); + + if (fseek(diskfile, 0, 2) != 0) /* seek to end of file */ + return(SEEK_ERROR); + + *filesize = ftell(diskfile); /* get file size */ + if (*filesize < 0) + return(SEEK_ERROR); + + if (fseek(diskfile, position1, 0) != 0) /* seek back to original pos */ + return(SEEK_ERROR); + +#endif + + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_close(int handle) +/* + close the file +*/ +{ + + if (fclose(handleTable[handle].fileptr) ) + return(FILE_NOT_CLOSED); + + handleTable[handle].fileptr = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_remove(char *filename) +/* + delete the file from disk +*/ +{ + remove(filename); + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_flush(int handle) +/* + flush the file +*/ +{ + if (fflush(handleTable[handle].fileptr) ) + return(WRITE_ERROR); + + /* The flush operation is not supposed to move the internal */ + /* file pointer, but it does on some Windows-95 compilers and */ + /* perhaps others, so seek to original position to be sure. */ + /* This seek will do no harm on other systems. */ + +#if MACHINE == IBMPC + + if (file_seek(handle, handleTable[handle].currentpos)) + return(SEEK_ERROR); + +#endif + + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_seek(int handle, OFF_T offset) +/* + seek to position relative to start of the file +*/ +{ + +#if _FILE_OFFSET_BITS - 0 == 64 + + if (fseeko(handleTable[handle].fileptr, offset, 0) != 0) + return(SEEK_ERROR); + +#else + + if (fseek(handleTable[handle].fileptr, offset, 0) != 0) + return(SEEK_ERROR); + +#endif + + handleTable[handle].currentpos = offset; + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_read(int hdl, void *buffer, long nbytes) +/* + read bytes from the current position in the file +*/ +{ + long nread; + char *cptr; + + if (handleTable[hdl].last_io_op == IO_WRITE) + { + if (file_seek(hdl, handleTable[hdl].currentpos)) + return(SEEK_ERROR); + } + + nread = (long) fread(buffer, 1, nbytes, handleTable[hdl].fileptr); + + if (nread == 1) + { + cptr = (char *) buffer; + + /* some editors will add a single end-of-file character to a file */ + /* Ignore it if the character is a zero, 10, or 32 */ + if (*cptr == 0 || *cptr == 10 || *cptr == 32) + return(END_OF_FILE); + else + return(READ_ERROR); + } + else if (nread != nbytes) + { + return(READ_ERROR); + } + + handleTable[hdl].currentpos += nbytes; + handleTable[hdl].last_io_op = IO_READ; + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_write(int hdl, void *buffer, long nbytes) +/* + write bytes at the current position in the file +*/ +{ + if (handleTable[hdl].last_io_op == IO_READ) + { + if (file_seek(hdl, handleTable[hdl].currentpos)) + return(SEEK_ERROR); + } + + if((long) fwrite(buffer, 1, nbytes, handleTable[hdl].fileptr) != nbytes) + return(WRITE_ERROR); + + handleTable[hdl].currentpos += nbytes; + handleTable[hdl].last_io_op = IO_WRITE; + return(0); +} +/*--------------------------------------------------------------------------*/ +int file_compress_open(char *filename, int rwmode, int *hdl) +/* + This routine opens the compressed diskfile by creating a new uncompressed + file then opening it. The input file name (the name of the compressed + file) gets replaced with the name of the uncompressed file, which is + initially stored in the global file_outfile string. file_outfile + then gets set to a null string. +*/ +{ + FILE *indiskfile, *outdiskfile; + int status, clobber = 0; + char *cptr; + + /* open the compressed disk file */ + status = file_openfile(filename, READONLY, &indiskfile); + if (status) + { + ffpmsg("failed to open compressed disk file (file_compress_open)"); + ffpmsg(filename); + return(status); + } + + /* name of the output uncompressed file is stored in the */ + /* global variable called 'file_outfile'. */ + + cptr = file_outfile; + if (*cptr == '!') + { + /* clobber any existing file with the same name */ + clobber = 1; + cptr++; + remove(cptr); + } + else + { + outdiskfile = fopen(file_outfile, "r"); /* does file already exist? */ + + if (outdiskfile) + { + ffpmsg("uncompressed file already exists: (file_compress_open)"); + ffpmsg(file_outfile); + fclose(outdiskfile); /* close file and exit with error */ + return(FILE_NOT_CREATED); + } + } + + outdiskfile = fopen(cptr, "w+b"); /* create new file */ + if (!outdiskfile) + { + ffpmsg("could not create uncompressed file: (file_compress_open)"); + ffpmsg(file_outfile); + return(FILE_NOT_CREATED); + } + + /* uncompress file into another file */ + uncompress2file(filename, indiskfile, outdiskfile, &status); + fclose(indiskfile); + fclose(outdiskfile); + + if (status) + { + ffpmsg("error in file_compress_open: failed to uncompressed file:"); + ffpmsg(filename); + ffpmsg(" into new output file:"); + ffpmsg(file_outfile); + return(status); + } + + strcpy(filename, cptr); /* switch the names */ + file_outfile[0] = '\0'; + + status = file_open(filename, rwmode, hdl); + + return(status); +} +/*--------------------------------------------------------------------------*/ +int file_is_compressed(char *filename) /* I - FITS file name */ +/* + Test if the disk file is compressed. Returns 1 if compressed, 0 if not. + This may modify the filename string by appending a compression suffex. +*/ +{ + FILE *diskfile; + unsigned char buffer[2]; + char tmpfilename[FLEN_FILENAME]; + + /* Open file. Try various suffix combinations */ + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(tmpfilename,filename); + strcat(filename,".gz"); + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(filename, tmpfilename); + strcat(filename,".Z"); + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(filename, tmpfilename); + strcat(filename,".z"); /* it's often lower case on CDROMs */ + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(filename, tmpfilename); + strcat(filename,".zip"); + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(filename, tmpfilename); + strcat(filename,"-z"); /* VMS suffix */ + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(filename, tmpfilename); + strcat(filename,"-gz"); /* VMS suffix */ + if (file_openfile(filename, 0, &diskfile)) + { + strcpy(filename,tmpfilename); /* restore original name */ + return(0); /* file not found */ + } + } + } + } + } + } + } + + if (fread(buffer, 1, 2, diskfile) != 2) /* read 2 bytes */ + { + fclose(diskfile); /* error reading file so just return */ + return(0); + } + + fclose(diskfile); + + /* see if the 2 bytes have the magic values for a compressed file */ + if ( (memcmp(buffer, "\037\213", 2) == 0) || /* GZIP */ + (memcmp(buffer, "\120\113", 2) == 0) || /* PKZIP */ + (memcmp(buffer, "\037\036", 2) == 0) || /* PACK */ + (memcmp(buffer, "\037\235", 2) == 0) || /* LZW */ + (memcmp(buffer, "\037\240", 2) == 0) ) /* LZH */ + { + return(1); /* this is a compressed file */ + } + else + { + return(0); /* not a compressed file */ + } +} +/*--------------------------------------------------------------------------*/ +int file_checkfile (char *urltype, char *infile, char *outfile) +{ + /* special case: if file:// driver, check if the file is compressed */ + if ( file_is_compressed(infile) ) + { + /* if output file has been specified, save the name for future use: */ + /* This is the name of the uncompressed file to be created on disk. */ + if (strlen(outfile)) + { + if (!strncmp(outfile, "mem:", 4) ) + { + /* uncompress the file in memory, with READ and WRITE access */ + strcpy(urltype, "compressmem://"); /* use special driver */ + *file_outfile = '\0'; + } + else + { + strcpy(urltype, "compressfile://"); /* use special driver */ + + /* don't copy the "file://" prefix, if present. */ + if (!strncmp(outfile, "file://", 7) ) + strcpy(file_outfile,outfile+7); + else + strcpy(file_outfile,outfile); + } + } + else + { + /* uncompress the file in memory */ + strcpy(urltype, "compress://"); /* use special driver */ + *file_outfile = '\0'; /* no output file was specified */ + } + } + else /* an ordinary, uncompressed FITS file on disk */ + { + /* save the output file name for later use when opening the file. */ + /* In this case, the file to be opened will be opened READONLY, */ + /* and copied to this newly created output file. The original file */ + /* will be closed, and the copy will be opened by CFITSIO for */ + /* subsequent processing (possibly with READWRITE access). */ + if (strlen(outfile)) + strcpy(file_outfile,outfile); + } + + return 0; +} + + + diff --git a/pkg/tbtables/cfitsio/drvrmem.c b/pkg/tbtables/cfitsio/drvrmem.c new file mode 100644 index 00000000..62bfd332 --- /dev/null +++ b/pkg/tbtables/cfitsio/drvrmem.c @@ -0,0 +1,1163 @@ +/* This file, drvrmem.c, contains driver routines for memory files. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include /* apparently needed to define size_t */ +#include "fitsio2.h" + +#define RECBUFLEN 1000 + +static char stdin_outfile[FLEN_FILENAME]; + +typedef struct /* structure containing mem file structure */ +{ + char **memaddrptr; /* Pointer to memory address pointer; */ + /* This may or may not point to memaddr. */ + char *memaddr; /* Pointer to starting memory address; may */ + /* not always be used, so use *memaddrptr instead */ + size_t *memsizeptr; /* Pointer to the size of the memory allocation. */ + /* This may or may not point to memsize. */ + size_t memsize; /* Size of the memory allocation; this may not */ + /* always be used, so use *memsizeptr instead. */ + size_t deltasize; /* Suggested increment for reallocating memory */ + void *(*mem_realloc)(void *p, size_t newsize); /* realloc function */ + OFF_T currentpos; /* current file position, relative to start */ + OFF_T fitsfilesize; /* size of the FITS file (always <= *memsizeptr) */ + FILE *fileptr; /* pointer to compressed output disk file */ +} memdriver; + +static memdriver memTable[NMAXFILES]; /* allocate mem file handle tables */ + +/*--------------------------------------------------------------------------*/ +int mem_init(void) +{ + int ii; + + for (ii = 0; ii < NMAXFILES; ii++) /* initialize all empty slots in table */ + { + memTable[ii].memaddrptr = 0; + memTable[ii].memaddr = 0; + } + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_setoptions(int options) +{ + /* do something with the options argument, to stop compiler warning */ + options = 0; + return(options); +} +/*--------------------------------------------------------------------------*/ +int mem_getoptions(int *options) +{ + *options = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_getversion(int *version) +{ + *version = 10; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_shutdown(void) +{ + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_create(char *filename, int *handle) +/* + Create a new empty memory file for subsequent writes. + The file name is ignored in this case. +*/ +{ + int status; + + /* initially allocate 1 FITS block = 2880 bytes */ + status = mem_createmem(2880L, handle); + + if (status) + { + ffpmsg("failed to create empty memory file (mem_create)"); + return(status); + } + + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_create_comp(char *filename, int *handle) +/* + Create a new empty memory file for subsequent writes. + Also create an empty compressed .gz file. The memory file + will be compressed and written to the disk file when the file is closed. +*/ +{ + FILE *diskfile; + char mode[4]; + int status; + + /* first, create disk file for the compressed output */ + + + if ( !strcmp(filename, "-.gz") || !strcmp(filename, "stdout.gz") || + !strcmp(filename, "STDOUT.gz") ) + { + /* special case: create uncompressed FITS file in memory, then + compress it an write it out to 'stdout' when it is closed. */ + + diskfile = stdout; + } + else + { + /* normal case: create disk file for the compressed output */ + + strcpy(mode, "w+b"); /* create file with read-write */ + + diskfile = fopen(filename, "r"); /* does file already exist? */ + + if (diskfile) + { + fclose(diskfile); /* close file and exit with error */ + return(FILE_NOT_CREATED); + } + +#if MACHINE == ALPHAVMS || MACHINE == VAXVMS + /* specify VMS record structure: fixed format, 2880 byte records */ + /* but force stream mode access to enable random I/O access */ + diskfile = fopen(filename, mode, "rfm=fix", "mrs=2880", "ctx=stm"); +#else + diskfile = fopen(filename, mode); +#endif + + if (!(diskfile)) /* couldn't create file */ + { + return(FILE_NOT_CREATED); + } + } + + /* now create temporary memory file */ + + /* initially allocate 1 FITS block = 2880 bytes */ + status = mem_createmem(2880L, handle); + + if (status) + { + ffpmsg("failed to create empty memory file (mem_create_comp)"); + return(status); + } + + memTable[*handle].fileptr = diskfile; + + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_openmem(void **buffptr, /* I - address of memory pointer */ + size_t *buffsize, /* I - size of buffer, in bytes */ + size_t deltasize, /* I - increment for future realloc's */ + void *(*memrealloc)(void *p, size_t newsize), /* function */ + int *handle) +/* + lowest level routine to open a pre-existing memory file. +*/ +{ + int ii; + + *handle = -1; + for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in handle table */ + { + if (memTable[ii].memaddrptr == 0) + { + *handle = ii; + break; + } + } + if (*handle == -1) + return(TOO_MANY_FILES); /* too many files opened */ + + memTable[ii].memaddrptr = (char **) buffptr; /* pointer to start addres */ + memTable[ii].memsizeptr = buffsize; /* allocated size of memory */ + memTable[ii].deltasize = deltasize; /* suggested realloc increment */ + memTable[ii].fitsfilesize = *buffsize; /* size of FITS file (upper limit) */ + memTable[ii].currentpos = 0; /* at beginning of the file */ + memTable[ii].mem_realloc = memrealloc; /* memory realloc function */ + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_createmem(size_t msize, int *handle) +/* + lowest level routine to allocate a memory file. +*/ +{ + int ii; + + *handle = -1; + for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in handle table */ + { + if (memTable[ii].memaddrptr == 0) + { + *handle = ii; + break; + } + } + if (*handle == -1) + return(TOO_MANY_FILES); /* too many files opened */ + + /* use the internally allocated memaddr and memsize variables */ + memTable[ii].memaddrptr = &memTable[ii].memaddr; + memTable[ii].memsizeptr = &memTable[ii].memsize; + + /* allocate initial block of memory for the file */ + if (msize > 0) + { + memTable[ii].memaddr = malloc(msize); + if ( !(memTable[ii].memaddr) ) + { + ffpmsg("malloc of initial memory failed (mem_createmem)"); + return(FILE_NOT_OPENED); + } + } + + /* set initial state of the file */ + memTable[ii].memsize = msize; + memTable[ii].deltasize = 2880; + memTable[ii].fitsfilesize = 0; + memTable[ii].currentpos = 0; + memTable[ii].mem_realloc = realloc; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_truncate(int handle, OFF_T filesize) +/* + truncate the file to a new size +*/ +{ + char *ptr; + + /* call the memory reallocation function, if defined */ + if ( memTable[handle].mem_realloc ) + { + ptr = (memTable[handle].mem_realloc)( + *(memTable[handle].memaddrptr), + filesize); + if (!ptr) + { + ffpmsg("Failed to reallocate memory (mem_truncate)"); + return(MEMORY_ALLOCATION); + } + + /* if allocated more memory, initialize it to zero */ + if ( (size_t) filesize > *(memTable[handle].memsizeptr) ) + { + memset(ptr + *(memTable[handle].memsizeptr), + 0, + filesize - *(memTable[handle].memsizeptr) ); + } + + *(memTable[handle].memaddrptr) = ptr; + *(memTable[handle].memsizeptr) = filesize; + } + + memTable[handle].fitsfilesize = filesize; + return(0); +} +/*--------------------------------------------------------------------------*/ +int stdin_checkfile(char *urltype, char *infile, char *outfile) +/* + do any special case checking when opening a file on the stdin stream +*/ +{ + if (strlen(outfile)) + { + strcpy(stdin_outfile,outfile); /* an output file is specified */ + strcpy(urltype,"stdinfile://"); + } + else + *stdin_outfile = '\0'; /* no output file was specified */ + + return(0); +} +/*--------------------------------------------------------------------------*/ +int stdin_open(char *filename, int rwmode, int *handle) +/* + open a FITS file from the stdin file stream by copying it into memory + The file name is ignored in this case. +*/ +{ + int status = 0; + char cbuff; + + if (*stdin_outfile) + { + /* copy the stdin stream to the specified disk file then open the file */ + + /* Create the output file */ + status = file_create(stdin_outfile,handle); + + if (status) + { + ffpmsg("Unable to create output file to copy stdin (stdin_open):"); + ffpmsg(stdin_outfile); + return(status); + } + + /* copy the whole stdin stream to the file */ + status = stdin2file(*handle); + file_close(*handle); + + if (status) + { + ffpmsg("failed to copy stdin to file (stdin_open)"); + ffpmsg(stdin_outfile); + return(status); + } + + /* reopen file with proper rwmode attribute */ + status = file_open(stdin_outfile, rwmode, handle); + } + else + { + + /* get the first character, then put it back */ + cbuff = fgetc(stdin); + ungetc(cbuff, stdin); + + /* compressed files begin with 037 or 'P' */ + if (cbuff == 31 || cbuff == 75) + { + /* looks like the input stream is compressed */ + status = mem_compress_stdin_open(filename, rwmode, handle); + + } + else + { + /* copy the stdin stream into memory then open file in memory */ + + if (rwmode != READONLY) + { + ffpmsg("cannot open stdin with WRITE access"); + return(READONLY_FILE); + } + + status = mem_createmem(2880L, handle); + + if (status) + { + ffpmsg("failed to create empty memory file (stdin_open)"); + return(status); + } + + /* copy the whole stdin stream into memory */ + status = stdin2mem(*handle); + + if (status) + { + ffpmsg("failed to copy stdin into memory (stdin_open)"); + free(memTable[*handle].memaddr); + } + } + } + + return(status); +} +/*--------------------------------------------------------------------------*/ +int stdin2mem(int hd) /* handle number */ +/* + Copy the stdin stream into memory. Fill whatever amount of memory + has already been allocated, then realloc more memory if necessary. +*/ +{ + size_t nread, memsize, delta; + OFF_T filesize; + char *memptr; + char simple[] = "SIMPLE"; + int c, ii, jj; + + memptr = *memTable[hd].memaddrptr; + memsize = *memTable[hd].memsizeptr; + delta = memTable[hd].deltasize; + + filesize = 0; + ii = 0; + + for(jj = 0; (c = fgetc(stdin)) != EOF && jj < 2000; jj++) + { + /* Skip over any garbage at the beginning of the stdin stream by */ + /* reading 1 char at a time, looking for 'S', 'I', 'M', 'P', 'L', 'E' */ + /* Give up if not found in the first 2000 characters */ + + if (c == simple[ii]) + { + ii++; + if (ii == 6) /* found the complete string? */ + { + memcpy(memptr, simple, 6); /* copy "SIMPLE" to buffer */ + filesize = 6; + break; + } + } + else + ii = 0; /* reset search to beginning of the string */ + } + + if (filesize == 0) + { + ffpmsg("Couldn't find the string 'SIMPLE' in the stdin stream."); + ffpmsg("This does not look like a FITS file."); + return(FILE_NOT_OPENED); + } + + /* fill up the remainder of the initial memory allocation */ + nread = fread(memptr + 6, 1, memsize - 6, stdin); + nread += 6; /* add in the 6 characters in 'SIMPLE' */ + + if (nread < memsize) /* reached the end? */ + { + memTable[hd].fitsfilesize = nread; + return(0); + } + + filesize = nread; + + while (1) + { + /* allocate memory for another FITS block */ + memptr = realloc(memptr, memsize + delta); + + if (!memptr) + { + ffpmsg("realloc failed while copying stdin (stdin2mem)"); + return(MEMORY_ALLOCATION); + } + memsize += delta; + + /* read another FITS block */ + nread = fread(memptr + filesize, 1, delta, stdin); + + filesize += nread; + + if (nread < delta) /* reached the end? */ + break; + } + + memTable[hd].fitsfilesize = filesize; + *memTable[hd].memaddrptr = memptr; + *memTable[hd].memsizeptr = memsize; + + return(0); +} +/*--------------------------------------------------------------------------*/ +int stdin2file(int handle) /* handle number */ +/* + Copy the stdin stream to a file. . +*/ +{ + size_t nread = 0; + char simple[] = "SIMPLE"; + int c, ii, jj, status = 0; + char recbuf[RECBUFLEN]; + + ii = 0; + for(jj = 0; (c = fgetc(stdin)) != EOF && jj < 2000; jj++) + { + /* Skip over any garbage at the beginning of the stdin stream by */ + /* reading 1 char at a time, looking for 'S', 'I', 'M', 'P', 'L', 'E' */ + /* Give up if not found in the first 2000 characters */ + + if (c == simple[ii]) + { + ii++; + if (ii == 6) /* found the complete string? */ + { + memcpy(recbuf, simple, 6); /* copy "SIMPLE" to buffer */ + break; + } + } + else + ii = 0; /* reset search to beginning of the string */ + } + + if (ii != 6) + { + ffpmsg("Couldn't find the string 'SIMPLE' in the stdin stream"); + return(FILE_NOT_OPENED); + } + + /* fill up the remainder of the buffer */ + nread = fread(recbuf + 6, 1, RECBUFLEN - 6, stdin); + nread += 6; /* add in the 6 characters in 'SIMPLE' */ + + status = file_write(handle, recbuf, nread); + if (status) + return(status); + + /* copy the rest of stdin stream */ + while(0 != (nread = fread(recbuf,1,RECBUFLEN, stdin))) + { + status = file_write(handle, recbuf, nread); + if (status) + return(status); + } + + return(status); +} +/*--------------------------------------------------------------------------*/ +int stdout_close(int handle) +/* + copy the memory file to stdout, then free the memory +*/ +{ + int status = 0; + + /* copy from memory to standard out */ + if(fwrite(memTable[handle].memaddr, 1, + memTable[handle].fitsfilesize, stdout) != + (size_t) memTable[handle].fitsfilesize ) + { + ffpmsg("failed to copy memory file to stdout (stdout_close)"); + status = WRITE_ERROR; + } + + free( memTable[handle].memaddr ); /* free the memory */ + memTable[handle].memaddrptr = 0; + memTable[handle].memaddr = 0; + return(status); +} +/*--------------------------------------------------------------------------*/ +int mem_compress_openrw(char *filename, int rwmode, int *hdl) +/* + This routine opens the compressed diskfile and creates an empty memory + buffer with an appropriate size, then calls mem_uncompress2mem. It allows + the memory 'file' to be opened with READWRITE access. +*/ +{ + return(mem_compress_open(filename, READONLY, hdl)); +} +/*--------------------------------------------------------------------------*/ +int mem_compress_open(char *filename, int rwmode, int *hdl) +/* + This routine opens the compressed diskfile and creates an empty memory + buffer with an appropriate size, then calls mem_uncompress2mem. +*/ +{ + FILE *diskfile; + int status, estimated = 1; + unsigned char buffer[4]; + size_t finalsize; + char *ptr; + + if (rwmode != READONLY) + { + ffpmsg( + "cannot open compressed file with WRITE access (mem_compress_open)"); + ffpmsg(filename); + return(READONLY_FILE); + } + + /* open the compressed disk file */ + status = file_openfile(filename, READONLY, &diskfile); + if (status) + { + ffpmsg("failed to open compressed disk file (compress_open)"); + ffpmsg(filename); + return(status); + } + + if (fread(buffer, 1, 2, diskfile) != 2) /* read 2 bytes */ + { + fclose(diskfile); + return(READ_ERROR); + } + + if (memcmp(buffer, "\037\213", 2) == 0) /* GZIP */ + { + /* the uncompressed file size is give at the end of the file */ + + fseek(diskfile, 0, 2); /* move to end of file */ + fseek(diskfile, -4L, 1); /* move back 4 bytes */ + fread(buffer, 1, 4L, diskfile); /* read 4 bytes */ + + /* have to worry about integer byte order */ + finalsize = buffer[0]; + finalsize |= buffer[1] << 8; + finalsize |= buffer[2] << 16; + finalsize |= buffer[3] << 24; + + estimated = 0; /* file size is known, not estimated */ + } + else if (memcmp(buffer, "\120\113", 2) == 0) /* PKZIP */ + { + /* the uncompressed file size is give at byte 22 the file */ + + fseek(diskfile, 22L, 0); /* move to byte 22 */ + fread(buffer, 1, 4L, diskfile); /* read 4 bytes */ + + /* have to worry about integer byte order */ + finalsize = buffer[0]; + finalsize |= buffer[1] << 8; + finalsize |= buffer[2] << 16; + finalsize |= buffer[3] << 24; + + estimated = 0; /* file size is known, not estimated */ + } + else if (memcmp(buffer, "\037\036", 2) == 0) /* PACK */ + finalsize = 0; /* for most methods we can't determine final size */ + else if (memcmp(buffer, "\037\235", 2) == 0) /* LZW */ + finalsize = 0; /* for most methods we can't determine final size */ + else if (memcmp(buffer, "\037\240", 2) == 0) /* LZH */ + finalsize = 0; /* for most methods we can't determine final size */ + else + { + /* not a compressed file; this should never happen */ + fclose(diskfile); + return(1); + } + + if (finalsize == 0) /* estimate uncompressed file size */ + { + fseek(diskfile, 0, 2); /* move to end of the compressed file */ + finalsize = ftell(diskfile); /* position = size of file */ + finalsize = finalsize * 3; /* assume factor of 3 compression */ + } + + fseek(diskfile, 0, 0); /* move back to beginning of file */ + + /* create a memory file big enough (hopefully) for the uncompressed file */ + status = mem_createmem(finalsize, hdl); + + if (status && estimated) + { + /* memory allocation failed, so try a smaller estimated size */ + finalsize = finalsize / 3; + status = mem_createmem(finalsize, hdl); + } + + if (status) + { + fclose(diskfile); + ffpmsg("failed to create empty memory file (compress_open)"); + return(status); + } + + /* uncompress file into memory */ + status = mem_uncompress2mem(filename, diskfile, *hdl); + + fclose(diskfile); + + if (status) + { + mem_close_free(*hdl); /* free up the memory */ + ffpmsg("failed to uncompress file into memory (compress_open)"); + return(status); + } + + /* if we allocated too much memory initially, then free it */ + if (*(memTable[*hdl].memsizeptr) > + (( (size_t) memTable[*hdl].fitsfilesize) + 256L) ) + { + ptr = realloc(*(memTable[*hdl].memaddrptr), + memTable[*hdl].fitsfilesize); + if (!ptr) + { + ffpmsg("Failed to reduce size of allocated memory (compress_open)"); + return(MEMORY_ALLOCATION); + } + + *(memTable[*hdl].memaddrptr) = ptr; + *(memTable[*hdl].memsizeptr) = memTable[*hdl].fitsfilesize; + } + + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_compress_stdin_open(char *filename, int rwmode, int *hdl) +/* + This routine reads the compressed input stream and creates an empty memory + buffer, then calls mem_uncompress2mem. +*/ +{ + int status; + char *ptr; + + if (rwmode != READONLY) + { + ffpmsg( + "cannot open compressed input stream with WRITE access (mem_compress_stdin_open)"); + return(READONLY_FILE); + } + + /* create a memory file for the uncompressed file */ + status = mem_createmem(28800, hdl); + + if (status) + { + ffpmsg("failed to create empty memory file (compress_stdin_open)"); + return(status); + } + + /* uncompress file into memory */ + status = mem_uncompress2mem(filename, stdin, *hdl); + + if (status) + { + mem_close_free(*hdl); /* free up the memory */ + ffpmsg("failed to uncompress stdin into memory (compress_stdin_open)"); + return(status); + } + + /* if we allocated too much memory initially, then free it */ + if (*(memTable[*hdl].memsizeptr) > + (( (size_t) memTable[*hdl].fitsfilesize) + 256L) ) + { + ptr = realloc(*(memTable[*hdl].memaddrptr), + memTable[*hdl].fitsfilesize); + if (!ptr) + { + ffpmsg("Failed to reduce size of allocated memory (compress_stdin_open)"); + return(MEMORY_ALLOCATION); + } + + *(memTable[*hdl].memaddrptr) = ptr; + *(memTable[*hdl].memsizeptr) = memTable[*hdl].fitsfilesize; + } + + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_iraf_open(char *filename, int rwmode, int *hdl) +/* + This routine creates an empty memory buffer, then calls iraf2mem to + open the IRAF disk file and convert it to a FITS file in memeory. +*/ +{ + int status; + size_t filesize = 0; + + /* create a memory file with size = 0 for the FITS converted IRAF file */ + status = mem_createmem(filesize, hdl); + if (status) + { + ffpmsg("failed to create empty memory file (mem_iraf_open)"); + return(status); + } + + /* convert the iraf file into a FITS file in memory */ + status = iraf2mem(filename, memTable[*hdl].memaddrptr, + memTable[*hdl].memsizeptr, &filesize, &status); + + if (status) + { + mem_close_free(*hdl); /* free up the memory */ + ffpmsg("failed to convert IRAF file into memory (mem_iraf_open)"); + return(status); + } + + memTable[*hdl].currentpos = 0; /* save starting position */ + memTable[*hdl].fitsfilesize=filesize; /* and initial file size */ + + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_rawfile_open(char *filename, int rwmode, int *hdl) +/* + This routine creates an empty memory buffer, writes a minimal + image header, then copies the image data from the raw file into + memory. It will byteswap the pixel values if the raw array + is in little endian byte order. +*/ +{ + FILE *diskfile; + fitsfile *fptr; + short *sptr; + int status, endian, datatype, bytePerPix, naxis; + long dim[5] = {1,1,1,1,1}, ii, nvals, offset = 0; + size_t filesize = 0, datasize; + char rootfile[FLEN_FILENAME], *cptr = 0, *cptr2 = 0; + void *ptr; + + if (rwmode != READONLY) + { + ffpmsg( + "cannot open raw binary file with WRITE access (mem_rawfile_open)"); + ffpmsg(filename); + return(READONLY_FILE); + } + + cptr = strchr(filename, '['); /* search for opening bracket [ */ + + if (!cptr) + { + ffpmsg("binary file name missing '[' character (mem_rawfile_open)"); + ffpmsg(filename); + return(URL_PARSE_ERROR); + } + + *rootfile = '\0'; + strncat(rootfile, filename, cptr - filename); /* store the rootname */ + + cptr++; + + while (*cptr == ' ') + cptr++; /* skip leading blanks */ + + /* Get the Data Type of the Image */ + + if (*cptr == 'b' || *cptr == 'B') + { + datatype = BYTE_IMG; + bytePerPix = 1; + } + else if (*cptr == 'i' || *cptr == 'I') + { + datatype = SHORT_IMG; + bytePerPix = 2; + } + else if (*cptr == 'u' || *cptr == 'U') + { + datatype = USHORT_IMG; + bytePerPix = 2; + + } + else if (*cptr == 'j' || *cptr == 'J') + { + datatype = LONG_IMG; + bytePerPix = 4; + } + else if (*cptr == 'r' || *cptr == 'R' || *cptr == 'f' || *cptr == 'F') + { + datatype = FLOAT_IMG; + bytePerPix = 4; + } + else if (*cptr == 'd' || *cptr == 'D') + { + datatype = DOUBLE_IMG; + bytePerPix = 8; + } + else + { + ffpmsg("error in raw binary file datatype (mem_rawfile_open)"); + ffpmsg(filename); + return(URL_PARSE_ERROR); + } + + cptr++; + + /* get Endian: Big or Little; default is same as the local machine */ + + if (*cptr == 'b' || *cptr == 'B') + { + endian = 0; + cptr++; + } + else if (*cptr == 'l' || *cptr == 'L') + { + endian = 1; + cptr++; + } + else + endian = BYTESWAPPED; /* byteswapped machines are little endian */ + + /* read each dimension (up to 5) */ + + naxis = 1; + dim[0] = strtol(cptr, &cptr2, 10); + + if (cptr2 && *cptr2 == ',') + { + naxis = 2; + dim[1] = strtol(cptr2+1, &cptr, 10); + + if (cptr && *cptr == ',') + { + naxis = 3; + dim[2] = strtol(cptr+1, &cptr2, 10); + + if (cptr2 && *cptr2 == ',') + { + naxis = 4; + dim[3] = strtol(cptr2+1, &cptr, 10); + + if (cptr && *cptr == ',') + naxis = 5; + dim[4] = strtol(cptr+1, &cptr2, 10); + } + } + } + + cptr = maxvalue(cptr, cptr2); + + if (*cptr == ':') /* read starting offset value */ + offset = strtol(cptr+1, 0, 10); + + nvals = dim[0] * dim[1] * dim[2] * dim[3] * dim[4]; + datasize = nvals * bytePerPix; + filesize = nvals * bytePerPix + 2880; + filesize = ((filesize - 1) / 2880 + 1) * 2880; + + /* open the raw binary disk file */ + status = file_openfile(rootfile, READONLY, &diskfile); + if (status) + { + ffpmsg("failed to open raw binary file (mem_rawfile_open)"); + ffpmsg(rootfile); + return(status); + } + + /* create a memory file with corrct size for the FITS converted raw file */ + status = mem_createmem(filesize, hdl); + if (status) + { + ffpmsg("failed to create memory file (mem_rawfile_open)"); + fclose(diskfile); + return(status); + } + + /* open this piece of memory as a new FITS file */ + ffimem(&fptr, (void **) memTable[*hdl].memaddrptr, &filesize, 0, 0, &status); + + /* write the required header keywords */ + ffcrim(fptr, datatype, naxis, dim, &status); + + /* close the FITS file, but keep the memory allocated */ + ffclos(fptr, &status); + + if (status > 0) + { + ffpmsg("failed to write basic image header (mem_rawfile_open)"); + fclose(diskfile); + mem_close_free(*hdl); /* free up the memory */ + return(status); + } + + if (offset > 0) + fseek(diskfile, offset, 0); /* offset to start of the data */ + + /* read the raw data into memory */ + ptr = *memTable[*hdl].memaddrptr + 2880; + + if (fread((char *) ptr, 1, datasize, diskfile) != datasize) + status = READ_ERROR; + + fclose(diskfile); /* close the raw binary disk file */ + + if (status) + { + mem_close_free(*hdl); /* free up the memory */ + ffpmsg("failed to copy raw file data into memory (mem_rawfile_open)"); + return(status); + } + + if (datatype == USHORT_IMG) /* have to subtract 32768 from each unsigned */ + { /* value to conform to FITS convention. More */ + /* efficient way to do this is to just flip */ + /* the most significant bit. */ + + sptr = (short *) ptr; + + if (endian == BYTESWAPPED) /* working with native format */ + { + for (ii = 0; ii < nvals; ii++, sptr++) + { + *sptr = ( *sptr ) ^ 0x8000; + } + } + else /* pixels are byteswapped WRT the native format */ + { + for (ii = 0; ii < nvals; ii++, sptr++) + { + *sptr = ( *sptr ) ^ 0x80; + } + } + } + + if (endian) /* swap the bytes if array is in little endian byte order */ + { + if (datatype == SHORT_IMG || datatype == USHORT_IMG) + { + ffswap2( (short *) ptr, nvals); + } + else if (datatype == LONG_IMG || datatype == FLOAT_IMG) + { + ffswap4( (INT32BIT *) ptr, nvals); + } + + else if (datatype == DOUBLE_IMG) + { + ffswap8( (double *) ptr, nvals); + } + } + + memTable[*hdl].currentpos = 0; /* save starting position */ + memTable[*hdl].fitsfilesize=filesize; /* and initial file size */ + + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_uncompress2mem(char *filename, FILE *diskfile, int hdl) +{ +/* + lower level routine to uncompress a file into memory. The file + has already been opened and the memory buffer has been allocated. +*/ + + size_t finalsize; + int status; + /* uncompress file into memory */ + status = 0; + uncompress2mem(filename, diskfile, + memTable[hdl].memaddrptr, /* pointer to memory address */ + memTable[hdl].memsizeptr, /* pointer to size of memory */ + realloc, /* reallocation function */ + &finalsize, &status); /* returned file size nd status*/ + memTable[hdl].currentpos = 0; /* save starting position */ + memTable[hdl].fitsfilesize=finalsize; /* and initial file size */ + return status; +} +/*--------------------------------------------------------------------------*/ +int mem_size(int handle, OFF_T *filesize) +/* + return the size of the file; only called when the file is first opened +*/ +{ + *filesize = memTable[handle].fitsfilesize; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_close_free(int handle) +/* + close the file and free the memory. +*/ +{ + free( *(memTable[handle].memaddrptr) ); + + memTable[handle].memaddrptr = 0; + memTable[handle].memaddr = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_close_keep(int handle) +/* + close the memory file but do not free the memory. +*/ +{ + memTable[handle].memaddrptr = 0; + memTable[handle].memaddr = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_close_comp(int handle) +/* + compress the memory file, writing it out to the fileptr (which might + be stdout) +*/ +{ + int status = 0; + size_t compsize; + + /* compress file in memory to a .gz disk file */ + + if(compress2file_from_mem(memTable[handle].memaddr, + memTable[handle].fitsfilesize, + memTable[handle].fileptr, + &compsize, &status ) ) + { + ffpmsg("failed to copy memory file to file (mem_close_comp)"); + status = WRITE_ERROR; + } + + free( memTable[handle].memaddr ); /* free the memory */ + memTable[handle].memaddrptr = 0; + memTable[handle].memaddr = 0; + + /* close the compressed disk file (except if it is 'stdout' */ + if (memTable[handle].fileptr != stdout) + fclose(memTable[handle].fileptr); + + return(status); +} +/*--------------------------------------------------------------------------*/ +int mem_seek(int handle, OFF_T offset) +/* + seek to position relative to start of the file. +*/ +{ + if (offset > (OFF_T) memTable[handle].fitsfilesize ) + return(END_OF_FILE); + + memTable[handle].currentpos = offset; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_read(int hdl, void *buffer, long nbytes) +/* + read bytes from the current position in the file +*/ +{ + if (memTable[hdl].currentpos + nbytes > memTable[hdl].fitsfilesize) + return(END_OF_FILE); + + memcpy(buffer, + *(memTable[hdl].memaddrptr) + memTable[hdl].currentpos, + nbytes); + + memTable[hdl].currentpos += nbytes; + return(0); +} +/*--------------------------------------------------------------------------*/ +int mem_write(int hdl, void *buffer, long nbytes) +/* + write bytes at the current position in the file +*/ +{ + size_t newsize; + char *ptr; + + if ((size_t) (memTable[hdl].currentpos + nbytes) > + *(memTable[hdl].memsizeptr) ) + { + + if (!(memTable[hdl].mem_realloc)) + { + ffpmsg("realloc function not defined (mem_write)"); + return(WRITE_ERROR); + } + + /* + Attempt to reallocate additional memory: + the memory buffer size is incremented by the larger of: + 1 FITS block (2880 bytes) or + the defined 'deltasize' parameter + */ + + newsize = maxvalue( (size_t) + (((memTable[hdl].currentpos + nbytes - 1) / 2880) + 1) * 2880, + *(memTable[hdl].memsizeptr) + memTable[hdl].deltasize); + + /* call the realloc function */ + ptr = (memTable[hdl].mem_realloc)( + *(memTable[hdl].memaddrptr), + newsize); + if (!ptr) + { + ffpmsg("Failed to reallocate memory (mem_write)"); + return(MEMORY_ALLOCATION); + } + + *(memTable[hdl].memaddrptr) = ptr; + *(memTable[hdl].memsizeptr) = newsize; + } + + /* now copy the bytes from the buffer into memory */ + memcpy( *(memTable[hdl].memaddrptr) + memTable[hdl].currentpos, + buffer, + nbytes); + + memTable[hdl].currentpos += nbytes; + memTable[hdl].fitsfilesize = + maxvalue(memTable[hdl].fitsfilesize, + memTable[hdl].currentpos); + return(0); +} diff --git a/pkg/tbtables/cfitsio/drvrnet.c b/pkg/tbtables/cfitsio/drvrnet.c new file mode 100644 index 00000000..1f06f03b --- /dev/null +++ b/pkg/tbtables/cfitsio/drvrnet.c @@ -0,0 +1,2587 @@ +/* This file, drvrhttp.c contains driver routines for http, ftp and root + files. */ + +/* This file was written by Bruce O'Neel at the ISDC, Switzerland */ +/* The FITSIO software is maintained by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + + +/* Notes on the drivers: + + The ftp driver uses passive mode exclusivly. If your remote system can't + deal with passive mode then it'll fail. Since Netscape Navigator uses + passive mode as well there shouldn't be too many ftp servers which have + problems. + + + The http driver works properly with 301 and 302 redirects. For many more + gory details see http://www.w3c.org/Protocols/rfc2068/rfc2068. The only + catch to the 301/302 redirects is that they have to redirect to another + http:// url. If not, things would have to change a lot in cfitsio and this + was thought to be too difficult. + + Redirects look like + + + + 301 Moved Permanently + +

Moved Permanently

+ The document has moved here.

+ + + This redirect was from apache 1.2.5 but most of the other servers produce + something very similiar. The parser for the redirects finds the first + anchor tag in the body and goes there. If that wasn't what was intended + by the remote system then hopefully the error stack, which includes notes + about the redirect will help the user fix the problem. + + + + Root protocal doesn't have any real docs, so, the emperical docs are as + follows. + + First, you must use a slightly modified rootd server. The modifications + include implimentation of the stat command which returns the size of the + remote file. Without that it's impossible for cfitsio to work properly + since fitsfiles don't include any information about the size of the files + in the headers. The rootd server closes the connections on any errors, + including reading beyond the end of the file or seeking beyond the end + of the file. The rootd:// driver doesn't reopen a closed connection, if + the connection is closed you're pretty much done. + + The messages are of the form + + + + All binary information is transfered in network format, so use htonl and + ntohl to convert back and forth. + + :== 4 byte length, in network format, the len doesn't include the + length of + :== one of the message opcodes below, 4 bytes, network format + :== depends on opcode + + The response is of the same form with the same opcode sent. Success is + indicated by being 0. + + Root is a NFSish protocol where each read/write includes the byte + offset to read or write to. As a result, seeks will always succeed + in the driver even if they would cause a fatal error when you try + to read because you're beyond the end of the file. + + There is file locking on the host such that you need to possibly + create /usr/tmp/rootdtab on the host system. There is one file per + socket connection, though the rootd daemon can support multiple + files open at once. + + The messages are sent in the following order: + + ROOTD_USER - user name, is the user name, trailing + null is sent though it's not required it seems. A ROOTD_AUTH + message is returned with any sort of error meaning that the user + name is wrong. + + ROOTD_PASS - password, ones complemented, stored in . Once + again the trailing null is sent. Once again a ROOTD_AUTH message is + returned + + ROOTD_OPEN - includes filename and one of + {create|update|read} as the file mode. ~ seems to be dealt with + as the username's login directory. A ROOTD_OPEN message is + returned. + + Once the file is opened any of the following can be sent: + + ROOTD_STAT - file status and size + returns a message where is the file length in bytes + + ROOTD_FLUSH - flushes the file, not sure this has any real effect + on the daemon since the daemon uses open/read/write/close rather + than the buffered fopen/fread/fwrite/fclose. + + ROOTD_GET - on send includes a text message of + offset and length to get. Return is a status message first with a + status value, then, the raw bytes for the length that you + requested. It's an error to seek or read past the end of the file, + and, the rootd daemon exits and won't respond anymore. Ie, don't + do this. + + ROOTD_PUT - on send includes a text message of + offset and length to put. Then send the raw bytes you want to + write. Then recieve a status message + + + When you are finished then you send the message: + + ROOTD_CLOSE - closes the file + + Once the file is closed then the socket is closed. + +$Id: drvrnet.c,v 1.6 2002/02/22 14:15:45 hodge Exp $ + +$Log: drvrnet.c,v $ +Revision 1.6 2002/02/22 14:15:45 hodge +Install latest version (2.401) of CFITSIO. OPR 45286 + +Revision 1.56 2000/01/04 11:58:31 oneel +Updates so that compressed network files are dealt with regardless of +their file names and/or mime types. + +Revision 1.55 2000/01/04 10:52:40 oneel +cfitsio 2.034 + +Revision 1.51 1999/08/10 12:13:40 oneel +Make the http code a bit less picky about the types of files it +uncompresses. Now it also uncompresses files which end in .Z or .gz. + +Revision 1.50 1999/08/04 12:38:46 oneel +Don's 2.0.32 patch with dal 1.3 + +Revision 1.39 1998/12/02 15:31:33 oneel +Updates to drvrnet.c so that less compiler warnings would be +generated. Fixes the signal handling. + +Revision 1.38 1998/11/23 10:03:24 oneel +Added in a useragent string, as suggested by: +Tim Kimball · Data Systems Division ¦ kimball@stsci.edu · 410-338-4417 +Space Telescope Science Institute ¦ http://www.stsci.edu/~kimball/ +3700 San Martin Drive ¦ http://archive.stsci.edu/ +Baltimore MD 21218 USA ¦ http://faxafloi.stsci.edu:4547/ + + + */ + +#ifdef HAVE_NET_SERVICES +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include "fitsio2.h" + +static jmp_buf env; /* holds the jump buffer for setjmp/longjmp pairs */ +static void signal_handler(int sig); + + +/* Network routine error codes */ +#define NET_OK 0 +#define NOT_INET_ADDRESS -1000 +#define UNKNOWN_INET_HOST -1001 +#define CONNECTION_ERROR -1002 + +/* Network routine constants */ +#define NET_DEFAULT 0 +#define NET_OOB 1 +#define NET_PEEK 2 + +#define NETTIMEOUT 180 /* in secs */ + +/* local defines and variables */ +#define MAXLEN 1200 +#define SHORTLEN 100 +static char netoutfile[MAXLEN]; + + +#define ROOTD_USER 2000 /*user id follows */ +#define ROOTD_PASS 2001 /*passwd follows */ +#define ROOTD_AUTH 2002 /*authorization status (to client) */ +#define ROOTD_FSTAT 2003 /*filename follows */ +#define ROOTD_OPEN 2004 /*filename follows + mode */ +#define ROOTD_PUT 2005 /*offset, number of bytes and buffer */ +#define ROOTD_GET 2006 /*offset, number of bytes */ +#define ROOTD_FLUSH 2007 /*flush file */ +#define ROOTD_CLOSE 2008 /*close file */ +#define ROOTD_STAT 2009 /*return rootd statistics */ +#define ROOTD_ACK 2010 /*acknowledgement (all OK) */ +#define ROOTD_ERR 2011 /*error code and message follow */ + +typedef struct /* structure containing disk file structure */ +{ + int sock; + OFF_T currentpos; +} rootdriver; + +static rootdriver handleTable[NIOBUF]; /* allocate diskfile handle tables */ + +/* static prototypes */ + +static int NET_TcpConnect(char *hostname, int port); +static int NET_SendRaw(int sock, const void *buf, int length, int opt); +static int NET_RecvRaw(int sock, void *buffer, int length); +static int NET_ParseUrl(const char *url, char *proto, char *host, int *port, + char *fn); +static int CreateSocketAddress(struct sockaddr_in *sockaddrPtr, + char *host,int port); +static int ftp_status(FILE *ftp, char *statusstr); +static int http_open_network(char *url, FILE **httpfile, char *contentencoding, + int *contentlength); +static int ftp_open_network(char *url, FILE **ftpfile, FILE **command, + int *sock); + +static int root_send_buffer(int sock, int op, char *buffer, int buflen); +static int root_recv_buffer(int sock, int *op, char *buffer,int buflen); +static int root_openfile(char *filename, char *rwmode, int *sock); + +/***************************/ +/* Static variables */ + +static int closehttpfile; +static int closememfile; +static int closefdiskfile; +static int closediskfile; +static int closefile; +static int closeoutfile; +static int closecommandfile; +static int closeftpfile; +static FILE *diskfile; +static FILE *outfile; + +/*--------------------------------------------------------------------------*/ +/* This creates a memory file handle with a copy of the URL in filename. The + file is uncompressed if necessary */ + +int http_open(char *filename, int rwmode, int *handle) +{ + + FILE *httpfile; + char contentencoding[SHORTLEN]; + char newfilename[MAXLEN]; + char errorstr[MAXLEN]; + char recbuf[MAXLEN]; + long len; + int contentlength; + int status; + char firstchar; + + closehttpfile = 0; + closememfile = 0; + + /* don't do r/w files */ + if (rwmode != 0) { + ffpmsg("Can't open http:// type file with READWRITE access"); + ffpmsg(" Specify an outfile for r/w access (http_open)"); + goto error; + } + + /* do the signal handler bits */ + if (setjmp(env) != 0) { + /* feels like the second time */ + /* this means something bad happened */ + ffpmsg("Timeout (http_open)"); + goto error; + } + + (void) signal(SIGALRM, signal_handler); + + /* Open the network connection */ + + /* Does the file have a .Z or .gz in it */ + /* Also, if file has a '?' in it (probably cgi script) */ + if (strstr(filename,".Z") || strstr(filename,".gz") || + strstr(filename,"?")) { + alarm(NETTIMEOUT); + if (http_open_network(filename,&httpfile,contentencoding, + &contentlength)) { + alarm(0); + ffpmsg("Unable to open http file (http_open):"); + ffpmsg(filename); + goto error; + } + } else { + alarm(NETTIMEOUT); + /* Try the .gz one */ + strcpy(newfilename,filename); + strcat(newfilename,".gz"); + + if (http_open_network(newfilename,&httpfile,contentencoding, + &contentlength)) { + alarm(0); + /* Now the .Z one */ + strcpy(newfilename,filename); + strcat(newfilename,".Z"); + alarm(NETTIMEOUT); + if (http_open_network(newfilename,&httpfile,contentencoding, + &contentlength)) { + alarm(0); + alarm(NETTIMEOUT); + if (http_open_network(filename,&httpfile,contentencoding, + &contentlength)) { + alarm(0); + ffpmsg("Unable to open http file (http_open)"); + ffpmsg(filename); + goto error; + } + } + } + } + + closehttpfile++; + + /* Create the memory file */ + if ((status = mem_create(filename,handle))) { + ffpmsg("Unable to create memory file (http_open)"); + goto error; + } + + closememfile++; + + /* Now, what do we do with the file */ + /* Check to see what the first character is */ + firstchar = fgetc(httpfile); + ungetc(firstchar,httpfile); + if (!strcmp(contentencoding,"x-gzip") || + !strcmp(contentencoding,"x-compress") || + strstr(filename,".gz") || + strstr(filename,".Z") || + ('\037' == firstchar)) { + /* do the compress dance, which is the same as the gzip dance */ + /* Using the cfitsio routine */ + + status = 0; + /* Ok, this is a tough case, let's be arbritary and say 10*NETTIMEOUT, + Given the choices for nettimeout above they'll probaby ^C before, but + it's always worth a shot*/ + + alarm(NETTIMEOUT*10); + status = mem_uncompress2mem(filename, httpfile, *handle); + alarm(0); + if (status) { + ffpmsg("Error writing compressed memory file (http_open)"); + ffpmsg(filename); + goto error; + } + + } else { + /* It's not compressed, bad choice, but we'll copy it anyway */ + if (contentlength % 2880) { + sprintf(errorstr,"Content-Length not a multiple of 2880 (http_open) %d", + contentlength); + ffpmsg(errorstr); + } + + /* write a memory file */ + alarm(NETTIMEOUT); + while(0 != (len = fread(recbuf,1,MAXLEN,httpfile))) { + alarm(0); /* cancel alarm */ + status = mem_write(*handle,recbuf,len); + if (status) { + ffpmsg("Error copying http file into memory (http_open)"); + ffpmsg(filename); + goto error; + } + alarm(NETTIMEOUT); /* rearm the alarm */ + } + } + + fclose(httpfile); + + signal(SIGALRM, SIG_DFL); + alarm(0); + return mem_seek(*handle,0); + + error: + alarm(0); /* clear it */ + if (closehttpfile) { + fclose(httpfile); + } + if (closememfile) { + mem_close_free(*handle); + } + + signal(SIGALRM, SIG_DFL); + return (FILE_NOT_OPENED); +} +/*--------------------------------------------------------------------------*/ +/* This creates a memory file handle with a copy of the URL in filename. The + file must be compressed and is copied (still compressed) to disk first. + The compressed disk file is then uncompressed into memory (READONLY). +*/ + +int http_compress_open(char *url, int rwmode, int *handle) +{ + FILE *httpfile; + char contentencoding[SHORTLEN]; + char recbuf[MAXLEN]; + long len; + int contentlength; + int ii, flen, status; + char firstchar; + + closehttpfile = 0; + closediskfile = 0; + closefdiskfile = 0; + closememfile = 0; + + /* cfileio made a mistake, should set the netoufile first otherwise + we don't know where to write the output file */ + + flen = strlen(netoutfile); + if (!flen) { + ffpmsg + ("Output file not set, shouldn't have happened (http_compress_open)"); + goto error; + } + + if (rwmode != 0) { + ffpmsg("Can't open compressed http:// type file with READWRITE access"); + ffpmsg(" Specify an UNCOMPRESSED outfile (http_compress_open)"); + goto error; + } + /* do the signal handler bits */ + if (setjmp(env) != 0) { + /* feels like the second time */ + /* this means something bad happened */ + ffpmsg("Timeout (http_open)"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* Open the http connectin */ + alarm(NETTIMEOUT); + if ((status = http_open_network(url,&httpfile,contentencoding, + &contentlength))) { + alarm(0); + ffpmsg("Unable to open http file (http_compress_open)"); + ffpmsg(url); + goto error; + } + + closehttpfile++; + + /* Better be compressed */ + + firstchar = fgetc(httpfile); + ungetc(firstchar,httpfile); + if (!strcmp(contentencoding,"x-gzip") || + !strcmp(contentencoding,"x-compress") || + ('\037' == firstchar)) { + + if (*netoutfile == '!') + { + /* user wants to clobber file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + status = file_remove(netoutfile); + } + + /* Create the new file */ + if ((status = file_create(netoutfile,handle))) { + ffpmsg("Unable to create output disk file (http_compress_open):"); + ffpmsg(netoutfile); + goto error; + } + + closediskfile++; + + /* write a file */ + alarm(NETTIMEOUT); + while(0 != (len = fread(recbuf,1,MAXLEN,httpfile))) { + alarm(0); + status = file_write(*handle,recbuf,len); + if (status) { + ffpmsg("Error writing disk file (http_compres_open)"); + ffpmsg(netoutfile); + goto error; + } + alarm(NETTIMEOUT); + } + file_close(*handle); + fclose(httpfile); + closehttpfile--; + closediskfile--; + + /* File is on disk, let's uncompress it into memory */ + + if (NULL == (diskfile = fopen(netoutfile,"r"))) { + ffpmsg("Unable to reopen disk file (http_compress_open)"); + ffpmsg(netoutfile); + goto error; + } + closefdiskfile++; + + /* Create the memory handle to hold it */ + if ((status = mem_create(url,handle))) { + ffpmsg("Unable to create memory file (http_compress_open)"); + goto error; + } + closememfile++; + + /* Uncompress it */ + status = 0; + status = mem_uncompress2mem(url,diskfile,*handle); + fclose(diskfile); + closefdiskfile--; + if (status) { + ffpmsg("Error uncompressing disk file to memory (http_compress_open)"); + ffpmsg(netoutfile); + goto error; + } + + } else { + /* Opps, this should not have happened */ + ffpmsg("Can only have compressed files here (http_compress_open)"); + goto error; + } + + signal(SIGALRM, SIG_DFL); + alarm(0); + return mem_seek(*handle,0); + + error: + alarm(0); /* clear it */ + if (closehttpfile) { + fclose(httpfile); + } + if (closefdiskfile) { + fclose(diskfile); + } + if (closememfile) { + mem_close_free(*handle); + } + if (closediskfile) { + file_close(*handle); + } + + signal(SIGALRM, SIG_DFL); + return (FILE_NOT_OPENED); +} + +/*--------------------------------------------------------------------------*/ +/* This creates a file handle with a copy of the URL in filename. The http + file is copied to disk first. If it's compressed then it is + uncompressed when copying to the disk */ + +int http_file_open(char *url, int rwmode, int *handle) +{ + FILE *httpfile; + char contentencoding[SHORTLEN]; + char errorstr[MAXLEN]; + char recbuf[MAXLEN]; + long len; + int contentlength; + int ii, flen, status; + char firstchar; + + /* Check if output file is actually a memory file */ + if (!strncmp(netoutfile, "mem:", 4) ) + { + /* allow the memory file to be opened with write access */ + return( http_open(url, READONLY, handle) ); + } + + closehttpfile = 0; + closefile = 0; + closeoutfile = 0; + + /* cfileio made a mistake, we need to know where to write the file */ + flen = strlen(netoutfile); + if (!flen) { + ffpmsg("Output file not set, shouldn't have happened (http_file_open)"); + return (FILE_NOT_OPENED); + } + + /* do the signal handler bits */ + if (setjmp(env) != 0) { + /* feels like the second time */ + /* this means something bad happened */ + ffpmsg("Timeout (http_open)"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* Open the network connection */ + alarm(NETTIMEOUT); + if ((status = http_open_network(url,&httpfile,contentencoding, + &contentlength))) { + alarm(0); + ffpmsg("Unable to open http file (http_file_open)"); + ffpmsg(url); + goto error; + } + + closehttpfile++; + + if (*netoutfile == '!') + { + /* user wants to clobber disk file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + status = file_remove(netoutfile); + } + + firstchar = fgetc(httpfile); + ungetc(firstchar,httpfile); + if (!strcmp(contentencoding,"x-gzip") || + !strcmp(contentencoding,"x-compress") || + ('\037' == firstchar)) { + + /* to make this more cfitsioish we use the file driver calls to create + the disk file */ + + /* Create the output file */ + if ((status = file_create(netoutfile,handle))) { + ffpmsg("Unable to create output file (http_file_open)"); + ffpmsg(netoutfile); + goto error; + } + + file_close(*handle); + if (NULL == (outfile = fopen(netoutfile,"w"))) { + ffpmsg("Unable to reopen the output file (http_file_open)"); + ffpmsg(netoutfile); + goto error; + } + closeoutfile++; + status = 0; + + /* Ok, this is a tough case, let's be arbritary and say 10*NETTIMEOUT, + Given the choices for nettimeout above they'll probaby ^C before, but + it's always worth a shot*/ + + alarm(NETTIMEOUT*10); + status = uncompress2file(url,httpfile,outfile,&status); + alarm(0); + if (status) { + ffpmsg("Error uncompressing http file to disk file (http_file_open)"); + ffpmsg(url); + ffpmsg(netoutfile); + goto error; + } + fclose(outfile); + closeoutfile--; + } else { + + /* Create the output file */ + if ((status = file_create(netoutfile,handle))) { + ffpmsg("Unable to create output file (http_file_open)"); + ffpmsg(netoutfile); + goto error; + } + + /* Give a warning message. This could just be bad padding at the end + so don't treat it like an error. */ + closefile++; + + if (contentlength % 2880) { + sprintf(errorstr, + "Content-Length not a multiple of 2880 (http_file_open) %d", + contentlength); + ffpmsg(errorstr); + } + + /* write a file */ + alarm(NETTIMEOUT); + while(0 != (len = fread(recbuf,1,MAXLEN,httpfile))) { + alarm(0); + status = file_write(*handle,recbuf,len); + if (status) { + ffpmsg("Error copying http file to disk file (http_file_open)"); + ffpmsg(url); + ffpmsg(netoutfile); + goto error; + } + } + file_close(*handle); + closefile--; + } + + fclose(httpfile); + closehttpfile--; + + signal(SIGALRM, SIG_DFL); + alarm(0); + + return file_open(netoutfile,rwmode,handle); + + error: + alarm(0); /* clear it */ + if (closehttpfile) { + fclose(httpfile); + } + if (closeoutfile) { + fclose(outfile); + } + if (closefile) { + file_close(*handle); + } + + signal(SIGALRM, SIG_DFL); + return (FILE_NOT_OPENED); +} + +/*--------------------------------------------------------------------------*/ +/* This is the guts of the code to get a file via http. + url is the input url + httpfile is set to be the file connected to the socket which you can + read the file from + contentencoding is the mime type of the file, returned if the http server + returns it + contentlength is the lenght of the file, returned if the http server returns + it +*/ +static int http_open_network(char *url, FILE **httpfile, char *contentencoding, + int *contentlength) +{ + + int status; + int sock; + int tmpint; + char recbuf[MAXLEN]; + char tmpstr[MAXLEN]; + char tmpstr1[SHORTLEN]; + char errorstr[MAXLEN]; + char proto[SHORTLEN]; + char host[SHORTLEN]; + char fn[MAXLEN]; + char turl[MAXLEN]; + char *scratchstr; + int port; + float version; + + + /* Parse the URL apart again */ + strcpy(turl,"http://"); + strcat(turl,url); + if (NET_ParseUrl(turl,proto,host,&port,fn)) { + sprintf(errorstr,"URL Parse Error (http_open) %s",url); + ffpmsg(errorstr); + return (FILE_NOT_OPENED); + } + + /* Connect to the remote host */ + sock = NET_TcpConnect(host,port); + if (sock < 0) { + ffpmsg("Couldn't connect to host (http_open_network)"); + return (FILE_NOT_OPENED); + } + + /* Make the socket a stdio file */ + if (NULL == (*httpfile = fdopen(sock,"r"))) { + ffpmsg ("fdopen failed to convert socket to file (http_open_network)"); + close(sock); + return (FILE_NOT_OPENED); + } + + /* Send the GET request to the remote server */ + strcpy(tmpstr,"GET "); + strcat(tmpstr,fn); + strcat(tmpstr," http/1.0\n"); + sprintf(tmpstr1,"User-Agent: HEASARC/CFITSIO/%-8.3f\n\n",ffvers(&version)); + strcat(tmpstr,tmpstr1); + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + /* read the header */ + if (!(fgets(recbuf,MAXLEN,*httpfile))) { + sprintf (errorstr,"http header short (http_open_network) %s",recbuf); + ffpmsg(errorstr); + fclose(*httpfile); + return (FILE_NOT_OPENED); + } + *contentlength = 0; + contentencoding[0] = '\0'; + + /* Our choices are 200, ok, 301, temporary redirect, or 302 perm redirect */ + sscanf(recbuf,"%s %d",tmpstr,&status); + if (status != 200){ + if (status == 301 || status == 302) { + /* got a redirect */ + if (status == 301) { + ffpmsg("Note: Web server replied with a temporary redirect from"); + } else { + ffpmsg("Note: Web server replied with a redirect from"); + } + ffpmsg(turl); + /* now, let's not write the most sophisticated parser here */ + + while (fgets(recbuf,MAXLEN,*httpfile)) { + scratchstr = strstr(recbuf," 3) { + recbuf[strlen(recbuf)-1] = '\0'; + recbuf[strlen(recbuf)-1] = '\0'; + } + sscanf(recbuf,"%s %d",tmpstr,&tmpint); + /* Did we get a content-length header ? */ + if (!strcmp(tmpstr,"Content-Length:")) { + *contentlength = tmpint; + } + /* Did we get the content-encoding header ? */ + if (!strcmp(tmpstr,"Content-Encoding:")) { + if (NULL != (scratchstr = strstr(recbuf,":"))) { + /* Found the : */ + scratchstr++; /* skip the : */ + scratchstr++; /* skip the extra space */ + strcpy(contentencoding,scratchstr); + } + } + } + + /* we're done, so return */ + return 0; +} + + +/*--------------------------------------------------------------------------*/ +/* This creates a memory file handle with a copy of the URL in filename. The + file is uncompressed if necessary */ + +int ftp_open(char *filename, int rwmode, int *handle) +{ + + FILE *ftpfile; + FILE *command; + int sock; + char newfilename[MAXLEN]; + char recbuf[MAXLEN]; + long len; + int status; + char firstchar; + + closememfile = 0; + closecommandfile = 0; + closeftpfile = 0; + + /* don't do r/w files */ + if (rwmode != 0) { + ffpmsg("Can't open ftp:// type file with READWRITE access"); + ffpmsg("Specify an outfile for r/w access (ftp_open)"); + return (FILE_NOT_OPENED); + } + + /* do the signal handler bits */ + if (setjmp(env) != 0) { + /* feels like the second time */ + /* this means something bad happened */ + ffpmsg("Timeout (http_open)"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* Open the ftp connetion. ftpfile is connected to the file port, + command is connected to port 21. sock is the socket on port 21 */ + + alarm(NETTIMEOUT); + strcpy(newfilename,filename); + /* Does the file have a .Z or .gz in it */ + if (strstr(newfilename,".Z") || strstr(newfilename,".gz")) { + alarm(NETTIMEOUT); + if (ftp_open_network(filename,&ftpfile,&command,&sock)) { + + alarm(0); + ffpmsg("Unable to open ftp file (ftp_open)"); + ffpmsg(filename); + goto error; + } + } else { + /* Try the .gz one */ + strcpy(newfilename,filename); + strcat(newfilename,".gz"); + alarm(NETTIMEOUT); + if (ftp_open_network(newfilename,&ftpfile,&command,&sock)) { + + alarm(0); + strcpy(newfilename,filename); + strcat(newfilename,".Z"); + alarm(NETTIMEOUT); + if (ftp_open_network(newfilename,&ftpfile,&command,&sock)) { + + /* Now as given */ + alarm(0); + strcpy(newfilename,filename); + alarm(NETTIMEOUT); + if (ftp_open_network(newfilename,&ftpfile,&command,&sock)) { + alarm(0); + ffpmsg("Unable to open ftp file (ftp_open)"); + ffpmsg(newfilename); + goto error; + } + } + } + } + + closeftpfile++; + closecommandfile++; + + /* create the memory file */ + if ((status = mem_create(filename,handle))) { + ffpmsg ("Could not create memory file to passive port (ftp_open)"); + ffpmsg(filename); + goto error; + } + closememfile++; + /* This isn't quite right, it'll fail if the file has .gzabc at the end + for instance */ + + /* Decide if the file is compressed */ + firstchar = fgetc(ftpfile); + ungetc(firstchar,ftpfile); + + if (strstr(newfilename,".gz") || + strstr(newfilename,".Z") || + ('\037' == firstchar)) { + + status = 0; + /* A bit arbritary really, the user will probably hit ^C */ + alarm(NETTIMEOUT*10); + status = mem_uncompress2mem(filename, ftpfile, *handle); + alarm(0); + if (status) { + ffpmsg("Error writing compressed memory file (ftp_open)"); + ffpmsg(filename); + goto error; + } + } else { + /* write a memory file */ + alarm(NETTIMEOUT); + while(0 != (len = fread(recbuf,1,MAXLEN,ftpfile))) { + alarm(0); + status = mem_write(*handle,recbuf,len); + if (status) { + ffpmsg("Error writing memory file (http_open)"); + ffpmsg(filename); + goto error; + } + alarm(NETTIMEOUT); + } + } + + /* close and clean up */ + fclose(ftpfile); + closeftpfile--; + + NET_SendRaw(sock,"QUIT\n",5,NET_DEFAULT); + fclose(command); + closecommandfile--; + + signal(SIGALRM, SIG_DFL); + alarm(0); + + return mem_seek(*handle,0); + + error: + alarm(0); /* clear it */ + if (closecommandfile) { + fclose(command); + } + if (closeftpfile) { + fclose(ftpfile); + } + if (closememfile) { + mem_close_free(*handle); + } + + signal(SIGALRM, SIG_DFL); + return (FILE_NOT_OPENED); +} +/*--------------------------------------------------------------------------*/ +/* This creates a file handle with a copy of the URL in filename. The + file must be uncompressed and is copied to disk first */ + +int ftp_file_open(char *url, int rwmode, int *handle) +{ + FILE *ftpfile; + FILE *command; + char recbuf[MAXLEN]; + long len; + int sock; + int ii, flen, status; + char firstchar; + + /* Check if output file is actually a memory file */ + if (!strncmp(netoutfile, "mem:", 4) ) + { + /* allow the memory file to be opened with write access */ + return( ftp_open(url, READONLY, handle) ); + } + + closeftpfile = 0; + closecommandfile = 0; + closefile = 0; + closeoutfile = 0; + + /* cfileio made a mistake, need to know where to write the output file */ + flen = strlen(netoutfile); + if (!flen) + { + ffpmsg("Output file not set, shouldn't have happened (ftp_file_open)"); + return (FILE_NOT_OPENED); + } + + /* do the signal handler bits */ + if (setjmp(env) != 0) { + /* feels like the second time */ + /* this means something bad happened */ + ffpmsg("Timeout (http_open)"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* open the network connection to url. ftpfile holds the connection to + the input file, command holds the connection to port 21, and sock is + the socket connected to port 21 */ + + alarm(NETTIMEOUT); + if ((status = ftp_open_network(url,&ftpfile,&command,&sock))) { + alarm(0); + ffpmsg("Unable to open http file (ftp_file_open)"); + ffpmsg(url); + goto error; + } + closeftpfile++; + closecommandfile++; + + if (*netoutfile == '!') + { + /* user wants to clobber file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + status = file_remove(netoutfile); + } + + /* Now, what do we do with the file */ + firstchar = fgetc(ftpfile); + ungetc(firstchar,ftpfile); + + if (strstr(url,".gz") || + strstr(url,".Z") || + ('\037' == firstchar)) { + + /* to make this more cfitsioish we use the file driver calls to create + the file */ + /* Create the output file */ + if ((status = file_create(netoutfile,handle))) { + ffpmsg("Unable to create output file (ftp_file_open)"); + ffpmsg(netoutfile); + goto error; + } + + file_close(*handle); + if (NULL == (outfile = fopen(netoutfile,"w"))) { + ffpmsg("Unable to reopen the output file (ftp_file_open)"); + ffpmsg(netoutfile); + goto error; + } + closeoutfile++; + status = 0; + + /* Ok, this is a tough case, let's be arbritary and say 10*NETTIMEOUT, + Given the choices for nettimeout above they'll probaby ^C before, but + it's always worth a shot*/ + + alarm(NETTIMEOUT*10); + status = uncompress2file(url,ftpfile,outfile,&status); + alarm(0); + if (status) { + ffpmsg("Unable to uncompress the output file (ftp_file_open)"); + ffpmsg(url); + ffpmsg(netoutfile); + goto error; + } + fclose(outfile); + closeoutfile--; + + } else { + + /* Create the output file */ + if ((status = file_create(netoutfile,handle))) { + ffpmsg("Unable to create output file (ftp_file_open)"); + ffpmsg(netoutfile); + goto error; + } + closefile++; + + /* write a file */ + alarm(NETTIMEOUT); + while(0 != (len = fread(recbuf,1,MAXLEN,ftpfile))) { + alarm(0); + status = file_write(*handle,recbuf,len); + if (status) { + ffpmsg("Error writing file (ftp_file_open)"); + ffpmsg(url); + ffpmsg(netoutfile); + goto error; + } + alarm(NETTIMEOUT); + } + file_close(*handle); + } + fclose(ftpfile); + closeftpfile--; + + NET_SendRaw(sock,"QUIT\n",5,NET_DEFAULT); + fclose(command); + closecommandfile--; + + signal(SIGALRM, SIG_DFL); + alarm(0); + + return file_open(netoutfile,rwmode,handle); + + error: + alarm(0); /* clear it */ + if (closeftpfile) { + fclose(ftpfile); + } + if (closecommandfile) { + fclose(command); + } + if (closeoutfile) { + fclose(outfile); + } + if (closefile) { + file_close(*handle); + } + + signal(SIGALRM, SIG_DFL); + return (FILE_NOT_OPENED); +} + +/*--------------------------------------------------------------------------*/ +/* This creates a memory handle with a copy of the URL in filename. The + file must be compressed and is copied to disk first */ + +int ftp_compress_open(char *url, int rwmode, int *handle) +{ + FILE *ftpfile; + FILE *command; + char recbuf[MAXLEN]; + long len; + int ii, flen, status; + int sock; + char firstchar; + + closeftpfile = 0; + closecommandfile = 0; + closememfile = 0; + closefdiskfile = 0; + closediskfile = 0; + + /* don't do r/w files */ + if (rwmode != 0) { + ffpmsg("Compressed files must be r/o"); + return (FILE_NOT_OPENED); + } + + /* Need to know where to write the output file */ + flen = strlen(netoutfile); + if (!flen) + { + ffpmsg( + "Output file not set, shouldn't have happened (ftp_compress_open)"); + return (FILE_NOT_OPENED); + } + + /* do the signal handler bits */ + if (setjmp(env) != 0) { + /* feels like the second time */ + /* this means something bad happened */ + ffpmsg("Timeout (http_open)"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* Open the network connection to url, ftpfile is connected to the file + port, command is connected to port 21. sock is for writing to port 21 */ + alarm(NETTIMEOUT); + if ((status = ftp_open_network(url,&ftpfile,&command,&sock))) { + alarm(0); + ffpmsg("Unable to open ftp file (ftp_compress_open)"); + ffpmsg(url); + goto error; + } + closeftpfile++; + closecommandfile++; + + /* Now, what do we do with the file */ + firstchar = fgetc(ftpfile); + ungetc(firstchar,ftpfile); + + if (strstr(url,".gz") || + strstr(url,".Z") || + ('\037' == firstchar)) { + + if (*netoutfile == '!') + { + /* user wants to clobber file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + status = file_remove(netoutfile); + } + + /* Create the output file */ + if ((status = file_create(netoutfile,handle))) { + ffpmsg("Unable to create output file (ftp_compress_open)"); + ffpmsg(netoutfile); + goto error; + } + closediskfile++; + + /* write a file */ + alarm(NETTIMEOUT); + while(0 != (len = fread(recbuf,1,MAXLEN,ftpfile))) { + alarm(0); + status = file_write(*handle,recbuf,len); + if (status) { + ffpmsg("Error writing file (ftp_compres_open)"); + ffpmsg(url); + ffpmsg(netoutfile); + goto error; + } + alarm(NETTIMEOUT); + } + + file_close(*handle); + closediskfile--; + fclose(ftpfile); + closeftpfile--; + /* Close down the ftp connection */ + NET_SendRaw(sock,"QUIT\n",5,NET_DEFAULT); + fclose(command); + closecommandfile--; + + /* File is on disk, let's uncompress it into memory */ + + if (NULL == (diskfile = fopen(netoutfile,"r"))) { + ffpmsg("Unable to reopen disk file (ftp_compress_open)"); + ffpmsg(netoutfile); + return (FILE_NOT_OPENED); + } + closefdiskfile++; + + if ((status = mem_create(url,handle))) { + ffpmsg("Unable to create memory file (ftp_compress_open)"); + ffpmsg(url); + goto error; + } + closememfile++; + + status = 0; + status = mem_uncompress2mem(url,diskfile,*handle); + fclose(diskfile); + closefdiskfile--; + + if (status) { + ffpmsg("Error writing compressed memory file (ftp_compress_open)"); + goto error; + } + + } else { + /* Opps, this should not have happened */ + ffpmsg("Can only compressed files here (ftp_compress_open)"); + goto error; + } + + + signal(SIGALRM, SIG_DFL); + alarm(0); + return mem_seek(*handle,0); + + error: + alarm(0); /* clear it */ + if (closeftpfile) { + fclose(ftpfile); + } + if (closecommandfile) { + fclose(command); + } + if (closefdiskfile) { + fclose(diskfile); + } + if (closememfile) { + mem_close_free(*handle); + } + if (closediskfile) { + file_close(*handle); + } + + signal(SIGALRM, SIG_DFL); + return (FILE_NOT_OPENED); +} + +/*--------------------------------------------------------------------------*/ +/* Open a ftp connection to filename (really a URL), return ftpfile set to + the file connection, and command set to the control connection, with sock + also set to the control connection */ + +int ftp_open_network(char *filename, FILE **ftpfile, FILE **command, int *sock) +{ + int status; + int sock1; + int tmpint; + char recbuf[MAXLEN]; + char errorstr[MAXLEN]; + char tmpstr[MAXLEN]; + char proto[SHORTLEN]; + char host[SHORTLEN]; + char *newhost; + char *username; + char *password; + char fn[MAXLEN]; + char *newfn; + char *passive; + char *tstr; + char ip[SHORTLEN]; + char turl[MAXLEN]; + int port; + + /* parse the URL */ + strcpy(turl,"ftp://"); + strcat(turl,filename); + if (NET_ParseUrl(turl,proto,host,&port,fn)) { + sprintf(errorstr,"URL Parse Error (ftp_open) %s",filename); + ffpmsg(errorstr); + return (FILE_NOT_OPENED); + } +#ifdef DEBUG + printf ("proto, %s, host, %s, port %d, fn %s\n",proto,host,port,fn); +#endif + + port = 21; + /* we might have a user name */ + username = "anonymous"; + password = "user@host.com"; + /* is there an @ sign */ + if (NULL != (newhost = strrchr(host,'@'))) { + *newhost = '\0'; /* make it a null, */ + newhost++; /* Now newhost points to the host name and host points to the + user name, password combo */ + username = host; + /* is there a : for a password */ + if (NULL != strchr(username,':')) { + password = strchr(username,':'); + *password = '\0'; + password++; + } + } else { + newhost = host; + } + +#ifdef DEBUG + printf("User %s pass %s\n",username,password); +#endif + + /* Connect to the host on the required port */ + *sock = NET_TcpConnect(newhost,port); + /* convert it to a stdio file */ + if (NULL == (*command = fdopen(*sock,"r"))) { + ffpmsg ("fdopen failed to convert socket to stdio file (ftp_open)"); + return (FILE_NOT_OPENED); + + } + + /* Wait for the 220 response */ + if (ftp_status(*command,"220 ")) { + ffpmsg ("error connecting to remote server, no 220 seen (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + /* Send the user name and wait for the right response */ + sprintf(tmpstr,"USER %s\n",username); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"331 ")) { + ffpmsg ("USER error no 331 seen (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + + } + + /* Send the password and wait for the right response */ + sprintf(tmpstr,"PASS %s\n",password); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"230 ")) { + ffpmsg ("PASS error, no 230 seen (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + + /* now do the cwd command */ + newfn = strrchr(fn,'/'); + if (newfn == NULL) { + strcpy(tmpstr,"CWD /\n"); + newfn = fn; + } else { + *newfn = '\0'; + newfn++; + if (strlen(fn) == 0) { + strcpy(tmpstr,"CWD /\n"); + } else { + /* remove the leading slash */ + if (fn[0] == '/') { + sprintf(tmpstr,"CWD %s\n",&fn[1]); + } else { + sprintf(tmpstr,"CWD %s\n",fn); + } + } + } + +#ifdef DEBUG + printf("CWD command is %s\n",tmpstr); +#endif + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"250 ")) { + ffpmsg ("CWD error, no 250 seen (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + if (!strlen(newfn)) { + ffpmsg("Null file name (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + /* Send the retrieve command to see if the file exists*/ + sprintf(tmpstr,"RETR %s\n",newfn); +#ifdef DEBUG + printf ("Checking to see if %s, exists %d\n",tmpstr,strlen(newfn)); +#endif + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + /* We better get a 425 here, we haven't sent a PORT or PASV command + yet. If we don't get a 425 then we're hosed and the file + doesn't exist */ + if (ftp_status(*command,"425 ")) { + ffpmsg("File doesn't exist on remote server (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + /* we're going to use passive mode here */ + + status = NET_SendRaw(*sock,"PASV\n",5,NET_DEFAULT); + if (!(fgets(recbuf,MAXLEN,*command))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + /* Passive mode response looks like + 227 Entering Passive Mode (129,194,67,8,210,80) */ + if (recbuf[0] == '2' && recbuf[1] == '2' && recbuf[2] == '7') { + /* got a good passive mode response, find the opening ( */ + + if (!(passive = strchr(recbuf,'('))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + *passive = '\0'; + passive++; + ip[0] = '\0'; + + /* Messy parsing of response from PASV *command */ + + if (!(tstr = strtok(passive,",)"))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + strcpy(ip,tstr); + strcat(ip,"."); + + if (!(tstr = strtok(NULL,",)"))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + strcat(ip,tstr); + strcat(ip,"."); + + if (!(tstr = strtok(NULL,",)"))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + strcat(ip,tstr); + strcat(ip,"."); + + if (!(tstr = strtok(NULL,",)"))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + strcat(ip,tstr); + + /* Done the ip number, now do the port # */ + if (!(tstr = strtok(NULL,",)"))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + sscanf(tstr,"%d",&port); + port *= 256; + + if (!(tstr = strtok(NULL,",)"))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + sscanf(tstr,"%d",&tmpint); + port += tmpint; + + /* Always use binary mode */ + sprintf(tmpstr,"TYPE I\n"); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"200 ")) { + ffpmsg ("TYPE I error, 200 not seen (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + if (!strlen(newfn)) { + ffpmsg("Null file name (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + /* Send the retrieve command */ + sprintf(tmpstr,"RETR %s\n",newfn); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + /* COnnect to the data port */ + sock1 = NET_TcpConnect(ip,port); + if (NULL == (*ftpfile = fdopen(sock1,"r"))) { + ffpmsg ("Could not connect to passive port (ftp_open)"); + fclose(*command); + return (FILE_NOT_OPENED); + } + + /* now we return */ + + return 0; + } + + /* no passive mode */ + + NET_SendRaw(*sock,"QUIT\n",5,NET_DEFAULT); + fclose(*command); + return (FILE_NOT_OPENED); +} + +/*--------------------------------------------------------------------------*/ +/* return a socket which results from connection to hostname on port port */ +static int NET_TcpConnect(char *hostname, int port) +{ + /* Connect to hostname on port */ + + struct sockaddr_in sockaddr; + int sock; + int stat; + int val = 1; + + CreateSocketAddress(&sockaddr,hostname,port); + /* Create socket */ + if ((sock = socket(AF_INET, SOCK_STREAM, 0)) < 0) { + ffpmsg("Can't create socket"); + return CONNECTION_ERROR; + } + + if ((stat = connect(sock, (struct sockaddr*) &sockaddr, + sizeof(sockaddr))) + < 0) { + close(sock); + perror("NET_Tcpconnect - Connection error"); + ffpmsg("Can't connect to host, connection error"); + return CONNECTION_ERROR; + } + setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&val, sizeof(val)); + setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&val, sizeof(val)); + + val = 65536; + setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&val, sizeof(val)); + setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&val, sizeof(val)); + return sock; +} + +/*--------------------------------------------------------------------------*/ +/* Write len bytes from buffer to socket sock */ +static int NET_SendRaw(int sock, const void *buffer, int length, int opt) +{ + + char * buf = (char *) buffer; + + int flag; + int n, nsent = 0; + + switch (opt) { + case NET_DEFAULT: + flag = 0; + break; + case NET_OOB: + flag = MSG_OOB; + break; + case NET_PEEK: + default: + flag = 0; + break; + } + + if (sock < 0) return -1; + + for (n = 0; n < length; n += nsent) { + if ((nsent = send(sock, buf+n, length-n, flag)) <= 0) { + return nsent; + } +#ifdef DEBUG + printf ("send raw, sent %d bytes\n",nsent); +#endif + } +#ifdef DEBUG + printf ("send raw end, sent %d bytes\n",n); +#endif + return n; +} + +/*--------------------------------------------------------------------------*/ + +static int NET_RecvRaw(int sock, void *buffer, int length) +{ + /* Receive exactly length bytes into buffer. Returns number of bytes */ + /* received. Returns -1 in case of error. */ + + + int nrecv, n; + char *buf = (char *)buffer; + + if (sock < 0) return -1; + for (n = 0; n < length; n += nrecv) { + while ((nrecv = recv(sock, buf+n, length-n, 0)) == -1 && errno == EINTR) + errno = 0; /* probably a SIGCLD that was caught */ + if (nrecv < 0) + return nrecv; + else if (nrecv == 0) + break; /*/ EOF */ + } + + return n; +} + +/*--------------------------------------------------------------------------*/ +/* Yet Another URL Parser + url - input url + proto - input protocol + host - output host + port - output port + fn - output filename +*/ + +static int NET_ParseUrl(const char *url, char *proto, char *host, int *port, + char *fn) +{ + /* parses urls into their bits */ + /* returns 1 if error, else 0 */ + + char *urlcopy, *urlcopyorig; + char *ptrstr; + char *thost; + int isftp = 0; + + /* figure out if there is a http: or ftp: */ + + urlcopyorig = urlcopy = (char *) malloc(strlen(url)+1); + strcpy(urlcopy,url); + + /* set some defaults */ + *port = 80; + strcpy(proto,"http:"); + strcpy(host,"localhost"); + strcpy(fn,"/"); + + ptrstr = strstr(urlcopy,"http:"); + if (ptrstr == NULL) { + /* Nope, not http: */ + ptrstr = strstr(urlcopy,"root:"); + if (ptrstr == NULL) { + /* Nope, not root either */ + ptrstr = strstr(urlcopy,"ftp:"); + if (ptrstr != NULL) { + if (ptrstr == urlcopy) { + strcpy(proto,"ftp:"); + *port = 21; + isftp++; + urlcopy += 4; /* move past ftp: */ + } else { + /* not at the beginning, bad url */ + free(urlcopyorig); + return 1; + } + } + } else { + if (ptrstr == urlcopy) { + urlcopy += 5; /* move past root: */ + } else { + /* not at the beginning, bad url */ + free(urlcopyorig); + return 1; + } + } + } else { + if (ptrstr == urlcopy) { + urlcopy += 5; /* move past http: */ + } else { + free(urlcopyorig); + return 1; + } + } + + /* got the protocol */ + /* get the hostname */ + if (urlcopy[0] == '/' && urlcopy[1] == '/') { + /* we have a hostname */ + urlcopy += 2; /* move past the // */ + } + /* do this only if http */ + if (!strcmp(proto,"http:")) { + strcpy(host,urlcopy); + thost = host; + while (*urlcopy != '/' && *urlcopy != ':' && *urlcopy) { + thost++; + urlcopy++; + } + /* we should either be at the end of the string, have a /, or have a : */ + *thost = '\0'; + if (*urlcopy == ':') { + /* follows a port number */ + urlcopy++; + sscanf(urlcopy,"%d",port); + while (*urlcopy != '/' && *urlcopy) urlcopy++; /* step to the */ + } + } else { + /* do this for ftp */ + strcpy(host,urlcopy); + thost = host; + while (*urlcopy != '/' && *urlcopy) { + thost++; + urlcopy++; + } + *thost = '\0'; + /* Now, we should either be at the end of the string, or have a / */ + + } + /* Now the rest is a fn */ + + if (*urlcopy) { + strcpy(fn,urlcopy); + } + free(urlcopyorig); + return 0; +} + +/*--------------------------------------------------------------------------*/ + +/* Small helper functions to set the netoutfile static string */ +/* Called by cfileio after parsing the output file off of the input file url */ + +int http_checkfile (char *urltype, char *infile, char *outfile1) +{ + char newinfile[MAXLEN]; + FILE *httpfile; + char contentencoding[MAXLEN]; + int contentlength; + + /* default to http:// if there is no output file */ + + strcpy(urltype,"http://"); + + if (strlen(outfile1)) { + /* there is an output file */ + + /* don't copy the "file://" prefix, if present. */ + if (!strncmp(outfile1, "file://", 7) ) + strcpy(netoutfile,outfile1+7); + else + strcpy(netoutfile,outfile1); + + if (!strncmp(outfile1, "mem:", 4) ) { + /* copy the file to memory, with READ and WRITE access + In this case, it makes no difference whether the http file + and or the output file are compressed or not. */ + + strcpy(urltype, "httpmem://"); /* use special driver */ + return 0; + } + + if (strstr(infile, "?")) { + /* file name contains a '?' so probably a cgi string; don't open it */ + strcpy(urltype,"httpfile://"); + return 0; + } + + if (!http_open_network(infile,&httpfile,contentencoding,&contentlength)) { + fclose(httpfile); + /* It's there, we're happy */ + if (strstr(infile,".gz") || (strstr(infile,".Z"))) { + /* It's compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"httpcompress://"); + } else { + strcpy(urltype,"httpfile://"); + } + } else { + strcpy(urltype,"httpfile://"); + } + return 0; + } + + /* Ok, let's try the .gz one */ + strcpy(newinfile,infile); + strcat(newinfile,".gz"); + if (!http_open_network(newinfile,&httpfile,contentencoding, + &contentlength)) { + fclose(httpfile); + strcpy(infile,newinfile); + /* It's there, we're happy, and, it's compressed */ + /* It's compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"httpcompress://"); + } else { + strcpy(urltype,"httpfile://"); + } + return 0; + } + + /* Ok, let's try the .Z one */ + strcpy(newinfile,infile); + strcat(newinfile,".Z"); + if (!http_open_network(newinfile,&httpfile,contentencoding, + &contentlength)) { + fclose(httpfile); + strcpy(infile,newinfile); + /* It's there, we're happy, and, it's compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"httpcompress://"); + } else { + strcpy(urltype,"httpfile://"); + } + return 0; + } + + } + return 0; +} +/*--------------------------------------------------------------------------*/ +int ftp_checkfile (char *urltype, char *infile, char *outfile1) +{ + char newinfile[MAXLEN]; + FILE *ftpfile; + FILE *command; + int sock; + + + /* default to ftp:// */ + + strcpy(urltype,"ftp://"); + + if (strlen(outfile1)) { + /* there is an output file */ + + /* don't copy the "file://" prefix, if present. */ + if (!strncmp(outfile1, "file://", 7) ) + strcpy(netoutfile,outfile1+7); + else + strcpy(netoutfile,outfile1); + + if (!strncmp(outfile1, "mem:", 4) ) { + /* copy the file to memory, with READ and WRITE access + In this case, it makes no difference whether the ftp file + and or the output file are compressed or not. */ + + strcpy(urltype, "ftpmem://"); /* use special driver */ + return 0; + } + + if (!ftp_open_network(infile,&ftpfile,&command,&sock)) { + fclose(ftpfile); + fclose(command); + /* It's there, we're happy */ + if (strstr(infile,".gz") || (strstr(infile,".Z"))) { + /* It's compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"ftpcompress://"); + } else { + strcpy(urltype,"ftpfile://"); + } + } else { + strcpy(urltype,"ftpfile://"); + } + return 0; + } + + /* Ok, let's try the .gz one */ + strcpy(newinfile,infile); + strcat(newinfile,".gz"); + if (!ftp_open_network(newinfile,&ftpfile,&command,&sock)) { + fclose(ftpfile); + fclose(command); + strcpy(infile,newinfile); + /* It's there, we're happy, and, it's compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"ftpcompress://"); + } else { + strcpy(urltype,"ftpfile://"); + } + return 0; + } + + /* Ok, let's try the .Z one */ + strcpy(newinfile,infile); + strcat(newinfile,".Z"); + if (!ftp_open_network(newinfile,&ftpfile,&command,&sock)) { + fclose(ftpfile); + fclose(command); + strcpy(infile,newinfile); + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"ftpcompress://"); + } else { + strcpy(urltype,"ftpfile://"); + } + return 0; + } + + } + return 0; +} +/*--------------------------------------------------------------------------*/ +/* A small helper function to wait for a particular status on the ftp + connectino */ +static int ftp_status(FILE *ftp, char *statusstr) +{ + /* read through until we find a string beginning with statusstr */ + /* This needs a timeout */ + + char recbuf[MAXLEN]; + int len; + + len = strlen(statusstr); + while (1) { + if (!(fgets(recbuf,MAXLEN,ftp))) { + return 1; /* error reading */ + } + + recbuf[len] = '\0'; /* make it short */ + if (!strcmp(recbuf,statusstr)) { + return 0; /* we're ok */ + } + if (recbuf[0] > '3') { + /* oh well, some sort of error */ + return 1; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * CreateSocketAddress -- + * + * This function initializes a sockaddr structure for a host and port. + * + * Results: + * 1 if the host was valid, 0 if the host could not be converted to + * an IP address. + * + * Side effects: + * Fills in the *sockaddrPtr structure. + * + *---------------------------------------------------------------------- + */ + +static int +CreateSocketAddress( + struct sockaddr_in *sockaddrPtr, /* Socket address */ + char *host, /* Host. NULL implies INADDR_ANY */ + int port) /* Port number */ +{ + struct hostent *hostent; /* Host database entry */ + struct in_addr addr; /* For 64/32 bit madness */ + char localhost[MAXLEN]; + + strcpy(localhost,host); + + memset((void *) sockaddrPtr, '\0', sizeof(struct sockaddr_in)); + sockaddrPtr->sin_family = AF_INET; + sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF)); + if (host == NULL) { + addr.s_addr = INADDR_ANY; + } else { + addr.s_addr = inet_addr(localhost); + if (addr.s_addr == 0xFFFFFFFF) { + hostent = gethostbyname(localhost); + if (hostent != NULL) { + memcpy((void *) &addr, + (void *) hostent->h_addr_list[0], + (size_t) hostent->h_length); + } else { +#ifdef EHOSTUNREACH + errno = EHOSTUNREACH; +#else +#ifdef ENXIO + errno = ENXIO; +#endif +#endif + return 0; /* error */ + } + } + } + + /* + * NOTE: On 64 bit machines the assignment below is rumored to not + * do the right thing. Please report errors related to this if you + * observe incorrect behavior on 64 bit machines such as DEC Alphas. + * Should we modify this code to do an explicit memcpy? + */ + + sockaddrPtr->sin_addr.s_addr = addr.s_addr; + return 1; /* Success. */ +} + +/* Signal handler for timeouts */ + +static void signal_handler(int sig) { + + switch (sig) { + case SIGALRM: /* process for alarm */ + longjmp(env,sig); + + default: { + /* Hmm, shouldn't have happend */ + exit(sig); + } + } +} + +/**************************************************************/ + +/* Root driver */ + +/*--------------------------------------------------------------------------*/ +int root_init(void) +{ + int ii; + + for (ii = 0; ii < NIOBUF; ii++) /* initialize all empty slots in table */ + { + handleTable[ii].sock = 0; + handleTable[ii].currentpos = 0; + } + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_setoptions(int options) +{ + /* do something with the options argument, to stop compiler warning */ + options = 0; + return(options); +} +/*--------------------------------------------------------------------------*/ +int root_getoptions(int *options) +{ + *options = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_getversion(int *version) +{ + *version = 10; + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_shutdown(void) +{ + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_open(char *url, int rwmode, int *handle) +{ + int ii, status; + int sock; + + *handle = -1; + for (ii = 0; ii < NIOBUF; ii++) /* find empty slot in table */ + { + if (handleTable[ii].sock == 0) + { + *handle = ii; + break; + } + } + + if (*handle == -1) + return(TOO_MANY_FILES); /* too many files opened */ + + /*open the file */ + if (rwmode) { + status = root_openfile(url, "update", &sock); + } else { + status = root_openfile(url, "read", &sock); + } + if (status) + return(status); + + handleTable[ii].sock = sock; + handleTable[ii].currentpos = 0; + + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_create(char *filename, int *handle) +{ + int ii, status; + int sock; + + *handle = -1; + for (ii = 0; ii < NIOBUF; ii++) /* find empty slot in table */ + { + if (handleTable[ii].sock == 0) + { + *handle = ii; + break; + } + } + + if (*handle == -1) + return(TOO_MANY_FILES); /* too many files opened */ + + /*open the file */ + status = root_openfile(filename, "create", &sock); + + if (status) { + ffpmsg("Unable to create file"); + return(status); + } + + handleTable[ii].sock = sock; + handleTable[ii].currentpos = 0; + + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_size(int handle, OFF_T *filesize) +/* + return the size of the file in bytes +*/ +{ + + int sock; + int offset; + int status; + int op; + + sock = handleTable[handle].sock; + + status = root_send_buffer(sock,ROOTD_STAT,NULL,0); + status = root_recv_buffer(sock,&op,(char *)&offset, 4); + *filesize = (OFF_T) ntohl(offset); + + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_close(int handle) +/* + close the file +*/ +{ + + int status; + int sock; + + sock = handleTable[handle].sock; + status = root_send_buffer(sock,ROOTD_CLOSE,NULL,0); + close(sock); + handleTable[handle].sock = 0; + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_flush(int handle) +/* + flush the file +*/ +{ + int status; + int sock; + + sock = handleTable[handle].sock; + status = root_send_buffer(sock,ROOTD_FLUSH,NULL,0); + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_seek(int handle, OFF_T offset) +/* + seek to position relative to start of the file +*/ +{ + handleTable[handle].currentpos = offset; + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_read(int hdl, void *buffer, long nbytes) +/* + read bytes from the current position in the file +*/ +{ + char msg[SHORTLEN]; + int op; + int status; + int astat; + + /* we presume here that the file position will never be > 2**31 = 2.1GB */ + sprintf(msg,"%ld %ld ",(long) handleTable[hdl].currentpos,nbytes); + status = root_send_buffer(handleTable[hdl].sock,ROOTD_GET,msg,strlen(msg)); + if ((unsigned) status != strlen(msg)) { + return (READ_ERROR); + } + astat = 0; + status = root_recv_buffer(handleTable[hdl].sock,&op,(char *) &astat,4); + if (astat != 0) { + return (READ_ERROR); + } +#ifdef DEBUG + printf("root_read, op %d astat %d\n",op,astat); +#endif + status = NET_RecvRaw(handleTable[hdl].sock,buffer,nbytes); + if (status != nbytes) { + return (READ_ERROR); + } + handleTable[hdl].currentpos += nbytes; + + return(0); +} +/*--------------------------------------------------------------------------*/ +int root_write(int hdl, void *buffer, long nbytes) +/* + write bytes at the current position in the file +*/ +{ + + char msg[SHORTLEN]; + int len; + int sock; + int status; + int astat; + int op; + + sock = handleTable[hdl].sock; + /* we presume here that the file position will never be > 2**31 = 2.1GB */ + sprintf(msg,"%ld %ld ",(long) handleTable[hdl].currentpos,nbytes); + + len = strlen(msg); + status = root_send_buffer(sock,ROOTD_PUT,msg,len+1); + if (status != len+1) { + return (WRITE_ERROR); + } + status = NET_SendRaw(sock,buffer,nbytes,NET_DEFAULT); + if (status != nbytes) { + return (WRITE_ERROR); + } + astat = 0; + status = root_recv_buffer(handleTable[hdl].sock,&op,(char *) &astat,4); +#ifdef DEBUG + printf("root_read, op %d astat %d\n",op,astat); +#endif + if (astat != 0) { + return (WRITE_ERROR); + } + handleTable[hdl].currentpos += nbytes; + return(0); +} + +/*--------------------------------------------------------------------------*/ +int root_openfile(char *url, char *rwmode, int *sock) + /* + lowest level routine to physically open a root file + */ +{ + + int status; + char recbuf[MAXLEN]; + char errorstr[MAXLEN]; + char proto[SHORTLEN]; + char host[SHORTLEN]; + char fn[MAXLEN]; + char turl[MAXLEN]; + int port; + int op; + int ii; + int authstat; + + + /* Parse the URL apart again */ + strcpy(turl,"root://"); + strcat(turl,url); + if (NET_ParseUrl(turl,proto,host,&port,fn)) { + sprintf(errorstr,"URL Parse Error (root_open) %s",url); + ffpmsg(errorstr); + return (FILE_NOT_OPENED); + } + +#ifdef DEBUG + printf("Connecting to %s on port %d\n",host,port); +#endif + /* Connect to the remote host */ + *sock = NET_TcpConnect(host,port); + if (*sock < 0) { + ffpmsg("Couldn't connect to host (http_open_network)"); + return (FILE_NOT_OPENED); + } + + /* get the username */ + if (NULL != getenv("ROOTUSERNAME")) { + strcpy(recbuf,getenv("ROOTUSERNAME")); + } else { + printf("Username: "); + fgets(recbuf,MAXLEN,stdin); + recbuf[strlen(recbuf)-1] = '\0'; + } + + status = root_send_buffer(*sock, ROOTD_USER, recbuf,strlen(recbuf)); + if (status < 0) { + ffpmsg("error talking to remote system on username "); + return (FILE_NOT_OPENED); + } + + status = root_recv_buffer(*sock,&op,(char *)&authstat,4); + if (!status) { + ffpmsg("error talking to remote system on username"); + return (FILE_NOT_OPENED); + } + +#ifdef DEBUG + printf("op is %d and authstat is %d\n",op,authstat); +#endif + + if (op != ROOTD_AUTH) { + ffpmsg("ERROR on ROOTD_USER"); + ffpmsg(recbuf); + return (FILE_NOT_OPENED); + } + + + /* now the password */ + if (NULL != getenv("ROOTPASSWORD")) { + strcpy(recbuf,getenv("ROOTPASSWORD")); + } else { + printf("Password: "); + fgets(recbuf,MAXLEN,stdin); + recbuf[strlen(recbuf)-1] = '\0'; + } + /* ones complement the password */ + for (ii=0;(unsigned) ii + + + + includes the 4 bytes for the op, the length bytes (4) are implicit + + + if buffer is null don't send it, not everything needs something sent */ + + int len; + int status; + + int hdr[2]; + + len = 4; + + if (buffer != NULL) { + len += buflen; + } + + hdr[0] = htonl(len); + +#ifdef DEBUG + printf("len sent is %x\n",hdr[0]); +#endif + + hdr[1] = htonl(op); +#ifdef DEBUG + printf("op sent is %x\n",hdr[1]); +#endif + + +#ifdef DEBUG + printf("Sending op %d and length of %d\n",op,len); +#endif + + status = NET_SendRaw(sock,hdr,sizeof(hdr),NET_DEFAULT); + if (status < 0) { + return status; + } + if (buffer != NULL) { + status = NET_SendRaw(sock,buffer,buflen,NET_DEFAULT); + } + return status; +} + +static int root_recv_buffer(int sock, int *op, char *buffer, int buflen) +{ + /* recv a buffer, the form is + + + + + */ + + int recv1 = 0; + int len; + int status; + char recbuf[MAXLEN]; + + status = NET_RecvRaw(sock,&len,4); +#ifdef DEBUG + printf("Recv: status from rec is %d\n",status); +#endif + if (status < 0) { + return status; + } + recv1 += status; + + len = ntohl(len); +#ifdef DEBUG + printf ("Recv: length is %d\n",len); +#endif + + /* ok, have the length, recive the operation */ + len -= 4; + status = NET_RecvRaw(sock,op,4); + if (status < 0) { + return status; + } + + recv1 += status; + + *op = ntohl(*op); +#ifdef DEBUG + printf ("Recv: Operation is %d\n",*op); +#endif + + if (len > MAXLEN) { + len = MAXLEN; + } + + if (len > 0) { /* Get the rest of the message */ + status = NET_RecvRaw(sock,recbuf,len); + if (len > buflen) { + len = buflen; + } + memcpy(buffer,recbuf,len); + if (status < 0) { + return status; + } + } + + recv1 += status; + return recv1; + +} +#endif diff --git a/pkg/tbtables/cfitsio/drvrsmem.c b/pkg/tbtables/cfitsio/drvrsmem.c new file mode 100644 index 00000000..3c2b4032 --- /dev/null +++ b/pkg/tbtables/cfitsio/drvrsmem.c @@ -0,0 +1,953 @@ +/* S H A R E D M E M O R Y D R I V E R + ======================================= + + by Jerzy.Borkowski@obs.unige.ch + +09-Mar-98 : initial version 1.0 released +23-Mar-98 : shared_malloc now accepts new handle as an argument +23-Mar-98 : shmem://0, shmem://1, etc changed to shmem://h0, etc due to bug + in url parser. +10-Apr-98 : code cleanup +13-May-99 : delayed initialization added, global table deleted on exit when + no shmem segments remain, and last process terminates +*/ + +#ifdef HAVE_SHMEM_SERVICES +#include "fitsio2.h" /* drvrsmem.h is included by it */ + +#include +#include +#include +#include +#include +#include +#include +#include + + +static int shared_kbase = 0; /* base for shared memory handles */ +static int shared_maxseg = 0; /* max number of shared memory blocks */ +static int shared_range = 0; /* max number of tried entries */ +static int shared_fd = SHARED_INVALID; /* handle of global access lock file */ +static int shared_gt_h = SHARED_INVALID; /* handle of global table segment */ +static SHARED_LTAB *shared_lt = NULL; /* local table pointer */ +static SHARED_GTAB *shared_gt = NULL; /* global table pointer */ +static int shared_create_mode = 0666; /* permission flags for created objects */ +static int shared_debug = 1; /* simple debugging tool, set to 0 to disable messages */ +static int shared_init_called = 0; /* flag whether shared_init() has been called, used for delayed init */ + + /* static support routines prototypes */ + +static int shared_clear_entry(int idx); /* unconditionally clear entry */ +static int shared_destroy_entry(int idx); /* unconditionally destroy sema & shseg and clear entry */ +static int shared_mux(int idx, int mode); /* obtain exclusive access to specified segment */ +static int shared_demux(int idx, int mode); /* free exclusive access to specified segment */ + +static int shared_process_count(int sem); /* valid only for time of invocation */ +static int shared_delta_process(int sem, int delta); /* change number of processes hanging on segment */ +static int shared_attach_process(int sem); +static int shared_detach_process(int sem); +static int shared_get_free_entry(int newhandle); /* get free entry in shared_key, or -1, entry is set rw locked */ +static int shared_get_hash(long size, int idx);/* return hash value for malloc */ +static long shared_adjust_size(long size); /* size must be >= 0 !!! */ +static int shared_check_locked_index(int idx); /* verify that given idx is valid */ +static int shared_map(int idx); /* map all tables for given idx, check for validity */ +static int shared_validate(int idx, int mode); /* use intrnally inside crit.sect !!! */ + + /* support routines - initialization */ + + +static int shared_clear_entry(int idx) /* unconditionally clear entry */ + { if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG); + shared_gt[idx].key = SHARED_INVALID; /* clear entries in global table */ + shared_gt[idx].handle = SHARED_INVALID; + shared_gt[idx].sem = SHARED_INVALID; + shared_gt[idx].semkey = SHARED_INVALID; + shared_gt[idx].nprocdebug = 0; + shared_gt[idx].size = 0; + shared_gt[idx].attr = 0; + + return(SHARED_OK); + } + +static int shared_destroy_entry(int idx) /* unconditionally destroy sema & shseg and clear entry */ + { int r, r2; + union semun filler; + + if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG); + r2 = r = SHARED_OK; + filler.val = 0; /* this is to make cc happy (warning otherwise) */ + if (SHARED_INVALID != shared_gt[idx].sem) r = semctl(shared_gt[idx].sem, 0, IPC_RMID, filler); /* destroy semaphore */ + if (SHARED_INVALID != shared_gt[idx].handle) r2 = shmctl(shared_gt[idx].handle, IPC_RMID, 0); /* destroy shared memory segment */ + if (SHARED_OK == r) r = r2; /* accumulate error code in r, free r2 */ + r2 = shared_clear_entry(idx); + return((SHARED_OK == r) ? r2 : r); + } + +void shared_cleanup(void) /* this must (should) be called during exit/abort */ + { int i, j, r, oktodelete, filelocked, segmentspresent; + flock_t flk; + struct shmid_ds ds; + + if (shared_debug) printf("shared_cleanup:"); + if (NULL != shared_lt) + { if (shared_debug) printf(" deleting segments:"); + for (i=0; i>\n"); + return; + } + + +int shared_init(int debug_msgs) /* initialize shared memory stuff, you have to call this routine once */ + { int i; + char buf[1000], *p; + mode_t oldumask; + + shared_init_called = 1; /* tell everybody no need to call us for the 2nd time */ + shared_debug = debug_msgs; /* set required debug mode */ + + if (shared_debug) printf("shared_init:"); + + shared_kbase = 0; /* adapt to current env. settings */ + if (NULL != (p = getenv(SHARED_ENV_KEYBASE))) shared_kbase = atoi(p); + if (0 == shared_kbase) shared_kbase = SHARED_KEYBASE; + if (shared_debug) printf(" keybase=%d", shared_kbase); + + shared_maxseg = 0; + if (NULL != (p = getenv(SHARED_ENV_MAXSEG))) shared_maxseg = atoi(p); + if (0 == shared_maxseg) shared_maxseg = SHARED_MAXSEG; + if (shared_debug) printf(" maxseg=%d", shared_maxseg); + + shared_range = 3 * shared_maxseg; + + if (SHARED_INVALID == shared_fd) /* create rw locking file (this file is never deleted) */ + { if (shared_debug) printf(" lockfileinit="); + sprintf(buf, "%s.%d.%d", SHARED_FDNAME, shared_kbase, shared_maxseg); + oldumask = umask(0); + + shared_fd = open(buf, O_TRUNC | O_EXCL | O_CREAT | O_RDWR, shared_create_mode); + umask(oldumask); + if (SHARED_INVALID == shared_fd) /* or just open rw locking file, in case it already exists */ + { shared_fd = open(buf, O_TRUNC | O_RDWR, shared_create_mode); + if (SHARED_INVALID == shared_fd) return(SHARED_NOFILE); + if (shared_debug) printf("slave"); + + } + else + { if (shared_debug) printf("master"); + } + } + + if (SHARED_INVALID == shared_gt_h) /* global table not attached, try to create it in shared memory */ + { if (shared_debug) printf(" globalsharedtableinit="); + shared_gt_h = shmget(shared_kbase, shared_maxseg * sizeof(SHARED_GTAB), IPC_CREAT | IPC_EXCL | shared_create_mode); /* try open as a master */ + if (SHARED_INVALID == shared_gt_h) /* if failed, try to open as a slave */ + { shared_gt_h = shmget(shared_kbase, shared_maxseg * sizeof(SHARED_GTAB), shared_create_mode); + if (SHARED_INVALID == shared_gt_h) return(SHARED_IPCERR); /* means deleted ID residing in system, shared mem unusable ... */ + shared_gt = (SHARED_GTAB *)shmat(shared_gt_h, 0, 0); /* attach segment */ + if (((SHARED_GTAB *)SHARED_INVALID) == shared_gt) return(SHARED_IPCERR); + if (shared_debug) printf("slave"); + } + else + { shared_gt = (SHARED_GTAB *)shmat(shared_gt_h, 0, 0); /* attach segment */ + if (((SHARED_GTAB *)SHARED_INVALID) == shared_gt) return(SHARED_IPCERR); + for (i=0; i>\n"); + return(SHARED_OK); + } + + +int shared_recover(int id) /* try to recover dormant segments after applic crash */ + { int i, r, r2; + + if (NULL == shared_gt) return(SHARED_NOTINIT); /* not initialized */ + if (NULL == shared_lt) return(SHARED_NOTINIT); /* not initialized */ + r = SHARED_OK; + for (i=0; i r2) || (0 == r2)) + { if (shared_debug) printf("Bogus handle=%d nproc=%d sema=%d:", i, shared_gt[i].nprocdebug, r2); + r = shared_destroy_entry(i); + if (shared_debug) + { printf("%s", r ? "error couldn't clear handle" : "handle cleared"); + } + } + shared_demux(i, SHARED_RDWRITE); + } + return(r); /* table full */ + } + + /* API routines - mutexes and locking */ + +static int shared_mux(int idx, int mode) /* obtain exclusive access to specified segment */ + { flock_t flk; + + int r; + + if (0 == shared_init_called) /* delayed initialization */ + { if (SHARED_OK != (r = shared_init(0))) return(r); + + } + if (SHARED_INVALID == shared_fd) return(SHARED_NOTINIT); + if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG); + flk.l_type = ((mode & SHARED_RDWRITE) ? F_WRLCK : F_RDLCK); + flk.l_whence = 0; + flk.l_start = idx; + flk.l_len = 1; + if (shared_debug) printf(" [mux (%d): ", idx); + if (-1 == fcntl(shared_fd, ((mode & SHARED_NOWAIT) ? F_SETLK : F_SETLKW), &flk)) + { switch (errno) + { case EAGAIN: ; + + case EACCES: if (shared_debug) printf("again]"); + return(SHARED_AGAIN); + default: if (shared_debug) printf("err]"); + return(SHARED_IPCERR); + } + } + if (shared_debug) printf("ok]"); + return(SHARED_OK); + } + + + +static int shared_demux(int idx, int mode) /* free exclusive access to specified segment */ + { flock_t flk; + + if (SHARED_INVALID == shared_fd) return(SHARED_NOTINIT); + if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG); + flk.l_type = F_UNLCK; + flk.l_whence = 0; + flk.l_start = idx; + flk.l_len = 1; + if (shared_debug) printf(" [demux (%d): ", idx); + if (-1 == fcntl(shared_fd, F_SETLKW, &flk)) + { switch (errno) + { case EAGAIN: ; + case EACCES: if (shared_debug) printf("again]"); + return(SHARED_AGAIN); + default: if (shared_debug) printf("err]"); + return(SHARED_IPCERR); + } + + } + if (shared_debug) printf("mode=%d ok]", mode); + return(SHARED_OK); + } + + + +static int shared_process_count(int sem) /* valid only for time of invocation */ + { union semun su; + + su.val = 0; /* to force compiler not to give warning messages */ + return(semctl(sem, 0, GETVAL, su)); /* su is unused here */ + } + + +static int shared_delta_process(int sem, int delta) /* change number of processes hanging on segment */ + { struct sembuf sb; + + if (SHARED_INVALID == sem) return(SHARED_BADARG); /* semaphore not attached */ + sb.sem_num = 0; + sb.sem_op = delta; + sb.sem_flg = SEM_UNDO; + return((-1 == semop(sem, &sb, 1)) ? SHARED_IPCERR : SHARED_OK); + } + + +static int shared_attach_process(int sem) + { if (shared_debug) printf(" [attach process]"); + return(shared_delta_process(sem, 1)); + } + + +static int shared_detach_process(int sem) + { if (shared_debug) printf(" [detach process]"); + return(shared_delta_process(sem, -1)); + } + + /* API routines - hashing and searching */ + + +static int shared_get_free_entry(int newhandle) /* get newhandle, or -1, entry is set rw locked */ + { + if (NULL == shared_gt) return(-1); /* not initialized */ + if (NULL == shared_lt) return(-1); /* not initialized */ + if (newhandle < 0) return(-1); + if (newhandle >= shared_maxseg) return(-1); + if (shared_lt[newhandle].tcnt) return(-1); /* somebody (we) is using it */ + if (shared_mux(newhandle, SHARED_NOWAIT | SHARED_RDWRITE)) return(-1); /* used by others */ + if (SHARED_INVALID == shared_gt[newhandle].key) return(newhandle); /* we have found free slot, lock it and return index */ + shared_demux(newhandle, SHARED_RDWRITE); + if (shared_debug) printf("[free_entry - ERROR - entry unusable]"); + return(-1); /* table full */ + } + + +static int shared_get_hash(long size, int idx) /* return hash value for malloc */ + { static int counter = 0; + int hash; + + hash = (counter + size * idx) % shared_range; + counter = (counter + 1) % shared_range; + return(hash); + } + + +static long shared_adjust_size(long size) /* size must be >= 0 !!! */ + { return(((size + sizeof(BLKHEAD) + SHARED_GRANUL - 1) / SHARED_GRANUL) * SHARED_GRANUL); } + + + /* API routines - core : malloc/realloc/free/attach/detach/lock/unlock */ + +int shared_malloc(long size, int mode, int newhandle) /* return idx or SHARED_INVALID */ + { int h, i, r, idx, key; + union semun filler; + BLKHEAD *bp; + + if (0 == shared_init_called) /* delayed initialization */ + { if (SHARED_OK != (r = shared_init(0))) return(r); + } + if (shared_debug) printf("malloc (size = %ld, mode = %d):", size, mode); + if (size < 0) return(SHARED_INVALID); + if (-1 == (idx = shared_get_free_entry(newhandle))) return(SHARED_INVALID); + if (shared_debug) printf(" idx=%d", idx); + for (i = 0; ; i++) + { if (i >= shared_range) /* table full, signal error & exit */ + { shared_demux(idx, SHARED_RDWRITE); + return(SHARED_INVALID); + } + key = shared_kbase + ((i + shared_get_hash(size, idx)) % shared_range); + if (shared_debug) printf(" key=%d", key); + h = shmget(key, shared_adjust_size(size), IPC_CREAT | IPC_EXCL | shared_create_mode); + if (shared_debug) printf(" handle=%d", h); + if (SHARED_INVALID == h) continue; /* segment already accupied */ + bp = (BLKHEAD *)shmat(h, 0, 0); /* try attach */ + if (shared_debug) printf(" p=%p", bp); + if (((BLKHEAD *)SHARED_INVALID) == bp) /* cannot attach, delete segment, try with another key */ + { shmctl(h, IPC_RMID, 0); + continue; + } /* now create semaphor counting number of processes attached */ + if (SHARED_INVALID == (shared_gt[idx].sem = semget(key, 1, IPC_CREAT | IPC_EXCL | shared_create_mode))) + { shmdt((void *)bp); /* cannot create segment, delete everything */ + shmctl(h, IPC_RMID, 0); + continue; /* try with another key */ + } + if (shared_debug) printf(" sem=%d", shared_gt[idx].sem); + if (shared_attach_process(shared_gt[idx].sem)) /* try attach process */ + { semctl(shared_gt[idx].sem, 0, IPC_RMID, filler); /* destroy semaphore */ + shmdt((char *)bp); /* detach shared mem segment */ + shmctl(h, IPC_RMID, 0); /* destroy shared mem segment */ + continue; /* try with another key */ + } + bp->s.tflag = BLOCK_SHARED; /* fill in data in segment's header (this is really not necessary) */ + bp->s.ID[0] = SHARED_ID_0; + bp->s.ID[1] = SHARED_ID_1; + bp->s.handle = idx; /* used in yorick */ + if (mode & SHARED_RESIZE) + { if (shmdt((char *)bp)) r = SHARED_IPCERR; /* if segment is resizable, then detach segment */ + shared_lt[idx].p = NULL; + } + else { shared_lt[idx].p = bp; } + shared_lt[idx].tcnt = 1; /* one thread using segment */ + shared_lt[idx].lkcnt = 0; /* no locks at the moment */ + shared_lt[idx].seekpos = 0L; /* r/w pointer positioned at beg of block */ + shared_gt[idx].handle = h; /* fill in data in global table */ + shared_gt[idx].size = size; + shared_gt[idx].attr = mode; + shared_gt[idx].semkey = key; + shared_gt[idx].key = key; + shared_gt[idx].nprocdebug = 0; + + break; + } + shared_demux(idx, SHARED_RDWRITE); /* hope this will not fail */ + return(idx); + } + + +int shared_attach(int idx) + { int r, r2; + + if (SHARED_OK != (r = shared_mux(idx, SHARED_RDWRITE | SHARED_WAIT))) return(r); + if (SHARED_OK != (r = shared_map(idx))) + { shared_demux(idx, SHARED_RDWRITE); + return(r); + } + if (shared_attach_process(shared_gt[idx].sem)) /* try attach process */ + { shmdt((char *)(shared_lt[idx].p)); /* cannot attach process, detach everything */ + shared_lt[idx].p = NULL; + shared_demux(idx, SHARED_RDWRITE); + return(SHARED_BADARG); + } + shared_lt[idx].tcnt++; /* one more thread is using segment */ + if (shared_gt[idx].attr & SHARED_RESIZE) /* if resizeable, detach and return special pointer */ + { if (shmdt((char *)(shared_lt[idx].p))) r = SHARED_IPCERR; /* if segment is resizable, then detach segment */ + shared_lt[idx].p = NULL; + } + shared_lt[idx].seekpos = 0L; /* r/w pointer positioned at beg of block */ + r2 = shared_demux(idx, SHARED_RDWRITE); + return(r ? r : r2); + } + + + +static int shared_check_locked_index(int idx) /* verify that given idx is valid */ + { int r; + + if (0 == shared_init_called) /* delayed initialization */ + { if (SHARED_OK != (r = shared_init(0))) return(r); + + } + if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG); + if (NULL == shared_lt[idx].p) return(SHARED_BADARG); /* NULL pointer, not attached ?? */ + if (0 == shared_lt[idx].lkcnt) return(SHARED_BADARG); /* not locked ?? */ + if ((SHARED_ID_0 != (shared_lt[idx].p)->s.ID[0]) || (SHARED_ID_1 != (shared_lt[idx].p)->s.ID[1]) || + (BLOCK_SHARED != (shared_lt[idx].p)->s.tflag)) /* invalid data in segment */ + return(SHARED_BADARG); + return(SHARED_OK); + } + + + +static int shared_map(int idx) /* map all tables for given idx, check for validity */ + { int h; /* have to obtain excl. access before calling shared_map */ + BLKHEAD *bp; + + if ((idx < 0) || (idx >= shared_maxseg)) return(SHARED_BADARG); + if (SHARED_INVALID == shared_gt[idx].key) return(SHARED_BADARG); + if (SHARED_INVALID == (h = shmget(shared_gt[idx].key, 1, shared_create_mode))) return(SHARED_BADARG); + if (((BLKHEAD *)SHARED_INVALID) == (bp = (BLKHEAD *)shmat(h, 0, 0))) return(SHARED_BADARG); + if ((SHARED_ID_0 != bp->s.ID[0]) || (SHARED_ID_1 != bp->s.ID[1]) || (BLOCK_SHARED != bp->s.tflag) || (h != shared_gt[idx].handle)) + { shmdt((char *)bp); /* invalid segment, detach everything */ + return(SHARED_BADARG); + + } + if (shared_gt[idx].sem != semget(shared_gt[idx].semkey, 1, shared_create_mode)) /* check if sema is still there */ + { shmdt((char *)bp); /* cannot attach semaphore, detach everything */ + return(SHARED_BADARG); + } + shared_lt[idx].p = bp; /* store pointer to shmem data */ + return(SHARED_OK); + } + + +static int shared_validate(int idx, int mode) /* use intrnally inside crit.sect !!! */ + { int r; + + if (SHARED_OK != (r = shared_mux(idx, mode))) return(r); /* idx checked by shared_mux */ + if (NULL == shared_lt[idx].p) + if (SHARED_OK != (r = shared_map(idx))) + { shared_demux(idx, mode); + return(r); + } + if ((SHARED_ID_0 != (shared_lt[idx].p)->s.ID[0]) || (SHARED_ID_1 != (shared_lt[idx].p)->s.ID[1]) || (BLOCK_SHARED != (shared_lt[idx].p)->s.tflag)) + { shared_demux(idx, mode); + return(r); + } + return(SHARED_OK); + } + + +SHARED_P shared_realloc(int idx, long newsize) /* realloc shared memory segment */ + { int h, key, i, r; + BLKHEAD *bp; + long transfersize; + + r = SHARED_OK; + if (newsize < 0) return(NULL); + if (shared_check_locked_index(idx)) return(NULL); + if (0 == (shared_gt[idx].attr & SHARED_RESIZE)) return(NULL); + if (-1 != shared_lt[idx].lkcnt) return(NULL); /* check for RW lock */ + if (shared_adjust_size(shared_gt[idx].size) == shared_adjust_size(newsize)) + { shared_gt[idx].size = newsize; + + return((SHARED_P)((shared_lt[idx].p) + 1)); + } + for (i = 0; ; i++) + { if (i >= shared_range) return(NULL); /* table full, signal error & exit */ + key = shared_kbase + ((i + shared_get_hash(newsize, idx)) % shared_range); + h = shmget(key, shared_adjust_size(newsize), IPC_CREAT | IPC_EXCL | shared_create_mode); + if (SHARED_INVALID == h) continue; /* segment already accupied */ + bp = (BLKHEAD *)shmat(h, 0, 0); /* try attach */ + if (((BLKHEAD *)SHARED_INVALID) == bp) /* cannot attach, delete segment, try with another key */ + { shmctl(h, IPC_RMID, 0); + continue; + } + *bp = *(shared_lt[idx].p); /* copy header, then data */ + transfersize = ((newsize < shared_gt[idx].size) ? newsize : shared_gt[idx].size); + if (transfersize > 0) + memcpy((void *)(bp + 1), (void *)((shared_lt[idx].p) + 1), transfersize); + if (shmdt((char *)(shared_lt[idx].p))) r = SHARED_IPCERR; /* try to detach old segment */ + if (shmctl(shared_gt[idx].handle, IPC_RMID, 0)) if (SHARED_OK == r) r = SHARED_IPCERR; /* destroy old shared memory segment */ + shared_gt[idx].size = newsize; /* signal new size */ + shared_gt[idx].handle = h; /* signal new handle */ + shared_gt[idx].key = key; /* signal new key */ + shared_lt[idx].p = bp; + break; + } + return((SHARED_P)(bp + 1)); + } + + +int shared_free(int idx) /* detach segment, if last process & !PERSIST, destroy segment */ + { int cnt, r, r2; + + if (SHARED_OK != (r = shared_validate(idx, SHARED_RDWRITE | SHARED_WAIT))) return(r); + if (SHARED_OK != (r = shared_detach_process(shared_gt[idx].sem))) /* update number of processes using segment */ + { shared_demux(idx, SHARED_RDWRITE); + return(r); + } + shared_lt[idx].tcnt--; /* update number of threads using segment */ + if (shared_lt[idx].tcnt > 0) return(shared_demux(idx, SHARED_RDWRITE)); /* if more threads are using segment we are done */ + if (shmdt((char *)(shared_lt[idx].p))) /* if, we are the last thread, try to detach segment */ + { shared_demux(idx, SHARED_RDWRITE); + return(SHARED_IPCERR); + } + shared_lt[idx].p = NULL; /* clear entry in local table */ + shared_lt[idx].seekpos = 0L; /* r/w pointer positioned at beg of block */ + if (-1 == (cnt = shared_process_count(shared_gt[idx].sem))) /* get number of processes hanging on segment */ + { shared_demux(idx, SHARED_RDWRITE); + return(SHARED_IPCERR); + } + if ((0 == cnt) && (0 == (shared_gt[idx].attr & SHARED_PERSIST))) r = shared_destroy_entry(idx); /* no procs on seg, destroy it */ + r2 = shared_demux(idx, SHARED_RDWRITE); + return(r ? r : r2); + } + + +SHARED_P shared_lock(int idx, int mode) /* lock given segment for exclusive access */ + { int r; + + if (shared_mux(idx, mode)) return(NULL); /* idx checked by shared_mux */ + if (0 != shared_lt[idx].lkcnt) /* are we already locked ?? */ + if (SHARED_OK != (r = shared_map(idx))) + { shared_demux(idx, mode); + return(NULL); + } + if (NULL == shared_lt[idx].p) /* stupid pointer ?? */ + if (SHARED_OK != (r = shared_map(idx))) + { shared_demux(idx, mode); + return(NULL); + } + if ((SHARED_ID_0 != (shared_lt[idx].p)->s.ID[0]) || (SHARED_ID_1 != (shared_lt[idx].p)->s.ID[1]) || (BLOCK_SHARED != (shared_lt[idx].p)->s.tflag)) + { shared_demux(idx, mode); + return(NULL); + } + if (mode & SHARED_RDWRITE) + { shared_lt[idx].lkcnt = -1; + + shared_gt[idx].nprocdebug++; + } + + else shared_lt[idx].lkcnt++; + shared_lt[idx].seekpos = 0L; /* r/w pointer positioned at beg of block */ + return((SHARED_P)((shared_lt[idx].p) + 1)); + } + + +int shared_unlock(int idx) /* unlock given segment, assumes seg is locked !! */ + { int r, r2, mode; + + if (SHARED_OK != (r = shared_check_locked_index(idx))) return(r); + if (shared_lt[idx].lkcnt > 0) + { shared_lt[idx].lkcnt--; /* unlock read lock */ + mode = SHARED_RDONLY; + } + else + { shared_lt[idx].lkcnt = 0; /* unlock write lock */ + shared_gt[idx].nprocdebug--; + mode = SHARED_RDWRITE; + } + if (0 == shared_lt[idx].lkcnt) if (shared_gt[idx].attr & SHARED_RESIZE) + { if (shmdt((char *)(shared_lt[idx].p))) r = SHARED_IPCERR; /* segment is resizable, then detach segment */ + shared_lt[idx].p = NULL; /* signal detachment in local table */ + } + r2 = shared_demux(idx, mode); /* unlock segment, rest is only parameter checking */ + return(r ? r : r2); + } + + /* API routines - support and info routines */ + + +int shared_attr(int idx) /* get the attributes of the shared memory segment */ + { int r; + + if (shared_check_locked_index(idx)) return(SHARED_INVALID); + r = shared_gt[idx].attr; + return(r); + } + + +int shared_set_attr(int idx, int newattr) /* get the attributes of the shared memory segment */ + { int r; + + if (shared_check_locked_index(idx)) return(SHARED_INVALID); + if (-1 != shared_lt[idx].lkcnt) return(SHARED_INVALID); /* ADDED - check for RW lock */ + r = shared_gt[idx].attr; + shared_gt[idx].attr = newattr; + return(r); + + } + + +int shared_set_debug(int mode) /* set/reset debug mode */ + { int r = shared_debug; + + shared_debug = mode; + return(r); + } + + +int shared_set_createmode(int mode) /* set/reset debug mode */ + { int r = shared_create_mode; + + shared_create_mode = mode; + return(r); + } + + + + +int shared_list(int id) + { int i, r; + + if (NULL == shared_gt) return(SHARED_NOTINIT); /* not initialized */ + if (NULL == shared_lt) return(SHARED_NOTINIT); /* not initialized */ + if (shared_debug) printf("shared_list:"); + r = SHARED_OK; + printf(" Idx Key Nproc Size Flags\n"); + printf("==============================================\n"); + for (i=0; i= SHARED_ERRBASE) + { printf(" cannot clear PERSIST attribute"); + } + if (shared_free(i)) + { printf(" delete failed\n"); + } + else + { printf(" deleted\n"); + } + } + if (shared_debug) printf(" done\n"); + return(r); /* table full */ + } + + +/************************* CFITSIO DRIVER FUNCTIONS ***************************/ + +int smem_init(void) + { return(0); + } + +int smem_shutdown(void) + + { if (shared_init_called) shared_cleanup(); + return(0); + } + +int smem_setoptions(int option) + { option = 0; + return(0); + } + + +int smem_getoptions(int *options) + { if (NULL == options) return(SHARED_NULPTR); + *options = 0; + return(0); + } + +int smem_getversion(int *version) + { if (NULL == version) return(SHARED_NULPTR); + *version = 10; + return(0); + } + + +int smem_open(char *filename, int rwmode, int *driverhandle) + { int h, nitems, r; + DAL_SHM_SEGHEAD *sp; + + + if (NULL == filename) return(SHARED_NULPTR); + if (NULL == driverhandle) return(SHARED_NULPTR); + nitems = sscanf(filename, "h%d", &h); + if (1 != nitems) return(SHARED_BADARG); + + if (SHARED_OK != (r = shared_attach(h))) return(r); + + if (NULL == (sp = (DAL_SHM_SEGHEAD *)shared_lock(h, + ((READWRITE == rwmode) ? SHARED_RDWRITE : SHARED_RDONLY)))) + { shared_free(h); + return(SHARED_BADARG); + } + + if ((h != sp->h) || (DAL_SHM_SEGHEAD_ID != sp->ID)) + { shared_unlock(h); + shared_free(h); + + return(SHARED_BADARG); + } + + *driverhandle = h; + return(0); + } + + +int smem_create(char *filename, int *driverhandle) + { DAL_SHM_SEGHEAD *sp; + int h, sz, nitems; + + if (NULL == filename) return(SHARED_NULPTR); /* currently ignored */ + if (NULL == driverhandle) return(SHARED_NULPTR); + nitems = sscanf(filename, "h%d", &h); + if (1 != nitems) return(SHARED_BADARG); + + if (SHARED_INVALID == (h = shared_malloc(sz = 2880 + sizeof(DAL_SHM_SEGHEAD), + SHARED_RESIZE | SHARED_PERSIST, h))) + return(SHARED_NOMEM); + + if (NULL == (sp = (DAL_SHM_SEGHEAD *)shared_lock(h, SHARED_RDWRITE))) + { shared_free(h); + return(SHARED_BADARG); + } + + sp->ID = DAL_SHM_SEGHEAD_ID; + sp->h = h; + sp->size = sz; + sp->nodeidx = -1; + + *driverhandle = h; + + return(0); + } + + +int smem_close(int driverhandle) + { int r; + + if (SHARED_OK != (r = shared_unlock(driverhandle))) return(r); + return(shared_free(driverhandle)); + } + +int smem_remove(char *filename) + { int nitems, h, r; + + if (NULL == filename) return(SHARED_NULPTR); + nitems = sscanf(filename, "h%d", &h); + if (1 != nitems) return(SHARED_BADARG); + + if (0 == shared_check_locked_index(h)) /* are we locked ? */ + + { if (-1 != shared_lt[h].lkcnt) /* are we locked RO ? */ + { if (SHARED_OK != (r = shared_unlock(h))) return(r); /* yes, so relock in RW */ + if (NULL == shared_lock(h, SHARED_RDWRITE)) return(SHARED_BADARG); + } + + } + else /* not locked */ + { if (SHARED_OK != (r = smem_open(filename, READWRITE, &h))) + return(r); /* so open in RW mode */ + } + + shared_set_attr(h, SHARED_RESIZE); /* delete PERSIST attribute */ + return(smem_close(h)); /* detach segment (this will delete it) */ + } + +int smem_size(int driverhandle, OFF_T *size) + { + if (NULL == size) return(SHARED_NULPTR); + if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID); + *size = (OFF_T) (shared_gt[driverhandle].size - sizeof(DAL_SHM_SEGHEAD)); + return(0); + } + +int smem_flush(int driverhandle) + { + if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID); + return(0); + } + +int smem_seek(int driverhandle, OFF_T offset) + { + if (offset < 0) return(SHARED_BADARG); + if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID); + shared_lt[driverhandle].seekpos = offset; + return(0); + } + +int smem_read(int driverhandle, void *buffer, long nbytes) + { + if (NULL == buffer) return(SHARED_NULPTR); + if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID); + if (nbytes < 0) return(SHARED_BADARG); + if ((shared_lt[driverhandle].seekpos + nbytes) > shared_gt[driverhandle].size) + return(SHARED_BADARG); /* read beyond EOF */ + + memcpy(buffer, + ((char *)(((DAL_SHM_SEGHEAD *)(shared_lt[driverhandle].p + 1)) + 1)) + + shared_lt[driverhandle].seekpos, + nbytes); + + shared_lt[driverhandle].seekpos += nbytes; + return(0); + } + +int smem_write(int driverhandle, void *buffer, long nbytes) + { + if (NULL == buffer) return(SHARED_NULPTR); + if (shared_check_locked_index(driverhandle)) return(SHARED_INVALID); + if (-1 != shared_lt[driverhandle].lkcnt) return(SHARED_INVALID); /* are we locked RW ? */ + + if (nbytes < 0) return(SHARED_BADARG); + if ((unsigned long)(shared_lt[driverhandle].seekpos + nbytes) > (unsigned long)(shared_gt[driverhandle].size - sizeof(DAL_SHM_SEGHEAD))) + { /* need to realloc shmem */ + if (NULL == shared_realloc(driverhandle, shared_lt[driverhandle].seekpos + nbytes + sizeof(DAL_SHM_SEGHEAD))) + return(SHARED_NOMEM); + } + + memcpy(((char *)(((DAL_SHM_SEGHEAD *)(shared_lt[driverhandle].p + 1)) + 1)) + + shared_lt[driverhandle].seekpos, + buffer, + nbytes); + + shared_lt[driverhandle].seekpos += nbytes; + return(0); + } +#endif diff --git a/pkg/tbtables/cfitsio/drvrsmem.h b/pkg/tbtables/cfitsio/drvrsmem.h new file mode 100644 index 00000000..9b876013 --- /dev/null +++ b/pkg/tbtables/cfitsio/drvrsmem.h @@ -0,0 +1,179 @@ +/* S H A R E D M E M O R Y D R I V E R + ======================================= + + by Jerzy.Borkowski@obs.unige.ch + +09-Mar-98 : initial version 1.0 released +23-Mar-98 : shared_malloc now accepts new handle as an argument +*/ + + +#include /* this is necessary for Solaris/Linux */ +#include +#include + +#ifdef _AIX +#include +#else +#include +#endif + + /* configuration parameters */ + +#define SHARED_MAXSEG (16) /* maximum number of shared memory blocks */ + +#define SHARED_KEYBASE (14011963) /* base for shared memory keys, may be overriden by getenv */ +#define SHARED_FDNAME ("/tmp/.shmem-lockfile") /* template for lock file name */ + +#define SHARED_ENV_KEYBASE ("SHMEM_LIB_KEYBASE") /* name of environment variable */ +#define SHARED_ENV_MAXSEG ("SHMEM_LIB_MAXSEG") /* name of environment variable */ + + /* useful constants */ + +#define SHARED_RDONLY (0) /* flag for shared_(un)lock, lock for read */ +#define SHARED_RDWRITE (1) /* flag for shared_(un)lock, lock for write */ +#define SHARED_WAIT (0) /* flag for shared_lock, block if cannot lock immediate */ +#define SHARED_NOWAIT (2) /* flag for shared_lock, fail if cannot lock immediate */ +#define SHARED_NOLOCK (0x100) /* flag for shared_validate function */ + +#define SHARED_RESIZE (4) /* flag for shared_malloc, object is resizeable */ +#define SHARED_PERSIST (8) /* flag for shared_malloc, object is not deleted after last proc detaches */ + +#define SHARED_INVALID (-1) /* invalid handle for semaphore/shared memory */ + +#define SHARED_EMPTY (0) /* entries for shared_used table */ +#define SHARED_USED (1) + +#define SHARED_GRANUL (16384) /* granularity of shared_malloc allocation = phys page size, system dependent */ + + + + /* checkpoints in shared memory segments - might be omitted */ + +#define SHARED_ID_0 ('J') /* first byte of identifier in BLKHEAD */ +#define SHARED_ID_1 ('B') /* second byte of identifier in BLKHEAD */ + +#define BLOCK_REG (0) /* value for tflag member of BLKHEAD */ +#define BLOCK_SHARED (1) /* value for tflag member of BLKHEAD */ + + /* generic error codes */ + +#define SHARED_OK (0) + +#define SHARED_ERR_MIN_IDX SHARED_BADARG +#define SHARED_ERR_MAX_IDX SHARED_NORESIZE + + +#define DAL_SHM_FREE (0) +#define DAL_SHM_USED (1) + +#define DAL_SHM_ID0 ('D') +#define DAL_SHM_ID1 ('S') +#define DAL_SHM_ID2 ('M') + +#define DAL_SHM_SEGHEAD_ID (0x19630114) + + + + /* data types */ + +/* BLKHEAD object is placed at the beginning of every memory segment (both + shared and regular) to allow automatic recognition of segments type */ + +typedef union + { struct BLKHEADstruct + { char ID[2]; /* ID = 'JB', just as a checkpoint */ + char tflag; /* is it shared memory or regular one ? */ + int handle; /* this is not necessary, used only for non-resizeable objects via ptr */ + } s; + double d; /* for proper alignment on every machine */ + } BLKHEAD; + +typedef void *SHARED_P; /* generic type of shared memory pointer */ + +typedef struct SHARED_GTABstruct /* data type used in global table */ + { int sem; /* access semaphore (1 field): process count */ + int semkey; /* key value used to generate semaphore handle */ + int key; /* key value used to generate shared memory handle (realloc changes it) */ + int handle; /* handle of shared memory segment */ + int size; /* size of shared memory segment */ + int nprocdebug; /* attached proc counter, helps remove zombie segments */ + char attr; /* attributes of shared memory object */ + } SHARED_GTAB; + +typedef struct SHARED_LTABstruct /* data type used in local table */ + { BLKHEAD *p; /* pointer to segment (may be null) */ + int tcnt; /* number of threads in this process attached to segment */ + int lkcnt; /* >=0 <- number of read locks, -1 - write lock */ + long seekpos; /* current pointer position, read/write/seek operations change it */ + } SHARED_LTAB; + + + /* system dependent definitions */ + +#ifndef HAVE_FLOCK_T +typedef struct flock flock_t; +#define HAVE_FLOCK_T +#endif + +#ifndef HAVE_UNION_SEMUN +union semun + { int val; + struct semid_ds *buf; + unsigned short *array; + }; +#define HAVE_UNION_SEMUN +#endif + + +typedef struct DAL_SHM_SEGHEAD_STRUCT DAL_SHM_SEGHEAD; + +struct DAL_SHM_SEGHEAD_STRUCT + { int ID; /* ID for debugging */ + int h; /* handle of sh. mem */ + int size; /* size of data area */ + int nodeidx; /* offset of root object (node struct typically) */ + }; + + /* API routines */ + +#ifdef __cplusplus +extern "C" { +#endif + +void shared_cleanup(void); /* must be called at exit/abort */ +int shared_init(int debug_msgs); /* must be called before any other shared memory routine */ +int shared_recover(int id); /* try to recover dormant segment(s) after applic crash */ +int shared_malloc(long size, int mode, int newhandle); /* allocate n-bytes of shared memory */ +int shared_attach(int idx); /* attach to segment given index to table */ +int shared_free(int idx); /* release shared memory */ +SHARED_P shared_lock(int idx, int mode); /* lock segment for reading */ +SHARED_P shared_realloc(int idx, long newsize); /* reallocate n-bytes of shared memory (ON LOCKED SEGMENT ONLY) */ +int shared_size(int idx); /* get size of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_attr(int idx); /* get attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_set_attr(int idx, int newattr); /* set attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_unlock(int idx); /* unlock segment (ON LOCKED SEGMENT ONLY) */ +int shared_set_debug(int debug_msgs); /* set/reset debug mode */ +int shared_set_createmode(int mode); /* set/reset debug mode */ +int shared_list(int id); /* list segment(s) */ +int shared_uncond_delete(int id); /* uncondintionally delete (NOWAIT operation) segment(s) */ +int shared_getaddr(int id, char **address); /* get starting address of FITS file in segment */ + +int smem_init(void); +int smem_shutdown(void); +int smem_setoptions(int options); +int smem_getoptions(int *options); +int smem_getversion(int *version); +int smem_open(char *filename, int rwmode, int *driverhandle); +int smem_create(char *filename, int *driverhandle); +int smem_close(int driverhandle); +int smem_remove(char *filename); +int smem_size(int driverhandle, OFF_T *size); +int smem_flush(int driverhandle); +int smem_seek(int driverhandle, OFF_T offset); +int smem_read(int driverhandle, void *buffer, long nbytes); +int smem_write(int driverhandle, void *buffer, long nbytes); + +#ifdef __cplusplus +} +#endif diff --git a/pkg/tbtables/cfitsio/editcol.c b/pkg/tbtables/cfitsio/editcol.c new file mode 100644 index 00000000..57e7622f --- /dev/null +++ b/pkg/tbtables/cfitsio/editcol.c @@ -0,0 +1,2068 @@ +/* This file, editcol.c, contains the set of FITSIO routines that */ +/* insert or delete rows or columns in a table or resize an image */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffrsim(fitsfile *fptr, /* I - FITS file pointer */ + int bitpix, /* I - bits per pixel */ + int naxis, /* I - number of axes in the array */ + long *naxes, /* I - size of each axis */ + int *status) /* IO - error status */ +/* + resize an existing primary array or IMAGE extension. +*/ +{ + int ii, simple, obitpix, onaxis, extend, nmodify; + long onaxes[99], pcount, gcount, nblocks, longval; + long longbitpix; + OFF_T newsize, oldsize; + char comment[FLEN_COMMENT], keyname[FLEN_KEYWORD], message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + /* get current image size parameters */ + if (ffghpr(fptr, 99, &simple, &obitpix, &onaxis, onaxes, &pcount, + &gcount, &extend, status) > 0) + return(*status); + + longbitpix = bitpix; + + /* test for the 2 special cases that represent unsigned integers */ + if (longbitpix == USHORT_IMG) + longbitpix = SHORT_IMG; + else if (longbitpix == ULONG_IMG) + longbitpix = LONG_IMG; + + /* test that the new values are legal */ + + if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG && + longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG && + longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG) + { + sprintf(message, + "Illegal value for BITPIX keyword: %d", bitpix); + ffpmsg(message); + return(*status = BAD_BITPIX); + } + + if (naxis < 0 || naxis > 999) + { + sprintf(message, + "Illegal value for NAXIS keyword: %d", naxis); + ffpmsg(message); + return(*status = BAD_NAXIS); + } + + if (naxis == 0) + newsize = 0; + else + newsize = 1; + + for (ii = 0; ii < naxis; ii++) + { + if (naxes[ii] < 0) + { + sprintf(message, + "Illegal value for NAXIS%d keyword: %ld", ii + 1, naxes[ii]); + ffpmsg(message); + return(*status = BAD_NAXES); + } + + newsize *= naxes[ii]; /* compute new image size, in pixels */ + } + + /* compute size of old image, in bytes */ + + if (onaxis == 0) + oldsize = 0; + else + { + oldsize = 1; + for (ii = 0; ii < onaxis; ii++) + oldsize *= onaxes[ii]; + oldsize = (oldsize + pcount) * gcount * (abs(obitpix) / 8); + } + + oldsize = (oldsize + 2879) / 2880; /* old size, in blocks */ + + newsize = (newsize + pcount) * gcount * (abs(longbitpix) / 8); + newsize = (newsize + 2879) / 2880; /* new size, in blocks */ + + if (newsize > oldsize) /* have to insert new blocks for image */ + { + nblocks = newsize - oldsize; + if (ffiblk(fptr, nblocks, 1, status) > 0) + return(*status); + } + else if (oldsize > newsize) /* have to delete blocks from image */ + { + nblocks = oldsize - newsize; + if (ffdblk(fptr, nblocks, status) > 0) + return(*status); + } + + /* now update the header keywords */ + + strcpy(comment,"&"); /* special value to leave comments unchanged */ + + if (longbitpix != obitpix) + { /* update BITPIX value */ + ffmkyj(fptr, "BITPIX", longbitpix, comment, status); + } + + if (naxis != onaxis) + { /* update NAXIS value */ + longval = naxis; + ffmkyj(fptr, "NAXIS", longval, comment, status); + } + + /* modify the existing NAXISn keywords */ + nmodify = minvalue(naxis, onaxis); + for (ii = 0; ii < nmodify; ii++) + { + ffkeyn("NAXIS", ii+1, keyname, status); + ffmkyj(fptr, keyname, naxes[ii], comment, status); + } + + if (naxis > onaxis) /* insert additional NAXISn keywords */ + { + strcpy(comment,"length of data axis"); + for (ii = onaxis; ii < naxis; ii++) + { + ffkeyn("NAXIS", ii+1, keyname, status); + ffikyj(fptr, keyname, naxes[ii], comment, status); + } + } + else if (onaxis > naxis) /* delete old NAXISn keywords */ + { + for (ii = naxis; ii < onaxis; ii++) + { + ffkeyn("NAXIS", ii+1, keyname, status); + ffdkey(fptr, keyname, status); + } + } + + /* Update the BSCALE and BZERO keywords, if an unsigned integer image */ + if (bitpix == USHORT_IMG) + { + strcpy(comment, "offset data range to that of unsigned short"); + ffukyg(fptr, "BZERO", 32768., 0, comment, status); + strcpy(comment, "default scaling factor"); + ffukyg(fptr, "BSCALE", 1.0, 0, comment, status); + } + else if (bitpix == ULONG_IMG) + { + strcpy(comment, "offset data range to that of unsigned long"); + ffukyg(fptr, "BZERO", 2147483648., 0, comment, status); + strcpy(comment, "default scaling factor"); + ffukyg(fptr, "BSCALE", 1.0, 0, comment, status); + } + + /* re-read the header, to make sure structures are updated */ + ffrdef(fptr, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffirow(fitsfile *fptr, /* I - FITS file pointer */ + long firstrow, /* I - insert space AFTER this row */ + /* 0 = insert space at beginning of table */ + long nrows, /* I - number of rows to insert */ + int *status) /* IO - error status */ +/* + insert NROWS blank rows immediated after row firstrow (1 = first row). + Set firstrow = 0 to insert space at the beginning of the table. +*/ +{ + int tstatus; + long naxis1, naxis2; + OFF_T datasize, firstbyte, nshift, nbytes; + long freespace, nblock; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg("Can only add rows to TABLE or BINTABLE extension (ffirow)"); + return(*status = NOT_TABLE); + } + + if (nrows < 0 ) + return(*status = NEG_BYTES); + else if (nrows == 0) + return(*status); /* no op, so just return */ + + /* get the current size of the table */ + /* use internal structure since NAXIS2 keyword may not be up to date */ + naxis1 = (long) (fptr->Fptr)->rowlength; + naxis2 = (fptr->Fptr)->numrows; + + if (firstrow > naxis2) + { + ffpmsg( + "Insert position greater than the number of rows in the table (ffirow)"); + return(*status = BAD_ROW_NUM); + } + else if (firstrow < 0) + { + ffpmsg("Insert position is less than 0 (ffirow)"); + return(*status = BAD_ROW_NUM); + } + + /* current data size */ + datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize; + freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize; + nshift = (OFF_T)naxis1 * nrows; /* no. of bytes to add to table */ + + if ( (freespace - nshift) < 0) /* not enough existing space? */ + { + nblock = (nshift - freespace + 2879) / 2880; /* number of blocks */ + ffiblk(fptr, nblock, 1, status); /* insert the blocks */ + } + + firstbyte = (OFF_T)naxis1 * firstrow; /* relative insert position */ + nbytes = datasize - firstbyte; /* no. of bytes to shift down */ + firstbyte += ((fptr->Fptr)->datastart); /* absolute insert position */ + + ffshft(fptr, firstbyte, nbytes, nshift, status); /* shift rows and heap */ + + /* update the heap starting address */ + (fptr->Fptr)->heapstart += nshift; + + /* update the THEAP keyword if it exists */ + tstatus = 0; + ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus); + + /* update the NAXIS2 keyword */ + ffmkyj(fptr, "NAXIS2", naxis2 + nrows, "&", status); + ((fptr->Fptr)->numrows) += nrows; + ((fptr->Fptr)->origrows) += nrows; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdrow(fitsfile *fptr, /* I - FITS file pointer */ + long firstrow, /* I - first row to delete (1 = first) */ + long nrows, /* I - number of rows to delete */ + int *status) /* IO - error status */ +/* + delete NROWS rows from table starting with firstrow (1 = first row of table). +*/ +{ + int tstatus; + long naxis1, naxis2; + OFF_T datasize, firstbyte, nbytes, nshift; + long freespace, nblock; + char comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrow)"); + return(*status = NOT_TABLE); + } + + if (nrows < 0 ) + return(*status = NEG_BYTES); + else if (nrows == 0) + return(*status); /* no op, so just return */ + + ffgkyj(fptr, "NAXIS1", &naxis1, comm, status); /* get the current */ + + /* ffgkyj(fptr, "NAXIS2", &naxis2, comm, status);*/ /* size of the table */ + + /* the NAXIS2 keyword may not be up to date, so use the structure value */ + naxis2 = (fptr->Fptr)->numrows; + + if (firstrow > naxis2) + { + ffpmsg( + "Delete position greater than the number of rows in the table (ffdrow)"); + return(*status = BAD_ROW_NUM); + } + else if (firstrow < 1) + { + ffpmsg("Delete position is less than 1 (ffdrow)"); + return(*status = BAD_ROW_NUM); + } + else if (firstrow + nrows - 1 > naxis2) + { + ffpmsg("No. of rows to delete exceeds size of table (ffdrow)"); + return(*status = BAD_ROW_NUM); + } + + nshift = (OFF_T)naxis1 * nrows; /* no. of bytes to delete from table */ + /* cur size of data */ + datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize; + + firstbyte = (OFF_T)naxis1 * (firstrow + nrows - 1); /* relative del pos */ + nbytes = datasize - firstbyte; /* no. of bytes to shift up */ + firstbyte += ((fptr->Fptr)->datastart); /* absolute delete position */ + + ffshft(fptr, firstbyte, nbytes, nshift * (-1), status); /* shift data */ + + freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize; + nblock = (nshift + freespace) / 2880; /* number of blocks */ + + /* delete integral number blocks */ + if (nblock > 0) + ffdblk(fptr, nblock, status); + + /* update the heap starting address */ + (fptr->Fptr)->heapstart -= nshift; + + /* update the THEAP keyword if it exists */ + tstatus = 0; + ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus); + + /* update the NAXIS2 keyword */ + ffmkyj(fptr, "NAXIS2", naxis2 - nrows, "&", status); + ((fptr->Fptr)->numrows) -= nrows; + ((fptr->Fptr)->origrows) -= nrows; + + /* Update the heap data, if any. This will remove any orphaned data */ + /* that was only pointed to by the rows that have been deleted */ + ffcmph(fptr, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdrrg(fitsfile *fptr, /* I - FITS file pointer to table */ + char *ranges, /* I - ranges of rows to delete (1 = first) */ + int *status) /* IO - error status */ +/* + delete the ranges of rows from the table (1 = first row of table). + +The 'ranges' parameter typically looks like: + '10-20, 30 - 40, 55' or '50-' +and gives a list of rows or row ranges separated by commas. +*/ +{ + char *cptr; + int nranges, nranges2, ii; + long *minrow, *maxrow, naxis2, nrows, *rowarray, jj, kk; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrrg)"); + return(*status = NOT_TABLE); + } + + /* the NAXIS2 keyword may not be up to date, so use the structure value */ + naxis2 = (fptr->Fptr)->numrows; + + /* find how many ranges were specified ( = no. of commas in string + 1) */ + cptr = ranges; + for (nranges = 1; (cptr = strchr(cptr, ',')); nranges++) + cptr++; + + minrow = calloc(nranges, sizeof(long)); + maxrow = calloc(nranges, sizeof(long)); + + if (!minrow || !maxrow) { + *status = MEMORY_ALLOCATION; + ffpmsg("failed to allocate memory for row ranges (ffdrrg)"); + if (maxrow) free(maxrow); + if (minrow) free(minrow); + return(*status); + } + + /* parse range list into array of range min and max values */ + ffrwrg(ranges, naxis2, nranges, &nranges2, minrow, maxrow, status); + if (*status > 0 || nranges2 == 0) { + free(maxrow); + free(minrow); + return(*status); + } + + /* determine total number or rows to delete */ + nrows = 0; + for (ii = 0; ii < nranges2; ii++) { + nrows = nrows + maxrow[ii] - minrow[ii] + 1; + } + + rowarray = calloc(nrows, sizeof(long)); + if (!rowarray) { + *status = MEMORY_ALLOCATION; + ffpmsg("failed to allocate memory for row array (ffdrrg)"); + return(*status); + } + + for (kk = 0, ii = 0; ii < nranges2; ii++) { + for (jj = minrow[ii]; jj <= maxrow[ii]; jj++) { + rowarray[kk] = jj; + kk++; + } + } + + /* delete the rows */ + ffdrws(fptr, rowarray, nrows, status); + + free(rowarray); + free(maxrow); + free(minrow); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdrws(fitsfile *fptr, /* I - FITS file pointer */ + long *rownum, /* I - list of rows to delete (1 = first) */ + long nrows, /* I - number of rows to delete */ + int *status) /* IO - error status */ +/* + delete the list of rows from the table (1 = first row of table). +*/ +{ + OFF_T insertpos, nextrowpos; + long naxis1, naxis2, ii, nextrow; + char comm[FLEN_COMMENT]; + unsigned char *buffer; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrws)"); + return(*status = NOT_TABLE); + } + + if (nrows < 0 ) + return(*status = NEG_BYTES); + else if (nrows == 0) + return(*status); /* no op, so just return */ + + ffgkyj(fptr, "NAXIS1", &naxis1, comm, status); /* row width */ + ffgkyj(fptr, "NAXIS2", &naxis2, comm, status); /* number of rows */ + + /* check that input row list is in ascending order */ + for (ii = 1; ii < nrows; ii++) + { + if (rownum[ii - 1] >= rownum[ii]) + { + ffpmsg("row numbers are not in increasing order (ffdrws)"); + return(*status = BAD_ROW_NUM); + } + } + + if (rownum[0] < 1) + { + ffpmsg("first row to delete is less than 1 (ffdrws)"); + return(*status = BAD_ROW_NUM); + } + else if (rownum[nrows - 1] > naxis2) + { + ffpmsg("last row to delete exceeds size of table (ffdrws)"); + return(*status = BAD_ROW_NUM); + } + + buffer = (unsigned char *) malloc(naxis1); /* buffer for one row */ + + if (!buffer) + { + ffpmsg("malloc failed (ffdrws)"); + return(*status = MEMORY_ALLOCATION); + } + + /* byte location to start of first row to delete, and the next row */ + insertpos = (fptr->Fptr)->datastart + ((rownum[0] - 1) * naxis1); + nextrowpos = insertpos + naxis1; + nextrow = rownum[0] + 1; + + /* work through the list of rows to delete */ + for (ii = 1; ii < nrows; nextrow++, nextrowpos += naxis1) + { + if (nextrow < rownum[ii]) + { /* keep this row, so copy it to the new position */ + + ffmbyt(fptr, nextrowpos, REPORT_EOF, status); + ffgbyt(fptr, naxis1, buffer, status); /* read the bytes */ + + ffmbyt(fptr, insertpos, IGNORE_EOF, status); + ffpbyt(fptr, naxis1, buffer, status); /* write the bytes */ + + if (*status > 0) + { + ffpmsg("error while copying good rows in table (ffdrws)"); + free(buffer); + return(*status); + } + insertpos += naxis1; + } + else + { /* skip over this row since it is in the list */ + ii++; + } + } + + /* finished with all the rows to delete; copy remaining rows */ + while(nextrow <= naxis2) + { + ffmbyt(fptr, nextrowpos, REPORT_EOF, status); + ffgbyt(fptr, naxis1, buffer, status); /* read the bytes */ + + ffmbyt(fptr, insertpos, IGNORE_EOF, status); + ffpbyt(fptr, naxis1, buffer, status); /* write the bytes */ + + if (*status > 0) + { + ffpmsg("failed to copy remaining rows in table (ffdrws)"); + free(buffer); + return(*status); + } + insertpos += naxis1; + nextrowpos += naxis1; + nextrow++; + } + free(buffer); + + /* now delete the empty rows at the end of the table */ + ffdrow(fptr, naxis2 - nrows + 1, nrows, status); + + /* Update the heap data, if any. This will remove any orphaned data */ + /* that was only pointed to by the rows that have been deleted */ + ffcmph(fptr, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffrwrg( + char *rowlist, /* I - list of rows and row ranges */ + long maxrows, /* I - number of rows in the table */ + int maxranges, /* I - max number of ranges to be returned */ + int *numranges, /* O - number ranges returned */ + long *minrow, /* O - first row in each range */ + long *maxrow, /* O - last row in each range */ + int *status) /* IO - status value */ +{ +/* + parse the input list of row ranges, returning the number of ranges, + and the min and max row value in each range. + + The only characters allowed in the input rowlist are + decimal digits, minus sign, and comma (and non-significant spaces) + + Example: + + list = "10-20, 30-35,50" + + would return numranges = 3, minrow[] = {10, 30, 50}, maxrow[] = {20, 35, 50} + + error is returned if min value of range is > max value of range or if the + ranges are not monotonically increasing. +*/ + char *next; + long minval, maxval; + + if (*status > 0) + return(*status); + + if (maxrows <= 0 ) { + *status = RANGE_PARSE_ERROR; + ffpmsg("Input maximum range value is <= 0 (fits_parse_ranges)"); + return(*status); + } + + next = rowlist; + *numranges = 0; + + while (*next == ' ')next++; /* skip spaces */ + + while (*next != '\0') { + + /* find min value of next range; *next must be '-' or a digit */ + if (*next == '-') { + minval = 1; /* implied minrow value = 1 */ + } else if ( isdigit((int) *next) ) { + minval = strtol(next, &next, 10); + } else { + *status = RANGE_PARSE_ERROR; + ffpmsg("Syntax error in this row range list:"); + ffpmsg(rowlist); + return(*status); + } + + while (*next == ' ')next++; /* skip spaces */ + + /* find max value of next range; *next must be '-', or ',' */ + if (*next == '-') { + next++; + while (*next == ' ')next++; /* skip spaces */ + + if ( isdigit((int) *next) ) { + maxval = strtol(next, &next, 10); + } else if (*next == ',' || *next == '\0') { + maxval = maxrows; /* implied max value */ + } else { + *status = RANGE_PARSE_ERROR; + ffpmsg("Syntax error in this row range list:"); + ffpmsg(rowlist); + return(*status); + } + } else if (*next == ',' || *next == '\0') { + maxval = minval; /* only a single integer in this range */ + } else { + *status = RANGE_PARSE_ERROR; + ffpmsg("Syntax error in this row range list:"); + ffpmsg(rowlist); + return(*status); + } + + if (*numranges + 1 > maxranges) { + *status = RANGE_PARSE_ERROR; + ffpmsg("Overflowed maximum number of ranges (fits_parse_ranges)"); + return(*status); + } + + if (minval < 1 ) { + *status = RANGE_PARSE_ERROR; + ffpmsg("Syntax error in this row range list: row number < 1"); + ffpmsg(rowlist); + return(*status); + } + + if (maxval < minval) { + *status = RANGE_PARSE_ERROR; + ffpmsg("Syntax error in this row range list: min > max"); + ffpmsg(rowlist); + return(*status); + } + + if (*numranges > 0) { + if (minval <= maxrow[(*numranges) - 1]) { + *status = RANGE_PARSE_ERROR; + ffpmsg("Syntax error in this row range list. Range minimum is"); + ffpmsg(" less than or equal to previous range maximum"); + ffpmsg(rowlist); + return(*status); + } + } + + if (minval <= maxrows) { /* ignore range if greater than maxrows */ + if (maxval > maxrows) + maxval = maxrows; + + minrow[*numranges] = minval; + maxrow[*numranges] = maxval; + + (*numranges)++; + } + + while (*next == ' ')next++; /* skip spaces */ + if (*next == ',') { + next++; + while (*next == ' ')next++; /* skip more spaces */ + } + } + + if (*numranges == 0) { /* a null string was entered */ + minrow[0] = 1; + maxrow[0] = maxrows; + *numranges = 1; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fficol(fitsfile *fptr, /* I - FITS file pointer */ + int numcol, /* I - position for new col. (1 = 1st) */ + char *ttype, /* I - name of column (TTYPE keyword) */ + char *tform, /* I - format of column (TFORM keyword) */ + int *status) /* IO - error status */ +/* + Insert a new column into an existing table at position numcol. If + numcol is greater than the number of existing columns in the table + then the new column will be appended as the last column in the table. +*/ +{ + char *name, *format; + + name = ttype; + format = tform; + + fficls(fptr, numcol, 1, &name, &format, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fficls(fitsfile *fptr, /* I - FITS file pointer */ + int fstcol, /* I - position for first new col. (1 = 1st) */ + int ncols, /* I - number of columns to insert */ + char **ttype, /* I - array of column names(TTYPE keywords) */ + char **tform, /* I - array of formats of column (TFORM) */ + int *status) /* IO - error status */ +/* + Insert 1 or more new columns into an existing table at position numcol. If + fstcol is greater than the number of existing columns in the table + then the new column will be appended as the last column in the table. +*/ +{ + int colnum, datacode, decims, tfields, tstatus, ii; + OFF_T datasize, firstbyte, nbytes, nadd; + long width, firstcol, delbyte, repeat, naxis1, naxis2, freespace; + long nblock, tbcol; + char tfm[FLEN_VALUE], keyname[FLEN_KEYWORD], comm[FLEN_COMMENT], *cptr; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg("Can only add columns to TABLE or BINTABLE extension (fficol)"); + return(*status = NOT_TABLE); + } + + /* is the column number valid? */ + tfields = (fptr->Fptr)->tfield; + if (fstcol < 1 ) + return(*status = BAD_COL_NUM); + else if (fstcol > tfields) + colnum = tfields + 1; /* append as last column */ + else + colnum = fstcol; + + /* parse the tform value and calc number of bytes to add to each row */ + delbyte = 0; + for (ii = 0; ii < ncols; ii++) + { + strcpy(tfm, tform[ii]); + ffupch(tfm); /* make sure format is in upper case */ + + if ((fptr->Fptr)->hdutype == ASCII_TBL) + { + ffasfm(tfm, &datacode, &width, &decims, status); + delbyte += width + 1; /* add one space between the columns */ + } + else + { + ffbnfm(tfm, &datacode, &repeat, &width, status); + + if (datacode < 0) /* variable length array column */ + delbyte += 8; + else if (datacode == 1) /* bit column; round up */ + delbyte += (repeat + 7) / 8; /* to multiple of 8 bits */ + else if (datacode == 16) /* ASCII string column */ + delbyte += repeat; + else /* numerical data type */ + delbyte += (datacode / 10) * repeat; + } + } + + if (*status > 0) + return(*status); + + /* get the current size of the table */ + /* use internal structure since NAXIS2 keyword may not be up to date */ + naxis1 = (long) (fptr->Fptr)->rowlength; + naxis2 = (fptr->Fptr)->numrows; + + /* current size of data */ + datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize; + freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize; + nadd = (OFF_T)delbyte * naxis2; /* no. of bytes to add to table */ + + if ( (freespace - nadd) < 0) /* not enough existing space? */ + { + nblock = (nadd - freespace + 2879) / 2880; /* number of blocks */ + if (ffiblk(fptr, nblock, 1, status) > 0) /* insert the blocks */ + return(*status); + } + + /* shift heap down (if it exists) */ + if ((fptr->Fptr)->heapsize > 0) + { + nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift down */ + + /* absolute heap pos */ + firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart; + + if (ffshft(fptr, firstbyte, nbytes, nadd, status) > 0) /* move heap */ + return(*status); + } + + /* update the heap starting address */ + (fptr->Fptr)->heapstart += nadd; + + /* update the THEAP keyword if it exists */ + tstatus = 0; + ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus); + + /* calculate byte position in the row where to insert the new column */ + if (colnum > tfields) + firstcol = naxis1; + else + { + colptr = (fptr->Fptr)->tableptr; + colptr += (colnum - 1); + firstcol = colptr->tbcol; + } + + /* insert delbyte bytes in every row, at byte position firstcol */ + ffcins(fptr, naxis1, naxis2, delbyte, firstcol, status); + + if ((fptr->Fptr)->hdutype == ASCII_TBL) + { + /* adjust the TBCOL values of the existing columns */ + for(ii = 0; ii < tfields; ii++) + { + ffkeyn("TBCOL", ii + 1, keyname, status); + ffgkyj(fptr, keyname, &tbcol, comm, status); + if (tbcol > firstcol) + { + tbcol += delbyte; + ffmkyj(fptr, keyname, tbcol, "&", status); + } + } + } + + /* update the mandatory keywords */ + ffmkyj(fptr, "TFIELDS", tfields + ncols, "&", status); + ffmkyj(fptr, "NAXIS1", naxis1 + delbyte, "&", status); + + /* increment the index value on any existing column keywords */ + if(colnum <= tfields) + ffkshf(fptr, colnum, tfields, ncols, status); + + /* add the required keywords for the new columns */ + for (ii = 0; ii < ncols; ii++, colnum++) + { + strcpy(comm, "label for field"); + ffkeyn("TTYPE", colnum, keyname, status); + ffpkys(fptr, keyname, ttype[ii], comm, status); + + strcpy(comm, "format of field"); + strcpy(tfm, tform[ii]); + ffupch(tfm); /* make sure format is in upper case */ + ffkeyn("TFORM", colnum, keyname, status); + + if (abs(datacode) == TSBYTE) + { + /* Replace the 'S' with an 'B' in the TFORMn code */ + cptr = tfm; + while (*cptr != 'S') + cptr++; + + *cptr = 'B'; + ffpkys(fptr, keyname, tfm, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", colnum, keyname, status); + strcpy(comm, "offset for signed bytes"); + + ffpkyg(fptr, keyname, -128., 0, comm, status); + + ffkeyn("TSCAL", colnum, keyname, status); + strcpy(comm, "data are not scaled"); + ffpkyg(fptr, keyname, 1., 0, comm, status); + } + else if (abs(datacode) == TUSHORT) + { + /* Replace the 'U' with an 'I' in the TFORMn code */ + cptr = tfm; + while (*cptr != 'U') + cptr++; + + *cptr = 'I'; + ffpkys(fptr, keyname, tfm, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", colnum, keyname, status); + strcpy(comm, "offset for unsigned integers"); + + ffpkyg(fptr, keyname, 32768., 0, comm, status); + + ffkeyn("TSCAL", colnum, keyname, status); + strcpy(comm, "data are not scaled"); + ffpkyg(fptr, keyname, 1., 0, comm, status); + } + else if (abs(datacode) == TULONG) + { + /* Replace the 'V' with an 'J' in the TFORMn code */ + cptr = tfm; + while (*cptr != 'V') + cptr++; + + *cptr = 'J'; + ffpkys(fptr, keyname, tfm, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", colnum, keyname, status); + strcpy(comm, "offset for unsigned integers"); + + ffpkyg(fptr, keyname, 2147483648., 0, comm, status); + + ffkeyn("TSCAL", colnum, keyname, status); + strcpy(comm, "data are not scaled"); + ffpkyg(fptr, keyname, 1., 0, comm, status); + } + else + { + ffpkys(fptr, keyname, tfm, comm, status); + } + + if ((fptr->Fptr)->hdutype == ASCII_TBL) /* write the TBCOL keyword */ + { + if (colnum == tfields + 1) + tbcol = firstcol + 2; /* allow space between preceding col */ + else + tbcol = firstcol + 1; + + strcpy(comm, "beginning column of field"); + ffkeyn("TBCOL", colnum, keyname, status); + ffpkyj(fptr, keyname, tbcol, comm, status); + + /* increment the column starting position for the next column */ + ffasfm(tfm, &datacode, &width, &decims, status); + firstcol += width + 1; /* add one space between the columns */ + } + } + ffrdef(fptr, status); /* initialize the new table structure */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmvec(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - position of col to be modified */ + long newveclen, /* I - new vector length of column (TFORM) */ + int *status) /* IO - error status */ +/* + Modify the vector length of a column in a binary table, larger or smaller. + E.g., change a column from TFORMn = '1E' to '20E'. +*/ +{ + int datacode, tfields, tstatus; + OFF_T datasize, size, firstbyte, nbytes, nadd, ndelete; + long width, delbyte, repeat, naxis1, naxis2, freespace; + long nblock, firstcol; + char tfm[FLEN_VALUE], keyname[FLEN_KEYWORD], tcode[2]; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype != BINARY_TBL) + { + ffpmsg( + "Can only change vector length of a column in BINTABLE extension (ffmvec)"); + return(*status = NOT_TABLE); + } + + /* is the column number valid? */ + tfields = (fptr->Fptr)->tfield; + if (colnum < 1 || colnum > tfields) + return(*status = BAD_COL_NUM); + + /* look up the current vector length and element width */ + + colptr = (fptr->Fptr)->tableptr; + colptr += (colnum - 1); + + datacode = colptr->tdatatype; /* datatype of the column */ + repeat = (long) colptr->trepeat; /* field repeat count */ + width = colptr->twidth; /* width of a single element in chars */ + + if (datacode < 0) + { + ffpmsg( + "Can't modify vector length of variable length column (ffmvec)"); + return(*status = BAD_TFORM); + } + + if (repeat == newveclen) + return(*status); /* column already has the desired vector length */ + + if (datacode == TSTRING) + width = 1; /* width was equal to width of unit string */ + + naxis1 = (long) (fptr->Fptr)->rowlength; /* current width of the table */ + naxis2 = (fptr->Fptr)->numrows; + + delbyte = (newveclen - repeat) * width; /* no. of bytes to insert */ + if (datacode == TBIT) /* BIT column is a special case */ + delbyte = ((newveclen + 1) / 8) - ((repeat + 1) / 8); + + if (delbyte > 0) /* insert space for more elements */ + { + /* current size of data */ + datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize; + freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize; + + nadd = (OFF_T)delbyte * naxis2; /* no. of bytes to add to table */ + + if ( (freespace - nadd) < 0) /* not enough existing space? */ + { + nblock = (nadd - freespace + 2879) / 2880; /* number of blocks */ + if (ffiblk(fptr, nblock, 1, status) > 0) /* insert the blocks */ + return(*status); + } + + /* shift heap down (if it exists) */ + if ((fptr->Fptr)->heapsize > 0) + { + nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift down */ + + /* absolute heap pos */ + firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart; + + if (ffshft(fptr, firstbyte, nbytes, nadd, status) > 0) /* move heap */ + return(*status); + } + + /* update the heap starting address */ + (fptr->Fptr)->heapstart += nadd; + + /* update the THEAP keyword if it exists */ + tstatus = 0; + ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus); + + firstcol = colptr->tbcol + (repeat * width); /* insert position */ + + /* insert delbyte bytes in every row, at byte position firstcol */ + ffcins(fptr, naxis1, naxis2, delbyte, firstcol, status); + } + else if (delbyte < 0) + { + /* current size of table */ + size = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize; + freespace = ((size + 2879) / 2880) * 2880 - size - ((OFF_T)delbyte * naxis2); + nblock = freespace / 2880; /* number of empty blocks to delete */ + firstcol = colptr->tbcol + (newveclen * width); /* delete position */ + + /* delete elements from the vector */ + ffcdel(fptr, naxis1, naxis2, -delbyte, firstcol, status); + + /* abs heap pos */ + firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart; + ndelete = (OFF_T)delbyte * naxis2; /* size of shift (negative) */ + + /* shift heap up (if it exists) */ + if ((fptr->Fptr)->heapsize > 0) + { + nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift up */ + if (ffshft(fptr, firstbyte, nbytes, ndelete, status) > 0) + return(*status); + } + + /* delete the empty blocks at the end of the HDU */ + if (nblock > 0) + ffdblk(fptr, nblock, status); + + /* update the heap starting address */ + (fptr->Fptr)->heapstart += ndelete; /* ndelete is negative */ + + /* update the THEAP keyword if it exists */ + tstatus = 0; + ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus); + } + + /* construct the new TFORM keyword for the column */ + if (datacode == TBIT) + strcpy(tcode,"X"); + else if (datacode == TBYTE) + strcpy(tcode,"B"); + else if (datacode == TLOGICAL) + strcpy(tcode,"L"); + else if (datacode == TSTRING) + strcpy(tcode,"A"); + else if (datacode == TSHORT) + strcpy(tcode,"I"); + else if (datacode == TLONG) + strcpy(tcode,"J"); + else if (datacode == TFLOAT) + strcpy(tcode,"E"); + else if (datacode == TDOUBLE) + strcpy(tcode,"D"); + else if (datacode == TCOMPLEX) + strcpy(tcode,"C"); + else if (datacode == TDBLCOMPLEX) + strcpy(tcode,"M"); + + sprintf(tfm,"%ld%s",newveclen,tcode); /* TFORM value */ + ffkeyn("TFORM", colnum, keyname, status); /* Keyword name */ + ffmkys(fptr, keyname, tfm, "&", status); /* modify TFORM keyword */ + + ffmkyj(fptr, "NAXIS1", naxis1 + delbyte, "&", status); /* modify NAXIS1 */ + + ffrdef(fptr, status); /* reinitialize the new table structure */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpcl(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int incol, /* I - number of input column */ + int outcol, /* I - number for output column */ + int create_col, /* I - create new col if TRUE, else overwrite */ + int *status) /* IO - error status */ +/* + copy a column from infptr and insert it in the outfptr table. +*/ +{ + int tstatus, colnum, typecode, anynull; + long tfields, repeat, width, nrows, outrows; + long inloop, outloop, maxloop, ndone, ntodo, npixels; + long firstrow, firstelem, ii; + char keyname[FLEN_KEYWORD], ttype[FLEN_VALUE], tform[FLEN_VALUE]; + char ttype_comm[FLEN_COMMENT],tform_comm[FLEN_COMMENT]; + char *lvalues = 0, nullflag, **strarray = 0; + char nulstr[] = {'\5', '\0'}; /* unique null string value */ + double dnull = 0.l, *dvalues = 0; + float fnull = 0., *fvalues = 0; + + if (*status > 0) + return(*status); + + if (infptr->HDUposition != (infptr->Fptr)->curhdu) + { + ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status); + } + else if ((infptr->Fptr)->datastart == DATA_UNDEFINED) + ffrdef(infptr, status); /* rescan header */ + + if (outfptr->HDUposition != (outfptr->Fptr)->curhdu) + { + ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status); + } + else if ((outfptr->Fptr)->datastart == DATA_UNDEFINED) + ffrdef(outfptr, status); /* rescan header */ + + if (*status > 0) + return(*status); + + if ((infptr->Fptr)->hdutype == IMAGE_HDU || (outfptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg + ("Can not copy columns to or from IMAGE HDUs (ffcpcl)"); + return(*status = NOT_TABLE); + } + + if ( (infptr->Fptr)->hdutype == BINARY_TBL && (outfptr->Fptr)->hdutype == ASCII_TBL) + { + ffpmsg + ("Copying from Binary table to ASCII table is not supported (ffcpcl)"); + return(*status = NOT_BTABLE); + } + + /* get the datatype and vector repeat length of the column */ + ffgtcl(infptr, incol, &typecode, &repeat, &width, status); + + if (typecode < 0) + { + ffpmsg("Variable-length columns are not supported (ffcpcl)"); + return(*status = BAD_TFORM); + } + + if (create_col) /* insert new column in output table? */ + { + tstatus = 0; + ffkeyn("TTYPE", incol, keyname, &tstatus); + ffgkys(infptr, keyname, ttype, ttype_comm, &tstatus); + ffkeyn("TFORM", incol, keyname, &tstatus); + + if (ffgkys(infptr, keyname, tform, tform_comm, &tstatus) ) + { + ffpmsg + ("Could not find TTYPE and TFORM keywords in input table (ffcpcl)"); + return(*status = NO_TFORM); + } + + if ((infptr->Fptr)->hdutype == ASCII_TBL && (outfptr->Fptr)->hdutype == BINARY_TBL) + { + /* convert from ASCII table to BINARY table format string */ + if (typecode == TSTRING) + ffnkey(width, "A", tform, status); + + else if (typecode == TLONG) + strcpy(tform, "1J"); + + else if (typecode == TSHORT) + strcpy(tform, "1I"); + + else if (typecode == TFLOAT) + strcpy(tform,"1E"); + + else if (typecode == TDOUBLE) + strcpy(tform,"1D"); + } + + if (ffgkyj(outfptr, "TFIELDS", &tfields, 0, &tstatus)) + { + ffpmsg + ("Could not read TFIELDS keyword in output table (ffcpcl)"); + return(*status = NO_TFIELDS); + } + + colnum = minvalue((int) tfields + 1, outcol); /* output col. number */ + + /* create the empty column */ + if (fficol(outfptr, colnum, ttype, tform, status) > 0) + { + ffpmsg + ("Could not append new column to output file (ffcpcl)"); + return(*status); + } + + /* copy the comment strings from the input file for TTYPE and TFORM */ + tstatus = 0; + ffkeyn("TTYPE", colnum, keyname, &tstatus); + ffmcom(outfptr, keyname, ttype_comm, &tstatus); + ffkeyn("TFORM", colnum, keyname, &tstatus); + ffmcom(outfptr, keyname, tform_comm, &tstatus); + + /* copy other column-related keywords if they exist */ + + ffcpky(infptr, outfptr, incol, colnum, "TUNIT", status); + ffcpky(infptr, outfptr, incol, colnum, "TSCAL", status); + ffcpky(infptr, outfptr, incol, colnum, "TZERO", status); + ffcpky(infptr, outfptr, incol, colnum, "TDISP", status); + ffcpky(infptr, outfptr, incol, colnum, "TLMIN", status); + ffcpky(infptr, outfptr, incol, colnum, "TLMAX", status); + ffcpky(infptr, outfptr, incol, colnum, "TDIM", status); + + /* WCS keywords */ + ffcpky(infptr, outfptr, incol, colnum, "TCTYP", status); + ffcpky(infptr, outfptr, incol, colnum, "TCUNI", status); + ffcpky(infptr, outfptr, incol, colnum, "TCRVL", status); + ffcpky(infptr, outfptr, incol, colnum, "TCRPX", status); + ffcpky(infptr, outfptr, incol, colnum, "TCDLT", status); + ffcpky(infptr, outfptr, incol, colnum, "TCROT", status); + + if ((infptr->Fptr)->hdutype == ASCII_TBL && (outfptr->Fptr)->hdutype == BINARY_TBL) + { + /* binary tables only have TNULLn keyword for integer columns */ + if (typecode == TLONG || typecode == TSHORT) + { + /* check if null string is defined; replace with integer */ + ffkeyn("TNULL", incol, keyname, &tstatus); + if (ffgkys(infptr, keyname, ttype, 0, &tstatus) <= 0) + { + ffkeyn("TNULL", colnum, keyname, &tstatus); + if (typecode == TLONG) + ffpkyj(outfptr, keyname, -9999999L, "Null value", status); + else + ffpkyj(outfptr, keyname, -32768L, "Null value", status); + } + } + } + else + { + ffcpky(infptr, outfptr, incol, colnum, "TNULL", status); + } + + /* rescan header to recognize the new keywords */ + if (ffrdef(outfptr, status) ) + return(*status); + } + else + { + colnum = outcol; + } + + ffgkyj(infptr, "NAXIS2", &nrows, 0, status); /* no. of input rows */ + ffgkyj(outfptr, "NAXIS2", &outrows, 0, status); /* no. of output rows */ + nrows = minvalue(nrows, outrows); + + if (typecode == TBIT) + repeat = (repeat - 1) / 8 + 1; /* convert from bits to bytes */ + else if (typecode == TSTRING && (infptr->Fptr)->hdutype == BINARY_TBL) + repeat = repeat / width; /* convert from chars to unit strings */ + + /* get optimum number of rows to copy at one time */ + ffgrsz(infptr, &inloop, status); + ffgrsz(outfptr, &outloop, status); + + /* adjust optimum number, since 2 tables are open at once */ + maxloop = minvalue(inloop, outloop); /* smallest of the 2 tables */ + maxloop = maxvalue(1, maxloop / 2); /* at least 1 row */ + maxloop = minvalue(maxloop, nrows); /* max = nrows to be copied */ + maxloop *= repeat; /* mult by no of elements in a row */ + + /* allocate memory for arrays */ + if (typecode == TLOGICAL) + { + lvalues = (char *) calloc(maxloop, sizeof(char) ); + if (!lvalues) + { + ffpmsg + ("malloc failed to get memory for logicals (ffcpcl)"); + return(*status = ARRAY_TOO_BIG); + } + } + else if (typecode == TSTRING) + { + /* allocate array of pointers */ + strarray = (char **) calloc(maxloop, sizeof(strarray)); + + /* allocate space for each string */ + for (ii = 0; ii < maxloop; ii++) + strarray[ii] = (char *) calloc(width+1, sizeof(char)); + } + else if (typecode == TCOMPLEX) + { + fvalues = (float *) calloc(maxloop * 2, sizeof(float) ); + if (!fvalues) + { + ffpmsg + ("malloc failed to get memory for complex (ffcpcl)"); + return(*status = ARRAY_TOO_BIG); + } + fnull = 0.; + } + else if (typecode == TDBLCOMPLEX) + { + dvalues = (double *) calloc(maxloop * 2, sizeof(double) ); + if (!dvalues) + { + ffpmsg + ("malloc failed to get memory for dbl complex (ffcpcl)"); + return(*status = ARRAY_TOO_BIG); + } + dnull = 0.; + } + else /* numerical datatype; read them all as doubles */ + { + dvalues = (double *) calloc(maxloop, sizeof(double) ); + if (!dvalues) + { + ffpmsg + ("malloc failed to get memory for doubles (ffcpcl)"); + return(*status = ARRAY_TOO_BIG); + } + dnull = -9.99991999E31; /* use an unlikely value for nulls */ + } + + npixels = nrows * repeat; /* total no. of pixels to copy */ + ntodo = minvalue(npixels, maxloop); /* no. to copy per iteration */ + ndone = 0; /* total no. of pixels that have been copied */ + + while (ntodo) /* iterate through the table */ + { + firstrow = ndone / repeat + 1; + firstelem = ndone - ((firstrow - 1) * repeat) + 1; + + /* read from input table */ + if (typecode == TLOGICAL) + ffgcl(infptr, incol, firstrow, firstelem, ntodo, + lvalues, status); + else if (typecode == TSTRING) + ffgcvs(infptr, incol, firstrow, firstelem, ntodo, + nulstr, strarray, &anynull, status); + + else if (typecode == TCOMPLEX) + ffgcvc(infptr, incol, firstrow, firstelem, ntodo, fnull, + fvalues, &anynull, status); + + else if (typecode == TDBLCOMPLEX) + ffgcvm(infptr, incol, firstrow, firstelem, ntodo, dnull, + dvalues, &anynull, status); + + else /* all numerical types */ + ffgcvd(infptr, incol, firstrow, firstelem, ntodo, dnull, + dvalues, &anynull, status); + + if (*status > 0) + { + ffpmsg("Error reading input copy of column (ffcpcl)"); + break; + } + + /* write to output table */ + if (typecode == TLOGICAL) + { + nullflag = 2; + ffpcnl(outfptr, colnum, firstrow, firstelem, ntodo, + lvalues, nullflag, status); + } + + else if (typecode == TSTRING) + { + if (anynull) + ffpcns(outfptr, colnum, firstrow, firstelem, ntodo, + strarray, nulstr, status); + else + ffpcls(outfptr, colnum, firstrow, firstelem, ntodo, + strarray, status); + } + + else if (typecode == TCOMPLEX) + { /* doesn't support writing nulls */ + ffpclc(outfptr, colnum, firstrow, firstelem, ntodo, + fvalues, status); + } + + else if (typecode == TDBLCOMPLEX) + { /* doesn't support writing nulls */ + ffpclm(outfptr, colnum, firstrow, firstelem, ntodo, + dvalues, status); + } + + else /* all other numerical types */ + { + if (anynull) + ffpcnd(outfptr, colnum, firstrow, firstelem, ntodo, + dvalues, dnull, status); + else + ffpcld(outfptr, colnum, firstrow, firstelem, ntodo, + dvalues, status); + } + + if (*status > 0) + { + ffpmsg("Error writing output copy of column (ffcpcl)"); + break; + } + + npixels -= ntodo; + ndone += ntodo; + ntodo = minvalue(npixels, maxloop); + } + + /* free the previously allocated memory */ + if (typecode == TLOGICAL) + { + free(lvalues); + } + else if (typecode == TSTRING) + { + for (ii = 0; ii < maxloop; ii++) + free(strarray[ii]); + + free(strarray); + } + else + { + free(dvalues); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpky(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int incol, /* I - input index number */ + int outcol, /* I - output index number */ + char *rootname, /* I - root name of the keyword to be copied */ + int *status) /* IO - error status */ +/* + copy an indexed keyword from infptr to outfptr. +*/ +{ + int tstatus = 0; + char keyname[FLEN_KEYWORD]; + char value[FLEN_VALUE], comment[FLEN_COMMENT], card[FLEN_CARD]; + + ffkeyn(rootname, incol, keyname, &tstatus); + if (ffgkey(infptr, keyname, value, comment, &tstatus) <= 0) + { + ffkeyn(rootname, outcol, keyname, &tstatus); + ffmkky(keyname, value, comment, card, status); + ffprec(outfptr, card, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdcol(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column to delete (1 = 1st) */ + int *status) /* IO - error status */ +/* + Delete a column from a table. +*/ +{ + int ii, tstatus; + OFF_T firstbyte, size, ndelete, nbytes; + long delbyte, nspace, naxis1, naxis2, firstcol; + long freespace, nblock, tbcol; + char keyname[FLEN_KEYWORD], comm[FLEN_COMMENT]; + tcolumn *colptr, *nextcol; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffpmsg + ("Can only delete column from TABLE or BINTABLE extension (ffdcol)"); + return(*status = NOT_TABLE); + } + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield ) + return(*status = BAD_COL_NUM); + + colptr = (fptr->Fptr)->tableptr; + colptr += (colnum - 1); + firstcol = colptr->tbcol; /* starting byte position of the column */ + + /* use column width to determine how many bytes to delete in each row */ + if ((fptr->Fptr)->hdutype == ASCII_TBL) + { + delbyte = colptr->twidth; /* width of ASCII column */ + + if (colnum < (fptr->Fptr)->tfield) /* check for space between next column */ + { + nextcol = colptr + 1; + nspace = (nextcol->tbcol) - (colptr->tbcol) - delbyte; + if (nspace > 0) + delbyte++; + } + else if (colnum > 1) /* check for space between last 2 columns */ + { + nextcol = colptr - 1; + nspace = (colptr->tbcol) - (nextcol->tbcol) - (nextcol->twidth); + if (nspace > 0) + { + delbyte++; + firstcol--; /* delete the leading space */ + } + } + } + else /* a binary table */ + { + if (colnum < (fptr->Fptr)->tfield) + { + nextcol = colptr + 1; + delbyte = (nextcol->tbcol) - (colptr->tbcol); + } + else + { + delbyte = ((fptr->Fptr)->rowlength) - (colptr->tbcol); + } + } + + naxis1 = (long) (fptr->Fptr)->rowlength; /* current width of the table */ + naxis2 = (fptr->Fptr)->numrows; + + /* current size of table */ + size = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize; + freespace = ((OFF_T)delbyte * naxis2) + ((size + 2879) / 2880) * 2880 - size; + nblock = freespace / 2880; /* number of empty blocks to delete */ + + ffcdel(fptr, naxis1, naxis2, delbyte, firstcol, status); /* delete col */ + + /* absolute heap position */ + firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart; + ndelete = (OFF_T)delbyte * naxis2; /* size of shift */ + + /* shift heap up (if it exists) */ + if ((fptr->Fptr)->heapsize > 0) + { + nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift up */ + + if (ffshft(fptr, firstbyte, nbytes, -ndelete, status) > 0) /* mv heap */ + return(*status); + } + + /* delete the empty blocks at the end of the HDU */ + if (nblock > 0) + ffdblk(fptr, nblock, status); + + /* update the heap starting address */ + (fptr->Fptr)->heapstart -= ndelete; + + /* update the THEAP keyword if it exists */ + tstatus = 0; + ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus); + + if ((fptr->Fptr)->hdutype == ASCII_TBL) + { + /* adjust the TBCOL values of the remaining columns */ + for (ii = 1; ii <= (fptr->Fptr)->tfield; ii++) + { + ffkeyn("TBCOL", ii, keyname, status); + ffgkyj(fptr, keyname, &tbcol, comm, status); + if (tbcol > firstcol) + { + tbcol = tbcol - delbyte; + ffmkyj(fptr, keyname, tbcol, "&", status); + } + } + } + + /* update the mandatory keywords */ + ffmkyj(fptr, "TFIELDS", ((fptr->Fptr)->tfield) - 1, "&", status); + ffmkyj(fptr, "NAXIS1", naxis1 - delbyte, "&", status); + /* + delete the index keywords starting with 'T' associated with the + deleted column and subtract 1 from index of all higher keywords + */ + ffkshf(fptr, colnum, (fptr->Fptr)->tfield, -1, status); + + ffrdef(fptr, status); /* initialize the new table structure */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcins(fitsfile *fptr, /* I - FITS file pointer */ + long naxis1, /* I - width of the table, in bytes */ + long naxis2, /* I - number of rows in the table */ + long ninsert, /* I - number of bytes to insert in each row */ + long bytepos, /* I - rel. position in row to insert bytes */ + int *status) /* IO - error status */ +/* + Insert 'ninsert' bytes into each row of the table at position 'bytepos'. +*/ +{ + unsigned char buffer[10000], cfill; + long newlen, fbyte, nbytes, ii, irow, nseg; + + if (*status > 0) + return(*status); + + if (naxis2 == 0) + return(*status); /* just return if there are 0 rows in the table */ + + /* select appropriate fill value */ + if ((fptr->Fptr)->hdutype == ASCII_TBL) + cfill = 32; /* ASCII tables use blank fill */ + else + cfill = 0; /* primary array and binary tables use zero fill */ + + newlen = naxis1 + ninsert; + + if (newlen <= 10000) + { + /******************************************************************* + CASE #1: optimal case where whole new row fits in the work buffer + *******************************************************************/ + + for (ii = 0; ii < ninsert; ii++) + buffer[ii] = cfill; /* initialize buffer with fill value */ + + /* first move the trailing bytes (if any) in the last row */ + fbyte = bytepos + 1; + nbytes = naxis1 - bytepos; + ffgtbb(fptr, naxis2, fbyte, nbytes, &buffer[ninsert], status); + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + /* write the row (with leading fill bytes) in the new place */ + nbytes += ninsert; + ffptbb(fptr, naxis2, fbyte, nbytes, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig. value */ + + /* now move the rest of the rows */ + for (irow = naxis2 - 1; irow > 0; irow--) + { + /* read the row to be shifted (work backwards thru the table) */ + ffgtbb(fptr, irow, fbyte, naxis1, &buffer[ninsert], status); + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + /* write the row (with the leading fill bytes) in the new place */ + ffptbb(fptr, irow, fbyte, newlen, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + } + } + else + { + /***************************************************************** + CASE #2: whole row doesn't fit in work buffer; move row in pieces + ****************************************************************** + first copy the data, then go back and write fill into the new column + start by copying the trailing bytes (if any) in the last row. */ + + nbytes = naxis1 - bytepos; + nseg = (nbytes + 9999) / 10000; + fbyte = (nseg - 1) * 10000 + bytepos + 1; + nbytes = naxis1 - fbyte + 1; + + for (ii = 0; ii < nseg; ii++) + { + ffgtbb(fptr, naxis2, fbyte, nbytes, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + ffptbb(fptr, naxis2, fbyte + ninsert, nbytes, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + + fbyte -= 10000; + nbytes = 10000; + } + + /* now move the rest of the rows */ + nseg = (naxis1 + 9999) / 10000; + for (irow = naxis2 - 1; irow > 0; irow--) + { + fbyte = (nseg - 1) * 10000 + bytepos + 1; + nbytes = naxis1 - (nseg - 1) * 10000; + for (ii = 0; ii < nseg; ii++) + { + /* read the row to be shifted (work backwards thru the table) */ + ffgtbb(fptr, irow, fbyte, nbytes, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + /* write the row in the new place */ + ffptbb(fptr, irow, fbyte + ninsert, nbytes, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + + fbyte -= 10000; + nbytes = 10000; + } + } + + /* now write the fill values into the new column */ + nbytes = minvalue(ninsert, 10000); + memset(buffer, cfill, nbytes); /* initialize with fill value */ + + nseg = (ninsert + 9999) / 10000; + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + for (irow = 1; irow <= naxis2; irow++) + { + fbyte = bytepos + 1; + nbytes = ninsert - ((nseg - 1) * 10000); + for (ii = 0; ii < nseg; ii++) + { + ffptbb(fptr, irow, fbyte, nbytes, buffer, status); + fbyte += nbytes; + nbytes = 10000; + } + } + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcdel(fitsfile *fptr, /* I - FITS file pointer */ + long naxis1, /* I - width of the table, in bytes */ + long naxis2, /* I - number of rows in the table */ + long ndelete, /* I - number of bytes to delete in each row */ + long bytepos, /* I - rel. position in row to delete bytes */ + int *status) /* IO - error status */ +/* + delete 'ndelete' bytes from each row of the table at position 'bytepos'. +*/ +{ + unsigned char buffer[10000]; + long newlen, i1, i2, ii, remain, nbytes, irow, nseg; + + if (*status > 0) + return(*status); + + if (naxis2 == 0) + return(*status); /* just return if there are 0 rows in the table */ + + newlen = naxis1 - ndelete; + + if (newlen <= 10000) + { + /******************************************************************* + CASE #1: optimal case where whole new row fits in the work buffer + *******************************************************************/ + i1 = bytepos + 1; + i2 = i1 + ndelete; + for (irow = 1; irow < naxis2; irow++) + { + ffgtbb(fptr, irow, i2, newlen, buffer, status); /* read row */ + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + ffptbb(fptr, irow, i1, newlen, buffer, status); /* write row */ + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + } + + /* now do the last row */ + remain = naxis1 - (bytepos + ndelete); + + if (remain > 0) + { + ffgtbb(fptr, naxis2, i2, remain, buffer, status); /* read row */ + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + ffptbb(fptr, naxis2, i1, remain, buffer, status); /* write row */ + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + } + } + else + { + /***************************************************************** + CASE #2: whole row doesn't fit in work buffer; move row in pieces + ******************************************************************/ + + nseg = (newlen + 9999) / 10000; + for (irow = 1; irow < naxis2; irow++) + { + i1 = bytepos + 1; + i2 = i1 + ndelete; + + nbytes = newlen - (nseg - 1) * 10000; + for (ii = 0; ii < nseg; ii++) + { + ffgtbb(fptr, irow, i2, nbytes, buffer, status); /* read bytes */ + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + ffptbb(fptr, irow, i1, nbytes, buffer, status); /* rewrite bytes */ + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + + i1 += nbytes; + i2 += nbytes; + nbytes = 10000; + } + } + + /* now do the last row */ + remain = naxis1 - (bytepos + ndelete); + + if (remain > 0) + { + nseg = (remain + 9999) / 10000; + i1 = bytepos + 1; + i2 = i1 + ndelete; + nbytes = remain - (nseg - 1) * 10000; + for (ii = 0; ii < nseg; ii++) + { + ffgtbb(fptr, naxis2, i2, nbytes, buffer, status); + (fptr->Fptr)->rowlength = (OFF_T) newlen; /* new row length */ + + ffptbb(fptr, naxis2, i1, nbytes, buffer, status); /* write row */ + (fptr->Fptr)->rowlength = (OFF_T) naxis1; /* reset to orig value */ + + i1 += nbytes; + i2 += nbytes; + nbytes = 10000; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffkshf(fitsfile *fptr, /* I - FITS file pointer */ + int colmin, /* I - starting col. to be incremented; 1 = 1st */ + int colmax, /* I - last column to be incremented */ + int incre, /* I - shift index number by this amount */ + int *status) /* IO - error status */ +/* + shift the index value on any existing column keywords + This routine will modify the name of any keyword that begins with 'T' + and has an index number in the range COLMIN - COLMAX, inclusive. + + if incre is positive, then the index values will be incremented. + if incre is negative, then the kewords with index = COLMIN + will be deleted and the index of higher numbered keywords will + be decremented. +*/ +{ + int nkeys, nmore, nrec, tstatus, i1; + long ivalue; + char rec[FLEN_CARD], q[FLEN_KEYWORD], newkey[FLEN_KEYWORD]; + + ffghsp(fptr, &nkeys, &nmore, status); /* get number of keywords */ + + /* go thru header starting with the 9th keyword looking for 'TxxxxNNN' */ + + for (nrec = 9; nrec <= nkeys; nrec++) + { + ffgrec(fptr, nrec, rec, status); + + if (rec[0] == 'T') + { + i1 = 0; + strncpy(q, &rec[1], 4); + if (!strncmp(q, "BCOL", 4) || !strncmp(q, "FORM", 4) || + !strncmp(q, "TYPE", 4) || !strncmp(q, "SCAL", 4) || + !strncmp(q, "UNIT", 4) || !strncmp(q, "NULL", 4) || + !strncmp(q, "ZERO", 4) || !strncmp(q, "DISP", 4) || + !strncmp(q, "LMIN", 4) || !strncmp(q, "LMAX", 4) || + !strncmp(q, "DMIN", 4) || !strncmp(q, "DMAX", 4) || + !strncmp(q, "CTYP", 4) || !strncmp(q, "CRPX", 4) || + !strncmp(q, "CRVL", 4) || !strncmp(q, "CDLT", 4) || + !strncmp(q, "CROT", 4) || !strncmp(q, "CUNI", 4) ) + i1 = 5; + else if (!strncmp(rec, "TDIM", 4) ) + i1 = 4; + + if (i1) + { + /* try reading the index number suffix */ + q[0] = '\0'; + strncat(q, &rec[i1], 8 - i1); + + tstatus = 0; + ffc2ii(q, &ivalue, &tstatus); + + if (tstatus == 0 && ivalue >= colmin && ivalue <= colmax) + { + if (incre <= 0 && ivalue == colmin) + { + ffdrec(fptr, nrec, status); /* delete keyword */ + nkeys = nkeys - 1; + nrec = nrec - 1; + } + else + { + ivalue = ivalue + incre; + q[0] = '\0'; + strncat(q, rec, i1); + + ffkeyn(q, ivalue, newkey, status); + strncpy(rec, " ", 8); /* erase old keyword name */ + i1 = strlen(newkey); + strncpy(rec, newkey, i1); /* overwrite new keyword name */ + ffmrec(fptr, nrec, rec, status); /* modify the record */ + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffshft(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T firstbyte, /* I - position of first byte in block to shift */ + OFF_T nbytes, /* I - size of block of bytes to shift */ + OFF_T nshift, /* I - size of shift in bytes (+ or -) */ + int *status) /* IO - error status */ +/* + Shift block of bytes by nshift bytes (positive or negative). + A positive nshift value moves the block down further in the file, while a + negative value shifts the block towards the beginning of the file. +*/ +{ +#define shftbuffsize 100000 + long ntomov; + OFF_T ptr, ntodo; + char buffer[shftbuffsize]; + + if (*status > 0) + return(*status); + + ntodo = nbytes; /* total number of bytes to shift */ + + if (nshift > 0) + /* start at the end of the block and work backwards */ + ptr = firstbyte + nbytes; + else + /* start at the beginning of the block working forwards */ + ptr = firstbyte; + + while (ntodo) + { + /* number of bytes to move at one time */ + ntomov = minvalue(ntodo, shftbuffsize); + + if (nshift > 0) /* if moving block down ... */ + ptr -= ntomov; + + /* move to position and read the bytes to be moved */ + ffmbyt(fptr, ptr, REPORT_EOF, status); + ffgbyt(fptr, ntomov, buffer, status); + + /* move by shift amount and write the bytes */ + ffmbyt(fptr, ptr + nshift, IGNORE_EOF, status); + if (ffpbyt(fptr, ntomov, buffer, status) > 0) + { + ffpmsg("Error while shifting block (ffshft)"); + return(*status); + } + + ntodo -= ntomov; + if (nshift < 0) /* if moving block up ... */ + ptr += ntomov; + } + + /* now overwrite the old data with fill */ + if ((fptr->Fptr)->hdutype == ASCII_TBL) + memset(buffer, 32, shftbuffsize); /* fill ASCII tables with spaces */ + else + memset(buffer, 0, shftbuffsize); /* fill other HDUs with zeros */ + + + if (nshift < 0) + { + ntodo = -nshift; + /* point to the end of the shifted block */ + ptr = firstbyte + nbytes + nshift; + } + else + { + ntodo = nshift; + /* point to original beginning of the block */ + ptr = firstbyte; + } + + ffmbyt(fptr, ptr, REPORT_EOF, status); + + while (ntodo) + { + ntomov = minvalue(ntodo, shftbuffsize); + ffpbyt(fptr, ntomov, buffer, status); + ntodo -= ntomov; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/edithdu.c b/pkg/tbtables/cfitsio/edithdu.c new file mode 100644 index 00000000..5baac075 --- /dev/null +++ b/pkg/tbtables/cfitsio/edithdu.c @@ -0,0 +1,793 @@ +/* This file, edithdu.c, contains the FITSIO routines related to */ +/* copying, inserting, or deleting HDUs in a FITS file */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffcopy(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int morekeys, /* I - reserve space in output header */ + int *status) /* IO - error status */ +/* + copy the CHDU from infptr to the CHDU of outfptr. + This will also allocate space in the output header for MOREKY keywords +*/ +{ + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + if (ffcphd(infptr, outfptr, status) ) /* copy the header keywords */ + return(*status); + + if (morekeys > 0) + ffhdef(outfptr, morekeys, status); /* reserve space for more keywords */ + + ffcpdt(infptr, outfptr, status); /* now copy the data unit */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpfl(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int previous, /* I - copy any previous HDUs? */ + int current, /* I - copy the current HDU? */ + int following, /* I - copy any following HDUs? */ + int *status) /* IO - error status */ +/* + copy all or part of the input file to the output file. +*/ +{ + int hdunum, ii; + + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + ffghdn(infptr, &hdunum); + + if (previous) { /* copy any previous HDUs */ + for (ii=1; ii < hdunum; ii++) { + ffmahd(infptr, ii, NULL, status); + ffcopy(infptr, outfptr, 0, status); + } + } + + if (current && (*status <= 0) ) { /* copy current HDU */ + ffmahd(infptr, hdunum, NULL, status); + ffcopy(infptr, outfptr, 0, status); + } + + if (following && (*status <= 0) ) { /* copy any remaining HDUs */ + ii = hdunum + 1; + while (1) + { + if (ffmahd(infptr, ii, NULL, status) ) { + /* reset expected end of file status */ + if (*status == END_OF_FILE) + *status = 0; + break; + } + + if (ffcopy(infptr, outfptr, 0, status)) + break; /* quit on unexpected error */ + + ii++; + } + } + + ffmahd(infptr, hdunum, NULL, status); /* restore initial position */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcphd(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int *status) /* IO - error status */ +/* + copy the header keywords from infptr to outfptr. +*/ +{ + int nkeys, ii, inPrim = 0, outPrim = 0; + long naxis, naxes[1]; + char *card, comm[FLEN_COMMENT]; + char *tmpbuff = NULL; + + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + /* set the input pointer to the correct HDU */ + if (infptr->HDUposition != (infptr->Fptr)->curhdu) + ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status); + + if (ffghsp(infptr, &nkeys, NULL, status) > 0) /* get no. of keywords */ + return(*status); + + /* create a memory buffer to hold the header records */ + tmpbuff = (char*) malloc(nkeys*FLEN_CARD*sizeof(char)); + if (!tmpbuff) + return(*status = MEMORY_ALLOCATION); + + /* read all of the header records in the input HDU */ + for (ii = 0; ii < nkeys; ii++) + ffgrec(infptr, ii+1, tmpbuff + (ii * FLEN_CARD), status); + + if (infptr->HDUposition == 0) /* set flag if this is the Primary HDU */ + inPrim = 1; + + /* if input is an image hdu, get the number of axes */ + naxis = -1; /* negative if HDU is a table */ + if ((infptr->Fptr)->hdutype == IMAGE_HDU) + ffgkyj(infptr, "NAXIS", &naxis, NULL, status); + + /* set the output pointer to the correct HDU */ + if (outfptr->HDUposition != (outfptr->Fptr)->curhdu) + ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status); + + /* check if output header is empty; if not create new empty HDU */ + if ((outfptr->Fptr)->headend != + (outfptr->Fptr)->headstart[(outfptr->Fptr)->curhdu] ) + ffcrhd(outfptr, status); + + if (outfptr->HDUposition == 0) + { + if (naxis < 0) + { + /* the input HDU is a table, so we have to create */ + /* a dummy Primary array before copying it to the output */ + ffcrim(outfptr, 8, 0, naxes, status); + ffcrhd(outfptr, status); /* create new empty HDU */ + } + else + { + /* set flag that this is the Primary HDU */ + outPrim = 1; + } + } + + if (*status > 0) /* check for errors before proceeding */ + { + free(tmpbuff); + return(*status); + } + if ( inPrim == 1 && outPrim == 0 ) + { + /* copying from primary array to image extension */ + strcpy(comm, "IMAGE extension"); + ffpkys(outfptr, "XTENSION", "IMAGE", comm, status); + + /* copy BITPIX through NAXISn keywords */ + for (ii = 1; ii < 3 + naxis; ii++) + { + card = tmpbuff + (ii * FLEN_CARD); + ffprec(outfptr, card, status); + } + + strcpy(comm, "number of random group parameters"); + ffpkyj(outfptr, "PCOUNT", 0, comm, status); + + strcpy(comm, "number of random groups"); + ffpkyj(outfptr, "GCOUNT", 1, comm, status); + + + /* copy remaining keywords, excluding EXTEND, and reference COMMENT keywords */ + for (ii = 3 + naxis ; ii < nkeys; ii++) + { + card = tmpbuff+(ii * FLEN_CARD); + if (FSTRNCMP(card, "EXTEND ", 8) && + FSTRNCMP(card, "COMMENT FITS (Flexible Image Transport System) format is", 58) && + FSTRNCMP(card, "COMMENT and Astrophysics', volume 376, page 3", 47) ) + { + ffprec(outfptr, card, status); + } + } + } + else if ( inPrim == 0 && outPrim == 1 ) + { + /* copying between image extension and primary array */ + strcpy(comm, "file does conform to FITS standard"); + ffpkyl(outfptr, "SIMPLE", TRUE, comm, status); + + /* copy BITPIX through NAXISn keywords */ + for (ii = 1; ii < 3 + naxis; ii++) + { + card = tmpbuff + (ii * FLEN_CARD); + ffprec(outfptr, card, status); + } + + /* add the EXTEND keyword */ + strcpy(comm, "FITS dataset may contain extensions"); + ffpkyl(outfptr, "EXTEND", TRUE, comm, status); + + /* write standard block of self-documentating comments */ + ffprec(outfptr, + "COMMENT FITS (Flexible Image Transport System) format is defined in 'Astronomy", + status); + ffprec(outfptr, + "COMMENT and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H", + status); + + /* copy remaining keywords, excluding pcount, gcount */ + for (ii = 3 + naxis; ii < nkeys; ii++) + { + card = tmpbuff+(ii * FLEN_CARD); + if (FSTRNCMP(card, "PCOUNT ", 8) && FSTRNCMP(card, "GCOUNT ", 8)) + { + ffprec(outfptr, card, status); + } + } + } + else + { + /* input and output HDUs are same type; simply copy all keywords */ + for (ii = 0; ii < nkeys; ii++) + { + card = tmpbuff+(ii * FLEN_CARD); + ffprec(outfptr, card, status); + } + } + + free(tmpbuff); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpdt(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int *status) /* IO - error status */ +{ +/* + copy the data unit from the CHDU of infptr to the CHDU of outfptr. + This will overwrite any data already in the outfptr CHDU. +*/ + long nb, ii; + OFF_T indatastart, indataend, outdatastart; + char buffer[2880]; + + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + ffghof(infptr, NULL, &indatastart, &indataend, status); + ffghof(outfptr, NULL, &outdatastart, NULL, status); + + /* Calculate the number of blocks to be copied */ + nb = (indataend - indatastart) / 2880; + + if (nb > 0) + { + if (infptr->Fptr == outfptr->Fptr) + { + /* copying between 2 HDUs in the SAME file */ + for (ii = 0; ii < nb; ii++) + { + ffmbyt(infptr, indatastart, REPORT_EOF, status); + ffgbyt(infptr, 2880L, buffer, status); /* read input block */ + + ffmbyt(outfptr, outdatastart, IGNORE_EOF, status); + ffpbyt(outfptr, 2880L, buffer, status); /* write output block */ + + indatastart += 2880; /* move address */ + outdatastart += 2880; /* move address */ + } + } + else + { + /* copying between HDUs in separate files */ + /* move to the initial copy position in each of the files */ + ffmbyt(infptr, indatastart, REPORT_EOF, status); + ffmbyt(outfptr, outdatastart, IGNORE_EOF, status); + + for (ii = 0; ii < nb; ii++) + { + ffgbyt(infptr, 2880L, buffer, status); /* read input block */ + ffpbyt(outfptr, 2880L, buffer, status); /* write output block */ + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffiimg(fitsfile *fptr, /* I - FITS file pointer */ + int bitpix, /* I - bits per pixel */ + int naxis, /* I - number of axes in the array */ + long *naxes, /* I - size of each axis */ + int *status) /* IO - error status */ +/* + insert an IMAGE extension following the current HDU +*/ +{ + int bytlen, nexthdu, maxhdu, ii, onaxis; + long nblocks; + OFF_T npixels, newstart, datasize; + char errmsg[FLEN_ERRMSG], card[FLEN_CARD], naxiskey[FLEN_KEYWORD]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + maxhdu = (fptr->Fptr)->maxhdu; + + if (*status != PREPEND_PRIMARY) + { + /* if the current header is completely empty ... */ + if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) + /* or, if we are at the end of the file, ... */ + || ( (((fptr->Fptr)->curhdu) == maxhdu ) && + ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) ) + { + /* then simply append new image extension */ + ffcrim(fptr, bitpix, naxis, naxes, status); + return(*status); + } + } + + if (bitpix == 8) + bytlen = 1; + else if (bitpix == 16) + bytlen = 2; + else if (bitpix == 32 || bitpix == -32) + bytlen = 4; + else if (bitpix == -64) + bytlen = 8; + else + { + sprintf(errmsg, + "Illegal value for BITPIX keyword: %d", bitpix); + ffpmsg(errmsg); + return(*status = BAD_BITPIX); /* illegal bitpix value */ + } + if (naxis < 0 || naxis > 999) + { + sprintf(errmsg, + "Illegal value for NAXIS keyword: %d", naxis); + ffpmsg(errmsg); + return(*status = BAD_NAXIS); + } + + for (ii = 0; ii < naxis; ii++) + { + if (naxes[ii] < 0) + { + sprintf(errmsg, + "Illegal value for NAXIS%d keyword: %ld", ii + 1, naxes[ii]); + ffpmsg(errmsg); + return(*status = BAD_NAXES); + } + } + + /* calculate number of pixels in the image */ + if (naxis == 0) + npixels = 0; + else + npixels = naxes[0]; + + for (ii = 1; ii < naxis; ii++) + npixels = npixels * naxes[ii]; + + datasize = npixels * bytlen; /* size of image in bytes */ + nblocks = ((datasize + 2879) / 2880) + 1; /* +1 for the header */ + + if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */ + { /* close the CHDU */ + ffrdef(fptr, status); /* scan header to redefine structure */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + else + return(*status = READONLY_FILE); + + if (*status == PREPEND_PRIMARY) + { + /* inserting a new primary array; the current primary */ + /* array must be transformed into an image extension. */ + + *status = 0; + ffmahd(fptr, 1, NULL, status); /* move to the primary array */ + + ffgidm(fptr, &onaxis, status); + if (onaxis > 0) + ffkeyn("NAXIS",onaxis, naxiskey, status); + else + strcpy(naxiskey, "NAXIS"); + + ffgcrd(fptr, naxiskey, card, status); /* read last NAXIS keyword */ + + ffikyj(fptr, "PCOUNT", 0L, "required keyword", status); /* add PCOUNT and */ + ffikyj(fptr, "GCOUNT", 1L, "required keyword", status); /* GCOUNT keywords */ + + if (*status > 0) + return(*status); + + if (ffdkey(fptr, "EXTEND", status) ) /* delete the EXTEND keyword */ + *status = 0; + + /* redefine internal structure for this HDU */ + ffrdef(fptr, status); + + + /* insert space for the primary array */ + if (ffiblk(fptr, nblocks, -1, status) > 0) /* insert the blocks */ + return(*status); + + nexthdu = 0; /* number of the new hdu */ + newstart = 0; /* starting addr of HDU */ + } + else + { + nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */ + newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */ + + (fptr->Fptr)->hdutype = IMAGE_HDU; /* so that correct fill value is used */ + /* ffiblk also increments headstart for all following HDUs */ + if (ffiblk(fptr, nblocks, 1, status) > 0) /* insert the blocks */ + return(*status); + } + + ((fptr->Fptr)->maxhdu)++; /* increment known number of HDUs in the file */ + for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--) + (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */ + + if (nexthdu == 0) + (fptr->Fptr)->headstart[1] = nblocks * 2880; /* start of the old Primary array */ + + (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */ + + /* set default parameters for this new empty HDU */ + (fptr->Fptr)->curhdu = nexthdu; /* we are now located at the next HDU */ + fptr->HDUposition = nexthdu; /* we are now located at the next HDU */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + 2880; + (fptr->Fptr)->hdutype = IMAGE_HDU; /* might need to be reset... */ + + /* write the required header keywords */ + ffphpr(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status); + + /* redefine internal structure for this HDU */ + ffrdef(fptr, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffitab(fitsfile *fptr, /* I - FITS file pointer */ + long naxis1, /* I - width of row in the table */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + long *tbcol, /* I - byte offset in row to each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + int *status) /* IO - error status */ +/* + insert an ASCII table extension following the current HDU +*/ +{ + int nexthdu, maxhdu, ii, nunit, nhead, ncols, gotmem = 0; + long nblocks, rowlen; + OFF_T datasize, newstart; + char errmsg[81]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + maxhdu = (fptr->Fptr)->maxhdu; + /* if the current header is completely empty ... */ + if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + /* or, if we are at the end of the file, ... */ + || ( (((fptr->Fptr)->curhdu) == maxhdu ) && + ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) ) + { + /* then simply append new image extension */ + ffcrtb(fptr, ASCII_TBL, naxis2, tfields, ttype, tform, tunit, + extnm, status); + return(*status); + } + + if (naxis1 < 0) + return(*status = NEG_WIDTH); + else if (naxis2 < 0) + return(*status = NEG_ROWS); + else if (tfields < 0 || tfields > 999) + { + sprintf(errmsg, + "Illegal value for TFIELDS keyword: %d", tfields); + ffpmsg(errmsg); + return(*status = BAD_TFIELDS); + } + + /* count number of optional TUNIT keywords to be written */ + nunit = 0; + for (ii = 0; ii < tfields; ii++) + { + if (tunit && *tunit && *tunit[ii]) + nunit++; + } + + if (extnm && *extnm) + nunit++; /* add one for the EXTNAME keyword */ + + rowlen = naxis1; + + if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */ + { + /* allocate mem for tbcol; malloc may have problems allocating small */ + /* arrays, so allocate at least 20 bytes */ + + ncols = maxvalue(5, tfields); + tbcol = (long *) calloc(ncols, sizeof(long)); + + if (tbcol) + { + gotmem = 1; + + /* calculate width of a row and starting position of each column. */ + /* Each column will be separated by 1 blank space */ + ffgabc(tfields, tform, 1, &rowlen, tbcol, status); + } + } + + nhead = (9 + (3 * tfields) + nunit + 35) / 36; /* no. of header blocks */ + datasize = (OFF_T)rowlen * naxis2; /* size of table in bytes */ + nblocks = ((datasize + 2879) / 2880) + nhead; /* size of HDU */ + + if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */ + { /* close the CHDU */ + ffrdef(fptr, status); /* scan header to redefine structure */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + else + return(*status = READONLY_FILE); + + nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */ + newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */ + + (fptr->Fptr)->hdutype = ASCII_TBL; /* so that correct fill value is used */ + /* ffiblk also increments headstart for all following HDUs */ + if (ffiblk(fptr, nblocks, 1, status) > 0) /* insert the blocks */ + { + if (gotmem) + free(tbcol); + return(*status); + } + + ((fptr->Fptr)->maxhdu)++; /* increment known number of HDUs in the file */ + for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--) + (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */ + + (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */ + + /* set default parameters for this new empty HDU */ + (fptr->Fptr)->curhdu = nexthdu; /* we are now located at the next HDU */ + fptr->HDUposition = nexthdu; /* we are now located at the next HDU */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + (nhead * 2880); + (fptr->Fptr)->hdutype = ASCII_TBL; /* might need to be reset... */ + + /* write the required header keywords */ + + ffphtb(fptr, rowlen, naxis2, tfields, ttype, tbcol, tform, tunit, + extnm, status); + + if (gotmem) + free(tbcol); + + /* redefine internal structure for this HDU */ + + ffrdef(fptr, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffibin(fitsfile *fptr, /* I - FITS file pointer */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + long pcount, /* I - size of special data area (heap) */ + int *status) /* IO - error status */ +/* + insert a Binary table extension following the current HDU +*/ +{ + int nexthdu, maxhdu, ii, nunit, nhead, datacode; + long naxis1, nblocks, repeat, width; + OFF_T datasize, newstart; + char errmsg[81]; + + if (*status > 0) + return(*status); + + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + maxhdu = (fptr->Fptr)->maxhdu; + /* if the current header is completely empty ... */ + if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + /* or, if we are at the end of the file, ... */ + || ( (((fptr->Fptr)->curhdu) == maxhdu ) && + ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) ) + { + /* then simply append new image extension */ + ffcrtb(fptr, BINARY_TBL, naxis2, tfields, ttype, tform, tunit, + extnm, status); + return(*status); + } + + if (naxis2 < 0) + return(*status = NEG_ROWS); + else if (tfields < 0 || tfields > 999) + { + sprintf(errmsg, + "Illegal value for TFIELDS keyword: %d", tfields); + ffpmsg(errmsg); + return(*status = BAD_TFIELDS); + } + + /* count number of optional TUNIT keywords to be written */ + nunit = 0; + for (ii = 0; ii < tfields; ii++) + { + if (tunit && *tunit && *tunit[ii]) + nunit++; + } + + if (extnm && *extnm) + nunit++; /* add one for the EXTNAME keyword */ + + nhead = (9 + (2 * tfields) + nunit + 35) / 36; /* no. of header blocks */ + + /* calculate total width of the table */ + naxis1 = 0; + for (ii = 0; ii < tfields; ii++) + { + ffbnfm(tform[ii], &datacode, &repeat, &width, status); + + if (datacode == TBIT) + naxis1 = naxis1 + ((repeat + 7) / 8); + else if (datacode == TSTRING) + naxis1 += repeat; + else + naxis1 = naxis1 + (repeat * width); + } + + datasize = ((OFF_T)naxis1 * naxis2) + pcount; /* size of table in bytes */ + nblocks = ((datasize + 2879) / 2880) + nhead; /* size of HDU */ + + if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */ + { /* close the CHDU */ + ffrdef(fptr, status); /* scan header to redefine structure */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + else + return(*status = READONLY_FILE); + + nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */ + newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */ + + (fptr->Fptr)->hdutype = BINARY_TBL; /* so that correct fill value is used */ + + /* ffiblk also increments headstart for all following HDUs */ + if (ffiblk(fptr, nblocks, 1, status) > 0) /* insert the blocks */ + return(*status); + + ((fptr->Fptr)->maxhdu)++; /* increment known number of HDUs in the file */ + for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--) + (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */ + + (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */ + + /* set default parameters for this new empty HDU */ + (fptr->Fptr)->curhdu = nexthdu; /* we are now located at the next HDU */ + fptr->HDUposition = nexthdu; /* we are now located at the next HDU */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + (nhead * 2880); + (fptr->Fptr)->hdutype = BINARY_TBL; /* might need to be reset... */ + + /* write the required header keywords. This will write PCOUNT = 0 */ + /* so that the variable length data will be written at the right place */ + ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, pcount, + status); + + /* redefine internal structure for this HDU (with PCOUNT = 0) */ + ffrdef(fptr, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdhdu(fitsfile *fptr, /* I - FITS file pointer */ + int *hdutype, /* O - type of the new CHDU after deletion */ + int *status) /* IO - error status */ +/* + Delete the CHDU. If the CHDU is the primary array, then replace the HDU + with an empty primary array with no data. Return the + type of the new CHDU after the old CHDU is deleted. +*/ +{ + int tmptype = 0; + long nblocks, ii, naxes[1]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->curhdu == 0) /* replace primary array with null image */ + { + /* ignore any existing keywords */ + (fptr->Fptr)->headend = 0; + (fptr->Fptr)->nextkey = 0; + + /* write default primary array header */ + ffphpr(fptr,1,8,0,naxes,0,1,1,status); + + /* calc number of blocks to delete (leave just 1 block) */ + nblocks = ( (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1] - + 2880 ) / 2880; + + /* ffdblk also updates the starting address of all following HDUs */ + if (nblocks > 0) + { + if (ffdblk(fptr, nblocks, status) > 0) /* delete the HDU */ + return(*status); + } + + /* this might not be necessary, but is doesn't hurt */ + (fptr->Fptr)->datastart = DATA_UNDEFINED; + + ffrdef(fptr, status); /* reinitialize the primary array */ + } + else + { + + /* calc number of blocks to delete */ + nblocks = ( (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1] - + (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) / 2880; + + /* ffdblk also updates the starting address of all following HDUs */ + if (ffdblk(fptr, nblocks, status) > 0) /* delete the HDU */ + return(*status); + + /* delete the CHDU from the list of HDUs */ + for (ii = (fptr->Fptr)->curhdu + 1; ii <= (fptr->Fptr)->maxhdu; ii++) + (fptr->Fptr)->headstart[ii] = (fptr->Fptr)->headstart[ii + 1]; + + (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] = 0; + ((fptr->Fptr)->maxhdu)--; /* decrement the known number of HDUs */ + + if (ffrhdu(fptr, &tmptype, status) > 0) /* initialize next HDU */ + { + /* failed (end of file?), so move back one HDU */ + *status = 0; + ffcmsg(); /* clear extraneous error messages */ + ffgext(fptr, ((fptr->Fptr)->curhdu) - 1, &tmptype, status); + } + } + + if (hdutype) + *hdutype = tmptype; + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/eval.l b/pkg/tbtables/cfitsio/eval.l new file mode 100644 index 00000000..4b9e0deb --- /dev/null +++ b/pkg/tbtables/cfitsio/eval.l @@ -0,0 +1,512 @@ +%{ +/************************************************************************/ +/* */ +/* CFITSIO Lexical Parser */ +/* */ +/* This file is one of 3 files containing code which parses an */ +/* arithmetic expression and evaluates it in the context of an input */ +/* FITS file table extension. The CFITSIO lexical parser is divided */ +/* into the following 3 parts/files: the CFITSIO "front-end", */ +/* eval_f.c, contains the interface between the user/CFITSIO and the */ +/* real core of the parser; the FLEX interpreter, eval_l.c, takes the */ +/* input string and parses it into tokens and identifies the FITS */ +/* information required to evaluate the expression (ie, keywords and */ +/* columns); and, the BISON grammar and evaluation routines, eval_y.c, */ +/* receives the FLEX output and determines and performs the actual */ +/* operations. The files eval_l.c and eval_y.c are produced from */ +/* running flex and bison on the files eval.l and eval.y, respectively. */ +/* (flex and bison are available from any GNU archive: see www.gnu.org) */ +/* */ +/* The grammar rules, rather than evaluating the expression in situ, */ +/* builds a tree, or Nodal, structure mapping out the order of */ +/* operations and expression dependencies. This "compilation" process */ +/* allows for much faster processing of multiple rows. This technique */ +/* was developed by Uwe Lammers of the XMM Science Analysis System, */ +/* although the CFITSIO implementation is entirely code original. */ +/* */ +/* */ +/* Modification History: */ +/* */ +/* Kent Blackburn c1992 Original parser code developed for the */ +/* FTOOLS software package, in particular, */ +/* the fselect task. */ +/* Kent Blackburn c1995 BIT column support added */ +/* Peter D Wilson Feb 1998 Vector column support added */ +/* Peter D Wilson May 1998 Ported to CFITSIO library. User */ +/* interface routines written, in essence */ +/* making fselect, fcalc, and maketime */ +/* capabilities available to all tools */ +/* via single function calls. */ +/* Peter D Wilson Jun 1998 Major rewrite of parser core, so as to */ +/* create a run-time evaluation tree, */ +/* inspired by the work of Uwe Lammers, */ +/* resulting in a speed increase of */ +/* 10-100 times. */ +/* Peter D Wilson Jul 1998 gtifilter(a,b,c,d) function added */ +/* Peter D Wilson Aug 1998 regfilter(a,b,c,d) function added */ +/* Peter D Wilson Jul 1999 Make parser fitsfile-independent, */ +/* allowing a purely vector-based usage */ +/* */ +/************************************************************************/ + +#include +#include +#include +#ifdef sparc +#include +#else +#include +#endif +#include "eval_defs.h" + +ParseData gParse; /* Global structure holding all parser information */ + +/***** Internal functions *****/ + + int yyGetVariable( char *varName, YYSTYPE *varVal ); + +static int find_variable( char *varName ); +static int expr_read( char *buf, int nbytes ); + +/***** Definitions *****/ + +#define YY_NO_UNPUT /* Don't include YYUNPUT function */ +#define YY_NEVER_INTERACTIVE 1 + +#define MAXCHR 256 +#define MAXBIT 128 + +#define OCT_0 "000" +#define OCT_1 "001" +#define OCT_2 "010" +#define OCT_3 "011" +#define OCT_4 "100" +#define OCT_5 "101" +#define OCT_6 "110" +#define OCT_7 "111" +#define OCT_X "xxx" + +#define HEX_0 "0000" +#define HEX_1 "0001" +#define HEX_2 "0010" +#define HEX_3 "0011" +#define HEX_4 "0100" +#define HEX_5 "0101" +#define HEX_6 "0110" +#define HEX_7 "0111" +#define HEX_8 "1000" +#define HEX_9 "1001" +#define HEX_A "1010" +#define HEX_B "1011" +#define HEX_C "1100" +#define HEX_D "1101" +#define HEX_E "1110" +#define HEX_F "1111" +#define HEX_X "xxxx" + +/* + MJT - 13 June 1996 + read from buffer instead of stdin + (as per old ftools.skel) +*/ +#undef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( (result = expr_read( (char *) buf, max_size )) < 0 ) \ + YY_FATAL_ERROR( "read() in flex scanner failed" ); + +%} +bit ([bB][01xX]+) +oct ([oO][01234567xX]+) +hex ([hH][0123456789aAbBcCdDeEfFxX]+) +integer [0-9]+ +boolean (t|f|T|F) +real ([0-9]*"."[0-9]+)|([0-9]*"."*[0-9]+[eEdD][+-]?[0-9]+)|([0-9]*".") +constant ("#"[a-zA-Z0-9_]+)|("#""$"[^\n]*"$") +string ([\"][^\"\n]*[\"])|([\'][^\'\n]*[\']) +variable ([a-zA-Z_][a-zA-Z0-9_]*)|("$"[^$\n]*"$") +function [a-zA-Z][a-zA-Z0-9]+"(" +intcast ("(int)"|"(INT)") +fltcast ("(float)"|"(FLOAT)"|"(double)"|"(DOUBLE)") +power ("^"|"**") +not ("!"|".not."|".NOT."|"not."|"NOT.") +or ("||"|".or."|".OR."|"or."|"OR.") +and ("&&"|".and."|".AND."|"and."|"AND.") +equal ("=="|".eq."|".EQ."|"eq."|"EQ.") +not_equal ("!="|".ne."|".NE."|"ne."|"NE.") +greater (">"|".gt."|".GT."|"gt."|"GT.") +lesser ("<"|".lt."|".LT."|"lt."|"LT.") +greater_eq (">="|"=>"|".ge."|".GE."|"ge."|"GE.") +lesser_eq ("<="|"=<"|".le."|".LE."|"le."|"LE.") +nl \n + +%% + +[ \t]+ ; +{bit} { + int len; + len = strlen(yytext); + while (yytext[len] == ' ') + len--; + len = len - 1; + strncpy(yylval.str,&yytext[1],len); + yylval.str[len] = '\0'; + return( BITSTR ); + } +{oct} { + int len; + char tmpstring[256]; + char bitstring[256]; + len = strlen(yytext); + while (yytext[len] == ' ') + len--; + len = len - 1; + strncpy(tmpstring,&yytext[1],len); + tmpstring[len] = '\0'; + bitstring[0] = '\0'; + len = 0; + while ( tmpstring[len] != '\0') + { + switch ( tmpstring[len] ) + { + case '0': + strcat(bitstring,OCT_0); + break; + case '1': + strcat(bitstring,OCT_1); + break; + case '2': + strcat(bitstring,OCT_2); + break; + case '3': + strcat(bitstring,OCT_3); + break; + case '4': + strcat(bitstring,OCT_4); + break; + case '5': + strcat(bitstring,OCT_5); + break; + case '6': + strcat(bitstring,OCT_6); + break; + case '7': + strcat(bitstring,OCT_7); + break; + case 'x': + case 'X': + strcat(bitstring,OCT_X); + break; + } + len++; + } + strcpy( yylval.str, bitstring ); + return( BITSTR ); + } +{hex} { + int len; + char tmpstring[256]; + char bitstring[256]; + len = strlen(yytext); + while (yytext[len] == ' ') + len--; + len = len - 1; + strncpy(tmpstring,&yytext[1],len); + tmpstring[len] = '\0'; + bitstring[0] = '\0'; + len = 0; + while ( tmpstring[len] != '\0') + { + switch ( tmpstring[len] ) + { + case '0': + strcat(bitstring,HEX_0); + break; + case '1': + strcat(bitstring,HEX_1); + break; + case '2': + strcat(bitstring,HEX_2); + break; + case '3': + strcat(bitstring,HEX_3); + break; + case '4': + strcat(bitstring,HEX_4); + break; + case '5': + strcat(bitstring,HEX_5); + break; + case '6': + strcat(bitstring,HEX_6); + break; + case '7': + strcat(bitstring,HEX_7); + break; + case '8': + strcat(bitstring,HEX_8); + break; + case '9': + strcat(bitstring,HEX_9); + break; + case 'a': + case 'A': + strcat(bitstring,HEX_A); + break; + case 'b': + case 'B': + strcat(bitstring,HEX_B); + break; + case 'c': + case 'C': + strcat(bitstring,HEX_C); + break; + case 'd': + case 'D': + strcat(bitstring,HEX_D); + break; + case 'e': + case 'E': + strcat(bitstring,HEX_E); + break; + case 'f': + case 'F': + strcat(bitstring,HEX_F); + break; + case 'x': + case 'X': + strcat(bitstring,HEX_X); + break; + } + len++; + } + + strcpy( yylval.str, bitstring ); + return( BITSTR ); + } +{integer} { + yylval.lng = atol(yytext); + return( LONG ); + } +{boolean} { + if ((yytext[0] == 't') || (yytext[0] == 'T')) + yylval.log = 1; + else + yylval.log = 0; + return( BOOLEAN ); + } +{real} { + yylval.dbl = atof(yytext); + return( DOUBLE ); + } +{constant} { + if( !strcasecmp(yytext,"#PI") ) { + yylval.dbl = (double)(4) * atan((double)(1)); + return( DOUBLE ); + } else if( !strcasecmp(yytext,"#E") ) { + yylval.dbl = exp((double)(1)); + return( DOUBLE ); + } else if( !strcasecmp(yytext,"#DEG") ) { + yylval.dbl = ((double)4)*atan((double)1)/((double)180); + return( DOUBLE ); + } else if( !strcasecmp(yytext,"#ROW") ) { + return( ROWREF ); + } else if( !strcasecmp(yytext,"#NULL") ) { + return( NULLREF ); + } else if( !strcasecmp(yytext,"#SNULL") ) { + return( SNULLREF ); + } else { + int len; + if (yytext[1] == '$') { + len = strlen(yytext) - 3; + yylval.str[0] = '#'; + strncpy(yylval.str+1,&yytext[2],len); + yylval.str[len+1] = '\0'; + yytext = yylval.str; + } + return( (*gParse.getData)(yytext, &yylval) ); + } + } +{string} { + int len; + len = strlen(yytext) - 2; + strncpy(yylval.str,&yytext[1],len); + yylval.str[len] = '\0'; + return( STRING ); + } +{variable} { + int len,type; + + if (yytext[0] == '$') { + len = strlen(yytext) - 2; + strncpy(yylval.str,&yytext[1],len); + yylval.str[len] = '\0'; + yytext = yylval.str; + } + type = yyGetVariable(yytext, &yylval); + return( type ); + } +{function} { + char *fname; + int len=0; + fname = &yylval.str[0]; + while( (fname[len]=toupper(yytext[len])) ) len++; + + if( FSTRCMP(fname,"BOX(")==0 + || FSTRCMP(fname,"CIRCLE(")==0 + || FSTRCMP(fname,"ELLIPSE(")==0 + || FSTRCMP(fname,"NEAR(")==0 + || FSTRCMP(fname,"ISNULL(")==0 + ) + /* Return type is always boolean */ + return( BFUNCTION ); + + else if( FSTRCMP(fname,"GTIFILTER(")==0 ) + return( GTIFILTER ); + + else if( FSTRCMP(fname,"REGFILTER(")==0 ) + return( REGFILTER ); + + else + return( FUNCTION ); + } +{intcast} { return( INTCAST ); } +{fltcast} { return( FLTCAST ); } +{power} { return( POWER ); } +{not} { return( NOT ); } +{or} { return( OR ); } +{and} { return( AND ); } +{equal} { return( EQ ); } +{not_equal} { return( NE ); } +{greater} { return( GT ); } +{lesser} { return( LT ); } +{greater_eq} { return( GTE ); } +{lesser_eq} { return( LTE ); } +{nl} { return( '\n' ); } +. { return( yytext[0] ); } +%% + +int yywrap() +{ + /* MJT -- 13 June 1996 + Supplied for compatibility with + pre-2.5.1 versions of flex which + do not recognize %option noyywrap + */ + return(1); +} + +/* + expr_read is lifted from old ftools.skel. + Now we can use any version of flex with + no .skel file necessary! MJT - 13 June 1996 + + keep a memory of how many bytes have been + read previously, so that an unlimited-sized + buffer can be supported. PDW - 28 Feb 1998 +*/ + +static int expr_read(char *buf, int nbytes) +{ + int n; + + n = 0; + if( !gParse.is_eobuf ) { + do { + buf[n++] = gParse.expr[gParse.index++]; + } while ((nlng = varNum; + } + return( type ); +} + +static int find_variable(char *varName) +{ + int i; + + if( gParse.nCols ) + for( i=0; i c2) return(1); + if (c1 == 0) return(0); + s1++; + s2++; + } +} + +int strncasecmp(const char *s1, const char *s2, size_t n) +{ + char c1, c2; + + for (; n-- ;) { + c1 = toupper( *s1 ); + c2 = toupper( *s2 ); + + if (c1 < c2) return(-1); + if (c1 > c2) return(1); + if (c1 == 0) return(0); + s1++; + s2++; + } + return(0); +} + +#endif diff --git a/pkg/tbtables/cfitsio/eval.y b/pkg/tbtables/cfitsio/eval.y new file mode 100644 index 00000000..238ab788 --- /dev/null +++ b/pkg/tbtables/cfitsio/eval.y @@ -0,0 +1,5227 @@ +%{ +/************************************************************************/ +/* */ +/* CFITSIO Lexical Parser */ +/* */ +/* This file is one of 3 files containing code which parses an */ +/* arithmetic expression and evaluates it in the context of an input */ +/* FITS file table extension. The CFITSIO lexical parser is divided */ +/* into the following 3 parts/files: the CFITSIO "front-end", */ +/* eval_f.c, contains the interface between the user/CFITSIO and the */ +/* real core of the parser; the FLEX interpreter, eval_l.c, takes the */ +/* input string and parses it into tokens and identifies the FITS */ +/* information required to evaluate the expression (ie, keywords and */ +/* columns); and, the BISON grammar and evaluation routines, eval_y.c, */ +/* receives the FLEX output and determines and performs the actual */ +/* operations. The files eval_l.c and eval_y.c are produced from */ +/* running flex and bison on the files eval.l and eval.y, respectively. */ +/* (flex and bison are available from any GNU archive: see www.gnu.org) */ +/* */ +/* The grammar rules, rather than evaluating the expression in situ, */ +/* builds a tree, or Nodal, structure mapping out the order of */ +/* operations and expression dependencies. This "compilation" process */ +/* allows for much faster processing of multiple rows. This technique */ +/* was developed by Uwe Lammers of the XMM Science Analysis System, */ +/* although the CFITSIO implementation is entirely code original. */ +/* */ +/* */ +/* Modification History: */ +/* */ +/* Kent Blackburn c1992 Original parser code developed for the */ +/* FTOOLS software package, in particular, */ +/* the fselect task. */ +/* Kent Blackburn c1995 BIT column support added */ +/* Peter D Wilson Feb 1998 Vector column support added */ +/* Peter D Wilson May 1998 Ported to CFITSIO library. User */ +/* interface routines written, in essence */ +/* making fselect, fcalc, and maketime */ +/* capabilities available to all tools */ +/* via single function calls. */ +/* Peter D Wilson Jun 1998 Major rewrite of parser core, so as to */ +/* create a run-time evaluation tree, */ +/* inspired by the work of Uwe Lammers, */ +/* resulting in a speed increase of */ +/* 10-100 times. */ +/* Peter D Wilson Jul 1998 gtifilter(a,b,c,d) function added */ +/* Peter D Wilson Aug 1998 regfilter(a,b,c,d) function added */ +/* Peter D Wilson Jul 1999 Make parser fitsfile-independent, */ +/* allowing a purely vector-based usage */ +/* Craig B Markwardt Jun 2004 Add MEDIAN() function */ +/* Craig B Markwardt Jun 2004 Add SUM(), and MIN/MAX() for bit arrays */ +/* Craig B Markwardt Jun 2004 Allow subscripting of nX bit arrays */ +/* Craig B Markwardt Jun 2004 Implement statistical functions */ +/* NVALID(), AVERAGE(), and STDDEV() */ +/* for integer and floating point vectors */ +/* Craig B Markwardt Jun 2004 Use NULL values for range errors instead*/ +/* of throwing a parse error */ +/* Craig B Markwardt Oct 2004 Add ACCUM() and SEQDIFF() functions */ +/* */ +/************************************************************************/ + +#define APPROX 1.0e-7 +#include "eval_defs.h" +#include "region.h" +#include + +#include + +#ifndef alloca +#define alloca malloc +#endif + + /* Shrink the initial stack depth to keep local data <32K (mac limit) */ + /* yacc will allocate more space if needed, though. */ +#define YYINITDEPTH 100 + +/***************************************************************/ +/* Replace Bison's BACKUP macro with one that fixes a bug -- */ +/* must update state after popping the stack -- and allows */ +/* popping multiple terms at one time. */ +/***************************************************************/ + +#define YYNEWBACKUP(token, value) \ + do \ + if (yychar == YYEMPTY ) \ + { yychar = (token); \ + memcpy( &yylval, &(value), sizeof(value) ); \ + yychar1 = YYTRANSLATE (yychar); \ + while (yylen--) YYPOPSTACK; \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { yyerror ("syntax error: cannot back up"); YYERROR; } \ + while (0) + +/***************************************************************/ +/* Useful macros for accessing/testing Nodes */ +/***************************************************************/ + +#define TEST(a) if( (a)<0 ) YYERROR +#define SIZE(a) gParse.Nodes[ a ].value.nelem +#define TYPE(a) gParse.Nodes[ a ].type +#define PROMOTE(a,b) if( TYPE(a) > TYPE(b) ) \ + b = New_Unary( TYPE(a), 0, b ); \ + else if( TYPE(a) < TYPE(b) ) \ + a = New_Unary( TYPE(b), 0, a ); + +/***** Internal functions *****/ + +#ifdef __cplusplus +extern "C" { +#endif + +static int Alloc_Node ( void ); +static void Free_Last_Node( void ); +static void Evaluate_Node ( int thisNode ); + +static int New_Const ( int returnType, void *value, long len ); +static int New_Column( int ColNum ); +static int New_Offset( int ColNum, int offset ); +static int New_Unary ( int returnType, int Op, int Node1 ); +static int New_BinOp ( int returnType, int Node1, int Op, int Node2 ); +static int New_Func ( int returnType, funcOp Op, int nNodes, + int Node1, int Node2, int Node3, int Node4, + int Node5, int Node6, int Node7 ); +static int New_Deref ( int Var, int nDim, + int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 ); +static int New_GTI ( char *fname, int Node1, char *start, char *stop ); +static int New_REG ( char *fname, int NodeX, int NodeY, char *colNames ); +static int New_Vector( int subNode ); +static int Close_Vec ( int vecNode ); +static int Locate_Col( Node *this ); +static int Test_Dims ( int Node1, int Node2 ); +static void Copy_Dims ( int Node1, int Node2 ); + +static void Allocate_Ptrs( Node *this ); +static void Do_Unary ( Node *this ); +static void Do_Offset ( Node *this ); +static void Do_BinOp_bit ( Node *this ); +static void Do_BinOp_str ( Node *this ); +static void Do_BinOp_log ( Node *this ); +static void Do_BinOp_lng ( Node *this ); +static void Do_BinOp_dbl ( Node *this ); +static void Do_Func ( Node *this ); +static void Do_Deref ( Node *this ); +static void Do_GTI ( Node *this ); +static void Do_REG ( Node *this ); +static void Do_Vector ( Node *this ); + +static long Search_GTI ( double evtTime, long nGTI, double *start, + double *stop, int ordered ); + +static char saobox (double xcen, double ycen, double xwid, double ywid, + double rot, double xcol, double ycol); +static char ellipse(double xcen, double ycen, double xrad, double yrad, + double rot, double xcol, double ycol); +static char circle (double xcen, double ycen, double rad, + double xcol, double ycol); +static char bnear (double x, double y, double tolerance); +static char bitcmp (char *bitstrm1, char *bitstrm2); +static char bitlgte(char *bits1, int oper, char *bits2); + +static void bitand(char *result, char *bitstrm1, char *bitstrm2); +static void bitor (char *result, char *bitstrm1, char *bitstrm2); +static void bitnot(char *result, char *bits); + +static void yyerror(char *msg); + +#ifdef __cplusplus + } +#endif + +%} + +%union { + int Node; /* Index of Node */ + double dbl; /* real value */ + long lng; /* integer value */ + char log; /* logical value */ + char str[256]; /* string value */ +} + +%token BOOLEAN /* First 3 must be in order of */ +%token LONG /* increasing promotion for later use */ +%token DOUBLE +%token STRING +%token BITSTR +%token FUNCTION +%token BFUNCTION +%token GTIFILTER +%token REGFILTER +%token COLUMN +%token BCOLUMN +%token SCOLUMN +%token BITCOL +%token ROWREF +%token NULLREF +%token SNULLREF + +%type expr +%type bexpr +%type sexpr +%type bits +%type vector +%type bvector + +%left ',' '=' ':' '{' '}' +%right '?' +%left OR +%left AND +%left EQ NE '~' +%left GT LT LTE GTE +%left '+' '-' '%' +%left '*' '/' +%left '|' '&' +%right POWER +%left NOT +%left INTCAST FLTCAST +%left UMINUS +%left '[' + +%right ACCUM DIFF + +%% + +lines: /* nothing ; was | lines line */ + | lines line + ; + +line: '\n' {} + | expr '\n' + { if( $1<0 ) { + yyerror("Couldn't build node structure: out of memory?"); + YYERROR; } + gParse.resultNode = $1; + } + | bexpr '\n' + { if( $1<0 ) { + yyerror("Couldn't build node structure: out of memory?"); + YYERROR; } + gParse.resultNode = $1; + } + | sexpr '\n' + { if( $1<0 ) { + yyerror("Couldn't build node structure: out of memory?"); + YYERROR; } + gParse.resultNode = $1; + } + | bits '\n' + { if( $1<0 ) { + yyerror("Couldn't build node structure: out of memory?"); + YYERROR; } + gParse.resultNode = $1; + } + | error '\n' { yyerrok; } + ; + +bvector: '{' bexpr + { $$ = New_Vector( $2 ); TEST($$); } + | bvector ',' bexpr + { + if( gParse.Nodes[$1].nSubNodes >= MAXSUBS ) { + $1 = Close_Vec( $1 ); TEST($1); + $$ = New_Vector( $1 ); TEST($$); + } else { + $$ = $1; + } + gParse.Nodes[$$].SubNodes[ gParse.Nodes[$$].nSubNodes++ ] + = $3; + } + ; + +vector: '{' expr + { $$ = New_Vector( $2 ); TEST($$); } + | vector ',' expr + { + if( TYPE($1) < TYPE($3) ) + TYPE($1) = TYPE($3); + if( gParse.Nodes[$1].nSubNodes >= MAXSUBS ) { + $1 = Close_Vec( $1 ); TEST($1); + $$ = New_Vector( $1 ); TEST($$); + } else { + $$ = $1; + } + gParse.Nodes[$$].SubNodes[ gParse.Nodes[$$].nSubNodes++ ] + = $3; + } + | vector ',' bexpr + { + if( gParse.Nodes[$1].nSubNodes >= MAXSUBS ) { + $1 = Close_Vec( $1 ); TEST($1); + $$ = New_Vector( $1 ); TEST($$); + } else { + $$ = $1; + } + gParse.Nodes[$$].SubNodes[ gParse.Nodes[$$].nSubNodes++ ] + = $3; + } + | bvector ',' expr + { + TYPE($1) = TYPE($3); + if( gParse.Nodes[$1].nSubNodes >= MAXSUBS ) { + $1 = Close_Vec( $1 ); TEST($1); + $$ = New_Vector( $1 ); TEST($$); + } else { + $$ = $1; + } + gParse.Nodes[$$].SubNodes[ gParse.Nodes[$$].nSubNodes++ ] + = $3; + } + ; + +expr: vector '}' + { $$ = Close_Vec( $1 ); TEST($$); } + ; + +bexpr: bvector '}' + { $$ = Close_Vec( $1 ); TEST($$); } + ; + +bits: BITSTR + { + $$ = New_Const( BITSTR, $1, strlen($1)+1 ); TEST($$); + SIZE($$) = strlen($1); + } + | BITCOL + { $$ = New_Column( $1 ); TEST($$); } + | BITCOL '{' expr '}' + { + if( TYPE($3) != LONG + || gParse.Nodes[$3].operation != CONST_OP ) { + yyerror("Offset argument must be a constant integer"); + YYERROR; + } + $$ = New_Offset( $1, $3 ); TEST($$); + } + | bits '&' bits + { $$ = New_BinOp( BITSTR, $1, '&', $3 ); TEST($$); + SIZE($$) = ( SIZE($1)>SIZE($3) ? SIZE($1) : SIZE($3) ); } + | bits '|' bits + { $$ = New_BinOp( BITSTR, $1, '|', $3 ); TEST($$); + SIZE($$) = ( SIZE($1)>SIZE($3) ? SIZE($1) : SIZE($3) ); } + | bits '+' bits + { $$ = New_BinOp( BITSTR, $1, '+', $3 ); TEST($$); + SIZE($$) = SIZE($1) + SIZE($3); } + | bits '[' expr ']' + { $$ = New_Deref( $1, 1, $3, 0, 0, 0, 0 ); TEST($$); } + | bits '[' expr ',' expr ']' + { $$ = New_Deref( $1, 2, $3, $5, 0, 0, 0 ); TEST($$); } + | bits '[' expr ',' expr ',' expr ']' + { $$ = New_Deref( $1, 3, $3, $5, $7, 0, 0 ); TEST($$); } + | bits '[' expr ',' expr ',' expr ',' expr ']' + { $$ = New_Deref( $1, 4, $3, $5, $7, $9, 0 ); TEST($$); } + | bits '[' expr ',' expr ',' expr ',' expr ',' expr ']' + { $$ = New_Deref( $1, 5, $3, $5, $7, $9, $11 ); TEST($$); } + | NOT bits + { $$ = New_Unary( BITSTR, NOT, $2 ); TEST($$); } + + | '(' bits ')' + { $$ = $2; } + ; + +expr: LONG + { $$ = New_Const( LONG, &($1), sizeof(long) ); TEST($$); } + | DOUBLE + { $$ = New_Const( DOUBLE, &($1), sizeof(double) ); TEST($$); } + | COLUMN + { $$ = New_Column( $1 ); TEST($$); } + | COLUMN '{' expr '}' + { + if( TYPE($3) != LONG + || gParse.Nodes[$3].operation != CONST_OP ) { + yyerror("Offset argument must be a constant integer"); + YYERROR; + } + $$ = New_Offset( $1, $3 ); TEST($$); + } + | ROWREF + { $$ = New_Func( LONG, row_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); } + | NULLREF + { $$ = New_Func( LONG, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); } + | expr '%' expr + { PROMOTE($1,$3); $$ = New_BinOp( TYPE($1), $1, '%', $3 ); + TEST($$); } + | expr '+' expr + { PROMOTE($1,$3); $$ = New_BinOp( TYPE($1), $1, '+', $3 ); + TEST($$); } + | expr '-' expr + { PROMOTE($1,$3); $$ = New_BinOp( TYPE($1), $1, '-', $3 ); + TEST($$); } + | expr '*' expr + { PROMOTE($1,$3); $$ = New_BinOp( TYPE($1), $1, '*', $3 ); + TEST($$); } + | expr '/' expr + { PROMOTE($1,$3); $$ = New_BinOp( TYPE($1), $1, '/', $3 ); + TEST($$); } + | expr POWER expr + { PROMOTE($1,$3); $$ = New_BinOp( TYPE($1), $1, POWER, $3 ); + TEST($$); } + | '+' expr %prec UMINUS + { $$ = $2; } + | '-' expr %prec UMINUS + { $$ = New_Unary( TYPE($2), UMINUS, $2 ); TEST($$); } + | '(' expr ')' + { $$ = $2; } + | expr '*' bexpr + { $3 = New_Unary( TYPE($1), 0, $3 ); + $$ = New_BinOp( TYPE($1), $1, '*', $3 ); + TEST($$); } + | bexpr '*' expr + { $1 = New_Unary( TYPE($3), 0, $1 ); + $$ = New_BinOp( TYPE($3), $1, '*', $3 ); + TEST($$); } + | bexpr '?' expr ':' expr + { + PROMOTE($3,$5); + if( ! Test_Dims($3,$5) ) { + yyerror("Incompatible dimensions in '?:' arguments"); + YYERROR; + } + $$ = New_Func( 0, ifthenelse_fct, 3, $3, $5, $1, + 0, 0, 0, 0 ); + TEST($$); + if( SIZE($3)=SIZE($4) && Test_Dims( $2, $4 ) ) { + PROMOTE($2,$4); + $$ = New_Func( 0, defnull_fct, 2, $2, $4, 0, + 0, 0, 0, 0 ); + TEST($$); + } else { + yyerror("Dimensions of DEFNULL arguments " + "are not compatible"); + YYERROR; + } + } else if (FSTRCMP($1,"ARCTAN2(") == 0) { + if( TYPE($2) != DOUBLE ) $2 = New_Unary( DOUBLE, 0, $2 ); + if( TYPE($4) != DOUBLE ) $4 = New_Unary( DOUBLE, 0, $4 ); + if( Test_Dims( $2, $4 ) ) { + $$ = New_Func( 0, atan2_fct, 2, $2, $4, 0, 0, 0, 0, 0 ); + TEST($$); + if( SIZE($2)=SIZE($4) && Test_Dims( $2, $4 ) ) { + $$ = New_Func( 0, defnull_fct, 2, $2, $4, 0, + 0, 0, 0, 0 ); + TEST($$); + } else { + yyerror("Dimensions of DEFNULL arguments are not compatible"); + YYERROR; + } + } else { + yyerror("Boolean Function(expr,expr) not supported"); + YYERROR; + } + } + | BFUNCTION expr ',' expr ',' expr ')' + { + if( SIZE($2)>1 || SIZE($4)>1 || SIZE($6)>1 ) { + yyerror("Cannot use array as function argument"); + YYERROR; + } + if( TYPE($2) != DOUBLE ) $2 = New_Unary( DOUBLE, 0, $2 ); + if( TYPE($4) != DOUBLE ) $4 = New_Unary( DOUBLE, 0, $4 ); + if( TYPE($6) != DOUBLE ) $6 = New_Unary( DOUBLE, 0, $6 ); + if (FSTRCMP($1,"NEAR(") == 0) + $$ = New_Func( BOOLEAN, near_fct, 3, $2, $4, $6, + 0, 0, 0, 0 ); + else { + yyerror("Boolean Function not supported"); + YYERROR; + } + TEST($$); + } + | BFUNCTION expr ',' expr ',' expr ',' expr ',' expr ')' + { + if( SIZE($2)>1 || SIZE($4)>1 || SIZE($6)>1 || SIZE($8)>1 + || SIZE($10)>1 ) { + yyerror("Cannot use array as function argument"); + YYERROR; + } + if( TYPE($2) != DOUBLE ) $2 = New_Unary( DOUBLE, 0, $2 ); + if( TYPE($4) != DOUBLE ) $4 = New_Unary( DOUBLE, 0, $4 ); + if( TYPE($6) != DOUBLE ) $6 = New_Unary( DOUBLE, 0, $6 ); + if( TYPE($8) != DOUBLE ) $8 = New_Unary( DOUBLE, 0, $8 ); + if( TYPE($10)!= DOUBLE ) $10= New_Unary( DOUBLE, 0, $10); + if (FSTRCMP($1,"CIRCLE(") == 0) + $$ = New_Func( BOOLEAN, circle_fct, 5, $2, $4, $6, $8, + $10, 0, 0 ); + else { + yyerror("Boolean Function not supported"); + YYERROR; + } + TEST($$); + } + | BFUNCTION expr ',' expr ',' expr ',' expr ',' expr ',' expr ',' expr ')' + { + if( SIZE($2)>1 || SIZE($4)>1 || SIZE($6)>1 || SIZE($8)>1 + || SIZE($10)>1 || SIZE($12)>1 || SIZE($14)>1 ) { + yyerror("Cannot use array as function argument"); + YYERROR; + } + if( TYPE($2) != DOUBLE ) $2 = New_Unary( DOUBLE, 0, $2 ); + if( TYPE($4) != DOUBLE ) $4 = New_Unary( DOUBLE, 0, $4 ); + if( TYPE($6) != DOUBLE ) $6 = New_Unary( DOUBLE, 0, $6 ); + if( TYPE($8) != DOUBLE ) $8 = New_Unary( DOUBLE, 0, $8 ); + if( TYPE($10)!= DOUBLE ) $10= New_Unary( DOUBLE, 0, $10); + if( TYPE($12)!= DOUBLE ) $12= New_Unary( DOUBLE, 0, $12); + if( TYPE($14)!= DOUBLE ) $14= New_Unary( DOUBLE, 0, $14); + if (FSTRCMP($1,"BOX(") == 0) + $$ = New_Func( BOOLEAN, box_fct, 7, $2, $4, $6, $8, + $10, $12, $14 ); + else if (FSTRCMP($1,"ELLIPSE(") == 0) + $$ = New_Func( BOOLEAN, elps_fct, 7, $2, $4, $6, $8, + $10, $12, $14 ); + else { + yyerror("SAO Image Function not supported"); + YYERROR; + } + TEST($$); + } + + | GTIFILTER ')' + { /* Use defaults for all elements */ + $$ = New_GTI( "", -99, "*START*", "*STOP*" ); + TEST($$); } + | GTIFILTER STRING ')' + { /* Use defaults for all except filename */ + $$ = New_GTI( $2, -99, "*START*", "*STOP*" ); + TEST($$); } + | GTIFILTER STRING ',' expr ')' + { $$ = New_GTI( $2, $4, "*START*", "*STOP*" ); + TEST($$); } + | GTIFILTER STRING ',' expr ',' STRING ',' STRING ')' + { $$ = New_GTI( $2, $4, $6, $8 ); + TEST($$); } + + | REGFILTER STRING ')' + { /* Use defaults for all except filename */ + $$ = New_REG( $2, -99, -99, "" ); + TEST($$); } + | REGFILTER STRING ',' expr ',' expr ')' + { $$ = New_REG( $2, $4, $6, "" ); + TEST($$); } + | REGFILTER STRING ',' expr ',' expr ',' STRING ')' + { $$ = New_REG( $2, $4, $6, $8 ); + TEST($$); } + + | bexpr '[' expr ']' + { $$ = New_Deref( $1, 1, $3, 0, 0, 0, 0 ); TEST($$); } + | bexpr '[' expr ',' expr ']' + { $$ = New_Deref( $1, 2, $3, $5, 0, 0, 0 ); TEST($$); } + | bexpr '[' expr ',' expr ',' expr ']' + { $$ = New_Deref( $1, 3, $3, $5, $7, 0, 0 ); TEST($$); } + | bexpr '[' expr ',' expr ',' expr ',' expr ']' + { $$ = New_Deref( $1, 4, $3, $5, $7, $9, 0 ); TEST($$); } + | bexpr '[' expr ',' expr ',' expr ',' expr ',' expr ']' + { $$ = New_Deref( $1, 5, $3, $5, $7, $9, $11 ); TEST($$); } + | NOT bexpr + { $$ = New_Unary( BOOLEAN, NOT, $2 ); TEST($$); } + | '(' bexpr ')' + { $$ = $2; } + ; + +sexpr: STRING + { $$ = New_Const( STRING, $1, strlen($1)+1 ); TEST($$); + SIZE($$) = strlen($1); } + | SCOLUMN + { $$ = New_Column( $1 ); TEST($$); } + | SCOLUMN '{' expr '}' + { + if( TYPE($3) != LONG + || gParse.Nodes[$3].operation != CONST_OP ) { + yyerror("Offset argument must be a constant integer"); + YYERROR; + } + $$ = New_Offset( $1, $3 ); TEST($$); + } + | SNULLREF + { $$ = New_Func( STRING, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); } + | '(' sexpr ')' + { $$ = $2; } + | sexpr '+' sexpr + { $$ = New_BinOp( STRING, $1, '+', $3 ); TEST($$); + SIZE($$) = SIZE($1) + SIZE($3); } + | bexpr '?' sexpr ':' sexpr + { + if( SIZE($1)!=1 ) { + yyerror("Cannot have a vector string column"); + YYERROR; + } + $$ = New_Func( 0, ifthenelse_fct, 3, $3, $5, $1, + 0, 0, 0, 0 ); + TEST($$); + if( SIZE($3)SIZE($2) ) SIZE($$) = SIZE($4); + } + } + ; + +%% + +/*************************************************************************/ +/* Start of "New" routines which build the expression Nodal structure */ +/*************************************************************************/ + +static int Alloc_Node( void ) +{ + /* Use this for allocation to guarantee *Nodes */ + Node *newNodePtr; /* survives on failure, making it still valid */ + /* while working our way out of this error */ + + if( gParse.nNodes == gParse.nNodesAlloc ) { + if( gParse.Nodes ) { + gParse.nNodesAlloc += gParse.nNodesAlloc; + newNodePtr = (Node *)realloc( gParse.Nodes, + sizeof(Node)*gParse.nNodesAlloc ); + } else { + gParse.nNodesAlloc = 100; + newNodePtr = (Node *)malloc ( sizeof(Node)*gParse.nNodesAlloc ); + } + + if( newNodePtr ) { + gParse.Nodes = newNodePtr; + } else { + gParse.status = MEMORY_ALLOCATION; + return( -1 ); + } + } + + return ( gParse.nNodes++ ); +} + +static void Free_Last_Node( void ) +{ + if( gParse.nNodes ) gParse.nNodes--; +} + +static int New_Const( int returnType, void *value, long len ) +{ + Node *this; + int n; + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = CONST_OP; /* Flag a constant */ + this->DoOp = NULL; + this->nSubNodes = 0; + this->type = returnType; + memcpy( &(this->value.data), value, len ); + this->value.undef = NULL; + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } + return(n); +} + +static int New_Column( int ColNum ) +{ + Node *this; + int n, i; + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = -ColNum; + this->DoOp = NULL; + this->nSubNodes = 0; + this->type = gParse.varData[ColNum].type; + this->value.nelem = gParse.varData[ColNum].nelem; + this->value.naxis = gParse.varData[ColNum].naxis; + for( i=0; ivalue.naxes[i] = gParse.varData[ColNum].naxes[i]; + } + return(n); +} + +static int New_Offset( int ColNum, int offsetNode ) +{ + Node *this; + int n, i, colNode; + + colNode = New_Column( ColNum ); + if( colNode<0 ) return(-1); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = '{'; + this->DoOp = Do_Offset; + this->nSubNodes = 2; + this->SubNodes[0] = colNode; + this->SubNodes[1] = offsetNode; + this->type = gParse.varData[ColNum].type; + this->value.nelem = gParse.varData[ColNum].nelem; + this->value.naxis = gParse.varData[ColNum].naxis; + for( i=0; ivalue.naxes[i] = gParse.varData[ColNum].naxes[i]; + } + return(n); +} + +static int New_Unary( int returnType, int Op, int Node1 ) +{ + Node *this, *that; + int i,n; + + if( Node1<0 ) return(-1); + that = gParse.Nodes + Node1; + + if( !Op ) Op = returnType; + + if( (Op==DOUBLE || Op==FLTCAST) && that->type==DOUBLE ) return( Node1 ); + if( (Op==LONG || Op==INTCAST) && that->type==LONG ) return( Node1 ); + if( (Op==BOOLEAN ) && that->type==BOOLEAN ) return( Node1 ); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = Op; + this->DoOp = Do_Unary; + this->nSubNodes = 1; + this->SubNodes[0] = Node1; + this->type = returnType; + + that = gParse.Nodes + Node1; /* Reset in case .Nodes mv'd */ + this->value.nelem = that->value.nelem; + this->value.naxis = that->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that->value.naxes[i]; + + if( that->operation==CONST_OP ) this->DoOp( this ); + } + return( n ); +} + +static int New_BinOp( int returnType, int Node1, int Op, int Node2 ) +{ + Node *this,*that1,*that2; + int n,i,constant; + + if( Node1<0 || Node2<0 ) return(-1); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = Op; + this->nSubNodes = 2; + this->SubNodes[0]= Node1; + this->SubNodes[1]= Node2; + this->type = returnType; + + that1 = gParse.Nodes + Node1; + that2 = gParse.Nodes + Node2; + constant = (that1->operation==CONST_OP + && that2->operation==CONST_OP); + if( that1->type!=STRING && that1->type!=BITSTR ) + if( !Test_Dims( Node1, Node2 ) ) { + Free_Last_Node(); + yyerror("Array sizes/dims do not match for binary operator"); + return(-1); + } + if( that1->value.nelem == 1 ) that1 = that2; + + this->value.nelem = that1->value.nelem; + this->value.naxis = that1->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that1->value.naxes[i]; + + if ( Op == ACCUM && that1->type == BITSTR ) { + /* ACCUM is rank-reducing on bit strings */ + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } + + /* Both subnodes should be of same time */ + switch( that1->type ) { + case BITSTR: this->DoOp = Do_BinOp_bit; break; + case STRING: this->DoOp = Do_BinOp_str; break; + case BOOLEAN: this->DoOp = Do_BinOp_log; break; + case LONG: this->DoOp = Do_BinOp_lng; break; + case DOUBLE: this->DoOp = Do_BinOp_dbl; break; + } + if( constant ) this->DoOp( this ); + } + return( n ); +} + +static int New_Func( int returnType, funcOp Op, int nNodes, + int Node1, int Node2, int Node3, int Node4, + int Node5, int Node6, int Node7 ) +/* If returnType==0 , use Node1's type and vector sizes as returnType, */ +/* else return a single value of type returnType */ +{ + Node *this, *that; + int i,n,constant; + + if( Node1<0 || Node2<0 || Node3<0 || Node4<0 || + Node5<0 || Node6<0 || Node7<0 ) return(-1); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = (int)Op; + this->DoOp = Do_Func; + this->nSubNodes = nNodes; + this->SubNodes[0] = Node1; + this->SubNodes[1] = Node2; + this->SubNodes[2] = Node3; + this->SubNodes[3] = Node4; + this->SubNodes[4] = Node5; + this->SubNodes[5] = Node6; + this->SubNodes[6] = Node7; + i = constant = nNodes; /* Functions with zero params are not const */ + while( i-- ) + constant = ( constant && + gParse.Nodes[ this->SubNodes[i] ].operation==CONST_OP ); + + if( returnType ) { + this->type = returnType; + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } else { + that = gParse.Nodes + Node1; + this->type = that->type; + this->value.nelem = that->value.nelem; + this->value.naxis = that->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that->value.naxes[i]; + } + if( constant ) this->DoOp( this ); + } + return( n ); +} + +static int New_Deref( int Var, int nDim, + int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 ) +{ + int n, idx, constant; + long elem=0; + Node *this, *theVar, *theDim[MAXDIMS]; + + if( Var<0 || Dim1<0 || Dim2<0 || Dim3<0 || Dim4<0 || Dim5<0 ) return(-1); + + theVar = gParse.Nodes + Var; + if( theVar->operation==CONST_OP || theVar->value.nelem==1 ) { + yyerror("Cannot index a scalar value"); + return(-1); + } + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->nSubNodes = nDim+1; + theVar = gParse.Nodes + (this->SubNodes[0]=Var); + theDim[0] = gParse.Nodes + (this->SubNodes[1]=Dim1); + theDim[1] = gParse.Nodes + (this->SubNodes[2]=Dim2); + theDim[2] = gParse.Nodes + (this->SubNodes[3]=Dim3); + theDim[3] = gParse.Nodes + (this->SubNodes[4]=Dim4); + theDim[4] = gParse.Nodes + (this->SubNodes[5]=Dim5); + constant = theVar->operation==CONST_OP; + for( idx=0; idxoperation==CONST_OP); + + for( idx=0; idxvalue.nelem>1 ) { + Free_Last_Node(); + yyerror("Cannot use an array as an index value"); + return(-1); + } else if( theDim[idx]->type!=LONG ) { + Free_Last_Node(); + yyerror("Index value must be an integer type"); + return(-1); + } + + this->operation = '['; + this->DoOp = Do_Deref; + this->type = theVar->type; + + if( theVar->value.naxis == nDim ) { /* All dimensions specified */ + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } else if( nDim==1 ) { /* Dereference only one dimension */ + elem=1; + this->value.naxis = theVar->value.naxis-1; + for( idx=0; idxvalue.naxis; idx++ ) { + elem *= ( this->value.naxes[idx] = theVar->value.naxes[idx] ); + } + this->value.nelem = elem; + } else { + Free_Last_Node(); + yyerror("Must specify just one or all indices for vector"); + return(-1); + } + if( constant ) this->DoOp( this ); + } + return(n); +} + +extern int yyGetVariable( char *varName, YYSTYPE *varVal ); + +static int New_GTI( char *fname, int Node1, char *start, char *stop ) +{ + fitsfile *fptr; + Node *this, *that0, *that1; + int type,i,n, startCol, stopCol, Node0; + int hdutype, hdunum, evthdu, samefile, extvers, movetotype, tstat; + char extname[100]; + long nrows; + double timeZeroI[2], timeZeroF[2], dt, timeSpan; + char xcol[20], xexpr[20]; + YYSTYPE colVal; + + if( Node1==-99 ) { + type = yyGetVariable( "TIME", &colVal ); + if( type==COLUMN ) { + Node1 = New_Column( (int)colVal.lng ); + } else { + yyerror("Could not build TIME column for GTIFILTER"); + return(-1); + } + } + Node1 = New_Unary( DOUBLE, 0, Node1 ); + Node0 = Alloc_Node(); /* This will hold the START/STOP times */ + if( Node1<0 || Node0<0 ) return(-1); + + /* Record current HDU number in case we need to move within this file */ + + fptr = gParse.def_fptr; + ffghdn( fptr, &evthdu ); + + /* Look for TIMEZERO keywords in current extension */ + + tstat = 0; + if( ffgkyd( fptr, "TIMEZERO", timeZeroI, NULL, &tstat ) ) { + tstat = 0; + if( ffgkyd( fptr, "TIMEZERI", timeZeroI, NULL, &tstat ) ) { + timeZeroI[0] = timeZeroF[0] = 0.0; + } else if( ffgkyd( fptr, "TIMEZERF", timeZeroF, NULL, &tstat ) ) { + timeZeroF[0] = 0.0; + } + } else { + timeZeroF[0] = 0.0; + } + + /* Resolve filename parameter */ + + switch( fname[0] ) { + case '\0': + samefile = 1; + hdunum = 1; + break; + case '[': + samefile = 1; + i = 1; + while( fname[i] != '\0' && fname[i] != ']' ) i++; + if( fname[i] ) { + fname[i] = '\0'; + fname++; + ffexts( fname, &hdunum, extname, &extvers, &movetotype, + xcol, xexpr, &gParse.status ); + if( *extname ) { + ffmnhd( fptr, movetotype, extname, extvers, &gParse.status ); + ffghdn( fptr, &hdunum ); + } else if( hdunum ) { + ffmahd( fptr, ++hdunum, &hdutype, &gParse.status ); + } else if( !gParse.status ) { + yyerror("Cannot use primary array for GTI filter"); + return( -1 ); + } + } else { + yyerror("File extension specifier lacks closing ']'"); + return( -1 ); + } + break; + case '+': + samefile = 1; + hdunum = atoi( fname ) + 1; + if( hdunum>1 ) + ffmahd( fptr, hdunum, &hdutype, &gParse.status ); + else { + yyerror("Cannot use primary array for GTI filter"); + return( -1 ); + } + break; + default: + samefile = 0; + if( ! ffopen( &fptr, fname, READONLY, &gParse.status ) ) + ffghdn( fptr, &hdunum ); + break; + } + if( gParse.status ) return(-1); + + /* If at primary, search for GTI extension */ + + if( hdunum==1 ) { + while( 1 ) { + hdunum++; + if( ffmahd( fptr, hdunum, &hdutype, &gParse.status ) ) break; + if( hdutype==IMAGE_HDU ) continue; + tstat = 0; + if( ffgkys( fptr, "EXTNAME", extname, NULL, &tstat ) ) continue; + ffupch( extname ); + if( strstr( extname, "GTI" ) ) break; + } + if( gParse.status ) { + if( gParse.status==END_OF_FILE ) + yyerror("GTI extension not found in this file"); + return(-1); + } + } + + /* Locate START/STOP Columns */ + + ffgcno( fptr, CASEINSEN, start, &startCol, &gParse.status ); + ffgcno( fptr, CASEINSEN, stop, &stopCol, &gParse.status ); + if( gParse.status ) return(-1); + + /* Look for TIMEZERO keywords in GTI extension */ + + tstat = 0; + if( ffgkyd( fptr, "TIMEZERO", timeZeroI+1, NULL, &tstat ) ) { + tstat = 0; + if( ffgkyd( fptr, "TIMEZERI", timeZeroI+1, NULL, &tstat ) ) { + timeZeroI[1] = timeZeroF[1] = 0.0; + } else if( ffgkyd( fptr, "TIMEZERF", timeZeroF+1, NULL, &tstat ) ) { + timeZeroF[1] = 0.0; + } + } else { + timeZeroF[1] = 0.0; + } + + n = Alloc_Node(); + if( n >= 0 ) { + this = gParse.Nodes + n; + this->nSubNodes = 2; + this->SubNodes[1] = Node1; + this->operation = (int)gtifilt_fct; + this->DoOp = Do_GTI; + this->type = BOOLEAN; + that1 = gParse.Nodes + Node1; + this->value.nelem = that1->value.nelem; + this->value.naxis = that1->value.naxis; + for( i=0; i < that1->value.naxis; i++ ) + this->value.naxes[i] = that1->value.naxes[i]; + + /* Init START/STOP node to be treated as a "constant" */ + + this->SubNodes[0] = Node0; + that0 = gParse.Nodes + Node0; + that0->operation = CONST_OP; + that0->DoOp = NULL; + that0->value.data.ptr= NULL; + + /* Read in START/STOP times */ + + if( ffgkyj( fptr, "NAXIS2", &nrows, NULL, &gParse.status ) ) + return(-1); + that0->value.nelem = nrows; + if( nrows ) { + + that0->value.data.dblptr = (double*)malloc( 2*nrows*sizeof(double) ); + if( !that0->value.data.dblptr ) { + gParse.status = MEMORY_ALLOCATION; + return(-1); + } + + ffgcvd( fptr, startCol, 1L, 1L, nrows, 0.0, + that0->value.data.dblptr, &i, &gParse.status ); + ffgcvd( fptr, stopCol, 1L, 1L, nrows, 0.0, + that0->value.data.dblptr+nrows, &i, &gParse.status ); + if( gParse.status ) { + free( that0->value.data.dblptr ); + return(-1); + } + + /* Test for fully time-ordered GTI... both START && STOP */ + + that0->type = 1; /* Assume yes */ + i = nrows; + while( --i ) + if( that0->value.data.dblptr[i-1] + >= that0->value.data.dblptr[i] + || that0->value.data.dblptr[i-1+nrows] + >= that0->value.data.dblptr[i+nrows] ) { + that0->type = 0; + break; + } + + /* Handle TIMEZERO offset, if any */ + + dt = (timeZeroI[1] - timeZeroI[0]) + (timeZeroF[1] - timeZeroF[0]); + timeSpan = that0->value.data.dblptr[nrows+nrows-1] + - that0->value.data.dblptr[0]; + + if( fabs( dt / timeSpan ) > 1e-12 ) { + for( i=0; i<(nrows+nrows); i++ ) + that0->value.data.dblptr[i] += dt; + } + } + if( gParse.Nodes[Node1].operation==CONST_OP ) + this->DoOp( this ); + } + + if( samefile ) + ffmahd( fptr, evthdu, &hdutype, &gParse.status ); + else + ffclos( fptr, &gParse.status ); + + return( n ); +} + +static int New_REG( char *fname, int NodeX, int NodeY, char *colNames ) +{ + Node *this, *that0; + int type, n, Node0; + int Xcol, Ycol, tstat; + WCSdata wcs; + SAORegion *Rgn; + char *cX, *cY; + YYSTYPE colVal; + + if( NodeX==-99 ) { + type = yyGetVariable( "X", &colVal ); + if( type==COLUMN ) { + NodeX = New_Column( (int)colVal.lng ); + } else { + yyerror("Could not build X column for REGFILTER"); + return(-1); + } + } + if( NodeY==-99 ) { + type = yyGetVariable( "Y", &colVal ); + if( type==COLUMN ) { + NodeY = New_Column( (int)colVal.lng ); + } else { + yyerror("Could not build Y column for REGFILTER"); + return(-1); + } + } + NodeX = New_Unary( DOUBLE, 0, NodeX ); + NodeY = New_Unary( DOUBLE, 0, NodeY ); + Node0 = Alloc_Node(); /* This will hold the Region Data */ + if( NodeX<0 || NodeY<0 || Node0<0 ) return(-1); + + n = Alloc_Node(); + if( n >= 0 ) { + this = gParse.Nodes + n; + this->nSubNodes = 3; + this->SubNodes[0] = Node0; + this->SubNodes[1] = NodeX; + this->SubNodes[2] = NodeY; + this->operation = (int)regfilt_fct; + this->DoOp = Do_REG; + this->type = BOOLEAN; + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + + /* Init Region node to be treated as a "constant" */ + + that0 = gParse.Nodes + Node0; + that0->operation = CONST_OP; + that0->DoOp = NULL; + + /* Identify what columns to use for WCS information */ + + Xcol = Ycol = 0; + if( *colNames ) { + /* Use the column names in this string for WCS info */ + while( *colNames==' ' ) colNames++; + cX = cY = colNames; + while( *cY && *cY!=' ' && *cY!=',' ) cY++; + if( *cY ) + *(cY++) = '\0'; + while( *cY==' ' ) cY++; + if( !*cY ) { + yyerror("Could not extract valid pair of column names from REGFILTER"); + Free_Last_Node(); + return( -1 ); + } + fits_get_colnum( gParse.def_fptr, CASEINSEN, cX, &Xcol, + &gParse.status ); + fits_get_colnum( gParse.def_fptr, CASEINSEN, cY, &Ycol, + &gParse.status ); + if( gParse.status ) { + yyerror("Could not locate columns indicated for WCS info"); + Free_Last_Node(); + return( -1 ); + } + + } else { + /* Try to find columns used in X/Y expressions */ + Xcol = Locate_Col( gParse.Nodes + NodeX ); + Ycol = Locate_Col( gParse.Nodes + NodeY ); + if( Xcol<0 || Ycol<0 ) { + yyerror("Found multiple X/Y column references in REGFILTER"); + Free_Last_Node(); + return( -1 ); + } + } + + /* Now, get the WCS info, if it exists, from the indicated columns */ + wcs.exists = 0; + if( Xcol>0 && Ycol>0 ) { + tstat = 0; + ffgtcs( gParse.def_fptr, Xcol, Ycol, + &wcs.xrefval, &wcs.yrefval, + &wcs.xrefpix, &wcs.yrefpix, + &wcs.xinc, &wcs.yinc, + &wcs.rot, wcs.type, + &tstat ); + if( tstat==NO_WCS_KEY ) { + wcs.exists = 0; + } else if( tstat ) { + gParse.status = tstat; + Free_Last_Node(); + return( -1 ); + } else { + wcs.exists = 1; + } + } + + /* Read in Region file */ + + fits_read_rgnfile( fname, &wcs, &Rgn, &gParse.status ); + if( gParse.status ) { + Free_Last_Node(); + return( -1 ); + } + + that0->value.data.ptr = Rgn; + + if( gParse.Nodes[NodeX].operation==CONST_OP + && gParse.Nodes[NodeY].operation==CONST_OP ) + this->DoOp( this ); + } + + return( n ); +} + +static int New_Vector( int subNode ) +{ + Node *this, *that; + int n; + + n = Alloc_Node(); + if( n >= 0 ) { + this = gParse.Nodes + n; + that = gParse.Nodes + subNode; + this->type = that->type; + this->nSubNodes = 1; + this->SubNodes[0] = subNode; + this->operation = '{'; + this->DoOp = Do_Vector; + } + + return( n ); +} + +static int Close_Vec( int vecNode ) +{ + Node *this; + int n, nelem=0; + + this = gParse.Nodes + vecNode; + for( n=0; n < this->nSubNodes; n++ ) { + if( TYPE( this->SubNodes[n] ) != this->type ) { + this->SubNodes[n] = New_Unary( this->type, 0, this->SubNodes[n] ); + if( this->SubNodes[n]<0 ) return(-1); + } + nelem += SIZE(this->SubNodes[n]); + } + this->value.naxis = 1; + this->value.nelem = nelem; + this->value.naxes[0] = nelem; + + return( vecNode ); +} + +static int Locate_Col( Node *this ) +/* Locate the TABLE column number of any columns in "this" calculation. */ +/* Return ZERO if none found, or negative if more than 1 found. */ +{ + Node *that; + int i, col=0, newCol, nfound=0; + + if( this->nSubNodes==0 + && this->operation<=0 && this->operation!=CONST_OP ) + return gParse.colData[ - this->operation].colnum; + + for( i=0; inSubNodes; i++ ) { + that = gParse.Nodes + this->SubNodes[i]; + if( that->operation>0 ) { + newCol = Locate_Col( that ); + if( newCol<=0 ) { + nfound += -newCol; + } else { + if( !nfound ) { + col = newCol; + nfound++; + } else if( col != newCol ) { + nfound++; + } + } + } else if( that->operation!=CONST_OP ) { + /* Found a Column */ + newCol = gParse.colData[- that->operation].colnum; + if( !nfound ) { + col = newCol; + nfound++; + } else if( col != newCol ) { + nfound++; + } + } + } + if( nfound!=1 ) + return( - nfound ); + else + return( col ); +} + +static int Test_Dims( int Node1, int Node2 ) +{ + Node *that1, *that2; + int valid, i; + + if( Node1<0 || Node2<0 ) return(0); + + that1 = gParse.Nodes + Node1; + that2 = gParse.Nodes + Node2; + + if( that1->value.nelem==1 || that2->value.nelem==1 ) + valid = 1; + else if( that1->type==that2->type + && that1->value.nelem==that2->value.nelem + && that1->value.naxis==that2->value.naxis ) { + valid = 1; + for( i=0; ivalue.naxis; i++ ) { + if( that1->value.naxes[i]!=that2->value.naxes[i] ) + valid = 0; + } + } else + valid = 0; + return( valid ); +} + +static void Copy_Dims( int Node1, int Node2 ) +{ + Node *that1, *that2; + int i; + + if( Node1<0 || Node2<0 ) return; + + that1 = gParse.Nodes + Node1; + that2 = gParse.Nodes + Node2; + + that1->value.nelem = that2->value.nelem; + that1->value.naxis = that2->value.naxis; + for( i=0; ivalue.naxis; i++ ) + that1->value.naxes[i] = that2->value.naxes[i]; +} + +/********************************************************************/ +/* Routines for actually evaluating the expression start here */ +/********************************************************************/ + +void Evaluate_Parser( long firstRow, long nRows ) + /***********************************************************************/ + /* Reset the parser for processing another batch of data... */ + /* firstRow: Row number of the first element to evaluate */ + /* nRows: Number of rows to be processed */ + /* Initialize each COLUMN node so that its UNDEF and DATA pointers */ + /* point to the appropriate column arrays. */ + /* Finally, call Evaluate_Node for final node. */ + /***********************************************************************/ +{ + int i, column; + long offset, rowOffset; + + gParse.firstRow = firstRow; + gParse.nRows = nRows; + + /* Reset Column Nodes' pointers to point to right data and UNDEF arrays */ + + rowOffset = firstRow - gParse.firstDataRow; + for( i=0; i 0 + || gParse.Nodes[i].operation == CONST_OP ) continue; + + column = -gParse.Nodes[i].operation; + offset = gParse.varData[column].nelem * rowOffset; + + gParse.Nodes[i].value.undef = gParse.varData[column].undef + offset; + + switch( gParse.Nodes[i].type ) { + case BITSTR: + gParse.Nodes[i].value.data.strptr = + (char**)gParse.varData[column].data + rowOffset; + gParse.Nodes[i].value.undef = NULL; + break; + case STRING: + gParse.Nodes[i].value.data.strptr = + (char**)gParse.varData[column].data + rowOffset; + gParse.Nodes[i].value.undef = gParse.varData[column].undef + rowOffset; + break; + case BOOLEAN: + gParse.Nodes[i].value.data.logptr = + (char*)gParse.varData[column].data + offset; + break; + case LONG: + gParse.Nodes[i].value.data.lngptr = + (long*)gParse.varData[column].data + offset; + break; + case DOUBLE: + gParse.Nodes[i].value.data.dblptr = + (double*)gParse.varData[column].data + offset; + break; + } + } + + Evaluate_Node( gParse.resultNode ); +} + +static void Evaluate_Node( int thisNode ) + /**********************************************************************/ + /* Recursively evaluate thisNode's subNodes, then call one of the */ + /* Do_ functions pointed to by thisNode's DoOp element. */ + /**********************************************************************/ +{ + Node *this; + int i; + + if( gParse.status ) return; + + this = gParse.Nodes + thisNode; + if( this->operation>0 ) { /* <=0 indicate constants and columns */ + i = this->nSubNodes; + while( i-- ) { + Evaluate_Node( this->SubNodes[i] ); + if( gParse.status ) return; + } + this->DoOp( this ); + } +} + +static void Allocate_Ptrs( Node *this ) +{ + long elem, row, size; + + if( this->type==BITSTR || this->type==STRING ) { + + this->value.data.strptr = (char**)malloc( gParse.nRows + * sizeof(char*) ); + if( this->value.data.strptr ) { + this->value.data.strptr[0] = (char*)malloc( gParse.nRows + * (this->value.nelem+2) + * sizeof(char) ); + if( this->value.data.strptr[0] ) { + row = 0; + while( (++row)value.data.strptr[row] = + this->value.data.strptr[row-1] + this->value.nelem+1; + } + if( this->type==STRING ) { + this->value.undef = this->value.data.strptr[row-1] + + this->value.nelem+1; + } else { + this->value.undef = NULL; /* BITSTRs don't use undef array */ + } + } else { + gParse.status = MEMORY_ALLOCATION; + free( this->value.data.strptr ); + } + } else { + gParse.status = MEMORY_ALLOCATION; + } + + } else { + + elem = this->value.nelem * gParse.nRows; + switch( this->type ) { + case DOUBLE: size = sizeof( double ); break; + case LONG: size = sizeof( long ); break; + case BOOLEAN: size = sizeof( char ); break; + default: size = 1; break; + } + + this->value.data.ptr = malloc( elem*(size+1) ); + + if( this->value.data.ptr==NULL ) { + gParse.status = MEMORY_ALLOCATION; + } else { + this->value.undef = (char *)this->value.data.ptr + elem*size; + } + } +} + +static void Do_Unary( Node *this ) +{ + Node *that; + long elem; + + that = gParse.Nodes + this->SubNodes[0]; + + if( that->operation==CONST_OP ) { /* Operating on a constant! */ + switch( this->operation ) { + case DOUBLE: + case FLTCAST: + if( that->type==LONG ) + this->value.data.dbl = (double)that->value.data.lng; + else if( that->type==BOOLEAN ) + this->value.data.dbl = ( that->value.data.log ? 1.0 : 0.0 ); + break; + case LONG: + case INTCAST: + if( that->type==DOUBLE ) + this->value.data.lng = (long)that->value.data.dbl; + else if( that->type==BOOLEAN ) + this->value.data.lng = ( that->value.data.log ? 1L : 0L ); + break; + case BOOLEAN: + if( that->type==DOUBLE ) + this->value.data.log = ( that->value.data.dbl != 0.0 ); + else if( that->type==LONG ) + this->value.data.log = ( that->value.data.lng != 0L ); + break; + case UMINUS: + if( that->type==DOUBLE ) + this->value.data.dbl = - that->value.data.dbl; + else if( that->type==LONG ) + this->value.data.lng = - that->value.data.lng; + break; + case NOT: + if( that->type==BOOLEAN ) + this->value.data.log = ( ! that->value.data.log ); + else if( that->type==BITSTR ) + bitnot( this->value.data.str, that->value.data.str ); + break; + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + if( this->type!=BITSTR ) { + elem = gParse.nRows; + if( this->type!=STRING ) + elem *= this->value.nelem; + while( elem-- ) + this->value.undef[elem] = that->value.undef[elem]; + } + + elem = gParse.nRows * this->value.nelem; + + switch( this->operation ) { + + case BOOLEAN: + if( that->type==DOUBLE ) + while( elem-- ) + this->value.data.logptr[elem] = + ( that->value.data.dblptr[elem] != 0.0 ); + else if( that->type==LONG ) + while( elem-- ) + this->value.data.logptr[elem] = + ( that->value.data.lngptr[elem] != 0L ); + break; + + case DOUBLE: + case FLTCAST: + if( that->type==LONG ) + while( elem-- ) + this->value.data.dblptr[elem] = + (double)that->value.data.lngptr[elem]; + else if( that->type==BOOLEAN ) + while( elem-- ) + this->value.data.dblptr[elem] = + ( that->value.data.logptr[elem] ? 1.0 : 0.0 ); + break; + + case LONG: + case INTCAST: + if( that->type==DOUBLE ) + while( elem-- ) + this->value.data.lngptr[elem] = + (long)that->value.data.dblptr[elem]; + else if( that->type==BOOLEAN ) + while( elem-- ) + this->value.data.lngptr[elem] = + ( that->value.data.logptr[elem] ? 1L : 0L ); + break; + + case UMINUS: + if( that->type==DOUBLE ) { + while( elem-- ) + this->value.data.dblptr[elem] = + - that->value.data.dblptr[elem]; + } else if( that->type==LONG ) { + while( elem-- ) + this->value.data.lngptr[elem] = + - that->value.data.lngptr[elem]; + } + break; + + case NOT: + if( that->type==BOOLEAN ) { + while( elem-- ) + this->value.data.logptr[elem] = + ( ! that->value.data.logptr[elem] ); + } else if( that->type==BITSTR ) { + elem = gParse.nRows; + while( elem-- ) + bitnot( this->value.data.strptr[elem], + that->value.data.strptr[elem] ); + } + break; + } + } + } + + if( that->operation>0 ) { + free( that->value.data.ptr ); + } +} + +static void Do_Offset( Node *this ) +{ + Node *col; + long fRow, nRowOverlap, nRowReload, rowOffset; + long nelem, elem, offset, nRealElem; + int status; + + col = gParse.Nodes + this->SubNodes[0]; + rowOffset = gParse.Nodes[ this->SubNodes[1] ].value.data.lng; + + Allocate_Ptrs( this ); + + fRow = gParse.firstRow + rowOffset; + if( this->type==STRING || this->type==BITSTR ) + nRealElem = 1; + else + nRealElem = this->value.nelem; + + nelem = nRealElem; + + if( fRow < gParse.firstDataRow ) { + + /* Must fill in data at start of array */ + + nRowReload = gParse.firstDataRow - fRow; + if( nRowReload > gParse.nRows ) nRowReload = gParse.nRows; + nRowOverlap = gParse.nRows - nRowReload; + + offset = 0; + + /* NULLify any values falling out of bounds */ + + while( fRow<1 && nRowReload>0 ) { + if( this->type == BITSTR ) { + nelem = this->value.nelem; + this->value.data.strptr[offset][ nelem ] = '\0'; + while( nelem-- ) this->value.data.strptr[offset][nelem] = '0'; + offset++; + } else { + while( nelem-- ) + this->value.undef[offset++] = 1; + } + nelem = nRealElem; + fRow++; + nRowReload--; + } + + } else if( fRow + gParse.nRows > gParse.firstDataRow + gParse.nDataRows ) { + + /* Must fill in data at end of array */ + + nRowReload = (fRow+gParse.nRows) - (gParse.firstDataRow+gParse.nDataRows); + if( nRowReload>gParse.nRows ) { + nRowReload = gParse.nRows; + } else { + fRow = gParse.firstDataRow + gParse.nDataRows; + } + nRowOverlap = gParse.nRows - nRowReload; + + offset = nRowOverlap * nelem; + + /* NULLify any values falling out of bounds */ + + elem = gParse.nRows * nelem; + while( fRow+nRowReload>gParse.totalRows && nRowReload>0 ) { + if( this->type == BITSTR ) { + nelem = this->value.nelem; + elem--; + this->value.data.strptr[elem][ nelem ] = '\0'; + while( nelem-- ) this->value.data.strptr[elem][nelem] = '0'; + } else { + while( nelem-- ) + this->value.undef[--elem] = 1; + } + nelem = nRealElem; + nRowReload--; + } + + } else { + + nRowReload = 0; + nRowOverlap = gParse.nRows; + offset = 0; + + } + + if( nRowReload>0 ) { + switch( this->type ) { + case BITSTR: + case STRING: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.strptr+offset, + this->value.undef+offset ); + break; + case BOOLEAN: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.logptr+offset, + this->value.undef+offset ); + break; + case LONG: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.lngptr+offset, + this->value.undef+offset ); + break; + case DOUBLE: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.dblptr+offset, + this->value.undef+offset ); + break; + } + } + + /* Now copy over the overlapping region, if any */ + + if( nRowOverlap <= 0 ) return; + + if( rowOffset>0 ) + elem = nRowOverlap * nelem; + else + elem = gParse.nRows * nelem; + + offset = nelem * rowOffset; + while( nRowOverlap-- && !gParse.status ) { + while( nelem-- && !gParse.status ) { + elem--; + if( this->type != BITSTR ) + this->value.undef[elem] = col->value.undef[elem+offset]; + switch( this->type ) { + case BITSTR: + strcpy( this->value.data.strptr[elem ], + col->value.data.strptr[elem+offset] ); + break; + case STRING: + strcpy( this->value.data.strptr[elem ], + col->value.data.strptr[elem+offset] ); + break; + case BOOLEAN: + this->value.data.logptr[elem] = col->value.data.logptr[elem+offset]; + break; + case LONG: + this->value.data.lngptr[elem] = col->value.data.lngptr[elem+offset]; + break; + case DOUBLE: + this->value.data.dblptr[elem] = col->value.data.dblptr[elem+offset]; + break; + } + } + nelem = nRealElem; + } +} + +static void Do_BinOp_bit( Node *this ) +{ + Node *that1, *that2; + char *sptr1=NULL, *sptr2=NULL; + int const1, const2; + long rows; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + const1 = ( that1->operation==CONST_OP ); + const2 = ( that2->operation==CONST_OP ); + sptr1 = ( const1 ? that1->value.data.str : NULL ); + sptr2 = ( const2 ? that2->value.data.str : NULL ); + + if( const1 && const2 ) { + switch( this->operation ) { + case NE: + this->value.data.log = !bitcmp( sptr1, sptr2 ); + break; + case EQ: + this->value.data.log = bitcmp( sptr1, sptr2 ); + break; + case GT: + case LT: + case LTE: + case GTE: + this->value.data.log = bitlgte( sptr1, this->operation, sptr2 ); + break; + case '|': + bitor( this->value.data.str, sptr1, sptr2 ); + break; + case '&': + bitand( this->value.data.str, sptr1, sptr2 ); + break; + case '+': + strcpy( this->value.data.str, sptr1 ); + strcat( this->value.data.str, sptr2 ); + break; + case ACCUM: + this->value.data.lng = 0; + while( *sptr1 ) { + if ( *sptr1 == '1' ) this->value.data.lng ++; + sptr1 ++; + } + break; + + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + rows = gParse.nRows; + switch( this->operation ) { + + /* BITSTR comparisons */ + + case NE: + case EQ: + case GT: + case LT: + case LTE: + case GTE: + while( rows-- ) { + if( !const1 ) + sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) + sptr2 = that2->value.data.strptr[rows]; + switch( this->operation ) { + case NE: this->value.data.logptr[rows] = + !bitcmp( sptr1, sptr2 ); + break; + case EQ: this->value.data.logptr[rows] = + bitcmp( sptr1, sptr2 ); + break; + case GT: + case LT: + case LTE: + case GTE: this->value.data.logptr[rows] = + bitlgte( sptr1, this->operation, sptr2 ); + break; + } + this->value.undef[rows] = 0; + } + break; + + /* BITSTR AND/ORs ... no UNDEFS in or out */ + + case '|': + case '&': + case '+': + while( rows-- ) { + if( !const1 ) + sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) + sptr2 = that2->value.data.strptr[rows]; + if( this->operation=='|' ) + bitor( this->value.data.strptr[rows], sptr1, sptr2 ); + else if( this->operation=='&' ) + bitand( this->value.data.strptr[rows], sptr1, sptr2 ); + else { + strcpy( this->value.data.strptr[rows], sptr1 ); + strcat( this->value.data.strptr[rows], sptr2 ); + } + } + break; + + /* Accumulate 1 bits */ + case ACCUM: + { + long i, previous, curr; + + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.data.strptr[i]; + for (curr = 0; *sptr1; sptr1 ++) { + if ( *sptr1 == '1' ) curr ++; + } + previous += curr; + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + } + } + } + } + + if( that1->operation>0 ) { + free( that1->value.data.strptr[0] ); + free( that1->value.data.strptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.strptr[0] ); + free( that2->value.data.strptr ); + } +} + +static void Do_BinOp_str( Node *this ) +{ + Node *that1, *that2; + char *sptr1, *sptr2, null1=0, null2=0; + int const1, const2, val; + long rows; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + const1 = ( that1->operation==CONST_OP ); + const2 = ( that2->operation==CONST_OP ); + sptr1 = ( const1 ? that1->value.data.str : NULL ); + sptr2 = ( const2 ? that2->value.data.str : NULL ); + + if( const1 && const2 ) { /* Result is a constant */ + switch( this->operation ) { + + /* Compare Strings */ + + case NE: + case EQ: + val = ( FSTRCMP( sptr1, sptr2 ) == 0 ); + this->value.data.log = ( this->operation==EQ ? val : !val ); + break; + case GT: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) > 0 ); + break; + case LT: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) < 0 ); + break; + case GTE: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) >= 0 ); + break; + case LTE: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) <= 0 ); + break; + + /* Concat Strings */ + + case '+': + strcpy( this->value.data.str, sptr1 ); + strcat( this->value.data.str, sptr2 ); + break; + } + this->operation = CONST_OP; + + } else { /* Not a constant */ + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + rows = gParse.nRows; + switch( this->operation ) { + + /* Compare Strings */ + + case NE: + case EQ: + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + val = ( FSTRCMP( sptr1, sptr2 ) == 0 ); + this->value.data.logptr[rows] = + ( this->operation==EQ ? val : !val ); + } + } + break; + + case GT: + case LT: + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + val = ( FSTRCMP( sptr1, sptr2 ) ); + this->value.data.logptr[rows] = + ( this->operation==GT ? val>0 : val<0 ); + } + } + break; + + case GTE: + case LTE: + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + val = ( FSTRCMP( sptr1, sptr2 ) ); + this->value.data.logptr[rows] = + ( this->operation==GTE ? val>=0 : val<=0 ); + } + } + break; + + /* Concat Strings */ + + case '+': + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + strcpy( this->value.data.strptr[rows], sptr1 ); + strcat( this->value.data.strptr[rows], sptr2 ); + } + } + break; + } + } + } + + if( that1->operation>0 ) { + free( that1->value.data.strptr[0] ); + free( that1->value.data.strptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.strptr[0] ); + free( that2->value.data.strptr ); + } +} + +static void Do_BinOp_log( Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + char val1=0, val2=0, null1=0, null2=0; + long rows, nelem, elem; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + vector1 = ( that1->operation!=CONST_OP ); + if( vector1 ) + vector1 = that1->value.nelem; + else { + val1 = that1->value.data.log; + } + + vector2 = ( that2->operation!=CONST_OP ); + if( vector2 ) + vector2 = that2->value.nelem; + else { + val2 = that2->value.data.log; + } + + if( !vector1 && !vector2 ) { /* Result is a constant */ + switch( this->operation ) { + case OR: + this->value.data.log = (val1 || val2); + break; + case AND: + this->value.data.log = (val1 && val2); + break; + case EQ: + this->value.data.log = ( (val1 && val2) || (!val1 && !val2) ); + break; + case NE: + this->value.data.log = ( (val1 && !val2) || (!val1 && val2) ); + break; + case ACCUM: + this->value.data.lng = val1; + break; + } + this->operation=CONST_OP; + } else if (this->operation == ACCUM) { + long i, previous, curr; + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.logptr[i]; + previous += curr; + } + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + } + + } else { + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + if (this->operation == ACCUM) { + long i, previous, curr; + + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.logptr[i]; + previous += curr; + } + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + } + + while( rows-- ) { + while( nelem-- ) { + elem--; + + if( vector1>1 ) { + val1 = that1->value.data.logptr[elem]; + null1 = that1->value.undef[elem]; + } else if( vector1 ) { + val1 = that1->value.data.logptr[rows]; + null1 = that1->value.undef[rows]; + } + + if( vector2>1 ) { + val2 = that2->value.data.logptr[elem]; + null2 = that2->value.undef[elem]; + } else if( vector2 ) { + val2 = that2->value.data.logptr[rows]; + null2 = that2->value.undef[rows]; + } + + this->value.undef[elem] = (null1 || null2); + switch( this->operation ) { + + case OR: + /* This is more complicated than others to suppress UNDEFs */ + /* in those cases where the other argument is DEF && TRUE */ + + if( !null1 && !null2 ) { + this->value.data.logptr[elem] = (val1 || val2); + } else if( (null1 && !null2 && val2) + || ( !null1 && null2 && val1 ) ) { + this->value.data.logptr[elem] = 1; + this->value.undef[elem] = 0; + } + break; + + case AND: + /* This is more complicated than others to suppress UNDEFs */ + /* in those cases where the other argument is DEF && FALSE */ + + if( !null1 && !null2 ) { + this->value.data.logptr[elem] = (val1 && val2); + } else if( (null1 && !null2 && !val2) + || ( !null1 && null2 && !val1 ) ) { + this->value.data.logptr[elem] = 0; + this->value.undef[elem] = 0; + } + break; + + case EQ: + this->value.data.logptr[elem] = + ( (val1 && val2) || (!val1 && !val2) ); + break; + + case NE: + this->value.data.logptr[elem] = + ( (val1 && !val2) || (!val1 && val2) ); + break; + } + } + nelem = this->value.nelem; + } + } + } + + if( that1->operation>0 ) { + free( that1->value.data.ptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.ptr ); + } +} + +static void Do_BinOp_lng( Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + long val1=0, val2=0; + char null1=0, null2=0; + long rows, nelem, elem; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + vector1 = ( that1->operation!=CONST_OP ); + if( vector1 ) + vector1 = that1->value.nelem; + else { + val1 = that1->value.data.lng; + } + + vector2 = ( that2->operation!=CONST_OP ); + if( vector2 ) + vector2 = that2->value.nelem; + else { + val2 = that2->value.data.lng; + } + + if( !vector1 && !vector2 ) { /* Result is a constant */ + + switch( this->operation ) { + case '~': /* Treat as == for LONGS */ + case EQ: this->value.data.log = (val1 == val2); break; + case NE: this->value.data.log = (val1 != val2); break; + case GT: this->value.data.log = (val1 > val2); break; + case LT: this->value.data.log = (val1 < val2); break; + case LTE: this->value.data.log = (val1 <= val2); break; + case GTE: this->value.data.log = (val1 >= val2); break; + + case '+': this->value.data.lng = (val1 + val2); break; + case '-': this->value.data.lng = (val1 - val2); break; + case '*': this->value.data.lng = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.lng = (val1 % val2); + else yyerror("Divide by Zero"); + break; + case '/': + if( val2 ) this->value.data.lng = (val1 / val2); + else yyerror("Divide by Zero"); + break; + case POWER: + this->value.data.lng = (long)pow((double)val1,(double)val2); + break; + case ACCUM: + this->value.data.lng = val1; + break; + case DIFF: + this->value.data.lng = 0; + break; + } + this->operation=CONST_OP; + + } else if ((this->operation == ACCUM) || (this->operation == DIFF)) { + long i, previous, curr; + int undef; + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + previous = that2->value.data.lng; + undef = (int) that2->value.undef; + + if (this->operation == ACCUM) { + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.lngptr[i]; + previous += curr; + } + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + } else { + /* Sequential difference for this chunk */ + for (i=0; ivalue.data.lngptr[i]; + if (that1->value.undef[i] || undef) { + /* Either this, or previous, value was undefined */ + this->value.data.lngptr[i] = 0; + this->value.undef[i] = 1; + } else { + /* Both defined, we are okay! */ + this->value.data.lngptr[i] = curr - previous; + this->value.undef[i] = 0; + } + + previous = curr; + undef = that1->value.undef[i]; + } + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + that2->value.undef = (char *) undef; /* XXX evil, but no harm here */ + } + + } else { + + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + while( rows-- && !gParse.status ) { + while( nelem-- && !gParse.status ) { + elem--; + + if( vector1>1 ) { + val1 = that1->value.data.lngptr[elem]; + null1 = that1->value.undef[elem]; + } else if( vector1 ) { + val1 = that1->value.data.lngptr[rows]; + null1 = that1->value.undef[rows]; + } + + if( vector2>1 ) { + val2 = that2->value.data.lngptr[elem]; + null2 = that2->value.undef[elem]; + } else if( vector2 ) { + val2 = that2->value.data.lngptr[rows]; + null2 = that2->value.undef[rows]; + } + + this->value.undef[elem] = (null1 || null2); + switch( this->operation ) { + case '~': /* Treat as == for LONGS */ + case EQ: this->value.data.logptr[elem] = (val1 == val2); break; + case NE: this->value.data.logptr[elem] = (val1 != val2); break; + case GT: this->value.data.logptr[elem] = (val1 > val2); break; + case LT: this->value.data.logptr[elem] = (val1 < val2); break; + case LTE: this->value.data.logptr[elem] = (val1 <= val2); break; + case GTE: this->value.data.logptr[elem] = (val1 >= val2); break; + + case '+': this->value.data.lngptr[elem] = (val1 + val2); break; + case '-': this->value.data.lngptr[elem] = (val1 - val2); break; + case '*': this->value.data.lngptr[elem] = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.lngptr[elem] = (val1 % val2); + else { + this->value.data.lngptr[elem] = 0; + this->value.undef[elem] = 1; + } + break; + case '/': + if( val2 ) this->value.data.lngptr[elem] = (val1 / val2); + else { + this->value.data.lngptr[elem] = 0; + this->value.undef[elem] = 1; + } + break; + case POWER: + this->value.data.lngptr[elem] = (long)pow((double)val1,(double)val2); + break; + } + } + nelem = this->value.nelem; + } + } + + if( that1->operation>0 ) { + free( that1->value.data.ptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.ptr ); + } +} + +static void Do_BinOp_dbl( Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + double val1=0.0, val2=0.0; + char null1=0, null2=0; + long rows, nelem, elem; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + vector1 = ( that1->operation!=CONST_OP ); + if( vector1 ) + vector1 = that1->value.nelem; + else { + val1 = that1->value.data.dbl; + } + + vector2 = ( that2->operation!=CONST_OP ); + if( vector2 ) + vector2 = that2->value.nelem; + else { + val2 = that2->value.data.dbl; + } + + if( !vector1 && !vector2 ) { /* Result is a constant */ + + switch( this->operation ) { + case '~': this->value.data.log = ( fabs(val1-val2) < APPROX ); break; + case EQ: this->value.data.log = (val1 == val2); break; + case NE: this->value.data.log = (val1 != val2); break; + case GT: this->value.data.log = (val1 > val2); break; + case LT: this->value.data.log = (val1 < val2); break; + case LTE: this->value.data.log = (val1 <= val2); break; + case GTE: this->value.data.log = (val1 >= val2); break; + + case '+': this->value.data.dbl = (val1 + val2); break; + case '-': this->value.data.dbl = (val1 - val2); break; + case '*': this->value.data.dbl = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.dbl = val1 - val2*((int)(val1/val2)); + else yyerror("Divide by Zero"); + break; + case '/': + if( val2 ) this->value.data.dbl = (val1 / val2); + else yyerror("Divide by Zero"); + break; + case POWER: + this->value.data.dbl = (double)pow(val1,val2); + break; + case ACCUM: + this->value.data.dbl = val1; + break; + case DIFF: + this->value.data.dbl = 0; + break; + } + this->operation=CONST_OP; + + } else if ((this->operation == ACCUM) || (this->operation == DIFF)) { + long i; + int undef; + double previous, curr; + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + previous = that2->value.data.dbl; + undef = (int) that2->value.undef; + + if (this->operation == ACCUM) { + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.dblptr[i]; + previous += curr; + } + this->value.data.dblptr[i] = previous; + this->value.undef[i] = 0; + } + } else { + /* Sequential difference for this chunk */ + for (i=0; ivalue.data.dblptr[i]; + if (that1->value.undef[i] || undef) { + /* Either this, or previous, value was undefined */ + this->value.data.dblptr[i] = 0; + this->value.undef[i] = 1; + } else { + /* Both defined, we are okay! */ + this->value.data.dblptr[i] = curr - previous; + this->value.undef[i] = 0; + } + + previous = curr; + undef = that1->value.undef[i]; + } + } + + /* Store final cumulant for next pass */ + that2->value.data.dbl = previous; + that2->value.undef = (char *) undef; /* XXX evil, but no harm here */ + } + + } else { + + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + while( rows-- && !gParse.status ) { + while( nelem-- && !gParse.status ) { + elem--; + + if( vector1>1 ) { + val1 = that1->value.data.dblptr[elem]; + null1 = that1->value.undef[elem]; + } else if( vector1 ) { + val1 = that1->value.data.dblptr[rows]; + null1 = that1->value.undef[rows]; + } + + if( vector2>1 ) { + val2 = that2->value.data.dblptr[elem]; + null2 = that2->value.undef[elem]; + } else if( vector2 ) { + val2 = that2->value.data.dblptr[rows]; + null2 = that2->value.undef[rows]; + } + + this->value.undef[elem] = (null1 || null2); + switch( this->operation ) { + case '~': this->value.data.logptr[elem] = + ( fabs(val1-val2) < APPROX ); break; + case EQ: this->value.data.logptr[elem] = (val1 == val2); break; + case NE: this->value.data.logptr[elem] = (val1 != val2); break; + case GT: this->value.data.logptr[elem] = (val1 > val2); break; + case LT: this->value.data.logptr[elem] = (val1 < val2); break; + case LTE: this->value.data.logptr[elem] = (val1 <= val2); break; + case GTE: this->value.data.logptr[elem] = (val1 >= val2); break; + + case '+': this->value.data.dblptr[elem] = (val1 + val2); break; + case '-': this->value.data.dblptr[elem] = (val1 - val2); break; + case '*': this->value.data.dblptr[elem] = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.dblptr[elem] = + val1 - val2*((int)(val1/val2)); + else { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } + break; + case '/': + if( val2 ) this->value.data.dblptr[elem] = (val1 / val2); + else { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } + break; + case POWER: + this->value.data.dblptr[elem] = (double)pow(val1,val2); + break; + } + } + nelem = this->value.nelem; + } + } + + if( that1->operation>0 ) { + free( that1->value.data.ptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.ptr ); + } +} + +/* + * This Quickselect routine is based on the algorithm described in + * "Numerical recipes in C", Second Edition, + * Cambridge University Press, 1992, Section 8.5, ISBN 0-521-43108-5 + * This code by Nicolas Devillard - 1998. Public domain. + * http://ndevilla.free.fr/median/median/src/quickselect.c + */ + +#define ELEM_SWAP(a,b) { register long t=(a);(a)=(b);(b)=t; } + +/* + * qselect_median_lng - select the median value of a long array + * + * This routine selects the median value of the long integer array + * arr[]. If there are an even number of elements, the "lower median" + * is selected. + * + * The array arr[] is scrambled, so users must operate on a scratch + * array if they wish the values to be preserved. + * + * long arr[] - array of values + * int n - number of elements in arr + * + * RETURNS: the lower median value of arr[] + * + */ +long qselect_median_lng(long arr[], int n) +{ + int low, high ; + int median; + int middle, ll, hh; + + low = 0 ; high = n-1 ; median = (low + high) / 2; + for (;;) { + + if (high <= low) { /* One element only */ + return arr[median]; + } + + if (high == low + 1) { /* Two elements only */ + if (arr[low] > arr[high]) + ELEM_SWAP(arr[low], arr[high]) ; + return arr[median]; + } + + /* Find median of low, middle and high items; swap into position low */ + middle = (low + high) / 2; + if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ; + if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ; + if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ; + + /* Swap low item (now in position middle) into position (low+1) */ + ELEM_SWAP(arr[middle], arr[low+1]) ; + + /* Nibble from each end towards middle, swapping items when stuck */ + ll = low + 1; + hh = high; + for (;;) { + do ll++; while (arr[low] > arr[ll]) ; + do hh--; while (arr[hh] > arr[low]) ; + + if (hh < ll) + break; + + ELEM_SWAP(arr[ll], arr[hh]) ; + } + + /* Swap middle item (in position low) back into correct position */ + ELEM_SWAP(arr[low], arr[hh]) ; + + /* Re-set active partition */ + if (hh <= median) + low = ll; + if (hh >= median) + high = hh - 1; + } +} + +#undef ELEM_SWAP + +#define ELEM_SWAP(a,b) { register double t=(a);(a)=(b);(b)=t; } + +/* + * qselect_median_dbl - select the median value of a double array + * + * This routine selects the median value of the double array + * arr[]. If there are an even number of elements, the "lower median" + * is selected. + * + * The array arr[] is scrambled, so users must operate on a scratch + * array if they wish the values to be preserved. + * + * double arr[] - array of values + * int n - number of elements in arr + * + * RETURNS: the lower median value of arr[] + * + */ +double qselect_median_dbl(double arr[], int n) +{ + int low, high ; + int median; + int middle, ll, hh; + + low = 0 ; high = n-1 ; median = (low + high) / 2; + for (;;) { + if (high <= low) { /* One element only */ + return arr[median] ; + } + + if (high == low + 1) { /* Two elements only */ + if (arr[low] > arr[high]) + ELEM_SWAP(arr[low], arr[high]) ; + return arr[median] ; + } + + /* Find median of low, middle and high items; swap into position low */ + middle = (low + high) / 2; + if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ; + if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ; + if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ; + + /* Swap low item (now in position middle) into position (low+1) */ + ELEM_SWAP(arr[middle], arr[low+1]) ; + + /* Nibble from each end towards middle, swapping items when stuck */ + ll = low + 1; + hh = high; + for (;;) { + do ll++; while (arr[low] > arr[ll]) ; + do hh--; while (arr[hh] > arr[low]) ; + + if (hh < ll) + break; + + ELEM_SWAP(arr[ll], arr[hh]) ; + } + + /* Swap middle item (in position low) back into correct position */ + ELEM_SWAP(arr[low], arr[hh]) ; + + /* Re-set active partition */ + if (hh <= median) + low = ll; + if (hh >= median) + high = hh - 1; + } +} + +#undef ELEM_SWAP + +static void Do_Func( Node *this ) +{ + Node *theParams[MAXSUBS]; + int vector[MAXSUBS], allConst; + lval pVals[MAXSUBS]; + char pNull[MAXSUBS]; + long ival; + double dval; + int i, valInit; + long row, elem, nelem; + double rndVal; + + i = this->nSubNodes; + allConst = 1; + while( i-- ) { + theParams[i] = gParse.Nodes + this->SubNodes[i]; + vector[i] = ( theParams[i]->operation!=CONST_OP ); + if( vector[i] ) { + allConst = 0; + vector[i] = theParams[i]->value.nelem; + } else { + if( theParams[i]->type==DOUBLE ) { + pVals[i].data.dbl = theParams[i]->value.data.dbl; + } else if( theParams[i]->type==LONG ) { + pVals[i].data.lng = theParams[i]->value.data.lng; + } else if( theParams[i]->type==BOOLEAN ) { + pVals[i].data.log = theParams[i]->value.data.log; + } else + strcpy(pVals[i].data.str, theParams[i]->value.data.str); + pNull[i] = 0; + } + } + + if( this->nSubNodes==0 ) allConst = 0; /* These do produce scalars */ + + if( allConst ) { + + switch( this->operation ) { + + /* Non-Trig single-argument functions */ + + case sum_fct: + if( theParams[0]->type==BOOLEAN ) + this->value.data.lng = ( pVals[0].data.log ? 1 : 0 ); + else if( theParams[0]->type==LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( theParams[0]->type==DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( theParams[0]->type==BITSTR ) + strcpy(this->value.data.str, pVals[0].data.str); + break; + case average_fct: + if( theParams[0]->type==LONG ) + this->value.data.dbl = pVals[0].data.lng; + else if( theParams[0]->type==DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + break; + case stddev_fct: + this->value.data.dbl = 0; /* Standard deviation of a constant = 0 */ + break; + case median_fct: + if( theParams[0]->type==BOOLEAN ) + this->value.data.lng = ( pVals[0].data.log ? 1 : 0 ); + else if( theParams[0]->type==LONG ) + this->value.data.lng = pVals[0].data.lng; + else + this->value.data.dbl = pVals[0].data.dbl; + break; + case abs_fct: + if( theParams[0]->type==DOUBLE ) { + dval = pVals[0].data.dbl; + this->value.data.dbl = (dval>0.0 ? dval : -dval); + } else { + ival = pVals[0].data.lng; + this->value.data.lng = (ival> 0 ? ival : -ival); + } + break; + + /* Special Null-Handling Functions */ + + case nonnull_fct: + this->value.data.lng = 1; /* Constants are always 1-element and defined */ + break; + case isnull_fct: /* Constants are always defined */ + this->value.data.log = 0; + break; + case defnull_fct: + if( this->type==BOOLEAN ) + this->value.data.log = pVals[0].data.log; + else if( this->type==LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( this->type==DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( this->type==STRING ) + strcpy(this->value.data.str,pVals[0].data.str); + break; + + /* Math functions with 1 double argument */ + + case sin_fct: + this->value.data.dbl = sin( pVals[0].data.dbl ); + break; + case cos_fct: + this->value.data.dbl = cos( pVals[0].data.dbl ); + break; + case tan_fct: + this->value.data.dbl = tan( pVals[0].data.dbl ); + break; + case asin_fct: + dval = pVals[0].data.dbl; + if( dval<-1.0 || dval>1.0 ) + yyerror("Out of range argument to arcsin"); + else + this->value.data.dbl = asin( dval ); + break; + case acos_fct: + dval = pVals[0].data.dbl; + if( dval<-1.0 || dval>1.0 ) + yyerror("Out of range argument to arccos"); + else + this->value.data.dbl = acos( dval ); + break; + case atan_fct: + this->value.data.dbl = atan( pVals[0].data.dbl ); + break; + case sinh_fct: + this->value.data.dbl = sinh( pVals[0].data.dbl ); + break; + case cosh_fct: + this->value.data.dbl = cosh( pVals[0].data.dbl ); + break; + case tanh_fct: + this->value.data.dbl = tanh( pVals[0].data.dbl ); + break; + case exp_fct: + this->value.data.dbl = exp( pVals[0].data.dbl ); + break; + case log_fct: + dval = pVals[0].data.dbl; + if( dval<=0.0 ) + yyerror("Out of range argument to log"); + else + this->value.data.dbl = log( dval ); + break; + case log10_fct: + dval = pVals[0].data.dbl; + if( dval<=0.0 ) + yyerror("Out of range argument to log10"); + else + this->value.data.dbl = log10( dval ); + break; + case sqrt_fct: + dval = pVals[0].data.dbl; + if( dval<0.0 ) + yyerror("Out of range argument to sqrt"); + else + this->value.data.dbl = sqrt( dval ); + break; + case ceil_fct: + this->value.data.dbl = ceil( pVals[0].data.dbl ); + break; + case floor_fct: + this->value.data.dbl = floor( pVals[0].data.dbl ); + break; + case round_fct: + this->value.data.dbl = floor( pVals[0].data.dbl + 0.5 ); + break; + + /* Two-argument Trig Functions */ + + case atan2_fct: + this->value.data.dbl = + atan2( pVals[0].data.dbl, pVals[1].data.dbl ); + break; + + /* Min/Max functions taking 1 or 2 arguments */ + + case min1_fct: + /* No constant vectors! */ + if( this->type == DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( this->type == LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( this->type == BITSTR ) + strcpy(this->value.data.str, pVals[0].data.str); + break; + case min2_fct: + if( this->type == DOUBLE ) + this->value.data.dbl = + minvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + else if( this->type == LONG ) + this->value.data.lng = + minvalue( pVals[0].data.lng, pVals[1].data.lng ); + break; + case max1_fct: + /* No constant vectors! */ + if( this->type == DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( this->type == LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( this->type == BITSTR ) + strcpy(this->value.data.str, pVals[0].data.str); + break; + case max2_fct: + if( this->type == DOUBLE ) + this->value.data.dbl = + maxvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + else if( this->type == LONG ) + this->value.data.lng = + maxvalue( pVals[0].data.lng, pVals[1].data.lng ); + break; + + /* Boolean SAO region Functions... all arguments scalar dbls */ + + case near_fct: + this->value.data.log = bnear( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl ); + break; + case circle_fct: + this->value.data.log = circle( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl ); + break; + case box_fct: + this->value.data.log = saobox( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + break; + case elps_fct: + this->value.data.log = + ellipse( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + break; + + /* C Conditional expression: bool ? expr : expr */ + + case ifthenelse_fct: + switch( this->type ) { + case BOOLEAN: + this->value.data.log = ( pVals[2].data.log ? + pVals[0].data.log : pVals[1].data.log ); + break; + case LONG: + this->value.data.lng = ( pVals[2].data.log ? + pVals[0].data.lng : pVals[1].data.lng ); + break; + case DOUBLE: + this->value.data.dbl = ( pVals[2].data.log ? + pVals[0].data.dbl : pVals[1].data.dbl ); + break; + case STRING: + strcpy(this->value.data.str, ( pVals[2].data.log ? + pVals[0].data.str : + pVals[1].data.str ) ); + break; + } + break; + + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + row = gParse.nRows; + elem = row * this->value.nelem; + + if( !gParse.status ) { + switch( this->operation ) { + + /* Special functions with no arguments */ + + case row_fct: + while( row-- ) { + this->value.data.lngptr[row] = gParse.firstRow + row; + this->value.undef[row] = 0; + } + break; + case null_fct: + if( this->type==LONG ) { + while( row-- ) { + this->value.data.lngptr[row] = 0; + this->value.undef[row] = 1; + } + } else if( this->type==STRING ) { + while( row-- ) { + this->value.data.strptr[row][0] = '\0'; + this->value.undef[row] = 1; + } + } + break; + case rnd_fct: + if( rand()<32768 && rand()<32768 ) + dval = 32768.0; + else + dval = 2147483648.0; + while( row-- ) { + rndVal = (double)rand(); + while( rndVal > dval ) dval *= 2.0; + this->value.data.dblptr[row] = rndVal/dval; + this->value.undef[row] = 0; + } + break; + + /* Non-Trig single-argument functions */ + + case sum_fct: + elem = row * theParams[0]->value.nelem; + if( theParams[0]->type==BOOLEAN ) { + while( row-- ) { + this->value.data.lngptr[row] = 0; + /* Default is UNDEF until a defined value is found */ + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( ! theParams[0]->value.undef[elem] ) { + this->value.data.lngptr[row] += + ( theParams[0]->value.data.logptr[elem] ? 1 : 0 ); + this->value.undef[row] = 0; + } + } + } + } else if( theParams[0]->type==LONG ) { + while( row-- ) { + this->value.data.lngptr[row] = 0; + /* Default is UNDEF until a defined value is found */ + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( ! theParams[0]->value.undef[elem] ) { + this->value.data.lngptr[row] += + theParams[0]->value.data.lngptr[elem]; + this->value.undef[row] = 0; + } + } + } + } else if( theParams[0]->type==DOUBLE ){ + while( row-- ) { + this->value.data.dblptr[row] = 0.0; + /* Default is UNDEF until a defined value is found */ + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( ! theParams[0]->value.undef[elem] ) { + this->value.data.dblptr[row] += + theParams[0]->value.data.dblptr[elem]; + this->value.undef[row] = 0; + } + } + } + } else { /* BITSTR */ + nelem = theParams[0]->value.nelem; + while( row-- ) { + char *sptr1 = theParams[0]->value.data.strptr[row]; + this->value.data.lngptr[row] = 0; + this->value.undef[row] = 0; + while (*sptr1) { + if (*sptr1 == '1') this->value.data.lngptr[row] ++; + sptr1++; + } + } + } + break; + + case average_fct: + elem = row * theParams[0]->value.nelem; + if( theParams[0]->type==LONG ) { + while( row-- ) { + int count = 0; + this->value.data.dblptr[row] = 0; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + this->value.data.dblptr[row] += + theParams[0]->value.data.lngptr[elem]; + count ++; + } + } + if (count == 0) { + this->value.undef[row] = 1; + } else { + this->value.undef[row] = 0; + this->value.data.dblptr[row] /= count; + } + } + } else if( theParams[0]->type==DOUBLE ){ + while( row-- ) { + int count = 0; + this->value.data.dblptr[row] = 0; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + this->value.data.dblptr[row] += + theParams[0]->value.data.dblptr[elem]; + count ++; + } + } + if (count == 0) { + this->value.undef[row] = 1; + } else { + this->value.undef[row] = 0; + this->value.data.dblptr[row] /= count; + } + } + } + break; + case stddev_fct: + elem = row * theParams[0]->value.nelem; + if( theParams[0]->type==LONG ) { + + /* Compute the mean value */ + while( row-- ) { + int count = 0; + double sum = 0, sum2 = 0; + + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + sum += theParams[0]->value.data.lngptr[elem]; + count ++; + } + } + if (count > 1) { + sum /= count; + + /* Compute the sum of squared deviations */ + nelem = theParams[0]->value.nelem; + elem += nelem; /* Reset elem for second pass */ + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + double dx = (theParams[0]->value.data.lngptr[elem] - sum); + sum2 += (dx*dx); + } + } + + sum2 /= (double)count-1; + + this->value.undef[row] = 0; + this->value.data.dblptr[row] = sqrt(sum2); + } else { + this->value.undef[row] = 0; /* STDDEV => 0 */ + this->value.data.dblptr[row] = 0; + } + } + } else if( theParams[0]->type==DOUBLE ){ + + /* Compute the mean value */ + while( row-- ) { + int count = 0; + double sum = 0, sum2 = 0; + + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + sum += theParams[0]->value.data.dblptr[elem]; + count ++; + } + } + if (count > 1) { + sum /= count; + + /* Compute the sum of squared deviations */ + nelem = theParams[0]->value.nelem; + elem += nelem; /* Reset elem for second pass */ + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + double dx = (theParams[0]->value.data.dblptr[elem] - sum); + sum2 += (dx*dx); + } + } + + sum2 /= (double)count-1; + + this->value.undef[row] = 0; + this->value.data.dblptr[row] = sqrt(sum2); + } else { + this->value.undef[row] = 0; /* STDDEV => 0 */ + this->value.data.dblptr[row] = 0; + } + } + } + break; + + case median_fct: + elem = row * theParams[0]->value.nelem; + nelem = theParams[0]->value.nelem; + if( theParams[0]->type==LONG ) { + long *dptr = theParams[0]->value.data.lngptr; + char *uptr = theParams[0]->value.undef; + long *mptr = (long *) malloc(sizeof(long)*nelem); + int irow; + + /* Allocate temporary storage for this row, since the + quickselect function will scramble the contents */ + if (mptr == 0) { + yyerror("Could not allocate temporary memory in median function"); + free( this->value.data.ptr ); + break; + } + + for (irow=0; irow 0) { + this->value.undef[irow] = 0; + this->value.data.lngptr[irow] = qselect_median_lng(mptr, nelem1); + } else { + this->value.undef[irow] = 1; + this->value.data.lngptr[irow] = 0; + } + + } + + free(mptr); + } else { + double *dptr = theParams[0]->value.data.dblptr; + char *uptr = theParams[0]->value.undef; + double *mptr = (double *) malloc(sizeof(double)*nelem); + int irow; + + /* Allocate temporary storage for this row, since the + quickselect function will scramble the contents */ + if (mptr == 0) { + yyerror("Could not allocate temporary memory in median function"); + free( this->value.data.ptr ); + break; + } + + for (irow=0; irow 0) { + this->value.undef[irow] = 0; + this->value.data.dblptr[irow] = qselect_median_dbl(mptr, nelem1); + } else { + this->value.undef[irow] = 1; + this->value.data.dblptr[irow] = 0; + } + + } + free(mptr); + } + break; + case abs_fct: + if( theParams[0]->type==DOUBLE ) + while( elem-- ) { + dval = theParams[0]->value.data.dblptr[elem]; + this->value.data.dblptr[elem] = (dval>0.0 ? dval : -dval); + this->value.undef[elem] = theParams[0]->value.undef[elem]; + } + else + while( elem-- ) { + ival = theParams[0]->value.data.lngptr[elem]; + this->value.data.lngptr[elem] = (ival> 0 ? ival : -ival); + this->value.undef[elem] = theParams[0]->value.undef[elem]; + } + break; + + /* Special Null-Handling Functions */ + + case nonnull_fct: + nelem = theParams[0]->value.nelem; + if ( theParams[0]->type==STRING ) nelem = 1; + elem = row * nelem; + while( row-- ) { + int nelem1 = nelem; + + this->value.undef[row] = 0; /* Initialize to 0 (defined) */ + this->value.data.lngptr[row] = 0; + while( nelem1-- ) { + elem --; + if ( theParams[0]->value.undef[elem] == 0 ) this->value.data.lngptr[row] ++; + } + } + break; + case isnull_fct: + if( theParams[0]->type==STRING ) elem = row; + while( elem-- ) { + this->value.data.logptr[elem] = theParams[0]->value.undef[elem]; + this->value.undef[elem] = 0; + } + break; + case defnull_fct: + switch( this->type ) { + case BOOLEAN: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pNull[i] = theParams[i]->value.undef[elem]; + pVals[i].data.log = + theParams[i]->value.data.logptr[elem]; + } else if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + pVals[i].data.log = + theParams[i]->value.data.logptr[row]; + } + if( pNull[0] ) { + this->value.undef[elem] = pNull[1]; + this->value.data.logptr[elem] = pVals[1].data.log; + } else { + this->value.undef[elem] = 0; + this->value.data.logptr[elem] = pVals[0].data.log; + } + } + } + break; + case LONG: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pNull[i] = theParams[i]->value.undef[elem]; + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + } else if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + } + if( pNull[0] ) { + this->value.undef[elem] = pNull[1]; + this->value.data.lngptr[elem] = pVals[1].data.lng; + } else { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[0].data.lng; + } + } + } + break; + case DOUBLE: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pNull[i] = theParams[i]->value.undef[elem]; + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + } else if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + } + if( pNull[0] ) { + this->value.undef[elem] = pNull[1]; + this->value.data.dblptr[elem] = pVals[1].data.dbl; + } else { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[0].data.dbl; + } + } + } + break; + case STRING: + while( row-- ) { + i=2; while( i-- ) + if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + strcpy(pVals[i].data.str, + theParams[i]->value.data.strptr[row]); + } + if( pNull[0] ) { + this->value.undef[row] = pNull[1]; + strcpy(this->value.data.strptr[row],pVals[1].data.str); + } else { + this->value.undef[elem] = 0; + strcpy(this->value.data.strptr[row],pVals[0].data.str); + } + } + } + break; + + /* Math functions with 1 double argument */ + + case sin_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + sin( theParams[0]->value.data.dblptr[elem] ); + } + break; + case cos_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + cos( theParams[0]->value.data.dblptr[elem] ); + } + break; + case tan_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + tan( theParams[0]->value.data.dblptr[elem] ); + } + break; + case asin_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<-1.0 || dval>1.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = asin( dval ); + } + break; + case acos_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<-1.0 || dval>1.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = acos( dval ); + } + break; + case atan_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + this->value.data.dblptr[elem] = atan( dval ); + } + break; + case sinh_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + sinh( theParams[0]->value.data.dblptr[elem] ); + } + break; + case cosh_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + cosh( theParams[0]->value.data.dblptr[elem] ); + } + break; + case tanh_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + tanh( theParams[0]->value.data.dblptr[elem] ); + } + break; + case exp_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + this->value.data.dblptr[elem] = exp( dval ); + } + break; + case log_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<=0.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = log( dval ); + } + break; + case log10_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<=0.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = log10( dval ); + } + break; + case sqrt_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<0.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = sqrt( dval ); + } + break; + case ceil_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + ceil( theParams[0]->value.data.dblptr[elem] ); + } + break; + case floor_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + floor( theParams[0]->value.data.dblptr[elem] ); + } + break; + case round_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + floor( theParams[0]->value.data.dblptr[elem] + 0.5); + } + break; + + /* Two-argument Trig Functions */ + + case atan2_fct: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = (pNull[0] || pNull[1]) ) ) + this->value.data.dblptr[elem] = + atan2( pVals[0].data.dbl, pVals[1].data.dbl ); + } + } + break; + + /* Min/Max functions taking 1 or 2 arguments */ + + case min1_fct: + elem = row * theParams[0]->value.nelem; + if( this->type==LONG ) { + long minVal=0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + minVal = theParams[0]->value.data.lngptr[elem]; + } else { + minVal = minvalue( minVal, + theParams[0]->value.data.lngptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.lngptr[row] = minVal; + } + } else if( this->type==DOUBLE ) { + double minVal=0.0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + minVal = theParams[0]->value.data.dblptr[elem]; + } else { + minVal = minvalue( minVal, + theParams[0]->value.data.dblptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.dblptr[row] = minVal; + } + } else if( this->type==BITSTR ) { + char minVal; + while( row-- ) { + char *sptr1 = theParams[0]->value.data.strptr[row]; + minVal = '1'; + while (*sptr1) { + if (*sptr1 == '0') minVal = '0'; + sptr1++; + } + this->value.data.strptr[row][0] = minVal; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + } + break; + case min2_fct: + if( this->type==LONG ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.lngptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[1].data.lng; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[0].data.lng; + } else { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = + minvalue( pVals[0].data.lng, pVals[1].data.lng ); + } + } + } + } else if( this->type==DOUBLE ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.dblptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[1].data.dbl; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[0].data.dbl; + } else { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = + minvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + } + } + } + } + break; + + case max1_fct: + elem = row * theParams[0]->value.nelem; + if( this->type==LONG ) { + long maxVal=0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + maxVal = theParams[0]->value.data.lngptr[elem]; + } else { + maxVal = maxvalue( maxVal, + theParams[0]->value.data.lngptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.lngptr[row] = maxVal; + } + } else if( this->type==DOUBLE ) { + double maxVal=0.0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + maxVal = theParams[0]->value.data.dblptr[elem]; + } else { + maxVal = maxvalue( maxVal, + theParams[0]->value.data.dblptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.dblptr[row] = maxVal; + } + } else if( this->type==BITSTR ) { + char maxVal; + while( row-- ) { + char *sptr1 = theParams[0]->value.data.strptr[row]; + maxVal = '0'; + while (*sptr1) { + if (*sptr1 == '1') maxVal = '1'; + sptr1++; + } + this->value.data.strptr[row][0] = maxVal; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + } + break; + case max2_fct: + if( this->type==LONG ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.lngptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[1].data.lng; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[0].data.lng; + } else { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = + maxvalue( pVals[0].data.lng, pVals[1].data.lng ); + } + } + } + } else if( this->type==DOUBLE ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.dblptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[1].data.dbl; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[0].data.dbl; + } else { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = + maxvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + } + } + } + } + break; + + /* Boolean SAO region Functions... all arguments scalar dbls */ + + case near_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=3; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + bnear( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl ); + } + break; + case circle_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=5; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + circle( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl ); + } + break; + case box_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=7; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + saobox( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + } + break; + case elps_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=7; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + ellipse( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + } + break; + + /* C Conditional expression: bool ? expr : expr */ + + case ifthenelse_fct: + switch( this->type ) { + case BOOLEAN: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + if( vector[2]>1 ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[elem]; + pNull[2] = theParams[2]->value.undef[elem]; + } else if( vector[2] ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.log = + theParams[i]->value.data.logptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.log = + theParams[i]->value.data.logptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = pNull[2]) ) { + if( pVals[2].data.log ) { + this->value.data.logptr[elem] = pVals[0].data.log; + this->value.undef[elem] = pNull[0]; + } else { + this->value.data.logptr[elem] = pVals[1].data.log; + this->value.undef[elem] = pNull[1]; + } + } + } + } + break; + case LONG: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + if( vector[2]>1 ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[elem]; + pNull[2] = theParams[2]->value.undef[elem]; + } else if( vector[2] ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = pNull[2]) ) { + if( pVals[2].data.log ) { + this->value.data.lngptr[elem] = pVals[0].data.lng; + this->value.undef[elem] = pNull[0]; + } else { + this->value.data.lngptr[elem] = pVals[1].data.lng; + this->value.undef[elem] = pNull[1]; + } + } + } + } + break; + case DOUBLE: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + if( vector[2]>1 ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[elem]; + pNull[2] = theParams[2]->value.undef[elem]; + } else if( vector[2] ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = pNull[2]) ) { + if( pVals[2].data.log ) { + this->value.data.dblptr[elem] = pVals[0].data.dbl; + this->value.undef[elem] = pNull[0]; + } else { + this->value.data.dblptr[elem] = pVals[1].data.dbl; + this->value.undef[elem] = pNull[1]; + } + } + } + } + break; + case STRING: + while( row-- ) { + if( vector[2] ) { + pVals[2].data.log = theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i] ) { + strcpy( pVals[i].data.str, + theParams[i]->value.data.strptr[row] ); + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row] = pNull[2]) ) { + if( pVals[2].data.log ) { + strcpy( this->value.data.strptr[row], + pVals[0].data.str ); + this->value.undef[row] = pNull[0]; + } else { + strcpy( this->value.data.strptr[row], + pVals[1].data.str ); + this->value.undef[row] = pNull[1]; + } + } else { + this->value.data.strptr[row][0] = '\0'; + } + } + break; + + } + break; + + } + } + } + + i = this->nSubNodes; + while( i-- ) { + if( theParams[i]->operation>0 ) { + /* Currently only numeric params allowed */ + free( theParams[i]->value.data.ptr ); + } + } +} + +static void Do_Deref( Node *this ) +{ + Node *theVar, *theDims[MAXDIMS]; + int isConst[MAXDIMS], allConst; + long dimVals[MAXDIMS]; + int i, nDims; + long row, elem, dsize; + + theVar = gParse.Nodes + this->SubNodes[0]; + + i = nDims = this->nSubNodes-1; + allConst = 1; + while( i-- ) { + theDims[i] = gParse.Nodes + this->SubNodes[i+1]; + isConst[i] = ( theDims[i]->operation==CONST_OP ); + if( isConst[i] ) + dimVals[i] = theDims[i]->value.data.lng; + else + allConst = 0; + } + + if( this->type==DOUBLE ) { + dsize = sizeof( double ); + } else if( this->type==LONG ) { + dsize = sizeof( long ); + } else if( this->type==BOOLEAN ) { + dsize = sizeof( char ); + } else + dsize = 0; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + if( allConst && theVar->value.naxis==nDims ) { + + /* Dereference completely using constant indices */ + + elem = 0; + i = nDims; + while( i-- ) { + if( dimVals[i]<1 || dimVals[i]>theVar->value.naxes[i] ) break; + elem = theVar->value.naxes[i]*elem + dimVals[i]-1; + } + if( i<0 ) { + for( row=0; rowtype==STRING ) + this->value.undef[row] = theVar->value.undef[row]; + else if( this->type==BITSTR ) + this->value.undef; /* Dummy - BITSTRs do not have undefs */ + else + this->value.undef[row] = theVar->value.undef[elem]; + + if( this->type==DOUBLE ) + this->value.data.dblptr[row] = + theVar->value.data.dblptr[elem]; + else if( this->type==LONG ) + this->value.data.lngptr[row] = + theVar->value.data.lngptr[elem]; + else if( this->type==BOOLEAN ) + this->value.data.logptr[row] = + theVar->value.data.logptr[elem]; + else { + /* XXX Note, the below expression uses knowledge of + the layout of the string format, namely (nelem+1) + characters per string, followed by (nelem+1) + "undef" values. */ + this->value.data.strptr[row][0] = + theVar->value.data.strptr[0][elem+row]; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + elem += theVar->value.nelem; + } + } else { + yyerror("Index out of range"); + free( this->value.data.ptr ); + } + + } else if( allConst && nDims==1 ) { + + /* Reduce dimensions by 1, using a constant index */ + + if( dimVals[0] < 1 || + dimVals[0] > theVar->value.naxes[ theVar->value.naxis-1 ] ) { + yyerror("Index out of range"); + free( this->value.data.ptr ); + } else if ( this->type == BITSTR || this->type == STRING ) { + elem = this->value.nelem * (dimVals[0]-1); + for( row=0; rowvalue.undef) + this->value.undef[row] = theVar->value.undef[row]; + memcpy( (char*)this->value.data.strptr[0] + + row*sizeof(char)*(this->value.nelem+1), + (char*)theVar->value.data.strptr[0] + elem*sizeof(char), + this->value.nelem * sizeof(char) ); + /* Null terminate */ + this->value.data.strptr[row][this->value.nelem] = 0; + elem += theVar->value.nelem+1; + } + } else { + elem = this->value.nelem * (dimVals[0]-1); + for( row=0; rowvalue.undef + row*this->value.nelem, + theVar->value.undef + elem, + this->value.nelem * sizeof(char) ); + memcpy( (char*)this->value.data.ptr + + row*dsize*this->value.nelem, + (char*)theVar->value.data.ptr + elem*dsize, + this->value.nelem * dsize ); + elem += theVar->value.nelem; + } + } + + } else if( theVar->value.naxis==nDims ) { + + /* Dereference completely using an expression for the indices */ + + for( row=0; rowvalue.undef[row] ) { + yyerror("Null encountered as vector index"); + free( this->value.data.ptr ); + break; + } else + dimVals[i] = theDims[i]->value.data.lngptr[row]; + } + } + if( gParse.status ) break; + + elem = 0; + i = nDims; + while( i-- ) { + if( dimVals[i]<1 || dimVals[i]>theVar->value.naxes[i] ) break; + elem = theVar->value.naxes[i]*elem + dimVals[i]-1; + } + if( i<0 ) { + elem += row*theVar->value.nelem; + + if( this->type==STRING ) + this->value.undef[row] = theVar->value.undef[row]; + else if( this->type==BITSTR ) + this->value.undef; /* Dummy - BITSTRs do not have undefs */ + else + this->value.undef[row] = theVar->value.undef[elem]; + + if( this->type==DOUBLE ) + this->value.data.dblptr[row] = + theVar->value.data.dblptr[elem]; + else if( this->type==LONG ) + this->value.data.lngptr[row] = + theVar->value.data.lngptr[elem]; + else if( this->type==BOOLEAN ) + this->value.data.logptr[row] = + theVar->value.data.logptr[elem]; + else { + /* XXX Note, the below expression uses knowledge of + the layout of the string format, namely (nelem+1) + characters per string, followed by (nelem+1) + "undef" values. */ + this->value.data.strptr[row][0] = + theVar->value.data.strptr[0][elem+row]; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + } else { + yyerror("Index out of range"); + free( this->value.data.ptr ); + } + } + + } else { + + /* Reduce dimensions by 1, using a nonconstant expression */ + + for( row=0; rowvalue.undef[row] ) { + yyerror("Null encountered as vector index"); + free( this->value.data.ptr ); + break; + } else + dimVals[0] = theDims[0]->value.data.lngptr[row]; + + if( dimVals[0] < 1 || + dimVals[0] > theVar->value.naxes[ theVar->value.naxis-1 ] ) { + yyerror("Index out of range"); + free( this->value.data.ptr ); + } else if ( this->type == BITSTR || this->type == STRING ) { + elem = this->value.nelem * (dimVals[0]-1); + elem += row*(theVar->value.nelem+1); + if (this->value.undef) + this->value.undef[row] = theVar->value.undef[row]; + memcpy( (char*)this->value.data.strptr[0] + + row*sizeof(char)*(this->value.nelem+1), + (char*)theVar->value.data.strptr[0] + elem*sizeof(char), + this->value.nelem * sizeof(char) ); + /* Null terminate */ + this->value.data.strptr[row][this->value.nelem] = 0; + } else { + elem = this->value.nelem * (dimVals[0]-1); + elem += row*theVar->value.nelem; + memcpy( this->value.undef + row*this->value.nelem, + theVar->value.undef + elem, + this->value.nelem * sizeof(char) ); + memcpy( (char*)this->value.data.ptr + + row*dsize*this->value.nelem, + (char*)theVar->value.data.ptr + elem*dsize, + this->value.nelem * dsize ); + } + } + } + } + + if( theVar->operation>0 ) { + if (theVar->type == STRING || theVar->type == BITSTR) + free(theVar->value.data.strptr[0] ); + else + free( theVar->value.data.ptr ); + } + for( i=0; ioperation>0 ) { + free( theDims[i]->value.data.ptr ); + } +} + +static void Do_GTI( Node *this ) +{ + Node *theExpr, *theTimes; + double *start, *stop, *times; + long elem, nGTI, gti; + int ordered; + + theTimes = gParse.Nodes + this->SubNodes[0]; + theExpr = gParse.Nodes + this->SubNodes[1]; + + nGTI = theTimes->value.nelem; + start = theTimes->value.data.dblptr; + stop = theTimes->value.data.dblptr + nGTI; + ordered = theTimes->type; + + if( theExpr->operation==CONST_OP ) { + + this->value.data.log = + (Search_GTI( theExpr->value.data.dbl, nGTI, start, stop, ordered )>=0); + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + times = theExpr->value.data.dblptr; + if( !gParse.status ) { + + elem = gParse.nRows * this->value.nelem; + if( nGTI ) { + gti = -1; + while( elem-- ) { + if( (this->value.undef[elem] = theExpr->value.undef[elem]) ) + continue; + + /* Before searching entire GTI, check the GTI found last time */ + if( gti<0 || times[elem]stop[gti] ) { + gti = Search_GTI( times[elem], nGTI, start, stop, ordered ); + } + this->value.data.logptr[elem] = ( gti>=0 ); + } + } else + while( elem-- ) { + this->value.data.logptr[elem] = 0; + this->value.undef[elem] = 0; + } + } + } + + if( theExpr->operation>0 ) + free( theExpr->value.data.ptr ); +} + +static long Search_GTI( double evtTime, long nGTI, double *start, + double *stop, int ordered ) +{ + long gti, step; + + if( ordered && nGTI>15 ) { /* If time-ordered and lots of GTIs, */ + /* use "FAST" Binary search algorithm */ + if( evtTime>=start[0] && evtTime<=stop[nGTI-1] ) { + gti = step = (nGTI >> 1); + while(1) { + if( step>1L ) step >>= 1; + + if( evtTime>stop[gti] ) { + if( evtTime>=start[gti+1] ) + gti += step; + else { + gti = -1L; + break; + } + } else if( evtTime=start[gti] && evtTime<=stop[gti] ) + break; + } + return( gti ); +} + +static void Do_REG( Node *this ) +{ + Node *theRegion, *theX, *theY; + double Xval=0.0, Yval=0.0; + char Xnull=0, Ynull=0; + int Xvector, Yvector; + long nelem, elem, rows; + + theRegion = gParse.Nodes + this->SubNodes[0]; + theX = gParse.Nodes + this->SubNodes[1]; + theY = gParse.Nodes + this->SubNodes[2]; + + Xvector = ( theX->operation!=CONST_OP ); + if( Xvector ) + Xvector = theX->value.nelem; + else { + Xval = theX->value.data.dbl; + } + + Yvector = ( theY->operation!=CONST_OP ); + if( Yvector ) + Yvector = theY->value.nelem; + else { + Yval = theY->value.data.dbl; + } + + if( !Xvector && !Yvector ) { + + this->value.data.log = + ( fits_in_region( Xval, Yval, (SAORegion *)theRegion->value.data.ptr ) + != 0 ); + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + rows = gParse.nRows; + nelem = this->value.nelem; + elem = rows*nelem; + + while( rows-- ) { + while( nelem-- ) { + elem--; + + if( Xvector>1 ) { + Xval = theX->value.data.dblptr[elem]; + Xnull = theX->value.undef[elem]; + } else if( Xvector ) { + Xval = theX->value.data.dblptr[rows]; + Xnull = theX->value.undef[rows]; + } + + if( Yvector>1 ) { + Yval = theY->value.data.dblptr[elem]; + Ynull = theY->value.undef[elem]; + } else if( Yvector ) { + Yval = theY->value.data.dblptr[rows]; + Ynull = theY->value.undef[rows]; + } + + this->value.undef[elem] = ( Xnull || Ynull ); + if( this->value.undef[elem] ) + continue; + + this->value.data.logptr[elem] = + ( fits_in_region( Xval, Yval, + (SAORegion *)theRegion->value.data.ptr ) + != 0 ); + } + nelem = this->value.nelem; + } + } + } + + if( theX->operation>0 ) + free( theX->value.data.ptr ); + if( theY->operation>0 ) + free( theY->value.data.ptr ); +} + +static void Do_Vector( Node *this ) +{ + Node *that; + long row, elem, idx, jdx, offset=0; + int node; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + for( node=0; nodenSubNodes; node++ ) { + + that = gParse.Nodes + this->SubNodes[node]; + + if( that->operation == CONST_OP ) { + + idx = gParse.nRows*this->value.nelem + offset; + while( (idx-=this->value.nelem)>=0 ) { + + this->value.undef[idx] = 0; + + switch( this->type ) { + case BOOLEAN: + this->value.data.logptr[idx] = that->value.data.log; + break; + case LONG: + this->value.data.lngptr[idx] = that->value.data.lng; + break; + case DOUBLE: + this->value.data.dblptr[idx] = that->value.data.dbl; + break; + } + } + + } else { + + row = gParse.nRows; + idx = row * that->value.nelem; + while( row-- ) { + elem = that->value.nelem; + jdx = row*this->value.nelem + offset; + while( elem-- ) { + this->value.undef[jdx+elem] = + that->value.undef[--idx]; + + switch( this->type ) { + case BOOLEAN: + this->value.data.logptr[jdx+elem] = + that->value.data.logptr[idx]; + break; + case LONG: + this->value.data.lngptr[jdx+elem] = + that->value.data.lngptr[idx]; + break; + case DOUBLE: + this->value.data.dblptr[jdx+elem] = + that->value.data.dblptr[idx]; + break; + } + } + } + } + offset += that->value.nelem; + } + + } + + for( node=0; node < this->nSubNodes; node++ ) + if( gParse.Nodes[this->SubNodes[node]].operation>0 ) + free( gParse.Nodes[this->SubNodes[node]].value.data.ptr ); +} + +/*****************************************************************************/ +/* Utility routines which perform the calculations on bits and SAO regions */ +/*****************************************************************************/ + +static char bitlgte(char *bits1, int oper, char *bits2) +{ + int val1, val2, nextbit; + char result; + int i, l1, l2, length, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bits1); + l2 = strlen(bits2); + if (l1 < l2) + { + length = l2; + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bits1++); + stream[i] = '\0'; + bits1 = stream; + } + else if (l2 < l1) + { + length = l1; + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bits2++); + stream[i] = '\0'; + bits2 = stream; + } + else + length = l1; + + val1 = val2 = 0; + nextbit = 1; + + while( length-- ) + { + chr1 = bits1[length]; + chr2 = bits2[length]; + if ((chr1 != 'x')&&(chr1 != 'X')&&(chr2 != 'x')&&(chr2 != 'X')) + { + if (chr1 == '1') val1 += nextbit; + if (chr2 == '1') val2 += nextbit; + nextbit *= 2; + } + } + result = 0; + switch (oper) + { + case LT: + if (val1 < val2) result = 1; + break; + case LTE: + if (val1 <= val2) result = 1; + break; + case GT: + if (val1 > val2) result = 1; + break; + case GTE: + if (val1 >= val2) result = 1; + break; + } + return (result); +} + +static void bitand(char *result,char *bitstrm1,char *bitstrm2) +{ + int i, l1, l2, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + if (l1 < l2) + { + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bitstrm1++); + stream[i] = '\0'; + bitstrm1 = stream; + } + else if (l2 < l1) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bitstrm2++); + stream[i] = '\0'; + bitstrm2 = stream; + } + while ( (chr1 = *(bitstrm1++)) ) + { + chr2 = *(bitstrm2++); + if ((chr1 == 'x') || (chr2 == 'x')) + *result = 'x'; + else if ((chr1 == '1') && (chr2 == '1')) + *result = '1'; + else + *result = '0'; + result++; + } + *result = '\0'; +} + +static void bitor(char *result,char *bitstrm1,char *bitstrm2) +{ + int i, l1, l2, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + if (l1 < l2) + { + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bitstrm1++); + stream[i] = '\0'; + bitstrm1 = stream; + } + else if (l2 < l1) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bitstrm2++); + stream[i] = '\0'; + bitstrm2 = stream; + } + while ( (chr1 = *(bitstrm1++)) ) + { + chr2 = *(bitstrm2++); + if ((chr1 == '1') || (chr2 == '1')) + *result = '1'; + else if ((chr1 == '0') || (chr2 == '0')) + *result = '0'; + else + *result = 'x'; + result++; + } + *result = '\0'; +} + +static void bitnot(char *result,char *bits) +{ + int length; + char chr; + + length = strlen(bits); + while( length-- ) { + chr = *(bits++); + *(result++) = ( chr=='1' ? '0' : ( chr=='0' ? '1' : chr ) ); + } + *result = '\0'; +} + +static char bitcmp(char *bitstrm1, char *bitstrm2) +{ + int i, l1, l2, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + if (l1 < l2) + { + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bitstrm1++); + stream[i] = '\0'; + bitstrm1 = stream; + } + else if (l2 < l1) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bitstrm2++); + stream[i] = '\0'; + bitstrm2 = stream; + } + while( (chr1 = *(bitstrm1++)) ) + { + chr2 = *(bitstrm2++); + if ( ((chr1 == '0') && (chr2 == '1')) + || ((chr1 == '1') && (chr2 == '0')) ) + return( 0 ); + } + return( 1 ); +} + +static char bnear(double x, double y, double tolerance) +{ + if (fabs(x - y) < tolerance) + return ( 1 ); + else + return ( 0 ); +} + +static char saobox(double xcen, double ycen, double xwid, double ywid, + double rot, double xcol, double ycol) +{ + double x,y,xprime,yprime,xmin,xmax,ymin,ymax,theta; + + theta = (rot / 180.0) * myPI; + xprime = xcol - xcen; + yprime = ycol - ycen; + x = xprime * cos(theta) + yprime * sin(theta); + y = -xprime * sin(theta) + yprime * cos(theta); + xmin = - 0.5 * xwid; xmax = 0.5 * xwid; + ymin = - 0.5 * ywid; ymax = 0.5 * ywid; + if ((x >= xmin) && (x <= xmax) && (y >= ymin) && (y <= ymax)) + return ( 1 ); + else + return ( 0 ); +} + +static char circle(double xcen, double ycen, double rad, + double xcol, double ycol) +{ + double r2,dx,dy,dlen; + + dx = xcol - xcen; + dy = ycol - ycen; + dx *= dx; dy *= dy; + dlen = dx + dy; + r2 = rad * rad; + if (dlen <= r2) + return ( 1 ); + else + return ( 0 ); +} + +static char ellipse(double xcen, double ycen, double xrad, double yrad, + double rot, double xcol, double ycol) +{ + double x,y,xprime,yprime,dx,dy,dlen,theta; + + theta = (rot / 180.0) * myPI; + xprime = xcol - xcen; + yprime = ycol - ycen; + x = xprime * cos(theta) + yprime * sin(theta); + y = -xprime * sin(theta) + yprime * cos(theta); + dx = x / xrad; dy = y / yrad; + dx *= dx; dy *= dy; + dlen = dx + dy; + if (dlen <= 1.0) + return ( 1 ); + else + return ( 0 ); +} + +static void yyerror(char *s) +{ + char msg[80]; + + if( !gParse.status ) gParse.status = PARSE_SYNTAX_ERR; + + strncpy(msg, s, 80); + msg[79] = '\0'; + ffpmsg(msg); +} diff --git a/pkg/tbtables/cfitsio/eval_defs.h b/pkg/tbtables/cfitsio/eval_defs.h new file mode 100644 index 00000000..d991fc16 --- /dev/null +++ b/pkg/tbtables/cfitsio/eval_defs.h @@ -0,0 +1,153 @@ +#include +#include +#include +#include +#if defined(__sgi) || defined(__hpux) +#include +#endif +#ifdef sparc +#include +#endif +#include "fitsio2.h" + +#ifndef FFBISON +#include "eval_tab.h" +#endif + +#define MAXDIMS 5 +#define MAXSUBS 10 +#define MAXVARNAME 80 +#define CONST_OP -1000 +#define pERROR -1 + +typedef struct { + char name[MAXVARNAME+1]; + int type; + long nelem; + int naxis; + long naxes[MAXDIMS]; + char *undef; + void *data; + } DataInfo; + +typedef struct { + long nelem; + int naxis; + long naxes[MAXDIMS]; + char *undef; + union { + double dbl; + long lng; + char log; + char str[256]; + double *dblptr; + long *lngptr; + char *logptr; + char **strptr; + void *ptr; + } data; + } lval; + +typedef struct Node { + int operation; + void (*DoOp)(struct Node *this); + int nSubNodes; + int SubNodes[MAXSUBS]; + int type; + lval value; + } Node; + +typedef struct { + fitsfile *def_fptr; + int (*getData)( char *dataName, void *dataValue ); + int (*loadData)( int varNum, long fRow, long nRows, + void *data, char *undef ); + + int compressed; + int timeCol; + int parCol; + int valCol; + + char *expr; + int index; + int is_eobuf; + + Node *Nodes; + int nNodes; + int nNodesAlloc; + int resultNode; + + long firstRow; + long nRows; + + int nCols; + iteratorCol *colData; + DataInfo *varData; + + long firstDataRow; + long nDataRows; + long totalRows; + + int datatype; + + int status; + } ParseData; + +typedef enum { + rnd_fct = 1001, + sum_fct, + nelem_fct, + sin_fct, + cos_fct, + tan_fct, + asin_fct, + acos_fct, + atan_fct, + sinh_fct, + cosh_fct, + tanh_fct, + exp_fct, + log_fct, + log10_fct, + sqrt_fct, + abs_fct, + atan2_fct, + ceil_fct, + floor_fct, + round_fct, + min1_fct, + min2_fct, + max1_fct, + max2_fct, + near_fct, + circle_fct, + box_fct, + elps_fct, + isnull_fct, + defnull_fct, + gtifilt_fct, + regfilt_fct, + ifthenelse_fct, + row_fct, + null_fct, + median_fct, + average_fct, + stddev_fct, + nonnull_fct + } funcOp; + +extern ParseData gParse; + +#ifdef __cplusplus +extern "C" { +#endif + + int ffparse(void); + int fflex(void); + void ffrestart(FILE*); + + void Evaluate_Parser( long firstRow, long nRows ); + +#ifdef __cplusplus + } +#endif diff --git a/pkg/tbtables/cfitsio/eval_f.c b/pkg/tbtables/cfitsio/eval_f.c new file mode 100644 index 00000000..20441818 --- /dev/null +++ b/pkg/tbtables/cfitsio/eval_f.c @@ -0,0 +1,2293 @@ +/************************************************************************/ +/* */ +/* CFITSIO Lexical Parser */ +/* */ +/* This file is one of 3 files containing code which parses an */ +/* arithmetic expression and evaluates it in the context of an input */ +/* FITS file table extension. The CFITSIO lexical parser is divided */ +/* into the following 3 parts/files: the CFITSIO "front-end", */ +/* eval_f.c, contains the interface between the user/CFITSIO and the */ +/* real core of the parser; the FLEX interpreter, eval_l.c, takes the */ +/* input string and parses it into tokens and identifies the FITS */ +/* information required to evaluate the expression (ie, keywords and */ +/* columns); and, the BISON grammar and evaluation routines, eval_y.c, */ +/* receives the FLEX output and determines and performs the actual */ +/* operations. The files eval_l.c and eval_y.c are produced from */ +/* running flex and bison on the files eval.l and eval.y, respectively. */ +/* (flex and bison are available from any GNU archive: see www.gnu.org) */ +/* */ +/* The grammar rules, rather than evaluating the expression in situ, */ +/* builds a tree, or Nodal, structure mapping out the order of */ +/* operations and expression dependencies. This "compilation" process */ +/* allows for much faster processing of multiple rows. This technique */ +/* was developed by Uwe Lammers of the XMM Science Analysis System, */ +/* although the CFITSIO implementation is entirely code original. */ +/* */ +/* */ +/* Modification History: */ +/* */ +/* Kent Blackburn c1992 Original parser code developed for the */ +/* FTOOLS software package, in particular, */ +/* the fselect task. */ +/* Kent Blackburn c1995 BIT column support added */ +/* Peter D Wilson Feb 1998 Vector column support added */ +/* Peter D Wilson May 1998 Ported to CFITSIO library. User */ +/* interface routines written, in essence */ +/* making fselect, fcalc, and maketime */ +/* capabilities available to all tools */ +/* via single function calls. */ +/* Peter D Wilson Jun 1998 Major rewrite of parser core, so as to */ +/* create a run-time evaluation tree, */ +/* inspired by the work of Uwe Lammers, */ +/* resulting in a speed increase of */ +/* 10-100 times. */ +/* Peter D Wilson Jul 1998 gtifilter(a,b,c,d) function added */ +/* Peter D Wilson Aug 1998 regfilter(a,b,c,d) function added */ +/* Peter D Wilson Jul 1999 Make parser fitsfile-independent, */ +/* allowing a purely vector-based usage */ +/* Peter D Wilson Aug 1999 Add row-offset capability */ +/* Peter D Wilson Sep 1999 Add row-range capability to ffcalc_rng */ +/* */ +/************************************************************************/ + +#include +#include +#include "eval_defs.h" +#include "region.h" + +typedef struct { + int datatype; /* Data type to cast parse results into for user */ + void *dataPtr; /* Pointer to array of results, NULL if to use iterCol */ + void *nullPtr; /* Pointer to nulval, use zero if NULL */ + long maxRows; /* Max No. of rows to process, -1=all, 0=1 iteration */ + int anyNull; /* Flag indicating at least 1 undef value encountered */ +} parseInfo; + +/* Internal routines needed to allow the evaluator to operate on FITS data */ + +static void Setup_DataArrays( int nCols, iteratorCol *cols, + long fRow, long nRows ); +static int find_column( char *colName, void *itslval ); +static int find_keywd ( char *key, void *itslval ); +static int allocateCol( int nCol, int *status ); +static int load_column( int varNum, long fRow, long nRows, + void *data, char *undef ); + +/*---------------------------------------------------------------------------*/ +int fffrow( fitsfile *fptr, /* I - Input FITS file */ + char *expr, /* I - Boolean expression */ + long firstrow, /* I - First row of table to eval */ + long nrows, /* I - Number of rows to evaluate */ + long *n_good_rows, /* O - Number of rows eval to True */ + char *row_status, /* O - Array of boolean results */ + int *status ) /* O - Error status */ +/* */ +/* Evaluate a boolean expression using the indicated rows, returning an */ +/* array of flags indicating which rows evaluated to TRUE/FALSE */ +/*---------------------------------------------------------------------------*/ +{ + parseInfo Info; + int naxis, constant; + long nelem, naxes[MAXDIMS], elem; + char result; + + if( *status ) return( *status ); + + if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis, + naxes, status ) ) { + ffcprs(); + return( *status ); + } + if( nelem<0 ) { + constant = 1; + nelem = -nelem; + } else + constant = 0; + + if( Info.datatype!=TLOGICAL || nelem!=1 ) { + ffcprs(); + ffpmsg("Expression does not evaluate to a logical scalar."); + return( *status = PARSE_BAD_TYPE ); + } + + if( constant ) { /* No need to call parser... have result from ffiprs */ + result = gParse.Nodes[gParse.resultNode].value.data.log; + *n_good_rows = nrows; + for( elem=0; elem1 ? firstrow : 1); + Info.dataPtr = row_status; + Info.nullPtr = NULL; + Info.maxRows = nrows; + + if( ffiter( gParse.nCols, gParse.colData, firstrow-1, 0, + parse_data, (void*)&Info, status ) == -1 ) + *status = 0; /* -1 indicates exitted without error before end... OK */ + + if( *status ) { + + /***********************/ + /* Error... Do nothing */ + /***********************/ + + } else { + + /***********************************/ + /* Count number of good rows found */ + /***********************************/ + + *n_good_rows = 0L; + for( elem=0; elemHDUposition != (infptr->Fptr)->curhdu ) + ffmahd( infptr, (infptr->HDUposition) + 1, NULL, status ); + if( *status ) { + ffcprs(); + return( *status ); + } + inExt.rowLength = (long) (infptr->Fptr)->rowlength; + inExt.numRows = (infptr->Fptr)->numrows; + inExt.heapSize = (infptr->Fptr)->heapsize; + if( inExt.numRows == 0 ) { /* Nothing to copy */ + ffcprs(); + return( *status ); + } + + if( outfptr->HDUposition != (outfptr->Fptr)->curhdu ) + ffmahd( outfptr, (outfptr->HDUposition) + 1, NULL, status ); + if( (outfptr->Fptr)->datastart < 0 ) + ffrdef( outfptr, status ); + if( *status ) { + ffcprs(); + return( *status ); + } + outExt.rowLength = (long) (outfptr->Fptr)->rowlength; + outExt.numRows = (outfptr->Fptr)->numrows; + if( !outExt.numRows ) + (outfptr->Fptr)->heapsize = 0L; + outExt.heapSize = (outfptr->Fptr)->heapsize; + + if( inExt.rowLength != outExt.rowLength ) { + ffpmsg("Output table has different row length from input"); + ffcprs(); + return( *status = PARSE_BAD_OUTPUT ); + } + + /***********************************/ + /* Fill out Info data for parser */ + /***********************************/ + + Info.dataPtr = (char *)malloc( (inExt.numRows + 1) * sizeof(char) ); + Info.nullPtr = NULL; + Info.maxRows = inExt.numRows; + if( !Info.dataPtr ) { + ffpmsg("Unable to allocate memory for row selection"); + ffcprs(); + return( *status = MEMORY_ALLOCATION ); + } + + /* make sure array is zero terminated */ + ((char*)Info.dataPtr)[inExt.numRows] = 0; + + if( constant ) { /* Set all rows to the same value from constant result */ + + result = gParse.Nodes[gParse.resultNode].value.data.log; + for( ntodo = 0; ntodo 1) + ffirow( outfptr, outExt.numRows, nGood, status ); + } + + do { + if( ((char*)Info.dataPtr)[inloc-1] ) { + ffgtbb( infptr, inloc, 1L, rdlen, buffer+rdlen*nbuff, status ); + nbuff++; + if( nbuff==maxrows ) { + ffptbb( outfptr, outloc, 1L, rdlen*nbuff, buffer, status ); + outloc += nbuff; + nbuff = 0; + } + } + inloc++; + } while( !*status && inloc<=inExt.numRows ); + + if( nbuff ) { + ffptbb( outfptr, outloc, 1L, rdlen*nbuff, buffer, status ); + outloc += nbuff; + } + + if( infptr==outfptr ) { + + if( outloc<=inExt.numRows ) + ffdrow( infptr, outloc, inExt.numRows-outloc+1, status ); + + } else if( inExt.heapSize && nGood ) { + + /* Copy heap, if it exists and at least one row copied */ + + /********************************************************/ + /* Get location information from the output extension */ + /********************************************************/ + + if( outfptr->HDUposition != (outfptr->Fptr)->curhdu ) + ffmahd( outfptr, (outfptr->HDUposition) + 1, NULL, status ); + outExt.dataStart = (outfptr->Fptr)->datastart; + outExt.heapStart = (outfptr->Fptr)->heapstart; + + /*************************************************/ + /* Insert more space into outfptr if necessary */ + /*************************************************/ + + hsize = outExt.heapStart + outExt.heapSize; + freespace = ( ( (hsize + 2879) / 2880) * 2880) - hsize; + ntodo = inExt.heapSize; + + if ( (freespace - ntodo) < 0) { /* not enough existing space? */ + ntodo = (ntodo - freespace + 2879) / 2880; /* number of blocks */ + ffiblk(outfptr, ntodo, 1, status); /* insert the blocks */ + } + ffukyj( outfptr, "PCOUNT", inExt.heapSize+outExt.heapSize, + NULL, status ); + + /*******************************************************/ + /* Get location information from the input extension */ + /*******************************************************/ + + if( infptr->HDUposition != (infptr->Fptr)->curhdu ) + ffmahd( infptr, (infptr->HDUposition) + 1, NULL, status ); + inExt.dataStart = (infptr->Fptr)->datastart; + inExt.heapStart = (infptr->Fptr)->heapstart; + + /**********************************/ + /* Finally copy heap to outfptr */ + /**********************************/ + + ntodo = inExt.heapSize; + inbyteloc = inExt.heapStart + inExt.dataStart; + outbyteloc = outExt.heapStart + outExt.dataStart + outExt.heapSize; + + while ( ntodo && !*status ) { + rdlen = minvalue(ntodo,500000); + ffmbyt( infptr, inbyteloc, REPORT_EOF, status ); + ffgbyt( infptr, rdlen, buffer, status ); + ffmbyt( outfptr, outbyteloc, IGNORE_EOF, status ); + ffpbyt( outfptr, rdlen, buffer, status ); + inbyteloc += rdlen; + outbyteloc += rdlen; + ntodo -= rdlen; + } + + /***********************************************************/ + /* But must update DES if data is being appended to a */ + /* pre-existing heap space. Edit each new entry in file */ + /***********************************************************/ + + if( outExt.heapSize ) { + long repeat, offset, j; + int i; + for( i=1; i<=(outfptr->Fptr)->tfield; i++ ) { + if( (outfptr->Fptr)->tableptr[i-1].tdatatype<0 ) { + for( j=outExt.numRows+1; j<=outExt.numRows+nGood; j++ ) { + ffgdes( outfptr, i, j, &repeat, &offset, status ); + offset += outExt.heapSize; + ffpdes( outfptr, i, j, repeat, offset, status ); + } + } + } + } + + } /* End of HEAP copy */ + + free(buffer); + } + + free(Info.dataPtr); + ffcprs(); + + ffcmph(outfptr, status); /* compress heap, deleting any orphaned data */ + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffcrow( fitsfile *fptr, /* I - Input FITS file */ + int datatype, /* I - Datatype to return results as */ + char *expr, /* I - Arithmetic expression */ + long firstrow, /* I - First row to evaluate */ + long nelements, /* I - Number of elements to return */ + void *nulval, /* I - Ptr to value to use as UNDEF */ + void *array, /* O - Array of results */ + int *anynul, /* O - Were any UNDEFs encountered? */ + int *status ) /* O - Error status */ +/* */ +/* Calculate an expression for the indicated rows of a table, returning */ +/* the results, cast as datatype (TSHORT, TDOUBLE, etc), in array. If */ +/* nulval==NULL, UNDEFs will be zeroed out. For vector results, the number */ +/* of elements returned may be less than nelements if nelements is not an */ +/* even multiple of the result dimension. Call fftexp to obtain the */ +/* dimensions of the results. */ +/*---------------------------------------------------------------------------*/ +{ + parseInfo Info; + int naxis; + long nelem1, naxes[MAXDIMS]; + + if( *status ) return( *status ); + + if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem1, &naxis, + naxes, status ) ) { + ffcprs(); + return( *status ); + } + if( nelem1<0 ) nelem1 = - nelem1; + + if( nelements1 ? firstrow : 1); + + if( datatype ) Info.datatype = datatype; + + Info.dataPtr = array; + Info.nullPtr = nulval; + Info.maxRows = nelements / nelem1; + + if( ffiter( gParse.nCols, gParse.colData, firstrow-1, 0, + parse_data, (void*)&Info, status ) == -1 ) + *status=0; /* -1 indicates exitted without error before end... OK */ + + *anynul = Info.anyNull; + ffcprs(); + return( *status ); +} + +/*--------------------------------------------------------------------------*/ +int ffcalc( fitsfile *infptr, /* I - Input FITS file */ + char *expr, /* I - Arithmetic expression */ + fitsfile *outfptr, /* I - Output fits file */ + char *parName, /* I - Name of output parameter */ + char *parInfo, /* I - Extra information on parameter */ + int *status ) /* O - Error status */ +/* */ +/* Evaluate an expression for all rows of a table. Call ffcalc_rng with */ +/* a row range of 1-MAX. */ +{ + long start=1, end=LONG_MAX; + + return ffcalc_rng( infptr, expr, outfptr, parName, parInfo, + 1, &start, &end, status ); +} + +/*--------------------------------------------------------------------------*/ +int ffcalc_rng( fitsfile *infptr, /* I - Input FITS file */ + char *expr, /* I - Arithmetic expression */ + fitsfile *outfptr, /* I - Output fits file */ + char *parName, /* I - Name of output parameter */ + char *parInfo, /* I - Extra information on parameter */ + int nRngs, /* I - Row range info */ + long *start, /* I - Row range info */ + long *end, /* I - Row range info */ + int *status ) /* O - Error status */ +/* */ +/* Evaluate an expression using the data in the input FITS file and place */ +/* the results into either a column or keyword in the output fits file, */ +/* depending on the value of parName (keywords normally prefixed with '#') */ +/* and whether the expression evaluates to a constant or a table column. */ +/* The logic is as follows: */ +/* (1) If a column exists with name, parName, put results there. */ +/* (2) If parName starts with '#', as in #NAXIS, put result there, */ +/* with parInfo used as the comment. If expression does not evaluate */ +/* to a constant, flag an error. */ +/* (3) If a keyword exists with name, parName, and expression is a */ +/* constant, put result there, using parInfo as the new comment. */ +/* (4) Else, create a new column with name parName and TFORM parInfo. */ +/* If parInfo is NULL, use a default data type for the column. */ +/*--------------------------------------------------------------------------*/ +{ + parseInfo Info; + int naxis, constant, typecode, newNullKwd=0; + long nelem, naxes[MAXDIMS], repeat, width; + int col_cnt, colNo; + Node *result; + char card[81], tform[16], nullKwd[9], tdimKwd[9]; + int hdutype; + + if( *status ) return( *status ); + + if( ffiprs( infptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis, + naxes, status ) ) { + ffcprs(); + return( *status ); + } + if( nelem<0 ) { + constant = 1; + nelem = -nelem; + } else + constant = 0; + + /* Case (1): If column exists put it there */ + + colNo = 0; + if( ffgcno( outfptr, CASEINSEN, parName, &colNo, status )==COL_NOT_FOUND ) { + + /* Output column doesn't exist. Test for keyword. */ + + /* Case (2): Does parName indicate result should be put into keyword */ + + *status = 0; + if( parName[0]=='#' ) { + if( ! constant ) { + ffcprs(); + ffpmsg( "Cannot put tabular result into keyword (ffcalc)" ); + return( *status = PARSE_BAD_TYPE ); + } + parName++; + + } else if( constant ) { + + /* Case (3): Does a keyword named parName already exist */ + + if( ffgcrd( outfptr, parName, card, status )==KEY_NO_EXIST ) { + colNo = -1; + } else if( *status ) { + ffcprs(); + return( *status ); + } + + } else + colNo = -1; + + if( colNo<0 ) { + + /* Case (4): Create new column */ + + *status = 0; + ffgncl( outfptr, &colNo, status ); + colNo++; + ffghdt( outfptr, &hdutype, status ); + if( parInfo==NULL || *parInfo=='\0' ) { + /* Figure out best default column type */ + if( hdutype==BINARY_TBL ) { + sprintf(tform,"%ld",nelem); + switch( Info.datatype ) { + case TLOGICAL: strcat(tform,"L"); break; + case TLONG: strcat(tform,"J"); break; + case TDOUBLE: strcat(tform,"D"); break; + case TSTRING: strcat(tform,"A"); break; + case TBIT: strcat(tform,"X"); break; + } + } else { + switch( Info.datatype ) { + case TLOGICAL: + ffcprs(); + ffpmsg("Cannot create LOGICAL column in ASCII table"); + return( *status = NOT_BTABLE ); + break; + case TLONG: strcpy(tform,"I11"); break; + case TDOUBLE: strcpy(tform,"D23.15"); break; + case TSTRING: + case TBIT: sprintf(tform,"A%ld",nelem); break; + } + } + parInfo = tform; + } else if( !(isdigit((int) *parInfo)) && hdutype==BINARY_TBL ) { + if( Info.datatype==TBIT && *parInfo=='B' ) + nelem = (nelem+7)/8; + sprintf(tform,"%ld%s",nelem,parInfo); + parInfo = tform; + } + fficol( outfptr, colNo, parName, parInfo, status ); + if( naxis>1 ) + ffptdm( outfptr, colNo, naxis, naxes, status ); + + /* Setup TNULLn keyword in case NULLs are encountered */ + + ffkeyn("TNULL", colNo, nullKwd, status); + if( ffgcrd( outfptr, nullKwd, card, status )==KEY_NO_EXIST ) { + *status = 0; + if( hdutype==BINARY_TBL ) { + long nullVal=0; + fits_binary_tform( parInfo, &typecode, &repeat, &width, status ); + if( typecode==TBYTE ) + nullVal = UCHAR_MAX; + else if( typecode==TSHORT ) + nullVal = SHRT_MIN; + else if( typecode==TINT ) + nullVal = INT_MIN; + else if( typecode==TLONG ) + nullVal = LONG_MIN; + if( nullVal ) { + ffpkyj( outfptr, nullKwd, nullVal, "Null value", status ); + fits_set_btblnull( outfptr, colNo, nullVal, status ); + newNullKwd = 1; + } + } else if( hdutype==ASCII_TBL ) { + ffpkys( outfptr, nullKwd, "NULL", "Null value string", status ); + fits_set_atblnull( outfptr, colNo, "NULL", status ); + newNullKwd = 1; + } + } + + } + + } else if( *status ) { + ffcprs(); + return( *status ); + } else { + + /********************************************************/ + /* Check if a TDIM keyword should be written/updated. */ + /********************************************************/ + + ffkeyn("TDIM", colNo, tdimKwd, status); + ffgcrd( outfptr, tdimKwd, card, status ); + if( *status==0 ) { + /* TDIM exists, so update it with result's dimension */ + ffptdm( outfptr, colNo, naxis, naxes, status ); + } else if( *status==KEY_NO_EXIST ) { + /* TDIM does not exist, so clear error stack and */ + /* write a TDIM only if result is multi-dimensional */ + *status = 0; + ffcmsg(); + if( naxis>1 ) + ffptdm( outfptr, colNo, naxis, naxes, status ); + } + if( *status ) { + /* Either some other error happened in ffgcrd */ + /* or one happened in ffptdm */ + ffcprs(); + return( *status ); + } + + } + + if( colNo>0 ) { + + /* Output column exists (now)... put results into it */ + + int anyNull = 0; + int nPerLp, i; + long totaln; + + ffgkyj(infptr, "NAXIS2", &totaln, 0, status); + + /*************************************/ + /* Create new iterator Output Column */ + /*************************************/ + + col_cnt = gParse.nCols; + if( allocateCol( col_cnt, status ) ) { + ffcprs(); + return( *status ); + } + + fits_iter_set_by_num( gParse.colData+col_cnt, outfptr, + colNo, 0, OutputCol ); + gParse.nCols++; + + for( i=0; i= 10) && (nRngs == 1) && + (start[0] == 1) && (end[0] == totaln)) + nPerLp = 0; + else + nPerLp = Info.maxRows; + + if( ffiter( gParse.nCols, gParse.colData, start[i]-1, + nPerLp, parse_data, (void*)&Info, status ) == -1 ) + *status = 0; + else if( *status ) { + ffcprs(); + return( *status ); + } + if( Info.anyNull ) anyNull = 1; + } + + if( newNullKwd && !anyNull ) { + ffdkey( outfptr, nullKwd, status ); + } + + } else { + + /* Put constant result into keyword */ + + result = gParse.Nodes + gParse.resultNode; + switch( Info.datatype ) { + case TDOUBLE: + ffukyd( outfptr, parName, result->value.data.dbl, 15, + parInfo, status ); + break; + case TLONG: + ffukyj( outfptr, parName, result->value.data.lng, parInfo, status ); + break; + case TLOGICAL: + ffukyl( outfptr, parName, result->value.data.log, parInfo, status ); + break; + case TBIT: + case TSTRING: + ffukys( outfptr, parName, result->value.data.str, parInfo, status ); + break; + } + } + + ffcprs(); + return( *status ); +} + +/*--------------------------------------------------------------------------*/ +int fftexp( fitsfile *fptr, /* I - Input FITS file */ + char *expr, /* I - Arithmetic expression */ + int maxdim, /* I - Max Dimension of naxes */ + int *datatype, /* O - Data type of result */ + long *nelem, /* O - Vector length of result */ + int *naxis, /* O - # of dimensions of result */ + long *naxes, /* O - Size of each dimension */ + int *status ) /* O - Error status */ +/* */ +/* Evaluate the given expression and return information on the result. */ +/*--------------------------------------------------------------------------*/ +{ + ffiprs( fptr, 0, expr, maxdim, datatype, nelem, naxis, naxes, status ); + ffcprs(); + return( *status ); +} + +/*--------------------------------------------------------------------------*/ +int ffiprs( fitsfile *fptr, /* I - Input FITS file */ + int compressed, /* I - Is FITS file hkunexpanded? */ + char *expr, /* I - Arithmetic expression */ + int maxdim, /* I - Max Dimension of naxes */ + int *datatype, /* O - Data type of result */ + long *nelem, /* O - Vector length of result */ + int *naxis, /* O - # of dimensions of result */ + long *naxes, /* O - Size of each dimension */ + int *status ) /* O - Error status */ +/* */ +/* Initialize the parser and determine what type of result the expression */ +/* produces. */ +/*--------------------------------------------------------------------------*/ +{ + Node *result; + int i,lexpr, tstatus = 0; + static iteratorCol dmyCol; + + if( *status ) return( *status ); + + /* Initialize the Parser structure */ + + gParse.def_fptr = fptr; + gParse.compressed = compressed; + gParse.nCols = 0; + gParse.colData = NULL; + gParse.varData = NULL; + gParse.getData = find_column; + gParse.loadData = load_column; + gParse.Nodes = NULL; + gParse.nNodesAlloc= 0; + gParse.nNodes = 0; + gParse.status = 0; + + if( ffgkyj(fptr, "NAXIS2", &gParse.totalRows, 0, &tstatus) ) + { + /* this might be a 1D or null image with no NAXIS2 keyword */ + gParse.totalRows = 0; + } + /* Copy expression into parser... read from file if necessary */ + + if( expr[0]=='@' ) { + if( ffimport_file( expr+1, &gParse.expr, status ) ) return( *status ); + lexpr = strlen(gParse.expr); + } else { + lexpr = strlen(expr); + gParse.expr = (char*)malloc( (2+lexpr)*sizeof(char)); + strcpy(gParse.expr,expr); + } + strcat(gParse.expr + lexpr,"\n"); + gParse.index = 0; + gParse.is_eobuf = 0; + + /* Parse the expression, building the Nodes and determing */ + /* which columns are neded and what data type is returned */ + + ffrestart(NULL); + if( ffparse() ) { + return( *status = PARSE_SYNTAX_ERR ); + } + /* Check results */ + + *status = gParse.status; + if( *status ) return(*status); + + if( !gParse.nNodes ) { + ffpmsg("Blank expression"); + return( *status = PARSE_SYNTAX_ERR ); + } + if( !gParse.nCols ) { + dmyCol.fptr = fptr; /* This allows iterator to know value of */ + gParse.colData = &dmyCol; /* fptr when no columns are referenced */ + } + + result = gParse.Nodes + gParse.resultNode; + + *naxis = result->value.naxis; + *nelem = result->value.nelem; + for( i=0; i<*naxis && ivalue.naxes[i]; + + switch( result->type ) { + case BOOLEAN: + *datatype = TLOGICAL; + break; + case LONG: + *datatype = TLONG; + break; + case DOUBLE: + *datatype = TDOUBLE; + break; + case BITSTR: + *datatype = TBIT; + break; + case STRING: + *datatype = TSTRING; + break; + default: + *datatype = 0; + ffpmsg("Bad return data type"); + *status = gParse.status = PARSE_BAD_TYPE; + break; + } + gParse.datatype = *datatype; + free(gParse.expr); + + if( result->operation==CONST_OP ) *nelem = - *nelem; + return(*status); +} + +/*--------------------------------------------------------------------------*/ +void ffcprs( void ) /* No parameters */ +/* */ +/* Clear the parser, making it ready to accept a new expression. */ +/*--------------------------------------------------------------------------*/ +{ + int col, node, i; + + if( gParse.nCols > 0 ) { + free( gParse.colData ); + for( col=0; col 0 ) { + node = gParse.nNodes; + while( node-- ) { + i = gParse.Nodes[node].SubNodes[0]; + if( gParse.Nodes[node].operation==gtifilt_fct ) { + free( gParse.Nodes[ i ].value.data.ptr ); + } + else if( gParse.Nodes[node].operation==regfilt_fct ) { + fits_free_region( (SAORegion *)gParse.Nodes[ i ].value.data.ptr ); + } + } + gParse.nNodes = 0; + } + if( gParse.Nodes ) free( gParse.Nodes ); + gParse.Nodes = NULL; +} + +/*---------------------------------------------------------------------------*/ +int parse_data( long totalrows, /* I - Total rows to be processed */ + long offset, /* I - Number of rows skipped at start*/ + long firstrow, /* I - First row of this iteration */ + long nrows, /* I - Number of rows in this iter */ + int nCols, /* I - Number of columns in use */ + iteratorCol *colData, /* IO- Column information/data */ + void *userPtr ) /* I - Data handling instructions */ +/* */ +/* Iterator work function which calls the parser and copies the results */ +/* into either an OutputCol or a data pointer supplied in the userPtr */ +/* structure. */ +/*---------------------------------------------------------------------------*/ +{ + int status, constant=0, anyNullThisTime=0; + long jj, kk, idx, remain, ntodo; + Node *result; + + /* declare variables static to preserve their values between calls */ + static void *Data, *Null; + static int datasize; + static long lastRow, jnull, repeat, resDataSize; + static parseInfo *userInfo; + static long zeros[4] = {0,0,0,0}; + + /*--------------------------------------------------------*/ + /* Initialization procedures: execute on the first call */ + /*--------------------------------------------------------*/ + if (firstrow == offset+1) + { + userInfo = (parseInfo*)userPtr; + userInfo->anyNull = 0; + + if( userInfo->maxRows>0 ) + userInfo->maxRows = minvalue(totalrows,userInfo->maxRows); + else if( userInfo->maxRows<0 ) + userInfo->maxRows = totalrows; + else + userInfo->maxRows = nrows; + + lastRow = firstrow + userInfo->maxRows - 1; + + if( userInfo->dataPtr==NULL ) { + + if( colData[nCols-1].iotype == InputCol ) { + ffpmsg("Output column for parser results not found!"); + return( PARSE_NO_OUTPUT ); + } + /* Data gets set later */ + Null = colData[nCols-1].array; + userInfo->datatype = colData[nCols-1].datatype; + + /* Check for a TNULL keyword for output column */ + + status = 0; + jnull = 0L; + ffgknj( colData[nCols-1].fptr, "TNULL", colData[nCols-1].colnum, + 1, &jnull, (int*)&jj, &status ); + if( status==BAD_INTKEY ) { + /* Probably ASCII table with text TNULL keyword */ + switch( userInfo->datatype ) { + case TSHORT: jnull = SHRT_MIN; break; + case TINT: jnull = INT_MIN; break; + case TLONG: jnull = LONG_MIN; break; + } + } + repeat = colData[nCols-1].repeat; + + } else { + + Data = userInfo->dataPtr; + Null = (userInfo->nullPtr ? userInfo->nullPtr : zeros); + repeat = gParse.Nodes[gParse.resultNode].value.nelem; + + } + + /* Determine the size of each element of the returned result */ + + switch( userInfo->datatype ) { + case TBIT: /* Fall through to TBYTE */ + case TLOGICAL: /* Fall through to TBYTE */ + case TBYTE: datasize = sizeof(char); break; + case TSHORT: datasize = sizeof(short); break; + case TINT: datasize = sizeof(int); break; + case TLONG: datasize = sizeof(long); break; + case TFLOAT: datasize = sizeof(float); break; + case TDOUBLE: datasize = sizeof(double); break; + case TSTRING: datasize = sizeof(char*); break; + } + + /* Determine the size of each element of the calculated result */ + /* (only matters for numeric/logical data) */ + + switch( gParse.Nodes[gParse.resultNode].type ) { + case BOOLEAN: resDataSize = sizeof(char); break; + case LONG: resDataSize = sizeof(long); break; + case DOUBLE: resDataSize = sizeof(double); break; + } + } + + /*-------------------------------------------*/ + /* Main loop: process all the rows of data */ + /*-------------------------------------------*/ + + /* If writing to output column, set first element to appropriate */ + /* null value. If no NULLs encounter, zero out before returning. */ + + if( userInfo->dataPtr == NULL ) { + /* First, reset Data pointer to start of output array */ + Data = (char*)colData[nCols-1].array + datasize; + + switch( userInfo->datatype ) { + case TLOGICAL: *(char *)Null = 'U'; break; + case TBYTE: *(char *)Null = (char )jnull; break; + case TSHORT: *(short *)Null = (short)jnull; break; + case TINT: *(int *)Null = (int )jnull; break; + case TLONG: *(long *)Null = (long )jnull; break; + case TFLOAT: *(float *)Null = FLOATNULLVALUE; break; + case TDOUBLE: *(double*)Null = DOUBLENULLVALUE; break; + case TSTRING: (*(char **)Null)[0] = '\1'; + (*(char **)Null)[1] = '\0'; break; + } + } + + /* Alter nrows in case calling routine didn't want to do all rows */ + + nrows = minvalue(nrows,lastRow-firstrow+1); + + Setup_DataArrays( nCols, colData, firstrow, nrows ); + + /* Parser allocates arrays for each column and calculation it performs. */ + /* Limit number of rows processed during each pass to reduce memory */ + /* requirements... In most cases, iterator will limit rows to less */ + /* than 2500 rows per iteration, so this is really only relevant for */ + /* hk-compressed files which must be decompressed in memory and sent */ + /* whole to parse_data in a single iteration. */ + + remain = nrows; + while( remain ) { + + ntodo = minvalue(remain,2500); + Evaluate_Parser ( firstrow, ntodo ); + if( gParse.status ) break; + + firstrow += ntodo; + remain -= ntodo; + + /* Copy results into data array */ + + result = gParse.Nodes + gParse.resultNode; + if( result->operation==CONST_OP ) constant = 1; + + switch( result->type ) { + + case BOOLEAN: + case LONG: + case DOUBLE: + if( constant ) { + char undef=0; + for( kk=0; kkvalue.data), + &undef, result->value.nelem /* 1 */, + userInfo->datatype, Null, + (char*)Data + (kk*repeat+jj)*datasize, + &anyNullThisTime, &gParse.status ); + } else { + if ( repeat == result->value.nelem ) { + ffcvtn( gParse.datatype, + result->value.data.ptr, + result->value.undef, + result->value.nelem*ntodo, + userInfo->datatype, Null, Data, + &anyNullThisTime, &gParse.status ); + } else if( result->value.nelem == 1 ) { + for( kk=0; kkvalue.data.ptr + kk*resDataSize, + (char*)result->value.undef + kk, + 1, userInfo->datatype, Null, + (char*)Data + (kk*repeat+jj)*datasize, + &anyNullThisTime, &gParse.status ); + } + } else { + int nCopy; + nCopy = minvalue( repeat, result->value.nelem ); + for( kk=0; kkvalue.data.ptr + + kk*result->value.nelem*resDataSize, + (char*)result->value.undef + + kk*result->value.nelem, + nCopy, userInfo->datatype, Null, + (char*)Data + (kk*repeat)*datasize, + &anyNullThisTime, &gParse.status ); + if( nCopy < repeat ) { + memset( (char*)Data + (kk*repeat+nCopy)*datasize, + 0, (repeat-nCopy)*datasize); + } + } + + } + if( result->operation>0 ) { + free( result->value.data.ptr ); + } + } + if( gParse.status==OVERFLOW_ERR ) { + gParse.status = NUM_OVERFLOW; + ffpmsg("Numerical overflow while converting expression to necessary datatype"); + } + break; + + case BITSTR: + switch( userInfo->datatype ) { + case TBYTE: + idx = -1; + for( kk=0; kkvalue.nelem; jj++ ) { + if( jj%8 == 0 ) + ((char*)Data)[++idx] = 0; + if( constant ) { + if( result->value.data.str[jj]=='1' ) + ((char*)Data)[idx] |= 128>>(jj%8); + } else { + if( result->value.data.strptr[kk][jj]=='1' ) + ((char*)Data)[idx] |= 128>>(jj%8); + } + } + } + break; + case TBIT: + case TLOGICAL: + if( constant ) { + for( kk=0; kkvalue.nelem; jj++ ) { + ((char*)Data)[ jj+kk*result->value.nelem ] = + ( result->value.data.str[jj]=='1' ); + } + } else { + for( kk=0; kkvalue.nelem; jj++ ) { + ((char*)Data)[ jj+kk*result->value.nelem ] = + ( result->value.data.strptr[kk][jj]=='1' ); + } + } + break; + case TSTRING: + if( constant ) { + for( jj=0; jjvalue.data.str ); + } + } else { + for( jj=0; jjvalue.data.strptr[jj] ); + } + } + break; + default: + ffpmsg("Cannot convert bit expression to desired type."); + gParse.status = PARSE_BAD_TYPE; + break; + } + if( result->operation>0 ) { + free( result->value.data.strptr[0] ); + free( result->value.data.strptr ); + } + break; + + case STRING: + if( userInfo->datatype==TSTRING ) { + if( constant ) { + for( jj=0; jjvalue.data.str ); + } else { + for( jj=0; jjvalue.undef[jj] ) { + anyNullThisTime = 1; + strcpy( ((char**)Data)[jj], + *(char **)Null ); + } else { + strcpy( ((char**)Data)[jj], + result->value.data.strptr[jj] ); + } + } + } else { + ffpmsg("Cannot convert string expression to desired type."); + gParse.status = PARSE_BAD_TYPE; + } + if( result->operation>0 ) { + free( result->value.data.strptr[0] ); + free( result->value.data.strptr ); + } + break; + } + + if( gParse.status ) break; + + /* Increment Data to point to where the next block should go */ + + if( result->type==BITSTR && userInfo->datatype==TBYTE ) + Data = (char*)Data + + datasize * ( (result->value.nelem+7)/8 ) * ntodo; + else if( result->type==STRING ) + Data = (char*)Data + datasize * ntodo; + else + Data = (char*)Data + datasize * ntodo * repeat; + } + + /* If no NULLs encountered during this pass, set Null value to */ + /* zero to make the writing of the output column data faster */ + + if( anyNullThisTime ) + userInfo->anyNull = 1; + else if( userInfo->dataPtr == NULL ) { + if( userInfo->datatype == TSTRING ) + memcpy( *(char **)Null, zeros, 2 ); + else + memcpy( Null, zeros, datasize ); + } + + /*-------------------------------------------------------*/ + /* Clean up procedures: after processing all the rows */ + /*-------------------------------------------------------*/ + + if( firstrow - 1 == lastRow ) { + if( !gParse.status && userInfo->maxRows UCHAR_MAX ) { + *status = OVERFLOW_ERR; + ((unsigned char*)output)[i] = UCHAR_MAX; + } else + ((unsigned char*)output)[i] = + (unsigned char) ((long*)input)[i]; + } + } + return( *status ); + break; + case TFLOAT: + fffr4i1((float*)input,ntodo,1.,0.,0,0,NULL,NULL, + (unsigned char*)output,status); + break; + case TDOUBLE: + fffr8i1((double*)input,ntodo,1.,0.,0,0,NULL,NULL, + (unsigned char*)output,status); + break; + default: + *status = BAD_DATATYPE; + break; + } + for(i=0;i SHRT_MAX ) { + *status = OVERFLOW_ERR; + ((short*)output)[i] = SHRT_MAX; + } else + ((short*)output)[i] = (short) ((long*)input)[i]; + } + } + return( *status ); + break; + case TFLOAT: + fffr4i2((float*)input,ntodo,1.,0.,0,0,NULL,NULL, + (short*)output,status); + break; + case TDOUBLE: + fffr8i2((double*)input,ntodo,1.,0.,0,0,NULL,NULL, + (short*)output,status); + break; + default: + *status = BAD_DATATYPE; + break; + } + for(i=0;i=0 ) { + found[parNo] = 1; /* Flag this parameter as found */ + switch( gParse.colData[parNo].datatype ) { + case TLONG: + ffgcvj( fptr, gParse.valCol, row, 1L, 1L, + ((long*)gParse.colData[parNo].array)[0], + ((long*)gParse.colData[parNo].array)+currelem, + &anynul, status ); + break; + case TDOUBLE: + ffgcvd( fptr, gParse.valCol, row, 1L, 1L, + ((double*)gParse.colData[parNo].array)[0], + ((double*)gParse.colData[parNo].array)+currelem, + &anynul, status ); + break; + case TSTRING: + ffgcvs( fptr, gParse.valCol, row, 1L, 1L, + ((char**)gParse.colData[parNo].array)[0], + ((char**)gParse.colData[parNo].array)+currelem, + &anynul, status ); + break; + } + if( *status ) return( *status ); + } + } + + if( currelemoperation==CONST_OP ) { + + if( result->value.data.log ) { + *(long*)userPtr = firstrow; + return( -1 ); + } + + } else { + + for( idx=0; idxvalue.data.logptr[idx] && !result->value.undef[idx] ) { + *(long*)userPtr = firstrow + idx; + return( -1 ); + } + } + } + + return( gParse.status ); +} + + +/************************************************************************* + + Functions used by the evaluator to access FITS data + (find_column, find_keywd, allocateCol, load_column) + + *************************************************************************/ + + +static int find_column( char *colName, void *itslval ) +{ + FFSTYPE *thelval = (FFSTYPE*)itslval; + int col_cnt, status; + int colnum, typecode, type, hdutype; + long repeat, width; + fitsfile *fptr; + char temp[80]; + double tzero,tscale; + int istatus; + + if( *colName == '#' ) + return( find_keywd( colName + 1, itslval ) ); + + fptr = gParse.def_fptr; + status = 0; + if( gParse.compressed ) + colnum = gParse.valCol; + else + if( fits_get_colnum( fptr, CASEINSEN, colName, &colnum, &status ) ) { + if( status == COL_NOT_FOUND ) { + type = find_keywd( colName, itslval ); + if( type != pERROR ) ffcmsg(); + return( type ); + } + gParse.status = status; + return pERROR; + } + + if( fits_get_coltype( fptr, colnum, &typecode, + &repeat, &width, &status ) ) { + gParse.status = status; + return pERROR; + } + + col_cnt = gParse.nCols; + if( allocateCol( col_cnt, &gParse.status ) ) return pERROR; + fits_iter_set_by_num( gParse.colData+col_cnt, fptr, colnum, 0, InputCol ); + + /* Make sure we don't overflow variable name array */ + strncpy(gParse.varData[col_cnt].name,colName,MAXVARNAME); + gParse.varData[col_cnt].name[MAXVARNAME] = '\0'; + + switch( typecode ) { + case TBIT: + gParse.varData[col_cnt].type = BITSTR; + gParse.colData[col_cnt].datatype = TBYTE; + type = BITCOL; + break; + case TBYTE: + case TSHORT: + case TLONG: + /* The datatype of column with TZERO and TSCALE keywords might be + float or double. + */ + sprintf(temp,"TZERO%d",colnum); + istatus = 0; + if(fits_read_key(fptr,TDOUBLE,temp,&tzero,NULL,&istatus)) { + tzero = 0.0; + } + sprintf(temp,"TSCAL%d",colnum); + istatus = 0; + if(fits_read_key(fptr,TDOUBLE,temp,&tscale,NULL,&istatus)) { + tscale = 1.0; + } + if (tscale == 1.0 && (tzero == 0.0 || tzero == 32768.0 )) { + gParse.varData[col_cnt].type = LONG; + gParse.colData[col_cnt].datatype = TLONG; + } else if (tscale == 1.0 && tzero == 2147483648.0 ) { + gParse.varData[col_cnt].type = LONG; + gParse.colData[col_cnt].datatype = TULONG; + } else { + gParse.varData[col_cnt].type = DOUBLE; + gParse.colData[col_cnt].datatype = TDOUBLE; + } + type = COLUMN; + break; + case TFLOAT: + case TDOUBLE: + gParse.varData[col_cnt].type = DOUBLE; + gParse.colData[col_cnt].datatype = TDOUBLE; + type = COLUMN; + break; + case TLOGICAL: + gParse.varData[col_cnt].type = BOOLEAN; + gParse.colData[col_cnt].datatype = TLOGICAL; + type = BCOLUMN; + break; + case TSTRING: + gParse.varData[col_cnt].type = STRING; + gParse.colData[col_cnt].datatype = TSTRING; + type = SCOLUMN; + fits_get_hdu_type( fptr, &hdutype, &status ); + if( hdutype == ASCII_TBL ) repeat = width; + break; + default: + gParse.status = PARSE_BAD_TYPE; + return pERROR; + } + gParse.varData[col_cnt].nelem = repeat; + if( repeat>1 && typecode!=TSTRING ) { + if( fits_read_tdim( fptr, colnum, MAXDIMS, + &gParse.varData[col_cnt].naxis, + &gParse.varData[col_cnt].naxes[0], &status ) + ) { + gParse.status = status; + return pERROR; + } + } else { + gParse.varData[col_cnt].naxis = 1; + gParse.varData[col_cnt].naxes[0] = 1; + } + gParse.nCols++; + thelval->lng = col_cnt; + + return( type ); +} + +static int find_keywd(char *keyname, void *itslval ) +{ + FFSTYPE *thelval = (FFSTYPE*)itslval; + int status, type; + char keyvalue[FLEN_VALUE], dtype; + fitsfile *fptr; + double rval; + int bval; + long ival; + + status = 0; + fptr = gParse.def_fptr; + if( fits_read_keyword( fptr, keyname, keyvalue, NULL, &status ) ) { + if( status == KEY_NO_EXIST ) { + /* Do this since ffgkey doesn't put an error message on stack */ + sprintf(keyvalue, "ffgkey could not find keyword: %s",keyname); + ffpmsg(keyvalue); + } + gParse.status = status; + return( pERROR ); + } + + if( fits_get_keytype( keyvalue, &dtype, &status ) ) { + gParse.status = status; + return( pERROR ); + } + + switch( dtype ) { + case 'C': + fits_read_key_str( fptr, keyname, keyvalue, NULL, &status ); + type = STRING; + strcpy( thelval->str , keyvalue ); + break; + case 'L': + fits_read_key_log( fptr, keyname, &bval, NULL, &status ); + type = BOOLEAN; + thelval->log = bval; + break; + case 'I': + fits_read_key_lng( fptr, keyname, &ival, NULL, &status ); + type = LONG; + thelval->lng = ival; + break; + case 'F': + fits_read_key_dbl( fptr, keyname, &rval, NULL, &status ); + type = DOUBLE; + thelval->dbl = rval; + break; + default: + type = pERROR; + break; + } + + if( status ) { + gParse.status=status; + return pERROR; + } + + return( type ); +} + +static int allocateCol( int nCol, int *status ) +{ + if( (nCol%25)==0 ) { + if( nCol ) { + gParse.colData = (iteratorCol*) realloc( gParse.colData, + (nCol+25)*sizeof(iteratorCol) ); + gParse.varData = (DataInfo *) realloc( gParse.varData, + (nCol+25)*sizeof(DataInfo) ); + } else { + gParse.colData = (iteratorCol*) malloc( 25*sizeof(iteratorCol) ); + gParse.varData = (DataInfo *) malloc( 25*sizeof(DataInfo) ); + } + if( gParse.colData == NULL + || gParse.varData == NULL ) { + if( gParse.colData ) free(gParse.colData); + if( gParse.varData ) free(gParse.varData); + gParse.colData = NULL; + gParse.varData = NULL; + return( *status = MEMORY_ALLOCATION ); + } + } + gParse.varData[nCol].data = NULL; + gParse.varData[nCol].undef = NULL; + return 0; +} + +static int load_column( int varNum, long fRow, long nRows, + void *data, char *undef ) +{ + iteratorCol *var = gParse.colData+varNum; + long nelem,nbytes,row,len,idx; + char **bitStrs; + unsigned char *bytes; + int status = 0, anynul; + + nelem = nRows * var->repeat; + + switch( var->datatype ) { + case TBYTE: + nbytes = ((var->repeat+7)/8) * nRows; + bytes = (unsigned char *)malloc( nbytes * sizeof(char) ); + + ffgcvb(var->fptr, var->colnum, fRow, 1L, nbytes, + 0, bytes, &anynul, &status); + + nelem = var->repeat; + bitStrs = (char **)data; + for( row=0; rowfptr, var->colnum, fRow, 1L, nRows, + (char **)data, undef, &anynul, &status); + break; + case TLOGICAL: + ffgcfl(var->fptr, var->colnum, fRow, 1L, nelem, + (char *)data, undef, &anynul, &status); + break; + case TLONG: + ffgcfj(var->fptr, var->colnum, fRow, 1L, nelem, + (long *)data, undef, &anynul, &status); + break; + case TDOUBLE: + ffgcfd(var->fptr, var->colnum, fRow, 1L, nelem, + (double *)data, undef, &anynul, &status); + break; + } + + if( status ) { + gParse.status = status; + return pERROR; + } + + return 0; +} diff --git a/pkg/tbtables/cfitsio/eval_l.c b/pkg/tbtables/cfitsio/eval_l.c new file mode 100644 index 00000000..4eb58555 --- /dev/null +++ b/pkg/tbtables/cfitsio/eval_l.c @@ -0,0 +1,2219 @@ +/* A lexical scanner generated by flex */ + +/* Scanner skeleton version: + * $Header: /thor/data2/sienkiew/cvs/st/tables/lib/tbtables/cfitsio/eval_l.c,v 1.11 2005/09/27 14:58:21 hodge Exp $ + */ + +#define FLEX_SCANNER +#define FF_FLEX_MAJOR_VERSION 2 +#define FF_FLEX_MINOR_VERSION 5 + +#include + + +/* cfront 1.2 defines "c_plusplus" instead of "__cplusplus" */ +#ifdef c_plusplus +#ifndef __cplusplus +#define __cplusplus +#endif +#endif + + +#ifdef __cplusplus + +#include +#include + +/* Use prototypes in function declarations. */ +#define FF_USE_PROTOS + +/* The "const" storage-class-modifier is valid. */ +#define FF_USE_CONST + +#else /* ! __cplusplus */ + +#if __STDC__ + +#define FF_USE_PROTOS +#define FF_USE_CONST + +#endif /* __STDC__ */ +#endif /* ! __cplusplus */ + +#ifdef __TURBOC__ + #pragma warn -rch + #pragma warn -use +#include +#include +#define FF_USE_CONST +#define FF_USE_PROTOS +#endif + +#ifdef FF_USE_CONST +#define ffconst const +#else +#define ffconst +#endif + + +#ifdef FF_USE_PROTOS +#define FF_PROTO(proto) proto +#else +#define FF_PROTO(proto) () +#endif + +/* Returned upon end-of-file. */ +#define FF_NULL 0 + +/* Promotes a possibly negative, possibly signed char to an unsigned + * integer for use as an array index. If the signed char is negative, + * we want to instead treat it as an 8-bit unsigned char, hence the + * double cast. + */ +#define FF_SC_TO_UI(c) ((unsigned int) (unsigned char) c) + +/* Enter a start condition. This macro really ought to take a parameter, + * but we do it the disgusting crufty way forced on us by the ()-less + * definition of BEGIN. + */ +#define BEGIN ff_start = 1 + 2 * + +/* Translate the current start state into a value that can be later handed + * to BEGIN to return to the state. The FFSTATE alias is for lex + * compatibility. + */ +#define FF_START ((ff_start - 1) / 2) +#define FFSTATE FF_START + +/* Action number for EOF rule of a given start state. */ +#define FF_STATE_EOF(state) (FF_END_OF_BUFFER + state + 1) + +/* Special action meaning "start processing a new file". */ +#define FF_NEW_FILE ffrestart( ffin ) + +#define FF_END_OF_BUFFER_CHAR 0 + +/* Size of default input buffer. */ +#define FF_BUF_SIZE 16384 + +typedef struct ff_buffer_state *FF_BUFFER_STATE; + +extern int ffleng; +extern FILE *ffin, *ffout; + +#define EOB_ACT_CONTINUE_SCAN 0 +#define EOB_ACT_END_OF_FILE 1 +#define EOB_ACT_LAST_MATCH 2 + +/* The funky do-while in the following #define is used to turn the definition + * int a single C statement (which needs a semi-colon terminator). This + * avoids problems with code like: + * + * if ( condition_holds ) + * ffless( 5 ); + * else + * do_something_else(); + * + * Prior to using the do-while the compiler would get upset at the + * "else" because it interpreted the "if" statement as being all + * done when it reached the ';' after the ffless() call. + */ + +/* Return all but the first 'n' matched characters back to the input stream. */ + +#define ffless(n) \ + do \ + { \ + /* Undo effects of setting up fftext. */ \ + *ff_cp = ff_hold_char; \ + FF_RESTORE_FF_MORE_OFFSET \ + ff_c_buf_p = ff_cp = ff_bp + n - FF_MORE_ADJ; \ + FF_DO_BEFORE_ACTION; /* set up fftext again */ \ + } \ + while ( 0 ) + +#define unput(c) ffunput( c, fftext_ptr ) + +/* The following is because we cannot portably get our hands on size_t + * (without autoconf's help, which isn't available because we want + * flex-generated scanners to compile on their own). + */ +typedef unsigned int ff_size_t; + + +struct ff_buffer_state + { + FILE *ff_input_file; + + char *ff_ch_buf; /* input buffer */ + char *ff_buf_pos; /* current position in input buffer */ + + /* Size of input buffer in bytes, not including room for EOB + * characters. + */ + ff_size_t ff_buf_size; + + /* Number of characters read into ff_ch_buf, not including EOB + * characters. + */ + int ff_n_chars; + + /* Whether we "own" the buffer - i.e., we know we created it, + * and can realloc() it to grow it, and should free() it to + * delete it. + */ + int ff_is_our_buffer; + + /* Whether this is an "interactive" input source; if so, and + * if we're using stdio for input, then we want to use getc() + * instead of fread(), to make sure we stop fetching input after + * each newline. + */ + int ff_is_interactive; + + /* Whether we're considered to be at the beginning of a line. + * If so, '^' rules will be active on the next match, otherwise + * not. + */ + int ff_at_bol; + + /* Whether to try to fill the input buffer when we reach the + * end of it. + */ + int ff_fill_buffer; + + int ff_buffer_status; +#define FF_BUFFER_NEW 0 +#define FF_BUFFER_NORMAL 1 + /* When an EOF's been seen but there's still some text to process + * then we mark the buffer as FF_EOF_PENDING, to indicate that we + * shouldn't try reading from the input source any more. We might + * still have a bunch of tokens to match, though, because of + * possible backing-up. + * + * When we actually see the EOF, we change the status to "new" + * (via ffrestart()), so that the user can continue scanning by + * just pointing ffin at a new input file. + */ +#define FF_BUFFER_EOF_PENDING 2 + }; + +static FF_BUFFER_STATE ff_current_buffer = 0; + +/* We provide macros for accessing buffer states in case in the + * future we want to put the buffer states in a more general + * "scanner state". + */ +#define FF_CURRENT_BUFFER ff_current_buffer + + +/* ff_hold_char holds the character lost when fftext is formed. */ +static char ff_hold_char; + +static int ff_n_chars; /* number of characters read into ff_ch_buf */ + + +int ffleng; + +/* Points to current character in buffer. */ +static char *ff_c_buf_p = (char *) 0; +static int ff_init = 1; /* whether we need to initialize */ +static int ff_start = 0; /* start state number */ + +/* Flag which is used to allow ffwrap()'s to do buffer switches + * instead of setting up a fresh ffin. A bit of a hack ... + */ +static int ff_did_buffer_switch_on_eof; + +void ffrestart FF_PROTO(( FILE *input_file )); + +void ff_switch_to_buffer FF_PROTO(( FF_BUFFER_STATE new_buffer )); +void ff_load_buffer_state FF_PROTO(( void )); +FF_BUFFER_STATE ff_create_buffer FF_PROTO(( FILE *file, int size )); +void ff_delete_buffer FF_PROTO(( FF_BUFFER_STATE b )); +void ff_init_buffer FF_PROTO(( FF_BUFFER_STATE b, FILE *file )); +void ff_flush_buffer FF_PROTO(( FF_BUFFER_STATE b )); +#define FF_FLUSH_BUFFER ff_flush_buffer( ff_current_buffer ) + +FF_BUFFER_STATE ff_scan_buffer FF_PROTO(( char *base, ff_size_t size )); +FF_BUFFER_STATE ff_scan_string FF_PROTO(( ffconst char *ff_str )); +FF_BUFFER_STATE ff_scan_bytes FF_PROTO(( ffconst char *bytes, int len )); + +static void *ff_flex_alloc FF_PROTO(( ff_size_t )); +static void *ff_flex_realloc FF_PROTO(( void *, ff_size_t )); +static void ff_flex_free FF_PROTO(( void * )); + +#define ff_new_buffer ff_create_buffer + +#define ff_set_interactive(is_interactive) \ + { \ + if ( ! ff_current_buffer ) \ + ff_current_buffer = ff_create_buffer( ffin, FF_BUF_SIZE ); \ + ff_current_buffer->ff_is_interactive = is_interactive; \ + } + +#define ff_set_bol(at_bol) \ + { \ + if ( ! ff_current_buffer ) \ + ff_current_buffer = ff_create_buffer( ffin, FF_BUF_SIZE ); \ + ff_current_buffer->ff_at_bol = at_bol; \ + } + +#define FF_AT_BOL() (ff_current_buffer->ff_at_bol) + +typedef unsigned char FF_CHAR; +FILE *ffin = (FILE *) 0, *ffout = (FILE *) 0; +typedef int ff_state_type; +extern char *fftext; +#define fftext_ptr fftext + +static ff_state_type ff_get_previous_state FF_PROTO(( void )); +static ff_state_type ff_try_NUL_trans FF_PROTO(( ff_state_type current_state )); +static int ff_get_next_buffer FF_PROTO(( void )); +static void ff_fatal_error FF_PROTO(( ffconst char msg[] )); + +/* Done after the current pattern has been matched and before the + * corresponding action - sets up fftext. + */ +#define FF_DO_BEFORE_ACTION \ + fftext_ptr = ff_bp; \ + ffleng = (int) (ff_cp - ff_bp); \ + ff_hold_char = *ff_cp; \ + *ff_cp = '\0'; \ + ff_c_buf_p = ff_cp; + +#define FF_NUM_RULES 26 +#define FF_END_OF_BUFFER 27 +static ffconst short int ff_accept[160] = + { 0, + 0, 0, 27, 25, 1, 24, 15, 25, 25, 25, + 25, 25, 25, 25, 7, 5, 21, 25, 20, 10, + 10, 10, 10, 6, 10, 10, 10, 10, 10, 14, + 10, 10, 10, 10, 10, 10, 10, 25, 1, 19, + 0, 9, 0, 8, 0, 10, 17, 0, 0, 0, + 0, 0, 0, 0, 14, 0, 7, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, + 5, 0, 23, 18, 22, 10, 10, 10, 2, 10, + 10, 10, 4, 10, 10, 10, 10, 3, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 16, 0, + + 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 7, 11, 10, + 20, 21, 10, 10, 10, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 15, 0, 0, 12, 0, + 0, 0, 0, 0, 0, 0, 13, 0, 0 + } ; + +static ffconst int ff_ec[256] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 2, 4, 5, 6, 7, 1, 8, 9, 10, + 11, 12, 13, 1, 13, 14, 1, 15, 15, 16, + 16, 16, 16, 16, 16, 17, 17, 1, 1, 18, + 19, 20, 1, 1, 21, 22, 23, 24, 25, 26, + 27, 28, 29, 30, 30, 31, 30, 32, 33, 30, + 34, 35, 30, 36, 37, 30, 30, 38, 30, 30, + 1, 1, 1, 39, 40, 1, 41, 42, 23, 43, + + 44, 45, 46, 28, 47, 30, 30, 48, 30, 49, + 50, 30, 51, 52, 30, 53, 54, 30, 30, 38, + 30, 30, 1, 55, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1 + } ; + +static ffconst int ff_meta[56] = + { 0, + 1, 1, 2, 1, 1, 1, 3, 1, 1, 1, + 1, 1, 1, 1, 4, 4, 4, 1, 1, 1, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 1, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 1 + } ; + +static ffconst short int ff_base[167] = + { 0, + 0, 0, 367, 368, 364, 368, 346, 359, 356, 355, + 353, 351, 32, 347, 66, 103, 339, 44, 338, 25, + 52, 316, 26, 315, 34, 133, 48, 61, 125, 368, + 0, 29, 45, 60, 81, 82, 93, 299, 351, 368, + 347, 368, 344, 343, 342, 368, 368, 339, 314, 315, + 313, 294, 295, 293, 368, 121, 164, 307, 301, 70, + 117, 43, 296, 276, 271, 58, 86, 79, 269, 152, + 168, 181, 368, 368, 368, 151, 162, 0, 180, 189, + 190, 191, 309, 196, 199, 205, 204, 211, 214, 207, + 223, 224, 232, 238, 243, 245, 222, 246, 368, 311, + + 310, 279, 282, 278, 259, 262, 258, 252, 286, 295, + 294, 293, 292, 291, 290, 267, 288, 258, 285, 284, + 278, 270, 268, 259, 218, 252, 264, 272, 368, 251, + 368, 368, 260, 280, 283, 236, 222, 230, 193, 184, + 212, 208, 202, 173, 156, 368, 133, 126, 368, 104, + 98, 119, 132, 80, 94, 92, 368, 78, 368, 323, + 325, 329, 333, 68, 67, 337 + } ; + +static ffconst short int ff_def[167] = + { 0, + 159, 1, 159, 159, 159, 159, 159, 160, 161, 162, + 159, 163, 159, 159, 159, 159, 159, 159, 159, 164, + 164, 164, 164, 164, 164, 164, 164, 164, 164, 159, + 165, 164, 164, 164, 164, 164, 164, 159, 159, 159, + 160, 159, 166, 161, 162, 159, 159, 163, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 164, 164, 165, 164, 164, + 164, 164, 26, 164, 164, 164, 164, 164, 164, 164, + 164, 164, 164, 164, 164, 164, 164, 164, 159, 166, + + 166, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 164, + 159, 159, 164, 164, 164, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 0, 159, + 159, 159, 159, 159, 159, 159 + } ; + +static ffconst short int ff_nxt[424] = + { 0, + 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + 4, 14, 4, 15, 16, 16, 16, 17, 18, 19, + 20, 21, 22, 22, 23, 24, 25, 26, 22, 22, + 27, 28, 29, 22, 22, 24, 22, 22, 30, 31, + 32, 21, 22, 33, 24, 34, 22, 35, 36, 37, + 22, 22, 24, 22, 38, 49, 77, 50, 81, 80, + 51, 73, 74, 75, 78, 78, 79, 115, 78, 82, + 78, 76, 84, 78, 52, 116, 53, 90, 54, 56, + 57, 57, 57, 85, 78, 86, 58, 78, 157, 79, + 59, 78, 60, 87, 111, 91, 61, 62, 63, 78, + + 78, 120, 157, 92, 157, 112, 64, 88, 88, 65, + 121, 66, 93, 67, 68, 69, 70, 71, 71, 71, + 78, 78, 124, 158, 94, 96, 72, 72, 125, 122, + 88, 97, 78, 95, 56, 108, 108, 108, 123, 88, + 88, 113, 157, 156, 98, 72, 72, 83, 83, 83, + 155, 154, 114, 83, 83, 83, 83, 83, 83, 89, + 129, 153, 88, 152, 78, 56, 57, 57, 57, 146, + 83, 129, 78, 83, 83, 83, 83, 83, 57, 57, + 57, 70, 71, 71, 71, 130, 47, 72, 72, 129, + 78, 72, 72, 127, 79, 128, 128, 128, 129, 129, + + 129, 78, 74, 75, 131, 129, 72, 72, 129, 73, + 72, 72, 132, 129, 129, 146, 129, 79, 40, 78, + 129, 47, 149, 129, 151, 88, 88, 99, 78, 78, + 78, 129, 129, 129, 150, 78, 74, 75, 78, 133, + 149, 129, 148, 78, 78, 131, 78, 129, 88, 134, + 78, 73, 129, 78, 129, 129, 132, 147, 40, 99, + 129, 78, 78, 78, 47, 99, 108, 108, 108, 129, + 145, 78, 40, 146, 135, 72, 72, 78, 128, 128, + 128, 132, 78, 73, 78, 78, 128, 128, 128, 129, + 78, 131, 129, 47, 72, 72, 146, 75, 74, 78, + + 144, 99, 143, 40, 132, 73, 131, 75, 74, 142, + 141, 140, 139, 138, 137, 136, 101, 101, 129, 78, + 126, 119, 78, 41, 118, 41, 41, 44, 44, 45, + 117, 45, 45, 48, 110, 48, 48, 100, 109, 100, + 100, 107, 106, 105, 104, 103, 102, 42, 46, 159, + 101, 42, 39, 99, 78, 78, 75, 73, 55, 42, + 47, 46, 43, 42, 40, 39, 159, 3, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159 + } ; + +static ffconst short int ff_chk[424] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 13, 20, 13, 25, 23, + 13, 18, 18, 18, 20, 23, 21, 62, 32, 25, + 165, 164, 27, 25, 13, 62, 13, 32, 13, 15, + 15, 15, 15, 27, 33, 28, 15, 27, 158, 21, + 15, 21, 15, 28, 60, 33, 15, 15, 15, 34, + + 28, 66, 156, 34, 155, 60, 15, 37, 37, 15, + 66, 15, 34, 15, 15, 15, 16, 16, 16, 16, + 35, 36, 68, 154, 35, 36, 16, 16, 68, 67, + 37, 36, 37, 35, 56, 56, 56, 56, 67, 29, + 29, 61, 153, 152, 37, 16, 16, 26, 26, 26, + 151, 150, 61, 26, 26, 26, 26, 26, 26, 29, + 76, 148, 29, 147, 29, 70, 70, 70, 70, 145, + 26, 77, 26, 26, 26, 26, 26, 26, 57, 57, + 57, 71, 71, 71, 71, 77, 144, 57, 57, 79, + 76, 71, 71, 72, 79, 72, 72, 72, 80, 81, + + 82, 77, 80, 81, 82, 84, 57, 57, 85, 84, + 71, 71, 85, 87, 86, 143, 90, 79, 86, 79, + 88, 142, 141, 89, 140, 88, 88, 89, 80, 81, + 82, 97, 91, 92, 139, 84, 91, 92, 85, 87, + 138, 93, 137, 87, 86, 93, 90, 94, 88, 90, + 88, 94, 95, 89, 96, 98, 95, 136, 96, 98, + 130, 97, 91, 92, 130, 126, 108, 108, 108, 133, + 125, 93, 124, 133, 97, 108, 108, 94, 127, 127, + 127, 123, 95, 122, 96, 98, 128, 128, 128, 134, + 130, 121, 135, 134, 108, 108, 135, 120, 119, 133, + + 118, 117, 116, 115, 114, 113, 112, 111, 110, 109, + 107, 106, 105, 104, 103, 102, 101, 100, 83, 134, + 69, 65, 135, 160, 64, 160, 160, 161, 161, 162, + 63, 162, 162, 163, 59, 163, 163, 166, 58, 166, + 166, 54, 53, 52, 51, 50, 49, 48, 45, 44, + 43, 41, 39, 38, 24, 22, 19, 17, 14, 12, + 11, 10, 9, 8, 7, 5, 3, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159, 159, 159, 159, 159, 159, 159, 159, + 159, 159, 159 + } ; + +static ff_state_type ff_last_accepting_state; +static char *ff_last_accepting_cpos; + +/* The intent behind this definition is that it'll catch + * any uses of REJECT which flex missed. + */ +#define REJECT reject_used_but_not_detected +#define ffmore() ffmore_used_but_not_detected +#define FF_MORE_ADJ 0 +#define FF_RESTORE_FF_MORE_OFFSET +char *fftext; +#line 1 "eval.l" +#define INITIAL 0 +#line 2 "eval.l" +/************************************************************************/ +/* */ +/* CFITSIO Lexical Parser */ +/* */ +/* This file is one of 3 files containing code which parses an */ +/* arithmetic expression and evaluates it in the context of an input */ +/* FITS file table extension. The CFITSIO lexical parser is divided */ +/* into the following 3 parts/files: the CFITSIO "front-end", */ +/* eval_f.c, contains the interface between the user/CFITSIO and the */ +/* real core of the parser; the FLEX interpreter, eval_l.c, takes the */ +/* input string and parses it into tokens and identifies the FITS */ +/* information required to evaluate the expression (ie, keywords and */ +/* columns); and, the BISON grammar and evaluation routines, eval_y.c, */ +/* receives the FLEX output and determines and performs the actual */ +/* operations. The files eval_l.c and eval_y.c are produced from */ +/* running flex and bison on the files eval.l and eval.y, respectively. */ +/* (flex and bison are available from any GNU archive: see www.gnu.org) */ +/* */ +/* The grammar rules, rather than evaluating the expression in situ, */ +/* builds a tree, or Nodal, structure mapping out the order of */ +/* operations and expression dependencies. This "compilation" process */ +/* allows for much faster processing of multiple rows. This technique */ +/* was developed by Uwe Lammers of the XMM Science Analysis System, */ +/* although the CFITSIO implementation is entirely code original. */ +/* */ +/* */ +/* Modification History: */ +/* */ +/* Kent Blackburn c1992 Original parser code developed for the */ +/* FTOOLS software package, in particular, */ +/* the fselect task. */ +/* Kent Blackburn c1995 BIT column support added */ +/* Peter D Wilson Feb 1998 Vector column support added */ +/* Peter D Wilson May 1998 Ported to CFITSIO library. User */ +/* interface routines written, in essence */ +/* making fselect, fcalc, and maketime */ +/* capabilities available to all tools */ +/* via single function calls. */ +/* Peter D Wilson Jun 1998 Major rewrite of parser core, so as to */ +/* create a run-time evaluation tree, */ +/* inspired by the work of Uwe Lammers, */ +/* resulting in a speed increase of */ +/* 10-100 times. */ +/* Peter D Wilson Jul 1998 gtifilter(a,b,c,d) function added */ +/* Peter D Wilson Aug 1998 regfilter(a,b,c,d) function added */ +/* Peter D Wilson Jul 1999 Make parser fitsfile-independent, */ +/* allowing a purely vector-based usage */ +/* */ +/************************************************************************/ + +#include +#include +#include +#ifdef sparc +#include +#else +#include +#endif +#include "eval_defs.h" + +ParseData gParse; /* Global structure holding all parser information */ + +/***** Internal functions *****/ + + int ffGetVariable( char *varName, FFSTYPE *varVal ); + +static int find_variable( char *varName ); +static int expr_read( char *buf, int nbytes ); + +/***** Definitions *****/ + +#define FF_NO_UNPUT /* Don't include FFUNPUT function */ +#define FF_NEVER_INTERACTIVE 1 + +#define MAXCHR 256 +#define MAXBIT 128 + +#define OCT_0 "000" +#define OCT_1 "001" +#define OCT_2 "010" +#define OCT_3 "011" +#define OCT_4 "100" +#define OCT_5 "101" +#define OCT_6 "110" +#define OCT_7 "111" +#define OCT_X "xxx" + +#define HEX_0 "0000" +#define HEX_1 "0001" +#define HEX_2 "0010" +#define HEX_3 "0011" +#define HEX_4 "0100" +#define HEX_5 "0101" +#define HEX_6 "0110" +#define HEX_7 "0111" +#define HEX_8 "1000" +#define HEX_9 "1001" +#define HEX_A "1010" +#define HEX_B "1011" +#define HEX_C "1100" +#define HEX_D "1101" +#define HEX_E "1110" +#define HEX_F "1111" +#define HEX_X "xxxx" + +/* + MJT - 13 June 1996 + read from buffer instead of stdin + (as per old ftools.skel) +*/ +#undef FF_INPUT +#define FF_INPUT(buf,result,max_size) \ + if ( (result = expr_read( (char *) buf, max_size )) < 0 ) \ + FF_FATAL_ERROR( "read() in flex scanner failed" ); + + +/* Macros after this point can all be overridden by user definitions in + * section 1. + */ + +#ifndef FF_SKIP_FFWRAP +#ifdef __cplusplus +extern "C" int ffwrap FF_PROTO(( void )); +#else +extern int ffwrap FF_PROTO(( void )); +#endif +#endif + +#ifndef FF_NO_UNPUT +static void ffunput FF_PROTO(( int c, char *buf_ptr )); +#endif + +#ifndef fftext_ptr +static void ff_flex_strncpy FF_PROTO(( char *, ffconst char *, int )); +#endif + +#ifdef FF_NEED_STRLEN +static int ff_flex_strlen FF_PROTO(( ffconst char * )); +#endif + +#ifndef FF_NO_INPUT +#ifdef __cplusplus +static int ffinput FF_PROTO(( void )); +#else +static int input FF_PROTO(( void )); +#endif +#endif + +#if FF_STACK_USED +static int ff_start_stack_ptr = 0; +static int ff_start_stack_depth = 0; +static int *ff_start_stack = 0; +#ifndef FF_NO_PUSH_STATE +static void ff_push_state FF_PROTO(( int new_state )); +#endif +#ifndef FF_NO_POP_STATE +static void ff_pop_state FF_PROTO(( void )); +#endif +#ifndef FF_NO_TOP_STATE +static int ff_top_state FF_PROTO(( void )); +#endif + +#else +#define FF_NO_PUSH_STATE 1 +#define FF_NO_POP_STATE 1 +#define FF_NO_TOP_STATE 1 +#endif + +#ifdef FF_MALLOC_DECL +FF_MALLOC_DECL +#else +#if __STDC__ +#ifndef __cplusplus +#include +#endif +#else +/* Just try to get by without declaring the routines. This will fail + * miserably on non-ANSI systems for which sizeof(size_t) != sizeof(int) + * or sizeof(void*) != sizeof(int). + */ +#endif +#endif + +/* Amount of stuff to slurp up with each read. */ +#ifndef FF_READ_BUF_SIZE +#define FF_READ_BUF_SIZE 8192 +#endif + +/* Copy whatever the last rule matched to the standard output. */ + +#ifndef ECHO +/* This used to be an fputs(), but since the string might contain NUL's, + * we now use fwrite(). + */ +#define ECHO (void) fwrite( fftext, ffleng, 1, ffout ) +#endif + +/* Gets input and stuffs it into "buf". number of characters read, or FF_NULL, + * is returned in "result". + */ +#ifndef FF_INPUT +#define FF_INPUT(buf,result,max_size) \ + if ( ff_current_buffer->ff_is_interactive ) \ + { \ + int c = '*', n; \ + for ( n = 0; n < max_size && \ + (c = getc( ffin )) != EOF && c != '\n'; ++n ) \ + buf[n] = (char) c; \ + if ( c == '\n' ) \ + buf[n++] = (char) c; \ + if ( c == EOF && ferror( ffin ) ) \ + FF_FATAL_ERROR( "input in flex scanner failed" ); \ + result = n; \ + } \ + else if ( ((result = fread( buf, 1, max_size, ffin )) == 0) \ + && ferror( ffin ) ) \ + FF_FATAL_ERROR( "input in flex scanner failed" ); +#endif + +/* No semi-colon after return; correct usage is to write "ffterminate();" - + * we don't want an extra ';' after the "return" because that will cause + * some compilers to complain about unreachable statements. + */ +#ifndef ffterminate +#define ffterminate() return FF_NULL +#endif + +/* Number of entries by which start-condition stack grows. */ +#ifndef FF_START_STACK_INCR +#define FF_START_STACK_INCR 25 +#endif + +/* Report a fatal error. */ +#ifndef FF_FATAL_ERROR +#define FF_FATAL_ERROR(msg) ff_fatal_error( msg ) +#endif + +/* Default declaration of generated scanner - a define so the user can + * easily add parameters. + */ +#ifndef FF_DECL +#define FF_DECL int fflex FF_PROTO(( void )) +#endif + +/* Code executed at the beginning of each rule, after fftext and ffleng + * have been set up. + */ +#ifndef FF_USER_ACTION +#define FF_USER_ACTION +#endif + +/* Code executed at the end of each rule. */ +#ifndef FF_BREAK +#define FF_BREAK break; +#endif + +#define FF_RULE_SETUP \ + FF_USER_ACTION + +FF_DECL + { + register ff_state_type ff_current_state; + register char *ff_cp, *ff_bp; + register int ff_act; + +#line 142 "eval.l" + + + + if ( ff_init ) + { + ff_init = 0; + +#ifdef FF_USER_INIT + FF_USER_INIT; +#endif + + if ( ! ff_start ) + ff_start = 1; /* first start state */ + + if ( ! ffin ) + ffin = stdin; + + if ( ! ffout ) + ffout = stdout; + + if ( ! ff_current_buffer ) + ff_current_buffer = + ff_create_buffer( ffin, FF_BUF_SIZE ); + + ff_load_buffer_state(); + } + + while ( 1 ) /* loops until end-of-file is reached */ + { + ff_cp = ff_c_buf_p; + + /* Support of fftext. */ + *ff_cp = ff_hold_char; + + /* ff_bp points to the position in ff_ch_buf of the start of + * the current run. + */ + ff_bp = ff_cp; + + ff_current_state = ff_start; +ff_match: + do + { + register FF_CHAR ff_c = ff_ec[FF_SC_TO_UI(*ff_cp)]; + if ( ff_accept[ff_current_state] ) + { + ff_last_accepting_state = ff_current_state; + ff_last_accepting_cpos = ff_cp; + } + while ( ff_chk[ff_base[ff_current_state] + ff_c] != ff_current_state ) + { + ff_current_state = (int) ff_def[ff_current_state]; + if ( ff_current_state >= 160 ) + ff_c = ff_meta[(unsigned int) ff_c]; + } + ff_current_state = ff_nxt[ff_base[ff_current_state] + (unsigned int) ff_c]; + ++ff_cp; + } + while ( ff_base[ff_current_state] != 368 ); + +ff_find_action: + ff_act = ff_accept[ff_current_state]; + if ( ff_act == 0 ) + { /* have to back up */ + ff_cp = ff_last_accepting_cpos; + ff_current_state = ff_last_accepting_state; + ff_act = ff_accept[ff_current_state]; + } + + FF_DO_BEFORE_ACTION; + + +do_action: /* This label is used only to access EOF actions. */ + + + switch ( ff_act ) + { /* beginning of action switch */ + case 0: /* must back up */ + /* undo the effects of FF_DO_BEFORE_ACTION */ + *ff_cp = ff_hold_char; + ff_cp = ff_last_accepting_cpos; + ff_current_state = ff_last_accepting_state; + goto ff_find_action; + +case 1: +FF_RULE_SETUP +#line 144 "eval.l" +; + FF_BREAK +case 2: +FF_RULE_SETUP +#line 145 "eval.l" +{ + int len; + len = strlen(fftext); + while (fftext[len] == ' ') + len--; + len = len - 1; + strncpy(fflval.str,&fftext[1],len); + fflval.str[len] = '\0'; + return( BITSTR ); + } + FF_BREAK +case 3: +FF_RULE_SETUP +#line 155 "eval.l" +{ + int len; + char tmpstring[256]; + char bitstring[256]; + len = strlen(fftext); + while (fftext[len] == ' ') + len--; + len = len - 1; + strncpy(tmpstring,&fftext[1],len); + tmpstring[len] = '\0'; + bitstring[0] = '\0'; + len = 0; + while ( tmpstring[len] != '\0') + { + switch ( tmpstring[len] ) + { + case '0': + strcat(bitstring,OCT_0); + break; + case '1': + strcat(bitstring,OCT_1); + break; + case '2': + strcat(bitstring,OCT_2); + break; + case '3': + strcat(bitstring,OCT_3); + break; + case '4': + strcat(bitstring,OCT_4); + break; + case '5': + strcat(bitstring,OCT_5); + break; + case '6': + strcat(bitstring,OCT_6); + break; + case '7': + strcat(bitstring,OCT_7); + break; + case 'x': + case 'X': + strcat(bitstring,OCT_X); + break; + } + len++; + } + strcpy( fflval.str, bitstring ); + return( BITSTR ); + } + FF_BREAK +case 4: +FF_RULE_SETUP +#line 205 "eval.l" +{ + int len; + char tmpstring[256]; + char bitstring[256]; + len = strlen(fftext); + while (fftext[len] == ' ') + len--; + len = len - 1; + strncpy(tmpstring,&fftext[1],len); + tmpstring[len] = '\0'; + bitstring[0] = '\0'; + len = 0; + while ( tmpstring[len] != '\0') + { + switch ( tmpstring[len] ) + { + case '0': + strcat(bitstring,HEX_0); + break; + case '1': + strcat(bitstring,HEX_1); + break; + case '2': + strcat(bitstring,HEX_2); + break; + case '3': + strcat(bitstring,HEX_3); + break; + case '4': + strcat(bitstring,HEX_4); + break; + case '5': + strcat(bitstring,HEX_5); + break; + case '6': + strcat(bitstring,HEX_6); + break; + case '7': + strcat(bitstring,HEX_7); + break; + case '8': + strcat(bitstring,HEX_8); + break; + case '9': + strcat(bitstring,HEX_9); + break; + case 'a': + case 'A': + strcat(bitstring,HEX_A); + break; + case 'b': + case 'B': + strcat(bitstring,HEX_B); + break; + case 'c': + case 'C': + strcat(bitstring,HEX_C); + break; + case 'd': + case 'D': + strcat(bitstring,HEX_D); + break; + case 'e': + case 'E': + strcat(bitstring,HEX_E); + break; + case 'f': + case 'F': + strcat(bitstring,HEX_F); + break; + case 'x': + case 'X': + strcat(bitstring,HEX_X); + break; + } + len++; + } + + strcpy( fflval.str, bitstring ); + return( BITSTR ); + } + FF_BREAK +case 5: +FF_RULE_SETUP +#line 286 "eval.l" +{ + fflval.lng = atol(fftext); + return( LONG ); + } + FF_BREAK +case 6: +FF_RULE_SETUP +#line 290 "eval.l" +{ + if ((fftext[0] == 't') || (fftext[0] == 'T')) + fflval.log = 1; + else + fflval.log = 0; + return( BOOLEAN ); + } + FF_BREAK +case 7: +FF_RULE_SETUP +#line 297 "eval.l" +{ + fflval.dbl = atof(fftext); + return( DOUBLE ); + } + FF_BREAK +case 8: +FF_RULE_SETUP +#line 301 "eval.l" +{ + if( !strcasecmp(fftext,"#PI") ) { + fflval.dbl = (double)(4) * atan((double)(1)); + return( DOUBLE ); + } else if( !strcasecmp(fftext,"#E") ) { + fflval.dbl = exp((double)(1)); + return( DOUBLE ); + } else if( !strcasecmp(fftext,"#DEG") ) { + fflval.dbl = ((double)4)*atan((double)1)/((double)180); + return( DOUBLE ); + } else if( !strcasecmp(fftext,"#ROW") ) { + return( ROWREF ); + } else if( !strcasecmp(fftext,"#NULL") ) { + return( NULLREF ); + } else if( !strcasecmp(fftext,"#SNULL") ) { + return( SNULLREF ); + } else { + int len; + if (fftext[1] == '$') { + len = strlen(fftext) - 3; + fflval.str[0] = '#'; + strncpy(fflval.str+1,&fftext[2],len); + fflval.str[len+1] = '\0'; + fftext = fflval.str; + } + return( (*gParse.getData)(fftext, &fflval) ); + } + } + FF_BREAK +case 9: +FF_RULE_SETUP +#line 329 "eval.l" +{ + int len; + len = strlen(fftext) - 2; + strncpy(fflval.str,&fftext[1],len); + fflval.str[len] = '\0'; + return( STRING ); + } + FF_BREAK +case 10: +FF_RULE_SETUP +#line 336 "eval.l" +{ + int len,type; + + if (fftext[0] == '$') { + len = strlen(fftext) - 2; + strncpy(fflval.str,&fftext[1],len); + fflval.str[len] = '\0'; + fftext = fflval.str; + } + type = ffGetVariable(fftext, &fflval); + return( type ); + } + FF_BREAK +case 11: +FF_RULE_SETUP +#line 348 "eval.l" +{ + char *fname; + int len=0; + fname = &fflval.str[0]; + while( (fname[len]=toupper(fftext[len])) ) len++; + + if( FSTRCMP(fname,"BOX(")==0 + || FSTRCMP(fname,"CIRCLE(")==0 + || FSTRCMP(fname,"ELLIPSE(")==0 + || FSTRCMP(fname,"NEAR(")==0 + || FSTRCMP(fname,"ISNULL(")==0 + ) + /* Return type is always boolean */ + return( BFUNCTION ); + + else if( FSTRCMP(fname,"GTIFILTER(")==0 ) + return( GTIFILTER ); + + else if( FSTRCMP(fname,"REGFILTER(")==0 ) + return( REGFILTER ); + + else + return( FUNCTION ); + } + FF_BREAK +case 12: +FF_RULE_SETUP +#line 372 "eval.l" +{ return( INTCAST ); } + FF_BREAK +case 13: +FF_RULE_SETUP +#line 373 "eval.l" +{ return( FLTCAST ); } + FF_BREAK +case 14: +FF_RULE_SETUP +#line 374 "eval.l" +{ return( POWER ); } + FF_BREAK +case 15: +FF_RULE_SETUP +#line 375 "eval.l" +{ return( NOT ); } + FF_BREAK +case 16: +FF_RULE_SETUP +#line 376 "eval.l" +{ return( OR ); } + FF_BREAK +case 17: +FF_RULE_SETUP +#line 377 "eval.l" +{ return( AND ); } + FF_BREAK +case 18: +FF_RULE_SETUP +#line 378 "eval.l" +{ return( EQ ); } + FF_BREAK +case 19: +FF_RULE_SETUP +#line 379 "eval.l" +{ return( NE ); } + FF_BREAK +case 20: +FF_RULE_SETUP +#line 380 "eval.l" +{ return( GT ); } + FF_BREAK +case 21: +FF_RULE_SETUP +#line 381 "eval.l" +{ return( LT ); } + FF_BREAK +case 22: +FF_RULE_SETUP +#line 382 "eval.l" +{ return( GTE ); } + FF_BREAK +case 23: +FF_RULE_SETUP +#line 383 "eval.l" +{ return( LTE ); } + FF_BREAK +case 24: +FF_RULE_SETUP +#line 384 "eval.l" +{ return( '\n' ); } + FF_BREAK +case 25: +FF_RULE_SETUP +#line 385 "eval.l" +{ return( fftext[0] ); } + FF_BREAK +case 26: +FF_RULE_SETUP +#line 386 "eval.l" +ECHO; + FF_BREAK +case FF_STATE_EOF(INITIAL): + ffterminate(); + + case FF_END_OF_BUFFER: + { + /* Amount of text matched not including the EOB char. */ + int ff_amount_of_matched_text = (int) (ff_cp - fftext_ptr) - 1; + + /* Undo the effects of FF_DO_BEFORE_ACTION. */ + *ff_cp = ff_hold_char; + FF_RESTORE_FF_MORE_OFFSET + + if ( ff_current_buffer->ff_buffer_status == FF_BUFFER_NEW ) + { + /* We're scanning a new file or input source. It's + * possible that this happened because the user + * just pointed ffin at a new source and called + * fflex(). If so, then we have to assure + * consistency between ff_current_buffer and our + * globals. Here is the right place to do so, because + * this is the first action (other than possibly a + * back-up) that will match for the new input source. + */ + ff_n_chars = ff_current_buffer->ff_n_chars; + ff_current_buffer->ff_input_file = ffin; + ff_current_buffer->ff_buffer_status = FF_BUFFER_NORMAL; + } + + /* Note that here we test for ff_c_buf_p "<=" to the position + * of the first EOB in the buffer, since ff_c_buf_p will + * already have been incremented past the NUL character + * (since all states make transitions on EOB to the + * end-of-buffer state). Contrast this with the test + * in input(). + */ + if ( ff_c_buf_p <= &ff_current_buffer->ff_ch_buf[ff_n_chars] ) + { /* This was really a NUL. */ + ff_state_type ff_next_state; + + ff_c_buf_p = fftext_ptr + ff_amount_of_matched_text; + + ff_current_state = ff_get_previous_state(); + + /* Okay, we're now positioned to make the NUL + * transition. We couldn't have + * ff_get_previous_state() go ahead and do it + * for us because it doesn't know how to deal + * with the possibility of jamming (and we don't + * want to build jamming into it because then it + * will run more slowly). + */ + + ff_next_state = ff_try_NUL_trans( ff_current_state ); + + ff_bp = fftext_ptr + FF_MORE_ADJ; + + if ( ff_next_state ) + { + /* Consume the NUL. */ + ff_cp = ++ff_c_buf_p; + ff_current_state = ff_next_state; + goto ff_match; + } + + else + { + ff_cp = ff_c_buf_p; + goto ff_find_action; + } + } + + else switch ( ff_get_next_buffer() ) + { + case EOB_ACT_END_OF_FILE: + { + ff_did_buffer_switch_on_eof = 0; + + if ( ffwrap() ) + { + /* Note: because we've taken care in + * ff_get_next_buffer() to have set up + * fftext, we can now set up + * ff_c_buf_p so that if some total + * hoser (like flex itself) wants to + * call the scanner after we return the + * FF_NULL, it'll still work - another + * FF_NULL will get returned. + */ + ff_c_buf_p = fftext_ptr + FF_MORE_ADJ; + + ff_act = FF_STATE_EOF(FF_START); + goto do_action; + } + + else + { + if ( ! ff_did_buffer_switch_on_eof ) + FF_NEW_FILE; + } + break; + } + + case EOB_ACT_CONTINUE_SCAN: + ff_c_buf_p = + fftext_ptr + ff_amount_of_matched_text; + + ff_current_state = ff_get_previous_state(); + + ff_cp = ff_c_buf_p; + ff_bp = fftext_ptr + FF_MORE_ADJ; + goto ff_match; + + case EOB_ACT_LAST_MATCH: + ff_c_buf_p = + &ff_current_buffer->ff_ch_buf[ff_n_chars]; + + ff_current_state = ff_get_previous_state(); + + ff_cp = ff_c_buf_p; + ff_bp = fftext_ptr + FF_MORE_ADJ; + goto ff_find_action; + } + break; + } + + default: + FF_FATAL_ERROR( + "fatal flex scanner internal error--no action found" ); + } /* end of action switch */ + } /* end of scanning one token */ + } /* end of fflex */ + + +/* ff_get_next_buffer - try to read in a new buffer + * + * Returns a code representing an action: + * EOB_ACT_LAST_MATCH - + * EOB_ACT_CONTINUE_SCAN - continue scanning from current position + * EOB_ACT_END_OF_FILE - end of file + */ + +static int ff_get_next_buffer() + { + register char *dest = ff_current_buffer->ff_ch_buf; + register char *source = fftext_ptr; + register int number_to_move, i; + int ret_val; + + if ( ff_c_buf_p > &ff_current_buffer->ff_ch_buf[ff_n_chars + 1] ) + FF_FATAL_ERROR( + "fatal flex scanner internal error--end of buffer missed" ); + + if ( ff_current_buffer->ff_fill_buffer == 0 ) + { /* Don't try to fill the buffer, so this is an EOF. */ + if ( ff_c_buf_p - fftext_ptr - FF_MORE_ADJ == 1 ) + { + /* We matched a single character, the EOB, so + * treat this as a final EOF. + */ + return EOB_ACT_END_OF_FILE; + } + + else + { + /* We matched some text prior to the EOB, first + * process it. + */ + return EOB_ACT_LAST_MATCH; + } + } + + /* Try to read more data. */ + + /* First move last chars to start of buffer. */ + number_to_move = (int) (ff_c_buf_p - fftext_ptr) - 1; + + for ( i = 0; i < number_to_move; ++i ) + *(dest++) = *(source++); + + if ( ff_current_buffer->ff_buffer_status == FF_BUFFER_EOF_PENDING ) + /* don't do the read, it's not guaranteed to return an EOF, + * just force an EOF + */ + ff_current_buffer->ff_n_chars = ff_n_chars = 0; + + else + { + int num_to_read = + ff_current_buffer->ff_buf_size - number_to_move - 1; + + while ( num_to_read <= 0 ) + { /* Not enough room in the buffer - grow it. */ +#ifdef FF_USES_REJECT + FF_FATAL_ERROR( +"input buffer overflow, can't enlarge buffer because scanner uses REJECT" ); +#else + + /* just a shorter name for the current buffer */ + FF_BUFFER_STATE b = ff_current_buffer; + + int ff_c_buf_p_offset = + (int) (ff_c_buf_p - b->ff_ch_buf); + + if ( b->ff_is_our_buffer ) + { + int new_size = b->ff_buf_size * 2; + + if ( new_size <= 0 ) + b->ff_buf_size += b->ff_buf_size / 8; + else + b->ff_buf_size *= 2; + + b->ff_ch_buf = (char *) + /* Include room in for 2 EOB chars. */ + ff_flex_realloc( (void *) b->ff_ch_buf, + b->ff_buf_size + 2 ); + } + else + /* Can't grow it, we don't own it. */ + b->ff_ch_buf = 0; + + if ( ! b->ff_ch_buf ) + FF_FATAL_ERROR( + "fatal error - scanner input buffer overflow" ); + + ff_c_buf_p = &b->ff_ch_buf[ff_c_buf_p_offset]; + + num_to_read = ff_current_buffer->ff_buf_size - + number_to_move - 1; +#endif + } + + if ( num_to_read > FF_READ_BUF_SIZE ) + num_to_read = FF_READ_BUF_SIZE; + + /* Read in more data. */ + FF_INPUT( (&ff_current_buffer->ff_ch_buf[number_to_move]), + ff_n_chars, num_to_read ); + + ff_current_buffer->ff_n_chars = ff_n_chars; + } + + if ( ff_n_chars == 0 ) + { + if ( number_to_move == FF_MORE_ADJ ) + { + ret_val = EOB_ACT_END_OF_FILE; + ffrestart( ffin ); + } + + else + { + ret_val = EOB_ACT_LAST_MATCH; + ff_current_buffer->ff_buffer_status = + FF_BUFFER_EOF_PENDING; + } + } + + else + ret_val = EOB_ACT_CONTINUE_SCAN; + + ff_n_chars += number_to_move; + ff_current_buffer->ff_ch_buf[ff_n_chars] = FF_END_OF_BUFFER_CHAR; + ff_current_buffer->ff_ch_buf[ff_n_chars + 1] = FF_END_OF_BUFFER_CHAR; + + fftext_ptr = &ff_current_buffer->ff_ch_buf[0]; + + return ret_val; + } + + +/* ff_get_previous_state - get the state just before the EOB char was reached */ + +static ff_state_type ff_get_previous_state() + { + register ff_state_type ff_current_state; + register char *ff_cp; + + ff_current_state = ff_start; + + for ( ff_cp = fftext_ptr + FF_MORE_ADJ; ff_cp < ff_c_buf_p; ++ff_cp ) + { + register FF_CHAR ff_c = (*ff_cp ? ff_ec[FF_SC_TO_UI(*ff_cp)] : 1); + if ( ff_accept[ff_current_state] ) + { + ff_last_accepting_state = ff_current_state; + ff_last_accepting_cpos = ff_cp; + } + while ( ff_chk[ff_base[ff_current_state] + ff_c] != ff_current_state ) + { + ff_current_state = (int) ff_def[ff_current_state]; + if ( ff_current_state >= 160 ) + ff_c = ff_meta[(unsigned int) ff_c]; + } + ff_current_state = ff_nxt[ff_base[ff_current_state] + (unsigned int) ff_c]; + } + + return ff_current_state; + } + + +/* ff_try_NUL_trans - try to make a transition on the NUL character + * + * synopsis + * next_state = ff_try_NUL_trans( current_state ); + */ + +#ifdef FF_USE_PROTOS +static ff_state_type ff_try_NUL_trans( ff_state_type ff_current_state ) +#else +static ff_state_type ff_try_NUL_trans( ff_current_state ) +ff_state_type ff_current_state; +#endif + { + register int ff_is_jam; + register char *ff_cp = ff_c_buf_p; + + register FF_CHAR ff_c = 1; + if ( ff_accept[ff_current_state] ) + { + ff_last_accepting_state = ff_current_state; + ff_last_accepting_cpos = ff_cp; + } + while ( ff_chk[ff_base[ff_current_state] + ff_c] != ff_current_state ) + { + ff_current_state = (int) ff_def[ff_current_state]; + if ( ff_current_state >= 160 ) + ff_c = ff_meta[(unsigned int) ff_c]; + } + ff_current_state = ff_nxt[ff_base[ff_current_state] + (unsigned int) ff_c]; + ff_is_jam = (ff_current_state == 159); + + return ff_is_jam ? 0 : ff_current_state; + } + + +#ifndef FF_NO_UNPUT +#ifdef FF_USE_PROTOS +static void ffunput( int c, register char *ff_bp ) +#else +static void ffunput( c, ff_bp ) +int c; +register char *ff_bp; +#endif + { + register char *ff_cp = ff_c_buf_p; + + /* undo effects of setting up fftext */ + *ff_cp = ff_hold_char; + + if ( ff_cp < ff_current_buffer->ff_ch_buf + 2 ) + { /* need to shift things up to make room */ + /* +2 for EOB chars. */ + register int number_to_move = ff_n_chars + 2; + register char *dest = &ff_current_buffer->ff_ch_buf[ + ff_current_buffer->ff_buf_size + 2]; + register char *source = + &ff_current_buffer->ff_ch_buf[number_to_move]; + + while ( source > ff_current_buffer->ff_ch_buf ) + *--dest = *--source; + + ff_cp += (int) (dest - source); + ff_bp += (int) (dest - source); + ff_current_buffer->ff_n_chars = + ff_n_chars = ff_current_buffer->ff_buf_size; + + if ( ff_cp < ff_current_buffer->ff_ch_buf + 2 ) + FF_FATAL_ERROR( "flex scanner push-back overflow" ); + } + + *--ff_cp = (char) c; + + + fftext_ptr = ff_bp; + ff_hold_char = *ff_cp; + ff_c_buf_p = ff_cp; + } +#endif /* ifndef FF_NO_UNPUT */ + + +#ifdef __cplusplus +static int ffinput() +#else +static int input() +#endif + { + int c; + + *ff_c_buf_p = ff_hold_char; + + if ( *ff_c_buf_p == FF_END_OF_BUFFER_CHAR ) + { + /* ff_c_buf_p now points to the character we want to return. + * If this occurs *before* the EOB characters, then it's a + * valid NUL; if not, then we've hit the end of the buffer. + */ + if ( ff_c_buf_p < &ff_current_buffer->ff_ch_buf[ff_n_chars] ) + /* This was really a NUL. */ + *ff_c_buf_p = '\0'; + + else + { /* need more input */ + int offset = ff_c_buf_p - fftext_ptr; + ++ff_c_buf_p; + + switch ( ff_get_next_buffer() ) + { + case EOB_ACT_LAST_MATCH: + /* This happens because ff_g_n_b() + * sees that we've accumulated a + * token and flags that we need to + * try matching the token before + * proceeding. But for input(), + * there's no matching to consider. + * So convert the EOB_ACT_LAST_MATCH + * to EOB_ACT_END_OF_FILE. + */ + + /* Reset buffer status. */ + ffrestart( ffin ); + + /* fall through */ + + case EOB_ACT_END_OF_FILE: + { + if ( ffwrap() ) + return EOF; + + if ( ! ff_did_buffer_switch_on_eof ) + FF_NEW_FILE; +#ifdef __cplusplus + return ffinput(); +#else + return input(); +#endif + } + + case EOB_ACT_CONTINUE_SCAN: + ff_c_buf_p = fftext_ptr + offset; + break; + } + } + } + + c = *(unsigned char *) ff_c_buf_p; /* cast for 8-bit char's */ + *ff_c_buf_p = '\0'; /* preserve fftext */ + ff_hold_char = *++ff_c_buf_p; + + + return c; + } + + +#ifdef FF_USE_PROTOS +void ffrestart( FILE *input_file ) +#else +void ffrestart( input_file ) +FILE *input_file; +#endif + { + if ( ! ff_current_buffer ) + ff_current_buffer = ff_create_buffer( ffin, FF_BUF_SIZE ); + + ff_init_buffer( ff_current_buffer, input_file ); + ff_load_buffer_state(); + } + + +#ifdef FF_USE_PROTOS +void ff_switch_to_buffer( FF_BUFFER_STATE new_buffer ) +#else +void ff_switch_to_buffer( new_buffer ) +FF_BUFFER_STATE new_buffer; +#endif + { + if ( ff_current_buffer == new_buffer ) + return; + + if ( ff_current_buffer ) + { + /* Flush out information for old buffer. */ + *ff_c_buf_p = ff_hold_char; + ff_current_buffer->ff_buf_pos = ff_c_buf_p; + ff_current_buffer->ff_n_chars = ff_n_chars; + } + + ff_current_buffer = new_buffer; + ff_load_buffer_state(); + + /* We don't actually know whether we did this switch during + * EOF (ffwrap()) processing, but the only time this flag + * is looked at is after ffwrap() is called, so it's safe + * to go ahead and always set it. + */ + ff_did_buffer_switch_on_eof = 1; + } + + +#ifdef FF_USE_PROTOS +void ff_load_buffer_state( void ) +#else +void ff_load_buffer_state() +#endif + { + ff_n_chars = ff_current_buffer->ff_n_chars; + fftext_ptr = ff_c_buf_p = ff_current_buffer->ff_buf_pos; + ffin = ff_current_buffer->ff_input_file; + ff_hold_char = *ff_c_buf_p; + } + + +#ifdef FF_USE_PROTOS +FF_BUFFER_STATE ff_create_buffer( FILE *file, int size ) +#else +FF_BUFFER_STATE ff_create_buffer( file, size ) +FILE *file; +int size; +#endif + { + FF_BUFFER_STATE b; + + b = (FF_BUFFER_STATE) ff_flex_alloc( sizeof( struct ff_buffer_state ) ); + if ( ! b ) + FF_FATAL_ERROR( "out of dynamic memory in ff_create_buffer()" ); + + b->ff_buf_size = size; + + /* ff_ch_buf has to be 2 characters longer than the size given because + * we need to put in 2 end-of-buffer characters. + */ + b->ff_ch_buf = (char *) ff_flex_alloc( b->ff_buf_size + 2 ); + if ( ! b->ff_ch_buf ) + FF_FATAL_ERROR( "out of dynamic memory in ff_create_buffer()" ); + + b->ff_is_our_buffer = 1; + + ff_init_buffer( b, file ); + + return b; + } + + +#ifdef FF_USE_PROTOS +void ff_delete_buffer( FF_BUFFER_STATE b ) +#else +void ff_delete_buffer( b ) +FF_BUFFER_STATE b; +#endif + { + if ( ! b ) + return; + + if ( b == ff_current_buffer ) + ff_current_buffer = (FF_BUFFER_STATE) 0; + + if ( b->ff_is_our_buffer ) + ff_flex_free( (void *) b->ff_ch_buf ); + + ff_flex_free( (void *) b ); + } + + +#ifndef FF_ALWAYS_INTERACTIVE +#ifndef FF_NEVER_INTERACTIVE +extern int isatty FF_PROTO(( int )); +#endif +#endif + +#ifdef FF_USE_PROTOS +void ff_init_buffer( FF_BUFFER_STATE b, FILE *file ) +#else +void ff_init_buffer( b, file ) +FF_BUFFER_STATE b; +FILE *file; +#endif + + + { + ff_flush_buffer( b ); + + b->ff_input_file = file; + b->ff_fill_buffer = 1; + +#if FF_ALWAYS_INTERACTIVE + b->ff_is_interactive = 1; +#else +#if FF_NEVER_INTERACTIVE + b->ff_is_interactive = 0; +#else + b->ff_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; +#endif +#endif + } + + +#ifdef FF_USE_PROTOS +void ff_flush_buffer( FF_BUFFER_STATE b ) +#else +void ff_flush_buffer( b ) +FF_BUFFER_STATE b; +#endif + + { + if ( ! b ) + return; + + b->ff_n_chars = 0; + + /* We always need two end-of-buffer characters. The first causes + * a transition to the end-of-buffer state. The second causes + * a jam in that state. + */ + b->ff_ch_buf[0] = FF_END_OF_BUFFER_CHAR; + b->ff_ch_buf[1] = FF_END_OF_BUFFER_CHAR; + + b->ff_buf_pos = &b->ff_ch_buf[0]; + + b->ff_at_bol = 1; + b->ff_buffer_status = FF_BUFFER_NEW; + + if ( b == ff_current_buffer ) + ff_load_buffer_state(); + } + + +#ifndef FF_NO_SCAN_BUFFER +#ifdef FF_USE_PROTOS +FF_BUFFER_STATE ff_scan_buffer( char *base, ff_size_t size ) +#else +FF_BUFFER_STATE ff_scan_buffer( base, size ) +char *base; +ff_size_t size; +#endif + { + FF_BUFFER_STATE b; + + if ( size < 2 || + base[size-2] != FF_END_OF_BUFFER_CHAR || + base[size-1] != FF_END_OF_BUFFER_CHAR ) + /* They forgot to leave room for the EOB's. */ + return 0; + + b = (FF_BUFFER_STATE) ff_flex_alloc( sizeof( struct ff_buffer_state ) ); + if ( ! b ) + FF_FATAL_ERROR( "out of dynamic memory in ff_scan_buffer()" ); + + b->ff_buf_size = size - 2; /* "- 2" to take care of EOB's */ + b->ff_buf_pos = b->ff_ch_buf = base; + b->ff_is_our_buffer = 0; + b->ff_input_file = 0; + b->ff_n_chars = b->ff_buf_size; + b->ff_is_interactive = 0; + b->ff_at_bol = 1; + b->ff_fill_buffer = 0; + b->ff_buffer_status = FF_BUFFER_NEW; + + ff_switch_to_buffer( b ); + + return b; + } +#endif + + +#ifndef FF_NO_SCAN_STRING +#ifdef FF_USE_PROTOS +FF_BUFFER_STATE ff_scan_string( ffconst char *ff_str ) +#else +FF_BUFFER_STATE ff_scan_string( ff_str ) +ffconst char *ff_str; +#endif + { + int len; + for ( len = 0; ff_str[len]; ++len ) + ; + + return ff_scan_bytes( ff_str, len ); + } +#endif + + +#ifndef FF_NO_SCAN_BYTES +#ifdef FF_USE_PROTOS +FF_BUFFER_STATE ff_scan_bytes( ffconst char *bytes, int len ) +#else +FF_BUFFER_STATE ff_scan_bytes( bytes, len ) +ffconst char *bytes; +int len; +#endif + { + FF_BUFFER_STATE b; + char *buf; + ff_size_t n; + int i; + + /* Get memory for full buffer, including space for trailing EOB's. */ + n = len + 2; + buf = (char *) ff_flex_alloc( n ); + if ( ! buf ) + FF_FATAL_ERROR( "out of dynamic memory in ff_scan_bytes()" ); + + for ( i = 0; i < len; ++i ) + buf[i] = bytes[i]; + + buf[len] = buf[len+1] = FF_END_OF_BUFFER_CHAR; + + b = ff_scan_buffer( buf, n ); + if ( ! b ) + FF_FATAL_ERROR( "bad buffer in ff_scan_bytes()" ); + + /* It's okay to grow etc. this buffer, and we should throw it + * away when we're done. + */ + b->ff_is_our_buffer = 1; + + return b; + } +#endif + + +#ifndef FF_NO_PUSH_STATE +#ifdef FF_USE_PROTOS +static void ff_push_state( int new_state ) +#else +static void ff_push_state( new_state ) +int new_state; +#endif + { + if ( ff_start_stack_ptr >= ff_start_stack_depth ) + { + ff_size_t new_size; + + ff_start_stack_depth += FF_START_STACK_INCR; + new_size = ff_start_stack_depth * sizeof( int ); + + if ( ! ff_start_stack ) + ff_start_stack = (int *) ff_flex_alloc( new_size ); + + else + ff_start_stack = (int *) ff_flex_realloc( + (void *) ff_start_stack, new_size ); + + if ( ! ff_start_stack ) + FF_FATAL_ERROR( + "out of memory expanding start-condition stack" ); + } + + ff_start_stack[ff_start_stack_ptr++] = FF_START; + + BEGIN(new_state); + } +#endif + + +#ifndef FF_NO_POP_STATE +static void ff_pop_state() + { + if ( --ff_start_stack_ptr < 0 ) + FF_FATAL_ERROR( "start-condition stack underflow" ); + + BEGIN(ff_start_stack[ff_start_stack_ptr]); + } +#endif + + +#ifndef FF_NO_TOP_STATE +static int ff_top_state() + { + return ff_start_stack[ff_start_stack_ptr - 1]; + } +#endif + +#ifndef FF_EXIT_FAILURE +#define FF_EXIT_FAILURE 2 +#endif + +#ifdef FF_USE_PROTOS +static void ff_fatal_error( ffconst char msg[] ) +#else +static void ff_fatal_error( msg ) +char msg[]; +#endif + { + (void) fprintf( stderr, "%s\n", msg ); + exit( FF_EXIT_FAILURE ); + } + + + +/* Redefine ffless() so it works in section 3 code. */ + +#undef ffless +#define ffless(n) \ + do \ + { \ + /* Undo effects of setting up fftext. */ \ + fftext[ffleng] = ff_hold_char; \ + ff_c_buf_p = fftext + n; \ + ff_hold_char = *ff_c_buf_p; \ + *ff_c_buf_p = '\0'; \ + ffleng = n; \ + } \ + while ( 0 ) + + +/* Internal utility routines. */ + +#ifndef fftext_ptr +#ifdef FF_USE_PROTOS +static void ff_flex_strncpy( char *s1, ffconst char *s2, int n ) +#else +static void ff_flex_strncpy( s1, s2, n ) +char *s1; +ffconst char *s2; +int n; +#endif + { + register int i; + for ( i = 0; i < n; ++i ) + s1[i] = s2[i]; + } +#endif + +#ifdef FF_NEED_STRLEN +#ifdef FF_USE_PROTOS +static int ff_flex_strlen( ffconst char *s ) +#else +static int ff_flex_strlen( s ) +ffconst char *s; +#endif + { + register int n; + for ( n = 0; s[n]; ++n ) + ; + + return n; + } +#endif + + +#ifdef FF_USE_PROTOS +static void *ff_flex_alloc( ff_size_t size ) +#else +static void *ff_flex_alloc( size ) +ff_size_t size; +#endif + { + return (void *) malloc( size ); + } + +#ifdef FF_USE_PROTOS +static void *ff_flex_realloc( void *ptr, ff_size_t size ) +#else +static void *ff_flex_realloc( ptr, size ) +void *ptr; +ff_size_t size; +#endif + { + /* The cast to (char *) in the following accommodates both + * implementations that use char* generic pointers, and those + * that use void* generic pointers. It works with the latter + * because both ANSI C and C++ allow castless assignment from + * any pointer type to void*, and deal with argument conversions + * as though doing an assignment. + */ + return (void *) realloc( (char *) ptr, size ); + } + +#ifdef FF_USE_PROTOS +static void ff_flex_free( void *ptr ) +#else +static void ff_flex_free( ptr ) +void *ptr; +#endif + { + free( ptr ); + } + +#if FF_MAIN +int main() + { + fflex(); + return 0; + } +#endif +#line 386 "eval.l" + + +int ffwrap() +{ + /* MJT -- 13 June 1996 + Supplied for compatibility with + pre-2.5.1 versions of flex which + do not recognize %option noffwrap + */ + return(1); +} + +/* + expr_read is lifted from old ftools.skel. + Now we can use any version of flex with + no .skel file necessary! MJT - 13 June 1996 + + keep a memory of how many bytes have been + read previously, so that an unlimited-sized + buffer can be supported. PDW - 28 Feb 1998 +*/ + +static int expr_read(char *buf, int nbytes) +{ + int n; + + n = 0; + if( !gParse.is_eobuf ) { + do { + buf[n++] = gParse.expr[gParse.index++]; + } while ((nlng = varNum; + } + return( type ); +} + +static int find_variable(char *varName) +{ + int i; + + if( gParse.nCols ) + for( i=0; i c2) return(1); + if (c1 == 0) return(0); + s1++; + s2++; + } +} + +int strncasecmp(const char *s1, const char *s2, size_t n) +{ + char c1, c2; + + for (; n-- ;) { + c1 = toupper( *s1 ); + c2 = toupper( *s2 ); + + if (c1 < c2) return(-1); + if (c1 > c2) return(1); + if (c1 == 0) return(0); + s1++; + s2++; + } + return(0); +} + +#endif diff --git a/pkg/tbtables/cfitsio/eval_tab.h b/pkg/tbtables/cfitsio/eval_tab.h new file mode 100644 index 00000000..2715f0fd --- /dev/null +++ b/pkg/tbtables/cfitsio/eval_tab.h @@ -0,0 +1,41 @@ +typedef union { + int Node; /* Index of Node */ + double dbl; /* real value */ + long lng; /* integer value */ + char log; /* logical value */ + char str[256]; /* string value */ +} FFSTYPE; +#define BOOLEAN 258 +#define LONG 259 +#define DOUBLE 260 +#define STRING 261 +#define BITSTR 262 +#define FUNCTION 263 +#define BFUNCTION 264 +#define GTIFILTER 265 +#define REGFILTER 266 +#define COLUMN 267 +#define BCOLUMN 268 +#define SCOLUMN 269 +#define BITCOL 270 +#define ROWREF 271 +#define NULLREF 272 +#define SNULLREF 273 +#define OR 274 +#define AND 275 +#define EQ 276 +#define NE 277 +#define GT 278 +#define LT 279 +#define LTE 280 +#define GTE 281 +#define POWER 282 +#define NOT 283 +#define INTCAST 284 +#define FLTCAST 285 +#define UMINUS 286 +#define ACCUM 287 +#define DIFF 288 + + +extern FFSTYPE fflval; diff --git a/pkg/tbtables/cfitsio/eval_y.c b/pkg/tbtables/cfitsio/eval_y.c new file mode 100644 index 00000000..56e7690a --- /dev/null +++ b/pkg/tbtables/cfitsio/eval_y.c @@ -0,0 +1,6686 @@ + +/* A Bison parser, made from eval.y + by GNU Bison version 1.25 + */ + +#define FFBISON 1 /* Identify Bison output. */ + +#define BOOLEAN 258 +#define LONG 259 +#define DOUBLE 260 +#define STRING 261 +#define BITSTR 262 +#define FUNCTION 263 +#define BFUNCTION 264 +#define GTIFILTER 265 +#define REGFILTER 266 +#define COLUMN 267 +#define BCOLUMN 268 +#define SCOLUMN 269 +#define BITCOL 270 +#define ROWREF 271 +#define NULLREF 272 +#define SNULLREF 273 +#define OR 274 +#define AND 275 +#define EQ 276 +#define NE 277 +#define GT 278 +#define LT 279 +#define LTE 280 +#define GTE 281 +#define POWER 282 +#define NOT 283 +#define INTCAST 284 +#define FLTCAST 285 +#define UMINUS 286 +#define ACCUM 287 +#define DIFF 288 + +#line 1 "eval.y" + +/************************************************************************/ +/* */ +/* CFITSIO Lexical Parser */ +/* */ +/* This file is one of 3 files containing code which parses an */ +/* arithmetic expression and evaluates it in the context of an input */ +/* FITS file table extension. The CFITSIO lexical parser is divided */ +/* into the following 3 parts/files: the CFITSIO "front-end", */ +/* eval_f.c, contains the interface between the user/CFITSIO and the */ +/* real core of the parser; the FLEX interpreter, eval_l.c, takes the */ +/* input string and parses it into tokens and identifies the FITS */ +/* information required to evaluate the expression (ie, keywords and */ +/* columns); and, the BISON grammar and evaluation routines, eval_y.c, */ +/* receives the FLEX output and determines and performs the actual */ +/* operations. The files eval_l.c and eval_y.c are produced from */ +/* running flex and bison on the files eval.l and eval.y, respectively. */ +/* (flex and bison are available from any GNU archive: see www.gnu.org) */ +/* */ +/* The grammar rules, rather than evaluating the expression in situ, */ +/* builds a tree, or Nodal, structure mapping out the order of */ +/* operations and expression dependencies. This "compilation" process */ +/* allows for much faster processing of multiple rows. This technique */ +/* was developed by Uwe Lammers of the XMM Science Analysis System, */ +/* although the CFITSIO implementation is entirely code original. */ +/* */ +/* */ +/* Modification History: */ +/* */ +/* Kent Blackburn c1992 Original parser code developed for the */ +/* FTOOLS software package, in particular, */ +/* the fselect task. */ +/* Kent Blackburn c1995 BIT column support added */ +/* Peter D Wilson Feb 1998 Vector column support added */ +/* Peter D Wilson May 1998 Ported to CFITSIO library. User */ +/* interface routines written, in essence */ +/* making fselect, fcalc, and maketime */ +/* capabilities available to all tools */ +/* via single function calls. */ +/* Peter D Wilson Jun 1998 Major rewrite of parser core, so as to */ +/* create a run-time evaluation tree, */ +/* inspired by the work of Uwe Lammers, */ +/* resulting in a speed increase of */ +/* 10-100 times. */ +/* Peter D Wilson Jul 1998 gtifilter(a,b,c,d) function added */ +/* Peter D Wilson Aug 1998 regfilter(a,b,c,d) function added */ +/* Peter D Wilson Jul 1999 Make parser fitsfile-independent, */ +/* allowing a purely vector-based usage */ +/* Craig B Markwardt Jun 2004 Add MEDIAN() function */ +/* Craig B Markwardt Jun 2004 Add SUM(), and MIN/MAX() for bit arrays */ +/* Craig B Markwardt Jun 2004 Allow subscripting of nX bit arrays */ +/* Craig B Markwardt Jun 2004 Implement statistical functions */ +/* NVALID(), AVERAGE(), and STDDEV() */ +/* for integer and floating point vectors */ +/* Craig B Markwardt Jun 2004 Use NULL values for range errors instead*/ +/* of throwing a parse error */ +/* Craig B Markwardt Oct 2004 Add ACCUM() and SEQDIFF() functions */ +/* */ +/************************************************************************/ + +#define APPROX 1.0e-7 +#include "eval_defs.h" +#include "region.h" +#include + +#include + +#ifndef alloca +#define alloca malloc +#endif + + /* Shrink the initial stack depth to keep local data <32K (mac limit) */ + /* yacc will allocate more space if needed, though. */ +#define FFINITDEPTH 100 + +/***************************************************************/ +/* Replace Bison's BACKUP macro with one that fixes a bug -- */ +/* must update state after popping the stack -- and allows */ +/* popping multiple terms at one time. */ +/***************************************************************/ + +#define FFNEWBACKUP(token, value) \ + do \ + if (ffchar == FFEMPTY ) \ + { ffchar = (token); \ + memcpy( &fflval, &(value), sizeof(value) ); \ + ffchar1 = FFTRANSLATE (ffchar); \ + while (fflen--) FFPOPSTACK; \ + ffstate = *ffssp; \ + goto ffbackup; \ + } \ + else \ + { fferror ("syntax error: cannot back up"); FFERROR; } \ + while (0) + +/***************************************************************/ +/* Useful macros for accessing/testing Nodes */ +/***************************************************************/ + +#define TEST(a) if( (a)<0 ) FFERROR +#define SIZE(a) gParse.Nodes[ a ].value.nelem +#define TYPE(a) gParse.Nodes[ a ].type +#define PROMOTE(a,b) if( TYPE(a) > TYPE(b) ) \ + b = New_Unary( TYPE(a), 0, b ); \ + else if( TYPE(a) < TYPE(b) ) \ + a = New_Unary( TYPE(b), 0, a ); + +/***** Internal functions *****/ + +#ifdef __cplusplus +extern "C" { +#endif + +static int Alloc_Node ( void ); +static void Free_Last_Node( void ); +static void Evaluate_Node ( int thisNode ); + +static int New_Const ( int returnType, void *value, long len ); +static int New_Column( int ColNum ); +static int New_Offset( int ColNum, int offset ); +static int New_Unary ( int returnType, int Op, int Node1 ); +static int New_BinOp ( int returnType, int Node1, int Op, int Node2 ); +static int New_Func ( int returnType, funcOp Op, int nNodes, + int Node1, int Node2, int Node3, int Node4, + int Node5, int Node6, int Node7 ); +static int New_Deref ( int Var, int nDim, + int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 ); +static int New_GTI ( char *fname, int Node1, char *start, char *stop ); +static int New_REG ( char *fname, int NodeX, int NodeY, char *colNames ); +static int New_Vector( int subNode ); +static int Close_Vec ( int vecNode ); +static int Locate_Col( Node *this ); +static int Test_Dims ( int Node1, int Node2 ); +static void Copy_Dims ( int Node1, int Node2 ); + +static void Allocate_Ptrs( Node *this ); +static void Do_Unary ( Node *this ); +static void Do_Offset ( Node *this ); +static void Do_BinOp_bit ( Node *this ); +static void Do_BinOp_str ( Node *this ); +static void Do_BinOp_log ( Node *this ); +static void Do_BinOp_lng ( Node *this ); +static void Do_BinOp_dbl ( Node *this ); +static void Do_Func ( Node *this ); +static void Do_Deref ( Node *this ); +static void Do_GTI ( Node *this ); +static void Do_REG ( Node *this ); +static void Do_Vector ( Node *this ); + +static long Search_GTI ( double evtTime, long nGTI, double *start, + double *stop, int ordered ); + +static char saobox (double xcen, double ycen, double xwid, double ywid, + double rot, double xcol, double ycol); +static char ellipse(double xcen, double ycen, double xrad, double yrad, + double rot, double xcol, double ycol); +static char circle (double xcen, double ycen, double rad, + double xcol, double ycol); +static char bnear (double x, double y, double tolerance); +static char bitcmp (char *bitstrm1, char *bitstrm2); +static char bitlgte(char *bits1, int oper, char *bits2); + +static void bitand(char *result, char *bitstrm1, char *bitstrm2); +static void bitor (char *result, char *bitstrm1, char *bitstrm2); +static void bitnot(char *result, char *bits); + +static void fferror(char *msg); + +#ifdef __cplusplus + } +#endif + + +#line 175 "eval.y" +typedef union { + int Node; /* Index of Node */ + double dbl; /* real value */ + long lng; /* integer value */ + char log; /* logical value */ + char str[256]; /* string value */ +} FFSTYPE; +#include + +#ifndef __cplusplus +#ifndef __STDC__ +#define const +#endif +#endif + + + +#define FFFINAL 276 +#define FFFLAG -32768 +#define FFNTBASE 53 + +#define FFTRANSLATE(x) ((unsigned)(x) <= 288 ? fftranslate[x] : 61) + +static const char fftranslate[] = { 0, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 49, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 36, 40, 2, 51, + 52, 37, 34, 19, 35, 2, 38, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 21, 2, 2, + 20, 2, 24, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 46, 2, 50, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 22, 39, 23, 29, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, + 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 25, 26, 27, 28, 30, 31, 32, + 33, 41, 42, 43, 44, 45, 47, 48 +}; + +#if FFDEBUG != 0 +static const short ffprhs[] = { 0, + 0, 1, 4, 6, 9, 12, 15, 18, 21, 24, + 28, 31, 35, 39, 43, 46, 49, 51, 53, 58, + 62, 66, 70, 75, 82, 91, 102, 115, 118, 122, + 124, 126, 128, 133, 135, 137, 141, 145, 149, 153, + 157, 161, 164, 167, 171, 175, 179, 185, 191, 197, + 200, 204, 208, 212, 216, 222, 227, 234, 243, 254, + 267, 270, 273, 276, 279, 281, 283, 288, 292, 296, + 300, 304, 308, 312, 316, 320, 324, 328, 332, 336, + 340, 344, 348, 352, 356, 360, 364, 368, 372, 376, + 380, 386, 392, 396, 400, 404, 410, 418, 430, 446, + 449, 453, 459, 469, 473, 481, 491, 496, 503, 512, + 523, 536, 539, 543, 545, 547, 552, 554, 558, 562, + 568 +}; + +static const short ffrhs[] = { -1, + 53, 54, 0, 49, 0, 57, 49, 0, 58, 49, + 0, 60, 49, 0, 59, 49, 0, 1, 49, 0, + 22, 58, 0, 55, 19, 58, 0, 22, 57, 0, + 56, 19, 57, 0, 56, 19, 58, 0, 55, 19, + 57, 0, 56, 23, 0, 55, 23, 0, 7, 0, + 15, 0, 15, 22, 57, 23, 0, 59, 40, 59, + 0, 59, 39, 59, 0, 59, 34, 59, 0, 59, + 46, 57, 50, 0, 59, 46, 57, 19, 57, 50, + 0, 59, 46, 57, 19, 57, 19, 57, 50, 0, + 59, 46, 57, 19, 57, 19, 57, 19, 57, 50, + 0, 59, 46, 57, 19, 57, 19, 57, 19, 57, + 19, 57, 50, 0, 42, 59, 0, 51, 59, 52, + 0, 4, 0, 5, 0, 12, 0, 12, 22, 57, + 23, 0, 16, 0, 17, 0, 57, 36, 57, 0, + 57, 34, 57, 0, 57, 35, 57, 0, 57, 37, + 57, 0, 57, 38, 57, 0, 57, 41, 57, 0, + 34, 57, 0, 35, 57, 0, 51, 57, 52, 0, + 57, 37, 58, 0, 58, 37, 57, 0, 58, 24, + 57, 21, 57, 0, 58, 24, 58, 21, 57, 0, + 58, 24, 57, 21, 58, 0, 8, 52, 0, 8, + 58, 52, 0, 8, 60, 52, 0, 8, 59, 52, + 0, 8, 57, 52, 0, 8, 57, 19, 57, 52, + 0, 57, 46, 57, 50, 0, 57, 46, 57, 19, + 57, 50, 0, 57, 46, 57, 19, 57, 19, 57, + 50, 0, 57, 46, 57, 19, 57, 19, 57, 19, + 57, 50, 0, 57, 46, 57, 19, 57, 19, 57, + 19, 57, 19, 57, 50, 0, 43, 57, 0, 43, + 58, 0, 44, 57, 0, 44, 58, 0, 3, 0, + 13, 0, 13, 22, 57, 23, 0, 59, 27, 59, + 0, 59, 28, 59, 0, 59, 31, 59, 0, 59, + 32, 59, 0, 59, 30, 59, 0, 59, 33, 59, + 0, 57, 30, 57, 0, 57, 31, 57, 0, 57, + 33, 57, 0, 57, 32, 57, 0, 57, 29, 57, + 0, 57, 27, 57, 0, 57, 28, 57, 0, 60, + 27, 60, 0, 60, 28, 60, 0, 60, 30, 60, + 0, 60, 33, 60, 0, 60, 31, 60, 0, 60, + 32, 60, 0, 58, 26, 58, 0, 58, 25, 58, + 0, 58, 27, 58, 0, 58, 28, 58, 0, 57, + 20, 57, 21, 57, 0, 58, 24, 58, 21, 58, + 0, 9, 57, 52, 0, 9, 58, 52, 0, 9, + 60, 52, 0, 8, 58, 19, 58, 52, 0, 9, + 57, 19, 57, 19, 57, 52, 0, 9, 57, 19, + 57, 19, 57, 19, 57, 19, 57, 52, 0, 9, + 57, 19, 57, 19, 57, 19, 57, 19, 57, 19, + 57, 19, 57, 52, 0, 10, 52, 0, 10, 6, + 52, 0, 10, 6, 19, 57, 52, 0, 10, 6, + 19, 57, 19, 6, 19, 6, 52, 0, 11, 6, + 52, 0, 11, 6, 19, 57, 19, 57, 52, 0, + 11, 6, 19, 57, 19, 57, 19, 6, 52, 0, + 58, 46, 57, 50, 0, 58, 46, 57, 19, 57, + 50, 0, 58, 46, 57, 19, 57, 19, 57, 50, + 0, 58, 46, 57, 19, 57, 19, 57, 19, 57, + 50, 0, 58, 46, 57, 19, 57, 19, 57, 19, + 57, 19, 57, 50, 0, 42, 58, 0, 51, 58, + 52, 0, 6, 0, 14, 0, 14, 22, 57, 23, + 0, 18, 0, 51, 60, 52, 0, 60, 34, 60, + 0, 58, 24, 60, 21, 60, 0, 8, 60, 19, + 60, 52, 0 +}; + +#endif + +#if FFDEBUG != 0 +static const short ffrline[] = { 0, + 226, 227, 230, 231, 237, 243, 249, 255, 258, 260, + 273, 275, 288, 299, 313, 317, 321, 326, 328, 337, + 340, 343, 346, 348, 350, 352, 354, 356, 359, 363, + 365, 367, 369, 378, 380, 382, 385, 388, 391, 394, + 397, 400, 402, 404, 406, 410, 414, 433, 452, 471, + 481, 495, 507, 532, 612, 664, 666, 668, 670, 672, + 674, 676, 678, 680, 684, 686, 688, 697, 700, 703, + 706, 709, 712, 715, 718, 721, 724, 727, 730, 733, + 736, 739, 742, 745, 748, 751, 754, 756, 758, 760, + 763, 770, 787, 800, 813, 824, 840, 858, 879, 906, + 910, 914, 917, 921, 925, 928, 932, 934, 936, 938, + 940, 942, 944, 948, 951, 953, 962, 964, 966, 969, + 981 +}; +#endif + + +#if FFDEBUG != 0 || defined (FFERROR_VERBOSE) + +static const char * const fftname[] = { "$","error","$undefined.","BOOLEAN", +"LONG","DOUBLE","STRING","BITSTR","FUNCTION","BFUNCTION","GTIFILTER","REGFILTER", +"COLUMN","BCOLUMN","SCOLUMN","BITCOL","ROWREF","NULLREF","SNULLREF","','","'='", +"':'","'{'","'}'","'?'","OR","AND","EQ","NE","'~'","GT","LT","LTE","GTE","'+'", +"'-'","'%'","'*'","'/'","'|'","'&'","POWER","NOT","INTCAST","FLTCAST","UMINUS", +"'['","ACCUM","DIFF","'\\n'","']'","'('","')'","lines","line","bvector","vector", +"expr","bexpr","bits","sexpr", NULL +}; +#endif + +static const short ffr1[] = { 0, + 53, 53, 54, 54, 54, 54, 54, 54, 55, 55, + 56, 56, 56, 56, 57, 58, 59, 59, 59, 59, + 59, 59, 59, 59, 59, 59, 59, 59, 59, 57, + 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, + 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, + 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, + 57, 57, 57, 57, 58, 58, 58, 58, 58, 58, + 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, + 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, + 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, + 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, + 58, 58, 58, 60, 60, 60, 60, 60, 60, 60, + 60 +}; + +static const short ffr2[] = { 0, + 0, 2, 1, 2, 2, 2, 2, 2, 2, 3, + 2, 3, 3, 3, 2, 2, 1, 1, 4, 3, + 3, 3, 4, 6, 8, 10, 12, 2, 3, 1, + 1, 1, 4, 1, 1, 3, 3, 3, 3, 3, + 3, 2, 2, 3, 3, 3, 5, 5, 5, 2, + 3, 3, 3, 3, 5, 4, 6, 8, 10, 12, + 2, 2, 2, 2, 1, 1, 4, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 5, 5, 3, 3, 3, 5, 7, 11, 15, 2, + 3, 5, 9, 3, 7, 9, 4, 6, 8, 10, + 12, 2, 3, 1, 1, 4, 1, 3, 3, 5, + 5 +}; + +static const short ffdefact[] = { 1, + 0, 0, 65, 30, 31, 114, 17, 0, 0, 0, + 0, 32, 66, 115, 18, 34, 35, 117, 0, 0, + 0, 0, 0, 0, 3, 0, 2, 0, 0, 0, + 0, 0, 0, 8, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, + 11, 9, 0, 42, 0, 43, 0, 112, 28, 61, + 62, 63, 64, 0, 0, 0, 0, 0, 16, 0, + 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, + 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, + 0, 0, 0, 6, 0, 54, 0, 51, 53, 0, + 52, 0, 93, 94, 95, 0, 101, 0, 104, 0, + 0, 0, 0, 44, 113, 29, 118, 14, 10, 12, + 13, 0, 79, 80, 78, 74, 75, 77, 76, 37, + 38, 36, 39, 45, 40, 41, 0, 0, 0, 0, + 88, 87, 89, 90, 46, 0, 0, 0, 68, 69, + 72, 70, 71, 73, 22, 21, 20, 0, 81, 82, + 83, 85, 86, 84, 119, 0, 0, 0, 0, 0, + 0, 33, 67, 116, 19, 0, 0, 56, 0, 0, + 0, 0, 107, 28, 0, 0, 23, 55, 96, 121, + 0, 0, 102, 0, 91, 0, 47, 49, 48, 92, + 120, 0, 0, 0, 0, 0, 0, 57, 0, 108, + 0, 24, 0, 97, 0, 0, 105, 0, 0, 0, + 0, 0, 0, 0, 58, 0, 109, 0, 25, 0, + 103, 106, 0, 0, 0, 0, 0, 59, 0, 110, + 0, 26, 0, 98, 0, 0, 0, 0, 60, 111, + 27, 0, 0, 99, 0, 0 +}; + +static const short ffdefgoto[] = { 1, + 27, 28, 29, 57, 55, 42, 53 +}; + +static const short ffpact[] = {-32768, + 290, -46,-32768,-32768,-32768,-32768,-32768, 339, 389, -2, + 10, 5, 6, 21, 23,-32768,-32768,-32768, 389, 389, + 389, 389, 389, 389,-32768, 389,-32768, 40, 42, 1024, + 165, 1299, 1319,-32768,-32768, 415, -13, 283, 131, 443, + 160, 1345, 385, -18,-32768, -17, 389, 389, 389, 389, + 1251, 1297, 1392, 20, 1297, 20, 1251, 22, 45, 20, + 22, 20, 22, 582, 209, 332, 1268, 389,-32768, 389, +-32768, 389, 389, 389, 389, 389, 389, 389, 389, 389, + 389, 389, 389, 389, 389, 389,-32768, 389, 389, 389, + 389, 389, 389, 389,-32768, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 389,-32768, 389, 389, 389, 389, + 389, 389, 389,-32768, 389,-32768, 389,-32768,-32768, 389, +-32768, 389,-32768,-32768,-32768, 389,-32768, 389,-32768, 1127, + 1147, 1167, 1187,-32768,-32768,-32768,-32768, 1251, 1297, 1251, + 1297, 1209, 1362, 1362, 1362, 1375, 1375, 1375, 1375, 82, + 82, 82, -36, 22, -36, -36, 664, 1231, 1282, 249, + 14, 62, -16, -16, -36, 688, 2, 2, -8, -8, + -8, -8, -8, -8, 16, 45, 45, 712, 100, 100, + 52, 52, 52, 52,-32768, 609, 226, 1284, 1047, 471, + 1067,-32768,-32768,-32768,-32768, 389, 389,-32768, 389, 389, + 389, 389,-32768, 45, 18, 389,-32768,-32768,-32768,-32768, + 389, 88,-32768, 389, 1328, 736, 1328, 1297, 1328, 1297, + 1392, 760, 784, 499, 78, 527, 389,-32768, 389,-32768, + 389,-32768, 389,-32768, 92, 94,-32768, 808, 832, 856, + 1087, 49, 50, 389,-32768, 389,-32768, 389,-32768, 389, +-32768,-32768, 880, 904, 928, 555, 389,-32768, 389,-32768, + 389,-32768, 389,-32768, 952, 976, 1000, 1107,-32768,-32768, +-32768, 389, 636,-32768, 103,-32768 +}; + +static const short ffpgoto[] = {-32768, +-32768,-32768,-32768, -1, 87, 121, 28 +}; + + +#define FFLAST 1426 + + +static const short fftable[] = { 30, + 126, 128, 34, 44, 85, 117, 36, 40, 7, 86, + 88, 89, 90, 91, 92, 46, 15, 51, 54, 56, + 93, 60, 62, 93, 64, 102, 47, 48, 33, 94, + 103, 104, 94, 127, 129, 39, 43, 105, 118, 90, + 91, 92, 49, 167, 50, 130, 131, 132, 133, 45, + 93, 102, 168, 67, 103, 104, 103, 104, 68, 94, + 70, 105, 69, 105, 71, 86, 138, 94, 140, 136, + 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 155, 156, 157, 113, 158, 31, 91, 92, + 105, 165, 166, 225, 37, 41, 235, 242, 93, 243, + 251, 252, 276, 178, 0, 52, 0, 94, 58, 61, + 63, 0, 65, 186, 0, 160, 0, 0, 83, 84, + 189, 32, 85, 0, 190, 0, 191, 86, 38, 109, + 110, 111, 112, 113, 179, 180, 181, 182, 183, 184, + 185, 0, 59, 0, 0, 0, 66, 188, 0, 120, + 0, 0, 0, 0, 139, 0, 141, 107, 108, 0, + 109, 110, 111, 112, 113, 0, 0, 0, 0, 154, + 0, 0, 0, 0, 159, 161, 162, 163, 164, 0, + 0, 0, 121, 88, 89, 90, 91, 92, 88, 89, + 90, 91, 92, 0, 215, 216, 93, 217, 219, 0, + 222, 93, 0, 187, 223, 94, 0, 0, 0, 224, + 94, 124, 226, 95, 0, 0, 169, 170, 171, 172, + 173, 174, 175, 176, 177, 238, 0, 239, 221, 240, + 0, 241, 88, 89, 90, 91, 92, 0, 0, 0, + 0, 0, 253, 0, 254, 93, 255, 0, 256, 88, + 89, 90, 91, 92, 94, 265, 0, 266, 0, 267, + 135, 268, 93, 0, 0, 0, 0, 0, 0, 201, + 273, 94, 0, 0, 0, 107, 108, 209, 109, 110, + 111, 112, 113, 0, 0, 218, 220, 204, 205, 275, + 2, 0, 3, 4, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 14, 15, 16, 17, 18, 0, 96, + 97, 19, 98, 99, 100, 101, 102, 0, 0, 0, + 0, 103, 104, 20, 21, 0, 0, 0, 105, 0, + 0, 22, 23, 24, 119, 0, 0, 0, 25, 0, + 26, 3, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15, 16, 17, 18, 0, 96, 97, + 19, 98, 99, 100, 101, 102, 0, 0, 0, 0, + 103, 104, 20, 21, 0, 0, 0, 105, 0, 0, + 22, 23, 24, 136, 0, 0, 0, 0, 0, 26, + 35, 3, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15, 16, 17, 18, 0, 0, 0, + 19, 107, 108, 0, 109, 110, 111, 112, 113, 0, + 0, 0, 20, 21, 0, 0, 0, 0, 0, 0, + 22, 23, 24, 115, 72, 0, 125, 0, 0, 26, + 0, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 0, 0, 85, 0, 0, 0, 0, + 86, 122, 72, 0, 0, 0, 116, 0, 0, 73, + 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, + 84, 0, 0, 85, 0, 0, 0, 0, 86, 212, + 72, 0, 0, 0, 123, 0, 0, 73, 74, 75, + 76, 77, 78, 79, 80, 81, 82, 83, 84, 0, + 0, 85, 0, 0, 0, 0, 86, 233, 72, 0, + 0, 0, 213, 0, 0, 73, 74, 75, 76, 77, + 78, 79, 80, 81, 82, 83, 84, 0, 0, 85, + 0, 0, 0, 0, 86, 236, 72, 0, 0, 0, + 234, 0, 0, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 0, 0, 85, 0, 0, + 0, 0, 86, 263, 72, 0, 0, 0, 237, 0, + 0, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 0, 0, 85, 0, 0, 0, 0, + 86, 72, 0, 0, 0, 0, 264, 0, 73, 74, + 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, + 0, 0, 85, 0, 0, 0, 0, 86, 72, 0, + 0, 0, 0, 134, 0, 73, 74, 75, 76, 77, + 78, 79, 80, 81, 82, 83, 84, 0, 0, 85, + 0, 0, 0, 0, 86, 72, 0, 0, 0, 0, + 208, 0, 73, 74, 75, 76, 77, 78, 79, 80, + 81, 82, 83, 84, 0, 0, 85, 0, 0, 0, + 0, 86, 197, 72, 0, 0, 0, 274, 0, 0, + 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, + 83, 84, 0, 0, 85, 0, 202, 72, 0, 86, + 0, 0, 0, 198, 73, 74, 75, 76, 77, 78, + 79, 80, 81, 82, 83, 84, 0, 0, 85, 0, + 206, 72, 0, 86, 0, 0, 0, 203, 73, 74, + 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, + 0, 0, 85, 0, 227, 72, 0, 86, 0, 0, + 0, 207, 73, 74, 75, 76, 77, 78, 79, 80, + 81, 82, 83, 84, 0, 0, 85, 0, 229, 72, + 0, 86, 0, 0, 0, 228, 73, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 83, 84, 0, 0, + 85, 0, 231, 72, 0, 86, 0, 0, 0, 230, + 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, + 83, 84, 0, 0, 85, 0, 244, 72, 0, 86, + 0, 0, 0, 232, 73, 74, 75, 76, 77, 78, + 79, 80, 81, 82, 83, 84, 0, 0, 85, 0, + 246, 72, 0, 86, 0, 0, 0, 245, 73, 74, + 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, + 0, 0, 85, 0, 248, 72, 0, 86, 0, 0, + 0, 247, 73, 74, 75, 76, 77, 78, 79, 80, + 81, 82, 83, 84, 0, 0, 85, 0, 257, 72, + 0, 86, 0, 0, 0, 249, 73, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 83, 84, 0, 0, + 85, 0, 259, 72, 0, 86, 0, 0, 0, 258, + 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, + 83, 84, 0, 0, 85, 0, 261, 72, 0, 86, + 0, 0, 0, 260, 73, 74, 75, 76, 77, 78, + 79, 80, 81, 82, 83, 84, 0, 0, 85, 0, + 0, 72, 0, 86, 0, 0, 0, 262, 73, 74, + 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, + 0, 0, 85, 0, 0, 72, 0, 86, 0, 0, + 0, 269, 73, 74, 75, 76, 77, 78, 79, 80, + 81, 82, 83, 84, 0, 0, 85, 0, 0, 72, + 0, 86, 0, 0, 0, 270, 73, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 83, 84, 0, 0, + 85, 0, 0, 72, 0, 86, 0, 0, 0, 271, + 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, + 83, 84, 0, 0, 85, 211, 72, 0, 0, 86, + 0, 0, 87, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 214, 72, 85, 0, 0, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 250, 72, 85, 0, 0, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 272, 72, 85, 0, 0, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 0, 72, 85, 0, 192, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 0, 72, 85, 0, 193, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 0, 72, 85, 0, 194, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 0, 72, 85, 0, 195, + 0, 0, 86, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 0, 0, 85, 72, 196, + 0, 0, 86, 0, 0, 73, 74, 75, 76, 77, + 78, 79, 80, 81, 82, 83, 84, 0, 0, 85, + 72, 199, 0, 0, 86, 0, 0, 73, 74, 75, + 76, 77, 78, 79, 80, 81, 82, 83, 84, 0, + 72, 85, 0, 0, 0, 0, 86, 73, 74, 75, + 76, 77, 78, 79, 80, 81, 82, 83, 84, 0, + 0, 85, 0, 0, 107, 108, 86, 109, 110, 111, + 112, 113, 200, 0, 0, 88, 89, 90, 91, 92, + 107, 108, 0, 109, 110, 111, 112, 113, 93, 137, + 88, 89, 90, 91, 92, 96, 97, 94, 98, 99, + 100, 101, 102, 93, 0, 210, 0, 103, 104, 0, + 0, 0, 94, 0, 105, 107, 108, 106, 109, 110, + 111, 112, 113, 0, 73, 74, 75, 76, 77, 78, + 79, 80, 81, 82, 83, 84, 0, 114, 85, 0, + 0, 96, 97, 86, 98, 99, 100, 101, 102, 0, + 0, 0, 0, 103, 104, 0, 0, 0, 0, 0, + 105, 76, 77, 78, 79, 80, 81, 82, 83, 84, + 0, 0, 85, 0, 0, 0, 0, 86, 80, 81, + 82, 83, 84, 0, 0, 85, 0, 0, 107, 108, + 86, 109, 110, 111, 112, 113 +}; + +static const short ffcheck[] = { 1, + 19, 19, 49, 6, 41, 19, 8, 9, 7, 46, + 24, 25, 26, 27, 28, 6, 15, 19, 20, 21, + 37, 23, 24, 37, 26, 34, 22, 22, 1, 46, + 39, 40, 46, 52, 52, 8, 9, 46, 52, 26, + 27, 28, 22, 42, 22, 47, 48, 49, 50, 52, + 37, 34, 51, 26, 39, 40, 39, 40, 19, 46, + 19, 46, 23, 46, 23, 46, 68, 46, 70, 52, + 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 85, 86, 34, 88, 1, 27, 28, + 46, 93, 94, 6, 8, 9, 19, 6, 37, 6, + 52, 52, 0, 105, -1, 19, -1, 46, 22, 23, + 24, -1, 26, 115, -1, 88, -1, -1, 37, 38, + 122, 1, 41, -1, 126, -1, 128, 46, 8, 30, + 31, 32, 33, 34, 107, 108, 109, 110, 111, 112, + 113, -1, 22, -1, -1, -1, 26, 120, -1, 19, + -1, -1, -1, -1, 68, -1, 70, 27, 28, -1, + 30, 31, 32, 33, 34, -1, -1, -1, -1, 83, + -1, -1, -1, -1, 88, 89, 90, 91, 92, -1, + -1, -1, 52, 24, 25, 26, 27, 28, 24, 25, + 26, 27, 28, -1, 196, 197, 37, 199, 200, -1, + 202, 37, -1, 117, 206, 46, -1, -1, -1, 211, + 46, 52, 214, 49, -1, -1, 96, 97, 98, 99, + 100, 101, 102, 103, 104, 227, -1, 229, 201, 231, + -1, 233, 24, 25, 26, 27, 28, -1, -1, -1, + -1, -1, 244, -1, 246, 37, 248, -1, 250, 24, + 25, 26, 27, 28, 46, 257, -1, 259, -1, 261, + 52, 263, 37, -1, -1, -1, -1, -1, -1, 21, + 272, 46, -1, -1, -1, 27, 28, 52, 30, 31, + 32, 33, 34, -1, -1, 199, 200, 167, 168, 0, + 1, -1, 3, 4, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 14, 15, 16, 17, 18, -1, 27, + 28, 22, 30, 31, 32, 33, 34, -1, -1, -1, + -1, 39, 40, 34, 35, -1, -1, -1, 46, -1, + -1, 42, 43, 44, 52, -1, -1, -1, 49, -1, + 51, 3, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15, 16, 17, 18, -1, 27, 28, + 22, 30, 31, 32, 33, 34, -1, -1, -1, -1, + 39, 40, 34, 35, -1, -1, -1, 46, -1, -1, + 42, 43, 44, 52, -1, -1, -1, -1, -1, 51, + 52, 3, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15, 16, 17, 18, -1, -1, -1, + 22, 27, 28, -1, 30, 31, 32, 33, 34, -1, + -1, -1, 34, 35, -1, -1, -1, -1, -1, -1, + 42, 43, 44, 19, 20, -1, 52, -1, -1, 51, + -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, -1, -1, 41, -1, -1, -1, -1, + 46, 19, 20, -1, -1, -1, 52, -1, -1, 27, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, -1, -1, 41, -1, -1, -1, -1, 46, 19, + 20, -1, -1, -1, 52, -1, -1, 27, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, -1, + -1, 41, -1, -1, -1, -1, 46, 19, 20, -1, + -1, -1, 52, -1, -1, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, -1, -1, 41, + -1, -1, -1, -1, 46, 19, 20, -1, -1, -1, + 52, -1, -1, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, -1, -1, 41, -1, -1, + -1, -1, 46, 19, 20, -1, -1, -1, 52, -1, + -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, -1, -1, 41, -1, -1, -1, -1, + 46, 20, -1, -1, -1, -1, 52, -1, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + -1, -1, 41, -1, -1, -1, -1, 46, 20, -1, + -1, -1, -1, 52, -1, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, -1, -1, 41, + -1, -1, -1, -1, 46, 20, -1, -1, -1, -1, + 52, -1, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, -1, -1, 41, -1, -1, -1, + -1, 46, 19, 20, -1, -1, -1, 52, -1, -1, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, -1, -1, 41, -1, 19, 20, -1, 46, + -1, -1, -1, 50, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, -1, -1, 41, -1, + 19, 20, -1, 46, -1, -1, -1, 50, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + -1, -1, 41, -1, 19, 20, -1, 46, -1, -1, + -1, 50, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, -1, -1, 41, -1, 19, 20, + -1, 46, -1, -1, -1, 50, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, -1, -1, + 41, -1, 19, 20, -1, 46, -1, -1, -1, 50, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, -1, -1, 41, -1, 19, 20, -1, 46, + -1, -1, -1, 50, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, -1, -1, 41, -1, + 19, 20, -1, 46, -1, -1, -1, 50, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + -1, -1, 41, -1, 19, 20, -1, 46, -1, -1, + -1, 50, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, -1, -1, 41, -1, 19, 20, + -1, 46, -1, -1, -1, 50, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, -1, -1, + 41, -1, 19, 20, -1, 46, -1, -1, -1, 50, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, -1, -1, 41, -1, 19, 20, -1, 46, + -1, -1, -1, 50, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, -1, -1, 41, -1, + -1, 20, -1, 46, -1, -1, -1, 50, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + -1, -1, 41, -1, -1, 20, -1, 46, -1, -1, + -1, 50, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, -1, -1, 41, -1, -1, 20, + -1, 46, -1, -1, -1, 50, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, -1, -1, + 41, -1, -1, 20, -1, 46, -1, -1, -1, 50, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, -1, -1, 41, 19, 20, -1, -1, 46, + -1, -1, 49, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 19, 20, 41, -1, -1, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 19, 20, 41, -1, -1, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 19, 20, 41, -1, -1, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, -1, 20, 41, -1, 23, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, -1, 20, 41, -1, 23, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, -1, 20, 41, -1, 23, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, -1, 20, 41, -1, 23, + -1, -1, 46, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, -1, -1, 41, 20, 21, + -1, -1, 46, -1, -1, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, -1, -1, 41, + 20, 21, -1, -1, 46, -1, -1, 27, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, -1, + 20, 41, -1, -1, -1, -1, 46, 27, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, -1, + -1, 41, -1, -1, 27, 28, 46, 30, 31, 32, + 33, 34, 21, -1, -1, 24, 25, 26, 27, 28, + 27, 28, -1, 30, 31, 32, 33, 34, 37, 52, + 24, 25, 26, 27, 28, 27, 28, 46, 30, 31, + 32, 33, 34, 37, -1, 52, -1, 39, 40, -1, + -1, -1, 46, -1, 46, 27, 28, 49, 30, 31, + 32, 33, 34, -1, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, -1, 49, 41, -1, + -1, 27, 28, 46, 30, 31, 32, 33, 34, -1, + -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, + 46, 30, 31, 32, 33, 34, 35, 36, 37, 38, + -1, -1, 41, -1, -1, -1, -1, 46, 34, 35, + 36, 37, 38, -1, -1, 41, -1, -1, 27, 28, + 46, 30, 31, 32, 33, 34 +}; +/* -*-C-*- Note some compilers choke on comments on `#line' lines. */ +#line 3 "/usr1/local/share/bison.simple" + +/* Skeleton output parser for bison, + Copyright (C) 1984, 1989, 1990 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ + +/* As a special exception, when this file is copied by Bison into a + Bison output file, you may use that output file without restriction. + This special exception was added by the Free Software Foundation + in version 1.24 of Bison. */ + +#ifndef alloca +#ifdef __GNUC__ +#define alloca __builtin_alloca +#else /* not GNU C. */ +#if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi) +#include +#else /* not sparc */ +#if defined (MSDOS) && !defined (__TURBOC__) +#include +#else /* not MSDOS, or __TURBOC__ */ +#if defined(_AIX) +#include + #pragma alloca +#else /* not MSDOS, __TURBOC__, or _AIX */ +#ifdef __hpux +#ifdef __cplusplus +extern "C" { +void *alloca (unsigned int); +}; +#else /* not __cplusplus */ +void *alloca (); +#endif /* not __cplusplus */ +#endif /* __hpux */ +#endif /* not _AIX */ +#endif /* not MSDOS, or __TURBOC__ */ +#endif /* not sparc. */ +#endif /* not GNU C. */ +#endif /* alloca not defined. */ + +/* This is the parser code that is written into each bison parser + when the %semantic_parser declaration is not specified in the grammar. + It was written by Richard Stallman by simplifying the hairy parser + used when %semantic_parser is specified. */ + +/* Note: there must be only one dollar sign in this file. + It is replaced by the list of actions, each action + as one case of the switch. */ + +#define fferrok (fferrstatus = 0) +#define ffclearin (ffchar = FFEMPTY) +#define FFEMPTY -2 +#define FFEOF 0 +#define FFACCEPT return(0) +#define FFABORT return(1) +#define FFERROR goto fferrlab1 +/* Like FFERROR except do call fferror. + This remains here temporarily to ease the + transition to the new meaning of FFERROR, for GCC. + Once GCC version 2 has supplanted version 1, this can go. */ +#define FFFAIL goto fferrlab +#define FFRECOVERING() (!!fferrstatus) +#define FFBACKUP(token, value) \ +do \ + if (ffchar == FFEMPTY && fflen == 1) \ + { ffchar = (token), fflval = (value); \ + ffchar1 = FFTRANSLATE (ffchar); \ + FFPOPSTACK; \ + goto ffbackup; \ + } \ + else \ + { fferror ("syntax error: cannot back up"); FFERROR; } \ +while (0) + +#define FFTERROR 1 +#define FFERRCODE 256 + +#ifndef FFPURE +#define FFLEX fflex() +#endif + +#ifdef FFPURE +#ifdef FFLSP_NEEDED +#ifdef FFLEX_PARAM +#define FFLEX fflex(&fflval, &fflloc, FFLEX_PARAM) +#else +#define FFLEX fflex(&fflval, &fflloc) +#endif +#else /* not FFLSP_NEEDED */ +#ifdef FFLEX_PARAM +#define FFLEX fflex(&fflval, FFLEX_PARAM) +#else +#define FFLEX fflex(&fflval) +#endif +#endif /* not FFLSP_NEEDED */ +#endif + +/* If nonreentrant, generate the variables here */ + +#ifndef FFPURE + +int ffchar; /* the lookahead symbol */ +FFSTYPE fflval; /* the semantic value of the */ + /* lookahead symbol */ + +#ifdef FFLSP_NEEDED +FFLTYPE fflloc; /* location data for the lookahead */ + /* symbol */ +#endif + +int ffnerrs; /* number of parse errors so far */ +#endif /* not FFPURE */ + +#if FFDEBUG != 0 +int ffdebug; /* nonzero means print parse trace */ +/* Since this is uninitialized, it does not stop multiple parsers + from coexisting. */ +#endif + +/* FFINITDEPTH indicates the initial size of the parser's stacks */ + +#ifndef FFINITDEPTH +#define FFINITDEPTH 200 +#endif + +/* FFMAXDEPTH is the maximum size the stacks can grow to + (effective only if the built-in stack extension method is used). */ + +#if FFMAXDEPTH == 0 +#undef FFMAXDEPTH +#endif + +#ifndef FFMAXDEPTH +#define FFMAXDEPTH 10000 +#endif + +/* Prevent warning if -Wstrict-prototypes. */ +#ifdef __GNUC__ +int ffparse (void); +#endif + +#if __GNUC__ > 1 /* GNU C and GNU C++ define this. */ +#define __ff_memcpy(TO,FROM,COUNT) __builtin_memcpy(TO,FROM,COUNT) +#else /* not GNU C or C++ */ +#ifndef __cplusplus + +/* This is the most reliable way to avoid incompatibilities + in available built-in functions on various systems. */ +static void +__ff_memcpy (to, from, count) + char *to; + char *from; + int count; +{ + register char *f = from; + register char *t = to; + register int i = count; + + while (i-- > 0) + *t++ = *f++; +} + +#else /* __cplusplus */ + +/* This is the most reliable way to avoid incompatibilities + in available built-in functions on various systems. */ +static void +__ff_memcpy (char *to, char *from, int count) +{ + register char *f = from; + register char *t = to; + register int i = count; + + while (i-- > 0) + *t++ = *f++; +} + +#endif +#endif + +#line 196 "/usr1/local/share/bison.simple" + +/* The user can define FFPARSE_PARAM as the name of an argument to be passed + into ffparse. The argument should have type void *. + It should actually point to an object. + Grammar actions can access the variable by casting it + to the proper pointer type. */ + +#ifdef FFPARSE_PARAM +#ifdef __cplusplus +#define FFPARSE_PARAM_ARG void *FFPARSE_PARAM +#define FFPARSE_PARAM_DECL +#else /* not __cplusplus */ +#define FFPARSE_PARAM_ARG FFPARSE_PARAM +#define FFPARSE_PARAM_DECL void *FFPARSE_PARAM; +#endif /* not __cplusplus */ +#else /* not FFPARSE_PARAM */ +#define FFPARSE_PARAM_ARG +#define FFPARSE_PARAM_DECL +#endif /* not FFPARSE_PARAM */ + +int +ffparse(FFPARSE_PARAM_ARG) + FFPARSE_PARAM_DECL +{ + register int ffstate; + register int ffn; + register short *ffssp; + register FFSTYPE *ffvsp; + int fferrstatus; /* number of tokens to shift before error messages enabled */ + int ffchar1 = 0; /* lookahead token as an internal (translated) token number */ + + short ffssa[FFINITDEPTH]; /* the state stack */ + FFSTYPE ffvsa[FFINITDEPTH]; /* the semantic value stack */ + + short *ffss = ffssa; /* refer to the stacks thru separate pointers */ + FFSTYPE *ffvs = ffvsa; /* to allow ffoverflow to reallocate them elsewhere */ + +#ifdef FFLSP_NEEDED + FFLTYPE fflsa[FFINITDEPTH]; /* the location stack */ + FFLTYPE *ffls = fflsa; + FFLTYPE *fflsp; + +#define FFPOPSTACK (ffvsp--, ffssp--, fflsp--) +#else +#define FFPOPSTACK (ffvsp--, ffssp--) +#endif + + int ffstacksize = FFINITDEPTH; + +#ifdef FFPURE + int ffchar; + FFSTYPE fflval; + int ffnerrs; +#ifdef FFLSP_NEEDED + FFLTYPE fflloc; +#endif +#endif + + FFSTYPE ffval; /* the variable used to return */ + /* semantic values from the action */ + /* routines */ + + int fflen; + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Starting parse\n"); +#endif + + ffstate = 0; + fferrstatus = 0; + ffnerrs = 0; + ffchar = FFEMPTY; /* Cause a token to be read. */ + + /* Initialize stack pointers. + Waste one element of value and location stack + so that they stay on the same level as the state stack. + The wasted elements are never initialized. */ + + ffssp = ffss - 1; + ffvsp = ffvs; +#ifdef FFLSP_NEEDED + fflsp = ffls; +#endif + +/* Push a new state, which is found in ffstate . */ +/* In all cases, when you get here, the value and location stacks + have just been pushed. so pushing a state here evens the stacks. */ +ffnewstate: + + *++ffssp = ffstate; + + if (ffssp >= ffss + ffstacksize - 1) + { + /* Give user a chance to reallocate the stack */ + /* Use copies of these so that the &'s don't force the real ones into memory. */ + FFSTYPE *ffvs1 = ffvs; + short *ffss1 = ffss; +#ifdef FFLSP_NEEDED + FFLTYPE *ffls1 = ffls; +#endif + + /* Get the current used size of the three stacks, in elements. */ + int size = ffssp - ffss + 1; + +#ifdef ffoverflow + /* Each stack pointer address is followed by the size of + the data in use in that stack, in bytes. */ +#ifdef FFLSP_NEEDED + /* This used to be a conditional around just the two extra args, + but that might be undefined if ffoverflow is a macro. */ + ffoverflow("parser stack overflow", + &ffss1, size * sizeof (*ffssp), + &ffvs1, size * sizeof (*ffvsp), + &ffls1, size * sizeof (*fflsp), + &ffstacksize); +#else + ffoverflow("parser stack overflow", + &ffss1, size * sizeof (*ffssp), + &ffvs1, size * sizeof (*ffvsp), + &ffstacksize); +#endif + + ffss = ffss1; ffvs = ffvs1; +#ifdef FFLSP_NEEDED + ffls = ffls1; +#endif +#else /* no ffoverflow */ + /* Extend the stack our own way. */ + if (ffstacksize >= FFMAXDEPTH) + { + fferror("parser stack overflow"); + return 2; + } + ffstacksize *= 2; + if (ffstacksize > FFMAXDEPTH) + ffstacksize = FFMAXDEPTH; + ffss = (short *) alloca (ffstacksize * sizeof (*ffssp)); + __ff_memcpy ((char *)ffss, (char *)ffss1, size * sizeof (*ffssp)); + ffvs = (FFSTYPE *) alloca (ffstacksize * sizeof (*ffvsp)); + __ff_memcpy ((char *)ffvs, (char *)ffvs1, size * sizeof (*ffvsp)); +#ifdef FFLSP_NEEDED + ffls = (FFLTYPE *) alloca (ffstacksize * sizeof (*fflsp)); + __ff_memcpy ((char *)ffls, (char *)ffls1, size * sizeof (*fflsp)); +#endif +#endif /* no ffoverflow */ + + ffssp = ffss + size - 1; + ffvsp = ffvs + size - 1; +#ifdef FFLSP_NEEDED + fflsp = ffls + size - 1; +#endif + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Stack size increased to %d\n", ffstacksize); +#endif + + if (ffssp >= ffss + ffstacksize - 1) + FFABORT; + } + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Entering state %d\n", ffstate); +#endif + + goto ffbackup; + ffbackup: + +/* Do appropriate processing given the current state. */ +/* Read a lookahead token if we need one and don't already have one. */ +/* ffresume: */ + + /* First try to decide what to do without reference to lookahead token. */ + + ffn = ffpact[ffstate]; + if (ffn == FFFLAG) + goto ffdefault; + + /* Not known => get a lookahead token if don't already have one. */ + + /* ffchar is either FFEMPTY or FFEOF + or a valid token in external form. */ + + if (ffchar == FFEMPTY) + { +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Reading a token: "); +#endif + ffchar = FFLEX; + } + + /* Convert token to internal form (in ffchar1) for indexing tables with */ + + if (ffchar <= 0) /* This means end of input. */ + { + ffchar1 = 0; + ffchar = FFEOF; /* Don't call FFLEX any more */ + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Now at end of input.\n"); +#endif + } + else + { + ffchar1 = FFTRANSLATE(ffchar); + +#if FFDEBUG != 0 + if (ffdebug) + { + fprintf (stderr, "Next token is %d (%s", ffchar, fftname[ffchar1]); + /* Give the individual parser a way to print the precise meaning + of a token, for further debugging info. */ +#ifdef FFPRINT + FFPRINT (stderr, ffchar, fflval); +#endif + fprintf (stderr, ")\n"); + } +#endif + } + + ffn += ffchar1; + if (ffn < 0 || ffn > FFLAST || ffcheck[ffn] != ffchar1) + goto ffdefault; + + ffn = fftable[ffn]; + + /* ffn is what to do for this token type in this state. + Negative => reduce, -ffn is rule number. + Positive => shift, ffn is new state. + New state is final state => don't bother to shift, + just return success. + 0, or most negative number => error. */ + + if (ffn < 0) + { + if (ffn == FFFLAG) + goto fferrlab; + ffn = -ffn; + goto ffreduce; + } + else if (ffn == 0) + goto fferrlab; + + if (ffn == FFFINAL) + FFACCEPT; + + /* Shift the lookahead token. */ + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Shifting token %d (%s), ", ffchar, fftname[ffchar1]); +#endif + + /* Discard the token being shifted unless it is eof. */ + if (ffchar != FFEOF) + ffchar = FFEMPTY; + + *++ffvsp = fflval; +#ifdef FFLSP_NEEDED + *++fflsp = fflloc; +#endif + + /* count tokens shifted since error; after three, turn off error status. */ + if (fferrstatus) fferrstatus--; + + ffstate = ffn; + goto ffnewstate; + +/* Do the default action for the current state. */ +ffdefault: + + ffn = ffdefact[ffstate]; + if (ffn == 0) + goto fferrlab; + +/* Do a reduction. ffn is the number of a rule to reduce with. */ +ffreduce: + fflen = ffr2[ffn]; + if (fflen > 0) + ffval = ffvsp[1-fflen]; /* implement default value of the action */ + +#if FFDEBUG != 0 + if (ffdebug) + { + int i; + + fprintf (stderr, "Reducing via rule %d (line %d), ", + ffn, ffrline[ffn]); + + /* Print the symbols being reduced, and their result. */ + for (i = ffprhs[ffn]; ffrhs[i] > 0; i++) + fprintf (stderr, "%s ", fftname[ffrhs[i]]); + fprintf (stderr, " -> %s\n", fftname[ffr1[ffn]]); + } +#endif + + + switch (ffn) { + +case 3: +#line 230 "eval.y" +{; + break;} +case 4: +#line 232 "eval.y" +{ if( ffvsp[-1].Node<0 ) { + fferror("Couldn't build node structure: out of memory?"); + FFERROR; } + gParse.resultNode = ffvsp[-1].Node; + ; + break;} +case 5: +#line 238 "eval.y" +{ if( ffvsp[-1].Node<0 ) { + fferror("Couldn't build node structure: out of memory?"); + FFERROR; } + gParse.resultNode = ffvsp[-1].Node; + ; + break;} +case 6: +#line 244 "eval.y" +{ if( ffvsp[-1].Node<0 ) { + fferror("Couldn't build node structure: out of memory?"); + FFERROR; } + gParse.resultNode = ffvsp[-1].Node; + ; + break;} +case 7: +#line 250 "eval.y" +{ if( ffvsp[-1].Node<0 ) { + fferror("Couldn't build node structure: out of memory?"); + FFERROR; } + gParse.resultNode = ffvsp[-1].Node; + ; + break;} +case 8: +#line 255 "eval.y" +{ fferrok; ; + break;} +case 9: +#line 259 "eval.y" +{ ffval.Node = New_Vector( ffvsp[0].Node ); TEST(ffval.Node); ; + break;} +case 10: +#line 261 "eval.y" +{ + if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) { + ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node); + ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node); + } else { + ffval.Node = ffvsp[-2].Node; + } + gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ] + = ffvsp[0].Node; + ; + break;} +case 11: +#line 274 "eval.y" +{ ffval.Node = New_Vector( ffvsp[0].Node ); TEST(ffval.Node); ; + break;} +case 12: +#line 276 "eval.y" +{ + if( TYPE(ffvsp[-2].Node) < TYPE(ffvsp[0].Node) ) + TYPE(ffvsp[-2].Node) = TYPE(ffvsp[0].Node); + if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) { + ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node); + ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node); + } else { + ffval.Node = ffvsp[-2].Node; + } + gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ] + = ffvsp[0].Node; + ; + break;} +case 13: +#line 289 "eval.y" +{ + if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) { + ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node); + ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node); + } else { + ffval.Node = ffvsp[-2].Node; + } + gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ] + = ffvsp[0].Node; + ; + break;} +case 14: +#line 300 "eval.y" +{ + TYPE(ffvsp[-2].Node) = TYPE(ffvsp[0].Node); + if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) { + ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node); + ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node); + } else { + ffval.Node = ffvsp[-2].Node; + } + gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ] + = ffvsp[0].Node; + ; + break;} +case 15: +#line 314 "eval.y" +{ ffval.Node = Close_Vec( ffvsp[-1].Node ); TEST(ffval.Node); ; + break;} +case 16: +#line 318 "eval.y" +{ ffval.Node = Close_Vec( ffvsp[-1].Node ); TEST(ffval.Node); ; + break;} +case 17: +#line 322 "eval.y" +{ + ffval.Node = New_Const( BITSTR, ffvsp[0].str, strlen(ffvsp[0].str)+1 ); TEST(ffval.Node); + SIZE(ffval.Node) = strlen(ffvsp[0].str); + ; + break;} +case 18: +#line 327 "eval.y" +{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ; + break;} +case 19: +#line 329 "eval.y" +{ + if( TYPE(ffvsp[-1].Node) != LONG + || gParse.Nodes[ffvsp[-1].Node].operation != CONST_OP ) { + fferror("Offset argument must be a constant integer"); + FFERROR; + } + ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node); + ; + break;} +case 20: +#line 338 "eval.y" +{ ffval.Node = New_BinOp( BITSTR, ffvsp[-2].Node, '&', ffvsp[0].Node ); TEST(ffval.Node); + SIZE(ffval.Node) = ( SIZE(ffvsp[-2].Node)>SIZE(ffvsp[0].Node) ? SIZE(ffvsp[-2].Node) : SIZE(ffvsp[0].Node) ); ; + break;} +case 21: +#line 341 "eval.y" +{ ffval.Node = New_BinOp( BITSTR, ffvsp[-2].Node, '|', ffvsp[0].Node ); TEST(ffval.Node); + SIZE(ffval.Node) = ( SIZE(ffvsp[-2].Node)>SIZE(ffvsp[0].Node) ? SIZE(ffvsp[-2].Node) : SIZE(ffvsp[0].Node) ); ; + break;} +case 22: +#line 344 "eval.y" +{ ffval.Node = New_BinOp( BITSTR, ffvsp[-2].Node, '+', ffvsp[0].Node ); TEST(ffval.Node); + SIZE(ffval.Node) = SIZE(ffvsp[-2].Node) + SIZE(ffvsp[0].Node); ; + break;} +case 23: +#line 347 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-3].Node, 1, ffvsp[-1].Node, 0, 0, 0, 0 ); TEST(ffval.Node); ; + break;} +case 24: +#line 349 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-5].Node, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0 ); TEST(ffval.Node); ; + break;} +case 25: +#line 351 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-7].Node, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0 ); TEST(ffval.Node); ; + break;} +case 26: +#line 353 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-9].Node, 4, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0 ); TEST(ffval.Node); ; + break;} +case 27: +#line 355 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-11].Node, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); TEST(ffval.Node); ; + break;} +case 28: +#line 357 "eval.y" +{ ffval.Node = New_Unary( BITSTR, NOT, ffvsp[0].Node ); TEST(ffval.Node); ; + break;} +case 29: +#line 360 "eval.y" +{ ffval.Node = ffvsp[-1].Node; ; + break;} +case 30: +#line 364 "eval.y" +{ ffval.Node = New_Const( LONG, &(ffvsp[0].lng), sizeof(long) ); TEST(ffval.Node); ; + break;} +case 31: +#line 366 "eval.y" +{ ffval.Node = New_Const( DOUBLE, &(ffvsp[0].dbl), sizeof(double) ); TEST(ffval.Node); ; + break;} +case 32: +#line 368 "eval.y" +{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ; + break;} +case 33: +#line 370 "eval.y" +{ + if( TYPE(ffvsp[-1].Node) != LONG + || gParse.Nodes[ffvsp[-1].Node].operation != CONST_OP ) { + fferror("Offset argument must be a constant integer"); + FFERROR; + } + ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node); + ; + break;} +case 34: +#line 379 "eval.y" +{ ffval.Node = New_Func( LONG, row_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); ; + break;} +case 35: +#line 381 "eval.y" +{ ffval.Node = New_Func( LONG, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); ; + break;} +case 36: +#line 383 "eval.y" +{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '%', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 37: +#line 386 "eval.y" +{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '+', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 38: +#line 389 "eval.y" +{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '-', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 39: +#line 392 "eval.y" +{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '*', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 40: +#line 395 "eval.y" +{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '/', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 41: +#line 398 "eval.y" +{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, POWER, ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 42: +#line 401 "eval.y" +{ ffval.Node = ffvsp[0].Node; ; + break;} +case 43: +#line 403 "eval.y" +{ ffval.Node = New_Unary( TYPE(ffvsp[0].Node), UMINUS, ffvsp[0].Node ); TEST(ffval.Node); ; + break;} +case 44: +#line 405 "eval.y" +{ ffval.Node = ffvsp[-1].Node; ; + break;} +case 45: +#line 407 "eval.y" +{ ffvsp[0].Node = New_Unary( TYPE(ffvsp[-2].Node), 0, ffvsp[0].Node ); + ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '*', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 46: +#line 411 "eval.y" +{ ffvsp[-2].Node = New_Unary( TYPE(ffvsp[0].Node), 0, ffvsp[-2].Node ); + ffval.Node = New_BinOp( TYPE(ffvsp[0].Node), ffvsp[-2].Node, '*', ffvsp[0].Node ); + TEST(ffval.Node); ; + break;} +case 47: +#line 415 "eval.y" +{ + PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); + if( ! Test_Dims(ffvsp[-2].Node,ffvsp[0].Node) ) { + fferror("Incompatible dimensions in '?:' arguments"); + FFERROR; + } + ffval.Node = New_Func( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node, + 0, 0, 0, 0 ); + TEST(ffval.Node); + if( SIZE(ffvsp[-2].Node)=SIZE(ffvsp[-1].Node) && Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) { + PROMOTE(ffvsp[-3].Node,ffvsp[-1].Node); + ffval.Node = New_Func( 0, defnull_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, + 0, 0, 0, 0 ); + TEST(ffval.Node); + } else { + fferror("Dimensions of DEFNULL arguments " + "are not compatible"); + FFERROR; + } + } else if (FSTRCMP(ffvsp[-4].str,"ARCTAN2(") == 0) { + if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node ); + if( TYPE(ffvsp[-1].Node) != DOUBLE ) ffvsp[-1].Node = New_Unary( DOUBLE, 0, ffvsp[-1].Node ); + if( Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) { + ffval.Node = New_Func( 0, atan2_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0, 0, 0 ); + TEST(ffval.Node); + if( SIZE(ffvsp[-3].Node)=SIZE(ffvsp[-1].Node) && Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) { + ffval.Node = New_Func( 0, defnull_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, + 0, 0, 0, 0 ); + TEST(ffval.Node); + } else { + fferror("Dimensions of DEFNULL arguments are not compatible"); + FFERROR; + } + } else { + fferror("Boolean Function(expr,expr) not supported"); + FFERROR; + } + ; + break;} +case 97: +#line 841 "eval.y" +{ + if( SIZE(ffvsp[-5].Node)>1 || SIZE(ffvsp[-3].Node)>1 || SIZE(ffvsp[-1].Node)>1 ) { + fferror("Cannot use array as function argument"); + FFERROR; + } + if( TYPE(ffvsp[-5].Node) != DOUBLE ) ffvsp[-5].Node = New_Unary( DOUBLE, 0, ffvsp[-5].Node ); + if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node ); + if( TYPE(ffvsp[-1].Node) != DOUBLE ) ffvsp[-1].Node = New_Unary( DOUBLE, 0, ffvsp[-1].Node ); + if (FSTRCMP(ffvsp[-6].str,"NEAR(") == 0) + ffval.Node = New_Func( BOOLEAN, near_fct, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, + 0, 0, 0, 0 ); + else { + fferror("Boolean Function not supported"); + FFERROR; + } + TEST(ffval.Node); + ; + break;} +case 98: +#line 859 "eval.y" +{ + if( SIZE(ffvsp[-9].Node)>1 || SIZE(ffvsp[-7].Node)>1 || SIZE(ffvsp[-5].Node)>1 || SIZE(ffvsp[-3].Node)>1 + || SIZE(ffvsp[-1].Node)>1 ) { + fferror("Cannot use array as function argument"); + FFERROR; + } + if( TYPE(ffvsp[-9].Node) != DOUBLE ) ffvsp[-9].Node = New_Unary( DOUBLE, 0, ffvsp[-9].Node ); + if( TYPE(ffvsp[-7].Node) != DOUBLE ) ffvsp[-7].Node = New_Unary( DOUBLE, 0, ffvsp[-7].Node ); + if( TYPE(ffvsp[-5].Node) != DOUBLE ) ffvsp[-5].Node = New_Unary( DOUBLE, 0, ffvsp[-5].Node ); + if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node ); + if( TYPE(ffvsp[-1].Node)!= DOUBLE ) ffvsp[-1].Node= New_Unary( DOUBLE, 0, ffvsp[-1].Node); + if (FSTRCMP(ffvsp[-10].str,"CIRCLE(") == 0) + ffval.Node = New_Func( BOOLEAN, circle_fct, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, + ffvsp[-1].Node, 0, 0 ); + else { + fferror("Boolean Function not supported"); + FFERROR; + } + TEST(ffval.Node); + ; + break;} +case 99: +#line 880 "eval.y" +{ + if( SIZE(ffvsp[-13].Node)>1 || SIZE(ffvsp[-11].Node)>1 || SIZE(ffvsp[-9].Node)>1 || SIZE(ffvsp[-7].Node)>1 + || SIZE(ffvsp[-5].Node)>1 || SIZE(ffvsp[-3].Node)>1 || SIZE(ffvsp[-1].Node)>1 ) { + fferror("Cannot use array as function argument"); + FFERROR; + } + if( TYPE(ffvsp[-13].Node) != DOUBLE ) ffvsp[-13].Node = New_Unary( DOUBLE, 0, ffvsp[-13].Node ); + if( TYPE(ffvsp[-11].Node) != DOUBLE ) ffvsp[-11].Node = New_Unary( DOUBLE, 0, ffvsp[-11].Node ); + if( TYPE(ffvsp[-9].Node) != DOUBLE ) ffvsp[-9].Node = New_Unary( DOUBLE, 0, ffvsp[-9].Node ); + if( TYPE(ffvsp[-7].Node) != DOUBLE ) ffvsp[-7].Node = New_Unary( DOUBLE, 0, ffvsp[-7].Node ); + if( TYPE(ffvsp[-5].Node)!= DOUBLE ) ffvsp[-5].Node= New_Unary( DOUBLE, 0, ffvsp[-5].Node); + if( TYPE(ffvsp[-3].Node)!= DOUBLE ) ffvsp[-3].Node= New_Unary( DOUBLE, 0, ffvsp[-3].Node); + if( TYPE(ffvsp[-1].Node)!= DOUBLE ) ffvsp[-1].Node= New_Unary( DOUBLE, 0, ffvsp[-1].Node); + if (FSTRCMP(ffvsp[-14].str,"BOX(") == 0) + ffval.Node = New_Func( BOOLEAN, box_fct, 7, ffvsp[-13].Node, ffvsp[-11].Node, ffvsp[-9].Node, ffvsp[-7].Node, + ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); + else if (FSTRCMP(ffvsp[-14].str,"ELLIPSE(") == 0) + ffval.Node = New_Func( BOOLEAN, elps_fct, 7, ffvsp[-13].Node, ffvsp[-11].Node, ffvsp[-9].Node, ffvsp[-7].Node, + ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); + else { + fferror("SAO Image Function not supported"); + FFERROR; + } + TEST(ffval.Node); + ; + break;} +case 100: +#line 907 "eval.y" +{ /* Use defaults for all elements */ + ffval.Node = New_GTI( "", -99, "*START*", "*STOP*" ); + TEST(ffval.Node); ; + break;} +case 101: +#line 911 "eval.y" +{ /* Use defaults for all except filename */ + ffval.Node = New_GTI( ffvsp[-1].str, -99, "*START*", "*STOP*" ); + TEST(ffval.Node); ; + break;} +case 102: +#line 915 "eval.y" +{ ffval.Node = New_GTI( ffvsp[-3].str, ffvsp[-1].Node, "*START*", "*STOP*" ); + TEST(ffval.Node); ; + break;} +case 103: +#line 918 "eval.y" +{ ffval.Node = New_GTI( ffvsp[-7].str, ffvsp[-5].Node, ffvsp[-3].str, ffvsp[-1].str ); + TEST(ffval.Node); ; + break;} +case 104: +#line 922 "eval.y" +{ /* Use defaults for all except filename */ + ffval.Node = New_REG( ffvsp[-1].str, -99, -99, "" ); + TEST(ffval.Node); ; + break;} +case 105: +#line 926 "eval.y" +{ ffval.Node = New_REG( ffvsp[-5].str, ffvsp[-3].Node, ffvsp[-1].Node, "" ); + TEST(ffval.Node); ; + break;} +case 106: +#line 929 "eval.y" +{ ffval.Node = New_REG( ffvsp[-7].str, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].str ); + TEST(ffval.Node); ; + break;} +case 107: +#line 933 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-3].Node, 1, ffvsp[-1].Node, 0, 0, 0, 0 ); TEST(ffval.Node); ; + break;} +case 108: +#line 935 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-5].Node, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0 ); TEST(ffval.Node); ; + break;} +case 109: +#line 937 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-7].Node, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0 ); TEST(ffval.Node); ; + break;} +case 110: +#line 939 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-9].Node, 4, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0 ); TEST(ffval.Node); ; + break;} +case 111: +#line 941 "eval.y" +{ ffval.Node = New_Deref( ffvsp[-11].Node, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); TEST(ffval.Node); ; + break;} +case 112: +#line 943 "eval.y" +{ ffval.Node = New_Unary( BOOLEAN, NOT, ffvsp[0].Node ); TEST(ffval.Node); ; + break;} +case 113: +#line 945 "eval.y" +{ ffval.Node = ffvsp[-1].Node; ; + break;} +case 114: +#line 949 "eval.y" +{ ffval.Node = New_Const( STRING, ffvsp[0].str, strlen(ffvsp[0].str)+1 ); TEST(ffval.Node); + SIZE(ffval.Node) = strlen(ffvsp[0].str); ; + break;} +case 115: +#line 952 "eval.y" +{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ; + break;} +case 116: +#line 954 "eval.y" +{ + if( TYPE(ffvsp[-1].Node) != LONG + || gParse.Nodes[ffvsp[-1].Node].operation != CONST_OP ) { + fferror("Offset argument must be a constant integer"); + FFERROR; + } + ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node); + ; + break;} +case 117: +#line 963 "eval.y" +{ ffval.Node = New_Func( STRING, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); ; + break;} +case 118: +#line 965 "eval.y" +{ ffval.Node = ffvsp[-1].Node; ; + break;} +case 119: +#line 967 "eval.y" +{ ffval.Node = New_BinOp( STRING, ffvsp[-2].Node, '+', ffvsp[0].Node ); TEST(ffval.Node); + SIZE(ffval.Node) = SIZE(ffvsp[-2].Node) + SIZE(ffvsp[0].Node); ; + break;} +case 120: +#line 970 "eval.y" +{ + if( SIZE(ffvsp[-4].Node)!=1 ) { + fferror("Cannot have a vector string column"); + FFERROR; + } + ffval.Node = New_Func( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node, + 0, 0, 0, 0 ); + TEST(ffval.Node); + if( SIZE(ffvsp[-2].Node)SIZE(ffvsp[-3].Node) ) SIZE(ffval.Node) = SIZE(ffvsp[-1].Node); + } + ; + break;} +} + /* the action file gets copied in in place of this dollarsign */ +#line 498 "/usr1/local/share/bison.simple" + + ffvsp -= fflen; + ffssp -= fflen; +#ifdef FFLSP_NEEDED + fflsp -= fflen; +#endif + +#if FFDEBUG != 0 + if (ffdebug) + { + short *ssp1 = ffss - 1; + fprintf (stderr, "state stack now"); + while (ssp1 != ffssp) + fprintf (stderr, " %d", *++ssp1); + fprintf (stderr, "\n"); + } +#endif + + *++ffvsp = ffval; + +#ifdef FFLSP_NEEDED + fflsp++; + if (fflen == 0) + { + fflsp->first_line = fflloc.first_line; + fflsp->first_column = fflloc.first_column; + fflsp->last_line = (fflsp-1)->last_line; + fflsp->last_column = (fflsp-1)->last_column; + fflsp->text = 0; + } + else + { + fflsp->last_line = (fflsp+fflen-1)->last_line; + fflsp->last_column = (fflsp+fflen-1)->last_column; + } +#endif + + /* Now "shift" the result of the reduction. + Determine what state that goes to, + based on the state we popped back to + and the rule number reduced by. */ + + ffn = ffr1[ffn]; + + ffstate = ffpgoto[ffn - FFNTBASE] + *ffssp; + if (ffstate >= 0 && ffstate <= FFLAST && ffcheck[ffstate] == *ffssp) + ffstate = fftable[ffstate]; + else + ffstate = ffdefgoto[ffn - FFNTBASE]; + + goto ffnewstate; + +fferrlab: /* here on detecting error */ + + if (! fferrstatus) + /* If not already recovering from an error, report this error. */ + { + ++ffnerrs; + +#ifdef FFERROR_VERBOSE + ffn = ffpact[ffstate]; + + if (ffn > FFFLAG && ffn < FFLAST) + { + int size = 0; + char *msg; + int x, count; + + count = 0; + /* Start X at -ffn if nec to avoid negative indexes in ffcheck. */ + for (x = (ffn < 0 ? -ffn : 0); + x < (sizeof(fftname) / sizeof(char *)); x++) + if (ffcheck[x + ffn] == x) + size += strlen(fftname[x]) + 15, count++; + msg = (char *) malloc(size + 15); + if (msg != 0) + { + strcpy(msg, "parse error"); + + if (count < 5) + { + count = 0; + for (x = (ffn < 0 ? -ffn : 0); + x < (sizeof(fftname) / sizeof(char *)); x++) + if (ffcheck[x + ffn] == x) + { + strcat(msg, count == 0 ? ", expecting `" : " or `"); + strcat(msg, fftname[x]); + strcat(msg, "'"); + count++; + } + } + fferror(msg); + free(msg); + } + else + fferror ("parse error; also virtual memory exceeded"); + } + else +#endif /* FFERROR_VERBOSE */ + fferror("parse error"); + } + + goto fferrlab1; +fferrlab1: /* here on error raised explicitly by an action */ + + if (fferrstatus == 3) + { + /* if just tried and failed to reuse lookahead token after an error, discard it. */ + + /* return failure if at end of input */ + if (ffchar == FFEOF) + FFABORT; + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Discarding token %d (%s).\n", ffchar, fftname[ffchar1]); +#endif + + ffchar = FFEMPTY; + } + + /* Else will try to reuse lookahead token + after shifting the error token. */ + + fferrstatus = 3; /* Each real token shifted decrements this */ + + goto fferrhandle; + +fferrdefault: /* current state does not do anything special for the error token. */ + +#if 0 + /* This is wrong; only states that explicitly want error tokens + should shift them. */ + ffn = ffdefact[ffstate]; /* If its default is to accept any token, ok. Otherwise pop it.*/ + if (ffn) goto ffdefault; +#endif + +fferrpop: /* pop the current state because it cannot handle the error token */ + + if (ffssp == ffss) FFABORT; + ffvsp--; + ffstate = *--ffssp; +#ifdef FFLSP_NEEDED + fflsp--; +#endif + +#if FFDEBUG != 0 + if (ffdebug) + { + short *ssp1 = ffss - 1; + fprintf (stderr, "Error: state stack now"); + while (ssp1 != ffssp) + fprintf (stderr, " %d", *++ssp1); + fprintf (stderr, "\n"); + } +#endif + +fferrhandle: + + ffn = ffpact[ffstate]; + if (ffn == FFFLAG) + goto fferrdefault; + + ffn += FFTERROR; + if (ffn < 0 || ffn > FFLAST || ffcheck[ffn] != FFTERROR) + goto fferrdefault; + + ffn = fftable[ffn]; + if (ffn < 0) + { + if (ffn == FFFLAG) + goto fferrpop; + ffn = -ffn; + goto ffreduce; + } + else if (ffn == 0) + goto fferrpop; + + if (ffn == FFFINAL) + FFACCEPT; + +#if FFDEBUG != 0 + if (ffdebug) + fprintf(stderr, "Shifting error token, "); +#endif + + *++ffvsp = fflval; +#ifdef FFLSP_NEEDED + *++fflsp = fflloc; +#endif + + ffstate = ffn; + goto ffnewstate; +} +#line 992 "eval.y" + + +/*************************************************************************/ +/* Start of "New" routines which build the expression Nodal structure */ +/*************************************************************************/ + +static int Alloc_Node( void ) +{ + /* Use this for allocation to guarantee *Nodes */ + Node *newNodePtr; /* survives on failure, making it still valid */ + /* while working our way out of this error */ + + if( gParse.nNodes == gParse.nNodesAlloc ) { + if( gParse.Nodes ) { + gParse.nNodesAlloc += gParse.nNodesAlloc; + newNodePtr = (Node *)realloc( gParse.Nodes, + sizeof(Node)*gParse.nNodesAlloc ); + } else { + gParse.nNodesAlloc = 100; + newNodePtr = (Node *)malloc ( sizeof(Node)*gParse.nNodesAlloc ); + } + + if( newNodePtr ) { + gParse.Nodes = newNodePtr; + } else { + gParse.status = MEMORY_ALLOCATION; + return( -1 ); + } + } + + return ( gParse.nNodes++ ); +} + +static void Free_Last_Node( void ) +{ + if( gParse.nNodes ) gParse.nNodes--; +} + +static int New_Const( int returnType, void *value, long len ) +{ + Node *this; + int n; + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = CONST_OP; /* Flag a constant */ + this->DoOp = NULL; + this->nSubNodes = 0; + this->type = returnType; + memcpy( &(this->value.data), value, len ); + this->value.undef = NULL; + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } + return(n); +} + +static int New_Column( int ColNum ) +{ + Node *this; + int n, i; + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = -ColNum; + this->DoOp = NULL; + this->nSubNodes = 0; + this->type = gParse.varData[ColNum].type; + this->value.nelem = gParse.varData[ColNum].nelem; + this->value.naxis = gParse.varData[ColNum].naxis; + for( i=0; ivalue.naxes[i] = gParse.varData[ColNum].naxes[i]; + } + return(n); +} + +static int New_Offset( int ColNum, int offsetNode ) +{ + Node *this; + int n, i, colNode; + + colNode = New_Column( ColNum ); + if( colNode<0 ) return(-1); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = '{'; + this->DoOp = Do_Offset; + this->nSubNodes = 2; + this->SubNodes[0] = colNode; + this->SubNodes[1] = offsetNode; + this->type = gParse.varData[ColNum].type; + this->value.nelem = gParse.varData[ColNum].nelem; + this->value.naxis = gParse.varData[ColNum].naxis; + for( i=0; ivalue.naxes[i] = gParse.varData[ColNum].naxes[i]; + } + return(n); +} + +static int New_Unary( int returnType, int Op, int Node1 ) +{ + Node *this, *that; + int i,n; + + if( Node1<0 ) return(-1); + that = gParse.Nodes + Node1; + + if( !Op ) Op = returnType; + + if( (Op==DOUBLE || Op==FLTCAST) && that->type==DOUBLE ) return( Node1 ); + if( (Op==LONG || Op==INTCAST) && that->type==LONG ) return( Node1 ); + if( (Op==BOOLEAN ) && that->type==BOOLEAN ) return( Node1 ); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = Op; + this->DoOp = Do_Unary; + this->nSubNodes = 1; + this->SubNodes[0] = Node1; + this->type = returnType; + + that = gParse.Nodes + Node1; /* Reset in case .Nodes mv'd */ + this->value.nelem = that->value.nelem; + this->value.naxis = that->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that->value.naxes[i]; + + if( that->operation==CONST_OP ) this->DoOp( this ); + } + return( n ); +} + +static int New_BinOp( int returnType, int Node1, int Op, int Node2 ) +{ + Node *this,*that1,*that2; + int n,i,constant; + + if( Node1<0 || Node2<0 ) return(-1); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = Op; + this->nSubNodes = 2; + this->SubNodes[0]= Node1; + this->SubNodes[1]= Node2; + this->type = returnType; + + that1 = gParse.Nodes + Node1; + that2 = gParse.Nodes + Node2; + constant = (that1->operation==CONST_OP + && that2->operation==CONST_OP); + if( that1->type!=STRING && that1->type!=BITSTR ) + if( !Test_Dims( Node1, Node2 ) ) { + Free_Last_Node(); + fferror("Array sizes/dims do not match for binary operator"); + return(-1); + } + if( that1->value.nelem == 1 ) that1 = that2; + + this->value.nelem = that1->value.nelem; + this->value.naxis = that1->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that1->value.naxes[i]; + + if ( Op == ACCUM && that1->type == BITSTR ) { + /* ACCUM is rank-reducing on bit strings */ + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } + + /* Both subnodes should be of same time */ + switch( that1->type ) { + case BITSTR: this->DoOp = Do_BinOp_bit; break; + case STRING: this->DoOp = Do_BinOp_str; break; + case BOOLEAN: this->DoOp = Do_BinOp_log; break; + case LONG: this->DoOp = Do_BinOp_lng; break; + case DOUBLE: this->DoOp = Do_BinOp_dbl; break; + } + if( constant ) this->DoOp( this ); + } + return( n ); +} + +static int New_Func( int returnType, funcOp Op, int nNodes, + int Node1, int Node2, int Node3, int Node4, + int Node5, int Node6, int Node7 ) +/* If returnType==0 , use Node1's type and vector sizes as returnType, */ +/* else return a single value of type returnType */ +{ + Node *this, *that; + int i,n,constant; + + if( Node1<0 || Node2<0 || Node3<0 || Node4<0 || + Node5<0 || Node6<0 || Node7<0 ) return(-1); + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->operation = (int)Op; + this->DoOp = Do_Func; + this->nSubNodes = nNodes; + this->SubNodes[0] = Node1; + this->SubNodes[1] = Node2; + this->SubNodes[2] = Node3; + this->SubNodes[3] = Node4; + this->SubNodes[4] = Node5; + this->SubNodes[5] = Node6; + this->SubNodes[6] = Node7; + i = constant = nNodes; /* Functions with zero params are not const */ + while( i-- ) + constant = ( constant && + gParse.Nodes[ this->SubNodes[i] ].operation==CONST_OP ); + + if( returnType ) { + this->type = returnType; + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } else { + that = gParse.Nodes + Node1; + this->type = that->type; + this->value.nelem = that->value.nelem; + this->value.naxis = that->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that->value.naxes[i]; + } + if( constant ) this->DoOp( this ); + } + return( n ); +} + +static int New_Deref( int Var, int nDim, + int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 ) +{ + int n, idx, constant; + long elem=0; + Node *this, *theVar, *theDim[MAXDIMS]; + + if( Var<0 || Dim1<0 || Dim2<0 || Dim3<0 || Dim4<0 || Dim5<0 ) return(-1); + + theVar = gParse.Nodes + Var; + if( theVar->operation==CONST_OP || theVar->value.nelem==1 ) { + fferror("Cannot index a scalar value"); + return(-1); + } + + n = Alloc_Node(); + if( n>=0 ) { + this = gParse.Nodes + n; + this->nSubNodes = nDim+1; + theVar = gParse.Nodes + (this->SubNodes[0]=Var); + theDim[0] = gParse.Nodes + (this->SubNodes[1]=Dim1); + theDim[1] = gParse.Nodes + (this->SubNodes[2]=Dim2); + theDim[2] = gParse.Nodes + (this->SubNodes[3]=Dim3); + theDim[3] = gParse.Nodes + (this->SubNodes[4]=Dim4); + theDim[4] = gParse.Nodes + (this->SubNodes[5]=Dim5); + constant = theVar->operation==CONST_OP; + for( idx=0; idxoperation==CONST_OP); + + for( idx=0; idxvalue.nelem>1 ) { + Free_Last_Node(); + fferror("Cannot use an array as an index value"); + return(-1); + } else if( theDim[idx]->type!=LONG ) { + Free_Last_Node(); + fferror("Index value must be an integer type"); + return(-1); + } + + this->operation = '['; + this->DoOp = Do_Deref; + this->type = theVar->type; + + if( theVar->value.naxis == nDim ) { /* All dimensions specified */ + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + } else if( nDim==1 ) { /* Dereference only one dimension */ + elem=1; + this->value.naxis = theVar->value.naxis-1; + for( idx=0; idxvalue.naxis; idx++ ) { + elem *= ( this->value.naxes[idx] = theVar->value.naxes[idx] ); + } + this->value.nelem = elem; + } else { + Free_Last_Node(); + fferror("Must specify just one or all indices for vector"); + return(-1); + } + if( constant ) this->DoOp( this ); + } + return(n); +} + +extern int ffGetVariable( char *varName, FFSTYPE *varVal ); + +static int New_GTI( char *fname, int Node1, char *start, char *stop ) +{ + fitsfile *fptr; + Node *this, *that0, *that1; + int type,i,n, startCol, stopCol, Node0; + int hdutype, hdunum, evthdu, samefile, extvers, movetotype, tstat; + char extname[100]; + long nrows; + double timeZeroI[2], timeZeroF[2], dt, timeSpan; + char xcol[20], xexpr[20]; + FFSTYPE colVal; + + if( Node1==-99 ) { + type = ffGetVariable( "TIME", &colVal ); + if( type==COLUMN ) { + Node1 = New_Column( (int)colVal.lng ); + } else { + fferror("Could not build TIME column for GTIFILTER"); + return(-1); + } + } + Node1 = New_Unary( DOUBLE, 0, Node1 ); + Node0 = Alloc_Node(); /* This will hold the START/STOP times */ + if( Node1<0 || Node0<0 ) return(-1); + + /* Record current HDU number in case we need to move within this file */ + + fptr = gParse.def_fptr; + ffghdn( fptr, &evthdu ); + + /* Look for TIMEZERO keywords in current extension */ + + tstat = 0; + if( ffgkyd( fptr, "TIMEZERO", timeZeroI, NULL, &tstat ) ) { + tstat = 0; + if( ffgkyd( fptr, "TIMEZERI", timeZeroI, NULL, &tstat ) ) { + timeZeroI[0] = timeZeroF[0] = 0.0; + } else if( ffgkyd( fptr, "TIMEZERF", timeZeroF, NULL, &tstat ) ) { + timeZeroF[0] = 0.0; + } + } else { + timeZeroF[0] = 0.0; + } + + /* Resolve filename parameter */ + + switch( fname[0] ) { + case '\0': + samefile = 1; + hdunum = 1; + break; + case '[': + samefile = 1; + i = 1; + while( fname[i] != '\0' && fname[i] != ']' ) i++; + if( fname[i] ) { + fname[i] = '\0'; + fname++; + ffexts( fname, &hdunum, extname, &extvers, &movetotype, + xcol, xexpr, &gParse.status ); + if( *extname ) { + ffmnhd( fptr, movetotype, extname, extvers, &gParse.status ); + ffghdn( fptr, &hdunum ); + } else if( hdunum ) { + ffmahd( fptr, ++hdunum, &hdutype, &gParse.status ); + } else if( !gParse.status ) { + fferror("Cannot use primary array for GTI filter"); + return( -1 ); + } + } else { + fferror("File extension specifier lacks closing ']'"); + return( -1 ); + } + break; + case '+': + samefile = 1; + hdunum = atoi( fname ) + 1; + if( hdunum>1 ) + ffmahd( fptr, hdunum, &hdutype, &gParse.status ); + else { + fferror("Cannot use primary array for GTI filter"); + return( -1 ); + } + break; + default: + samefile = 0; + if( ! ffopen( &fptr, fname, READONLY, &gParse.status ) ) + ffghdn( fptr, &hdunum ); + break; + } + if( gParse.status ) return(-1); + + /* If at primary, search for GTI extension */ + + if( hdunum==1 ) { + while( 1 ) { + hdunum++; + if( ffmahd( fptr, hdunum, &hdutype, &gParse.status ) ) break; + if( hdutype==IMAGE_HDU ) continue; + tstat = 0; + if( ffgkys( fptr, "EXTNAME", extname, NULL, &tstat ) ) continue; + ffupch( extname ); + if( strstr( extname, "GTI" ) ) break; + } + if( gParse.status ) { + if( gParse.status==END_OF_FILE ) + fferror("GTI extension not found in this file"); + return(-1); + } + } + + /* Locate START/STOP Columns */ + + ffgcno( fptr, CASEINSEN, start, &startCol, &gParse.status ); + ffgcno( fptr, CASEINSEN, stop, &stopCol, &gParse.status ); + if( gParse.status ) return(-1); + + /* Look for TIMEZERO keywords in GTI extension */ + + tstat = 0; + if( ffgkyd( fptr, "TIMEZERO", timeZeroI+1, NULL, &tstat ) ) { + tstat = 0; + if( ffgkyd( fptr, "TIMEZERI", timeZeroI+1, NULL, &tstat ) ) { + timeZeroI[1] = timeZeroF[1] = 0.0; + } else if( ffgkyd( fptr, "TIMEZERF", timeZeroF+1, NULL, &tstat ) ) { + timeZeroF[1] = 0.0; + } + } else { + timeZeroF[1] = 0.0; + } + + n = Alloc_Node(); + if( n >= 0 ) { + this = gParse.Nodes + n; + this->nSubNodes = 2; + this->SubNodes[1] = Node1; + this->operation = (int)gtifilt_fct; + this->DoOp = Do_GTI; + this->type = BOOLEAN; + that1 = gParse.Nodes + Node1; + this->value.nelem = that1->value.nelem; + this->value.naxis = that1->value.naxis; + for( i=0; i < that1->value.naxis; i++ ) + this->value.naxes[i] = that1->value.naxes[i]; + + /* Init START/STOP node to be treated as a "constant" */ + + this->SubNodes[0] = Node0; + that0 = gParse.Nodes + Node0; + that0->operation = CONST_OP; + that0->DoOp = NULL; + that0->value.data.ptr= NULL; + + /* Read in START/STOP times */ + + if( ffgkyj( fptr, "NAXIS2", &nrows, NULL, &gParse.status ) ) + return(-1); + that0->value.nelem = nrows; + if( nrows ) { + + that0->value.data.dblptr = (double*)malloc( 2*nrows*sizeof(double) ); + if( !that0->value.data.dblptr ) { + gParse.status = MEMORY_ALLOCATION; + return(-1); + } + + ffgcvd( fptr, startCol, 1L, 1L, nrows, 0.0, + that0->value.data.dblptr, &i, &gParse.status ); + ffgcvd( fptr, stopCol, 1L, 1L, nrows, 0.0, + that0->value.data.dblptr+nrows, &i, &gParse.status ); + if( gParse.status ) { + free( that0->value.data.dblptr ); + return(-1); + } + + /* Test for fully time-ordered GTI... both START && STOP */ + + that0->type = 1; /* Assume yes */ + i = nrows; + while( --i ) + if( that0->value.data.dblptr[i-1] + >= that0->value.data.dblptr[i] + || that0->value.data.dblptr[i-1+nrows] + >= that0->value.data.dblptr[i+nrows] ) { + that0->type = 0; + break; + } + + /* Handle TIMEZERO offset, if any */ + + dt = (timeZeroI[1] - timeZeroI[0]) + (timeZeroF[1] - timeZeroF[0]); + timeSpan = that0->value.data.dblptr[nrows+nrows-1] + - that0->value.data.dblptr[0]; + + if( fabs( dt / timeSpan ) > 1e-12 ) { + for( i=0; i<(nrows+nrows); i++ ) + that0->value.data.dblptr[i] += dt; + } + } + if( gParse.Nodes[Node1].operation==CONST_OP ) + this->DoOp( this ); + } + + if( samefile ) + ffmahd( fptr, evthdu, &hdutype, &gParse.status ); + else + ffclos( fptr, &gParse.status ); + + return( n ); +} + +static int New_REG( char *fname, int NodeX, int NodeY, char *colNames ) +{ + Node *this, *that0; + int type, n, Node0; + int Xcol, Ycol, tstat; + WCSdata wcs; + SAORegion *Rgn; + char *cX, *cY; + FFSTYPE colVal; + + if( NodeX==-99 ) { + type = ffGetVariable( "X", &colVal ); + if( type==COLUMN ) { + NodeX = New_Column( (int)colVal.lng ); + } else { + fferror("Could not build X column for REGFILTER"); + return(-1); + } + } + if( NodeY==-99 ) { + type = ffGetVariable( "Y", &colVal ); + if( type==COLUMN ) { + NodeY = New_Column( (int)colVal.lng ); + } else { + fferror("Could not build Y column for REGFILTER"); + return(-1); + } + } + NodeX = New_Unary( DOUBLE, 0, NodeX ); + NodeY = New_Unary( DOUBLE, 0, NodeY ); + Node0 = Alloc_Node(); /* This will hold the Region Data */ + if( NodeX<0 || NodeY<0 || Node0<0 ) return(-1); + + n = Alloc_Node(); + if( n >= 0 ) { + this = gParse.Nodes + n; + this->nSubNodes = 3; + this->SubNodes[0] = Node0; + this->SubNodes[1] = NodeX; + this->SubNodes[2] = NodeY; + this->operation = (int)regfilt_fct; + this->DoOp = Do_REG; + this->type = BOOLEAN; + this->value.nelem = 1; + this->value.naxis = 1; + this->value.naxes[0] = 1; + + /* Init Region node to be treated as a "constant" */ + + that0 = gParse.Nodes + Node0; + that0->operation = CONST_OP; + that0->DoOp = NULL; + + /* Identify what columns to use for WCS information */ + + Xcol = Ycol = 0; + if( *colNames ) { + /* Use the column names in this string for WCS info */ + while( *colNames==' ' ) colNames++; + cX = cY = colNames; + while( *cY && *cY!=' ' && *cY!=',' ) cY++; + if( *cY ) + *(cY++) = '\0'; + while( *cY==' ' ) cY++; + if( !*cY ) { + fferror("Could not extract valid pair of column names from REGFILTER"); + Free_Last_Node(); + return( -1 ); + } + fits_get_colnum( gParse.def_fptr, CASEINSEN, cX, &Xcol, + &gParse.status ); + fits_get_colnum( gParse.def_fptr, CASEINSEN, cY, &Ycol, + &gParse.status ); + if( gParse.status ) { + fferror("Could not locate columns indicated for WCS info"); + Free_Last_Node(); + return( -1 ); + } + + } else { + /* Try to find columns used in X/Y expressions */ + Xcol = Locate_Col( gParse.Nodes + NodeX ); + Ycol = Locate_Col( gParse.Nodes + NodeY ); + if( Xcol<0 || Ycol<0 ) { + fferror("Found multiple X/Y column references in REGFILTER"); + Free_Last_Node(); + return( -1 ); + } + } + + /* Now, get the WCS info, if it exists, from the indicated columns */ + wcs.exists = 0; + if( Xcol>0 && Ycol>0 ) { + tstat = 0; + ffgtcs( gParse.def_fptr, Xcol, Ycol, + &wcs.xrefval, &wcs.yrefval, + &wcs.xrefpix, &wcs.yrefpix, + &wcs.xinc, &wcs.yinc, + &wcs.rot, wcs.type, + &tstat ); + if( tstat==NO_WCS_KEY ) { + wcs.exists = 0; + } else if( tstat ) { + gParse.status = tstat; + Free_Last_Node(); + return( -1 ); + } else { + wcs.exists = 1; + } + } + + /* Read in Region file */ + + fits_read_rgnfile( fname, &wcs, &Rgn, &gParse.status ); + if( gParse.status ) { + Free_Last_Node(); + return( -1 ); + } + + that0->value.data.ptr = Rgn; + + if( gParse.Nodes[NodeX].operation==CONST_OP + && gParse.Nodes[NodeY].operation==CONST_OP ) + this->DoOp( this ); + } + + return( n ); +} + +static int New_Vector( int subNode ) +{ + Node *this, *that; + int n; + + n = Alloc_Node(); + if( n >= 0 ) { + this = gParse.Nodes + n; + that = gParse.Nodes + subNode; + this->type = that->type; + this->nSubNodes = 1; + this->SubNodes[0] = subNode; + this->operation = '{'; + this->DoOp = Do_Vector; + } + + return( n ); +} + +static int Close_Vec( int vecNode ) +{ + Node *this; + int n, nelem=0; + + this = gParse.Nodes + vecNode; + for( n=0; n < this->nSubNodes; n++ ) { + if( TYPE( this->SubNodes[n] ) != this->type ) { + this->SubNodes[n] = New_Unary( this->type, 0, this->SubNodes[n] ); + if( this->SubNodes[n]<0 ) return(-1); + } + nelem += SIZE(this->SubNodes[n]); + } + this->value.naxis = 1; + this->value.nelem = nelem; + this->value.naxes[0] = nelem; + + return( vecNode ); +} + +static int Locate_Col( Node *this ) +/* Locate the TABLE column number of any columns in "this" calculation. */ +/* Return ZERO if none found, or negative if more than 1 found. */ +{ + Node *that; + int i, col=0, newCol, nfound=0; + + if( this->nSubNodes==0 + && this->operation<=0 && this->operation!=CONST_OP ) + return gParse.colData[ - this->operation].colnum; + + for( i=0; inSubNodes; i++ ) { + that = gParse.Nodes + this->SubNodes[i]; + if( that->operation>0 ) { + newCol = Locate_Col( that ); + if( newCol<=0 ) { + nfound += -newCol; + } else { + if( !nfound ) { + col = newCol; + nfound++; + } else if( col != newCol ) { + nfound++; + } + } + } else if( that->operation!=CONST_OP ) { + /* Found a Column */ + newCol = gParse.colData[- that->operation].colnum; + if( !nfound ) { + col = newCol; + nfound++; + } else if( col != newCol ) { + nfound++; + } + } + } + if( nfound!=1 ) + return( - nfound ); + else + return( col ); +} + +static int Test_Dims( int Node1, int Node2 ) +{ + Node *that1, *that2; + int valid, i; + + if( Node1<0 || Node2<0 ) return(0); + + that1 = gParse.Nodes + Node1; + that2 = gParse.Nodes + Node2; + + if( that1->value.nelem==1 || that2->value.nelem==1 ) + valid = 1; + else if( that1->type==that2->type + && that1->value.nelem==that2->value.nelem + && that1->value.naxis==that2->value.naxis ) { + valid = 1; + for( i=0; ivalue.naxis; i++ ) { + if( that1->value.naxes[i]!=that2->value.naxes[i] ) + valid = 0; + } + } else + valid = 0; + return( valid ); +} + +static void Copy_Dims( int Node1, int Node2 ) +{ + Node *that1, *that2; + int i; + + if( Node1<0 || Node2<0 ) return; + + that1 = gParse.Nodes + Node1; + that2 = gParse.Nodes + Node2; + + that1->value.nelem = that2->value.nelem; + that1->value.naxis = that2->value.naxis; + for( i=0; ivalue.naxis; i++ ) + that1->value.naxes[i] = that2->value.naxes[i]; +} + +/********************************************************************/ +/* Routines for actually evaluating the expression start here */ +/********************************************************************/ + +void Evaluate_Parser( long firstRow, long nRows ) + /***********************************************************************/ + /* Reset the parser for processing another batch of data... */ + /* firstRow: Row number of the first element to evaluate */ + /* nRows: Number of rows to be processed */ + /* Initialize each COLUMN node so that its UNDEF and DATA pointers */ + /* point to the appropriate column arrays. */ + /* Finally, call Evaluate_Node for final node. */ + /***********************************************************************/ +{ + int i, column; + long offset, rowOffset; + + gParse.firstRow = firstRow; + gParse.nRows = nRows; + + /* Reset Column Nodes' pointers to point to right data and UNDEF arrays */ + + rowOffset = firstRow - gParse.firstDataRow; + for( i=0; i 0 + || gParse.Nodes[i].operation == CONST_OP ) continue; + + column = -gParse.Nodes[i].operation; + offset = gParse.varData[column].nelem * rowOffset; + + gParse.Nodes[i].value.undef = gParse.varData[column].undef + offset; + + switch( gParse.Nodes[i].type ) { + case BITSTR: + gParse.Nodes[i].value.data.strptr = + (char**)gParse.varData[column].data + rowOffset; + gParse.Nodes[i].value.undef = NULL; + break; + case STRING: + gParse.Nodes[i].value.data.strptr = + (char**)gParse.varData[column].data + rowOffset; + gParse.Nodes[i].value.undef = gParse.varData[column].undef + rowOffset; + break; + case BOOLEAN: + gParse.Nodes[i].value.data.logptr = + (char*)gParse.varData[column].data + offset; + break; + case LONG: + gParse.Nodes[i].value.data.lngptr = + (long*)gParse.varData[column].data + offset; + break; + case DOUBLE: + gParse.Nodes[i].value.data.dblptr = + (double*)gParse.varData[column].data + offset; + break; + } + } + + Evaluate_Node( gParse.resultNode ); +} + +static void Evaluate_Node( int thisNode ) + /**********************************************************************/ + /* Recursively evaluate thisNode's subNodes, then call one of the */ + /* Do_ functions pointed to by thisNode's DoOp element. */ + /**********************************************************************/ +{ + Node *this; + int i; + + if( gParse.status ) return; + + this = gParse.Nodes + thisNode; + if( this->operation>0 ) { /* <=0 indicate constants and columns */ + i = this->nSubNodes; + while( i-- ) { + Evaluate_Node( this->SubNodes[i] ); + if( gParse.status ) return; + } + this->DoOp( this ); + } +} + +static void Allocate_Ptrs( Node *this ) +{ + long elem, row, size; + + if( this->type==BITSTR || this->type==STRING ) { + + this->value.data.strptr = (char**)malloc( gParse.nRows + * sizeof(char*) ); + if( this->value.data.strptr ) { + this->value.data.strptr[0] = (char*)malloc( gParse.nRows + * (this->value.nelem+2) + * sizeof(char) ); + if( this->value.data.strptr[0] ) { + row = 0; + while( (++row)value.data.strptr[row] = + this->value.data.strptr[row-1] + this->value.nelem+1; + } + if( this->type==STRING ) { + this->value.undef = this->value.data.strptr[row-1] + + this->value.nelem+1; + } else { + this->value.undef = NULL; /* BITSTRs don't use undef array */ + } + } else { + gParse.status = MEMORY_ALLOCATION; + free( this->value.data.strptr ); + } + } else { + gParse.status = MEMORY_ALLOCATION; + } + + } else { + + elem = this->value.nelem * gParse.nRows; + switch( this->type ) { + case DOUBLE: size = sizeof( double ); break; + case LONG: size = sizeof( long ); break; + case BOOLEAN: size = sizeof( char ); break; + default: size = 1; break; + } + + this->value.data.ptr = malloc( elem*(size+1) ); + + if( this->value.data.ptr==NULL ) { + gParse.status = MEMORY_ALLOCATION; + } else { + this->value.undef = (char *)this->value.data.ptr + elem*size; + } + } +} + +static void Do_Unary( Node *this ) +{ + Node *that; + long elem; + + that = gParse.Nodes + this->SubNodes[0]; + + if( that->operation==CONST_OP ) { /* Operating on a constant! */ + switch( this->operation ) { + case DOUBLE: + case FLTCAST: + if( that->type==LONG ) + this->value.data.dbl = (double)that->value.data.lng; + else if( that->type==BOOLEAN ) + this->value.data.dbl = ( that->value.data.log ? 1.0 : 0.0 ); + break; + case LONG: + case INTCAST: + if( that->type==DOUBLE ) + this->value.data.lng = (long)that->value.data.dbl; + else if( that->type==BOOLEAN ) + this->value.data.lng = ( that->value.data.log ? 1L : 0L ); + break; + case BOOLEAN: + if( that->type==DOUBLE ) + this->value.data.log = ( that->value.data.dbl != 0.0 ); + else if( that->type==LONG ) + this->value.data.log = ( that->value.data.lng != 0L ); + break; + case UMINUS: + if( that->type==DOUBLE ) + this->value.data.dbl = - that->value.data.dbl; + else if( that->type==LONG ) + this->value.data.lng = - that->value.data.lng; + break; + case NOT: + if( that->type==BOOLEAN ) + this->value.data.log = ( ! that->value.data.log ); + else if( that->type==BITSTR ) + bitnot( this->value.data.str, that->value.data.str ); + break; + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + if( this->type!=BITSTR ) { + elem = gParse.nRows; + if( this->type!=STRING ) + elem *= this->value.nelem; + while( elem-- ) + this->value.undef[elem] = that->value.undef[elem]; + } + + elem = gParse.nRows * this->value.nelem; + + switch( this->operation ) { + + case BOOLEAN: + if( that->type==DOUBLE ) + while( elem-- ) + this->value.data.logptr[elem] = + ( that->value.data.dblptr[elem] != 0.0 ); + else if( that->type==LONG ) + while( elem-- ) + this->value.data.logptr[elem] = + ( that->value.data.lngptr[elem] != 0L ); + break; + + case DOUBLE: + case FLTCAST: + if( that->type==LONG ) + while( elem-- ) + this->value.data.dblptr[elem] = + (double)that->value.data.lngptr[elem]; + else if( that->type==BOOLEAN ) + while( elem-- ) + this->value.data.dblptr[elem] = + ( that->value.data.logptr[elem] ? 1.0 : 0.0 ); + break; + + case LONG: + case INTCAST: + if( that->type==DOUBLE ) + while( elem-- ) + this->value.data.lngptr[elem] = + (long)that->value.data.dblptr[elem]; + else if( that->type==BOOLEAN ) + while( elem-- ) + this->value.data.lngptr[elem] = + ( that->value.data.logptr[elem] ? 1L : 0L ); + break; + + case UMINUS: + if( that->type==DOUBLE ) { + while( elem-- ) + this->value.data.dblptr[elem] = + - that->value.data.dblptr[elem]; + } else if( that->type==LONG ) { + while( elem-- ) + this->value.data.lngptr[elem] = + - that->value.data.lngptr[elem]; + } + break; + + case NOT: + if( that->type==BOOLEAN ) { + while( elem-- ) + this->value.data.logptr[elem] = + ( ! that->value.data.logptr[elem] ); + } else if( that->type==BITSTR ) { + elem = gParse.nRows; + while( elem-- ) + bitnot( this->value.data.strptr[elem], + that->value.data.strptr[elem] ); + } + break; + } + } + } + + if( that->operation>0 ) { + free( that->value.data.ptr ); + } +} + +static void Do_Offset( Node *this ) +{ + Node *col; + long fRow, nRowOverlap, nRowReload, rowOffset; + long nelem, elem, offset, nRealElem; + int status; + + col = gParse.Nodes + this->SubNodes[0]; + rowOffset = gParse.Nodes[ this->SubNodes[1] ].value.data.lng; + + Allocate_Ptrs( this ); + + fRow = gParse.firstRow + rowOffset; + if( this->type==STRING || this->type==BITSTR ) + nRealElem = 1; + else + nRealElem = this->value.nelem; + + nelem = nRealElem; + + if( fRow < gParse.firstDataRow ) { + + /* Must fill in data at start of array */ + + nRowReload = gParse.firstDataRow - fRow; + if( nRowReload > gParse.nRows ) nRowReload = gParse.nRows; + nRowOverlap = gParse.nRows - nRowReload; + + offset = 0; + + /* NULLify any values falling out of bounds */ + + while( fRow<1 && nRowReload>0 ) { + if( this->type == BITSTR ) { + nelem = this->value.nelem; + this->value.data.strptr[offset][ nelem ] = '\0'; + while( nelem-- ) this->value.data.strptr[offset][nelem] = '0'; + offset++; + } else { + while( nelem-- ) + this->value.undef[offset++] = 1; + } + nelem = nRealElem; + fRow++; + nRowReload--; + } + + } else if( fRow + gParse.nRows > gParse.firstDataRow + gParse.nDataRows ) { + + /* Must fill in data at end of array */ + + nRowReload = (fRow+gParse.nRows) - (gParse.firstDataRow+gParse.nDataRows); + if( nRowReload>gParse.nRows ) { + nRowReload = gParse.nRows; + } else { + fRow = gParse.firstDataRow + gParse.nDataRows; + } + nRowOverlap = gParse.nRows - nRowReload; + + offset = nRowOverlap * nelem; + + /* NULLify any values falling out of bounds */ + + elem = gParse.nRows * nelem; + while( fRow+nRowReload>gParse.totalRows && nRowReload>0 ) { + if( this->type == BITSTR ) { + nelem = this->value.nelem; + elem--; + this->value.data.strptr[elem][ nelem ] = '\0'; + while( nelem-- ) this->value.data.strptr[elem][nelem] = '0'; + } else { + while( nelem-- ) + this->value.undef[--elem] = 1; + } + nelem = nRealElem; + nRowReload--; + } + + } else { + + nRowReload = 0; + nRowOverlap = gParse.nRows; + offset = 0; + + } + + if( nRowReload>0 ) { + switch( this->type ) { + case BITSTR: + case STRING: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.strptr+offset, + this->value.undef+offset ); + break; + case BOOLEAN: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.logptr+offset, + this->value.undef+offset ); + break; + case LONG: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.lngptr+offset, + this->value.undef+offset ); + break; + case DOUBLE: + status = (*gParse.loadData)( -col->operation, fRow, nRowReload, + this->value.data.dblptr+offset, + this->value.undef+offset ); + break; + } + } + + /* Now copy over the overlapping region, if any */ + + if( nRowOverlap <= 0 ) return; + + if( rowOffset>0 ) + elem = nRowOverlap * nelem; + else + elem = gParse.nRows * nelem; + + offset = nelem * rowOffset; + while( nRowOverlap-- && !gParse.status ) { + while( nelem-- && !gParse.status ) { + elem--; + if( this->type != BITSTR ) + this->value.undef[elem] = col->value.undef[elem+offset]; + switch( this->type ) { + case BITSTR: + strcpy( this->value.data.strptr[elem ], + col->value.data.strptr[elem+offset] ); + break; + case STRING: + strcpy( this->value.data.strptr[elem ], + col->value.data.strptr[elem+offset] ); + break; + case BOOLEAN: + this->value.data.logptr[elem] = col->value.data.logptr[elem+offset]; + break; + case LONG: + this->value.data.lngptr[elem] = col->value.data.lngptr[elem+offset]; + break; + case DOUBLE: + this->value.data.dblptr[elem] = col->value.data.dblptr[elem+offset]; + break; + } + } + nelem = nRealElem; + } +} + +static void Do_BinOp_bit( Node *this ) +{ + Node *that1, *that2; + char *sptr1=NULL, *sptr2=NULL; + int const1, const2; + long rows; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + const1 = ( that1->operation==CONST_OP ); + const2 = ( that2->operation==CONST_OP ); + sptr1 = ( const1 ? that1->value.data.str : NULL ); + sptr2 = ( const2 ? that2->value.data.str : NULL ); + + if( const1 && const2 ) { + switch( this->operation ) { + case NE: + this->value.data.log = !bitcmp( sptr1, sptr2 ); + break; + case EQ: + this->value.data.log = bitcmp( sptr1, sptr2 ); + break; + case GT: + case LT: + case LTE: + case GTE: + this->value.data.log = bitlgte( sptr1, this->operation, sptr2 ); + break; + case '|': + bitor( this->value.data.str, sptr1, sptr2 ); + break; + case '&': + bitand( this->value.data.str, sptr1, sptr2 ); + break; + case '+': + strcpy( this->value.data.str, sptr1 ); + strcat( this->value.data.str, sptr2 ); + break; + case ACCUM: + this->value.data.lng = 0; + while( *sptr1 ) { + if ( *sptr1 == '1' ) this->value.data.lng ++; + sptr1 ++; + } + break; + + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + rows = gParse.nRows; + switch( this->operation ) { + + /* BITSTR comparisons */ + + case NE: + case EQ: + case GT: + case LT: + case LTE: + case GTE: + while( rows-- ) { + if( !const1 ) + sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) + sptr2 = that2->value.data.strptr[rows]; + switch( this->operation ) { + case NE: this->value.data.logptr[rows] = + !bitcmp( sptr1, sptr2 ); + break; + case EQ: this->value.data.logptr[rows] = + bitcmp( sptr1, sptr2 ); + break; + case GT: + case LT: + case LTE: + case GTE: this->value.data.logptr[rows] = + bitlgte( sptr1, this->operation, sptr2 ); + break; + } + this->value.undef[rows] = 0; + } + break; + + /* BITSTR AND/ORs ... no UNDEFS in or out */ + + case '|': + case '&': + case '+': + while( rows-- ) { + if( !const1 ) + sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) + sptr2 = that2->value.data.strptr[rows]; + if( this->operation=='|' ) + bitor( this->value.data.strptr[rows], sptr1, sptr2 ); + else if( this->operation=='&' ) + bitand( this->value.data.strptr[rows], sptr1, sptr2 ); + else { + strcpy( this->value.data.strptr[rows], sptr1 ); + strcat( this->value.data.strptr[rows], sptr2 ); + } + } + break; + + /* Accumulate 1 bits */ + case ACCUM: + { + long i, previous, curr; + + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.data.strptr[i]; + for (curr = 0; *sptr1; sptr1 ++) { + if ( *sptr1 == '1' ) curr ++; + } + previous += curr; + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + } + } + } + } + + if( that1->operation>0 ) { + free( that1->value.data.strptr[0] ); + free( that1->value.data.strptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.strptr[0] ); + free( that2->value.data.strptr ); + } +} + +static void Do_BinOp_str( Node *this ) +{ + Node *that1, *that2; + char *sptr1, *sptr2, null1=0, null2=0; + int const1, const2, val; + long rows; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + const1 = ( that1->operation==CONST_OP ); + const2 = ( that2->operation==CONST_OP ); + sptr1 = ( const1 ? that1->value.data.str : NULL ); + sptr2 = ( const2 ? that2->value.data.str : NULL ); + + if( const1 && const2 ) { /* Result is a constant */ + switch( this->operation ) { + + /* Compare Strings */ + + case NE: + case EQ: + val = ( FSTRCMP( sptr1, sptr2 ) == 0 ); + this->value.data.log = ( this->operation==EQ ? val : !val ); + break; + case GT: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) > 0 ); + break; + case LT: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) < 0 ); + break; + case GTE: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) >= 0 ); + break; + case LTE: + this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) <= 0 ); + break; + + /* Concat Strings */ + + case '+': + strcpy( this->value.data.str, sptr1 ); + strcat( this->value.data.str, sptr2 ); + break; + } + this->operation = CONST_OP; + + } else { /* Not a constant */ + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + rows = gParse.nRows; + switch( this->operation ) { + + /* Compare Strings */ + + case NE: + case EQ: + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + val = ( FSTRCMP( sptr1, sptr2 ) == 0 ); + this->value.data.logptr[rows] = + ( this->operation==EQ ? val : !val ); + } + } + break; + + case GT: + case LT: + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + val = ( FSTRCMP( sptr1, sptr2 ) ); + this->value.data.logptr[rows] = + ( this->operation==GT ? val>0 : val<0 ); + } + } + break; + + case GTE: + case LTE: + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + val = ( FSTRCMP( sptr1, sptr2 ) ); + this->value.data.logptr[rows] = + ( this->operation==GTE ? val>=0 : val<=0 ); + } + } + break; + + /* Concat Strings */ + + case '+': + while( rows-- ) { + if( !const1 ) null1 = that1->value.undef[rows]; + if( !const2 ) null2 = that2->value.undef[rows]; + this->value.undef[rows] = (null1 || null2); + if( ! this->value.undef[rows] ) { + if( !const1 ) sptr1 = that1->value.data.strptr[rows]; + if( !const2 ) sptr2 = that2->value.data.strptr[rows]; + strcpy( this->value.data.strptr[rows], sptr1 ); + strcat( this->value.data.strptr[rows], sptr2 ); + } + } + break; + } + } + } + + if( that1->operation>0 ) { + free( that1->value.data.strptr[0] ); + free( that1->value.data.strptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.strptr[0] ); + free( that2->value.data.strptr ); + } +} + +static void Do_BinOp_log( Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + char val1=0, val2=0, null1=0, null2=0; + long rows, nelem, elem; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + vector1 = ( that1->operation!=CONST_OP ); + if( vector1 ) + vector1 = that1->value.nelem; + else { + val1 = that1->value.data.log; + } + + vector2 = ( that2->operation!=CONST_OP ); + if( vector2 ) + vector2 = that2->value.nelem; + else { + val2 = that2->value.data.log; + } + + if( !vector1 && !vector2 ) { /* Result is a constant */ + switch( this->operation ) { + case OR: + this->value.data.log = (val1 || val2); + break; + case AND: + this->value.data.log = (val1 && val2); + break; + case EQ: + this->value.data.log = ( (val1 && val2) || (!val1 && !val2) ); + break; + case NE: + this->value.data.log = ( (val1 && !val2) || (!val1 && val2) ); + break; + case ACCUM: + this->value.data.lng = val1; + break; + } + this->operation=CONST_OP; + } else if (this->operation == ACCUM) { + long i, previous, curr; + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.logptr[i]; + previous += curr; + } + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + } + + } else { + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + if (this->operation == ACCUM) { + long i, previous, curr; + + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.logptr[i]; + previous += curr; + } + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + } + + while( rows-- ) { + while( nelem-- ) { + elem--; + + if( vector1>1 ) { + val1 = that1->value.data.logptr[elem]; + null1 = that1->value.undef[elem]; + } else if( vector1 ) { + val1 = that1->value.data.logptr[rows]; + null1 = that1->value.undef[rows]; + } + + if( vector2>1 ) { + val2 = that2->value.data.logptr[elem]; + null2 = that2->value.undef[elem]; + } else if( vector2 ) { + val2 = that2->value.data.logptr[rows]; + null2 = that2->value.undef[rows]; + } + + this->value.undef[elem] = (null1 || null2); + switch( this->operation ) { + + case OR: + /* This is more complicated than others to suppress UNDEFs */ + /* in those cases where the other argument is DEF && TRUE */ + + if( !null1 && !null2 ) { + this->value.data.logptr[elem] = (val1 || val2); + } else if( (null1 && !null2 && val2) + || ( !null1 && null2 && val1 ) ) { + this->value.data.logptr[elem] = 1; + this->value.undef[elem] = 0; + } + break; + + case AND: + /* This is more complicated than others to suppress UNDEFs */ + /* in those cases where the other argument is DEF && FALSE */ + + if( !null1 && !null2 ) { + this->value.data.logptr[elem] = (val1 && val2); + } else if( (null1 && !null2 && !val2) + || ( !null1 && null2 && !val1 ) ) { + this->value.data.logptr[elem] = 0; + this->value.undef[elem] = 0; + } + break; + + case EQ: + this->value.data.logptr[elem] = + ( (val1 && val2) || (!val1 && !val2) ); + break; + + case NE: + this->value.data.logptr[elem] = + ( (val1 && !val2) || (!val1 && val2) ); + break; + } + } + nelem = this->value.nelem; + } + } + } + + if( that1->operation>0 ) { + free( that1->value.data.ptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.ptr ); + } +} + +static void Do_BinOp_lng( Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + long val1=0, val2=0; + char null1=0, null2=0; + long rows, nelem, elem; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + vector1 = ( that1->operation!=CONST_OP ); + if( vector1 ) + vector1 = that1->value.nelem; + else { + val1 = that1->value.data.lng; + } + + vector2 = ( that2->operation!=CONST_OP ); + if( vector2 ) + vector2 = that2->value.nelem; + else { + val2 = that2->value.data.lng; + } + + if( !vector1 && !vector2 ) { /* Result is a constant */ + + switch( this->operation ) { + case '~': /* Treat as == for LONGS */ + case EQ: this->value.data.log = (val1 == val2); break; + case NE: this->value.data.log = (val1 != val2); break; + case GT: this->value.data.log = (val1 > val2); break; + case LT: this->value.data.log = (val1 < val2); break; + case LTE: this->value.data.log = (val1 <= val2); break; + case GTE: this->value.data.log = (val1 >= val2); break; + + case '+': this->value.data.lng = (val1 + val2); break; + case '-': this->value.data.lng = (val1 - val2); break; + case '*': this->value.data.lng = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.lng = (val1 % val2); + else fferror("Divide by Zero"); + break; + case '/': + if( val2 ) this->value.data.lng = (val1 / val2); + else fferror("Divide by Zero"); + break; + case POWER: + this->value.data.lng = (long)pow((double)val1,(double)val2); + break; + case ACCUM: + this->value.data.lng = val1; + break; + case DIFF: + this->value.data.lng = 0; + break; + } + this->operation=CONST_OP; + + } else if ((this->operation == ACCUM) || (this->operation == DIFF)) { + long i, previous, curr; + int undef; + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + previous = that2->value.data.lng; + undef = (int) that2->value.undef; + + if (this->operation == ACCUM) { + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.lngptr[i]; + previous += curr; + } + this->value.data.lngptr[i] = previous; + this->value.undef[i] = 0; + } + } else { + /* Sequential difference for this chunk */ + for (i=0; ivalue.data.lngptr[i]; + if (that1->value.undef[i] || undef) { + /* Either this, or previous, value was undefined */ + this->value.data.lngptr[i] = 0; + this->value.undef[i] = 1; + } else { + /* Both defined, we are okay! */ + this->value.data.lngptr[i] = curr - previous; + this->value.undef[i] = 0; + } + + previous = curr; + undef = that1->value.undef[i]; + } + } + + /* Store final cumulant for next pass */ + that2->value.data.lng = previous; + that2->value.undef = (char *) undef; /* XXX evil, but no harm here */ + } + + } else { + + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + while( rows-- && !gParse.status ) { + while( nelem-- && !gParse.status ) { + elem--; + + if( vector1>1 ) { + val1 = that1->value.data.lngptr[elem]; + null1 = that1->value.undef[elem]; + } else if( vector1 ) { + val1 = that1->value.data.lngptr[rows]; + null1 = that1->value.undef[rows]; + } + + if( vector2>1 ) { + val2 = that2->value.data.lngptr[elem]; + null2 = that2->value.undef[elem]; + } else if( vector2 ) { + val2 = that2->value.data.lngptr[rows]; + null2 = that2->value.undef[rows]; + } + + this->value.undef[elem] = (null1 || null2); + switch( this->operation ) { + case '~': /* Treat as == for LONGS */ + case EQ: this->value.data.logptr[elem] = (val1 == val2); break; + case NE: this->value.data.logptr[elem] = (val1 != val2); break; + case GT: this->value.data.logptr[elem] = (val1 > val2); break; + case LT: this->value.data.logptr[elem] = (val1 < val2); break; + case LTE: this->value.data.logptr[elem] = (val1 <= val2); break; + case GTE: this->value.data.logptr[elem] = (val1 >= val2); break; + + case '+': this->value.data.lngptr[elem] = (val1 + val2); break; + case '-': this->value.data.lngptr[elem] = (val1 - val2); break; + case '*': this->value.data.lngptr[elem] = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.lngptr[elem] = (val1 % val2); + else { + this->value.data.lngptr[elem] = 0; + this->value.undef[elem] = 1; + } + break; + case '/': + if( val2 ) this->value.data.lngptr[elem] = (val1 / val2); + else { + this->value.data.lngptr[elem] = 0; + this->value.undef[elem] = 1; + } + break; + case POWER: + this->value.data.lngptr[elem] = (long)pow((double)val1,(double)val2); + break; + } + } + nelem = this->value.nelem; + } + } + + if( that1->operation>0 ) { + free( that1->value.data.ptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.ptr ); + } +} + +static void Do_BinOp_dbl( Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + double val1=0.0, val2=0.0; + char null1=0, null2=0; + long rows, nelem, elem; + + that1 = gParse.Nodes + this->SubNodes[0]; + that2 = gParse.Nodes + this->SubNodes[1]; + + vector1 = ( that1->operation!=CONST_OP ); + if( vector1 ) + vector1 = that1->value.nelem; + else { + val1 = that1->value.data.dbl; + } + + vector2 = ( that2->operation!=CONST_OP ); + if( vector2 ) + vector2 = that2->value.nelem; + else { + val2 = that2->value.data.dbl; + } + + if( !vector1 && !vector2 ) { /* Result is a constant */ + + switch( this->operation ) { + case '~': this->value.data.log = ( fabs(val1-val2) < APPROX ); break; + case EQ: this->value.data.log = (val1 == val2); break; + case NE: this->value.data.log = (val1 != val2); break; + case GT: this->value.data.log = (val1 > val2); break; + case LT: this->value.data.log = (val1 < val2); break; + case LTE: this->value.data.log = (val1 <= val2); break; + case GTE: this->value.data.log = (val1 >= val2); break; + + case '+': this->value.data.dbl = (val1 + val2); break; + case '-': this->value.data.dbl = (val1 - val2); break; + case '*': this->value.data.dbl = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.dbl = val1 - val2*((int)(val1/val2)); + else fferror("Divide by Zero"); + break; + case '/': + if( val2 ) this->value.data.dbl = (val1 / val2); + else fferror("Divide by Zero"); + break; + case POWER: + this->value.data.dbl = (double)pow(val1,val2); + break; + case ACCUM: + this->value.data.dbl = val1; + break; + case DIFF: + this->value.data.dbl = 0; + break; + } + this->operation=CONST_OP; + + } else if ((this->operation == ACCUM) || (this->operation == DIFF)) { + long i; + int undef; + double previous, curr; + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + previous = that2->value.data.dbl; + undef = (int) that2->value.undef; + + if (this->operation == ACCUM) { + /* Cumulative sum of this chunk */ + for (i=0; ivalue.undef[i]) { + curr = that1->value.data.dblptr[i]; + previous += curr; + } + this->value.data.dblptr[i] = previous; + this->value.undef[i] = 0; + } + } else { + /* Sequential difference for this chunk */ + for (i=0; ivalue.data.dblptr[i]; + if (that1->value.undef[i] || undef) { + /* Either this, or previous, value was undefined */ + this->value.data.dblptr[i] = 0; + this->value.undef[i] = 1; + } else { + /* Both defined, we are okay! */ + this->value.data.dblptr[i] = curr - previous; + this->value.undef[i] = 0; + } + + previous = curr; + undef = that1->value.undef[i]; + } + } + + /* Store final cumulant for next pass */ + that2->value.data.dbl = previous; + that2->value.undef = (char *) undef; /* XXX evil, but no harm here */ + } + + } else { + + rows = gParse.nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( this ); + + while( rows-- && !gParse.status ) { + while( nelem-- && !gParse.status ) { + elem--; + + if( vector1>1 ) { + val1 = that1->value.data.dblptr[elem]; + null1 = that1->value.undef[elem]; + } else if( vector1 ) { + val1 = that1->value.data.dblptr[rows]; + null1 = that1->value.undef[rows]; + } + + if( vector2>1 ) { + val2 = that2->value.data.dblptr[elem]; + null2 = that2->value.undef[elem]; + } else if( vector2 ) { + val2 = that2->value.data.dblptr[rows]; + null2 = that2->value.undef[rows]; + } + + this->value.undef[elem] = (null1 || null2); + switch( this->operation ) { + case '~': this->value.data.logptr[elem] = + ( fabs(val1-val2) < APPROX ); break; + case EQ: this->value.data.logptr[elem] = (val1 == val2); break; + case NE: this->value.data.logptr[elem] = (val1 != val2); break; + case GT: this->value.data.logptr[elem] = (val1 > val2); break; + case LT: this->value.data.logptr[elem] = (val1 < val2); break; + case LTE: this->value.data.logptr[elem] = (val1 <= val2); break; + case GTE: this->value.data.logptr[elem] = (val1 >= val2); break; + + case '+': this->value.data.dblptr[elem] = (val1 + val2); break; + case '-': this->value.data.dblptr[elem] = (val1 - val2); break; + case '*': this->value.data.dblptr[elem] = (val1 * val2); break; + + case '%': + if( val2 ) this->value.data.dblptr[elem] = + val1 - val2*((int)(val1/val2)); + else { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } + break; + case '/': + if( val2 ) this->value.data.dblptr[elem] = (val1 / val2); + else { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } + break; + case POWER: + this->value.data.dblptr[elem] = (double)pow(val1,val2); + break; + } + } + nelem = this->value.nelem; + } + } + + if( that1->operation>0 ) { + free( that1->value.data.ptr ); + } + if( that2->operation>0 ) { + free( that2->value.data.ptr ); + } +} + +/* + * This Quickselect routine is based on the algorithm described in + * "Numerical recipes in C", Second Edition, + * Cambridge University Press, 1992, Section 8.5, ISBN 0-521-43108-5 + * This code by Nicolas Devillard - 1998. Public domain. + * http://ndevilla.free.fr/median/median/src/quickselect.c + */ + +#define ELEM_SWAP(a,b) { register long t=(a);(a)=(b);(b)=t; } + +/* + * qselect_median_lng - select the median value of a long array + * + * This routine selects the median value of the long integer array + * arr[]. If there are an even number of elements, the "lower median" + * is selected. + * + * The array arr[] is scrambled, so users must operate on a scratch + * array if they wish the values to be preserved. + * + * long arr[] - array of values + * int n - number of elements in arr + * + * RETURNS: the lower median value of arr[] + * + */ +long qselect_median_lng(long arr[], int n) +{ + int low, high ; + int median; + int middle, ll, hh; + + low = 0 ; high = n-1 ; median = (low + high) / 2; + for (;;) { + + if (high <= low) { /* One element only */ + return arr[median]; + } + + if (high == low + 1) { /* Two elements only */ + if (arr[low] > arr[high]) + ELEM_SWAP(arr[low], arr[high]) ; + return arr[median]; + } + + /* Find median of low, middle and high items; swap into position low */ + middle = (low + high) / 2; + if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ; + if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ; + if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ; + + /* Swap low item (now in position middle) into position (low+1) */ + ELEM_SWAP(arr[middle], arr[low+1]) ; + + /* Nibble from each end towards middle, swapping items when stuck */ + ll = low + 1; + hh = high; + for (;;) { + do ll++; while (arr[low] > arr[ll]) ; + do hh--; while (arr[hh] > arr[low]) ; + + if (hh < ll) + break; + + ELEM_SWAP(arr[ll], arr[hh]) ; + } + + /* Swap middle item (in position low) back into correct position */ + ELEM_SWAP(arr[low], arr[hh]) ; + + /* Re-set active partition */ + if (hh <= median) + low = ll; + if (hh >= median) + high = hh - 1; + } +} + +#undef ELEM_SWAP + +#define ELEM_SWAP(a,b) { register double t=(a);(a)=(b);(b)=t; } + +/* + * qselect_median_dbl - select the median value of a double array + * + * This routine selects the median value of the double array + * arr[]. If there are an even number of elements, the "lower median" + * is selected. + * + * The array arr[] is scrambled, so users must operate on a scratch + * array if they wish the values to be preserved. + * + * double arr[] - array of values + * int n - number of elements in arr + * + * RETURNS: the lower median value of arr[] + * + */ +double qselect_median_dbl(double arr[], int n) +{ + int low, high ; + int median; + int middle, ll, hh; + + low = 0 ; high = n-1 ; median = (low + high) / 2; + for (;;) { + if (high <= low) { /* One element only */ + return arr[median] ; + } + + if (high == low + 1) { /* Two elements only */ + if (arr[low] > arr[high]) + ELEM_SWAP(arr[low], arr[high]) ; + return arr[median] ; + } + + /* Find median of low, middle and high items; swap into position low */ + middle = (low + high) / 2; + if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ; + if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ; + if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ; + + /* Swap low item (now in position middle) into position (low+1) */ + ELEM_SWAP(arr[middle], arr[low+1]) ; + + /* Nibble from each end towards middle, swapping items when stuck */ + ll = low + 1; + hh = high; + for (;;) { + do ll++; while (arr[low] > arr[ll]) ; + do hh--; while (arr[hh] > arr[low]) ; + + if (hh < ll) + break; + + ELEM_SWAP(arr[ll], arr[hh]) ; + } + + /* Swap middle item (in position low) back into correct position */ + ELEM_SWAP(arr[low], arr[hh]) ; + + /* Re-set active partition */ + if (hh <= median) + low = ll; + if (hh >= median) + high = hh - 1; + } +} + +#undef ELEM_SWAP + +static void Do_Func( Node *this ) +{ + Node *theParams[MAXSUBS]; + int vector[MAXSUBS], allConst; + lval pVals[MAXSUBS]; + char pNull[MAXSUBS]; + long ival; + double dval; + int i, valInit; + long row, elem, nelem; + double rndVal; + + i = this->nSubNodes; + allConst = 1; + while( i-- ) { + theParams[i] = gParse.Nodes + this->SubNodes[i]; + vector[i] = ( theParams[i]->operation!=CONST_OP ); + if( vector[i] ) { + allConst = 0; + vector[i] = theParams[i]->value.nelem; + } else { + if( theParams[i]->type==DOUBLE ) { + pVals[i].data.dbl = theParams[i]->value.data.dbl; + } else if( theParams[i]->type==LONG ) { + pVals[i].data.lng = theParams[i]->value.data.lng; + } else if( theParams[i]->type==BOOLEAN ) { + pVals[i].data.log = theParams[i]->value.data.log; + } else + strcpy(pVals[i].data.str, theParams[i]->value.data.str); + pNull[i] = 0; + } + } + + if( this->nSubNodes==0 ) allConst = 0; /* These do produce scalars */ + + if( allConst ) { + + switch( this->operation ) { + + /* Non-Trig single-argument functions */ + + case sum_fct: + if( theParams[0]->type==BOOLEAN ) + this->value.data.lng = ( pVals[0].data.log ? 1 : 0 ); + else if( theParams[0]->type==LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( theParams[0]->type==DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( theParams[0]->type==BITSTR ) + strcpy(this->value.data.str, pVals[0].data.str); + break; + case average_fct: + if( theParams[0]->type==LONG ) + this->value.data.dbl = pVals[0].data.lng; + else if( theParams[0]->type==DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + break; + case stddev_fct: + this->value.data.dbl = 0; /* Standard deviation of a constant = 0 */ + break; + case median_fct: + if( theParams[0]->type==BOOLEAN ) + this->value.data.lng = ( pVals[0].data.log ? 1 : 0 ); + else if( theParams[0]->type==LONG ) + this->value.data.lng = pVals[0].data.lng; + else + this->value.data.dbl = pVals[0].data.dbl; + break; + case abs_fct: + if( theParams[0]->type==DOUBLE ) { + dval = pVals[0].data.dbl; + this->value.data.dbl = (dval>0.0 ? dval : -dval); + } else { + ival = pVals[0].data.lng; + this->value.data.lng = (ival> 0 ? ival : -ival); + } + break; + + /* Special Null-Handling Functions */ + + case nonnull_fct: + this->value.data.lng = 1; /* Constants are always 1-element and defined */ + break; + case isnull_fct: /* Constants are always defined */ + this->value.data.log = 0; + break; + case defnull_fct: + if( this->type==BOOLEAN ) + this->value.data.log = pVals[0].data.log; + else if( this->type==LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( this->type==DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( this->type==STRING ) + strcpy(this->value.data.str,pVals[0].data.str); + break; + + /* Math functions with 1 double argument */ + + case sin_fct: + this->value.data.dbl = sin( pVals[0].data.dbl ); + break; + case cos_fct: + this->value.data.dbl = cos( pVals[0].data.dbl ); + break; + case tan_fct: + this->value.data.dbl = tan( pVals[0].data.dbl ); + break; + case asin_fct: + dval = pVals[0].data.dbl; + if( dval<-1.0 || dval>1.0 ) + fferror("Out of range argument to arcsin"); + else + this->value.data.dbl = asin( dval ); + break; + case acos_fct: + dval = pVals[0].data.dbl; + if( dval<-1.0 || dval>1.0 ) + fferror("Out of range argument to arccos"); + else + this->value.data.dbl = acos( dval ); + break; + case atan_fct: + this->value.data.dbl = atan( pVals[0].data.dbl ); + break; + case sinh_fct: + this->value.data.dbl = sinh( pVals[0].data.dbl ); + break; + case cosh_fct: + this->value.data.dbl = cosh( pVals[0].data.dbl ); + break; + case tanh_fct: + this->value.data.dbl = tanh( pVals[0].data.dbl ); + break; + case exp_fct: + this->value.data.dbl = exp( pVals[0].data.dbl ); + break; + case log_fct: + dval = pVals[0].data.dbl; + if( dval<=0.0 ) + fferror("Out of range argument to log"); + else + this->value.data.dbl = log( dval ); + break; + case log10_fct: + dval = pVals[0].data.dbl; + if( dval<=0.0 ) + fferror("Out of range argument to log10"); + else + this->value.data.dbl = log10( dval ); + break; + case sqrt_fct: + dval = pVals[0].data.dbl; + if( dval<0.0 ) + fferror("Out of range argument to sqrt"); + else + this->value.data.dbl = sqrt( dval ); + break; + case ceil_fct: + this->value.data.dbl = ceil( pVals[0].data.dbl ); + break; + case floor_fct: + this->value.data.dbl = floor( pVals[0].data.dbl ); + break; + case round_fct: + this->value.data.dbl = floor( pVals[0].data.dbl + 0.5 ); + break; + + /* Two-argument Trig Functions */ + + case atan2_fct: + this->value.data.dbl = + atan2( pVals[0].data.dbl, pVals[1].data.dbl ); + break; + + /* Min/Max functions taking 1 or 2 arguments */ + + case min1_fct: + /* No constant vectors! */ + if( this->type == DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( this->type == LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( this->type == BITSTR ) + strcpy(this->value.data.str, pVals[0].data.str); + break; + case min2_fct: + if( this->type == DOUBLE ) + this->value.data.dbl = + minvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + else if( this->type == LONG ) + this->value.data.lng = + minvalue( pVals[0].data.lng, pVals[1].data.lng ); + break; + case max1_fct: + /* No constant vectors! */ + if( this->type == DOUBLE ) + this->value.data.dbl = pVals[0].data.dbl; + else if( this->type == LONG ) + this->value.data.lng = pVals[0].data.lng; + else if( this->type == BITSTR ) + strcpy(this->value.data.str, pVals[0].data.str); + break; + case max2_fct: + if( this->type == DOUBLE ) + this->value.data.dbl = + maxvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + else if( this->type == LONG ) + this->value.data.lng = + maxvalue( pVals[0].data.lng, pVals[1].data.lng ); + break; + + /* Boolean SAO region Functions... all arguments scalar dbls */ + + case near_fct: + this->value.data.log = bnear( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl ); + break; + case circle_fct: + this->value.data.log = circle( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl ); + break; + case box_fct: + this->value.data.log = saobox( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + break; + case elps_fct: + this->value.data.log = + ellipse( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + break; + + /* C Conditional expression: bool ? expr : expr */ + + case ifthenelse_fct: + switch( this->type ) { + case BOOLEAN: + this->value.data.log = ( pVals[2].data.log ? + pVals[0].data.log : pVals[1].data.log ); + break; + case LONG: + this->value.data.lng = ( pVals[2].data.log ? + pVals[0].data.lng : pVals[1].data.lng ); + break; + case DOUBLE: + this->value.data.dbl = ( pVals[2].data.log ? + pVals[0].data.dbl : pVals[1].data.dbl ); + break; + case STRING: + strcpy(this->value.data.str, ( pVals[2].data.log ? + pVals[0].data.str : + pVals[1].data.str ) ); + break; + } + break; + + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + row = gParse.nRows; + elem = row * this->value.nelem; + + if( !gParse.status ) { + switch( this->operation ) { + + /* Special functions with no arguments */ + + case row_fct: + while( row-- ) { + this->value.data.lngptr[row] = gParse.firstRow + row; + this->value.undef[row] = 0; + } + break; + case null_fct: + if( this->type==LONG ) { + while( row-- ) { + this->value.data.lngptr[row] = 0; + this->value.undef[row] = 1; + } + } else if( this->type==STRING ) { + while( row-- ) { + this->value.data.strptr[row][0] = '\0'; + this->value.undef[row] = 1; + } + } + break; + case rnd_fct: + if( rand()<32768 && rand()<32768 ) + dval = 32768.0; + else + dval = 2147483648.0; + while( row-- ) { + rndVal = (double)rand(); + while( rndVal > dval ) dval *= 2.0; + this->value.data.dblptr[row] = rndVal/dval; + this->value.undef[row] = 0; + } + break; + + /* Non-Trig single-argument functions */ + + case sum_fct: + elem = row * theParams[0]->value.nelem; + if( theParams[0]->type==BOOLEAN ) { + while( row-- ) { + this->value.data.lngptr[row] = 0; + /* Default is UNDEF until a defined value is found */ + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( ! theParams[0]->value.undef[elem] ) { + this->value.data.lngptr[row] += + ( theParams[0]->value.data.logptr[elem] ? 1 : 0 ); + this->value.undef[row] = 0; + } + } + } + } else if( theParams[0]->type==LONG ) { + while( row-- ) { + this->value.data.lngptr[row] = 0; + /* Default is UNDEF until a defined value is found */ + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( ! theParams[0]->value.undef[elem] ) { + this->value.data.lngptr[row] += + theParams[0]->value.data.lngptr[elem]; + this->value.undef[row] = 0; + } + } + } + } else if( theParams[0]->type==DOUBLE ){ + while( row-- ) { + this->value.data.dblptr[row] = 0.0; + /* Default is UNDEF until a defined value is found */ + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( ! theParams[0]->value.undef[elem] ) { + this->value.data.dblptr[row] += + theParams[0]->value.data.dblptr[elem]; + this->value.undef[row] = 0; + } + } + } + } else { /* BITSTR */ + nelem = theParams[0]->value.nelem; + while( row-- ) { + char *sptr1 = theParams[0]->value.data.strptr[row]; + this->value.data.lngptr[row] = 0; + this->value.undef[row] = 0; + while (*sptr1) { + if (*sptr1 == '1') this->value.data.lngptr[row] ++; + sptr1++; + } + } + } + break; + + case average_fct: + elem = row * theParams[0]->value.nelem; + if( theParams[0]->type==LONG ) { + while( row-- ) { + int count = 0; + this->value.data.dblptr[row] = 0; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + this->value.data.dblptr[row] += + theParams[0]->value.data.lngptr[elem]; + count ++; + } + } + if (count == 0) { + this->value.undef[row] = 1; + } else { + this->value.undef[row] = 0; + this->value.data.dblptr[row] /= count; + } + } + } else if( theParams[0]->type==DOUBLE ){ + while( row-- ) { + int count = 0; + this->value.data.dblptr[row] = 0; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + this->value.data.dblptr[row] += + theParams[0]->value.data.dblptr[elem]; + count ++; + } + } + if (count == 0) { + this->value.undef[row] = 1; + } else { + this->value.undef[row] = 0; + this->value.data.dblptr[row] /= count; + } + } + } + break; + case stddev_fct: + elem = row * theParams[0]->value.nelem; + if( theParams[0]->type==LONG ) { + + /* Compute the mean value */ + while( row-- ) { + int count = 0; + double sum = 0, sum2 = 0; + + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + sum += theParams[0]->value.data.lngptr[elem]; + count ++; + } + } + if (count > 1) { + sum /= count; + + /* Compute the sum of squared deviations */ + nelem = theParams[0]->value.nelem; + elem += nelem; /* Reset elem for second pass */ + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + double dx = (theParams[0]->value.data.lngptr[elem] - sum); + sum2 += (dx*dx); + } + } + + sum2 /= (double)count-1; + + this->value.undef[row] = 0; + this->value.data.dblptr[row] = sqrt(sum2); + } else { + this->value.undef[row] = 0; /* STDDEV => 0 */ + this->value.data.dblptr[row] = 0; + } + } + } else if( theParams[0]->type==DOUBLE ){ + + /* Compute the mean value */ + while( row-- ) { + int count = 0; + double sum = 0, sum2 = 0; + + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + sum += theParams[0]->value.data.dblptr[elem]; + count ++; + } + } + if (count > 1) { + sum /= count; + + /* Compute the sum of squared deviations */ + nelem = theParams[0]->value.nelem; + elem += nelem; /* Reset elem for second pass */ + while( nelem-- ) { + elem--; + if (theParams[0]->value.undef[elem] == 0) { + double dx = (theParams[0]->value.data.dblptr[elem] - sum); + sum2 += (dx*dx); + } + } + + sum2 /= (double)count-1; + + this->value.undef[row] = 0; + this->value.data.dblptr[row] = sqrt(sum2); + } else { + this->value.undef[row] = 0; /* STDDEV => 0 */ + this->value.data.dblptr[row] = 0; + } + } + } + break; + + case median_fct: + elem = row * theParams[0]->value.nelem; + nelem = theParams[0]->value.nelem; + if( theParams[0]->type==LONG ) { + long *dptr = theParams[0]->value.data.lngptr; + char *uptr = theParams[0]->value.undef; + long *mptr = (long *) malloc(sizeof(long)*nelem); + int irow; + + /* Allocate temporary storage for this row, since the + quickselect function will scramble the contents */ + if (mptr == 0) { + fferror("Could not allocate temporary memory in median function"); + free( this->value.data.ptr ); + break; + } + + for (irow=0; irow 0) { + this->value.undef[irow] = 0; + this->value.data.lngptr[irow] = qselect_median_lng(mptr, nelem1); + } else { + this->value.undef[irow] = 1; + this->value.data.lngptr[irow] = 0; + } + + } + + free(mptr); + } else { + double *dptr = theParams[0]->value.data.dblptr; + char *uptr = theParams[0]->value.undef; + double *mptr = (double *) malloc(sizeof(double)*nelem); + int irow; + + /* Allocate temporary storage for this row, since the + quickselect function will scramble the contents */ + if (mptr == 0) { + fferror("Could not allocate temporary memory in median function"); + free( this->value.data.ptr ); + break; + } + + for (irow=0; irow 0) { + this->value.undef[irow] = 0; + this->value.data.dblptr[irow] = qselect_median_dbl(mptr, nelem1); + } else { + this->value.undef[irow] = 1; + this->value.data.dblptr[irow] = 0; + } + + } + free(mptr); + } + break; + case abs_fct: + if( theParams[0]->type==DOUBLE ) + while( elem-- ) { + dval = theParams[0]->value.data.dblptr[elem]; + this->value.data.dblptr[elem] = (dval>0.0 ? dval : -dval); + this->value.undef[elem] = theParams[0]->value.undef[elem]; + } + else + while( elem-- ) { + ival = theParams[0]->value.data.lngptr[elem]; + this->value.data.lngptr[elem] = (ival> 0 ? ival : -ival); + this->value.undef[elem] = theParams[0]->value.undef[elem]; + } + break; + + /* Special Null-Handling Functions */ + + case nonnull_fct: + nelem = theParams[0]->value.nelem; + if ( theParams[0]->type==STRING ) nelem = 1; + elem = row * nelem; + while( row-- ) { + int nelem1 = nelem; + + this->value.undef[row] = 0; /* Initialize to 0 (defined) */ + this->value.data.lngptr[row] = 0; + while( nelem1-- ) { + elem --; + if ( theParams[0]->value.undef[elem] == 0 ) this->value.data.lngptr[row] ++; + } + } + break; + case isnull_fct: + if( theParams[0]->type==STRING ) elem = row; + while( elem-- ) { + this->value.data.logptr[elem] = theParams[0]->value.undef[elem]; + this->value.undef[elem] = 0; + } + break; + case defnull_fct: + switch( this->type ) { + case BOOLEAN: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pNull[i] = theParams[i]->value.undef[elem]; + pVals[i].data.log = + theParams[i]->value.data.logptr[elem]; + } else if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + pVals[i].data.log = + theParams[i]->value.data.logptr[row]; + } + if( pNull[0] ) { + this->value.undef[elem] = pNull[1]; + this->value.data.logptr[elem] = pVals[1].data.log; + } else { + this->value.undef[elem] = 0; + this->value.data.logptr[elem] = pVals[0].data.log; + } + } + } + break; + case LONG: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pNull[i] = theParams[i]->value.undef[elem]; + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + } else if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + } + if( pNull[0] ) { + this->value.undef[elem] = pNull[1]; + this->value.data.lngptr[elem] = pVals[1].data.lng; + } else { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[0].data.lng; + } + } + } + break; + case DOUBLE: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pNull[i] = theParams[i]->value.undef[elem]; + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + } else if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + } + if( pNull[0] ) { + this->value.undef[elem] = pNull[1]; + this->value.data.dblptr[elem] = pVals[1].data.dbl; + } else { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[0].data.dbl; + } + } + } + break; + case STRING: + while( row-- ) { + i=2; while( i-- ) + if( vector[i] ) { + pNull[i] = theParams[i]->value.undef[row]; + strcpy(pVals[i].data.str, + theParams[i]->value.data.strptr[row]); + } + if( pNull[0] ) { + this->value.undef[row] = pNull[1]; + strcpy(this->value.data.strptr[row],pVals[1].data.str); + } else { + this->value.undef[elem] = 0; + strcpy(this->value.data.strptr[row],pVals[0].data.str); + } + } + } + break; + + /* Math functions with 1 double argument */ + + case sin_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + sin( theParams[0]->value.data.dblptr[elem] ); + } + break; + case cos_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + cos( theParams[0]->value.data.dblptr[elem] ); + } + break; + case tan_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + tan( theParams[0]->value.data.dblptr[elem] ); + } + break; + case asin_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<-1.0 || dval>1.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = asin( dval ); + } + break; + case acos_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<-1.0 || dval>1.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = acos( dval ); + } + break; + case atan_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + this->value.data.dblptr[elem] = atan( dval ); + } + break; + case sinh_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + sinh( theParams[0]->value.data.dblptr[elem] ); + } + break; + case cosh_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + cosh( theParams[0]->value.data.dblptr[elem] ); + } + break; + case tanh_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + tanh( theParams[0]->value.data.dblptr[elem] ); + } + break; + case exp_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + this->value.data.dblptr[elem] = exp( dval ); + } + break; + case log_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<=0.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = log( dval ); + } + break; + case log10_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<=0.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = log10( dval ); + } + break; + case sqrt_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + dval = theParams[0]->value.data.dblptr[elem]; + if( dval<0.0 ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 1; + } else + this->value.data.dblptr[elem] = sqrt( dval ); + } + break; + case ceil_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + ceil( theParams[0]->value.data.dblptr[elem] ); + } + break; + case floor_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + floor( theParams[0]->value.data.dblptr[elem] ); + } + break; + case round_fct: + while( elem-- ) + if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) { + this->value.data.dblptr[elem] = + floor( theParams[0]->value.data.dblptr[elem] + 0.5); + } + break; + + /* Two-argument Trig Functions */ + + case atan2_fct: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = (pNull[0] || pNull[1]) ) ) + this->value.data.dblptr[elem] = + atan2( pVals[0].data.dbl, pVals[1].data.dbl ); + } + } + break; + + /* Min/Max functions taking 1 or 2 arguments */ + + case min1_fct: + elem = row * theParams[0]->value.nelem; + if( this->type==LONG ) { + long minVal=0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + minVal = theParams[0]->value.data.lngptr[elem]; + } else { + minVal = minvalue( minVal, + theParams[0]->value.data.lngptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.lngptr[row] = minVal; + } + } else if( this->type==DOUBLE ) { + double minVal=0.0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + minVal = theParams[0]->value.data.dblptr[elem]; + } else { + minVal = minvalue( minVal, + theParams[0]->value.data.dblptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.dblptr[row] = minVal; + } + } else if( this->type==BITSTR ) { + char minVal; + while( row-- ) { + char *sptr1 = theParams[0]->value.data.strptr[row]; + minVal = '1'; + while (*sptr1) { + if (*sptr1 == '0') minVal = '0'; + sptr1++; + } + this->value.data.strptr[row][0] = minVal; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + } + break; + case min2_fct: + if( this->type==LONG ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.lngptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[1].data.lng; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[0].data.lng; + } else { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = + minvalue( pVals[0].data.lng, pVals[1].data.lng ); + } + } + } + } else if( this->type==DOUBLE ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.dblptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[1].data.dbl; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[0].data.dbl; + } else { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = + minvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + } + } + } + } + break; + + case max1_fct: + elem = row * theParams[0]->value.nelem; + if( this->type==LONG ) { + long maxVal=0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + maxVal = theParams[0]->value.data.lngptr[elem]; + } else { + maxVal = maxvalue( maxVal, + theParams[0]->value.data.lngptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.lngptr[row] = maxVal; + } + } else if( this->type==DOUBLE ) { + double maxVal=0.0; + while( row-- ) { + valInit = 1; + this->value.undef[row] = 1; + nelem = theParams[0]->value.nelem; + while( nelem-- ) { + elem--; + if ( !theParams[0]->value.undef[elem] ) { + if ( valInit ) { + valInit = 0; + maxVal = theParams[0]->value.data.dblptr[elem]; + } else { + maxVal = maxvalue( maxVal, + theParams[0]->value.data.dblptr[elem] ); + } + this->value.undef[row] = 0; + } + } + this->value.data.dblptr[row] = maxVal; + } + } else if( this->type==BITSTR ) { + char maxVal; + while( row-- ) { + char *sptr1 = theParams[0]->value.data.strptr[row]; + maxVal = '0'; + while (*sptr1) { + if (*sptr1 == '1') maxVal = '1'; + sptr1++; + } + this->value.data.strptr[row][0] = maxVal; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + } + break; + case max2_fct: + if( this->type==LONG ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.lngptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[1].data.lng; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = pVals[0].data.lng; + } else { + this->value.undef[elem] = 0; + this->value.data.lngptr[elem] = + maxvalue( pVals[0].data.lng, pVals[1].data.lng ); + } + } + } + } else if( this->type==DOUBLE ) { + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( pNull[0] && pNull[1] ) { + this->value.undef[elem] = 1; + this->value.data.dblptr[elem] = 0; + } else if (pNull[0]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[1].data.dbl; + } else if (pNull[1]) { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = pVals[0].data.dbl; + } else { + this->value.undef[elem] = 0; + this->value.data.dblptr[elem] = + maxvalue( pVals[0].data.dbl, pVals[1].data.dbl ); + } + } + } + } + break; + + /* Boolean SAO region Functions... all arguments scalar dbls */ + + case near_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=3; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + bnear( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl ); + } + break; + case circle_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=5; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + circle( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl ); + } + break; + case box_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=7; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + saobox( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + } + break; + case elps_fct: + while( row-- ) { + this->value.undef[row] = 0; + i=7; while( i-- ) + if( vector[i] ) { + pVals[i].data.dbl = theParams[i]->value.data.dblptr[row]; + this->value.undef[row] |= theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row]) ) + this->value.data.logptr[row] = + ellipse( pVals[0].data.dbl, pVals[1].data.dbl, + pVals[2].data.dbl, pVals[3].data.dbl, + pVals[4].data.dbl, pVals[5].data.dbl, + pVals[6].data.dbl ); + } + break; + + /* C Conditional expression: bool ? expr : expr */ + + case ifthenelse_fct: + switch( this->type ) { + case BOOLEAN: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + if( vector[2]>1 ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[elem]; + pNull[2] = theParams[2]->value.undef[elem]; + } else if( vector[2] ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.log = + theParams[i]->value.data.logptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.log = + theParams[i]->value.data.logptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = pNull[2]) ) { + if( pVals[2].data.log ) { + this->value.data.logptr[elem] = pVals[0].data.log; + this->value.undef[elem] = pNull[0]; + } else { + this->value.data.logptr[elem] = pVals[1].data.log; + this->value.undef[elem] = pNull[1]; + } + } + } + } + break; + case LONG: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + if( vector[2]>1 ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[elem]; + pNull[2] = theParams[2]->value.undef[elem]; + } else if( vector[2] ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.lng = + theParams[i]->value.data.lngptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = pNull[2]) ) { + if( pVals[2].data.log ) { + this->value.data.lngptr[elem] = pVals[0].data.lng; + this->value.undef[elem] = pNull[0]; + } else { + this->value.data.lngptr[elem] = pVals[1].data.lng; + this->value.undef[elem] = pNull[1]; + } + } + } + } + break; + case DOUBLE: + while( row-- ) { + nelem = this->value.nelem; + while( nelem-- ) { + elem--; + if( vector[2]>1 ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[elem]; + pNull[2] = theParams[2]->value.undef[elem]; + } else if( vector[2] ) { + pVals[2].data.log = + theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i]>1 ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[elem]; + pNull[i] = theParams[i]->value.undef[elem]; + } else if( vector[i] ) { + pVals[i].data.dbl = + theParams[i]->value.data.dblptr[row]; + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[elem] = pNull[2]) ) { + if( pVals[2].data.log ) { + this->value.data.dblptr[elem] = pVals[0].data.dbl; + this->value.undef[elem] = pNull[0]; + } else { + this->value.data.dblptr[elem] = pVals[1].data.dbl; + this->value.undef[elem] = pNull[1]; + } + } + } + } + break; + case STRING: + while( row-- ) { + if( vector[2] ) { + pVals[2].data.log = theParams[2]->value.data.logptr[row]; + pNull[2] = theParams[2]->value.undef[row]; + } + i=2; while( i-- ) + if( vector[i] ) { + strcpy( pVals[i].data.str, + theParams[i]->value.data.strptr[row] ); + pNull[i] = theParams[i]->value.undef[row]; + } + if( !(this->value.undef[row] = pNull[2]) ) { + if( pVals[2].data.log ) { + strcpy( this->value.data.strptr[row], + pVals[0].data.str ); + this->value.undef[row] = pNull[0]; + } else { + strcpy( this->value.data.strptr[row], + pVals[1].data.str ); + this->value.undef[row] = pNull[1]; + } + } else { + this->value.data.strptr[row][0] = '\0'; + } + } + break; + + } + break; + + } + } + } + + i = this->nSubNodes; + while( i-- ) { + if( theParams[i]->operation>0 ) { + /* Currently only numeric params allowed */ + free( theParams[i]->value.data.ptr ); + } + } +} + +static void Do_Deref( Node *this ) +{ + Node *theVar, *theDims[MAXDIMS]; + int isConst[MAXDIMS], allConst; + long dimVals[MAXDIMS]; + int i, nDims; + long row, elem, dsize; + + theVar = gParse.Nodes + this->SubNodes[0]; + + i = nDims = this->nSubNodes-1; + allConst = 1; + while( i-- ) { + theDims[i] = gParse.Nodes + this->SubNodes[i+1]; + isConst[i] = ( theDims[i]->operation==CONST_OP ); + if( isConst[i] ) + dimVals[i] = theDims[i]->value.data.lng; + else + allConst = 0; + } + + if( this->type==DOUBLE ) { + dsize = sizeof( double ); + } else if( this->type==LONG ) { + dsize = sizeof( long ); + } else if( this->type==BOOLEAN ) { + dsize = sizeof( char ); + } else + dsize = 0; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + if( allConst && theVar->value.naxis==nDims ) { + + /* Dereference completely using constant indices */ + + elem = 0; + i = nDims; + while( i-- ) { + if( dimVals[i]<1 || dimVals[i]>theVar->value.naxes[i] ) break; + elem = theVar->value.naxes[i]*elem + dimVals[i]-1; + } + if( i<0 ) { + for( row=0; rowtype==STRING ) + this->value.undef[row] = theVar->value.undef[row]; + else if( this->type==BITSTR ) + this->value.undef; /* Dummy - BITSTRs do not have undefs */ + else + this->value.undef[row] = theVar->value.undef[elem]; + + if( this->type==DOUBLE ) + this->value.data.dblptr[row] = + theVar->value.data.dblptr[elem]; + else if( this->type==LONG ) + this->value.data.lngptr[row] = + theVar->value.data.lngptr[elem]; + else if( this->type==BOOLEAN ) + this->value.data.logptr[row] = + theVar->value.data.logptr[elem]; + else { + /* XXX Note, the below expression uses knowledge of + the layout of the string format, namely (nelem+1) + characters per string, followed by (nelem+1) + "undef" values. */ + this->value.data.strptr[row][0] = + theVar->value.data.strptr[0][elem+row]; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + elem += theVar->value.nelem; + } + } else { + fferror("Index out of range"); + free( this->value.data.ptr ); + } + + } else if( allConst && nDims==1 ) { + + /* Reduce dimensions by 1, using a constant index */ + + if( dimVals[0] < 1 || + dimVals[0] > theVar->value.naxes[ theVar->value.naxis-1 ] ) { + fferror("Index out of range"); + free( this->value.data.ptr ); + } else if ( this->type == BITSTR || this->type == STRING ) { + elem = this->value.nelem * (dimVals[0]-1); + for( row=0; rowvalue.undef) + this->value.undef[row] = theVar->value.undef[row]; + memcpy( (char*)this->value.data.strptr[0] + + row*sizeof(char)*(this->value.nelem+1), + (char*)theVar->value.data.strptr[0] + elem*sizeof(char), + this->value.nelem * sizeof(char) ); + /* Null terminate */ + this->value.data.strptr[row][this->value.nelem] = 0; + elem += theVar->value.nelem+1; + } + } else { + elem = this->value.nelem * (dimVals[0]-1); + for( row=0; rowvalue.undef + row*this->value.nelem, + theVar->value.undef + elem, + this->value.nelem * sizeof(char) ); + memcpy( (char*)this->value.data.ptr + + row*dsize*this->value.nelem, + (char*)theVar->value.data.ptr + elem*dsize, + this->value.nelem * dsize ); + elem += theVar->value.nelem; + } + } + + } else if( theVar->value.naxis==nDims ) { + + /* Dereference completely using an expression for the indices */ + + for( row=0; rowvalue.undef[row] ) { + fferror("Null encountered as vector index"); + free( this->value.data.ptr ); + break; + } else + dimVals[i] = theDims[i]->value.data.lngptr[row]; + } + } + if( gParse.status ) break; + + elem = 0; + i = nDims; + while( i-- ) { + if( dimVals[i]<1 || dimVals[i]>theVar->value.naxes[i] ) break; + elem = theVar->value.naxes[i]*elem + dimVals[i]-1; + } + if( i<0 ) { + elem += row*theVar->value.nelem; + + if( this->type==STRING ) + this->value.undef[row] = theVar->value.undef[row]; + else if( this->type==BITSTR ) + this->value.undef; /* Dummy - BITSTRs do not have undefs */ + else + this->value.undef[row] = theVar->value.undef[elem]; + + if( this->type==DOUBLE ) + this->value.data.dblptr[row] = + theVar->value.data.dblptr[elem]; + else if( this->type==LONG ) + this->value.data.lngptr[row] = + theVar->value.data.lngptr[elem]; + else if( this->type==BOOLEAN ) + this->value.data.logptr[row] = + theVar->value.data.logptr[elem]; + else { + /* XXX Note, the below expression uses knowledge of + the layout of the string format, namely (nelem+1) + characters per string, followed by (nelem+1) + "undef" values. */ + this->value.data.strptr[row][0] = + theVar->value.data.strptr[0][elem+row]; + this->value.data.strptr[row][1] = 0; /* Null terminate */ + } + } else { + fferror("Index out of range"); + free( this->value.data.ptr ); + } + } + + } else { + + /* Reduce dimensions by 1, using a nonconstant expression */ + + for( row=0; rowvalue.undef[row] ) { + fferror("Null encountered as vector index"); + free( this->value.data.ptr ); + break; + } else + dimVals[0] = theDims[0]->value.data.lngptr[row]; + + if( dimVals[0] < 1 || + dimVals[0] > theVar->value.naxes[ theVar->value.naxis-1 ] ) { + fferror("Index out of range"); + free( this->value.data.ptr ); + } else if ( this->type == BITSTR || this->type == STRING ) { + elem = this->value.nelem * (dimVals[0]-1); + elem += row*(theVar->value.nelem+1); + if (this->value.undef) + this->value.undef[row] = theVar->value.undef[row]; + memcpy( (char*)this->value.data.strptr[0] + + row*sizeof(char)*(this->value.nelem+1), + (char*)theVar->value.data.strptr[0] + elem*sizeof(char), + this->value.nelem * sizeof(char) ); + /* Null terminate */ + this->value.data.strptr[row][this->value.nelem] = 0; + } else { + elem = this->value.nelem * (dimVals[0]-1); + elem += row*theVar->value.nelem; + memcpy( this->value.undef + row*this->value.nelem, + theVar->value.undef + elem, + this->value.nelem * sizeof(char) ); + memcpy( (char*)this->value.data.ptr + + row*dsize*this->value.nelem, + (char*)theVar->value.data.ptr + elem*dsize, + this->value.nelem * dsize ); + } + } + } + } + + if( theVar->operation>0 ) { + if (theVar->type == STRING || theVar->type == BITSTR) + free(theVar->value.data.strptr[0] ); + else + free( theVar->value.data.ptr ); + } + for( i=0; ioperation>0 ) { + free( theDims[i]->value.data.ptr ); + } +} + +static void Do_GTI( Node *this ) +{ + Node *theExpr, *theTimes; + double *start, *stop, *times; + long elem, nGTI, gti; + int ordered; + + theTimes = gParse.Nodes + this->SubNodes[0]; + theExpr = gParse.Nodes + this->SubNodes[1]; + + nGTI = theTimes->value.nelem; + start = theTimes->value.data.dblptr; + stop = theTimes->value.data.dblptr + nGTI; + ordered = theTimes->type; + + if( theExpr->operation==CONST_OP ) { + + this->value.data.log = + (Search_GTI( theExpr->value.data.dbl, nGTI, start, stop, ordered )>=0); + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + times = theExpr->value.data.dblptr; + if( !gParse.status ) { + + elem = gParse.nRows * this->value.nelem; + if( nGTI ) { + gti = -1; + while( elem-- ) { + if( (this->value.undef[elem] = theExpr->value.undef[elem]) ) + continue; + + /* Before searching entire GTI, check the GTI found last time */ + if( gti<0 || times[elem]stop[gti] ) { + gti = Search_GTI( times[elem], nGTI, start, stop, ordered ); + } + this->value.data.logptr[elem] = ( gti>=0 ); + } + } else + while( elem-- ) { + this->value.data.logptr[elem] = 0; + this->value.undef[elem] = 0; + } + } + } + + if( theExpr->operation>0 ) + free( theExpr->value.data.ptr ); +} + +static long Search_GTI( double evtTime, long nGTI, double *start, + double *stop, int ordered ) +{ + long gti, step; + + if( ordered && nGTI>15 ) { /* If time-ordered and lots of GTIs, */ + /* use "FAST" Binary search algorithm */ + if( evtTime>=start[0] && evtTime<=stop[nGTI-1] ) { + gti = step = (nGTI >> 1); + while(1) { + if( step>1L ) step >>= 1; + + if( evtTime>stop[gti] ) { + if( evtTime>=start[gti+1] ) + gti += step; + else { + gti = -1L; + break; + } + } else if( evtTime=start[gti] && evtTime<=stop[gti] ) + break; + } + return( gti ); +} + +static void Do_REG( Node *this ) +{ + Node *theRegion, *theX, *theY; + double Xval=0.0, Yval=0.0; + char Xnull=0, Ynull=0; + int Xvector, Yvector; + long nelem, elem, rows; + + theRegion = gParse.Nodes + this->SubNodes[0]; + theX = gParse.Nodes + this->SubNodes[1]; + theY = gParse.Nodes + this->SubNodes[2]; + + Xvector = ( theX->operation!=CONST_OP ); + if( Xvector ) + Xvector = theX->value.nelem; + else { + Xval = theX->value.data.dbl; + } + + Yvector = ( theY->operation!=CONST_OP ); + if( Yvector ) + Yvector = theY->value.nelem; + else { + Yval = theY->value.data.dbl; + } + + if( !Xvector && !Yvector ) { + + this->value.data.log = + ( fits_in_region( Xval, Yval, (SAORegion *)theRegion->value.data.ptr ) + != 0 ); + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + rows = gParse.nRows; + nelem = this->value.nelem; + elem = rows*nelem; + + while( rows-- ) { + while( nelem-- ) { + elem--; + + if( Xvector>1 ) { + Xval = theX->value.data.dblptr[elem]; + Xnull = theX->value.undef[elem]; + } else if( Xvector ) { + Xval = theX->value.data.dblptr[rows]; + Xnull = theX->value.undef[rows]; + } + + if( Yvector>1 ) { + Yval = theY->value.data.dblptr[elem]; + Ynull = theY->value.undef[elem]; + } else if( Yvector ) { + Yval = theY->value.data.dblptr[rows]; + Ynull = theY->value.undef[rows]; + } + + this->value.undef[elem] = ( Xnull || Ynull ); + if( this->value.undef[elem] ) + continue; + + this->value.data.logptr[elem] = + ( fits_in_region( Xval, Yval, + (SAORegion *)theRegion->value.data.ptr ) + != 0 ); + } + nelem = this->value.nelem; + } + } + } + + if( theX->operation>0 ) + free( theX->value.data.ptr ); + if( theY->operation>0 ) + free( theY->value.data.ptr ); +} + +static void Do_Vector( Node *this ) +{ + Node *that; + long row, elem, idx, jdx, offset=0; + int node; + + Allocate_Ptrs( this ); + + if( !gParse.status ) { + + for( node=0; nodenSubNodes; node++ ) { + + that = gParse.Nodes + this->SubNodes[node]; + + if( that->operation == CONST_OP ) { + + idx = gParse.nRows*this->value.nelem + offset; + while( (idx-=this->value.nelem)>=0 ) { + + this->value.undef[idx] = 0; + + switch( this->type ) { + case BOOLEAN: + this->value.data.logptr[idx] = that->value.data.log; + break; + case LONG: + this->value.data.lngptr[idx] = that->value.data.lng; + break; + case DOUBLE: + this->value.data.dblptr[idx] = that->value.data.dbl; + break; + } + } + + } else { + + row = gParse.nRows; + idx = row * that->value.nelem; + while( row-- ) { + elem = that->value.nelem; + jdx = row*this->value.nelem + offset; + while( elem-- ) { + this->value.undef[jdx+elem] = + that->value.undef[--idx]; + + switch( this->type ) { + case BOOLEAN: + this->value.data.logptr[jdx+elem] = + that->value.data.logptr[idx]; + break; + case LONG: + this->value.data.lngptr[jdx+elem] = + that->value.data.lngptr[idx]; + break; + case DOUBLE: + this->value.data.dblptr[jdx+elem] = + that->value.data.dblptr[idx]; + break; + } + } + } + } + offset += that->value.nelem; + } + + } + + for( node=0; node < this->nSubNodes; node++ ) + if( gParse.Nodes[this->SubNodes[node]].operation>0 ) + free( gParse.Nodes[this->SubNodes[node]].value.data.ptr ); +} + +/*****************************************************************************/ +/* Utility routines which perform the calculations on bits and SAO regions */ +/*****************************************************************************/ + +static char bitlgte(char *bits1, int oper, char *bits2) +{ + int val1, val2, nextbit; + char result; + int i, l1, l2, length, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bits1); + l2 = strlen(bits2); + if (l1 < l2) + { + length = l2; + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bits1++); + stream[i] = '\0'; + bits1 = stream; + } + else if (l2 < l1) + { + length = l1; + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bits2++); + stream[i] = '\0'; + bits2 = stream; + } + else + length = l1; + + val1 = val2 = 0; + nextbit = 1; + + while( length-- ) + { + chr1 = bits1[length]; + chr2 = bits2[length]; + if ((chr1 != 'x')&&(chr1 != 'X')&&(chr2 != 'x')&&(chr2 != 'X')) + { + if (chr1 == '1') val1 += nextbit; + if (chr2 == '1') val2 += nextbit; + nextbit *= 2; + } + } + result = 0; + switch (oper) + { + case LT: + if (val1 < val2) result = 1; + break; + case LTE: + if (val1 <= val2) result = 1; + break; + case GT: + if (val1 > val2) result = 1; + break; + case GTE: + if (val1 >= val2) result = 1; + break; + } + return (result); +} + +static void bitand(char *result,char *bitstrm1,char *bitstrm2) +{ + int i, l1, l2, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + if (l1 < l2) + { + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bitstrm1++); + stream[i] = '\0'; + bitstrm1 = stream; + } + else if (l2 < l1) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bitstrm2++); + stream[i] = '\0'; + bitstrm2 = stream; + } + while ( (chr1 = *(bitstrm1++)) ) + { + chr2 = *(bitstrm2++); + if ((chr1 == 'x') || (chr2 == 'x')) + *result = 'x'; + else if ((chr1 == '1') && (chr2 == '1')) + *result = '1'; + else + *result = '0'; + result++; + } + *result = '\0'; +} + +static void bitor(char *result,char *bitstrm1,char *bitstrm2) +{ + int i, l1, l2, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + if (l1 < l2) + { + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bitstrm1++); + stream[i] = '\0'; + bitstrm1 = stream; + } + else if (l2 < l1) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bitstrm2++); + stream[i] = '\0'; + bitstrm2 = stream; + } + while ( (chr1 = *(bitstrm1++)) ) + { + chr2 = *(bitstrm2++); + if ((chr1 == '1') || (chr2 == '1')) + *result = '1'; + else if ((chr1 == '0') || (chr2 == '0')) + *result = '0'; + else + *result = 'x'; + result++; + } + *result = '\0'; +} + +static void bitnot(char *result,char *bits) +{ + int length; + char chr; + + length = strlen(bits); + while( length-- ) { + chr = *(bits++); + *(result++) = ( chr=='1' ? '0' : ( chr=='0' ? '1' : chr ) ); + } + *result = '\0'; +} + +static char bitcmp(char *bitstrm1, char *bitstrm2) +{ + int i, l1, l2, ldiff; + char stream[256]; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + if (l1 < l2) + { + ldiff = l2 - l1; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l1-- ) stream[i++] = *(bitstrm1++); + stream[i] = '\0'; + bitstrm1 = stream; + } + else if (l2 < l1) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bitstrm2++); + stream[i] = '\0'; + bitstrm2 = stream; + } + while( (chr1 = *(bitstrm1++)) ) + { + chr2 = *(bitstrm2++); + if ( ((chr1 == '0') && (chr2 == '1')) + || ((chr1 == '1') && (chr2 == '0')) ) + return( 0 ); + } + return( 1 ); +} + +static char bnear(double x, double y, double tolerance) +{ + if (fabs(x - y) < tolerance) + return ( 1 ); + else + return ( 0 ); +} + +static char saobox(double xcen, double ycen, double xwid, double ywid, + double rot, double xcol, double ycol) +{ + double x,y,xprime,yprime,xmin,xmax,ymin,ymax,theta; + + theta = (rot / 180.0) * myPI; + xprime = xcol - xcen; + yprime = ycol - ycen; + x = xprime * cos(theta) + yprime * sin(theta); + y = -xprime * sin(theta) + yprime * cos(theta); + xmin = - 0.5 * xwid; xmax = 0.5 * xwid; + ymin = - 0.5 * ywid; ymax = 0.5 * ywid; + if ((x >= xmin) && (x <= xmax) && (y >= ymin) && (y <= ymax)) + return ( 1 ); + else + return ( 0 ); +} + +static char circle(double xcen, double ycen, double rad, + double xcol, double ycol) +{ + double r2,dx,dy,dlen; + + dx = xcol - xcen; + dy = ycol - ycen; + dx *= dx; dy *= dy; + dlen = dx + dy; + r2 = rad * rad; + if (dlen <= r2) + return ( 1 ); + else + return ( 0 ); +} + +static char ellipse(double xcen, double ycen, double xrad, double yrad, + double rot, double xcol, double ycol) +{ + double x,y,xprime,yprime,dx,dy,dlen,theta; + + theta = (rot / 180.0) * myPI; + xprime = xcol - xcen; + yprime = ycol - ycen; + x = xprime * cos(theta) + yprime * sin(theta); + y = -xprime * sin(theta) + yprime * cos(theta); + dx = x / xrad; dy = y / yrad; + dx *= dx; dy *= dy; + dlen = dx + dy; + if (dlen <= 1.0) + return ( 1 ); + else + return ( 0 ); +} + +static void fferror(char *s) +{ + char msg[80]; + + if( !gParse.status ) gParse.status = PARSE_SYNTAX_ERR; + + strncpy(msg, s, 80); + msg[79] = '\0'; + ffpmsg(msg); +} diff --git a/pkg/tbtables/cfitsio/f77.inc b/pkg/tbtables/cfitsio/f77.inc new file mode 100644 index 00000000..51e05e49 --- /dev/null +++ b/pkg/tbtables/cfitsio/f77.inc @@ -0,0 +1,31 @@ +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) + diff --git a/pkg/tbtables/cfitsio/f77_wrap.h b/pkg/tbtables/cfitsio/f77_wrap.h new file mode 100644 index 00000000..c197167d --- /dev/null +++ b/pkg/tbtables/cfitsio/f77_wrap.h @@ -0,0 +1,278 @@ +#define UNSIGNED_BYTE +#include "cfortran.h" + +/************************************************************************ + DEC C creates longs as 8-byte integers. On most other machines, ints + and longs are both 4-bytes, so both are compatible with Fortrans + default integer which is 4-bytes. To support DECs, we must redefine + LONGs and convert them to 8-bytes when going to C, and restore them + to 4-bytes when returning to Fortran. Ugh!!! +*************************************************************************/ + +#if defined(DECFortran) || (defined(__alpha) && defined(g77Fortran)) \ + || (defined(mipsFortran) && _MIPS_SZLONG==64) \ + || (defined(IBMR2Fortran) && defined(__64BIT__)) +#undef LONGV_cfSTR +#undef PLONG_cfSTR +#undef LONGVVVVVVV_cfTYPE +#undef PLONG_cfTYPE +#undef LONGV_cfT +#undef PLONG_cfT + +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LONGV,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLONG,A,B,C,D,E) +#define LONGVVVVVVV_cfTYPE int +#define PLONG_cfTYPE int +#define LONGV_cfQ(B) long *B, _(B,N); +#define PLONG_cfQ(B) long B; +#define LONGV_cfT(M,I,A,B,D) ( (_(B,N) = * _3(M,_LONGV_A,I)), \ + B = F2Clongv(_(B,N),A) ) +#define PLONG_cfT(M,I,A,B,D) ((B=*A),&B) +#define LONGV_cfR(A,B,D) C2Flongv(_(B,N),A,B); +#define PLONG_cfR(A,B,D) *A=B; +#define LONGV_cfH(S,U,B) +#define PLONG_cfH(S,U,B) + +static long *F2Clongv(long size, int *A) +{ + long i; + long *B; + + B=(long *)malloc( size*sizeof(long) ); + for(i=0;idsc$a_pointer + +/* We want single strings to be equivalent to string vectors with */ +/* a single element, so ignore the number of elements info in the */ +/* vector structure, and rely on the NUM_ELEM definitions. */ + +#undef STRINGV_cfT +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length, \ + num_elem(A->dsc$a_pointer, \ + A->dsc$w_length, \ + _3(M,_STRV_A,I) ) ) +#else +#ifdef CRAYFortran +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)_fcdtocp(A) +#else +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)A +#endif +#endif + +#define _cfMAX(A,B) ( (A>B) ? A : B ) +#define STRINGV_cfQ(B) char **B; unsigned int _(B,N), _(B,M); +#define STRINGV_cfR(A,B,D) free(B[0]); free(B); +#define TTSTR( A,B,D) \ + ((B=(char*)malloc(_cfMAX(D,gMinStrLen)+1))[D]='\0',memcpy(B,A,D), \ + kill_trailing(B,' ')) +#define TTTTSTRV( A,B,D,E) ( \ + _(B,N)=_cfMAX(E,1), \ + _(B,M)=_cfMAX(D,gMinStrLen)+1, \ + B=(char**)malloc(_(B,N)*sizeof(char*)), \ + B[0]=(char*)malloc(_(B,N)*_(B,M)), \ + vindex(B,_(B,M),_(B,N),f2cstrv2(A,B[0],D,_(B,M),_(B,N))) \ + ) +#define RRRRPSTRV(A,B,D) \ + c2fstrv2(B[0],A,_(B,M),D,_(B,N)), \ + free(B[0]), \ + free(B); + +static char **vindex(char **B, int elem_len, int nelem, char *B0) +{ + int i; + if( nelem ) + for( i=0;idsc$a_pointer)[0]) +#define BYTEV_cfT(M,I,A,B,D) (INTEGER_BYTE*)A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define BYTE_cfN(T,A) _fcd A +#define BYTEV_cfN(T,A) _fcd A +#define BYTE_cfT(M,I,A,B,D) (INTEGER_BYTE)((_fcdtocp(A))[0]) +#define BYTEV_cfT(M,I,A,B,D) (INTEGER_BYTE*)_fcdtocp(A) +#else +#define BYTE_cfN(T,A) INTEGER_BYTE * A +#define BYTEV_cfN(T,A) INTEGER_BYTE * A +#define BYTE_cfT(M,I,A,B,D) A[0] +#define BYTEV_cfT(M,I,A,B,D) A +#endif +#endif + +/************************************************************************ + The following definitions and functions handle conversions between + C and Fortran arrays of LOGICALS. Individually, LOGICALS are + treated as int's but as char's when in an array. cfortran defines + (F2C/C2F)LOGICALV but never uses them, so these routines also + handle TRUE/FALSE conversions. +*************************************************************************/ + +#undef LOGICALV_cfSTR +#undef LOGICALV_cfT +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICALV,A,B,C,D,E) +#define LOGICALV_cfQ(B) char *B; unsigned int _(B,N); +#define LOGICALV_cfT(M,I,A,B,D) (_(B,N)= * _3(M,_LOGV_A,I), \ + B=F2CcopyLogVect(_(B,N),A)) +#define LOGICALV_cfR(A,B,D) C2FcopyLogVect(_(B,N),A,B); +#define LOGICALV_cfH(S,U,B) + +static char *F2CcopyLogVect(long size, int *A) +{ + long i; + char *B; + + B=(char *)malloc(size*sizeof(char)); + for( i=0; i0 ) return; + for( i=50;i0 ) return; + if( unit == -1 ) { + int i; for( i=50; i=MAXFITSFILES ) { + *status = BAD_FILEPTR; + ffpmsg("Cfffiou was sent an unacceptable unit number."); + } else gFitsFiles[unit]=NULL; +} +FCALLSCSUB2(Cfffiou,FTFIOU,ftfiou,INT,PINT) + + +int CFits2Unit( fitsfile *fptr ); +int CFits2Unit( fitsfile *fptr ) + /* Utility routine to convert a fitspointer to a Fortran unit number */ + /* for use when a C program is calling a Fortran routine which could */ + /* in turn call CFITSIO... Modelled after code by Ning Gan. */ +{ + static fitsfile *last_fptr = (fitsfile *)NULL; /* Remember last fptr */ + static int last_unit = 0; /* Remember last unit */ + int status = 0; + + /* Test whether we are repeating the last lookup */ + + if( last_unit && fptr==gFitsFiles[last_unit] ) + return( last_unit ); + + /* Check if gFitsFiles has an entry for this fptr. */ + /* Allows Fortran to call C to call Fortran to */ + /* call CFITSIO... OUCH!!! */ + + last_fptr = fptr; + for( last_unit=1; last_unitFwork_fn(&a1,&a2,&a3,&a4,&n_cols,units,colnum,datatype, + iotype,repeat,&status,f->userData, + ptrs[ 0], ptrs[ 1], ptrs[ 2], ptrs[ 3], ptrs[ 4], + ptrs[ 5], ptrs[ 6], ptrs[ 7], ptrs[ 8], ptrs[ 9], + ptrs[10], ptrs[11], ptrs[12], ptrs[13], ptrs[14], + ptrs[15], ptrs[16], ptrs[17], ptrs[18], ptrs[19], + ptrs[20], ptrs[21], ptrs[22], ptrs[23], ptrs[24] ); + } + + /* Check whether there are any LOGICAL or STRING columns being outputted */ + nstr=0; + for( i=0;i +#include "fitsio.h" + +int main(int argc, char *argv[]) +{ + fitsfile *infptr, *outfptr; /* FITS file pointers defined in fitsio.h */ + int status = 0, ii = 1; /* status must always be initialized = 0 */ + + if (argc != 3) + { + printf("Usage: fitscopy inputfile outputfile\n"); + printf("\n"); + printf("Copy an input file to an output file, optionally filtering\n"); + printf("the file in the process. This seemingly simple program can\n"); + printf("apply powerful filters which transform the input file as\n"); + printf("it is being copied. Filters may be used to extract a\n"); + printf("subimage from a larger image, select rows from a table,\n"); + printf("filter a table with a GTI time extension or a SAO region file,\n"); + printf("create or delete columns in a table, create an image by\n"); + printf("binning (histogramming) 2 table columns, and convert IRAF\n"); + printf("format *.imh or raw binary data files into FITS images.\n"); + printf("See the CFITSIO User's Guide for a complete description of\n"); + printf("the Extended File Name filtering syntax.\n"); + printf("\n"); + printf("Examples:\n"); + printf("\n"); + printf("fitscopy in.fit out.fit (simple file copy)\n"); + printf("fitscopy - - (stdin to stdout)\n"); + printf("fitscopy in.fit[11:50,21:60] out.fit (copy a subimage)\n"); + printf("fitscopy iniraf.imh out.fit (IRAF image to FITS)\n"); + printf("fitscopy in.dat[i512,512] out.fit (raw array to FITS)\n"); + printf("fitscopy in.fit[events][pi>35] out.fit (copy rows with pi>35)\n"); + printf("fitscopy in.fit[events][bin X,Y] out.fit (bin an image) \n"); + printf("fitscopy in.fit[events][col x=.9*y] out.fit (new x column)\n"); + printf("fitscopy in.fit[events][gtifilter()] out.fit (time filter)\n"); + printf("fitscopy in.fit[2][regfilter(\"pow.reg\")] out.fit (spatial filter)\n"); + printf("\n"); + printf("Note that it may be necessary to enclose the input file name\n"); + printf("in single quote characters on the Unix command line.\n"); + return(0); + } + + /* Open the input file */ + if ( !fits_open_file(&infptr, argv[1], READONLY, &status) ) + { + /* Create the output file */ + if ( !fits_create_file(&outfptr, argv[2], &status) ) + { + /* Copy every HDU until we get an error */ + while( !fits_movabs_hdu(infptr, ii++, NULL, &status) ) + fits_copy_hdu(infptr, outfptr, 0, &status); + + /* Reset status after normal error */ + if (status == END_OF_FILE) status = 0; + + fits_close_file(outfptr, &status); + } + fits_close_file(infptr, &status); + } + + /* if error occured, print out error message */ + if (status) fits_report_error(stderr, status); + return(status); +} diff --git a/pkg/tbtables/cfitsio/fitscore.c b/pkg/tbtables/cfitsio/fitscore.c new file mode 100644 index 00000000..bc02077b --- /dev/null +++ b/pkg/tbtables/cfitsio/fitscore.c @@ -0,0 +1,7007 @@ +/* This file, fitscore.c, contains the core set of FITSIO routines. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ +/* + +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER." + +*/ + + +#include +#include +#include +#include +#include +#include +/* stddef.h is apparently needed to define size_t with some compilers ?? */ +#include +#include "fitsio2.h" + +#define errmsgsiz 25 +#define ESMARKER 27 /* Escape character is used as error stack marker */ + +#define DelAll 1 /* delete all messages on the error stack */ +#define DelMark 2 /* delete newest messages back to and including marker */ +#define DelNewest 3 /* delete the newest message from the stack */ +#define GetMesg 4 /* pop and return oldest message, ignoring marks */ +#define PutMesg 5 /* add a new message to the stack */ +#define PutMark 6 /* add a marker to the stack */ + +/*--------------------------------------------------------------------------*/ +float ffvers(float *version) /* IO - version number */ +/* + return the current version number of the FITSIO software +*/ +{ + *version = 2.51; + +/* 2 December 2004 + + + Previous releases: + *version = 2.50 28 July 2004 + *version = 2.49 11 Feb 2004 + *version = 2.48 28 Jan 2004 + *version = 2.470 18 Aug 2003 + *version = 2.460 20 May 2003 + *version = 2.450 30 Apr 2003 (internal release only) + *version = 2.440 8 Jan 2003 + *version = 2.430; 4 Nov 2002 + *version = 2.420; 19 Jul 2002 + *version = 2.410; 22 Apr 2002 used in ftools v5.2 + *version = 2.401; 28 Jan 2002 + *version = 2.400; 18 Jan 2002 + *version = 2.301; 7 Dec 2001 + *version = 2.300; 23 Oct 2001 + *version = 2.204; 26 Jul 2001 + *version = 2.203; 19 Jul 2001 used in ftools v5.1 + *version = 2.202; 22 May 2001 + *version = 2.201; 15 Mar 2001 + *version = 2.200; 26 Jan 2001 + *version = 2.100; 26 Sep 2000 + *version = 2.037; 6 Jul 2000 + *version = 2.036; 1 Feb 2000 + *version = 2.035; 7 Dec 1999 (internal release only) + *version = 2.034; 23 Nov 1999 + *version = 2.033; 17 Sep 1999 + *version = 2.032; 25 May 1999 + *version = 2.031; 31 Mar 1999 + *version = 2.030; 24 Feb 1999 + *version = 2.029; 11 Feb 1999 + *version = 2.028; 26 Jan 1999 + *version = 2.027; 12 Jan 1999 + *version = 2.026; 23 Dec 1998 + *version = 2.025; 1 Dec 1998 + *version = 2.024; 9 Nov 1998 + *version = 2.023; 1 Nov 1998 first full release of V2.0 + *version = 1.42; 30 Apr 1998 + *version = 1.40; 6 Feb 1998 + *version = 1.33; 16 Dec 1997 (internal release only) + *version = 1.32; 21 Nov 1997 (internal release only) + *version = 1.31; 4 Nov 1997 (internal release only) + *version = 1.30; 11 Sep 1997 + *version = 1.27; 3 Sep 1997 (internal release only) + *version = 1.25; 2 Jul 1997 + *version = 1.24; 2 May 1997 + *version = 1.23; 24 Apr 1997 + *version = 1.22; 18 Apr 1997 + *version = 1.21; 26 Mar 1997 + *version = 1.2; 29 Jan 1997 + *version = 1.11; 04 Dec 1996 + *version = 1.101; 13 Nov 1996 + *version = 1.1; 6 Nov 1996 + *version = 1.04; 17 Sep 1996 + *version = 1.03; 20 Aug 1996 + *version = 1.02; 15 Aug 1996 + *version = 1.01; 12 Aug 1996 +*/ + + return(*version); +} +/*--------------------------------------------------------------------------*/ +int ffflnm(fitsfile *fptr, /* I - FITS file pointer */ + char *filename, /* O - name of the file */ + int *status) /* IO - error status */ +/* + return the name of the FITS file +*/ +{ + strcpy(filename,(fptr->Fptr)->filename); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffflmd(fitsfile *fptr, /* I - FITS file pointer */ + int *filemode, /* O - open mode of the file */ + int *status) /* IO - error status */ +/* + return the access mode of the FITS file +*/ +{ + *filemode = (fptr->Fptr)->writemode; + return(*status); +} +/*--------------------------------------------------------------------------*/ +void ffgerr(int status, /* I - error status value */ + char *errtext) /* O - error message (max 30 char long + null) */ +/* + Return a short descriptive error message that corresponds to the input + error status value. The message may be up to 30 characters long, plus + the terminating null character. +*/ +{ + errtext[0] = '\0'; + + if (status >= 0 && status < 300) + { + switch (status) { + + case 0: + strcpy(errtext, "OK - no error"); + break; + case 1: + strcpy(errtext, "non-CFITSIO program error"); + break; + case 101: + strcpy(errtext, "same input and output files"); + break; + case 103: + strcpy(errtext, "attempt to open too many files"); + break; + case 104: + strcpy(errtext, "could not open the named file"); + break; + case 105: + strcpy(errtext, "couldn't create the named file"); + break; + case 106: + strcpy(errtext, "error writing to FITS file"); + break; + case 107: + strcpy(errtext, "tried to move past end of file"); + break; + case 108: + strcpy(errtext, "error reading from FITS file"); + break; + case 110: + strcpy(errtext, "could not close the file"); + break; + case 111: + strcpy(errtext, "array dimensions too big"); + break; + case 112: + strcpy(errtext, "cannot write to readonly file"); + break; + case 113: + strcpy(errtext, "could not allocate memory"); + break; + case 114: + strcpy(errtext, "invalid fitsfile pointer"); + break; + case 115: + strcpy(errtext, "NULL input pointer"); + break; + case 116: + strcpy(errtext, "error seeking file position"); + break; + case 121: + strcpy(errtext, "invalid URL prefix"); + break; + case 122: + strcpy(errtext, "too many I/O drivers"); + break; + case 123: + strcpy(errtext, "I/O driver init failed"); + break; + case 124: + strcpy(errtext, "no I/O driver for this URLtype"); + break; + case 125: + strcpy(errtext, "parse error in input file URL"); + break; + case 126: + strcpy(errtext, "parse error in range list"); + break; + case 151: + strcpy(errtext, "bad argument (shared mem drvr)"); + break; + case 152: + strcpy(errtext, "null ptr arg (shared mem drvr)"); + break; + case 153: + strcpy(errtext, "no free shared memory handles"); + break; + case 154: + strcpy(errtext, "share mem drvr not initialized"); + break; + case 155: + strcpy(errtext, "IPC system error (shared mem)"); + break; + case 156: + strcpy(errtext, "no memory (shared mem drvr)"); + break; + case 157: + strcpy(errtext, "share mem resource deadlock"); + break; + case 158: + strcpy(errtext, "lock file open/create failed"); + break; + case 159: + strcpy(errtext, "can't resize share mem block"); + break; + case 201: + strcpy(errtext, "header already has keywords"); + break; + case 202: + strcpy(errtext, "keyword not found in header"); + break; + case 203: + strcpy(errtext, "keyword number out of bounds"); + break; + case 204: + strcpy(errtext, "keyword value is undefined"); + break; + case 205: + strcpy(errtext, "string missing closing quote"); + break; + case 206: + strcpy(errtext, "error in indexed keyword name"); + break; + case 207: + strcpy(errtext, "illegal character in keyword"); + break; + case 208: + strcpy(errtext, "required keywords out of order"); + break; + case 209: + strcpy(errtext, "keyword value not positive int"); + break; + case 210: + strcpy(errtext, "END keyword not found"); + break; + case 211: + strcpy(errtext, "illegal BITPIX keyword value"); + break; + case 212: + strcpy(errtext, "illegal NAXIS keyword value"); + break; + case 213: + strcpy(errtext, "illegal NAXISn keyword value"); + break; + case 214: + strcpy(errtext, "illegal PCOUNT keyword value"); + break; + case 215: + strcpy(errtext, "illegal GCOUNT keyword value"); + break; + case 216: + strcpy(errtext, "illegal TFIELDS keyword value"); + break; + case 217: + strcpy(errtext, "negative table row size"); + break; + case 218: + strcpy(errtext, "negative number of rows"); + break; + case 219: + strcpy(errtext, "named column not found"); + break; + case 220: + strcpy(errtext, "illegal SIMPLE keyword value"); + break; + case 221: + strcpy(errtext, "first keyword not SIMPLE"); + break; + case 222: + strcpy(errtext, "second keyword not BITPIX"); + break; + case 223: + strcpy(errtext, "third keyword not NAXIS"); + break; + case 224: + strcpy(errtext, "missing NAXISn keywords"); + break; + case 225: + strcpy(errtext, "first keyword not XTENSION"); + break; + case 226: + strcpy(errtext, "CHDU not an ASCII table"); + break; + case 227: + strcpy(errtext, "CHDU not a binary table"); + break; + case 228: + strcpy(errtext, "PCOUNT keyword not found"); + break; + case 229: + strcpy(errtext, "GCOUNT keyword not found"); + break; + case 230: + strcpy(errtext, "TFIELDS keyword not found"); + break; + case 231: + strcpy(errtext, "missing TBCOLn keyword"); + break; + case 232: + strcpy(errtext, "missing TFORMn keyword"); + break; + case 233: + strcpy(errtext, "CHDU not an IMAGE extension"); + break; + case 234: + strcpy(errtext, "illegal TBCOLn keyword value"); + break; + case 235: + strcpy(errtext, "CHDU not a table extension"); + break; + case 236: + strcpy(errtext, "column exceeds width of table"); + break; + case 237: + strcpy(errtext, "more than 1 matching col. name"); + break; + case 241: + strcpy(errtext, "row width not = field widths"); + break; + case 251: + strcpy(errtext, "unknown FITS extension type"); + break; + case 252: + strcpy(errtext, "1st key not SIMPLE or XTENSION"); + break; + case 253: + strcpy(errtext, "END keyword is not blank"); + break; + case 254: + strcpy(errtext, "Header fill area not blank"); + break; + case 255: + strcpy(errtext, "Data fill area invalid"); + break; + case 261: + strcpy(errtext, "illegal TFORM format code"); + break; + case 262: + strcpy(errtext, "unknown TFORM datatype code"); + break; + case 263: + strcpy(errtext, "illegal TDIMn keyword value"); + break; + case 264: + strcpy(errtext, "invalid BINTABLE heap pointer"); + break; + default: + strcpy(errtext, "unknown error status"); + break; + } + } + else if (status < 600) + { + switch(status) { + + case 301: + strcpy(errtext, "illegal HDU number"); + break; + case 302: + strcpy(errtext, "column number < 1 or > tfields"); + break; + case 304: + strcpy(errtext, "negative byte address"); + break; + case 306: + strcpy(errtext, "negative number of elements"); + break; + case 307: + strcpy(errtext, "bad first row number"); + break; + case 308: + strcpy(errtext, "bad first element number"); + break; + case 309: + strcpy(errtext, "not an ASCII (A) column"); + break; + case 310: + strcpy(errtext, "not a logical (L) column"); + break; + case 311: + strcpy(errtext, "bad ASCII table datatype"); + break; + case 312: + strcpy(errtext, "bad binary table datatype"); + break; + case 314: + strcpy(errtext, "null value not defined"); + break; + case 317: + strcpy(errtext, "not a variable length column"); + break; + case 320: + strcpy(errtext, "illegal number of dimensions"); + break; + case 321: + strcpy(errtext, "1st pixel no. > last pixel no."); + break; + case 322: + strcpy(errtext, "BSCALE or TSCALn = 0."); + break; + case 323: + strcpy(errtext, "illegal axis length < 1"); + break; + case 340: + strcpy(errtext, "not group table"); + break; + case 341: + strcpy(errtext, "HDU already member of group"); + break; + case 342: + strcpy(errtext, "group member not found"); + break; + case 343: + strcpy(errtext, "group not found"); + break; + case 344: + strcpy(errtext, "bad group id"); + break; + case 345: + strcpy(errtext, "too many HDUs tracked"); + break; + case 346: + strcpy(errtext, "HDU alread tracked"); + break; + case 347: + strcpy(errtext, "bad Grouping option"); + break; + case 348: + strcpy(errtext, "identical pointers (groups)"); + break; + case 360: + strcpy(errtext, "malloc failed in parser"); + break; + case 361: + strcpy(errtext, "file read error in parser"); + break; + case 362: + strcpy(errtext, "null pointer arg (parser)"); + break; + case 363: + strcpy(errtext, "empty line (parser)"); + break; + case 364: + strcpy(errtext, "cannot unread > 1 line"); + break; + case 365: + strcpy(errtext, "parser too deeply nested"); + break; + case 366: + strcpy(errtext, "file open failed (parser)"); + break; + case 367: + strcpy(errtext, "hit EOF (parser)"); + break; + case 368: + strcpy(errtext, "bad argument (parser)"); + break; + case 369: + strcpy(errtext, "unexpected token (parser)"); + break; + case 401: + strcpy(errtext, "bad int to string conversion"); + break; + case 402: + strcpy(errtext, "bad float to string conversion"); + break; + case 403: + strcpy(errtext, "keyword value not integer"); + break; + case 404: + strcpy(errtext, "keyword value not logical"); + break; + case 405: + strcpy(errtext, "keyword value not floating pt"); + break; + case 406: + strcpy(errtext, "keyword value not double"); + break; + case 407: + strcpy(errtext, "bad string to int conversion"); + break; + case 408: + strcpy(errtext, "bad string to float conversion"); + break; + case 409: + strcpy(errtext, "bad string to double convert"); + break; + case 410: + strcpy(errtext, "illegal datatype code value"); + break; + case 411: + strcpy(errtext, "illegal no. of decimals"); + break; + case 412: + strcpy(errtext, "datatype conversion overflow"); + break; + case 413: + strcpy(errtext, "error compressing image"); + break; + case 414: + strcpy(errtext, "error uncompressing image"); + break; + case 420: + strcpy(errtext, "bad date or time conversion"); + break; + case 431: + strcpy(errtext, "syntax error in expression"); + break; + case 432: + strcpy(errtext, "expression result wrong type"); + break; + case 433: + strcpy(errtext, "vector result too large"); + break; + case 434: + strcpy(errtext, "missing output column"); + break; + case 435: + strcpy(errtext, "bad data in parsed column"); + break; + case 436: + strcpy(errtext, "output extension of wrong type"); + break; + case 501: + strcpy(errtext, "WCS angle too large"); + break; + case 502: + strcpy(errtext, "bad WCS coordinate"); + break; + case 503: + strcpy(errtext, "error in WCS calculation"); + break; + case 504: + strcpy(errtext, "bad WCS projection type"); + break; + case 505: + strcpy(errtext, "WCS keywords not found"); + break; + default: + strcpy(errtext, "unknown error status"); + break; + } + } + else + { + strcpy(errtext, "unknown error status"); + } + return; +} +/*--------------------------------------------------------------------------*/ +void ffpmsg(const char *err_message) +/* + put message on to error stack +*/ +{ + ffxmsg(PutMesg, (char *)err_message); + return; +} +/*--------------------------------------------------------------------------*/ +void ffpmrk(void) +/* + write a marker to the stack. It is then possible to pop only those + messages following the marker off of the stack, leaving the previous + messages unaffected. + + The marker is ignored by the ffgmsg routine. +*/ +{ + char *dummy = 0; + + ffxmsg(PutMark, dummy); + return; +} +/*--------------------------------------------------------------------------*/ +int ffgmsg(char *err_message) +/* + get oldest message from error stack, ignoring markers +*/ +{ + ffxmsg(GetMesg, err_message); + return(*err_message); +} +/*--------------------------------------------------------------------------*/ +void ffcmsg(void) +/* + erase all messages in the error stack +*/ +{ + char *dummy = 0; + + ffxmsg(DelAll, dummy); + return; +} +/*--------------------------------------------------------------------------*/ +void ffcmrk(void) +/* + erase newest messages in the error stack, stopping if a marker is found. + The marker is also erased in this case. +*/ +{ + char *dummy = 0; + + ffxmsg(DelMark, dummy); + return; +} +/*--------------------------------------------------------------------------*/ +void ffxmsg( int action, + char *errmsg) +/* + general routine to get, put, or clear the error message stack. + Use a static array rather than allocating memory as needed for + the error messages because it is likely to be more efficient + and simpler to implement. + + Action Code: +DelAll 1 delete all messages on the error stack +DelMark 2 delete messages back to and including the 1st marker +DelNewest 3 delete the newest message from the stack +GetMesg 4 pop and return oldest message, ignoring marks +PutMesg 5 add a new message to the stack +PutMark 6 add a marker to the stack + +*/ +{ + int ii; + char markflag; + static char *txtbuff[errmsgsiz], *tmpbuff, *msgptr; + static char errbuff[errmsgsiz][81]; /* initialize all = \0 */ + static int nummsg = 0; + + if (action == DelAll) /* clear the whole message stack */ + { + for (ii = 0; ii < nummsg; ii ++) + *txtbuff[ii] = '\0'; + + nummsg = 0; + } + else if (action == DelMark) /* clear up to and including first marker */ + { + while (nummsg > 0) { + nummsg--; + markflag = *txtbuff[nummsg]; /* store possible marker character */ + *txtbuff[nummsg] = '\0'; /* clear the buffer for this msg */ + + if (markflag == ESMARKER) + break; /* found a marker, so quit */ + } + } + else if (action == DelNewest) /* remove newest message from stack */ + { + if (nummsg > 0) + { + nummsg--; + *txtbuff[nummsg] = '\0'; /* clear the buffer for this msg */ + } + } + else if (action == GetMesg) /* pop and return oldest message from stack */ + { /* ignoring markers */ + while (nummsg > 0) + { + strcpy(errmsg, txtbuff[0]); /* copy oldest message to output */ + + *txtbuff[0] = '\0'; /* clear the buffer for this msg */ + + nummsg--; + for (ii = 0; ii < nummsg; ii++) + txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */ + + if (errmsg[0] != ESMARKER) /* quit if this is not a marker */ + return; + } + errmsg[0] = '\0'; /* no messages in the stack */ + } + else if (action == PutMesg) /* add new message to stack */ + { + msgptr = errmsg; + while (strlen(msgptr)) + { + if (nummsg == errmsgsiz) + { + tmpbuff = txtbuff[0]; /* buffers full; reuse oldest buffer */ + *txtbuff[0] = '\0'; /* clear the buffer for this msg */ + + nummsg--; + for (ii = 0; ii < nummsg; ii++) + txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */ + + txtbuff[nummsg] = tmpbuff; /* set pointer for the new message */ + } + else + { + for (ii = 0; ii < errmsgsiz; ii++) + { + if (*errbuff[ii] == '\0') /* find first empty buffer */ + { + txtbuff[nummsg] = errbuff[ii]; + break; + } + } + } + + strncat(txtbuff[nummsg], msgptr, 80); + nummsg++; + + msgptr += minvalue(80, strlen(msgptr)); + } + } + else if (action == PutMark) /* put a marker on the stack */ + { + if (nummsg == errmsgsiz) + { + tmpbuff = txtbuff[0]; /* buffers full; reuse oldest buffer */ + *txtbuff[0] = '\0'; /* clear the buffer for this msg */ + + nummsg--; + for (ii = 0; ii < nummsg; ii++) + txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */ + + txtbuff[nummsg] = tmpbuff; /* set pointer for the new message */ + } + else + { + for (ii = 0; ii < errmsgsiz; ii++) + { + if (*errbuff[ii] == '\0') /* find first empty buffer */ + { + txtbuff[nummsg] = errbuff[ii]; + break; + } + } + } + + *txtbuff[nummsg] = ESMARKER; /* write the marker */ + *(txtbuff[nummsg] + 1) = '\0'; + nummsg++; + + } + return; +} +/*--------------------------------------------------------------------------*/ +int ffpxsz(int datatype) +/* + return the number of bytes per pixel associated with the datatype +*/ +{ + if (datatype == TBYTE) + return(sizeof(char)); + else if (datatype == TUSHORT) + return(sizeof(short)); + else if (datatype == TSHORT) + return(sizeof(short)); + else if (datatype == TULONG) + return(sizeof(long)); + else if (datatype == TLONG) + return(sizeof(long)); + else if (datatype == TINT) + return(sizeof(int)); + else if (datatype == TUINT) + return(sizeof(int)); + else if (datatype == TFLOAT) + return(sizeof(float)); + else if (datatype == TDOUBLE) + return(sizeof(double)); + else if (datatype == TLOGICAL) + return(sizeof(char)); + else + return(0); +} +/*--------------------------------------------------------------------------*/ +int fftkey(char *keyword, /* I - keyword name */ + int *status) /* IO - error status */ +/* + Test that the keyword name conforms to the FITS standard. Must contain + only capital letters, digits, minus or underscore chars. Trailing spaces + are allowed. If the input status value is less than zero, then the test + is modified so that upper or lower case letters are allowed, and no + error messages are printed if the keyword is not legal. +*/ +{ + size_t maxchr, ii; + int spaces=0; + char msg[81], testchar; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + maxchr=strlen(keyword); + if (maxchr > 8) + maxchr = 8; + + for (ii = 0; ii < maxchr; ii++) + { + if (*status == 0) + testchar = keyword[ii]; + else + testchar = toupper(keyword[ii]); + + if ( (testchar >= 'A' && testchar <= 'Z') || + (testchar >= '0' && testchar <= '9') || + testchar == '-' || testchar == '_' ) + { + if (spaces) + { + if (*status == 0) + { + /* don't print error message if status < 0 */ + sprintf(msg, + "Keyword name contains embedded space(s): %.8s", + keyword); + ffpmsg(msg); + } + return(*status = BAD_KEYCHAR); + } + } + else if (keyword[ii] == ' ') + spaces = 1; + + else + { + if (*status == 0) + { + /* don't print error message if status < 0 */ + sprintf(msg, "Character %d in this keyword is illegal: %.8s", + (int) (ii+1), keyword); + ffpmsg(msg); + + /* explicitly flag the 2 most common cases */ + if (keyword[ii] == 0) + ffpmsg(" (This a NULL (0) character)."); + else if (keyword[ii] == 9) + ffpmsg(" (This an ASCII TAB (9) character)."); + } + + return(*status = BAD_KEYCHAR); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftrec(char *card, /* I - keyword card to test */ + int *status) /* IO - error status */ +/* + Test that the keyword card conforms to the FITS standard. Must contain + only printable ASCII characters; +*/ +{ + size_t ii, maxchr; + char msg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + maxchr = strlen(card); + + for (ii = 8; ii < maxchr; ii++) + { + if (card[ii] < 32 || card[ii] > 126) + { + sprintf(msg, + "Character %d in this keyword is illegal. Hex Value = %X", + (int) (ii+1), (int) card[ii] ); + ffpmsg(msg); + + strncpy(msg, card, 80); + msg[80] = '\0'; + ffpmsg(msg); + return(*status = BAD_KEYCHAR); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +void ffupch(char *string) +/* + convert string to upper case, in place. +*/ +{ + size_t len, ii; + + len = strlen(string); + for (ii = 0; ii < len; ii++) + string[ii] = toupper(string[ii]); + return; +} +/*--------------------------------------------------------------------------*/ +int ffmkky(char *keyname, /* I - keyword name */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + char *card, /* O - constructed keyword card */ + int *status) /* IO - status value */ +/* + Make a complete FITS 80-byte keyword card from the input name, value and + comment strings. Output card is null terminated without any trailing blanks. +*/ +{ + size_t namelen, len, ii; + char tmpname[FLEN_KEYWORD], *cptr; + int tstatus = -1; + + if (*status > 0) + return(*status); + + *tmpname = '\0'; + *card = '\0'; + + cptr = keyname; + while(*cptr == ' ') /* skip leading blanks in the name */ + cptr++; + + strncat(tmpname, cptr, FLEN_KEYWORD - 1); + + namelen = strlen(tmpname); + if (namelen) + { + cptr = tmpname + namelen - 1; + + while(*cptr == ' ') /* skip trailing blanks */ + { + *cptr = '\0'; + cptr--; + } + + namelen = cptr - tmpname + 1; + } + + if (namelen <= 8 && (fftkey(keyname, &tstatus) <= 0) ) + { + /* a normal FITS keyword */ + strcat(card, tmpname); /* copy keyword name to buffer */ + + for (ii = namelen; ii < 8; ii++) + card[ii] = ' '; /* pad keyword name with spaces */ + + card[8] = '='; /* append '= ' in columns 9-10 */ + card[9] = ' '; + card[10] = '\0'; /* terminate the partial string */ + namelen = 10; + } + else + { + /* use the ESO HIERARCH convention for longer keyword names */ + + /* check that the name does not contain an '=' (equals sign) */ + if (strchr(tmpname, '=') ) + { + ffpmsg("Illegal keyword name; contains an equals sign (=)"); + ffpmsg(tmpname); + return(*status = BAD_KEYCHAR); + } + + /* Don't repeat HIERARCH if the keyword already contains it */ + if (FSTRNCMP(tmpname, "HIERARCH ", 9) && + FSTRNCMP(tmpname, "hierarch ", 9)) + strcat(card, "HIERARCH "); + else + namelen -= 9; /* deleted the string 'HIERARCH ' */ + + strcat(card, tmpname); + strcat(card, " = "); + namelen += 12; + } + + len = strlen(value); + if (len > 0) + { + if (value[0] == '\'') /* is this a quoted string value? */ + { + if (namelen > 77) + { + ffpmsg( + "The following keyword + value is too long to fit on a card:"); + ffpmsg(keyname); + ffpmsg(value); + return(*status = BAD_KEYCHAR); + } + + strncat(card, value, 80 - namelen); /* append the value string */ + len = minvalue(80, namelen + len); + + /* restore the closing quote if it got truncated */ + if (len == 80) + { + card[79] = '\''; + } + + if (comm) + { + if (comm[0] != 0) + { + if (len < 30) + { + for (ii = len; ii < 30; ii++) + card[ii] = ' '; /* fill with spaces to col 30 */ + + card[30] = '\0'; + len = 30; + } + } + } + } + else + { + if (namelen + len > 80) + { + ffpmsg( + "The following keyword + value is too long to fit on a card:"); + ffpmsg(keyname); + ffpmsg(value); + return(*status = BAD_KEYCHAR); + } + else if (namelen + len < 30) + { + /* add spaces so field ends at least in col 30 */ + strncat(card, " ", 30 - (namelen + len)); + } + + strncat(card, value, 80 - namelen); /* append the value string */ + len = minvalue(80, namelen + len); + len = maxvalue(30, len); + } + + if (comm) + { + if ((len < 77) && ( strlen(comm) > 0) ) /* room for a comment? */ + { + strcat(card, " / "); /* append comment separator */ + strncat(card, comm, 77 - len); /* append comment (what fits) */ + } + } + } + else + { + if (namelen == 10) /* This case applies to normal keywords only */ + { + card[8] = ' '; /* keywords with no value have no '=' */ + if (comm) + { + strncat(card, comm, 80 - namelen); /* append comment (what fits) */ + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkey(fitsfile *fptr, /* I - FITS file pointer */ + char *card, /* I - card string value */ + int *status) /* IO - error status */ +/* + replace the previously read card (i.e. starting 80 bytes before the + (fptr->Fptr)->nextkey position) with the contents of the input card. +*/ +{ + char tcard[81]; + size_t len, ii; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + strncpy(tcard,card,80); + tcard[80] = '\0'; + + len = strlen(tcard); + for (ii=len; ii < 80; ii++) /* fill card with spaces if necessary */ + tcard[ii] = ' '; + + for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */ + tcard[ii] = toupper(tcard[ii]); + + fftkey(tcard, status); /* test keyword name contains legal chars */ + fftrec(tcard, status); /* test rest of keyword for legal chars */ + + /* move position of keyword to be over written */ + ffmbyt(fptr, ((fptr->Fptr)->nextkey) - 80, REPORT_EOF, status); + ffpbyt(fptr, 80, tcard, status); /* write the 80 byte card */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffkeyn(char *keyroot, /* I - root string for keyword name */ + int value, /* I - index number to be appended to root name */ + char *keyname, /* O - output root + index keyword name */ + int *status) /* IO - error status */ +/* + Construct a keyword name string by appending the index number to the root. + e.g., if root = "TTYPE" and value = 12 then keyname = "TTYPE12". +*/ +{ + char suffix[16]; + size_t rootlen; + + keyname[0] = '\0'; /* initialize output name to null */ + rootlen = strlen(keyroot); + + if (rootlen == 0 || rootlen > 7 || value < 0 ) + return(*status = 206); + + sprintf(suffix, "%d", value); /* construct keyword suffix */ + + if ( strlen(suffix) + rootlen > 8) + return(*status = 206); + + strcpy(keyname, keyroot); /* copy root string to name string */ + strcat(keyname, suffix); /* append suffix to the root */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffnkey(int value, /* I - index number to be appended to root name */ + char *keyroot, /* I - root string for keyword name */ + char *keyname, /* O - output root + index keyword name */ + int *status) /* IO - error status */ +/* + Construct a keyword name string by appending the root string to the index + number. e.g., if root = "TTYPE" and value = 12 then keyname = "12TTYPE". +*/ +{ + size_t rootlen; + + keyname[0] = '\0'; /* initialize output name to null */ + rootlen = strlen(keyroot); + + if (rootlen == 0 || rootlen > 7 || value < 0 ) + return(*status = 206); + + sprintf(keyname, "%d", value); /* construct keyword prefix */ + + if (rootlen + strlen(keyname) > 8) + return(*status = 206); + + strcat(keyname, keyroot); /* append root to the prefix */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpsvc(char *card, /* I - FITS header card (nominally 80 bytes long) */ + char *value, /* O - value string parsed from the card */ + char *comm, /* O - comment string parsed from the card */ + int *status) /* IO - error status */ +/* + ParSe the Value and Comment strings from the input header card string. + If the card contains a quoted string value, the returned value string + includes the enclosing quote characters. If comm = NULL, don't return + the comment string. +*/ +{ + int jj; + size_t ii, cardlen, nblank, valpos; + + if (*status > 0) + return(*status); + + value[0] = '\0'; + if (comm) + comm[0] = '\0'; + + cardlen = strlen(card); + + /* support for ESO HIERARCH keywords; find the '=' */ + if (FSTRNCMP(card, "HIERARCH ", 9) == 0) + { + valpos = strcspn(card, "="); + + if (valpos == cardlen) /* no value indicator ??? */ + { + if (comm != NULL) + { + if (cardlen > 8) + { + strcpy(comm, &card[8]); + + jj=cardlen - 8; + for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */ + { + if (comm[jj] == ' ') + comm[jj] = '\0'; + else + break; + } + } + } + return(*status); /* no value indicator */ + } + valpos++; /* point to the position after the '=' */ + } + else if (cardlen < 9 || + FSTRNCMP(card, "COMMENT ", 8) == 0 || /* keywords with no value */ + FSTRNCMP(card, "HISTORY ", 8) == 0 || + FSTRNCMP(card, "END ", 8) == 0 || + FSTRNCMP(card, " ", 8) == 0 || + FSTRNCMP(&card[8], "= ", 2) != 0 ) /* no '= ' in cols 9-10 */ + { + /* no value, so the comment extends from cols 9 - 80 */ + if (comm != NULL) + { + if (cardlen > 8) + { + strcpy(comm, &card[8]); + + jj=cardlen - 8; + for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */ + { + if (comm[jj] == ' ') + comm[jj] = '\0'; + else + break; + } + } + } + return(*status); + } + else + { + valpos = 10; /* starting position of the value field */ + } + + nblank = strspn(&card[valpos], " "); /* find number of leading blanks */ + + if (nblank + valpos == cardlen) + { + /* the absence of a value string is legal, and simply indicates + that the keyword value is undefined. Don't write an error + message in this case. + */ + return(*status); + } + + ii = valpos + nblank; + + if (card[ii] == '/' ) /* slash indicates start of the comment */ + { + ii++; + } + else if (card[ii] == '\'' ) /* is this a quoted string value? */ + { + value[0] = card[ii]; + for (jj=1, ii++; ii < cardlen; ii++, jj++) + { + if (card[ii] == '\'') /* is this the closing quote? */ + { + if (card[ii+1] == '\'') /* 2 successive quotes? */ + { + value[jj] = card[ii]; + ii++; + jj++; + } + else + { + value[jj] = card[ii]; + break; /* found the closing quote, so exit this loop */ + } + } + value[jj] = card[ii]; /* copy the next character to the output */ + } + + if (ii == cardlen) + { + value[jj] = '\0'; /* terminate the bad value string */ + ffpmsg("This keyword string value has no closing quote:"); + ffpmsg(card); + return(*status = NO_QUOTE); + } + else + { + value[jj+1] = '\0'; /* terminate the good value string */ + ii++; /* point to the character following the value */ + } + } + else if (card[ii] == '(' ) /* is this a complex value? */ + { + nblank = strcspn(&card[ii], ")" ); /* find closing ) */ + if (nblank == strlen( &card[ii] ) ) + { + ffpmsg("This complex keyword value has no closing ')':"); + ffpmsg(card); + return(*status = NO_QUOTE); + } + + nblank++; + strncpy(value, &card[ii], nblank); + value[nblank] = '\0'; + ii = ii + nblank; + } + else /* an integer, floating point, or logical FITS value string */ + { + nblank = strcspn(&card[ii], " /"); /* find the end of the token */ + strncpy(value, &card[ii], nblank); + value[nblank] = '\0'; + ii = ii + nblank; + } + + /* now find the comment string, if any */ + if (comm) + { + nblank = strspn(&card[ii], " "); /* find next non-space character */ + ii = ii + nblank; + + if (ii < 80) + { + if (card[ii] == '/') /* ignore the slash separator */ + { + ii++; + if (card[ii] == ' ') /* also ignore the following space */ + ii++; + } + strcat(comm, &card[ii]); /* copy the remaining characters */ + + jj=strlen(comm); + for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */ + { + if (comm[jj] == ' ') + comm[jj] = '\0'; + else + break; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgthd(char *tmplt, /* I - input header template string */ + char *card, /* O - returned FITS header record */ + int *hdtype, /* O - how to interpreter the returned card string */ + /* + -2 = modify the name of a keyword; the old keyword name + is returned starting at address chars[0]; the new name + is returned starting at address char[40] (to be consistent + with the Fortran version). Both names are null terminated. + -1 = card contains the name of a keyword that is to be deleted + 0 = append this keyword if it doesn't already exist, or + modify the value if the keyword already exists. + 1 = append this comment keyword ('HISTORY', + 'COMMENT', or blank keyword name) + 2 = this is the END keyword; do not write it to the header + */ + int *status) /* IO - error status */ +/* + 'Get Template HeaDer' + parse a template header line and create a formated + character string which is suitable for appending to a FITS header +*/ +{ + char keyname[FLEN_KEYWORD], value[FLEN_VALUE], comment[FLEN_COMMENT]; + char *tok, *suffix, *loc, tvalue[FLEN_VALUE]; + int len, vlen, more, tstatus; + double dval; + + if (*status > 0) + return(*status); + + card[0] = '\0'; + *hdtype = 0; + + if (!FSTRNCMP(tmplt, " ", 8) ) + { + /* if first 8 chars of template are blank, then this is a comment */ + strncat(card, tmplt, 80); + *hdtype = 1; + return(*status); + } + + tok = tmplt; /* point to start of template string */ + + keyname[0] = '\0'; + value[0] = '\0'; + comment[0] = '\0'; + + len = strspn(tok, " "); /* no. of spaces before keyword */ + tok += len; + + if (tok[0] == '-') /* is there a leading minus sign? */ + { + /* first token is name of keyword to be deleted or renamed */ + *hdtype = -1; + tok++; + len = strspn(tok, " "); /* no. of spaces before keyword */ + tok += len; + if (len < 8) /* not a blank name? */ + { + len = strcspn(tok, " ="); /* length of name */ + if (len >= FLEN_KEYWORD) + return(*status = BAD_KEYCHAR); + + strncat(card, tok, len); + + /* + The HIERARCH convention supports non-standard characters + in the keyword name, so don't always convert to upper case or + abort if there are illegal characters in the name or if the + name is greater than 8 characters long. + */ + + if (len < 9) /* this is possibly a normal FITS keyword name */ + { + ffupch(card); + tstatus = 0; + if (fftkey(card, &tstatus) > 0) + { + /* name contained non-standard characters, so reset */ + card[0] = '\0'; + strncat(card, tok, len); + } + } + + tok += len; + } + + /* second token, if present, is the new name for the keyword */ + + len = strspn(tok, " "); /* no. of spaces before next token */ + tok += len; + + if (tok[0] == '\0' || tok[0] == '=') + return(*status); /* no second token */ + + *hdtype = -2; + len = strcspn(tok, " "); /* length of new name */ + if (len > 40) /* name has to fit on columns 41-80 of card */ + return(*status = BAD_KEYCHAR); + + /* copy the new name to card + 40; This is awkward, */ + /* but is consistent with the way the Fortran FITSIO works */ + strcat(card," "); + strncpy(&card[40], tok, len+1); /* copy len+1 to get terminator */ + + /* + The HIERARCH convention supports non-standard characters + in the keyword name, so don't always convert to upper case or + abort if there are illegal characters in the name or if the + name is greater than 8 characters long. + */ + + if (len < 9) /* this is possibly a normal FITS keyword name */ + { + ffupch(&card[40]); + tstatus = 0; + if (fftkey(&card[40], &tstatus) > 0) + { + /* name contained non-standard characters, so reset */ + strncpy(&card[40], tok, len); + } + } + } + else /* no negative sign at beginning of template */ + { + /* get the keyword name token */ + + len = strcspn(tok, " ="); /* length of keyword name */ + if (len >= FLEN_KEYWORD) + return(*status = BAD_KEYCHAR); + + strncat(keyname, tok, len); + + /* + The HIERARCH convention supports non-standard characters + in the keyword name, so don't always convert to upper case or + abort if there are illegal characters in the name or if the + name is greater than 8 characters long. + */ + + if (len < 9) /* this is possibly a normal FITS keyword name */ + { + ffupch(keyname); + tstatus = 0; + if (fftkey(keyname, &tstatus) > 0) + { + /* name contained non-standard characters, so reset */ + keyname[0] = '\0'; + strncat(keyname, tok, len); + } + } + + if (!FSTRCMP(keyname, "END") ) + { + strcpy(card, "END"); + *hdtype = 2; + return(*status); + } + + tok += len; /* move token pointer to end of the keyword */ + + if (!FSTRCMP(keyname, "COMMENT") || !FSTRCMP(keyname, "HISTORY") + || !FSTRCMP(keyname, "HIERARCH") ) + { + *hdtype = 1; /* simply append COMMENT and HISTORY keywords */ + strcpy(card, keyname); + strncat(card, tok, 73); + return(*status); + } + + /* look for the value token */ + len = strspn(tok, " ="); /* spaces or = between name and value */ + tok += len; + + if (*tok == '\'') /* is value enclosed in quotes? */ + { + more = TRUE; + while (more) + { + tok++; /* temporarily move past the quote char */ + len = strcspn(tok, "'"); /* length of quoted string */ + tok--; + strncat(value, tok, len + 2); + + tok += len + 1; + if (tok[0] != '\'') /* check there is a closing quote */ + return(*status = NO_QUOTE); + + tok++; + if (tok[0] != '\'') /* 2 quote chars = literal quote */ + more = FALSE; + } + } + else if (*tok == '/' || *tok == '\0') /* There is no value */ + { + strcat(value, " "); + } + else /* not a quoted string value */ + { + len = strcspn(tok, " /"); /* length of value string */ + + strncat(value, tok, len); + if (!( (tok[0] == 'T' || tok[0] == 'F') && + (tok[1] == ' ' || tok[1] == '/' || tok[1] == '\0') )) + { + /* not a logical value */ + + dval = strtod(value, &suffix); /* try to read value as number */ + + if (*suffix != '\0' && *suffix != ' ' && *suffix != '/') + { + /* value not recognized as a number; might be because it */ + /* contains a 'd' or 'D' exponent character */ + strcpy(tvalue, value); + loc = strchr(tvalue, 'D'); + if (loc) + { + *loc = 'E'; /* replace D's with E's. */ + dval = strtod(tvalue, &suffix); /* read value again */ + } + else + { + loc = strchr(tvalue, 'd'); + if (loc) + { + *loc = 'E'; /* replace d's with E's. */ + dval = strtod(tvalue, &suffix); /* read value again */ + } + } + } + + if (*suffix != '\0' && *suffix != ' ' && *suffix != '/') + { + /* value is not a number; must enclose it in quotes */ + strcpy(value, "'"); + strncat(value, tok, len); + strcat(value, "'"); + + /* the following useless statement stops the compiler warning */ + /* that dval is not used anywhere */ + if (dval == 0.) + len += (int) dval; + } + else + { + /* value is a number; convert any 'e' to 'E', or 'd' to 'D' */ + loc = strchr(value, 'e'); + if (loc) + { + *loc = 'E'; + } + else + { + loc = strchr(value, 'd'); + if (loc) + { + *loc = 'D'; + } + } + } + } + tok += len; + } + + len = strspn(tok, " /"); /* no. of spaces between value and comment */ + tok += len; + + vlen = strlen(value); + if (vlen > 0 && vlen < 10 && value[0] == '\'') + { + /* pad quoted string with blanks so it is at least 8 chars long */ + value[vlen-1] = '\0'; + strncat(value, " ", 10 - vlen); + strcat(&value[9], "'"); + } + + /* get the comment string */ + strncat(comment, tok, 70); + + /* construct the complete FITS header card */ + ffmkky(keyname, value, comment, card, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffasfm(char *tform, /* I - format code from the TFORMn keyword */ + int *dtcode, /* O - numerical datatype code */ + long *twidth, /* O - width of the field, in chars */ + int *decimals, /* O - number of decimal places (F, E, D format) */ + int *status) /* IO - error status */ +{ +/* + parse the ASCII table TFORM column format to determine the data + type, the field width, and number of decimal places (if relevant) +*/ + int ii, datacode; + long longval, width; + float fwidth; + char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + if (dtcode) + *dtcode = 0; + + if (twidth) + *twidth = 0; + + if (decimals) + *decimals = 0; + + ii = 0; + while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */ + ii++; + + strcpy(temp, &tform[ii]); /* copy format string */ + ffupch(temp); /* make sure it is in upper case */ + form = temp; /* point to start of format string */ + + + if (form[0] == 0) + { + ffpmsg("Error: ASCII table TFORM code is blank"); + return(*status = BAD_TFORM); + } + + /*-----------------------------------------------*/ + /* determine default datatype code */ + /*-----------------------------------------------*/ + if (form[0] == 'A') + datacode = TSTRING; + else if (form[0] == 'I') + datacode = TLONG; + else if (form[0] == 'F') + datacode = TFLOAT; + else if (form[0] == 'E') + datacode = TFLOAT; + else if (form[0] == 'D') + datacode = TDOUBLE; + else + { + sprintf(message, + "Illegal ASCII table TFORMn datatype: \'%s\'", tform); + ffpmsg(message); + return(*status = BAD_TFORM_DTYPE); + } + + if (dtcode) + *dtcode = datacode; + + form++; /* point to the start of field width */ + + if (datacode == TSTRING || datacode == TLONG) + { + /*-----------------------------------------------*/ + /* A or I data formats: */ + /*-----------------------------------------------*/ + + if (ffc2ii(form, &width, status) <= 0) /* read the width field */ + { + if (width <= 0) + { + width = 0; + *status = BAD_TFORM; + } + else + { + /* set to shorter precision if I4 or less */ + if (width <= 4 && datacode == TLONG) + datacode = TSHORT; + } + } + } + else + { + /*-----------------------------------------------*/ + /* F, E or D data formats: */ + /*-----------------------------------------------*/ + + if (ffc2rr(form, &fwidth, status) <= 0) /* read ww.dd width field */ + { + if (fwidth <= 0.) + *status = BAD_TFORM; + else + { + width = (long) fwidth; /* convert from float to long */ + + if (width > 7 && *temp == 'F') + datacode = TDOUBLE; /* type double if >7 digits */ + + if (width < 10) + form = form + 1; /* skip 1 digit */ + else + form = form + 2; /* skip 2 digits */ + + if (form[0] == '.') /* should be a decimal point here */ + { + form++; /* point to start of decimals field */ + + if (ffc2ii(form, &longval, status) <= 0) /* read decimals */ + { + if (decimals) + *decimals = longval; /* long to short convertion */ + + if (longval >= width) /* width < no. of decimals */ + *status = BAD_TFORM; + + if (longval > 6 && *temp == 'E') + datacode = TDOUBLE; /* type double if >6 digits */ + } + } + + } + } + } + if (*status > 0) + { + *status = BAD_TFORM; + sprintf(message,"Illegal ASCII table TFORMn code: \'%s\'", tform); + ffpmsg(message); + } + + if (dtcode) + *dtcode = datacode; + + if (twidth) + *twidth = width; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffbnfm(char *tform, /* I - format code from the TFORMn keyword */ + int *dtcode, /* O - numerical datatype code */ + long *trepeat, /* O - repeat count of the field */ + long *twidth, /* O - width of the field, in chars */ + int *status) /* IO - error status */ +{ +/* + parse the binary table TFORM column format to determine the data + type, repeat count, and the field width (if it is an ASCII (A) field) +*/ + size_t ii, nchar; + int datacode, variable, iread; + long width, repeat; + char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + if (dtcode) + *dtcode = 0; + + if (trepeat) + *trepeat = 0; + + if (twidth) + *twidth = 0; + + nchar = strlen(tform); + + for (ii = 0; ii < nchar; ii++) + { + if (tform[ii] != ' ') /* find first non-space char */ + break; + } + + if (ii == nchar) + { + ffpmsg("Error: binary table TFORM code is blank (ffbnfm)."); + return(*status = BAD_TFORM); + } + + strcpy(temp, &tform[ii]); /* copy format string */ + ffupch(temp); /* make sure it is in upper case */ + form = temp; /* point to start of format string */ + + /*-----------------------------------------------*/ + /* get the repeat count */ + /*-----------------------------------------------*/ + + ii = 0; + while(isdigit((int) form[ii])) + ii++; /* look for leading digits in the field */ + + if (ii == 0) + repeat = 1; /* no explicit repeat count */ + else + sscanf(form,"%ld", &repeat); /* read repeat count */ + + /*-----------------------------------------------*/ + /* determine datatype code */ + /*-----------------------------------------------*/ + + form = form + ii; /* skip over the repeat field */ + + if (form[0] == 'P') + { + variable = 1; /* this is a variable length column */ + repeat = 1; /* disregard any other repeat value */ + form++; /* move to the next data type code char */ + } + else + variable = 0; + + if (form[0] == 'U') /* internal code to signify unsigned integer */ + { + datacode = TUSHORT; + width = 2; + } + else if (form[0] == 'I') + { + datacode = TSHORT; + width = 2; + } + else if (form[0] == 'V') /* internal code to signify unsigned integer */ + { + datacode = TULONG; + width = 4; + } + else if (form[0] == 'J') + { + datacode = TLONG; + width = 4; + } + else if (form[0] == 'K') + { + datacode = TLONGLONG; + width = 8; + } + else if (form[0] == 'E') + { + datacode = TFLOAT; + width = 4; + } + else if (form[0] == 'D') + { + datacode = TDOUBLE; + width = 8; + } + else if (form[0] == 'A') + { + datacode = TSTRING; + + /* + the following code is used to support the non-standard + datatype of the form rAw where r = total width of the field + and w = width of fixed-length substrings within the field. + */ + iread = 0; + if (form[1] != 0) + { + if (form[1] == '(' ) /* skip parenthesis around */ + form++; /* variable length column width */ + + iread = sscanf(&form[1],"%ld", &width); + } + + if (iread != 1 || (!variable && (width > repeat)) ) + width = repeat; + + } + else if (form[0] == 'L') + { + datacode = TLOGICAL; + width = 1; + } + else if (form[0] == 'X') + { + datacode = TBIT; + width = 1; + } + else if (form[0] == 'B') + { + datacode = TBYTE; + width = 1; + } + else if (form[0] == 'S') /* internal code to signify signed byte */ + { + datacode = TSBYTE; + width = 1; + } + else if (form[0] == 'C') + { + datacode = TCOMPLEX; + width = 8; + } + else if (form[0] == 'M') + { + datacode = TDBLCOMPLEX; + width = 16; + } + else + { + sprintf(message, + "Illegal binary table TFORMn datatype: \'%s\' ", tform); + ffpmsg(message); + return(*status = BAD_TFORM_DTYPE); + } + + if (variable) + datacode = datacode * (-1); /* flag variable cols w/ neg type code */ + + if (dtcode) + *dtcode = datacode; + + if (trepeat) + *trepeat = repeat; + + if (twidth) + *twidth = width; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +void ffcfmt(char *tform, /* value of an ASCII table TFORMn keyword */ + char *cform) /* equivalent format code in C language syntax */ +/* + convert the FITS format string for an ASCII Table extension column into the + equivalent C format string that can be used in a printf statement, after + the values have been read as a double. +*/ +{ + int ii; + + cform[0] = '\0'; + ii = 0; + while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */ + ii++; + + if (tform[ii] == 0) + return; /* input format string was blank */ + + cform[0] = '%'; /* start the format string */ + + strcpy(&cform[1], &tform[ii + 1]); /* append the width and decimal code */ + + + if (tform[ii] == 'A') + strcat(cform, "s"); + else if (tform[ii] == 'I') + strcat(cform, ".0f"); /* 0 precision to suppress decimal point */ + if (tform[ii] == 'F') + strcat(cform, "f"); + if (tform[ii] == 'E') + strcat(cform, "E"); + if (tform[ii] == 'D') + strcat(cform, "E"); + + return; +} +/*--------------------------------------------------------------------------*/ +void ffcdsp(char *tform, /* value of an ASCII table TFORMn keyword */ + char *cform) /* equivalent format code in C language syntax */ +/* + convert the FITS TDISPn display format into the equivalent C format + suitable for use in a printf statement. +*/ +{ + int ii; + + cform[0] = '\0'; + ii = 0; + while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */ + ii++; + + if (tform[ii] == 0) + { + cform[0] = '\0'; + return; /* input format string was blank */ + } + + cform[0] = '%'; /* start the format string */ + + strcpy(&cform[1], &tform[ii + 1]); /* append the width and decimal code */ + + if (tform[ii] == 'A' || tform[ii] == 'a') + strcat(cform, "s"); + else if (tform[ii] == 'I' || tform[ii] == 'i') + strcat(cform, "d"); + else if (tform[ii] == 'O' || tform[ii] == 'o') + strcat(cform, "o"); + else if (tform[ii] == 'Z' || tform[ii] == 'z') + strcat(cform, "X"); + else if (tform[ii] == 'F' || tform[ii] == 'f') + strcat(cform, "f"); + else if (tform[ii] == 'E' || tform[ii] == 'e') + strcat(cform, "E"); + else if (tform[ii] == 'D' || tform[ii] == 'd') + strcat(cform, "E"); + else if (tform[ii] == 'G' || tform[ii] == 'g') + strcat(cform, "G"); + else + cform[0] = '\0'; /* unrecognized tform code */ + + return; +} +/*--------------------------------------------------------------------------*/ +int ffgcno( fitsfile *fptr, /* I - FITS file pionter */ + int casesen, /* I - case sensitive string comparison? 0=no */ + char *templt, /* I - input name of column (w/wildcards) */ + int *colnum, /* O - number of the named column; 1=first col */ + int *status) /* IO - error status */ +/* + Determine the column number corresponding to an input column name. + The first column of the table = column 1; + This supports the * and ? wild cards in the input template. +*/ +{ + char colname[FLEN_VALUE]; /* temporary string to hold column name */ + + ffgcnn(fptr, casesen, templt, colname, colnum, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcnn( fitsfile *fptr, /* I - FITS file pointer */ + int casesen, /* I - case sensitive string comparison? 0=no */ + char *templt, /* I - input name of column (w/wildcards) */ + char *colname, /* O - full column name up to 68 + 1 chars long*/ + int *colnum, /* O - number of the named column; 1=first col */ + int *status) /* IO - error status */ +/* + Return the full column name and column number of the next column whose + TTYPEn keyword value matches the input template string. + The template may contain the * and ? wildcards. Status = 237 is + returned if the match is not unique. If so, one may call this routine + again with input status=237 to get the next match. A status value of + 219 is returned when there are no more matching columns. +*/ +{ + char errmsg[FLEN_ERRMSG]; + static int startcol; + int tstatus, ii, founde, foundw, match, exact, unique; + long ivalue; + tcolumn *colptr; + + if (*status <= 0) + { + startcol = 0; /* start search with first column */ + tstatus = 0; + } + else if (*status == COL_NOT_UNIQUE) /* start search from previous spot */ + { + tstatus = COL_NOT_UNIQUE; + *status = 0; + } + else + return(*status); /* bad input status value */ + + colname[0] = 0; /* initialize null return */ + *colnum = 0; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header to get col struct */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* pointer to first column */ + colptr += (startcol); /* offset to starting column */ + + founde = FALSE; /* initialize 'found exact match' flag */ + foundw = FALSE; /* initialize 'found wildcard match' flag */ + unique = FALSE; + + for (ii = startcol; ii < (fptr->Fptr)->tfield; ii++, colptr++) + { + ffcmps(templt, colptr->ttype, casesen, &match, &exact); + if (match) + { + if (founde && exact) + { + /* warning: this is the second exact match we've found */ + /*reset pointer to first match so next search starts there */ + startcol = *colnum; + return(*status = COL_NOT_UNIQUE); + } + else if (founde) /* a wildcard match */ + { + /* already found exact match so ignore this non-exact match */ + } + else if (exact) + { + /* this is the first exact match we have found, so save it. */ + strcpy(colname, colptr->ttype); + *colnum = ii + 1; + founde = TRUE; + } + else if (foundw) + { + /* we have already found a wild card match, so not unique */ + /* continue searching for other matches */ + unique = FALSE; + } + else + { + /* this is the first wild card match we've found. save it */ + strcpy(colname, colptr->ttype); + *colnum = ii + 1; + startcol = *colnum; + foundw = TRUE; + unique = TRUE; + } + } + } + + /* OK, we've checked all the names now see if we got any matches */ + if (founde) + { + if (tstatus == COL_NOT_UNIQUE) /* we did find 1 exact match but */ + *status = COL_NOT_UNIQUE; /* there was a previous match too */ + } + else if (foundw) + { + /* found one or more wildcard matches; report error if not unique */ + if (!unique || tstatus == COL_NOT_UNIQUE) + *status = COL_NOT_UNIQUE; + } + else + { + /* didn't find a match; check if template is a positive integer */ + ffc2ii(templt, &ivalue, &tstatus); + if (tstatus == 0 && ivalue <= (fptr->Fptr)->tfield && ivalue > 0) + { + *colnum = ivalue; + + colptr = (fptr->Fptr)->tableptr; /* pointer to first column */ + colptr += (ivalue - 1); /* offset to correct column */ + strcpy(colname, colptr->ttype); + } + else + { + *status = COL_NOT_FOUND; + if (tstatus != COL_NOT_UNIQUE) + { + sprintf(errmsg, "ffgcnn could not find column: %.45s", templt); + ffpmsg(errmsg); + } + } + } + + startcol = *colnum; /* save pointer for next time */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +void ffcmps(char *templt, /* I - input template (may have wildcards) */ + char *colname, /* I - full column name up to 68 + 1 chars long */ + int casesen, /* I - case sensitive string comparison? 1=yes */ + int *match, /* O - do template and colname match? 1=yes */ + int *exact) /* O - do strings exactly match, or wildcards */ +/* + compare the template to the string and test if they match. + The strings are limited to 68 characters or less (the max. length + of a FITS string keyword value. This routine reports whether + the two strings match and whether the match is exact or + involves wildcards. + + This algorithm is very similar to the way unix filename wildcards + work except that this first treats a wild card as a literal character + when looking for a match. If there is no literal match, then + it interpretes it as a wild card. So the template 'AB*DE' + is considered to be an exact rather than a wild card match to + the string 'AB*DE'. The '#' wild card in the template string will + match any consecutive string of decimal digits in the colname. + +*/ +{ + int ii, found, t1, s1, wildsearch = 0, tsave = 0, ssave = 0; + char temp[FLEN_VALUE], col[FLEN_VALUE]; + + *match = FALSE; + *exact = TRUE; + + strncpy(temp, templt, FLEN_VALUE); /* copy strings to work area */ + strncpy(col, colname, FLEN_VALUE); + temp[FLEN_VALUE - 1] = '\0'; /* make sure strings are terminated */ + col[FLEN_VALUE - 1] = '\0'; + + /* truncate trailing non-significant blanks */ + for (ii = strlen(temp) - 1; ii >= 0 && temp[ii] == ' '; ii--) + temp[ii] = '\0'; + + for (ii = strlen(col) - 1; ii >= 0 && col[ii] == ' '; ii--) + col[ii] = '\0'; + + if (!casesen) + { /* convert both strings to uppercase before comparison */ + ffupch(temp); + ffupch(col); + } + + if (!FSTRCMP(temp, col) ) + { + *match = TRUE; /* strings exactly match */ + return; + } + + *exact = FALSE; /* strings don't exactly match */ + + t1 = 0; /* start comparison with 1st char of each string */ + s1 = 0; + + while(1) /* compare corresponding chars in each string */ + { + if (temp[t1] == '\0' && col[s1] == '\0') + { + /* completely scanned both strings so they match */ + *match = TRUE; + return; + } + else if (temp[t1] == '\0') + { + if (wildsearch) + { + /* + the previous wildcard search may have been going down + a blind alley. Backtrack, and resume the wildcard + search with the next character in the string. + */ + t1 = tsave; + s1 = ssave + 1; + } + else + { + /* reached end of template string so they don't match */ + return; + } + } + else if (col[s1] == '\0') + { + /* reached end of other string; they match if the next */ + /* character in the template string is a '*' wild card */ + + if (temp[t1] == '*' && temp[t1 + 1] == '\0') + { + *match = TRUE; + } + + return; + } + + if (temp[t1] == col[s1] || (temp[t1] == '?') ) + { + s1++; /* corresponding chars in the 2 strings match */ + t1++; /* increment both pointers and loop back again */ + } + else if (temp[t1] == '#' && isdigit((int) col[s1]) ) + { + s1++; /* corresponding chars in the 2 strings match */ + t1++; /* increment both pointers */ + + /* find the end of the string of digits */ + while (isdigit((int) col[s1]) ) + s1++; + } + else if (temp[t1] == '*') + { + + /* save current string locations, in case we need to restart */ + wildsearch = 1; + tsave = t1; + ssave = s1; + + /* get next char from template and look for it in the col name */ + t1++; + if (temp[t1] == '\0' || temp[t1] == ' ') + { + /* reached end of template so strings match */ + *match = TRUE; + return; + } + + found = FALSE; + while (col[s1] && !found) + { + if (temp[t1] == col[s1]) + { + t1++; /* found matching characters; incre both pointers */ + s1++; /* and loop back to compare next chars */ + found = TRUE; + } + else + s1++; /* increment the column name pointer and try again */ + } + + if (!found) + { + return; /* hit end of column name and failed to find a match */ + } + } + else + { + if (wildsearch) + { + /* + the previous wildcard search may have been going down + a blind alley. Backtrack, and resume the wildcard + search with the next character in the string. + */ + t1 = tsave; + s1 = ssave + 1; + } + else + { + return; /* strings don't match */ + } + } + } +} +/*--------------------------------------------------------------------------*/ +int ffgtcl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number */ + int *typecode, /* O - datatype code (21 = short, etc) */ + long *repeat, /* O - repeat count of field */ + long *width, /* O - if ASCII, width of field or unit string */ + int *status) /* IO - error status */ +/* + Get Type of table column. + Returns the datatype code of the column, as well as the vector + repeat count and (if it is an ASCII character column) the + width of the field or a unit string within the field. This supports the + TFORMn = 'rAw' syntax for specifying arrays of substrings, so + if TFORMn = '60A12' then repeat = 60 and width = 12. +*/ +{ + tcolumn *colptr; + int hdutype, decims; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + return(*status = BAD_COL_NUM); + + colptr = (fptr->Fptr)->tableptr; /* pointer to first column */ + colptr += (colnum - 1); /* offset to correct column */ + + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == ASCII_TBL) + { + ffasfm(colptr->tform, typecode, width, &decims, status); + + if (repeat) + *repeat = 1; + } + else + { + if (typecode) + *typecode = colptr->tdatatype; + + if (width) + *width = colptr->twidth; + + if (repeat) + *repeat = (long) colptr->trepeat; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffeqty( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number */ + int *typecode, /* O - datatype code (21 = short, etc) */ + long *repeat, /* O - repeat count of field */ + long *width, /* O - if ASCII, width of field or unit string */ + int *status) /* IO - error status */ +/* + Get the 'equivalent' table column type. + + This routine is similar to the ffgtcl routine (which returns the physical + datatype of the column, as stored in the FITS file) except that if the + TSCALn and TZEROn keywords are defined for the column, then it returns + the 'equivalent' datatype. Thus, if the column is defined as '1I' (short + integer) this routine may return the type as 'TUSHORT' or as 'TFLOAT' + depending on the TSCALn and TZEROn values. + + Returns the datatype code of the column, as well as the vector + repeat count and (if it is an ASCII character column) the + width of the field or a unit string within the field. This supports the + TFORMn = 'rAw' syntax for specifying arrays of substrings, so + if TFORMn = '60A12' then repeat = 60 and width = 12. +*/ +{ + tcolumn *colptr; + int hdutype, decims, tcode, effcode; + double tscale, tzero, min_val, max_val; + long lngscale = 1, lngzero = 0; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + return(*status = BAD_COL_NUM); + + colptr = (fptr->Fptr)->tableptr; /* pointer to first column */ + colptr += (colnum - 1); /* offset to correct column */ + + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == ASCII_TBL) + { + ffasfm(colptr->tform, typecode, width, &decims, status); + + if (repeat) + *repeat = 1; + } + else + { + if (typecode) + *typecode = colptr->tdatatype; + + if (width) + *width = colptr->twidth; + + if (repeat) + *repeat = (long) colptr->trepeat; + } + + /* return if caller is not interested in the typecode value */ + if (!typecode) + return(*status); + + /* check if the tscale and tzero keywords are defined, which might + change the effective datatype of the column */ + + tscale = colptr->tscale; + tzero = colptr->tzero; + + if (tscale == 1.0 && tzero == 0.0) /* no scaling */ + return(*status); + + tcode = abs(*typecode); + + switch (tcode) + { + case TBYTE: /* binary table 'rB' column */ + min_val = 0.; + max_val = 255.0; + break; + + case TSHORT: + min_val = -32768.0; + max_val = 32767.0; + break; + + case TLONG: + + min_val = -2147483648.0; + max_val = 2147483647.0; + break; + + default: /* don't have to deal with other data types */ + return(*status); + } + + if (tscale >= 0.) { + min_val = tzero + tscale * min_val; + max_val = tzero + tscale * max_val; + } else { + max_val = tzero + tscale * min_val; + min_val = tzero + tscale * max_val; + } + if (tzero < 2147483648.) /* don't exceed range of 32-bit integer */ + lngzero = tzero; + lngscale = tscale; + + if ((tzero != 2147483648.) && /* special value that exceeds integer range */ + (lngzero != tzero || lngscale != tscale)) { /* not integers? */ + /* floating point scaled values; just decide on required precision */ + if (tcode == TBYTE || tcode == TSHORT) + effcode = TFLOAT; + else + effcode = TDOUBLE; + + /* + In all the remaining cases, TSCALn and TZEROn are integers, + and not equal to 1 and 0, respectively. + */ + + } else if ((min_val == -128.) && (max_val == 127.)) { + effcode = TSBYTE; + + } else if ((min_val >= -32768.0) && (max_val <= 32767.0)) { + effcode = TSHORT; + + } else if ((min_val >= 0.0) && (max_val <= 65535.0)) { + effcode = TUSHORT; + + } else if ((min_val >= -2147483648.0) && (max_val <= 2147483647.0)) { + effcode = TLONG; + + } else if ((min_val >= 0.0) && (max_val < 4294967296.0)) { + effcode = TULONG; + + } else { /* exceeds the range of a 32-bit integer */ + effcode = TDOUBLE; + } + + /* return the effective datatype code (negative if variable length col.) */ + if (*typecode < 0) /* variable length array column */ + *typecode = -effcode; + else + *typecode = effcode; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgncl( fitsfile *fptr, /* I - FITS file pointer */ + int *ncols, /* O - number of columns in the table */ + int *status) /* IO - error status */ +/* + Get the number of columns in the table (= TFIELDS keyword) +*/ +{ + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + return(*status = NOT_TABLE); + + *ncols = (fptr->Fptr)->tfield; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgnrw( fitsfile *fptr, /* I - FITS file pointer */ + long *nrows, /* O - number of rows in the table */ + int *status) /* IO - error status */ +/* + Get the number of rows in the table (= NAXIS2 keyword) +*/ +{ + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + return(*status = NOT_TABLE); + + /* the NAXIS2 keyword may not be up to date, so use the structure value */ + *nrows = (fptr->Fptr)->numrows; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgacl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number */ + char *ttype, /* O - TTYPEn keyword value */ + long *tbcol, /* O - TBCOLn keyword value */ + char *tunit, /* O - TUNITn keyword value */ + char *tform, /* O - TFORMn keyword value */ + double *tscal, /* O - TSCALn keyword value */ + double *tzero, /* O - TZEROn keyword value */ + char *tnull, /* O - TNULLn keyword value */ + char *tdisp, /* O - TDISPn keyword value */ + int *status) /* IO - error status */ +/* + get ASCII column keyword values +*/ +{ + char name[FLEN_KEYWORD], comm[FLEN_COMMENT]; + tcolumn *colptr; + int tstatus; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + return(*status = BAD_COL_NUM); + + /* get what we can from the column structure */ + + colptr = (fptr->Fptr)->tableptr; /* pointer to first column */ + colptr += (colnum -1); /* offset to correct column */ + + if (ttype) + strcpy(ttype, colptr->ttype); + + if (tbcol) + *tbcol = (colptr->tbcol) + 1; /* first col is 1, not 0 */ + + if (tform) + strcpy(tform, colptr->tform); + + if (tscal) + *tscal = colptr->tscale; + + if (tzero) + *tzero = colptr->tzero; + + if (tnull) + strcpy(tnull, colptr->strnull); + + /* read keywords to get additional parameters */ + + if (tunit) + { + ffkeyn("TUNIT", colnum, name, status); + tstatus = 0; + *tunit = '\0'; + ffgkys(fptr, name, tunit, comm, &tstatus); + } + + if (tdisp) + { + ffkeyn("TDISP", colnum, name, status); + tstatus = 0; + *tdisp = '\0'; + ffgkys(fptr, name, tdisp, comm, &tstatus); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgbcl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number */ + char *ttype, /* O - TTYPEn keyword value */ + char *tunit, /* O - TUNITn keyword value */ + char *dtype, /* O - datatype char: I, J, E, D, etc. */ + long *repeat, /* O - vector column repeat count */ + double *tscal, /* O - TSCALn keyword value */ + double *tzero, /* O - TZEROn keyword value */ + long *tnull, /* O - TNULLn keyword value integer cols only */ + char *tdisp, /* O - TDISPn keyword value */ + int *status) /* IO - error status */ +/* + get BINTABLE column keyword values +*/ +{ + char name[FLEN_KEYWORD], comm[FLEN_COMMENT]; + tcolumn *colptr; + int tstatus; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + return(*status = BAD_COL_NUM); + + /* get what we can from the column structure */ + + colptr = (fptr->Fptr)->tableptr; /* pointer to first column */ + colptr += (colnum -1); /* offset to correct column */ + + if (ttype) + strcpy(ttype, colptr->ttype); + + if (dtype) + { + if (colptr->tdatatype < 0) /* add the "P" prefix for */ + strcpy(dtype, "P"); /* variable length columns */ + else + dtype[0] = 0; + + if (abs(colptr->tdatatype) == TBIT) + strcat(dtype, "X"); + else if (abs(colptr->tdatatype) == TBYTE) + strcat(dtype, "B"); + else if (abs(colptr->tdatatype) == TLOGICAL) + strcat(dtype, "L"); + else if (abs(colptr->tdatatype) == TSTRING) + strcat(dtype, "A"); + else if (abs(colptr->tdatatype) == TSHORT) + strcat(dtype, "I"); + else if (abs(colptr->tdatatype) == TLONG) + strcat(dtype, "J"); + else if (abs(colptr->tdatatype) == TFLOAT) + strcat(dtype, "E"); + else if (abs(colptr->tdatatype) == TDOUBLE) + strcat(dtype, "D"); + else if (abs(colptr->tdatatype) == TCOMPLEX) + strcat(dtype, "C"); + else if (abs(colptr->tdatatype) == TDBLCOMPLEX) + strcat(dtype, "M"); + } + + if (repeat) + *repeat = (long) colptr->trepeat; + + if (tscal) + *tscal = colptr->tscale; + + if (tzero) + *tzero = colptr->tzero; + + if (tnull) + *tnull = colptr->tnull; + + /* read keywords to get additional parameters */ + + if (tunit) + { + ffkeyn("TUNIT", colnum, name, status); + tstatus = 0; + *tunit = '\0'; + ffgkys(fptr, name, tunit, comm, &tstatus); + } + + if (tdisp) + { + ffkeyn("TDISP", colnum, name, status); + tstatus = 0; + *tdisp = '\0'; + ffgkys(fptr, name, tdisp, comm, &tstatus); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffghdn(fitsfile *fptr, /* I - FITS file pointer */ + int *chdunum) /* O - number of the CHDU; 1 = primary array */ +/* + Return the number of the Current HDU in the FITS file. The primary array + is HDU number 1. Note that this is one of the few cfitsio routines that + does not return the error status value as the value of the function. +*/ +{ + *chdunum = (fptr->HDUposition) + 1; + return(*chdunum); +} +/*--------------------------------------------------------------------------*/ +int ffghof(fitsfile *fptr, /* I - FITS file pointer */ + OFF_T *headstart, /* O - byte offset to beginning of CHDU */ + OFF_T *datastart, /* O - byte offset to beginning of next HDU */ + OFF_T *dataend, /* O - byte offset to beginning of next HDU */ + int *status) /* IO - error status */ +/* + Return the address (= byte offset) in the FITS file to the beginning of + the current HDU, the beginning of the data unit, and the end of the data unit. +*/ +{ + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + if (ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status) > 0) + return(*status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if (ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + if (headstart) + *headstart = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]; + + if (datastart) + *datastart = (fptr->Fptr)->datastart; + + if (dataend) + *dataend = (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1]; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffghad(fitsfile *fptr, /* I - FITS file pointer */ + long *headstart, /* O - byte offset to beginning of CHDU */ + long *datastart, /* O - byte offset to beginning of next HDU */ + long *dataend, /* O - byte offset to beginning of next HDU */ + int *status) /* IO - error status */ +/* + Return the address (= byte offset) in the FITS file to the beginning of + the current HDU, the beginning of the data unit, and the end of the data unit. +*/ +{ + OFF_T shead, sdata, edata; + + if (*status > 0) + return(*status); + + ffghof(fptr, &shead, &sdata, &edata, status); + + if (headstart) + { + if (shead > LONG_MAX) + *status = NUM_OVERFLOW; + else + *headstart = (long) shead; + } + + if (datastart) + { + if (sdata > LONG_MAX) + *status = NUM_OVERFLOW; + else + *datastart = (long) sdata; + } + + if (dataend) + { + if (edata > LONG_MAX) + *status = NUM_OVERFLOW; + else + *dataend = (long) edata; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffrhdu(fitsfile *fptr, /* I - FITS file pointer */ + int *hdutype, /* O - type of HDU */ + int *status) /* IO - error status */ +/* + read the required keywords of the CHDU and initialize the corresponding + structure elements that describe the format of the HDU +*/ +{ + int ii, tstatus; + char card[FLEN_CARD]; + char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT]; + char xname[FLEN_VALUE], *xtension, urltype[20]; + + if (*status > 0) + return(*status); + + if (ffgrec(fptr, 1, card, status) > 0 ) /* get the 80-byte card */ + { + ffpmsg("Cannot read first keyword in header (ffrhdu)."); + return(*status); + } + strncpy(name,card,8); /* first 8 characters = the keyword name */ + name[8] = '\0'; + + for (ii=7; ii >= 0; ii--) /* replace trailing blanks with nulls */ + { + if (name[ii] == ' ') + name[ii] = '\0'; + else + break; + } + + if (ffpsvc(card, value, comm, status) > 0) /* parse value and comment */ + { + ffpmsg("Cannot read value of first keyword in header (ffrhdu):"); + ffpmsg(card); + return(*status); + } + + if (!strcmp(name, "SIMPLE")) /* this is the primary array */ + { + + ffpinit(fptr, status); /* initialize the primary array */ + + if (hdutype != NULL) + *hdutype = 0; + } + + else if (!strcmp(name, "XTENSION")) /* this is an XTENSION keyword */ + { + if (ffc2s(value, xname, status) > 0) /* get the value string */ + { + ffpmsg("Bad value string for XTENSION keyword:"); + ffpmsg(value); + return(*status); + } + + xtension = xname; + while (*xtension == ' ') /* ignore any leading spaces in name */ + xtension++; + + if (!strcmp(xtension, "TABLE")) + { + ffainit(fptr, status); /* initialize the ASCII table */ + if (hdutype != NULL) + *hdutype = 1; + } + + else if (!strcmp(xtension, "BINTABLE") || + !strcmp(xtension, "A3DTABLE") || + !strcmp(xtension, "3DTABLE") ) + { + ffbinit(fptr, status); /* initialize the binary table */ + if (hdutype != NULL) + *hdutype = 2; + } + + else + { + tstatus = 0; + ffpinit(fptr, &tstatus); /* probably an IMAGE extension */ + + if (tstatus == UNKNOWN_EXT && hdutype != NULL) + *hdutype = -1; /* don't recognize this extension type */ + else + { + *status = tstatus; + if (hdutype != NULL) + *hdutype = 0; + } + } + } + + else /* not the start of a new extension */ + { + if (card[0] == 0 || + card[0] == 10) /* some editors append this character to EOF */ + { + *status = END_OF_FILE; + } + else + { + *status = UNKNOWN_REC; /* found unknown type of record */ + ffpmsg + ("Extension doesn't start with SIMPLE or XTENSION keyword. (ffrhdu)"); + ffpmsg(card); + } + } + + /* compare the starting position of the next HDU (if any) with the size */ + /* of the whole file to see if this is the last HDU in the file */ + + if ((fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] < + (fptr->Fptr)->logfilesize ) + { + (fptr->Fptr)->lasthdu = 0; /* no, not the last HDU */ + } + else + { + (fptr->Fptr)->lasthdu = 1; /* yes, this is the last HDU */ + + /* special code for mem:// type files (FITS file in memory) */ + /* Allocate enough memory to hold the entire HDU. */ + /* Without this code, CFITSIO would repeatedly realloc memory */ + /* to incrementally increase the size of the file by 2880 bytes */ + /* at a time, until it reached the final size */ + + ffurlt(fptr, urltype, status); + if (!strcmp(urltype,"mem://") || !strcmp(urltype,"memkeep://")) + { + fftrun(fptr, (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1], + status); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpinit(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + initialize the parameters defining the structure of the primary array + or an Image extension +*/ +{ + int groups, tstatus, simple, bitpix, naxis, extend, nspace; + int ttype = 0, bytlen = 0, ii; + long naxes[999], pcount, gcount, blank; + OFF_T npix; + double bscale, bzero; + char comm[FLEN_COMMENT]; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + (fptr->Fptr)->hdutype = IMAGE_HDU; /* primary array or IMAGE extension */ + (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */ + + groups = 0; + tstatus = *status; + + /* get all the descriptive info about this HDU */ + ffgphd(fptr, 999, &simple, &bitpix, &naxis, naxes, &pcount, &gcount, + &extend, &bscale, &bzero, &blank, &nspace, status); + + if (*status == NOT_IMAGE) + *status = tstatus; /* ignore 'unknown extension type' error */ + else if (*status > 0) + return(*status); + + /* + the logical end of the header is 80 bytes before the current position, + minus any trailing blank keywords just before the END keyword. + */ + (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1)); + + /* the data unit begins at the beginning of the next logical block */ + (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1) + * 2880; + + if (naxis > 0 && naxes[0] == 0) /* test for 'random groups' */ + { + tstatus = 0; + if (ffgkyl(fptr, "GROUPS", &groups, comm, &tstatus)) + groups = 0; /* GROUPS keyword not found */ + } + + if (bitpix == BYTE_IMG) /* test bitpix and set the datatype code */ + { + ttype=TBYTE; + bytlen=1; + } + else if (bitpix == SHORT_IMG) + { + ttype=TSHORT; + bytlen=2; + } + else if (bitpix == LONG_IMG) + { + ttype=TLONG; + bytlen=4; + } + else if (bitpix == LONGLONG_IMG) + { + ttype=TLONGLONG; + bytlen=8; + } + else if (bitpix == FLOAT_IMG) + { + ttype=TFLOAT; + bytlen=4; + } + else if (bitpix == DOUBLE_IMG) + { + ttype=TDOUBLE; + bytlen=8; + } + + /* calculate the size of the primary array */ + if (naxis == 0) + { + npix = 0; + } + else + { + if (groups) + { + npix = 1; /* NAXIS1 = 0 is a special flag for 'random groups' */ + } + else + { + npix = naxes[0]; + } + + for (ii=1; ii < naxis; ii++) + { + npix = npix*naxes[ii]; /* calc number of pixels in the array */ + } + } + + /* + now we know everything about the array; just fill in the parameters: + the next HDU begins in the next logical block after the data + */ + + (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] = + (fptr->Fptr)->datastart + + ( (OFF_T)(pcount + npix) * bytlen * gcount + 2879) / 2880 * 2880; + + /* + initialize the fictitious heap starting address (immediately following + the array data) and a zero length heap. This is used to find the + end of the data when checking the fill values in the last block. + */ + (fptr->Fptr)->heapstart = (npix + pcount) * bytlen * gcount; + (fptr->Fptr)->heapsize = 0; + + (fptr->Fptr)->compressimg = 0; /* this is not a compressed image */ + + if (naxis == 0) + { + (fptr->Fptr)->rowlength = 0; /* rows have zero length */ + (fptr->Fptr)->tfield = 0; /* table has no fields */ + + if ((fptr->Fptr)->tableptr) + free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */ + + (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */ + (fptr->Fptr)->numrows = 0; + (fptr->Fptr)->origrows = 0; + } + else + { + /* + The primary array is actually interpreted as a binary table. There + are two columns: the first column contains the group parameters if any. + The second column contains the primary array of data as a single vector + column element. In the case of 'random grouped' format, each group + is stored in a separate row of the table. + */ + /* the number of rows is equal to the number of groups */ + (fptr->Fptr)->numrows = gcount; + (fptr->Fptr)->origrows = gcount; + + (fptr->Fptr)->rowlength = (npix + pcount) * bytlen; /* total size */ + (fptr->Fptr)->tfield = 2; /* 2 fields: group params and the image */ + + if ((fptr->Fptr)->tableptr) + free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */ + + colptr = (tcolumn *) calloc(2, sizeof(tcolumn) ) ; + + if (!colptr) + { + ffpmsg + ("malloc failed to get memory for FITS array descriptors (ffpinit)"); + (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */ + return(*status = ARRAY_TOO_BIG); + } + + /* copy the table structure address to the fitsfile structure */ + (fptr->Fptr)->tableptr = colptr; + + /* the first column represents the group parameters, if any */ + colptr->tbcol = 0; + colptr->tdatatype = ttype; + colptr->twidth = bytlen; + colptr->trepeat = (OFF_T) pcount; + colptr->tscale = 1.; + colptr->tzero = 0.; + colptr->tnull = blank; + + colptr++; /* increment pointer to the second column */ + + /* the second column represents the image array */ + colptr->tbcol = pcount * bytlen; /* col starts after the group parms */ + colptr->tdatatype = ttype; + colptr->twidth = bytlen; + colptr->trepeat = npix; + colptr->tscale = bscale; + colptr->tzero = bzero; + colptr->tnull = blank; + } + + /* reset next keyword pointer to the start of the header */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ]; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffainit(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +{ +/* + initialize the parameters defining the structure of an ASCII table +*/ + int ii, nspace, tbcoln; + long nrows, rowlen, pcount, tfield; + tcolumn *colptr = 0; + char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT]; + char message[FLEN_ERRMSG], errmsg[81]; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + (fptr->Fptr)->hdutype = ASCII_TBL; /* set that this is an ASCII table */ + (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */ + + /* get table parameters and test that the header is a valid: */ + if (ffgttb(fptr, &rowlen, &nrows, &pcount, &tfield, status) > 0) + return(*status); + + if (pcount != 0) + { + ffpmsg("PCOUNT keyword not equal to 0 in ASCII table (ffainit)."); + sprintf(errmsg, " PCOUNT = %ld", pcount); + ffpmsg(errmsg); + return(*status = BAD_PCOUNT); + } + + (fptr->Fptr)->rowlength = (OFF_T) rowlen; /* store length of a row */ + (fptr->Fptr)->tfield = tfield; /* store number of table fields in row */ + + if ((fptr->Fptr)->tableptr) + free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */ + + /* mem for column structures ; space is initialized = 0 */ + if (tfield > 0) + { + colptr = (tcolumn *) calloc(tfield, sizeof(tcolumn) ); + if (!colptr) + { + ffpmsg + ("malloc failed to get memory for FITS table descriptors (ffainit)"); + (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */ + return(*status = ARRAY_TOO_BIG); + } + } + + /* copy the table structure address to the fitsfile structure */ + (fptr->Fptr)->tableptr = colptr; + + /* initialize the table field parameters */ + for (ii = 0; ii < tfield; ii++, colptr++) + { + colptr->ttype[0] = '\0'; /* null column name */ + colptr->tscale = 1.; + colptr->tzero = 0.; + colptr->strnull[0] = ASCII_NULL_UNDEFINED; /* null value undefined */ + colptr->tbcol = -1; /* initialize to illegal value */ + colptr->tdatatype = -9999; /* initialize to illegal value */ + } + + /* + Initialize the fictitious heap starting address (immediately following + the table data) and a zero length heap. This is used to find the + end of the table data when checking the fill values in the last block. + There is no special data following an ASCII table. + */ + (fptr->Fptr)->numrows = nrows; + (fptr->Fptr)->origrows = nrows; + (fptr->Fptr)->heapstart = (OFF_T)rowlen * nrows; + (fptr->Fptr)->heapsize = 0; + + (fptr->Fptr)->compressimg = 0; /* this is not a compressed image */ + + /* now search for the table column keywords and the END keyword */ + + for (nspace = 0, ii = 8; 1; ii++) /* infinite loop */ + { + ffgkyn(fptr, ii, name, value, comm, status); + + /* try to ignore minor syntax errors */ + if (*status == NO_QUOTE) + { + strcat(value, "'"); + *status = 0; + } + else if (*status == BAD_KEYCHAR) + { + *status = 0; + } + + if (*status == END_OF_FILE) + { + ffpmsg("END keyword not found in ASCII table header (ffainit)."); + return(*status = NO_END); + } + else if (*status > 0) + return(*status); + + else if (name[0] == 'T') /* keyword starts with 'T' ? */ + ffgtbp(fptr, name, value, status); /* test if column keyword */ + + else if (!FSTRCMP(name, "END")) /* is this the END keyword? */ + break; + + if (!name[0] && !value[0] && !comm[0]) /* a blank keyword? */ + nspace++; + + else + nspace = 0; + } + + /* test that all required keywords were found and have legal values */ + colptr = (fptr->Fptr)->tableptr; + for (ii = 0; ii < tfield; ii++, colptr++) + { + tbcoln = colptr->tbcol; /* the starting column number (zero based) */ + + if (colptr->tdatatype == -9999) + { + ffkeyn("TFORM", ii+1, name, status); /* construct keyword name */ + sprintf(message,"Required %s keyword not found (ffainit).", name); + ffpmsg(message); + return(*status = NO_TFORM); + } + + else if (tbcoln == -1) + { + ffkeyn("TBCOL", ii+1, name, status); /* construct keyword name */ + sprintf(message,"Required %s keyword not found (ffainit).", name); + ffpmsg(message); + return(*status = NO_TBCOL); + } + + else if ((fptr->Fptr)->rowlength != 0 && + (tbcoln < 0 || tbcoln >= (fptr->Fptr)->rowlength ) ) + { + ffkeyn("TBCOL", ii+1, name, status); /* construct keyword name */ + sprintf(message,"Value of %s keyword out of range: %d (ffainit).", + name, tbcoln); + ffpmsg(message); + return(*status = BAD_TBCOL); + } + + else if ((fptr->Fptr)->rowlength != 0 && + tbcoln + colptr->twidth > (fptr->Fptr)->rowlength ) + { + sprintf(message,"Column %d is too wide to fit in table (ffainit)", + ii+1); + ffpmsg(message); + sprintf(message, " TFORM = %s and NAXIS1 = %ld", + colptr->tform, (long) (fptr->Fptr)->rowlength); + ffpmsg(message); + return(*status = COL_TOO_WIDE); + } + } + + /* + now we know everything about the table; just fill in the parameters: + the 'END' record is 80 bytes before the current position, minus + any trailing blank keywords just before the END keyword. + */ + (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1)); + + /* the data unit begins at the beginning of the next logical block */ + (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1) + * 2880; + + /* the next HDU begins in the next logical block after the data */ + (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] = + (fptr->Fptr)->datastart + + ( ((OFF_T)rowlen * nrows + 2879) / 2880 * 2880 ); + + /* reset next keyword pointer to the start of the header */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ]; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffbinit(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +{ +/* + initialize the parameters defining the structure of a binary table +*/ + int ii, nspace; + long nrows, rowlen, tfield, pcount, totalwidth; + tcolumn *colptr = 0; + char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT]; + char message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + (fptr->Fptr)->hdutype = BINARY_TBL; /* set that this is a binary table */ + (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */ + + /* get table parameters and test that the header is valid: */ + if (ffgttb(fptr, &rowlen, &nrows, &pcount, &tfield, status) > 0) + return(*status); + + (fptr->Fptr)->rowlength = (OFF_T) rowlen; /* store length of a row */ + (fptr->Fptr)->tfield = tfield; /* store number of table fields in row */ + + if ((fptr->Fptr)->tableptr) + free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */ + + /* mem for column structures ; space is initialized = 0 */ + if (tfield > 0) + { + colptr = (tcolumn *) calloc(tfield, sizeof(tcolumn) ); + if (!colptr) + { + ffpmsg + ("malloc failed to get memory for FITS table descriptors (ffbinit)"); + (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */ + return(*status = ARRAY_TOO_BIG); + } + } + + /* copy the table structure address to the fitsfile structure */ + (fptr->Fptr)->tableptr = colptr; + + /* initialize the table field parameters */ + for (ii = 0; ii < tfield; ii++, colptr++) + { + colptr->ttype[0] = '\0'; /* null column name */ + colptr->tscale = 1.; + colptr->tzero = 0.; + colptr->tnull = NULL_UNDEFINED; /* (integer) null value undefined */ + colptr->tdatatype = -9999; /* initialize to illegal value */ + colptr->trepeat = 1; + colptr->strnull[0] = '\0'; /* for ASCII string columns (TFORM = rA) */ + } + + /* + Initialize the heap starting address (immediately following + the table data) and the size of the heap. This is used to find the + end of the table data when checking the fill values in the last block. + */ + (fptr->Fptr)->numrows = nrows; + (fptr->Fptr)->origrows = nrows; + (fptr->Fptr)->heapstart = (OFF_T)rowlen * nrows; + (fptr->Fptr)->heapsize = pcount; + + (fptr->Fptr)->compressimg = 0; /* initialize as not a compressed image */ + + /* now search for the table column keywords and the END keyword */ + + for (nspace = 0, ii = 8; 1; ii++) /* infinite loop */ + { + ffgkyn(fptr, ii, name, value, comm, status); + + /* try to ignore minor syntax errors */ + if (*status == NO_QUOTE) + { + strcat(value, "'"); + *status = 0; + } + else if (*status == BAD_KEYCHAR) + { + *status = 0; + } + + if (*status == END_OF_FILE) + { + ffpmsg("END keyword not found in binary table header (ffbinit)."); + return(*status = NO_END); + } + else if (*status > 0) + return(*status); + + else if (name[0] == 'T') /* keyword starts with 'T' ? */ + ffgtbp(fptr, name, value, status); /* test if column keyword */ + + else if (!FSTRCMP(name, "ZIMAGE")) + { + if (value[0] == 'T') + (fptr->Fptr)->compressimg = 1; /* this is a compressed image */ + } + else if (!FSTRCMP(name, "END")) /* is this the END keyword? */ + break; + + + if (!name[0] && !value[0] && !comm[0]) /* a blank keyword? */ + nspace++; + + else + nspace = 0; /* reset number of consecutive spaces before END */ + } + + /* test that all the required keywords were found and have legal values */ + colptr = (fptr->Fptr)->tableptr; /* set pointer to first column */ + + for (ii = 0; ii < tfield; ii++, colptr++) + { + if (colptr->tdatatype == -9999) + { + ffkeyn("TFORM", ii+1, name, status); /* construct keyword name */ + sprintf(message,"Required %s keyword not found (ffbinit).", name); + ffpmsg(message); + return(*status = NO_TFORM); + } + } + + /* + now we know everything about the table; just fill in the parameters: + the 'END' record is 80 bytes before the current position, minus + any trailing blank keywords just before the END keyword. + */ + + (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1)); + + /* the data unit begins at the beginning of the next logical block */ + (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1) + * 2880; + + /* the next HDU begins in the next logical block after the data */ + (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] = + (fptr->Fptr)->datastart + + ( ((OFF_T)rowlen * nrows + pcount + 2879) / 2880 * 2880 ); + + /* determine the byte offset to the beginning of each column */ + ffgtbc(fptr, &totalwidth, status); + + if (totalwidth != rowlen) + { + sprintf(message, + "NAXIS1 = %ld is not equal to the sum of column widths: %ld", + rowlen, totalwidth); + ffpmsg(message); + *status = BAD_ROW_WIDTH; + } + + /* reset next keyword pointer to the start of the header */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ]; + + if ( (fptr->Fptr)->compressimg == 1) /* Is this a compressed image */ + imcomp_get_compressed_image_par(fptr, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgabc(int tfields, /* I - number of columns in the table */ + char **tform, /* I - value of TFORMn keyword for each column */ + int space, /* I - number of spaces to leave between cols */ + long *rowlen, /* O - total width of a table row */ + long *tbcol, /* O - starting byte in row for each column */ + int *status) /* IO - error status */ +/* + calculate the starting byte offset of each column of an ASCII table + and the total length of a row, in bytes. The input space value determines + how many blank spaces to leave between each column (1 is recommended). +*/ +{ + int ii, datacode, decims; + long width; + + if (*status > 0) + return(*status); + + *rowlen=0; + + if (tfields <= 0) + return(*status); + + tbcol[0] = 1; + + for (ii = 0; ii < tfields; ii++) + { + tbcol[ii] = *rowlen + 1; /* starting byte in row of column */ + + ffasfm(tform[ii], &datacode, &width, &decims, status); + + *rowlen += (width + space); /* total length of row */ + } + + *rowlen -= space; /* don't add space after the last field */ + + return (*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtbc(fitsfile *fptr, /* I - FITS file pointer */ + long *totalwidth, /* O - total width of a table row */ + int *status) /* IO - error status */ +{ +/* + calculate the starting byte offset of each column of a binary table. + Use the values of the datatype code and repeat counts in the + column structure. Return the total length of a row, in bytes. +*/ + int tfields, ii; + long nbytes; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + tfields = (fptr->Fptr)->tfield; + colptr = (fptr->Fptr)->tableptr; /* point to first column structure */ + + *totalwidth = 0; + + for (ii = 0; ii < tfields; ii++, colptr++) + { + colptr->tbcol = *totalwidth; /* byte offset in row to this column */ + + if (colptr->tdatatype == TSTRING) + { + nbytes = (long) colptr->trepeat; /* one byte per char */ + } + else if (colptr->tdatatype == TBIT) + { + nbytes = ((long) colptr->trepeat + 7) / 8; + } + else if (colptr->tdatatype > 0) + { + nbytes = (long) colptr->trepeat * (colptr->tdatatype / 10); + } + else /* this is a variable length descriptor (neg. tdatatype) */ + nbytes = 8; + + *totalwidth = *totalwidth + nbytes; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtbp(fitsfile *fptr, /* I - FITS file pointer */ + char *name, /* I - name of the keyword */ + char *value, /* I - value string of the keyword */ + int *status) /* IO - error status */ +{ +/* + Get TaBle Parameter. The input keyword name begins with the letter T. + Test if the keyword is one of the table column definition keywords + of an ASCII or binary table. If so, decode it and update the value + in the structure. +*/ + int tstatus, datacode, decimals; + long width, repeat, nfield, ivalue; + double dvalue; + char tvalue[FLEN_VALUE]; + char message[FLEN_ERRMSG]; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + tstatus = 0; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if(!FSTRNCMP(name + 1, "TYPE", 4) ) + { + /* get the index number */ + if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */ + return(*status); /* must not be an indexed keyword */ + + if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */ + colptr = colptr + nfield - 1; /* point to the correct column */ + + if (ffc2s(value, tvalue, &tstatus) > 0) /* remove quotes */ + return(*status); + + strcpy(colptr->ttype, tvalue); /* copy col name to structure */ + } + else if(!FSTRNCMP(name + 1, "FORM", 4) ) + { + /* get the index number */ + if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */ + return(*status); /* must not be an indexed keyword */ + + if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */ + colptr = colptr + nfield - 1; /* point to the correct column */ + + if (ffc2s(value, tvalue, &tstatus) > 0) /* remove quotes */ + return(*status); + + strncpy(colptr->tform, tvalue, 9); /* copy TFORM to structure */ + colptr->tform[9] = '\0'; /* make sure it is terminated */ + + if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */ + { + if (ffasfm(tvalue, &datacode, &width, &decimals, status) > 0) + return(*status); /* bad format code */ + + colptr->tdatatype = TSTRING; /* store datatype code */ + colptr->trepeat = 1; /* field repeat count == 1 */ + colptr->twidth = width; /* the width of the field, in bytes */ + } + else /* binary table */ + { + if (ffbnfm(tvalue, &datacode, &repeat, &width, status) > 0) + return(*status); /* bad format code */ + + colptr->tdatatype = datacode; /* store datatype code */ + colptr->trepeat = (OFF_T) repeat; /* field repeat count */ + colptr->twidth = width; /* width of a unit value in chars */ + } + } + else if(!FSTRNCMP(name + 1, "BCOL", 4) ) + { + /* get the index number */ + if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */ + return(*status); /* must not be an indexed keyword */ + + if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */ + colptr = colptr + nfield - 1; /* point to the correct column */ + + if ((fptr->Fptr)->hdutype == BINARY_TBL) + return(*status); /* binary tables don't have TBCOL keywords */ + + if (ffc2ii(value, &ivalue, status) > 0) + { + sprintf(message, + "Error reading value of %s as an integer: %s", name, value); + ffpmsg(message); + return(*status); + } + colptr->tbcol = ivalue - 1; /* convert to zero base */ + } + else if(!FSTRNCMP(name + 1, "SCAL", 4) ) + { + /* get the index number */ + if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */ + return(*status); /* must not be an indexed keyword */ + + if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */ + colptr = colptr + nfield - 1; /* point to the correct column */ + + if (ffc2dd(value, &dvalue, &tstatus) > 0) + { + sprintf(message, + "Error reading value of %s as a double: %s", name, value); + ffpmsg(message); + + /* ignore this error, so don't return error status */ + return(*status); + } + colptr->tscale = dvalue; + } + else if(!FSTRNCMP(name + 1, "ZERO", 4) ) + { + /* get the index number */ + if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */ + return(*status); /* must not be an indexed keyword */ + + if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */ + colptr = colptr + nfield - 1; /* point to the correct column */ + + if (ffc2dd(value, &dvalue, &tstatus) > 0) + { + sprintf(message, + "Error reading value of %s as a double: %s", name, value); + ffpmsg(message); + + /* ignore this error, so don't return error status */ + return(*status); + } + colptr->tzero = dvalue; + } + else if(!FSTRNCMP(name + 1, "NULL", 4) ) + { + /* get the index number */ + if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */ + return(*status); /* must not be an indexed keyword */ + + if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */ + colptr = colptr + nfield - 1; /* point to the correct column */ + + if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */ + { + if (ffc2s(value, tvalue, &tstatus) > 0) /* remove quotes */ + return(*status); + + strncpy(colptr->strnull, tvalue, 17); /* copy TNULL string */ + colptr->strnull[17] = '\0'; /* terminate the strnull field */ + + } + else /* binary table */ + { + if (ffc2ii(value, &ivalue, &tstatus) > 0) + { + sprintf(message, + "Error reading value of %s as an integer: %s", name, value); + ffpmsg(message); + + /* ignore this error, so don't return error status */ + return(*status); + } + colptr->tnull = ivalue; /* null value for integer column */ + } + } + else if (!FSTRNCMP(name + 1, "HEAP", 4) ) + { + if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */ + return(*status); /* ASCII tables don't have a heap */ + + if (ffc2ii(value, &ivalue, &tstatus) > 0) + { + sprintf(message, + "Error reading value of %s as an integer: %s", name, value); + ffpmsg(message); + + /* ignore this error, so don't return error status */ + return(*status); + } + (fptr->Fptr)->heapstart = (OFF_T)ivalue; /* starting byte of the heap */ + return(*status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcpr( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number (1 = 1st column of table) */ + long firstrow, /* I - first row (1 = 1st row of table) */ + OFF_T firstelem, /* I - first element within vector (1 = 1st) */ + long nelem, /* I - number of elements to read or write */ + int writemode, /* I - = 1 if writing data, = 0 if reading data */ + /* If = 2, then writing data, but don't modify */ + /* the returned values of repeat and incre. */ + /* If = -1, then reading data in reverse */ + /* direction. */ + double *scale, /* O - FITS scaling factor (TSCALn keyword value) */ + double *zero, /* O - FITS scaling zero pt (TZEROn keyword value) */ + char *tform, /* O - ASCII column format: value of TFORMn keyword */ + long *twidth, /* O - width of ASCII column (characters) */ + int *tcode, /* O - column datatype code: I*4=41, R*4=42, etc */ + int *maxelem, /* O - max number of elements that fit in buffer */ + OFF_T *startpos,/* O - offset in file to starting row & column */ + OFF_T *elemnum, /* O - starting element number ( 0 = 1st element) */ + long *incre, /* O - byte offset between elements within a row */ + OFF_T *repeat, /* O - number of elements in a row (vector column) */ + OFF_T *rowlen, /* O - length of a row, in bytes */ + int *hdutype, /* O - HDU type: 0, 1, 2 = primary, table, bintable */ + long *tnull, /* O - null value for integer columns */ + char *snull, /* O - null value for ASCII table columns */ + int *status) /* IO - error status */ +/* + Get Column PaRameters, and test starting row and element numbers for + validity. This is a workhorse routine that is call by nearly every + other routine that reads or writes to FITS files. +*/ +{ + int nulpos, rangecheck = 1, tstatus = 0; + OFF_T datastart, endpos; + long tbcol, endrow, nrows, nblock, heapoffset, lrepeat; + char message[81]; + tcolumn *colptr; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + /* Do sanity check of input parameters */ + if (firstrow < 1) + { + if ((fptr->Fptr)->hdutype == IMAGE_HDU) /* Primary Array or IMAGE */ + { + sprintf(message, "Image group number is less than 1: %ld", + firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + else + { + sprintf(message, "Starting row number is less than 1: %ld", + firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + } + else if ((fptr->Fptr)->hdutype != ASCII_TBL && firstelem < 1) + { + sprintf(message, "Starting element number less than 1: %ld", + (long) firstelem); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + else if (nelem < 0) + { + sprintf(message, "Tried to read or write less than 0 elements: %ld", + nelem); + ffpmsg(message); + return(*status = NEG_BYTES); + } + else if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d", + colnum); + ffpmsg(message); + sprintf(message, " There are %d columns in this table.", + (fptr->Fptr)->tfield ); + ffpmsg(message); + + return(*status = BAD_COL_NUM); + } + + /* copy relevant parameters from the structure */ + + *hdutype = (fptr->Fptr)->hdutype; /* image, ASCII table, or BINTABLE */ + *rowlen = (fptr->Fptr)->rowlength; /* width of the table, in bytes */ + datastart = (fptr->Fptr)->datastart; /* offset in file to start of table */ + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + *scale = colptr->tscale; /* value scaling factor; default = 1.0 */ + *zero = colptr->tzero; /* value scaling zeropoint; default = 0.0 */ + *tnull = colptr->tnull; /* null value for integer columns */ + tbcol = colptr->tbcol; /* offset to start of column within row */ + *twidth = colptr->twidth; /* width of a single datum, in bytes */ + *incre = colptr->twidth; /* increment between datums, in bytes */ + *tcode = colptr->tdatatype; + *repeat = colptr->trepeat; + +#if (!SUPPORT_64BIT_INTEGERS) + if (*tcode == TLONGLONG) + { + /* experimental 64-bit integer data type */ + sprintf(message, + "BITPIX=64 or TTYPE = 'K' is not supported in this version of CFITSIO"); + ffpmsg(message); + return(*status = BAD_BITPIX); + } +#endif + + strcpy(tform, colptr->tform); /* value of TFORMn keyword */ + strcpy(snull, colptr->strnull); /* null value for ASCII table columns */ + + if (*hdutype == ASCII_TBL && snull[0] == '\0') + { + /* In ASCII tables, a null value is equivalent to all spaces */ + + strcpy(snull, " "); /* maximum of 17 spaces */ + nulpos = minvalue(17, *twidth); /* truncate to width of column */ + snull[nulpos] = '\0'; + } + + /* Special case: interpret writemode = -1 as reading data, but */ + /* don't do error check for exceeding the range of pixels */ + if (writemode == -1) + { + writemode = 0; + rangecheck = 0; + } + + /* Special case: interprete 'X' column as 'B' */ + if (abs(*tcode) == TBIT) + { + *tcode = *tcode / TBIT * TBYTE; + *repeat = (*repeat + 7) / 8; + } + + /* Special case: support the 'rAw' format in BINTABLEs */ + if (*hdutype == BINARY_TBL && *tcode == TSTRING) + *repeat = *repeat / *twidth; /* repeat = # of unit strings in field */ + + if (*hdutype == ASCII_TBL) + *elemnum = 0; /* ASCII tables don't have vector elements */ + else + *elemnum = firstelem - 1; + + /* interprete complex and double complex as pairs of floats or doubles */ + if (abs(*tcode) >= TCOMPLEX) + { + if (*tcode > 0) + *tcode = (*tcode + 1) / 2; + else + *tcode = (*tcode - 1) / 2; + + *repeat = *repeat * 2; + *twidth = *twidth / 2; + *incre = *incre / 2; + } + + /* calculate no. of pixels that fit in buffer */ + /* allow for case where floats are 8 bytes long */ + if (abs(*tcode) == TFLOAT) + *maxelem = DBUFFSIZE / sizeof(float); + else if (abs(*tcode) == TDOUBLE) + *maxelem = DBUFFSIZE / sizeof(double); + else if (abs(*tcode) == TSTRING) + { + *maxelem = (DBUFFSIZE - 1)/ *twidth; /* leave room for final \0 */ + if (*maxelem == 0) { + sprintf(message, + "ASCII string column is too wide: %ld; max supported width is %d", + *twidth, DBUFFSIZE - 1); + ffpmsg(message); + return(*status = COL_TOO_WIDE); + } + } + else + *maxelem = DBUFFSIZE / *twidth; + + /* calc starting byte position to 1st element of col */ + /* (this does not apply to variable length columns) */ + *startpos = datastart + ((OFF_T)(firstrow - 1) * *rowlen) + tbcol; + + if (*hdutype == IMAGE_HDU && writemode) /* Primary Array or IMAGE */ + { /* + For primary arrays, set the repeat count greater than the total + number of pixels to be written. This prevents an out-of-range + error message in cases where the final image array size is not + yet known or defined. + */ + if (*repeat < *elemnum + nelem) + *repeat = *elemnum + nelem; + } + else if (*tcode > 0) /* Fixed length table column */ + { + if (*elemnum >= *repeat) + { + sprintf(message, + "First element to write is too large: %ld; max allowed value is %ld", + (long) ((*elemnum) + 1), (long) *repeat); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + + /* last row number to be read or written */ + endrow = ((*elemnum + nelem - 1) / *repeat) + firstrow; + + if (writemode) + { + /* check if we are writing beyond the current end of table */ + if ((endrow > (fptr->Fptr)->numrows) && (nelem > 0) ) + { + /* if there are more HDUs following the current one, or */ + /* if there is a data heap, then we must insert space */ + /* for the new rows. */ + if ( !((fptr->Fptr)->lasthdu) || (fptr->Fptr)->heapsize > 0) + { + nrows = endrow - ((fptr->Fptr)->numrows); + if (ffirow(fptr, (fptr->Fptr)->numrows, nrows, status) > 0) + { + sprintf(message, + "Failed to add space for %ld new rows in table.", + nrows); + ffpmsg(message); + return(*status); + } + } + else + { + /* update heap starting address */ + (fptr->Fptr)->heapstart += + ((OFF_T)(endrow - (fptr->Fptr)->numrows) * + (fptr->Fptr)->rowlength ); + + (fptr->Fptr)->numrows = endrow; /* update number of rows */ + } + } + } + else /* reading from the file */ + { + if ( endrow > (fptr->Fptr)->numrows && rangecheck) + { + if (*hdutype == IMAGE_HDU) /* Primary Array or IMAGE */ + { + if (firstrow > (fptr->Fptr)->numrows) + { + sprintf(message, + "Attempted to read from group %ld of the HDU,", firstrow); + ffpmsg(message); + + sprintf(message, + "however the HDU only contains %ld group(s).", + (fptr->Fptr)->numrows ); + ffpmsg(message); + } + else + { + ffpmsg("Attempt to read past end of array:"); + sprintf(message, + " Image has %ld elements;", (long) *repeat); + ffpmsg(message); + + sprintf(message, + " Tried to read %ld elements starting at element %ld.", + nelem, (long) firstelem); + ffpmsg(message); + } + } + else + { + ffpmsg("Attempt to read past end of table:"); + sprintf(message, + " Table has %ld rows with %ld elements per row;", + (fptr->Fptr)->numrows, (long) *repeat); + ffpmsg(message); + + sprintf(message, + " Tried to read %ld elements starting at row %ld, element %ld.", + nelem, firstrow, (long) ((*elemnum) + 1)); + ffpmsg(message); + + } + return(*status = BAD_ROW_NUM); + } + } + + if (*repeat == 1 && nelem > 1 && writemode != 2) + { /* + When accessing a scalar column, fool the calling routine into + thinking that this is a vector column with very big elements. + This allows multiple values (up to the maxelem number of elements + that will fit in the buffer) to be read or written with a single + routine call, which increases the efficiency. + + If writemode == 2, then the calling program does not want to + have this efficiency trick applied. + */ + *incre = *rowlen; + *repeat = nelem; + } + } + else /* Variable length Binary Table column */ + { + *tcode *= (-1); + + if (writemode) /* return next empty heap address for writing */ + { + + *repeat = nelem + *elemnum; /* total no. of elements in the field */ + + /* first, check if we are overwriting an existing row, and */ + /* if so, if the existing space is big enough for the new vector */ + + if ( firstrow <= (fptr->Fptr)->numrows ) + { + ffgdes(fptr, colnum, firstrow, &lrepeat, &heapoffset, &tstatus); + if (!tstatus) + { + if (colptr->tdatatype <= -TCOMPLEX) + lrepeat = lrepeat * 2; /* no. of float or double values */ + else if (colptr->tdatatype == -TBIT) + lrepeat = (lrepeat + 7) / 8; /* convert from bits to bytes */ + + if (lrepeat >= *repeat) /* enough existing space? */ + { + *startpos = datastart + heapoffset + (fptr->Fptr)->heapstart; + + /* write the descriptor into the fixed length part of table */ + if (colptr->tdatatype <= -TCOMPLEX) + { + /* divide repeat count by 2 to get no. of complex values */ + ffpdes(fptr, colnum, firstrow, (long) *repeat / 2, + heapoffset, status); + } + else + { + ffpdes(fptr, colnum, firstrow, (long) *repeat, + heapoffset, status); + } + return(*status); + } + } + } + + /* Add more rows to the table, if writing beyond the end. */ + /* It is necessary to shift the heap down in this case */ + if ( firstrow > (fptr->Fptr)->numrows) + { + nrows = firstrow - ((fptr->Fptr)->numrows); + if (ffirow(fptr, (fptr->Fptr)->numrows, nrows, status) > 0) + { + sprintf(message, + "Failed to add space for %ld new rows in table.", + nrows); + ffpmsg(message); + return(*status); + } + } + + /* calculate starting position (for writing new data) in the heap */ + *startpos = datastart + (fptr->Fptr)->heapstart + + (fptr->Fptr)->heapsize; + + /* write the descriptor into the fixed length part of table */ + if (colptr->tdatatype <= -TCOMPLEX) + { + /* divide repeat count by 2 to get no. of complex values */ + ffpdes(fptr, colnum, firstrow, (long) *repeat / 2, + (fptr->Fptr)->heapsize, status); + } + else + { + ffpdes(fptr, colnum, firstrow, (long) *repeat, (fptr->Fptr)->heapsize, + status); + } + + /* If this is not the last HDU in the file, then check if */ + /* extending the heap would overwrite the following header. */ + /* If so, then have to insert more blocks. */ + if ( !((fptr->Fptr)->lasthdu) ) + { + endpos = datastart + (fptr->Fptr)->heapstart + + (fptr->Fptr)->heapsize + ((long) *repeat * (*incre)); + + if (endpos > (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1]) + { + /* calc the number of blocks that need to be added */ + nblock = ((endpos - 1 - + (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] ) + / 2880) + 1; + + if (ffiblk(fptr, nblock, 1, status) > 0) /* insert blocks */ + { + sprintf(message, + "Failed to extend the size of the variable length heap by %ld blocks.", + nblock); + ffpmsg(message); + return(*status); + } + } + } + + /* increment the address to the next empty heap position */ + (fptr->Fptr)->heapsize += ((long) *repeat * (*incre)); + } + else /* get the read start position in the heap */ + { + if ( firstrow > (fptr->Fptr)->numrows) + { + ffpmsg("Attempt to read past end of table"); + sprintf(message, + " Table has %ld rows and tried to read row %ld.", + (fptr->Fptr)->numrows, firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + + ffgdes(fptr, colnum, firstrow, &lrepeat, &heapoffset, status); + *repeat = (OFF_T) lrepeat; + + if (colptr->tdatatype <= -TCOMPLEX) + *repeat = *repeat * 2; /* no. of float or double values */ + else if (colptr->tdatatype == -TBIT) + *repeat = (*repeat + 7) / 8; /* convert from bits to bytes */ + + if (*elemnum >= *repeat) + { + sprintf(message, + "Starting element to read in variable length column is too large: %ld", + (long) firstelem); + ffpmsg(message); + sprintf(message, + " This row only contains %ld elements", (long) *repeat); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + + *startpos = datastart + heapoffset + (fptr->Fptr)->heapstart; + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftheap(fitsfile *fptr, /* I - FITS file pointer */ + long *heapsz, /* O - current size of the heap */ + long *unused, /* O - no. of unused bytes in the heap */ + long *overlap, /* O - no. of bytes shared by > 1 descriptors */ + int *valid, /* O - are all the heap addresses valid? */ + int *status) /* IO - error status */ +/* + Tests the contents of the binary table variable length array heap. + Returns the number of bytes that are currently not pointed to by any + of the descriptors, and also the number of bytes that are pointed to + by more than one descriptor. It returns valid = FALSE if any of the + descriptors point to addresses that are out of the bounds of the + heap. +*/ +{ + int jj, typecode, pixsize; + long ii, kk, repeat, offset, nbytes, theapsz, tunused = 0, toverlap = 0; + char *buffer, message[81]; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if ( fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header to make sure everything is up to date */ + else if ( ffrdef(fptr, status) > 0) + return(*status); + + if (valid) *valid = TRUE; + if (heapsz) *heapsz = (fptr->Fptr)->heapsize; + if (unused) *unused = 0; + if (overlap) *overlap = 0; + + /* return if this is not a binary table HDU or if the heap is empty */ + if ( (fptr->Fptr)->hdutype != BINARY_TBL || (fptr->Fptr)->heapsize == 0 ) + return(*status); + + theapsz = (fptr->Fptr)->heapsize; + buffer = calloc(1, theapsz); /* allocate temp space */ + if (!buffer) + { + sprintf(message,"Failed to allocate buffer to test the heap"); + ffpmsg(message); + return(*status = MEMORY_ALLOCATION); + } + + /* loop over all cols */ + for (jj = 1; jj <= (fptr->Fptr)->tfield && *status <= 0; jj++) + { + ffgtcl(fptr, jj, &typecode, NULL, NULL, status); + if (typecode > 0) + continue; /* ignore fixed length columns */ + + pixsize = -typecode / 10; + + /* copy heap data, row by row */ + for (ii = 1; ii <= (fptr->Fptr)->numrows; ii++) + { + ffgdes(fptr, jj, ii, &repeat, &offset, status); + if (typecode == -TBIT) + nbytes = (repeat + 7) / 8; + else + nbytes = repeat * pixsize; + + if (offset < 0 || offset + nbytes > theapsz) + { + if (valid) *valid = FALSE; /* address out of bounds */ + sprintf(message, + "Descriptor in row %ld, column %d has invalid heap address", + ii, jj); + ffpmsg(message); + } + else + { + for (kk = 0; kk < nbytes; kk++) + buffer[kk + offset]++; /* increment every used byte */ + } + } + } + + for (kk = 0; kk < theapsz; kk++) + { + if (buffer[kk] == 0) + tunused++; + else if (buffer[kk] > 1) + toverlap++; + } + + if (heapsz) *heapsz = theapsz; + if (unused) *unused = tunused; + if (overlap) *overlap = toverlap; + + free(buffer); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcmph(fitsfile *fptr, /* I -FITS file pointer */ + int *status) /* IO - error status */ +/* + compress the binary table heap by reordering the contents heap and + recovering any unused space +*/ +{ + fitsfile *tptr; + int jj, typecode, pixsize, valid; + long ii, repeat, offset, buffsize = 10000, nblock, pcount, nbytes; + long unused, overlap; + char *buffer, *tbuff = 0, comm[FLEN_COMMENT], valstring[FLEN_CARD]; + char message[81], card[FLEN_CARD]; + OFF_T readheapstart, writeheapstart, endpos, t1heapsize, t2heapsize; + + if (*status > 0) + return(*status); + + /* get information about the current heap */ + fftheap(fptr, NULL, &unused, &overlap, &valid, status); + + if (!valid) + return(*status = BAD_HEAP_PTR); /* bad heap pointers */ + + /* return if this is not a binary table HDU or if the heap is OK as is */ + if ( (fptr->Fptr)->hdutype != BINARY_TBL || (fptr->Fptr)->heapsize == 0 || + (unused == 0 && overlap == 0) || *status > 0 ) + return(*status); + + /* copy the current HDU to a temporary file in memory */ + if (ffinit( &tptr, "mem://tempheapfile", status) ) + { + sprintf(message,"Failed to create temporary file for the heap"); + ffpmsg(message); + return(*status); + } + if ( ffcopy(fptr, tptr, 0, status) ) + { + sprintf(message,"Failed to create copy of the heap"); + ffpmsg(message); + ffclos(tptr, status); + return(*status); + } + + buffer = malloc(buffsize); /* allocate initial buffer */ + if (!buffer) + { + sprintf(message,"Failed to allocate buffer to copy the heap"); + ffpmsg(message); + ffclos(tptr, status); + return(*status = MEMORY_ALLOCATION); + } + + readheapstart = (tptr->Fptr)->datastart + (tptr->Fptr)->heapstart; + writeheapstart = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart; + + t1heapsize = (fptr->Fptr)->heapsize; /* save original heap size */ + (fptr->Fptr)->heapsize = 0; /* reset heap to zero */ + + /* loop over all cols */ + for (jj = 1; jj <= (fptr->Fptr)->tfield && *status <= 0; jj++) + { + ffgtcl(tptr, jj, &typecode, NULL, NULL, status); + if (typecode > 0) + continue; /* ignore fixed length columns */ + + pixsize = -typecode / 10; + + /* copy heap data, row by row */ + for (ii = 1; ii <= (fptr->Fptr)->numrows; ii++) + { + ffgdes(tptr, jj, ii, &repeat, &offset, status); + if (typecode == -TBIT) + nbytes = (repeat + 7) / 8; + else + nbytes = repeat * pixsize; + + /* increase size of buffer if necessary to read whole array */ + if (nbytes > buffsize) + { + tbuff = realloc(buffer, nbytes); + + if (tbuff) + { + buffer = tbuff; + buffsize = nbytes; + } + else + *status = MEMORY_ALLOCATION; + } + + /* If this is not the last HDU in the file, then check if */ + /* extending the heap would overwrite the following header. */ + /* If so, then have to insert more blocks. */ + if ( !((fptr->Fptr)->lasthdu) ) + { + endpos = writeheapstart + (fptr->Fptr)->heapsize + nbytes; + + if (endpos > (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1]) + { + /* calc the number of blocks that need to be added */ + nblock = ((endpos - 1 - + (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] ) + / 2880) + 1; + + if (ffiblk(fptr, nblock, 1, status) > 0) /* insert blocks */ + { + sprintf(message, + "Failed to extend the size of the variable length heap by %ld blocks.", + nblock); + ffpmsg(message); + } + } + } + + /* read arrray of bytes from temporary copy */ + ffmbyt(tptr, readheapstart + offset, REPORT_EOF, status); + ffgbyt(tptr, nbytes, buffer, status); + + /* write arrray of bytes back to original file */ + ffmbyt(fptr, writeheapstart + (fptr->Fptr)->heapsize, + IGNORE_EOF, status); + ffpbyt(fptr, nbytes, buffer, status); + + /* write descriptor */ + ffpdes(fptr, jj, ii, repeat, + (fptr->Fptr)->heapsize, status); + + (fptr->Fptr)->heapsize += nbytes; /* update heapsize */ + + if (*status > 0) + { + free(buffer); + ffclos(tptr, status); + return(*status); + } + } + } + + free(buffer); + ffclos(tptr, status); + + /* delete any empty blocks at the end of the HDU */ + nblock = ( (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] - + (writeheapstart + (fptr->Fptr)->heapsize) ) / 2880; + + if (nblock > 0) + { + t2heapsize = (fptr->Fptr)->heapsize; /* save new heap size */ + (fptr->Fptr)->heapsize = t1heapsize; /* restore original heap size */ + + ffdblk(fptr, nblock, status); + (fptr->Fptr)->heapsize = t2heapsize; /* reset correct heap size */ + } + + /* update the PCOUNT value (size of heap) */ + ffgkyj(fptr, "PCOUNT", &pcount, comm, status); + if ((fptr->Fptr)->heapsize != pcount) + { + sprintf(valstring, "%ld", (fptr->Fptr)->heapsize); + ffmkky("PCOUNT", valstring, comm, card, status); + ffmkey(fptr, card, status); + } + ffrdef(fptr, status); /* rescan new HDU structure */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgdes(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number (1 = 1st column of table) */ + long rownum, /* I - row number (1 = 1st row of table) */ + long *length, /* O - number of elements in the row */ + long *heapaddr, /* O - heap pointer to the data */ + int *status) /* IO - error status */ +/* + get (read) the variable length vector descriptor from the table. +*/ +{ + OFF_T bytepos; + INT32BIT descript[2] = {0,0}; + tcolumn *colptr; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* point to first column structure */ + colptr += (colnum - 1); /* offset to the correct column */ + + if (colptr->tdatatype >= 0) + *status = NOT_VARI_LEN; + + else + { + bytepos = (fptr->Fptr)->datastart + + ((fptr->Fptr)->rowlength * (rownum - 1)) + + colptr->tbcol; + + /* read descriptor */ + if (ffgi4b(fptr, bytepos, 2, 4, descript, status) <= 0) + { + if (length) + *length = (long) descript[0]; /* 1st word is the length */ + if (heapaddr) + *heapaddr = (long) descript[1]; /* 2nd word is the address */ + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgdess(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number (1 = 1st column of table) */ + long firstrow, /* I - first row (1 = 1st row of table) */ + long nrows, /* I - number or rows to read */ + long *length, /* O - number of elements in the row */ + long *heapaddr, /* O - heap pointer to the data */ + int *status) /* IO - error status */ +/* + get (read) a range of variable length vector descriptors from the table. +*/ +{ + OFF_T rowsize, bytepos; + long ii; + INT32BIT descript[2]; + tcolumn *colptr; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* point to first column structure */ + colptr += (colnum - 1); /* offset to the correct column */ + + if (colptr->tdatatype >= 0) + *status = NOT_VARI_LEN; + + else + { + rowsize = (fptr->Fptr)->rowlength; + bytepos = (fptr->Fptr)->datastart + + (rowsize * (firstrow - 1)) + + colptr->tbcol; + + for (ii = 0; ii < nrows; ii++) + { + ffgi4b(fptr, bytepos, 2, 4, descript, status); /* read descriptor */ + + *length = (long) descript[0]; /* 1st word is the length */ + *heapaddr = (long) descript[1]; /* 2nd word is the address */ + + length++; + heapaddr++; + bytepos += rowsize; + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpdes(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number (1 = 1st column of table) */ + long rownum, /* I - row number (1 = 1st row of table) */ + long length, /* I - number of elements in the row */ + long heapaddr, /* I - heap pointer to the data */ + int *status) /* IO - error status */ +/* + put (write) the variable length vector descriptor to the table. +*/ +{ + OFF_T bytepos; + INT32BIT descript[2]; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + colptr = (fptr->Fptr)->tableptr; /* point to first column structure */ + colptr += (colnum - 1); /* offset to the correct column */ + + if (colptr->tdatatype >= 0) + *status = NOT_VARI_LEN; + + else + { + bytepos = (fptr->Fptr)->datastart + + ((fptr->Fptr)->rowlength * (rownum - 1)) + + colptr->tbcol; + + ffmbyt(fptr, bytepos, IGNORE_EOF, status); /* move to element */ + + descript[0] = (INT32BIT) length; /* 1st word is the length */ + descript[1] = (INT32BIT) heapaddr; /* 2nd word is the address */ + + ffpi4b(fptr, 2, 4, descript, status); /* write the descriptor */ + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffchdu(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +{ +/* + close the current HDU. If we have write access to the file, then: + - write the END keyword and pad header with blanks if necessary + - check the data fill values, and rewrite them if not correct +*/ + char message[FLEN_ERRMSG]; + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + /* no need to do any further updating of the HDU */ + } + else if ((fptr->Fptr)->writemode == 1) + { + ffrdef(fptr, status); /* scan header to redefine structure */ + if ((fptr->Fptr)->heapsize > 0) + ffuptf(fptr, status); /* update the variable length TFORM values */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + + if ((fptr->Fptr)->open_count == 1) + { + /* free memory for the CHDU structure only if no other files are using it */ + if ((fptr->Fptr)->tableptr) + { + free((fptr->Fptr)->tableptr); + (fptr->Fptr)->tableptr = NULL; + } + } + + if (*status > 0 && *status != NO_CLOSE_ERROR) + { + sprintf(message, + "Error while closing HDU number %d (ffchdu).", (fptr->Fptr)->curhdu); + ffpmsg(message); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuptf(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Update the value of the TFORM keywords for the variable length array + columns to make sure they all have the form 1Px(len) or Px(len) where + 'len' is the maximum length of the vector in the table (e.g., '1PE(400)') +*/ +{ + int ii; + long tflds, naxis2, maxlen, jj, length, addr; + char comment[FLEN_COMMENT], keyname[FLEN_KEYWORD]; + char tform[FLEN_VALUE], newform[FLEN_VALUE], lenval[40]; + char card[FLEN_CARD]; + char message[FLEN_ERRMSG]; + + ffgkyj(fptr, "TFIELDS", &tflds, comment, status); + ffgkyj(fptr, "NAXIS2", &naxis2, comment, status); + + for (ii = 1; ii <= tflds; ii++) /* loop over all the columns */ + { + ffkeyn("TFORM", ii, keyname, status); /* construct name */ + if (ffgkys(fptr, keyname, tform, comment, status) > 0) + { + sprintf(message, + "Error while updating variable length vector TFORMn values (ffuptf)."); + ffpmsg(message); + return(*status); + } + /* is this a variable array length column ? */ + if (tform[0] == 'P' || tform[1] == 'P') + { + if (strlen(tform) < 5) /* is maxlen field missing? */ + { + /* get the max length */ + maxlen = 0; + for (jj=1; jj <= naxis2; jj++) + { + ffgdes(fptr, ii, jj, &length, &addr, status); + maxlen = maxvalue(maxlen, length); + } + + /* construct the new keyword value */ + strcpy(newform, "'"); + strcat(newform, tform); + sprintf(lenval, "(%ld)", maxlen); + strcat(newform,lenval); + while(strlen(newform) < 9) + strcat(newform," "); /* append spaces 'till length = 8 */ + strcat(newform,"'" ); /* append closing parenthesis */ + /* would be simpler to just call ffmkyj here, but this */ + /* would force linking in all the modkey & putkey routines */ + ffmkky(keyname, newform, comment, card, status); /* make new card */ + ffmkey(fptr, card, status); /* replace last read keyword */ + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffrdef(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + ReDEFine the structure of a data unit. This routine re-reads + the CHDU header keywords to determine the structure and length of the + current data unit. This redefines the start of the next HDU. +*/ +{ + int dummy, tstatus = 0; + long naxis2, pcount; + char card[FLEN_CARD], comm[FLEN_COMMENT], valstring[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->writemode == 1) /* write access to the file? */ + { + /* don't need to check NAXIS2 and PCOUNT if data hasn't been written */ + if ((fptr->Fptr)->datastart != DATA_UNDEFINED) + { + /* update NAXIS2 keyword if more rows were written to the table */ + /* and if the user has not explicitly reset the NAXIS2 value */ + if ((fptr->Fptr)->hdutype != IMAGE_HDU) + { + if (ffgkyj(fptr, "NAXIS2", &naxis2, comm, &tstatus) > 0) + { + /* Couldn't read NAXIS2 (odd!); in certain circumstances */ + /* this may be normal, so ignore the error. */ + naxis2 = (fptr->Fptr)->numrows; + } + + if ((fptr->Fptr)->numrows > naxis2 + && (fptr->Fptr)->origrows == naxis2) + /* if origrows is not equal to naxis2, then the user must */ + /* have manually modified the NAXIS2 keyword value, and */ + /* we will assume that the current value is correct. */ + { + /* would be simpler to just call ffmkyj here, but this */ + /* would force linking in all the modkey & putkey routines */ + sprintf(valstring, "%ld", (fptr->Fptr)->numrows); + ffmkky("NAXIS2", valstring, comm, card, status); + ffmkey(fptr, card, status); + } + } + + /* if data has been written to variable length columns in a */ + /* binary table, then we may need to update the PCOUNT value */ + if ((fptr->Fptr)->heapsize > 0) + { + ffgkyj(fptr, "PCOUNT", &pcount, comm, status); + if ((fptr->Fptr)->heapsize > pcount) + { + /* would be simpler to just call ffmkyj here, but this */ + /* would force linking in all the modkey & putkey routines */ + sprintf(valstring, "%ld", (fptr->Fptr)->heapsize); + ffmkky("PCOUNT", valstring, comm, card, status); + ffmkey(fptr, card, status); + } + } + } + + if (ffwend(fptr, status) <= 0) /* rewrite END keyword and fill */ + { + ffrhdu(fptr, &dummy, status); /* re-scan the header keywords */ + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffhdef(fitsfile *fptr, /* I - FITS file pointer */ + int morekeys, /* I - reserve space for this many keywords */ + int *status) /* IO - error status */ +/* + based on the number of keywords which have already been written, + plus the number of keywords to reserve space for, we then can + define where the data unit should start (it must start at the + beginning of a 2880-byte logical block). + + This routine will only have any effect if the starting location of the + data unit following the header is not already defined. In any case, + it is always possible to add more keywords to the header even if the + data has already been written. It is just more efficient to reserve + the space in advance. +*/ +{ + OFF_T delta; + + if (*status > 0 || morekeys < 1) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + ffrdef(fptr, status); + + /* ffrdef defines the offset to datastart and the start of */ + /* the next HDU based on the number of existing keywords. */ + /* We need to increment both of these values based on */ + /* the number of new keywords to be added. */ + + delta = (((fptr->Fptr)->headend + (morekeys * 80)) / 2880 + 1) + * 2880 - (fptr->Fptr)->datastart; + + (fptr->Fptr)->datastart += delta; + + (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] += delta; + + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffwend(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + write the END card and following fill (space chars) in the current header +*/ +{ + int ii, tstatus; + OFF_T endpos; + long nspace; + char blankkey[FLEN_CARD], endkey[FLEN_CARD], keyrec[FLEN_CARD]; + + if (*status > 0) + return(*status); + + endpos = (fptr->Fptr)->headend; + + /* we assume that the HDUposition == curhdu in all cases */ + + /* calc the data starting position if not currently defined */ + if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + (fptr->Fptr)->datastart = ( endpos / 2880 + 1 ) * 2880; + + /* calculate the number of blank keyword slots in the header */ + nspace = ( (fptr->Fptr)->datastart - endpos ) / 80; + + /* construct a blank and END keyword (80 spaces ) */ + strcpy(blankkey, " "); + strcat(blankkey, " "); + strcpy(endkey, "END "); + strcat(endkey, " "); + + /* check if header is already correctly terminated with END and fill */ + tstatus=0; + ffmbyt(fptr, endpos, REPORT_EOF, &tstatus); /* move to header end */ + for (ii=0; ii < nspace; ii++) + { + ffgbyt(fptr, 80, keyrec, &tstatus); /* get next keyword */ + if (strncmp(keyrec, blankkey, 80) && strncmp(keyrec, endkey, 80)) + break; + } + + if (ii == nspace && !tstatus) + { + /* check if the END keyword exists at the correct position */ + endpos=maxvalue( endpos, ( (fptr->Fptr)->datastart - 2880 ) ); + ffmbyt(fptr, endpos, REPORT_EOF, &tstatus); /* move to END position */ + ffgbyt(fptr, 80, keyrec, &tstatus); /* read the END keyword */ + if ( !strncmp(keyrec, endkey, 80) && !tstatus) + return(*status); /* END card was already correct */ + } + + /* header was not correctly terminated, so write the END and blank fill */ + endpos = (fptr->Fptr)->headend; + ffmbyt(fptr, endpos, IGNORE_EOF, status); /* move to header end */ + for (ii=0; ii < nspace; ii++) + ffpbyt(fptr, 80, blankkey, status); /* write the blank keywords */ + + /* + The END keyword must either be placed immediately after the last + keyword that was written (as indicated by the headend value), or + must be in the first 80 bytes of the 2880-byte FITS record immediately + preceeding the data unit, whichever is further in the file. The + latter will occur if space has been reserved for more header keywords + which have not yet been written. + */ + + endpos=maxvalue( endpos, ( (fptr->Fptr)->datastart - 2880 ) ); + ffmbyt(fptr, endpos, REPORT_EOF, status); /* move to END position */ + + ffpbyt(fptr, 80, endkey, status); /* write the END keyword to header */ + + if (*status > 0) + ffpmsg("Error while writing END card (ffwend)."); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpdfl(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Write the Data Unit Fill values if they are not already correct. + The fill values are used to fill out the last 2880 byte block of the HDU. + Fill the data unit with zeros or blanks depending on the type of HDU + from the end of the data to the end of the current FITS 2880 byte block +*/ +{ + char chfill, fill[2880]; + OFF_T fillstart; + int nfill, tstatus, ii; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + return(*status); /* fill has already been correctly written */ + + if ((fptr->Fptr)->heapstart == 0) + return(*status); /* null data unit, so there is no fill */ + + fillstart = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart + + (fptr->Fptr)->heapsize; + + nfill = (fillstart + 2879) / 2880 * 2880 - fillstart; + + if ((fptr->Fptr)->hdutype == ASCII_TBL) + chfill = 32; /* ASCII tables are filled with spaces */ + else + chfill = 0; /* all other extensions are filled with zeros */ + + tstatus = 0; + + if (!nfill) /* no fill bytes; just check that entire table exists */ + { + fillstart--; + nfill = 1; + ffmbyt(fptr, fillstart, REPORT_EOF, &tstatus); /* move to last byte */ + ffgbyt(fptr, nfill, fill, &tstatus); /* get the last byte */ + + if (tstatus == 0) + return(*status); /* no EOF error, so everything is OK */ + } + else + { + ffmbyt(fptr, fillstart, REPORT_EOF, &tstatus); /* move to fill area */ + ffgbyt(fptr, nfill, fill, &tstatus); /* get the fill bytes */ + + if (tstatus == 0) + { + for (ii = 0; ii < nfill; ii++) + { + if (fill[ii] != chfill) + break; + } + + if (ii == nfill) + return(*status); /* all the fill values were correct */ + } + } + + /* fill values are incorrect or have not been written, so write them */ + + memset(fill, chfill, nfill); /* fill the buffer with the fill value */ + + ffmbyt(fptr, fillstart, IGNORE_EOF, status); /* move to fill area */ + ffpbyt(fptr, nfill, fill, status); /* write the fill bytes */ + + if (*status > 0) + ffpmsg("Error writing Data Unit fill bytes (ffpdfl)."); + + return(*status); +} +/********************************************************************** + ffchfl : Check Header Fill values + + Check that the header unit is correctly filled with blanks from + the END card to the end of the current FITS 2880-byte block + + Function parameters: + fptr Fits file pointer + status output error status + + Translated ftchfl into C by Peter Wilson, Oct. 1997 +**********************************************************************/ +int ffchfl( fitsfile *fptr, int *status) +{ + int nblank,i,gotend; + OFF_T endpos; + char rec[FLEN_CARD]; + char *blanks=" "; /* 80 spaces */ + + if( *status > 0 ) return (*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* calculate the number of blank keyword slots in the header */ + + endpos=(fptr->Fptr)->headend; + nblank=((fptr->Fptr)->datastart-endpos)/80; + + /* move the i/o pointer to the end of the header keywords */ + + ffmbyt(fptr,endpos,TRUE,status); + + /* find the END card (there may be blank keywords perceeding it) */ + + gotend=FALSE; + for(i=0;i 0 ) { + rec[FLEN_CARD - 1] = '\0'; /* make sure string is null terminated */ + ffpmsg(rec); + return( *status ); + } + } + return( *status ); +} + +/********************************************************************** + ffcdfl : Check Data Unit Fill values + + Check that the data unit is correctly filled with zeros or + blanks from the end of the data to the end of the current + FITS 2880 byte block + + Function parameters: + fptr Fits file pointer + status output error status + + Translated ftcdfl into C by Peter Wilson, Oct. 1997 +**********************************************************************/ +int ffcdfl( fitsfile *fptr, int *status) +{ + int nfill,i; + OFF_T filpos; + char chfill,chbuff[2880]; + + if( *status > 0 ) return( *status ); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* check if the data unit is null */ + if( (fptr->Fptr)->heapstart==0 ) return( *status ); + + /* calculate starting position of the fill bytes, if any */ + filpos = (fptr->Fptr)->datastart + + (fptr->Fptr)->heapstart + + (fptr->Fptr)->heapsize; + + /* calculate the number of fill bytes */ + nfill = (filpos + 2879) / 2880 * 2880 - filpos; + if( nfill == 0 ) return( *status ); + + /* move to the beginning of the fill bytes */ + ffmbyt(fptr, filpos, FALSE, status); + + if( ffgbyt(fptr, nfill, chbuff, status) > 0) + { + ffpmsg("Error reading data unit fill bytes (ffcdfl)."); + return( *status ); + } + + if( (fptr->Fptr)->hdutype==ASCII_TBL ) + chfill = 32; /* ASCII tables are filled with spaces */ + else + chfill = 0; /* all other extensions are filled with zeros */ + + /* check for all zeros or blanks */ + + for(i=0;iFptr)->hdutype==ASCII_TBL ) + ffpmsg("Warning: remaining bytes following ASCII table data are not filled with blanks."); + else + ffpmsg("Warning: remaining bytes following data are not filled with zeros."); + return( *status ); + } + } + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int ffcrhd(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + CReate Header Data unit: Create, initialize, and move the i/o pointer + to a new extension appended to the end of the FITS file. +*/ +{ + int tstatus = 0; + OFF_T bytepos, *ptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* If the current header is empty, we don't have to do anything */ + if ((fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + return(*status); + + while (ffmrhd(fptr, 1, 0, &tstatus) == 0); /* move to end of file */ + + if ((fptr->Fptr)->maxhdu == (fptr->Fptr)->MAXHDU) + { + /* allocate more space for the headstart array */ + ptr = (OFF_T*) realloc( (fptr->Fptr)->headstart, + ((fptr->Fptr)->MAXHDU + 1001) * sizeof(OFF_T) ); + + if (ptr == NULL) + return (*status = MEMORY_ALLOCATION); + else { + (fptr->Fptr)->MAXHDU = (fptr->Fptr)->MAXHDU + 1000; + (fptr->Fptr)->headstart = ptr; + } + } + + if (ffchdu(fptr, status) <= 0) /* close the current HDU */ + { + bytepos = (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1]; /* last */ + ffmbyt(fptr, bytepos, IGNORE_EOF, status); /* move file ptr to it */ + (fptr->Fptr)->maxhdu++; /* increment the known number of HDUs */ + (fptr->Fptr)->curhdu = (fptr->Fptr)->maxhdu; /* set current HDU loc */ + fptr->HDUposition = (fptr->Fptr)->maxhdu; /* set current HDU loc */ + (fptr->Fptr)->nextkey = bytepos; /* next keyword = start of header */ + (fptr->Fptr)->headend = bytepos; /* end of header */ + (fptr->Fptr)->datastart = DATA_UNDEFINED; /* start data unit undefined */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdblk(fitsfile *fptr, /* I - FITS file pointer */ + long nblocks, /* I - number of 2880-byte blocks to delete */ + int *status) /* IO - error status */ +/* + Delete the specified number of 2880-byte blocks from the end + of the CHDU by shifting all following extensions up this + number of blocks. +*/ +{ + char buffer[2880]; + int tstatus, ii; + OFF_T readpos, writepos; + + if (*status > 0 || nblocks <= 0) + return(*status); + + tstatus = 0; + /* pointers to the read and write positions */ + + readpos = (fptr->Fptr)->datastart + + (fptr->Fptr)->heapstart + + (fptr->Fptr)->heapsize; + readpos = ((readpos + 2879) / 2880) * 2880; /* start of block */ + +/* the following formula is wrong because the current data unit + may have been extended without updating the headstart value + of the following HDU. + + readpos = (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1]; +*/ + writepos = readpos - ((OFF_T)nblocks * 2880); + + while ( !ffmbyt(fptr, readpos, REPORT_EOF, &tstatus) && + !ffgbyt(fptr, 2880L, buffer, &tstatus) ) + { + ffmbyt(fptr, writepos, REPORT_EOF, status); + ffpbyt(fptr, 2880L, buffer, status); + + if (*status > 0) + { + ffpmsg("Error deleting FITS blocks (ffdblk)"); + return(*status); + } + readpos += 2880; /* increment to next block to transfer */ + writepos += 2880; + } + + /* now fill the last nblock blocks with zeros */ + memset(buffer, 0, 2880); + ffmbyt(fptr, writepos, REPORT_EOF, status); + + for (ii = 0; ii < nblocks; ii++) + ffpbyt(fptr, 2880L, buffer, status); + + /* move back before the deleted blocks, since they may be deleted */ + /* and we do not want to delete the current active buffer */ + ffmbyt(fptr, writepos - 1, REPORT_EOF, status); + + /* truncate the file to the new size, if supported on this device */ + fftrun(fptr, writepos, status); + + /* recalculate the starting location of all subsequent HDUs */ + for (ii = (fptr->Fptr)->curhdu; ii <= (fptr->Fptr)->maxhdu; ii++) + (fptr->Fptr)->headstart[ii + 1] -= ((OFF_T)nblocks * 2880); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffghdt(fitsfile *fptr, /* I - FITS file pointer */ + int *exttype, /* O - type of extension, 0, 1, or 2 */ + /* for IMAGE_HDU, ASCII_TBL, or BINARY_TBL */ + int *status) /* IO - error status */ +/* + Return the type of the CHDU. This returns the 'logical' type of the HDU, + not necessarily the physical type, so in the case of a compressed image + stored in a binary table, this will return the type as an Image, not a + binary table. +*/ +{ + if (*status > 0) + return(*status); + + if (fptr->HDUposition == 0 && (fptr->Fptr)->headend == 0) { + /* empty primary array is alway an IMAGE_HDU */ + *exttype = IMAGE_HDU; + } + else { + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + /* rescan header if data structure is undefined */ + if ( ffrdef(fptr, status) > 0) + return(*status); + } + + *exttype = (fptr->Fptr)->hdutype; /* return the type of HDU */ + + /* check if this is a compressed image */ + if ((fptr->Fptr)->compressimg) + *exttype = IMAGE_HDU; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_is_compressed_image(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Returns TRUE if the CHDU is a compressed image, else returns zero. +*/ +{ + if (*status > 0) + return(0); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + /* rescan header if data structure is undefined */ + if ( ffrdef(fptr, status) > 0) + return(*status); + } + + /* check if this is a compressed image */ + if ((fptr->Fptr)->compressimg) + return(1); + + return(0); +} +/*--------------------------------------------------------------------------*/ +int ffgipr(fitsfile *infptr, /* I - FITS file pointer */ + int maxaxis, /* I - max number of axes to return */ + int *bitpix, /* O - image data type */ + int *naxis, /* O - image dimension (NAXIS value) */ + long *naxes, /* O - size of image dimensions */ + int *status) /* IO - error status */ + +/* + get the datatype and size of the input image +*/ +{ + + if (*status > 0) + return(*status); + + /* don't return the parameter if a null pointer was given */ + + if (bitpix) + fits_get_img_type(infptr, bitpix, status); /* get BITPIX value */ + + if (naxis) + fits_get_img_dim(infptr, naxis, status); /* get NAXIS value */ + + if (naxes) + fits_get_img_size(infptr, maxaxis, naxes, status); /* get NAXISn values */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgidt( fitsfile *fptr, /* I - FITS file pointer */ + int *imgtype, /* O - image data type */ + int *status) /* IO - error status */ +/* + Get the datatype of the image (= BITPIX keyword for normal image, or + ZBITPIX for a compressed image) +*/ +{ + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffgky(fptr, TINT, "BITPIX", imgtype, NULL, status); + } + else if ((fptr->Fptr)->compressimg) + { + /* this is a binary table containing a compressed image */ + ffgky(fptr, TINT, "ZBITPIX", imgtype, NULL, status); + } + else + { + *status = NOT_IMAGE; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgiet( fitsfile *fptr, /* I - FITS file pointer */ + int *imgtype, /* O - image data type */ + int *status) /* IO - error status */ +/* + Get the effective datatype of the image (= BITPIX keyword for normal image, + or ZBITPIX for a compressed image) +*/ +{ + int tstatus; + long lngscale = 1, lngzero = 0; + double bscale, bzero, min_val, max_val; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffgky(fptr, TINT, "BITPIX", imgtype, NULL, status); + tstatus = 0; + ffgky(fptr, TDOUBLE, "BSCALE", &bscale, NULL, &tstatus); + if (tstatus) + bscale = 1.0; + + tstatus = 0; + ffgky(fptr, TDOUBLE, "BZERO", &bzero, NULL, &tstatus); + if (tstatus) + bzero = 0.0; + + } + else if ((fptr->Fptr)->compressimg) + { + /* this is a binary table containing a compressed image */ + ffgky(fptr, TINT, "ZBITPIX", imgtype, NULL, status); + } + else + { + *status = NOT_IMAGE; + return(*status); + + } + + /* check if the BSCALE and BZERO keywords are defined, which might + change the effective datatype of the image */ + tstatus = 0; + ffgky(fptr, TDOUBLE, "BSCALE", &bscale, NULL, &tstatus); + if (tstatus) + bscale = 1.0; + + tstatus = 0; + ffgky(fptr, TDOUBLE, "BZERO", &bzero, NULL, &tstatus); + if (tstatus) + bzero = 0.0; + + if (bscale == 1.0 && bzero == 0.0) /* no scaling */ + return(*status); + + switch (*imgtype) + { + case BYTE_IMG: /* 8-bit image */ + min_val = 0.; + max_val = 255.0; + break; + + case SHORT_IMG: + min_val = -32768.0; + max_val = 32767.0; + break; + + case LONG_IMG: + + min_val = -2147483648.0; + max_val = 2147483647.0; + break; + + default: /* don't have to deal with other data types */ + return(*status); + } + + if (bscale >= 0.) { + min_val = bzero + bscale * min_val; + max_val = bzero + bscale * max_val; + } else { + max_val = bzero + bscale * min_val; + min_val = bzero + bscale * max_val; + } + if (bzero < 2147483648.) /* don't exceed range of 32-bit integer */ + lngzero = bzero; + lngscale = bscale; + + if ((bzero != 2147483648.) && /* special value that exceeds integer range */ + (lngzero != bzero || lngscale != bscale)) { /* not integers? */ + /* floating point scaled values; just decide on required precision */ + if (*imgtype == BYTE_IMG || *imgtype == SHORT_IMG) + *imgtype = FLOAT_IMG; + else + *imgtype = DOUBLE_IMG; + + /* + In all the remaining cases, BSCALE and BZERO are integers, + and not equal to 1 and 0, respectively. + */ + + } else if ((min_val == -128.) && (max_val == 127.)) { + *imgtype = SBYTE_IMG; + + } else if ((min_val >= -32768.0) && (max_val <= 32767.0)) { + *imgtype = SHORT_IMG; + + } else if ((min_val >= 0.0) && (max_val <= 65535.0)) { + *imgtype = USHORT_IMG; + + } else if ((min_val >= -2147483648.0) && (max_val <= 2147483647.0)) { + *imgtype = LONG_IMG; + + } else if ((min_val >= 0.0) && (max_val < 4294967296.0)) { + *imgtype = ULONG_IMG; + + } else { /* exceeds the range of a 32-bit integer */ + *imgtype = DOUBLE_IMG; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgidm( fitsfile *fptr, /* I - FITS file pointer */ + int *naxis , /* O - image dimension (NAXIS value) */ + int *status) /* IO - error status */ +/* + Get the dimension of the image (= NAXIS keyword for normal image, or + ZNAXIS for a compressed image) +*/ +{ + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + ffgky(fptr, TINT, "NAXIS", naxis, NULL, status); + } + else if ((fptr->Fptr)->compressimg) + { + /* this is a binary table containing a compressed image */ + ffgky(fptr, TINT, "ZNAXIS", naxis, NULL, status); + } + else + { + *status = NOT_IMAGE; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgisz( fitsfile *fptr, /* I - FITS file pointer */ + int nlen, /* I - number of axes to return */ + long *naxes , /* O - size of image dimensions */ + int *status) /* IO - error status */ +/* + Get the size of the image dimensions (= NAXISn keywords for normal image, or + ZNAXISn for a compressed image) +*/ +{ + int ii, naxis; + char keyroot[FLEN_KEYWORD], keyname[FLEN_KEYWORD]; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ((fptr->Fptr)->hdutype == IMAGE_HDU) + { + strcpy(keyroot, "NAXIS"); + } + else if ((fptr->Fptr)->compressimg) + { + /* this is a binary table containing a compressed image */ + strcpy(keyroot, "ZNAXIS"); + } + else + { + return(*status = NOT_IMAGE); + } + + /* initialize to 1 */ + for (ii = 0; ii < nlen; ii++) + naxes[ii] = 1; + + /* get number of dimensions */ + fits_get_img_dim(fptr, &naxis, status); + naxis = minvalue(naxis, nlen); + + for (ii = 0; ii < naxis; ii++) + { + ffkeyn(keyroot, ii + 1, keyname, status); + ffgkyj(fptr, keyname, naxes + ii, NULL, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmahd(fitsfile *fptr, /* I - FITS file pointer */ + int hdunum, /* I - number of the HDU to move to */ + int *exttype, /* O - type of extension, 0, 1, or 2 */ + int *status) /* IO - error status */ +/* + Move to Absolute Header Data unit. Move to the specified HDU + and read the header to initialize the table structure. Note that extnum + is one based, so the primary array is extnum = 1. +*/ +{ + int moveto, tstatus; + char message[FLEN_ERRMSG]; + OFF_T *ptr; + + if (*status > 0) + return(*status); + else if (hdunum < 1 ) + return(*status = BAD_HDU_NUM); + else if (hdunum >= (fptr->Fptr)->MAXHDU ) + { + /* allocate more space for the headstart array */ + ptr = (OFF_T*) realloc( (fptr->Fptr)->headstart, + (hdunum + 1001) * sizeof(OFF_T) ); + + if (ptr == NULL) + return (*status = MEMORY_ALLOCATION); + else { + (fptr->Fptr)->MAXHDU = hdunum + 1000; + (fptr->Fptr)->headstart = ptr; + } + } + + /* set logical HDU position to the actual position, in case they differ */ + fptr->HDUposition = (fptr->Fptr)->curhdu; + + while( ((fptr->Fptr)->curhdu) + 1 != hdunum) /* at the correct HDU? */ + { + /* move directly to the extension if we know that it exists, + otherwise move to the highest known extension. */ + + moveto = minvalue(hdunum - 1, ((fptr->Fptr)->maxhdu) + 1); + + /* test if HDU exists */ + if ((fptr->Fptr)->headstart[moveto] < (fptr->Fptr)->logfilesize ) + { + if (ffchdu(fptr, status) <= 0) /* close out the current HDU */ + { + if (ffgext(fptr, moveto, exttype, status) > 0) + { /* failed to get the requested extension */ + + tstatus = 0; + ffrhdu(fptr, exttype, &tstatus); /* restore the CHDU */ + } + } + } + else + *status = END_OF_FILE; + + if (*status > 0) + { + if (*status != END_OF_FILE) + { + /* don't clutter up the message stack in the common case of */ + /* simply hitting the end of file (often an expected error) */ + + sprintf(message, + "Failed to move to HDU number %d (ffmahd).", hdunum); + ffpmsg(message); + } + return(*status); + } + } + + /* return the type of HDU; tile compressed images which are stored */ + /* in a binary table will return exttype = IMAGE_HDU, not BINARY_TBL */ + if (exttype != NULL) + ffghdt(fptr, exttype, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmrhd(fitsfile *fptr, /* I - FITS file pointer */ + int hdumov, /* I - rel. no. of HDUs to move by (+ or -) */ + int *exttype, /* O - type of extension, 0, 1, or 2 */ + int *status) /* IO - error status */ +/* + Move a Relative number of Header Data units. Offset to the specified + extension and read the header to initialize the HDU structure. +*/ +{ + int extnum; + + if (*status > 0) + return(*status); + + extnum = fptr->HDUposition + 1 + hdumov; /* the absolute HDU number */ + ffmahd(fptr, extnum, exttype, status); /* move to the HDU */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmnhd(fitsfile *fptr, /* I - FITS file pointer */ + int exttype, /* I - desired extension type */ + char *hduname, /* I - desired EXTNAME value for the HDU */ + int hduver, /* I - desired EXTVERS value for the HDU */ + int *status) /* IO - error status */ +/* + Move to the next HDU with a given extension type (IMAGE_HDU, ASCII_TBL, + BINARY_TBL, or ANY_HDU), extension name (EXTNAME or HDUNAME keyword), + and EXTVERS keyword values. If hduvers = 0, then move to the first HDU + with the given type and name regardless of EXTVERS value. If no matching + HDU is found in the file, then the current open HDU will remain unchanged. +*/ +{ + char extname[FLEN_VALUE]; + int ii, hdutype, alttype, extnum, tstatus, match, exact; + long extver; + + if (*status > 0) + return(*status); + + extnum = fptr->HDUposition + 1; /* save the current HDU number */ + + for (ii=1; 1; ii++) /* loop until EOF */ + { + tstatus = 0; + if (ffmahd(fptr, ii, &hdutype, &tstatus)) /* move to next HDU */ + { + ffmahd(fptr, extnum, 0, status); /* restore file position */ + return(*status = BAD_HDU_NUM); /* couldn't find desired HDU */ + } + + alttype = -1; + if (fits_is_compressed_image(fptr, status)) + alttype = BINARY_TBL; + + /* matching type? */ + if (exttype == ANY_HDU || hdutype == exttype || hdutype == alttype) + { + if (ffgkys(fptr, "EXTNAME", extname, 0, &tstatus) > 0) /* name */ + { + tstatus = 0; + /* look for HDUNAME, since EXTNAME didn't exist */ + ffgkys(fptr, "HDUNAME", extname, 0, &tstatus); + } + else + { + /* check if EXTNAME is the name we are looking for. */ + /* If not, try reading the HDUNAME keyword. */ + ffcmps(extname, hduname, CASEINSEN, &match, &exact); + if (!exact) + ffgkys(fptr, "HDUNAME", extname, 0, &tstatus); + } + + if (tstatus <= 0) + { + ffcmps(extname, hduname, CASEINSEN, &match, &exact); + if (exact) /* names match? */ + { + if (hduver) /* need to check if version numbers match? */ + { + if (ffgkyj(fptr, "EXTVER", &extver, 0, &tstatus) > 0) + extver = 1; /* assume default EXTVER value */ + + if ( (int) extver == hduver) + { + return(*status); /* found matching name and vers */ + } + } + else + { + return(*status); /* found matching name */ + } + } + } + } + } +} +/*--------------------------------------------------------------------------*/ +int ffthdu(fitsfile *fptr, /* I - FITS file pointer */ + int *nhdu, /* O - number of HDUs in the file */ + int *status) /* IO - error status */ +/* + Return the number of HDUs that currently exist in the file. +*/ +{ + int ii, extnum, tstatus; + + if (*status > 0) + return(*status); + + extnum = fptr->HDUposition + 1; /* save the current HDU number */ + *nhdu = extnum - 1; + + /* if the CHDU is empty or not completely defined, just return */ + if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + return(*status); + + tstatus = 0; + + /* loop until EOF */ + for (ii=extnum; ffmahd(fptr, ii, 0, &tstatus) <= 0; ii++) + { + *nhdu = ii; + } + + ffmahd(fptr, extnum, 0, status); /* restore orig file position */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgext(fitsfile *fptr, /* I - FITS file pointer */ + int hdunum, /* I - no. of HDU to move get (0 based) */ + int *exttype, /* O - type of extension, 0, 1, or 2 */ + int *status) /* IO - error status */ +/* + Get Extension. Move to the specified extension and initialize the + HDU structure. +*/ +{ + int xcurhdu, xmaxhdu; + OFF_T xheadend; + + if (*status > 0) + return(*status); + + if (ffmbyt(fptr, (fptr->Fptr)->headstart[hdunum], REPORT_EOF, status) <= 0) + { + /* temporarily save current values, in case of error */ + xcurhdu = (fptr->Fptr)->curhdu; + xmaxhdu = (fptr->Fptr)->maxhdu; + xheadend = (fptr->Fptr)->headend; + + /* set new parameter values */ + (fptr->Fptr)->curhdu = hdunum; + fptr->HDUposition = hdunum; + (fptr->Fptr)->maxhdu = maxvalue((fptr->Fptr)->maxhdu, hdunum); + (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */ + + if (ffrhdu(fptr, exttype, status) > 0) + { /* failed to get the new HDU, so restore previous values */ + (fptr->Fptr)->curhdu = xcurhdu; + fptr->HDUposition = xcurhdu; + (fptr->Fptr)->maxhdu = xmaxhdu; + (fptr->Fptr)->headend = xheadend; + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffiblk(fitsfile *fptr, /* I - FITS file pointer */ + long nblock, /* I - no. of blocks to insert */ + int headdata, /* I - insert where? 0=header, 1=data */ + /* -1=beginning of file */ + int *status) /* IO - error status */ +/* + insert 2880-byte blocks at the end of the current header or data unit +*/ +{ + int tstatus, savehdu, typhdu; + OFF_T insertpt, jpoint; + long ii, nshift; + char charfill; + char buff1[2880], buff2[2880]; + char *inbuff, *outbuff, *tmpbuff; + char card[FLEN_CARD]; + + if (*status > 0 || nblock <= 0) + return(*status); + + tstatus = *status; + + if (headdata == 0 || (fptr->Fptr)->hdutype == ASCII_TBL) + charfill = 32; /* headers and ASCII tables have space (32) fill */ + else + charfill = 0; /* images and binary tables have zero fill */ + + if (headdata == 0) + insertpt = (fptr->Fptr)->datastart; /* insert just before data, or */ + else if (headdata == -1) + { + insertpt = 0; + strcpy(card, "XTENSION= 'IMAGE ' / IMAGE extension"); + } + else /* at end of data, */ + { + insertpt = (fptr->Fptr)->datastart + + (fptr->Fptr)->heapstart + + (fptr->Fptr)->heapsize; + insertpt = ((insertpt + 2879) / 2880) * 2880; /* start of block */ + + /* the following formula is wrong because the current data unit + may have been extended without updating the headstart value + of the following HDU. + */ + /* insertpt = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1]; */ + } + + inbuff = buff1; /* set pointers to input and output buffers */ + outbuff = buff2; + + memset(outbuff, charfill, 2880); /* initialize buffer with fill */ + + if (nblock == 1) /* insert one block */ + { + if (headdata == -1) + ffmrec(fptr, 1, card, status); /* change SIMPLE -> XTENSION */ + + ffmbyt(fptr, insertpt, REPORT_EOF, status); /* move to 1st point */ + ffgbyt(fptr, 2880, inbuff, status); /* read first block of bytes */ + + while (*status <= 0) + { + ffmbyt(fptr, insertpt, REPORT_EOF, status); /* insert point */ + ffpbyt(fptr, 2880, outbuff, status); /* write the output buffer */ + + if (*status > 0) + return(*status); + + tmpbuff = inbuff; /* swap input and output pointers */ + inbuff = outbuff; + outbuff = tmpbuff; + insertpt += 2880; /* increment insert point by 1 block */ + + ffmbyt(fptr, insertpt, REPORT_EOF, status); /* move to next block */ + ffgbyt(fptr, 2880, inbuff, status); /* read block of bytes */ + } + + *status = tstatus; /* reset status value */ + ffmbyt(fptr, insertpt, IGNORE_EOF, status); /* move back to insert pt */ + ffpbyt(fptr, 2880, outbuff, status); /* write the final block */ + } + + else /* inserting more than 1 block */ + + { + savehdu = (fptr->Fptr)->curhdu; /* save the current HDU number */ + tstatus = *status; + while(*status <= 0) /* find the last HDU in file */ + ffmrhd(fptr, 1, &typhdu, status); + + if (*status == END_OF_FILE) + { + *status = tstatus; + } + + ffmahd(fptr, savehdu + 1, &typhdu, status); /* move back to CHDU */ + if (headdata == -1) + ffmrec(fptr, 1, card, status); /* NOW change SIMPLE -> XTENSION */ + + /* number of 2880-byte blocks that have to be shifted down */ + nshift = ((fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] - insertpt) + / 2880; + /* position of last block in file to be shifted */ + jpoint = (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] - 2880; + + /* move all the blocks starting at end of file working backwards */ + for (ii = 0; ii < nshift; ii++) + { + /* move to the read start position */ + if (ffmbyt(fptr, jpoint, REPORT_EOF, status) > 0) + return(*status); + + ffgbyt(fptr, 2880, inbuff,status); /* read one record */ + + /* move forward to the write postion */ + ffmbyt(fptr, jpoint + (nblock * 2880), IGNORE_EOF, status); + + ffpbyt(fptr, 2880, inbuff, status); /* write the record */ + + jpoint -= 2880; + } + + /* move back to the write start postion (might be EOF) */ + ffmbyt(fptr, insertpt, IGNORE_EOF, status); + + for (ii = 0; ii < nblock; ii++) /* insert correct fill value */ + ffpbyt(fptr, 2880, outbuff, status); + } + + if (headdata == 0) /* update data start address */ + (fptr->Fptr)->datastart += ((OFF_T)nblock * 2880); + + /* update following HDU addresses */ + for (ii = (fptr->Fptr)->curhdu; ii <= (fptr->Fptr)->maxhdu; ii++) + (fptr->Fptr)->headstart[ii + 1] += ((OFF_T)nblock * 2880); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkcl(char *tcard) + +/* + Return the type classification of the input header record + + TYP_STRUC_KEY: SIMPLE, BITPIX, NAXIS, NAXISn, EXTEND, BLOCKED, + GROUPS, PCOUNT, GCOUNT, END + XTENSION, TFIELDS, TTYPEn, TBCOLn, TFORMn, THEAP, + and the first 4 COMMENT keywords in the primary array + that define the FITS format. + + TYP_CMPRS_KEY: + The experimental keywords used in the compressed image format + ZIMAGE, ZCMPTYPE, ZNAMEn, ZVALn, ZTILEn, + ZBITPIX, ZNAXISn, ZSCALE, ZZERO, ZBLANK, + EXTNAME = 'COMPRESSED_IMAGE' + + TYP_SCAL_KEY: BSCALE, BZERO, TSCALn, TZEROn + + TYP_NULL_KEY: BLANK, TNULLn + + TYP_DIM_KEY: TDIMn + + TYP_RANG_KEY: TLMINn, TLMAXn, TDMINn, TDMAXn, DATAMIN, DATAMAX + + TYP_UNIT_KEY: BUNIT, TUNITn + + TYP_DISP_KEY: TDISPn + + TYP_HDUID_KEY: EXTNAME, EXTVER, EXTLEVEL, HDUNAME, HDUVER, HDULEVEL + + TYP_CKSUM_KEY CHECKSUM, DATASUM + + TYP_WCS_KEY: + Primary array: + CTYPEn, CUNITn, CRVALn, CRPIXn, CROTAn, CDELTn + CDj_is, PVj_ms, LONPOLEs, LATPOLEs + + Pixel list: + TCTYPn, TCTYns, TCUNIn, TCUNns, TCRVLn, TCRVns, TCRPXn, TCRPks, + TCDn_k, TCn_ks, TPVn_m, TPn_ms, TCDLTn, TCROTn + + Bintable vector: + jCTYPn, jCTYns, jCUNIn, jCUNns, jCRVLn, jCRVns, iCRPXn, iCRPns, + jiCDn, jiCDns, jPVn_m, jPn_ms, jCDLTn, jCROTn + + TYP_REFSYS_KEY: + EQUINOXs, EPOCH, MJD-OBSs, RADECSYS, RADESYSs + + TYP_COMM_KEY: COMMENT, HISTORY, (blank keyword) + + TYP_CONT_KEY: CONTINUE + + TYP_USER_KEY: all other keywords + +*/ +{ + char card[20], *card1, *card5; + + card[0] = '\0'; + strncat(card, tcard, 8); /* copy the keyword name */ + strcat(card, " "); /* append blanks to make at least 8 chars long */ + ffupch(card); /* make sure it is in upper case */ + + card1 = card + 1; /* pointer to 2nd character */ + card5 = card + 5; /* pointer to 6th character */ + + /* the strncmp function is slow, so try to be more efficient */ + if (*card == 'Z') + { + if (FSTRNCMP (card1, "IMAGE ", 7) == 0) + return (TYP_CMPRS_KEY); + else if (FSTRNCMP (card1, "CMPTYPE", 7) == 0) + return (TYP_CMPRS_KEY); + else if (FSTRNCMP (card1, "NAME", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_CMPRS_KEY); + } + else if (FSTRNCMP (card1, "VAL", 3) == 0) + { + if (*(card + 4) >= '0' && *(card + 4) <= '9') + return (TYP_CMPRS_KEY); + } + else if (FSTRNCMP (card1, "TILE", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_CMPRS_KEY); + } + else if (FSTRNCMP (card1, "BITPIX ", 7) == 0) + return (TYP_CMPRS_KEY); + else if (FSTRNCMP (card1, "NAXIS", 5) == 0) + { + if ( ( *(card + 6) >= '0' && *(card + 6) <= '9' ) + || (*(card + 6) == ' ') ) + return (TYP_CMPRS_KEY); + } + else if (FSTRNCMP (card1, "SCALE ", 7) == 0) + return (TYP_CMPRS_KEY); + else if (FSTRNCMP (card1, "ZERO ", 7) == 0) + return (TYP_CMPRS_KEY); + else if (FSTRNCMP (card1, "BLANK ", 7) == 0) + return (TYP_CMPRS_KEY); + } + else if (*card == ' ') + { + return (TYP_COMM_KEY); + } + else if (*card == '\0') + { + return (TYP_COMM_KEY); + } + else if (*card == 'B') + { + if (FSTRNCMP (card1, "ITPIX ", 7) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "LOCKED ", 7) == 0) + return (TYP_STRUC_KEY); + + if (FSTRNCMP (card1, "LANK ", 7) == 0) + return (TYP_NULL_KEY); + + if (FSTRNCMP (card1, "SCALE ", 7) == 0) + return (TYP_SCAL_KEY); + if (FSTRNCMP (card1, "ZERO ", 7) == 0) + return (TYP_SCAL_KEY); + + if (FSTRNCMP (card1, "UNIT ", 7) == 0) + return (TYP_UNIT_KEY); + } + else if (*card == 'C') + { + if (FSTRNCMP (card1, "OMMENT",6) == 0) + { + /* new comment string starting Oct 2001 */ + if (FSTRNCMP (card1, "OMMENT and Astrophysics', volume 376, page 3", + 46) == 0) + return (TYP_STRUC_KEY); + + /* original COMMENT strings from 1993 - 2001 */ + if (FSTRNCMP (card1, "OMMENT FITS (Flexible Image Transport System", + 46) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "OMMENT Astrophysics Supplement Series v44/p3", + 46) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "OMMENT Contact the NASA Science Office of St", + 46) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "OMMENT FITS Definition document #100 and oth", + 46) == 0) + return (TYP_STRUC_KEY); + + if (*(card + 7) == ' ' || *(card + 7) == '\0') + return (TYP_COMM_KEY); + else + return (TYP_USER_KEY); + } + + if (FSTRNCMP (card1, "HECKSUM", 7) == 0) + return (TYP_CKSUM_KEY); + + if (FSTRNCMP (card1, "ONTINUE", 7) == 0) + return (TYP_CONT_KEY); + + if (FSTRNCMP (card1, "TYPE",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "UNIT",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "RVAL",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "RPIX",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "ROTA",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "DELT",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (*card1 == 'D') + { + if (*(card + 2) >= '0' && *(card + 2) <= '9') + return (TYP_WCS_KEY); + } + } + else if (*card == 'D') + { + if (FSTRNCMP (card1, "ATASUM ", 7) == 0) + return (TYP_CKSUM_KEY); + if (FSTRNCMP (card1, "ATAMIN ", 7) == 0) + return (TYP_RANG_KEY); + if (FSTRNCMP (card1, "ATAMAX ", 7) == 0) + return (TYP_RANG_KEY); + } + else if (*card == 'E') + { + if (FSTRNCMP (card1, "XTEND ", 7) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "ND ", 7) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "XTNAME ", 7) == 0) + { + /* check for special compressed image value */ + if (FSTRNCMP(tcard, "EXTNAME = 'COMPRESSED_IMAGE'", 28) == 0) + return (TYP_CMPRS_KEY); + else + return (TYP_HDUID_KEY); + } + if (FSTRNCMP (card1, "XTVER ", 7) == 0) + return (TYP_HDUID_KEY); + if (FSTRNCMP (card1, "XTLEVEL", 7) == 0) + return (TYP_HDUID_KEY); + + if (FSTRNCMP (card1, "QUINOX", 6) == 0) + return (TYP_REFSYS_KEY); + if (FSTRNCMP (card1, "POCH ", 7) == 0) + return (TYP_REFSYS_KEY); + } + else if (*card == 'G') + { + if (FSTRNCMP (card1, "COUNT ", 7) == 0) + return (TYP_STRUC_KEY); + if (FSTRNCMP (card1, "ROUPS ", 7) == 0) + return (TYP_STRUC_KEY); + } + else if (*card == 'H') + { + if (FSTRNCMP (card1, "DUNAME ", 7) == 0) + return (TYP_HDUID_KEY); + if (FSTRNCMP (card1, "DUVER ", 7) == 0) + return (TYP_HDUID_KEY); + if (FSTRNCMP (card1, "DULEVEL", 7) == 0) + return (TYP_HDUID_KEY); + + if (FSTRNCMP (card1, "ISTORY",6) == 0) + { + if (*(card + 7) == ' ' || *(card + 7) == '\0') + return (TYP_COMM_KEY); + else + return (TYP_USER_KEY); + } + } + else if (*card == 'L') + { + if (FSTRNCMP (card1, "ONPOLE",6) == 0) + return (TYP_WCS_KEY); + if (FSTRNCMP (card1, "ATPOLE",6) == 0) + return (TYP_WCS_KEY); + } + else if (*card == 'M') + { + if (FSTRNCMP (card1, "JD_OBS ", 7) == 0) + return (TYP_REFSYS_KEY); + } + else if (*card == 'N') + { + if (FSTRNCMP (card1, "AXIS", 4) == 0) + { + if ((*card5 >= '0' && *card5 <= '9') + || (*card5 == ' ')) + return (TYP_STRUC_KEY); + } + } + else if (*card == 'P') + { + if (FSTRNCMP (card1, "COUNT ", 7) == 0) + return (TYP_STRUC_KEY); + } + else if (*card == 'R') + { + if (FSTRNCMP (card1, "ADECSYS", 7) == 0) + return (TYP_REFSYS_KEY); + if (FSTRNCMP (card1, "ADESYS", 6) == 0) + return (TYP_REFSYS_KEY); + } + else if (*card == 'S') + { + if (FSTRNCMP (card1, "IMPLE ", 7) == 0) + return (TYP_STRUC_KEY); + } + else if (*card == 'T') + { + if (FSTRNCMP (card1, "TYPE", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_STRUC_KEY); + } + else if (FSTRNCMP (card1, "FORM", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_STRUC_KEY); + } + else if (FSTRNCMP (card1, "BCOL", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_STRUC_KEY); + } + else if (FSTRNCMP (card1, "FIELDS ", 7) == 0) + return (TYP_STRUC_KEY); + else if (FSTRNCMP (card1, "HEAP ", 7) == 0) + return (TYP_STRUC_KEY); + + else if (FSTRNCMP (card1, "NULL", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_NULL_KEY); + } + + else if (FSTRNCMP (card1, "DIM", 3) == 0) + { + if (*(card + 4) >= '0' && *(card + 4) <= '9') + return (TYP_DIM_KEY); + } + + else if (FSTRNCMP (card1, "UNIT", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_UNIT_KEY); + } + + else if (FSTRNCMP (card1, "DISP", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_DISP_KEY); + } + + else if (FSTRNCMP (card1, "SCAL", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_SCAL_KEY); + } + else if (FSTRNCMP (card1, "ZERO", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_SCAL_KEY); + } + + else if (FSTRNCMP (card1, "LMIN", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_RANG_KEY); + } + else if (FSTRNCMP (card1, "LMAX", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_RANG_KEY); + } + else if (FSTRNCMP (card1, "DMIN", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_RANG_KEY); + } + else if (FSTRNCMP (card1, "DMAX", 4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_RANG_KEY); + } + + else if (FSTRNCMP (card1, "CTYP",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "CUNI",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "CRVL",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "CRPX",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "CROT",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "CDLT",4) == 0) + { + if (*card5 >= '0' && *card5 <= '9') + return (TYP_WCS_KEY); + } + else if (FSTRNCMP (card1, "CD",2) == 0) + { + if (*(card + 3) >= '0' && *(card + 3) <= '9') + return (TYP_WCS_KEY); + } + } + else if (*card == 'X') + { + if (FSTRNCMP (card1, "TENSION", 7) == 0) + return (TYP_STRUC_KEY); + } + + return (TYP_USER_KEY); /* by default all others are user keywords */ +} +/*--------------------------------------------------------------------------*/ +int ffdtyp(char *cval, /* I - formatted string representation of the value */ + char *dtype, /* O - datatype code: C, L, F, I, or X */ + int *status) /* IO - error status */ +/* + determine implicit datatype of input string. + This assumes that the string conforms to the FITS standard + for keyword values, so may not detect all invalid formats. +*/ +{ + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (cval[0] == '\0') + return(*status = VALUE_UNDEFINED); + else if (cval[0] == '\'') + *dtype = 'C'; /* character string starts with a quote */ + else if (cval[0] == 'T' || cval[0] == 'F') + *dtype = 'L'; /* logical = T or F character */ + else if (cval[0] == '(') + *dtype = 'X'; /* complex datatype "(1.2, -3.4)" */ + else if (strchr(cval,'.')) + *dtype = 'F'; /* float usualy contains a decimal point */ + else if (strchr(cval,'E') || strchr(cval,'D') ) + *dtype = 'F'; /* exponential contains a E or D */ + else + *dtype = 'I'; /* if none of the above assume it is integer */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2x(char *cval, /* I - formatted string representation of the value */ + char *dtype, /* O - datatype code: C, L, F, I or X */ + + /* Only one of the following will be defined, depending on datatype */ + long *ival, /* O - integer value */ + int *lval, /* O - logical value */ + char *sval, /* O - string value */ + double *dval, /* O - double value */ + + int *status) /* IO - error status */ +/* + high level routine to convert formatted character string to its + intrinsic data type +*/ +{ + ffdtyp(cval, dtype, status); /* determine the datatype */ + + if (*dtype == 'I') + ffc2ii(cval, ival, status); + else if (*dtype == 'F') + ffc2dd(cval, dval, status); + else if (*dtype == 'L') + ffc2ll(cval, lval, status); + else + ffc2s(cval, sval, status); /* C and X formats */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2i(char *cval, /* I - string representation of the value */ + long *ival, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert formatted string to an integer value, doing implicit + datatype conversion if necessary. +*/ +{ + char dtype, sval[81], msg[81]; + int lval; + double dval; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (cval[0] == '\0') + return(*status = VALUE_UNDEFINED); /* null value string */ + + /* convert the keyword to its native datatype */ + ffc2x(cval, &dtype, ival, &lval, sval, &dval, status); + + if (dtype == 'X' ) + { + *status = BAD_INTKEY; + } + else if (dtype == 'C') + { + /* try reading the string as a number */ + if (ffc2dd(sval, &dval, status) <= 0) + { + if (dval > (double) LONG_MAX || dval < (double) LONG_MIN) + *status = NUM_OVERFLOW; + else + *ival = (long) dval; + } + } + else if (dtype == 'F') + { + if (dval > (double) LONG_MAX || dval < (double) LONG_MIN) + *status = NUM_OVERFLOW; + else + *ival = (long) dval; + } + else if (dtype == 'L') + { + *ival = (long) lval; + } + + if (*status > 0) + { + *ival = 0; + strcpy(msg,"Error in ffc2i evaluating string as an integer: "); + strncat(msg,cval,30); + ffpmsg(msg); + return(*status); + } + + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2l(char *cval, /* I - string representation of the value */ + int *lval, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert formatted string to a logical value, doing implicit + datatype conversion if necessary +*/ +{ + char dtype, sval[81], msg[81]; + long ival; + double dval; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (cval[0] == '\0') + return(*status = VALUE_UNDEFINED); /* null value string */ + + /* convert the keyword to its native datatype */ + ffc2x(cval, &dtype, &ival, lval, sval, &dval, status); + + if (dtype == 'C' || dtype == 'X' ) + *status = BAD_LOGICALKEY; + + if (*status > 0) + { + *lval = 0; + strcpy(msg,"Error in ffc2l evaluating string as a logical: "); + strncat(msg,cval,30); + ffpmsg(msg); + return(*status); + } + + if (dtype == 'I') + { + if (ival) + *lval = 1; + else + *lval = 0; + } + else if (dtype == 'F') + { + if (dval) + *lval = 1; + else + *lval = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2r(char *cval, /* I - string representation of the value */ + float *fval, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert formatted string to a real float value, doing implicit + datatype conversion if necessary +*/ +{ + char dtype, sval[81], msg[81]; + int lval; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (cval[0] == '\0') + return(*status = VALUE_UNDEFINED); /* null value string */ + + ffdtyp(cval, &dtype, status); /* determine the datatype */ + + if (dtype == 'I' || dtype == 'F') + ffc2rr(cval, fval, status); + else if (dtype == 'L') + { + ffc2ll(cval, &lval, status); + *fval = (float) lval; + } + else if (dtype == 'C') + { + /* try reading the string as a number */ + ffc2s(cval, sval, status); + ffc2rr(sval, fval, status); + } + else + *status = BAD_FLOATKEY; + + if (*status > 0) + { + *fval = 0.; + strcpy(msg,"Error in ffc2r evaluating string as a float: "); + strncat(msg,cval,30); + ffpmsg(msg); + return(*status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2d(char *cval, /* I - string representation of the value */ + double *dval, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert formatted string to a double value, doing implicit + datatype conversion if necessary +*/ +{ + char dtype, sval[81], msg[81]; + int lval; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (cval[0] == '\0') + return(*status = VALUE_UNDEFINED); /* null value string */ + + ffdtyp(cval, &dtype, status); /* determine the datatype */ + + if (dtype == 'I' || dtype == 'F') + ffc2dd(cval, dval, status); + else if (dtype == 'L') + { + ffc2ll(cval, &lval, status); + *dval = (double) lval; + } + else if (dtype == 'C') + { + /* try reading the string as a number */ + ffc2s(cval, sval, status); + ffc2dd(sval, dval, status); + } + else + *status = BAD_DOUBLEKEY; + + if (*status > 0) + { + *dval = 0.; + strcpy(msg,"Error in ffc2d evaluating string as a double: "); + strncat(msg,cval,30); + ffpmsg(msg); + return(*status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2ii(char *cval, /* I - string representation of the value */ + long *ival, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert null-terminated formatted string to an integer value +*/ +{ + char *loc, msg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + errno = 0; + *ival = 0; + *ival = strtol(cval, &loc, 10); /* read the string as an integer */ + + /* check for read error, or junk following the integer */ + if (*loc != '\0' && *loc != ' ' ) + *status = BAD_C2I; + + if (errno == ERANGE) + { + strcpy(msg,"Range Error in ffc2ii converting string to long int: "); + strncat(msg,cval,25); + ffpmsg(msg); + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2ll(char *cval, /* I - string representation of the value: T or F */ + int *lval, /* O - numerical value of the input string: 1 or 0 */ + int *status) /* IO - error status */ +/* + convert null-terminated formatted string to a logical value +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (cval[0] == 'T') + *lval = 1; + else + *lval = 0; /* any character besides T is considered false */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2s(char *instr, /* I - null terminated quoted input string */ + char *outstr, /* O - null terminated output string without quotes */ + int *status) /* IO - error status */ +/* + convert an input quoted string to an unquoted string by removing + the leading and trailing quote character. Also, replace any + pairs of single quote characters with just a single quote + character (FITS used a pair of single quotes to represent + a literal quote character within the string). +*/ +{ + int jj; + size_t len, ii; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (instr[0] != '\'') + { + strcpy(outstr, instr); /* no leading quote, so return input string */ + return(*status); + } + + len = strlen(instr); + + for (ii=1, jj=0; ii < len; ii++, jj++) + { + if (instr[ii] == '\'') /* is this the closing quote? */ + { + if (instr[ii+1] == '\'') /* 2 successive quotes? */ + ii++; /* copy only one of the quotes */ + else + break; /* found the closing quote, so exit this loop */ + } + outstr[jj] = instr[ii]; /* copy the next character to the output */ + } + + outstr[jj] = '\0'; /* terminate the output string */ + + if (ii == len) + { + ffpmsg("This string value has no closing quote (ffc2s):"); + ffpmsg(instr); + return(*status = 205); + } + + for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */ + { + if (outstr[jj] == ' ') + outstr[jj] = 0; + else + break; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2rr(char *cval, /* I - string representation of the value */ + float *fval, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert null-terminated formatted string to a float value +*/ +{ + char *loc, msg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + errno = 0; + *fval = 0.; + *fval = (float) strtod(cval, &loc); /* read the string as an float */ + + /* check for read error, or junk following the value */ + if (*loc != '\0' && *loc != ' ' ) + { + strcpy(msg,"Error in ffc2rr converting string to float: "); + strncat(msg,cval,30); + ffpmsg(msg); + + *status = BAD_C2F; + } + + if (errno == ERANGE) + { + strcpy(msg,"Error in ffc2rr converting string to float: "); + strncat(msg,cval,30); + ffpmsg(msg); + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2dd(char *cval, /* I - string representation of the value */ + double *dval, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert null-terminated formatted string to a double value +*/ +{ + char msg[81], tval[73], *loc; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + + strcpy(tval, cval); + loc = strchr(tval, 'D'); + + if (loc) /* The C language does not support a 'D' */ + *loc = 'E'; /* exponent so replace any D's with E's. */ + errno = 0; + *dval = 0.; + *dval = strtod(tval, &loc); /* read the string as an double */ + + /* check for read error, or junk following the value */ + if (*loc != '\0' && *loc != ' ' ) + { + strcpy(msg,"Error in ffc2dd converting string to double: "); + strncat(msg,cval,30); + ffpmsg(msg); + + *status = BAD_C2D; + } + + if (errno == ERANGE) + { + strcpy(msg,"Error in ffc2dd converting string to double: "); + strncat(msg,cval,30); + ffpmsg(msg); + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/fitsio.doc b/pkg/tbtables/cfitsio/fitsio.doc new file mode 100644 index 00000000..4f639330 --- /dev/null +++ b/pkg/tbtables/cfitsio/fitsio.doc @@ -0,0 +1,6137 @@ + FITSIO - An Interface to FITS Format Files for Fortran Programmers + + William D Pence, HEASARC, NASA/GSFC + Version 2.4 + + +[Note: This file contains various formatting command symbols in the first +column which are used when generating the LATeX version of this document.] + +*I. Introduction + +This document describes the Fortran-callable subroutine interface that +is provided as part of the CFITSIO library (which is written in ANSI +C). This is a companion document to the CFITSIO User's Guide which +should be consulted for further information about the underlying +CFITSIO library. In the remainder of this document, the terms FITSIO +and CFITSIO are interchangeable and refer to the same library. + +FITSIO/CFITSIO is a machine-independent library of routines for reading +and writing data files in the FITS (Flexible Image Transport System) +data format. It can also read IRAF format image files and raw binary +data arrays by converting them on the fly into a virtual FITS format +file. This library was written to provide a powerful yet simple +interface for accessing FITS files which will run on most commonly used +computers and workstations. FITSIO supports all the features described +in the official NOST definition of the FITS format and can read and +write all the currently defined types of extensions, including ASCII +tables (TABLE), Binary tables (BINTABLE) and IMAGE extensions. The +FITSIO subroutines insulate the programmer from having to deal with the +complicated formatting details in the FITS file, however, it is assumed +that users have a general knowledge about the structure and usage of +FITS files. + +The CFITSIO package was initially developed by the HEASARC (High Energy +Astrophysics Science Archive Research Center) at the NASA Goddard Space +Flight Center to convert various existing and newly acquired +astronomical data sets into FITS format and to further analyze data +already in FITS format. New features continue to be added to CFITSIO +in large part due to contributions of ideas or actual code from users +of the package. The Integral Science Data Center in Switzerland, and +the XMM/ESTEC project in The Netherlands made especially significant +contributions that resulted in many of the new features that appeared +in v2.0 of CFITSIO. + +The latest version of the CFITSIO source code, documentation, and +example programs are available on the World-Wide Web or via anonymous +ftp from: +- + http://heasarc.gsfc.nasa.gov/fitsio + ftp://legacy.gsfc.nasa.gov/software/fitsio/c +- +\newpage +Any questions, bug reports, or suggested enhancements related to the CFITSIO +package should be sent to the primary author: +- + Dr. William Pence Telephone: (301) 286-4599 + HEASARC, Code 662 E-mail: pence@tetra.gsfc.nasa.gov + NASA/Goddard Space Flight Center + Greenbelt, MD 20771, USA +- +This User's Guide assumes that readers already have a general +understanding of the definition and structure of FITS format files. +Further information about FITS formats is available from the FITS Support +Office at {\tt http://fits.gsfc.nasa.gov}. In particular, the +'NOST FITS Standard' gives the authoritative definition of the FITS data +format, and the `FITS User's Guide' provides additional historical background +and practical advice on using FITS files. + +CFITSIO users may also be interested in the FTOOLS package of programs +that can be used to manipulate and analyze FITS format files. +Information about FTOOLS can be obtained on the Web or via anonymous +ftp at: +- + http://heasarc.gsfc.nasa.gov/ftools + ftp://legacy.gsfc.nasa.gov/software/ftools/release +- + +*II. Creating FITSIO/CFITSIO + +**A. Building the Library + +To use the FITSIO subroutines one must first build the CFITSIO library, +which requires a C compiler. gcc is ideal, or most other ANSI-C +compilers will also work. The CFITSIO code is contained in about 40 C +source files (*.c) and header files (*.h). On VAX/VMS systems 2 +assembly-code files (vmsieeed.mar and vmsieeer.mar) are also needed. + +The Fortran interface subroutines to the C CFITSIO routines are located +in the f77\_wrap1.c, through f77\_wrap4.c files. These are relatively simple +'wrappers' that translate the arguments in the Fortran subroutine into +the appropriate format for the corresponding C routine. This +translation is performed transparently to the user by a set of C macros +located in the cfortran.h file. Unfortunately cfortran.h does not +support every combination of C and Fortran compilers so the Fortran +interface is not supported on all platforms. (see further notes below). + +A standard combination of C and Fortran compilers will be assumed by +default, but one may also specify a particular Fortran compiler by +doing: +- + > setenv CFLAGS -DcompilerName=1 +- +(where 'compilerName' is the name of the compiler) before running +the configure command. The currently recognized compiler +names are: +- + g77Fortran + IBMR2Fortran + CLIPPERFortran + pgiFortran + NAGf90Fortran + f2cFortran + hpuxFortran + apolloFortran + sunFortran + CRAYFortran + mipsFortran + DECFortran + vmsFortran + CONVEXFortran + PowerStationFortran + AbsoftUNIXFortran + AbsoftProFortran + SXFortran +- +Alternatively, one may edit the CFLAGS line in the Makefile to add the +'-DcompilerName' flag after running the './configure' command. + +The CFITSIO library is built on Unix systems by typing: +- + > ./configure [--prefix=/target/installation/path] + > make (or 'make shared') + > make install (this step is optional) +- +at the operating system prompt. The configure command customizes the +Makefile for the particular system, then the `make' command compiles the +source files and builds the library. Type `./configure' and not simply +`configure' to ensure that the configure script in the current directory +is run and not some other system-wide configure script. The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, +- + > ./configure --prefix=/usr1/local +- +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include file to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +By default this also builds the set of Fortran-callable +wrapper routines whose calling sequences are described later in this +document. + +The 'make shared' option builds a shared or dynamic version of the +CFITSIO library. When using the shared library the executable code is +not copied into your program at link time and instead the program +locates the necessary library code at run time, normally through +LD\_LIBRARY\_PATH or some other method. The advantages of using a shared +library are: +- + 1. Less disk space if you build more than 1 program + 2. Less memory if more than one copy of a program using the shared + library is running at the same time since the system is smart + enough to share copies of the shared library at run time. + 3. Possibly easier maintenance since a new version of the shared + library can be installed without relinking all the software + that uses it (as long as the subroutine names and calling + sequences remain unchanged). + 4. No run-time penalty. +- +The disadvantages are: +- + 1. More hassle at runtime. You have to either build the programs + specially or have LD_LIBRARY_PATH set right. + 2. There may be a slight start up penalty, depending on where you are + reading the shared library and the program from and if your CPU is + either really slow or really heavily loaded. +- + +On HP/UX systems, the environment variable CFLAGS should be set +to -Ae before running configure to enable "extended ANSI" features. + +It may not be possible to staticly link programs that use CFITSIO on +some platforms (namely, on Solaris 2.6) due to the network drivers +(which provide FTP and HTTP access to FITS files). It is possible to +make both a dynamic and a static version of the CFITSIO library, but +network file access will not be possible using the static version. + +On VAX/VMS and ALPHA/VMS systems the make\_gfloat.com command file may +be executed to build the cfitsio.olb object library using the default +G-floating point option for double variables. The make\_dfloat.com and +make\_ieee.com files may be used instead to build the library with the +other floating point options. Note that the getcwd function that is +used in the group.c module may require that programs using CFITSIO be +linked with the ALPHA\$LIBRARY:VAXCRTL.OLB library. See the example +link line in the next section of this document. + +On Windows IBM-PC type platforms the situation is more complicated +because of the wide variety of Fortran compilers that are available and +because of the inherent complexities of calling the CFITSIO C routines +from Fortran. Two different versions of the CFITSIO dll library are +available, compiled with the Borland C++ compiler and the Microsoft +Visual C++ compiler, respectively, in the files +cfitsiodll\_2xxx\_borland.zip and cfitsiodll\_2xxx\_vcc.zip, where +'2xxx' represents the current release number. Both these dll libraries +contain a set of Fortran wrapper routines which may be compatible with +some, but probably not all, available Fortran compilers. To test if +they are compatible, compile the program testf77.f and try linking to +these dll libraries. If these libraries do not work with a particular +Fortran compiler, then there are 2 possible solutions. The first +solution would be to modify the file cfortran.h for that particular +combination of C and Fortran compilers, and then rebuild the CFITSIO +dll library. This will require, however, a some expertise in +mixed language programming. +The other solution is to use the older v5.03 Fortran-77 implementation +of FITSIO that is still available from the FITSIO web-site. This +version is no longer supported, but it does provide the basic functions +for reading and writing FITS files and should be compatible with most +Fortran compilers. + +CFITSIO has currently been tested on the following platforms: +- + OPERATING SYSTEM COMPILER + Sun OS gcc and cc (3.0.1) + Sun Solaris gcc and cc + Silicon Graphics IRIX gcc and cc + Silicon Graphics IRIX64 MIPS + Dec Alpha OSF/1 gcc and cc + DECstation Ultrix gcc + Dec Alpha OpenVMS cc + DEC VAX/VMS gcc and cc + HP-UX gcc + IBM AIX gcc + Linux gcc + MkLinux DR3 + Windows 95/98/NT Borland C++ V4.5 + Windows 95/98/NT/ME/XP Microsoft/Compaq Visual C++ v5.0, v6.0 + Windows 95/98/NT Cygwin gcc + OS/2 gcc + EMX + MacOS 7.1 or greater Metrowerks 10.+ +- +CFITSIO will probably run on most other Unix platforms. Cray +supercomputers are currently not supported. + +**B. Testing the Library + +The CFITSIO library should be tested by building and running +the testprog.c program that is included with the release. +On Unix systems type: +- + % make testprog + % testprog > testprog.lis + % diff testprog.lis testprog.out + % cmp testprog.fit testprog.std +- + On VMS systems, +(assuming cc is the name of the C compiler command), type: +- + $ cc testprog.c + $ link testprog, cfitsio/lib, alpha$library:vaxcrtl/lib + $ run testprog +- +The testprog program should produce a FITS file called `testprog.fit' +that is identical to the `testprog.std' FITS file included with this +release. The diagnostic messages (which were piped to the file +testprog.lis in the Unix example) should be identical to the listing +contained in the file testprog.out. The 'diff' and 'cmp' commands +shown above should not report any differences in the files. (There +may be some minor formatting differences, such as the presence or +absence of leading zeros, or 3 digit exponents in numbers, +which can be ignored). + +The Fortran wrappers in CFITSIO may be tested with the testf77 +program. On Unix systems the fortran compilation and link command +may be called 'f77' or 'g77', depending on the system. +- + % f77 -o testf77 testf77.f -L. -lcfitsio -lnsl -lsocket + or + % f77 -f -o testf77 testf77.f -L. -lcfitsio (under SUN O/S) + or + % f77 -o testf77 testf77.f -Wl,-L. -lcfitsio -lm -lnsl -lsocket (HP/UX) + or + % g77 -o testf77 -s testf77.f -lcfitsio -lcc_dynamic -lncurses (Mac OS-X) + + % testf77 > testf77.lis + % diff testf77.lis testf77.out + % cmp testf77.fit testf77.std +- +On machines running SUN O/S, Fortran programs must be compiled with the +'-f' option to force double precision variables to be aligned on 8-byte +boundarys to make the fortran-declared variables compatible with C. A +similar compiler option may be required on other platforms. Failing to +use this option may cause the program to crash on FITSIO routines that +read or write double precision variables. + +Also note that on some systems, the output listing of the testf77 +program may differ slightly from the testf77.std template, if leading +zeros are not printed by default before the decimal point when using F +format. + +A few other utility programs are included with CFITSIO: +- + speed - measures the maximum throughput (in MB per second) + for writing and reading FITS files with CFITSIO + + listhead - lists all the header keywords in any FITS file + + fitscopy - copies any FITS file (especially useful in conjunction + with the CFITSIO's extended input filename syntax) + + cookbook - a sample program that peforms common read and + write operations on a FITS file. + + iter_a, iter_b, iter_c - examples of the CFITSIO iterator routine +- + +The first 4 of these utility programs can be compiled and linked by typing +- + % make program_name +- + +**C. Linking Programs with FITSIO + +When linking applications software with the FITSIO library, several system libraries usually need to be specified on the link command line. On +Unix systems, the most reliable way to determine what libraries are required +is to type 'make testprog' and see what libraries the configure script has +added. The typical libraries that may need to be added are -lm (the math +library) and -lnsl and -lsocket (needed only for FTP and HTTP file access). +These latter 2 libraries are not needed on VMS and Windows platforms, +because FTP file access is not currently supported on those platforms. + +Note that when upgrading to a newer version of CFITSIO it is usually +necessay to recompile, as well as relink, the programs that use CFITSIO, +because the definitions in fitsio.h often change. + +**D. Getting Started with FITSIO + +In order to effectively use the FITSIO library as quickly as possible, +it is recommended that new users follow these steps: + +1. Read the following `FITS Primer' chapter for a brief +overview of the structure of FITS files. This is especially important +for users who have not previously dealt with the FITS table and image +extensions. + +2. Write a simple program to read or write a FITS file using the Basic +Interface routines. + +3. Refer to the cookbook.f program that is included with this release +for examples of routines that perform various common FITS file +operations. + +4. Read Chapters 4 and 5 to become familiar with the conventions and +advanced features of the FITSIO interface. + +5. Scan through the more extensive set of routines that are provided +in the `Advanced Interface'. These routines perform more specialized +functions than are provided by the Basic Interface routines. + +**E. Example Program + +The following listing shows an example of how to use the FITSIO +routines in a Fortran program. Refer to the cookbook.f program that +is included with the FITSIO distribution for examples of other +FITS programs. +- + program writeimage + +C Create a FITS primary array containing a 2-D image + + integer status,unit,blocksize,bitpix,naxis,naxes(2) + integer i,j,group,fpixel,nelements,array(300,200) + character filename*80 + logical simple,extend + + status=0 +C Name of the FITS file to be created: + filename='ATESTFILE.FITS' + +C Get an unused Logical Unit Number to use to create the FITS file + call ftgiou(unit,status) + +C create the new empty FITS file + blocksize=1 + call ftinit(unit,filename,blocksize,status) + +C initialize parameters about the FITS image (300 x 200 16-bit integers) + simple=.true. + bitpix=16 + naxis=2 + naxes(1)=300 + naxes(2)=200 + extend=.true. + +C write the required header keywords + call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status) + +C initialize the values in the image with a linear ramp function + do j=1,naxes(2) + do i=1,naxes(1) + array(i,j)=i+j + end do + end do + +C write the array to the FITS file + group=1 + fpixel=1 + nelements=naxes(1)*naxes(2) + call ftpprj(unit,group,fpixel,nelements,array,status) + +C write another optional keyword to the header + call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status) + +C close the file and free the unit number + call ftclos(unit, status) + call ftfiou(unit, status) + end +- + +**F. Legal Stuff + +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. +(However, see the restriction on the use of the gzip compression code, +below). + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER." + +The file compress.c contains (slightly modified) source code that +originally came from gzip-1.2.4, copyright (C) 1992-1993 by Jean-loup +Gailly. This gzip code is distributed under the GNU General Public +License and thus requires that any software that uses the CFITSIO +library (which in turn uses the gzip code) must conform to the +provisions in the GNU General Public License. A copy of the GNU +license is included at the beginning of compress.c file. + +An alternate version of the compress.c file (called +compress\_alternate.c) is provided for users who want to use the CFITSIO +library but are unwilling or unable to publicly release their software +under the terms of the GNU General Public License. This alternate +version contains non-functional stubs for the file compression and +uncompression routines used by CFITSIO. Replace the file `compress.c' +with `compress\_alternate.c' before compiling the CFITSIO library. This +will produce a version of CFITSIO which does not support reading or +writing compressed FITS files but is otherwise identical to the +standard version. + +**G. Acknowledgements + +The development of many of the powerful features in CFITSIO was made +possible through collaborations with many people or organizations from +around the world. The following, in particular, have made especially +significant contributions: + +Programmers from the Integral Science Data Center, Switzerland (namely, +Jurek Borkowski, Bruce O'Neel, and Don Jennings), designed the concept +for the plug-in I/O drivers that was introduced with CFITSIO 2.0. The +use of `drivers' greatly simplified the low-level I/O, which in turn +made other new features in CFITSIO (e.g., support for compressed FITS +files and support for IRAF format image files) much easier to +implement. Jurek Borkowski wrote the Shared Memory driver, and Bruce +O'Neel wrote the drivers for accessing FITS files over the network +using the FTP, HTTP, and ROOT protocols. + +The ISDC also provided the template parsing routines (written by Jurek +Borkowski) and the hierarchical grouping routines (written by Don +Jennings). The ISDC DAL (Data Access Layer) routines are layered on +top of CFITSIO and make extensive use of these features. + +Uwe Lammers (XMM/ESA/ESTEC, The Netherlands) designed the +high-performance lexical parsing algorithm that is used to do +on-the-fly filtering of FITS tables. This algorithm essentially +pre-compiles the user-supplied selection expression into a form that +can be rapidly evaluated for each row. Peter Wilson (RSTX, NASA/GSFC) +then wrote the parsing routines used by CFITSIO based on Lammers' +design, combined with other techniques such as the CFITSIO iterator +routine to further enhance the data processing throughput. This effort +also benefited from a much earlier lexical parsing routine that was +developed by Kent Blackburn (NASA/GSFC). More recently, Craig Markwardt +(NASA/GSFC) implemented additional functions (median, average, stddev) +and other enhancements to the lexical parser. + +The CFITSIO iterator function is loosely based on similar ideas +developed for the XMM Data Access Layer. + +Peter Wilson (RSTX, NASA/GSFC) wrote the complete set of +Fortran-callable wrappers for all the CFITSIO routines, which in turn +rely on the CFORTRAN macro developed by Burkhard Burow. + +The syntax used by CFITSIO for filtering or binning input FITS files is +based on ideas developed for the AXAF Science Center Data Model by +Jonathan McDowell, Antonella Fruscione, Aneta Siemiginowska and Bill +Joye. See http://heasarc.gsfc.nasa.gov/docs/journal/axaf7.html for +further description of the AXAF Data Model. + +The file decompression code were taken directly from the gzip (GNU zip) +program developed by Jean-loup Gailly and others. + +Doug Mink, SAO, provided the routines for converting IRAF format +images into FITS format. + +In addition, many other people have made valuable contributions to the +development of CFITSIO. These include (with apologies to others that may +have inadvertently been omitted): + +Steve Allen, Carl Akerlof, Keith Arnaud, Morten Krabbe Barfoed, Kent +Blackburn, G Bodammer, Romke Bontekoe, Lucio Chiappetti, Keith Costorf, +Robin Corbet, John Davis, Richard Fink, Ning Gan, Emily Greene, Joe +Harrington, Cheng Ho, Phil Hodge, Jim Ingham, Yoshitaka Ishisaki, Diab +Jerius, Mark Levine, Todd Karakaskian, Edward King, Scott Koch, Claire +Larkin, Rob Managan, Eric Mandel, John Mattox, Carsten Meyer, Emi +Miyata, Stefan Mochnacki, Mike Noble, Oliver Oberdorf, Clive Page, +Arvind Parmar, Jeff Pedelty, Tim Pearson, Maren Purves, Scott Randall, +Chris Rogers, Arnold Rots, Barry Schlesinger, Robin Stebbins, Andrew +Szymkowiak, Allyn Tennant, Peter Teuben, James Theiler, Doug Tody, +Shiro Ueno, Steve Walton, Archie Warnock, Alan Watson, Dan Whipple, Wim +Wimmers, Peter Young, Jianjun Xu, and Nelson Zarate. + + +*III. A FITS Primer + +This section gives a brief overview of the structure of FITS files. +Users should refer to the documentation available from the NOST, as +described in the introduction, for more detailed information on FITS +formats. + +FITS was first developed in the late 1970's as a standard data +interchange format between various astronomical observatories. Since +then FITS has become the defacto standard data format supported by most +astronomical data analysis software packages. + +A FITS file consists of one or more Header + Data Units (HDUs), where +the first HDU is called the `Primary HDU', or `Primary Array'. The +primary array contains an N-dimensional array of pixels, such as a 1-D +spectrum, a 2-D image, or a 3-D data cube. Five different primary +datatypes are supported: Unsigned 8-bit bytes, 16 and 32-bit signed +integers, and 32 and 64-bit floating point reals. FITS also has a +convention for storing 16 and 32-bit unsigned integers (see the later +section entitled `Unsigned Integers' for more details). The primary HDU +may also consist of only a header with a null array containing no +data pixels. + +Any number of additional HDUs may follow the primary array; these +additional HDUs are called FITS `extensions'. There are currently 3 +types of extensions defined by the FITS standard: + +\begin{itemize} +\item + Image Extension - a N-dimensional array of pixels, like in a primary array +\item + ASCII Table Extension - rows and columns of data in ASCII character format +\item + Binary Table Extension - rows and columns of data in binary representation +\end{itemize} + +In each case the HDU consists of an ASCII Header Unit followed by an optional +Data Unit. For historical reasons, each Header or Data unit must be an +exact multiple of 2880 8-bit bytes long. Any unused space is padded +with fill characters (ASCII blanks or zeros). + +Each Header Unit consists of any number of 80-character keyword records +or `card images' which have the general form: +- + KEYNAME = value / comment string + NULLKEY = / comment: This keyword has no value +- +The keyword names may be up to 8 characters long and can only contain +uppercase letters, the digits 0-9, the hyphen, and the underscore +character. The keyword name is (usually) followed by an equals sign and +a space character (= ) in columns 9 - 10 of the record, followed by the +value of the keyword which may be either an integer, a floating point +number, a character string (enclosed in single quotes), or a boolean +value (the letter T or F). A keyword may also have a null or undefined +value if there is no specified value string, as in the second example. + +The last keyword in the header is always the `END' keyword which has no +value or comment fields. There are many rules governing the exact +format of a keyword record (see the NOST FITS Standard) so it is better +to rely on standard interface software like FITSIO to correctly +construct or to parse the keyword records rather than try to deal +directly with the raw FITS formats. + +Each Header Unit begins with a series of required keywords which depend +on the type of HDU. These required keywords specify the size and +format of the following Data Unit. The header may contain other +optional keywords to describe other aspects of the data, such as the +units or scaling values. Other COMMENT or HISTORY keywords are also +frequently added to further document the data file. + +The optional Data Unit immediately follows the last 2880-byte block in +the Header Unit. Some HDUs do not have a Data Unit and only consist of +the Header Unit. + +If there is more than one HDU in the FITS file, then the Header Unit of +the next HDU immediately follows the last 2880-byte block of the +previous Data Unit (or Header Unit if there is no Data Unit). + +The main required keywords in FITS primary arrays or image extensions are: +\begin{itemize} +\item +BITPIX -- defines the datatype of the array: 8, 16, 32, -32, -64 for +unsigned 8--bit byte, 16--bit signed integer, 32--bit signed integer, +32--bit IEEE floating point, and 64--bit IEEE double precision floating +point, respectively. +\item +NAXIS -- the number of dimensions in the array, usually 0, 1, 2, 3, or 4. +\item +NAXISn -- (n ranges from 1 to NAXIS) defines the size of each dimension. +\end{itemize} + +FITS tables start with the keyword XTENSION = `TABLE' (for ASCII +tables) or XTENSION = `BINTABLE' (for binary tables) and have the +following main keywords: +\begin{itemize} +\item +TFIELDS -- number of fields or columns in the table +\item +NAXIS2 -- number of rows in the table +\item +TTYPEn -- for each column (n ranges from 1 to TFIELDS) gives the +name of the column +\item +TFORMn -- the datatype of the column +\item +TUNITn -- the physical units of the column (optional) +\end{itemize} + +Users should refer to the FITS Support Office at {\tt http://fits.gsfc.nasa.gov} +for futher information about the FITS format and related software +packages. + + +*IV. Extended File Name Syntax + +**A. Overview + +CFITSIO supports an extended syntax when specifying the name of the +data file to be opened or created that includes the following +features: + +\begin{itemize} +\item +CFITSIO can read IRAF format images which have header file names that +end with the '.imh' extension, as well as reading and writing FITS +files, This feature is implemented in CFITSIO by first converting the +IRAF image into a temporary FITS format file in memory, then opening +the FITS file. Any of the usual CFITSIO routines then may be used to +read the image header or data. Similarly, raw binary data arrays can +be read by converting them on the fly into virtual FITS images. + +\item +FITS files on the internet can be read (and sometimes written) using the FTP, +HTTP, or ROOT protocols. + +\item +FITS files can be piped between tasks on the stdin and stdout streams. + +\item +FITS files can be read and written in shared memory. This can potentially +achieve much better data I/O performance compared to reading and +writing the same FITS files on magnetic disk. + +\item +Compressed FITS files in gzip or Unix COMPRESS format can be directly read. + +\item +Output FITS files can be written directly in compressed gzip format, +thus saving disk space. + +\item +FITS table columns can be created, modified, or deleted 'on-the-fly' as +the table is opened by CFITSIO. This creates a virtual FITS file containing +the modifications that is then opened by the application program. + +\item +Table rows may be selected, or filtered out, on the fly when the table +is opened by CFITSIO, based on an arbitrary user-specified expression. +Only rows for which the expression evaluates to 'TRUE' are retained +in the copy of the table that is opened by the application program. + +\item +Histogram images may be created on the fly by binning the values in +table columns, resulting in a virtual N-dimensional FITS image. The +application program then only sees the FITS image (in the primary +array) instead of the original FITS table. +\end{itemize} + +The latter 3 features in particular add very powerful data processing +capabilities directly into CFITSIO, and hence into every task that uses +CFITSIO to read or write FITS files. For example, these features +transform a very simple program that just copies an input FITS file to +a new output file (like the `fitscopy' program that is distributed with +CFITSIO) into a multipurpose FITS file processing tool. By appending +fairly simple qualifiers onto the name of the input FITS file, the user +can perform quite complex table editing operations (e.g., create new +columns, or filter out rows in a table) or create FITS images by +binning or histogramming the values in table columns. In addition, +these functions have been coded using new state-of-the art algorithms +that are, in some cases, 10 - 100 times faster than previous widely +used implementations. + +Before describing the complete syntax for the extended FITS file names +in the next section, here are a few examples of FITS file names that +give a quick overview of the allowed syntax: + +\begin{itemize} +\item +{\tt 'myfile.fits'}: the simplest case of a FITS file on disk in the current +directory. + +\item +{\tt 'myfile.imh'}: opens an IRAF format image file and converts it on the +fly into a temporary FITS format image in memory which can then be read with +any other CFITSIO routine. + +\item +{\tt rawfile.dat[i512,512]}: opens a raw binary data array (a 512 x 512 +short integer array in this case) and converts it on the fly into a +temporary FITS format image in memory which can then be read with any +other CFITSIO routine. + +\item +{\tt myfile.fits.gz}: if this is the name of a new output file, the '.gz' +suffix will cause it to be compressed in gzip format when it is written to +disk. + +\item +{\tt 'myfile.fits.gz[events, 2]'}: opens and uncompresses the gzipped file +myfile.fits then moves to the extension which has the keywords EXTNAME += 'EVENTS' and EXTVER = 2. + +\item +{\tt '-'}: a dash (minus sign) signifies that the input file is to be read +from the stdin file stream, or that the output file is to be written to +the stdout stream. + +\item +{\tt 'ftp://legacy.gsfc.nasa.gov/test/vela.fits'}: FITS files in any ftp +archive site on the internet may be directly opened with read-only +access. + +\item +{\tt 'http://legacy.gsfc.nasa.gov/software/test.fits'}: any valid URL to a +FITS file on the Web may be opened with read-only access. + +\item +{\tt 'root://legacy.gsfc.nasa.gov/test/vela.fits'}: similar to ftp access +except that it provides write as well as read access to the files +across the network. This uses the root protocol developed at CERN. + +\item +{\tt 'shmem://h2[events]'}: opens the FITS file in a shared memory segment and +moves to the EVENTS extension. + +\item +{\tt 'mem://'}: creates a scratch output file in core computer memory. The +resulting 'file' will disappear when the program exits, so this +is mainly useful for testing purposes when one does not want a +permanent copy of the output file. + +\item +{\tt 'myfile.fits[3; Images(10)]'}: opens a copy of the image contained in the +10th row of the 'Images' column in the binary table in the 3th extension +of the FITS file. The application just sees this single image as the +primary array. + +\item +{\tt 'myfile.fits[1:512:2, 1:512:2]'}: opens a section of the input image +ranging from the 1st to the 512th pixel in X and Y, and selects every +second pixel in both dimensions, resulting in a 256 x 256 pixel image +in this case. + +\item +{\tt 'myfile.fits[EVENTS][col Rad = sqrt(X**2 + Y**2)]'}: creates and opens +a temporary file on the fly (in memory or on disk) that is identical to +myfile.fits except that it will contain a new column in the EVENTS +extension called 'Rad' whose value is computed using the indicated +expresson which is a function of the values in the X and Y columns. + +\item +{\tt 'myfile.fits[EVENTS][PHA > 5]'}: creates and opens a temporary FITS +files that is identical to 'myfile.fits' except that the EVENTS table +will only contain the rows that have values of the PHA column greater +than 5. In general, any arbitrary boolean expression using a C or +Fortran-like syntax, which may combine AND and OR operators, +may be used to select rows from a table. + +\item +{\tt 'myfile.fits[EVENTS][bin (X,Y)=1,2048,4]'}: creates a temporary FITS +primary array image which is computed on the fly by binning (i.e, +computing the 2-dimensional histogram) of the values in the X and Y +columns of the EVENTS extension. In this case the X and Y coordinates +range from 1 to 2048 and the image pixel size is 4 units in both +dimensions, so the resulting image is 512 x 512 pixels in size. + +\item +The final example combines many of these feature into one complex +expression (it is broken into several lines for clarity): +- + 'ftp://legacy.gsfc.nasa.gov/data/sample.fits.gz[EVENTS] + [col phacorr = pha * 1.1 - 0.3][phacorr >= 5.0 && phacorr <= 14.0] + [bin (X,Y)=32]' +- +In this case, CFITSIO (1) copies and uncompresses the FITS file from +the ftp site on the legacy machine, (2) moves to the 'EVENTS' +extension, (3) calculates a new column called 'phacorr', (4) selects +the rows in the table that have phacorr in the range 5 to 14, and +finally (5) bins the remaining rows on the X and Y column coordinates, +using a pixel size = 32 to create a 2D image. All this processing is +completely transparent to the application program, which simply sees +the final 2-D image in the primary array of the opened file. +\end{itemize} + +The full extended CFITSIO FITS file name can contain several different +components depending on the context. These components are described in +the following sections: +- +When creating a new file: + filetype://BaseFilename(templateName) + +When opening an existing primary array or image HDU: + filetype://BaseFilename(outName)[HDUlocation][ImageSection] + +When opening an existing table HDU: + filetype://BaseFilename(outName)[HDUlocation][colFilter][rowFilter][binSpec] +- +The filetype, BaseFilename, outName, HDUlocation, and ImageSection +components, if present, must be given in that order, but the colFilter, +rowFilter, and binSpec specifiers may follow in any order. Regardless +of the order, however, the colFilter specifier, if present, will be +processed first by CFITSIO, followed by the rowFilter specifier, and +finally by the binSpec specifier. + +**A. Filetype + +The type of file determines the medium on which the file is located +(e.g., disk or network) and, hence, which internal device driver is used by +CFITSIO to read and/or write the file. Currently supported types are +- + file:// - file on local magnetic disk (default) + ftp:// - a readonly file accessed with the anonymous FTP protocol. + It also supports ftp://username:password@hostname/... + for accessing password-protected ftp sites. + http:// - a readonly file accessed with the HTTP protocol. It + does not support username:password like the ftp driver. + Proxy HTTP servers are supported using the http_proxy + environment variable. + root:// - uses the CERN root protocol for writing as well as + reading files over the network. + shmem:// - opens or creates a file which persists in the computer's + shared memory. + mem:// - opens a temporary file in core memory. The file + disappears when the program exits so this is mainly + useful for test purposes when a permanent output file + is not desired. +- +If the filetype is not specified, then type file:// is assumed. +The double slashes '//' are optional and may be omitted in most cases. + +***1. Notes about HTTP proxy servers + +A proxy HTTP server may be used by defining the address (URL) and port +number of the proxy server with the http\_proxy environment variable. +For example +- + setenv http_proxy http://heasarc.gsfc.nasa.gov:3128 +- +will cause CFITSIO to use port 3128 on the heasarc proxy server whenever +reading a FITS file with HTTP. + +***2. Notes about the root filetype + +The original rootd server can be obtained from: +\verb-ftp://root.cern.ch/root/rootd.tar.gz- +but, for it to work correctly with CFITSIO one has to use a modified +version which supports a command to return the length of the file. +This modified version is available in rootd subdirectory +in the CFITSIO ftp area at +- + ftp://legacy.gsfc.nasa.gov/software/fitsio/c/root/rootd.tar.gz. +- + +This small server is started either by inetd when a client requests a +connection to a rootd server or by hand (i.e. from the command line). +The rootd server works with the ROOT TNetFile class. It allows remote +access to ROOT database files in either read or write mode. By default +TNetFile assumes port 432 (which requires rootd to be started as root). +To run rootd via inetd add the following line to /etc/services: +- + rootd 432/tcp +- +and to /etc/inetd.conf, add the following line: +- + rootd stream tcp nowait root /user/rdm/root/bin/rootd rootd -i +- +Force inetd to reread its conf file with "kill -HUP ". +You can also start rootd by hand running directly under your private +account (no root system privileges needed). For example to start +rootd listening on port 5151 just type: \verb+rootd -p 5151+ +Notice: no \& is needed. Rootd will go into background by itself. +- + Rootd arguments: + -i says we were started by inetd + -p port# specifies a different port to listen on + -d level level of debug info written to syslog + 0 = no debug (default) + 1 = minimum + 2 = medium + 3 = maximum +- +Rootd can also be configured for anonymous usage (like anonymous ftp). +To setup rootd to accept anonymous logins do the following (while being +logged in as root): +- + - Add the following line to /etc/passwd: + + rootd:*:71:72:Anonymous rootd:/var/spool/rootd:/bin/false + + where you may modify the uid, gid (71, 72) and the home directory + to suite your system. + + - Add the following line to /etc/group: + + rootd:*:72:rootd + + where the gid must match the gid in /etc/passwd. + + - Create the directories: + + mkdir /var/spool/rootd + mkdir /var/spool/rootd/tmp + chmod 777 /var/spool/rootd/tmp + + Where /var/spool/rootd must match the rootd home directory as + specified in the rootd /etc/passwd entry. + + - To make writeable directories for anonymous do, for example: + + mkdir /var/spool/rootd/pub + chown rootd:rootd /var/spool/rootd/pub +- +That's all. Several additional remarks: you can login to an anonymous +server either with the names "anonymous" or "rootd". The password should +be of type user@host.do.main. Only the @ is enforced for the time +being. In anonymous mode the top of the file tree is set to the rootd +home directory, therefore only files below the home directory can be +accessed. Anonymous mode only works when the server is started via +inetd. + +***3. Notes about the shmem filetype: + +Shared memory files are currently supported on most Unix platforms, +where the shared memory segments are managed by the operating system +kernel and `live' independently of processes. They are not deleted (by +default) when the process which created them terminates, although they +will disappear if the system is rebooted. Applications can create +shared memory files in CFITSIO by calling: +- + fit_create_file(&fitsfileptr, "shmem://h2", &status); +- +where the root `file' names are currently restricted to be 'h0', 'h1', +'h2', 'h3', etc., up to a maximumn number defined by the the value of +SHARED\_MAXSEG (equal to 16 by default). This is a prototype +implementation of the shared memory interface and a more robust +interface, which will have fewer restrictions on the number of files +and on their names, may be developed in the future. + +When opening an already existing FITS file in shared memory one calls +the usual CFITSIO routine: +- + fits_open_file(&fitsfileptr, "shmem://h7", mode, &status) +- +The file mode can be READWRITE or READONLY just as with disk files. +More than one process can operate on READONLY mode files at the same +time. CFITSIO supports proper file locking (both in READONLY and +READWRITE modes), so calls to fits\_open\_file may be locked out until +another other process closes the file. + +When an application is finished accessing a FITS file in a shared +memory segment, it may close it (and the file will remain in the +system) with fits\_close\_file, or delete it with fits\_delete\_file. +Physical deletion is postponed until the last process calls +ffclos/ffdelt. fits\_delete\_file tries to obtain a READWRITE lock on +the file to be deleted, thus it can be blocked if the object was not +opened in READWRITE mode. + +A shared memory management utility program called `smem', is included +with the CFITSIO distribution. It can be built by typing `make smem'; +then type `smem -h' to get a list of valid options. Executing smem +without any options causes it to list all the shared memory segments +currently residing in the system and managed by the shared memory +driver. To get a list of all the shared memory objects, run the system +utility program `ipcs [-a]'. + +**B. Base Filename + +The base filename is the name of the file optionally including the +director/subdirectory path, and in the case of `ftp', `http', and `root' +filetypes, the machine identifier. Examples: +- + myfile.fits + !data.fits + /data/myfile.fits + fits.gsfc.nasa.gov/ftp/sampledata/myfile.fits.gz +- + +When creating a new output file on magnetic disk (of type file://) if +the base filename begins with an exclamation point (!) then any +existing file with that same basename will be deleted prior to creating +the new FITS file. Otherwise if the file to be created already exists, +then CFITSIO will return an error and will not overwrite the existing +file. Note that the exclamation point, '!', is a special UNIX character, +so if it is used on the command line rather than entered at a task +prompt, it must be preceded by a backslash to force the UNIX +shell to pass it verbatim to the application program. + +If the output disk file name ends with the suffix '.gz', then CFITSIO +will compress the file using the gzip compression algorithm before +writing it to disk. This can reduce the amount of disk space used by +the file. Note that this feature requires that the uncompressed file +be constructed in memory before it is compressed and written to disk, +so it can fail if there is insufficient available memory. + +An input FITS file may be compressed with the gzip or Unix compress +algorithms, in which case CFITSIO will uncompress the file on the fly +into a temporary file (in memory or on disk). Compressed files may +only be opened with read-only permission. When specifying the name of +a compressed FITS file it is not necessary to append the file suffix +(e.g., `.gz' or `.Z'). If CFITSIO cannot find the input file name +without the suffix, then it will automatically search for a compressed +file with the same root name. In the case of reading ftp and http type +files, CFITSIO generally looks for a compressed version of the file +first, before trying to open the uncompressed file. By default, +CFITSIO copies (and uncompressed if necessary) the ftp or http FITS +file into memory on the local machine before opening it. This will +fail if the local machine does not have enough memory to hold the whole +FITS file, so in this case, the output filename specifier (see the next +section) can be used to further control how CFITSIO reads ftp and http +files. + +If the input file is an IRAF image file (*.imh file) then CFITSIO will +automatically convert it on the fly into a virtual FITS image before it +is opened by the application program. IRAF images can only be opened +with READONLY file access. + +Similarly, if the input file is a raw binary data array, then CFITSIO +will convert it on the fly into a virtual FITS image with the basic set +of required header keywords before it is opened by the application +program (with READONLY access). In this case the data type and +dimensions of the image must be specified in square brackets following +the filename (e.g. rawfile.dat[ib512,512]). The first character (case +insensitive) defines the datatype of the array: +- + b 8-bit unsigned byte + i 16-bit signed integer + u 16-bit unsigned integer + j 32-bit signed integer + r or f 32-bit floating point + d 64-bit floating point +- +An optional second character specifies the byte order of the array +values: b or B indicates big endian (as in FITS files and the native +format of SUN UNIX workstations and Mac PCs) and l or L indicates +little endian (native format of DEC OSF workstations and IBM PCs). If +this character is omitted then the array is assumed to have the native +byte order of the local machine. These datatype characters are then +followed by a series of one or more integer values separated by commas +which define the size of each dimension of the raw array. Arrays with +up to 5 dimensions are currently supported. Finally, a byte offset to +the position of the first pixel in the data file may be specified by +separating it with a ':' from the last dimension value. If omitted, it +is assumed that the offset = 0. This parameter may be used to skip +over any header information in the file that precedes the binary data. +Further examples: +- + raw.dat[b10000] 1-dimensional 10000 pixel byte array + raw.dat[rb400,400,12] 3-dimensional floating point big-endian array + img.fits[ib512,512:2880] reads the 512 x 512 short integer array in + a FITS file, skipping over the 2880 byte header +- + +One special case of input file is where the filename = `-' (a dash or +minus sign) or 'stdin' or 'stdout', which signifies that the input file +is to be read from the stdin stream, or written to the stdout stream if +a new output file is being created. In the case of reading from stdin, +CFITSIO first copies the whole stream into a temporary FITS file (in +memory or on disk), and subsequent reading of the FITS file occurs in +this copy. When writing to stdout, CFITSIO first constructs the whole +file in memory (since random access is required), then flushes it out +to the stdout stream when the file is closed. In addition, if the +output filename = '-.gz' or 'stdout.gz' then it will be gzip compressed +before being written to stdout. + +This ability to read and write on the stdin and stdout steams allows +FITS files to be piped between tasks in memory rather than having to +create temporary intermediate FITS files on disk. For example if task1 +creates an output FITS file, and task2 reads an input FITS file, the +FITS file may be piped between the 2 tasks by specifying +- + task1 - | task2 - +- +where the vertical bar is the Unix piping symbol. This assumes that the 2 +tasks read the name of the FITS file off of the command line. + +**C. Output File Name when Opening an Existing File + +An optional output filename may be specified in parentheses immediately +following the base file name to be opened. This is mainly useful in +those cases where CFITSIO creates a temporary copy of the input FITS +file before it is opened and passed to the application program. This +happens by default when opening a network FTP or HTTP-type file, when +reading a compressed FITS file on a local disk, when reading from the +stdin stream, or when a column filter, row filter, or binning specifier +is included as part of the input file specification. By default this +temporary file is created in memory. If there is not enough memory to +create the file copy, then CFITSIO will exit with an error. In these +cases one can force a permanent file to be created on disk, instead of +a temporary file in memory, by supplying the name in parentheses +immediately following the base file name. The output filename can +include the '!' clobber flag. + +Thus, if the input filename to CFITSIO is: +\verb+file1.fits.gz(file2.fits)+ +then CFITSIO will uncompress `file1.fits.gz' into the local disk file +`file2.fits' before opening it. CFITSIO does not automatically delete +the output file, so it will still exist after the application program +exits. + +In some cases, several different temporary FITS files will be created +in sequence, for instance, if one opens a remote file using FTP, then +filters rows in a binary table extension, then create an image by +binning a pair of columns. In this case, the remote file will be +copied to a temporary local file, then a second temporary file will be +created containing the filtered rows of the table, and finally a third +temporary file containing the binned image will be created. In cases +like this where multiple files are created, the outfile specifier will +be interpreted the name of the final file as described below, in descending +priority: + +\begin{itemize} +\item +as the name of the final image file if an image within a single binary +table cell is opened or if an image is created by binning a table column. +\item +as the name of the file containing the filtered table if a column filter +and/or a row filter are specified. +\item +as the name of the local copy of the remote FTP or HTTP file. +\item +as the name of the uncompressed version of the FITS file, if a +compressed FITS file on local disk has been opened. +\item +otherwise, the output filename is ignored. +\end{itemize} + + +The output file specifier is useful when reading FTP or HTTP-type +FITS files since it can be used to create a local disk copy of the file +that can be reused in the future. If the output file name = `*' then a +local file with the same name as the network file will be created. +Note that CFITSIO will behave differently depending on whether the +remote file is compressed or not as shown by the following examples: +\begin{itemize} +\item +`ftp://remote.machine/tmp/myfile.fits.gz(*)' - the remote compressed +file is copied to the local compressed file `myfile.fits.gz', which +is then uncompressed in local memory before being opened and passed +to the application program. + +\item +`ftp://remote.machine/tmp/myfile.fits.gz(myfile.fits)' - the remote +compressed file is copied and uncompressed into the local file +`myfile.fits'. This example requires less local memory than the +previous example since the file is uncompressed on disk instead of +in memory. + +\item +`ftp://remote.machine/tmp/myfile.fits(myfile.fits.gz)' - this will +usually produce an error since CFITSIO itself cannot compress files. +\end{itemize} + +The exact behavior of CFITSIO in the latter case depends on the type of +ftp server running on the remote machine and how it is configured. In +some cases, if the file `myfile.fits.gz' exists on the remote machine, +then the server will copy it to the local machine. In other cases the +ftp server will automatically create and transmit a compressed version +of the file if only the uncompressed version exists. This can get +rather confusing, so users should use a certain amount of caution when +using the output file specifier with FTP or HTTP file types, to make +sure they get the behavior that they expect. + +**D. Template File Name when Creating a New File + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described below. + +**E. HDU Location Specification + +The optional HDU location specifier defines which HDU (Header-Data +Unit, also known as an `extension') within the FITS file to initially +open. It must immediately follow the base file name (or the output +file name if present). If it is not specified then the first HDU (the +primary array) is opened. The HDU location specifier is required if +the colFilter, rowFilter, or binSpec specifiers are present, because +the primary array is not a valid HDU for these operations. The HDU may +be specified either by absolute position number, starting with 0 for +the primary array, or by reference to the HDU name, and optionally, the +version number and the HDU type of the desired extension. The location +of an image within a single cell of a binary table may also be +specified, as described below. + +The absolute position of the extension is specified either by enclosed +the number in square brackets (e.g., `[1]' = the first extension +following the primary array) or by preceded the number with a plus sign +(`+1'). To specify the HDU by name, give the name of the desired HDU +(the value of the EXTNAME or HDUNAME keyword) and optionally the +extension version number (value of the EXTVER keyword) and the +extension type (value of the XTENSION keyword: IMAGE, ASCII or TABLE, +or BINTABLE), separated by commas and all enclosed in square brackets. +If the value of EXTVER and XTENSION are not specified, then the first +extension with the correct value of EXTNAME is opened. The extension +name and type are not case sensitive, and the extension type may be +abbreviated to a single letter (e.g., I = IMAGE extension or primary +array, A or T = ASCII table extension, and B = binary table BINTABLE +extension). If the HDU location specifier is equal to `[PRIMARY]' or +`[P]', then the primary array (the first HDU) will be opened. + +FITS images are most commonly stored in the primary array or an image +extension, but images can also be stored as a vector in a single cell +of a binary table (i.e. each row of the vector column contains a +different image). Such an image can be opened with CFITSIO by +specifying the desired column name and the row number after the binary +table HDU specifier as shown in the following examples. The column name +is separated from the HDU specifier by a semicolon and the row number +is enclosed in parentheses. In this case CFITSIO copies the image from +the table cell into a temporary primary array before it is opened. The +application program then just sees the image in the primary array, +without any extensions. The particular row to be opened may be +specified either by giving an absolute integer row number (starting +with 1 for the first row), or by specifying a boolean expression that +evaluates to TRUE for the desired row. The first row that satisfies +the expression will be used. The row selection expression has the same +syntax as described in the Row Filter Specifier section, below. + + Examples: +- + myfile.fits[3] - open the 3rd HDU following the primary array + myfile.fits+3 - same as above, but using the FTOOLS-style notation + myfile.fits[EVENTS] - open the extension that has EXTNAME = 'EVENTS' + myfile.fits[EVENTS, 2] - same as above, but also requires EXTVER = 2 + myfile.fits[events,2,b] - same, but also requires XTENSION = 'BINTABLE' + myfile.fits[3; images(17)] - opens the image in row 17 of the 'images' + column in the 3rd extension of the file. + myfile.fits[3; images(exposure > 100)] - as above, but opens the image + in the first row that has an 'exposure' column value + greater than 100. +- + +**F. Image Section + +A virtual file containing a rectangular subsection of an image can be +extracted and opened by specifying the range of pixels (start:end) +along each axis to be extracted from the original image. One can also +specify an optional pixel increment (start:end:step) for each axis of +the input image. A pixel step = 1 will be assumed if it is not +specified. If the start pixel is larger then the end pixel, then the +image will be flipped (producing a mirror image) along that dimension. +An asterisk, '*', may be used to specify the entire range of an axis, +and '-*' will flip the entire axis. The input image can be in the +primary array, in an image extension, or contained in a vector cell of +a binary table. In the later 2 cases the extension name or number must +be specified before the image section specifier. + + Examples: +- + myfile.fits[1:512:2, 2:512:2] - open a 256x256 pixel image + consisting of the odd numbered columns (1st axis) and + the even numbered rows (2nd axis) of the image in the + primary array of the file. + + myfile.fits[*, 512:256] - open an image consisting of all the columns + in the input image, but only rows 256 through 512. + The image will be flipped along the 2nd axis since + the starting pixel is greater than the ending pixel. + + myfile.fits[*:2, 512:256:2] - same as above but keeping only + every other row and column in the input image. + + myfile.fits[-*, *] - copy the entire image, flipping it along + the first axis. + + myfile.fits[3][1:256,1:256] - opens a subsection of the image that + is in the 3rd extension of the file. + + myfile.fits[4; images(12)][1:10,1:10] - open an image consisting + of the first 10 pixels in both dimensions. The original + image resides in the 12th row of the 'images' vector + column in the table in the 4th extension of the file. +- + +When CFITSIO opens an image section it first creates a temporary file +containing the image section plus a copy of any other HDUs in the +file. This temporary file is then opened by the application program, +so it is not possible to write to or modify the input file when +specifying an image section. Note that CFITSIO automatically updates +the world coordinate system keywords in the header of the image +section, if they exist, so that the coordinate associated with each +pixel in the image section will be computed correctly. + +**G. Column and Keyword Filtering Specification + +The optional column/keyword filtering specifier is used to modify the +column structure and/or the header keywords in the HDU that was +selected with the previous HDU location specifier. This filtering +specifier must be enclosed in square brackets and can be distinguished +from a general row filter specifier (described below) by the fact that +it begins with the string 'col ' and is not immediately followed by an +equals sign. The original file is not changed by this filtering +operation, and instead the modifications are made on a copy of the +input FITS file (usually in memory), which also contains a copy of all +the other HDUs in the file. This temporary file is passed to the +application program and will persist only until the file is closed or +until the program exits, unless the outfile specifier (see above) is +also supplied. + +The column/keyword filter can be used to perform the following +operations. More than one operation may be specified by separating +them with semi-colons. + +\begin{itemize} + +\item +Copy only a specified list of columns columns to the filtered input file. +The list of column name should be separated by semi-colons. Wild card +characters may be used in the column names to match multiple columns. +If the expression contains both a list of columns to be included and +columns to be deleted, then all the columns in the original table +except the explicitly deleted columns will appear in the filtered +table (i.e., there is no need to explicitly list the columns to +be included if any columns are being deleted). + +\item +Delete a column or keyword by listing the name preceded by a minus +sign or an exclamation mark (!), e.g., '-TIME' will delete the TIME +column if it exists, otherwise the TIME keyword. An error is returned +if neither a column nor keyword with this name exists. Note that the +exclamation point, '!', is a special UNIX character, so if it is used +on the command line rather than entered at a task prompt, it must be +preceded by a backslash to force the UNIX shell to ignore it. + +\item +Rename an existing column or keyword with the syntax 'NewName == +OldName'. An error is returned if neither a column nor keyword with +this name exists. + +\item +Append a new column or keyword to the table. To create a column, +give the new name, optionally followed by the datatype in parentheses, +followed by a single equals sign and an expression to be used to +compute the value (e.g., 'newcol(1J) = 0' will create a new 32-bit +integer column called 'newcol' filled with zeros). The datatype is +specified using the same syntax that is allowed for the value of the +FITS TFORMn keyword (e.g., 'I', 'J', 'E', 'D', etc. for binary tables, +and 'I8', F12.3', 'E20.12', etc. for ASCII tables). If the datatype is +not specified then an appropriate datatype will be chosen depending on +the form of the expression (may be a character string, logical, bit, long +integer, or double column). An appropriate vector count (in the case +of binary tables) will also be added if not explicitly specified. + +When creating a new keyword, the keyword name must be preceded by a +pound sign '\#', and the expression must evaluate to a scalar +(i.e., cannot have a column name in the expression). The comment +string for the keyword may be specified in parentheses immediately +following the keyword name (instead of supplying a datatype as in +the case of creating a new column). + +\item +Recompute (overwrite) the values in an existing column or keyword by +giving the name followed by an equals sign and an arithmetic +expression. +\end{itemize} + +The expression that is used when appending or recomputing columns or +keywords can be arbitrarily complex and may be a function of other +header keyword values and other columns (in the same row). The full +syntax and available functions for the expression are described below +in the row filter specification section. + +If the expression contains both a list of columns to be included and +columns to be deleted, then all the columns in the original table +except the explicitly deleted columns will appear in the filtered +table. + +For complex or commonly used operations, one can also place the +operations into an external text file and import it into the column +filter using the syntax '[col @filename.txt]'. The operations can +extend over multiple lines of the file, but multiple operations must +still be separated by semicolons. Any lines in the external text file +that begin with 2 slash characters ('//') will be ignored and may be +used to add comments into the file. + +Examples: +- + [col Time;rate] - only the Time and rate columns will + appear in the filtered input file. + + [col Time;*raw] - include the Time column and any other + columns whose name ends with 'raw'. + + [col -TIME; Good == STATUS] - deletes the TIME column and + renames the status column to 'Good' + + [col PI=PHA * 1.1 + 0.2] - creates new PI column from PHA values + + [col rate = rate/exposure] - recomputes the rate column by dividing + it by the EXPOSURE keyword value. +- + +**H. Row Filtering Specification + + When entering the name of a FITS table that is to be opened by a + program, an optional row filter may be specified to select a subset + of the rows in the table. A temporary new FITS file is created on + the fly which contains only those rows for which the row filter + expression evaluates to true. (The primary array and any other + extensions in the input file are also copied to the temporary + file). The original FITS file is closed and the new virtual file + is opened by the application program. The row filter expression is + enclosed in square brackets following the file name and extension + name (e.g., 'file.fits[events][GRADE==50]' selects only those rows + where the GRADE column value equals 50). When dealing with tables + where each row has an associated time and/or 2D spatial position, + the row filter expression can also be used to select rows based on + the times in a Good Time Intervals (GTI) extension, or on spatial + position as given in a SAO-style region file. + +***1. General Syntax + + The row filtering expression can be an arbitrarily complex series + of operations performed on constants, keyword values, and column + data taken from the specified FITS TABLE extension. The expression + must evaluate to a boolean value for each row of the table, where + a value of FALSE means that the row will be excluded. + + For complex or commonly used filters, one can place the expression + into a text file and import it into the row filter using the syntax + '[@filename.txt]'. The expression can be arbitrarily complex and + extend over multiple lines of the file. Any lines in the external + text file that begin with 2 slash characters ('//') will be ignored + and may be used to add comments into the file. + + Keyword and column data are referenced by name. Any string of + characters not surrounded by quotes (ie, a constant string) or + followed by an open parentheses (ie, a function name) will be + initially interpreted as a column name and its contents for the + current row inserted into the expression. If no such column exists, + a keyword of that name will be searched for and its value used, if + found. To force the name to be interpreted as a keyword (in case + there is both a column and keyword with the same name), precede the + keyword name with a single pound sign, '\#', as in '\#NAXIS2'. Due to + the generalities of FITS column and keyword names, if the column or + keyword name contains a space or a character which might appear as + an arithmetic term then inclose the name in '\$' characters as in + \$MAX PHA\$ or \#\$MAX-PHA\$. Names are case insensitive. + + To access a table entry in a row other than the current one, follow + the column's name with a row offset within curly braces. For + example, 'PHA\{-3\}' will evaluate to the value of column PHA, 3 rows + above the row currently being processed. One cannot specify an + absolute row number, only a relative offset. Rows that fall outside + the table will be treated as undefined, or NULLs. + + Boolean operators can be used in the expression in either their + Fortran or C forms. The following boolean operators are available: +- + "equal" .eq. .EQ. == "not equal" .ne. .NE. != + "less than" .lt. .LT. < "less than/equal" .le. .LE. <= =< + "greater than" .gt. .GT. > "greater than/equal" .ge. .GE. >= => + "or" .or. .OR. || "and" .and. .AND. && + "negation" .not. .NOT. ! "approx. equal(1e-7)" ~ +- + +Note that the exclamation +point, '!', is a special UNIX character, so if it is used on the +command line rather than entered at a task prompt, it must be preceded +by a backslash to force the UNIX shell to ignore it. + + The expression may also include arithmetic operators and functions. + Trigonometric functions use radians, not degrees. The following + arithmetic operators and functions can be used in the expression + (function names are case insensitive). A null value will be returned + in case of illegal operations such as divide by zero, sqrt(negative) + log(negative), log10(negative), arccos(.gt. 1), arcsin(.gt. 1). + +- + "addition" + "subtraction" - + "multiplication" * "division" / + "negation" - "exponentiation" ** ^ + "absolute value" abs(x) "cosine" cos(x) + "sine" sin(x) "tangent" tan(x) + "arc cosine" arccos(x) "arc sine" arcsin(x) + "arc tangent" arctan(x) "arc tangent" arctan2(x,y) + "hyperbolic cos" cosh(x) "hyperbolic sin" sinh(x) + "hyperbolic tan" tanh(x) "round to nearest int" round(x) + "round down to int" floor(x) "round up to int" ceil(x) + "exponential" exp(x) "square root" sqrt(x) + "natural log" log(x) "common log" log10(x) + "modulus" i % j "random # [0.0,1.0)" random() + "minimum" min(x,y) "maximum" max(x,y) + "cumulative sum" accum(x) "sequential difference" seqdiff(x) + "if-then-else" b?x:y +- + + An alternate syntax for the min and max functions has only a single + argument which should be a vector value (see below). The result + will be the minimum/maximum element contained within the vector. + + The accum(x) function forms the cumulative sum of x, element by element. + Vector columns are supported simply by performing the summation process + through all the values. Null values are treated as 0. The seqdiff(x) + function forms the sequential difference of x, element by element. + The first value of seqdiff is the first value of x. A single null + value in x causes a pair of nulls in the output. The seqdiff and + accum functions are functional inverses, i.e., seqdiff(accum(x)) == x + as long as no null values are present. + + The following type casting operators are available, where the + inclosing parentheses are required and taken from the C language + usage. Also, the integer to real casts values to double precision: +- + "real to integer" (int) x (INT) x + "integer to real" (float) i (FLOAT) i +- + + In addition, several constants are built in for use in numerical + expressions: + +- + #pi 3.1415... #e 2.7182... + #deg #pi/180 #row current row number + #null undefined value #snull undefined string +- + + A string constant must be enclosed in quotes as in 'Crab'. The + "null" constants are useful for conditionally setting table values + to a NULL, or undefined, value (eg., "col1==-99 ? \#NULL : col1"). + + There is also a function for testing if two values are close to + each other, i.e., if they are "near" each other to within a user + specified tolerance. The arguments, value\_1 and value\_2 can be + integer or real and represent the two values who's proximity is + being tested to be within the specified tolerance, also an integer + or real: +- + near(value_1, value_2, tolerance) +- + When a NULL, or undefined, value is encountered in the FITS table, + the expression will evaluate to NULL unless the undefined value is + not actually required for evaluation, e.g. "TRUE .or. NULL" + evaluates to TRUE. The following two functions allow some NULL + detection and handling: +- + "a null value?" ISNULL(x) + "define a value for null" DEFNULL(x,y) +- + The former + returns a boolean value of TRUE if the argument x is NULL. The + later "defines" a value to be substituted for NULL values; it + returns the value of x if x is not NULL, otherwise it returns the + value of y. + +***2. Bit Masks + + Bit masks can be used to select out rows from bit columns (TFORMn = + \#X) in FITS files. To represent the mask, binary, octal, and hex + formats are allowed: + +- + binary: b0110xx1010000101xxxx0001 + octal: o720x1 -> (b111010000xxx001) + hex: h0FxD -> (b00001111xxxx1101) +- + + In all the representations, an x or X is allowed in the mask as a + wild card. Note that the x represents a different number of wild + card bits in each representation. All representations are case + insensitive. + + To construct the boolean expression using the mask as the boolean + equal operator described above on a bit table column. For example, + if you had a 7 bit column named flags in a FITS table and wanted + all rows having the bit pattern 0010011, the selection expression + would be: + +- + flags == b0010011 + or + flags .eq. b10011 +- + + It is also possible to test if a range of bits is less than, less + than equal, greater than and greater than equal to a particular + boolean value: + +- + flags <= bxxx010xx + flags .gt. bxxx100xx + flags .le. b1xxxxxxx +- + + Notice the use of the x bit value to limit the range of bits being + compared. + + It is not necessary to specify the leading (most significant) zero + (0) bits in the mask, as shown in the second expression above. + + Bit wise AND, OR and NOT operations are also possible on two or + more bit fields using the '\&'(AND), '$|$'(OR), and the '!'(NOT) + operators. All of these operators result in a bit field which can + then be used with the equal operator. For example: + +- + (!flags) == b1101100 + (flags & b1000001) == bx000001 +- + + Bit fields can be appended as well using the '+' operator. Strings + can be concatenated this way, too. + +***3. Vector Columns + + Vector columns can also be used in building the expression. No + special syntax is required if one wants to operate on all elements + of the vector. Simply use the column name as for a scalar column. + Vector columns can be freely intermixed with scalar columns or + constants in virtually all expressions. The result will be of the + same dimension as the vector. Two vectors in an expression, though, + need to have the same number of elements and have the same + dimensions. The only places a vector column cannot be used (for + now, anyway) are the SAO region functions and the NEAR boolean + function. + + Arithmetic and logical operations are all performed on an element by + element basis. Comparing two vector columns, eg "COL1 == COL2", + thus results in another vector of boolean values indicating which + elements of the two vectors are equal. + + Eight functions are available that operate on a vector and return a + scalar result: +- + "minimum" MIN(V) "maximum" MAX(V) + "average" AVERAGE(V) "median" MEDIAN(V) + "sumation" SUM(V) "standard deviation" STDDEV(V) + "# of values" NELEM(V) "# of non-null values" NVALID(V) +- + where V represents the name of a vector column or a manually + constructed vector using curly brackets as described below. The + first 6 of these functions ignore any null values in the vector when + computing the result. + + The SUM function literally sums all the elements in x, returning a + scalar value. If x is a boolean vector, SUM returns the number + of TRUE elements. The NELEM function returns the number of elements + in vector x whereas NVALID return the number of non-null elements in + the vector. (NELEM also operates on bit and string columns, + returning their column widths.) As an example, to test whether all + elements of two vectors satisfy a given logical comparison, one can + use the expression +- + SUM( COL1 > COL2 ) == NELEM( COL1 ) +- + + which will return TRUE if all elements of COL1 are greater than + their corresponding elements in COL2. + + To specify a single element of a vector, give the column name + followed by a comma-separated list of coordinates enclosed in + square brackets. For example, if a vector column named PHAS exists + in the table as a one dimensional, 256 component list of numbers + from which you wanted to select the 57th component for use in the + expression, then PHAS[57] would do the trick. Higher dimensional + arrays of data may appear in a column. But in order to interpret + them, the TDIMn keyword must appear in the header. Assuming that a + (4,4,4,4) array is packed into each row of a column named ARRAY4D, + the (1,2,3,4) component element of each row is accessed by + ARRAY4D[1,2,3,4]. Arrays up to dimension 5 are currently + supported. Each vector index can itself be an expression, although + it must evaluate to an integer value within the bounds of the + vector. Vector columns which contain spaces or arithmetic operators + must have their names enclosed in "\$" characters as with + \$ARRAY-4D\$[1,2,3,4]. + + A more C-like syntax for specifying vector indices is also + available. The element used in the preceding example alternatively + could be specified with the syntax ARRAY4D[4][3][2][1]. Note the + reverse order of indices (as in C), as well as the fact that the + values are still ones-based (as in Fortran -- adopted to avoid + ambiguity for 1D vectors). With this syntax, one does not need to + specify all of the indices. To extract a 3D slice of this 4D + array, use ARRAY4D[4]. + + Variable-length vector columns are not supported. + + Vectors can be manually constructed within the expression using a + comma-separated list of elements surrounded by curly braces ('\{\}'). + For example, '\{1,3,6,1\}' is a 4-element vector containing the values + 1, 3, 6, and 1. The vector can contain only boolean, integer, and + real values (or expressions). The elements will be promoted to the + highest datatype present. Any elements which are themselves + vectors, will be expanded out with each of its elements becoming an + element in the constructed vector. + +***4. Good Time Interval Filtering + + A common filtering method involves selecting rows which have a time + value which lies within what is called a Good Time Interval or GTI. + The time intervals are defined in a separate FITS table extension + which contains 2 columns giving the start and stop time of each + good interval. The filtering operation accepts only those rows of + the input table which have an associated time which falls within + one of the time intervals defined in the GTI extension. A high + level function, gtifilter(a,b,c,d), is available which evaluates + each row of the input table and returns TRUE or FALSE depending + whether the row is inside or outside the good time interval. The + syntax is +- + gtifilter( [ "gtifile" [, expr [, "STARTCOL", "STOPCOL" ] ] ] ) +- + where each "[]" demarks optional parameters. Note that the quotes + around the gtifile and START/STOP column are required. Either single + or double quotes may be used. In cases where this expression is + entered on the Unix command line, enclose the entire expression in + double quotes, and then use single quotes within the expression to + enclose the 'gtifile' and other terms. It is also usually possible + to do the reverse, and enclose the whole expression in single quotes + and then use double quotes within the expression. The gtifile, + if specified, can be blank ("") which will mean to use the first + extension with the name "*GTI*" in the current file, a plain + extension specifier (eg, "+2", "[2]", or "[STDGTI]") which will be + used to select an extension in the current file, or a regular + filename with or without an extension specifier which in the latter + case will mean to use the first extension with an extension name + "*GTI*". Expr can be any arithmetic expression, including simply + the time column name. A vector time expression will produce a + vector boolean result. STARTCOL and STOPCOL are the names of the + START/STOP columns in the GTI extension. If one of them is + specified, they both must be. + + In its simplest form, no parameters need to be provided -- default + values will be used. The expression "gtifilter()" is equivalent to +- + gtifilter( "", TIME, "*START*", "*STOP*" ) +- + This will search the current file for a GTI extension, filter the + TIME column in the current table, using START/STOP times taken from + columns in the GTI extension with names containing the strings + "START" and "STOP". The wildcards ('*') allow slight variations in + naming conventions such as "TSTART" or "STARTTIME". The same + default values apply for unspecified parameters when the first one + or two parameters are specified. The function automatically + searches for TIMEZERO/I/F keywords in the current and GTI + extensions, applying a relative time offset, if necessary. + +***5. Spatial Region Filtering + + Another common filtering method selects rows based on whether the + spatial position associated with each row is located within a given + 2-dimensional region. The syntax for this high-level filter is +- + regfilter( "regfilename" [ , Xexpr, Yexpr [ , "wcs cols" ] ] ) +- + where each "[]" demarks optional parameters. The region file name + is required and must be enclosed in quotes. The remaining + parameters are optional. The region file is an ASCII text file + which contains a list of one or more geometric shapes (circle, + ellipse, box, etc.) which defines a region on the celestial sphere + or an area within a particular 2D image. The region file is + typically generated using an image display program such as fv/POW + (distribute by the HEASARC), or ds9 (distributed by the Smithsonian + Astrophysical Observatory). Users should refer to the documentation + provided with these programs for more details on the syntax used in + the region files. + + In its simpliest form, (e.g., regfilter("region.reg") ) the + coordinates in the default 'X' and 'Y' columns will be used to + determine if each row is inside or outside the area specified in + the region file. Alternate position column names, or expressions, + may be entered if needed, as in +- + regfilter("region.reg", XPOS, YPOS) +- + Region filtering can be applied most unambiguously if the positions + in the region file and in the table to be filtered are both give in + terms of absolute celestial coordinate units. In this case the + locations and sizes of the geometric shapes in the region file are + specified in angular units on the sky (e.g., positions given in + R.A. and Dec. and sizes in arcseconds or arcminutes). Similarly, + each row of the filtered table will have a celestial coordinate + associated with it. This association is usually implemented using + a set of so-called 'World Coordinate System' (or WCS) FITS keywords + that define the coordinate transformation that must be applied to + the values in the 'X' and 'Y' columns to calculate the coordinate. + + Alternatively, one can perform spatial filtering using unitless + 'pixel' coordinates for the regions and row positions. In this + case the user must be careful to ensure that the positions in the 2 + files are self-consistent. A typical problem is that the region + file may be generated using a binned image, but the unbinned + coordinates are given in the event table. The ROSAT events files, + for example, have X and Y pixel coordinates that range from 1 - + 15360. These coordinates are typically binned by a factor of 32 to + produce a 480x480 pixel image. If one then uses a region file + generated from this image (in image pixel units) to filter the + ROSAT events file, then the X and Y column values must be converted + to corresponding pixel units as in: +- + regfilter("rosat.reg", X/32.+.5, Y/32.+.5) +- + Note that this binning conversion is not necessary if the region + file is specified using celestial coordinate units instead of pixel + units because CFITSIO is then able to directly compare the + celestial coordinate of each row in the table with the celestial + coordinates in the region file without having to know anything + about how the image may have been binned. + + The last "wcs cols" parameter should rarely be needed. If supplied, + this string contains the names of the 2 columns (space or comma + separated) which have the associated WCS keywords. If not supplied, + the filter will scan the X and Y expressions for column names. + If only one is found in each expression, those columns will be + used, otherwise an error will be returned. + + These region shapes are supported (names are case insensitive): +- + Point ( X1, Y1 ) <- One pixel square region + Line ( X1, Y1, X2, Y2 ) <- One pixel wide region + Polygon ( X1, Y1, X2, Y2, ... ) <- Rest are interiors with + Rectangle ( X1, Y1, X2, Y2, A ) | boundaries considered + Box ( Xc, Yc, Wdth, Hght, A ) V within the region + Diamond ( Xc, Yc, Wdth, Hght, A ) + Circle ( Xc, Yc, R ) + Annulus ( Xc, Yc, Rin, Rout ) + Ellipse ( Xc, Yc, Rx, Ry, A ) + Elliptannulus ( Xc, Yc, Rinx, Riny, Routx, Routy, Ain, Aout ) + Sector ( Xc, Yc, Amin, Amax ) +- + where (Xc,Yc) is the coordinate of the shape's center; (X\#,Y\#) are + the coordinates of the shape's edges; Rxxx are the shapes' various + Radii or semimajor/minor axes; and Axxx are the angles of rotation + (or bounding angles for Sector) in degrees. For rotated shapes, the + rotation angle can be left off, indicating no rotation. Common + alternate names for the regions can also be used: rotbox = box; + rotrectangle = rectangle; (rot)rhombus = (rot)diamond; and pie + = sector. When a shape's name is preceded by a minus sign, '-', + the defined region is instead the area *outside* its boundary (ie, + the region is inverted). All the shapes within a single region + file are OR'd together to create the region, and the order is + significant. The overall way of looking at region files is that if + the first region is an excluded region then a dummy included region + of the whole detector is inserted in the front. Then each region + specification as it is processed overrides any selections inside of + that region specified by previous regions. Another way of thinking + about this is that if a previous excluded region is completely + inside of a subsequent included region the excluded region is + ignored. + + The positional coordinates may be given either in pixel units, + decimal degrees or hh:mm:ss.s, dd:mm:ss.s units. The shape sizes + may be given in pixels, degrees, arcminutes, or arcseconds. Look + at examples of region file produced by fv/POW or ds9 for further + details of the region file format. + + There are three functions that are primarily for use with SAO region + files and the FSAOI task, but they can be used directly. They + return a boolean true or false depending on whether a two + dimensional point is in the region or not: +- + "point in a circular region" + circle(xcntr,ycntr,radius,Xcolumn,Ycolumn) + + "point in an elliptical region" + ellipse(xcntr,ycntr,xhlf_wdth,yhlf_wdth,rotation,Xcolumn,Ycolumn) + + "point in a rectangular region" + box(xcntr,ycntr,xfll_wdth,yfll_wdth,rotation,Xcolumn,Ycolumn) + + where + (xcntr,ycntr) are the (x,y) position of the center of the region + (xhlf_wdth,yhlf_wdth) are the (x,y) half widths of the region + (xfll_wdth,yfll_wdth) are the (x,y) full widths of the region + (radius) is half the diameter of the circle + (rotation) is the angle(degrees) that the region is rotated with + respect to (xcntr,ycntr) + (Xcoord,Ycoord) are the (x,y) coordinates to test, usually column + names + NOTE: each parameter can itself be an expression, not merely a + column name or constant. +- + +***5. Example Row Filters +- + [ binary && mag <= 5.0] - Extract all binary stars brighter + than fifth magnitude (note that + the initial space is necessary to + prevent it from being treated as a + binning specification) + + [#row >= 125 && #row <= 175] - Extract row numbers 125 through 175 + + [IMAGE[4,5] .gt. 100] - Extract all rows that have the + (4,5) component of the IMAGE column + greater than 100 + + [abs(sin(theta * #deg)) < 0.5] - Extract all rows having the + absolute value of the sine of theta + less than a half where the angles + are tabulated in degrees + + [SUM( SPEC > 3*BACKGRND )>=1] - Extract all rows containing a + spectrum, held in vector column + SPEC, with at least one value 3 + times greater than the background + level held in a keyword, BACKGRND + + [VCOL=={1,4,2}] - Extract all rows whose vector column + VCOL contains the 3-elements 1, 4, and + 2. + + [@rowFilter.txt] - Extract rows using the expression + contained within the text file + rowFilter.txt + + [gtifilter()] - Search the current file for a GTI + extension, filter the TIME + column in the current table, using + START/STOP times taken from + columns in the GTI extension + + [regfilter("pow.reg")] - Extract rows which have a coordinate + (as given in the X and Y columns) + within the spatial region specified + in the pow.reg region file. + + [regfilter("pow.reg", Xs, Ys)] - Same as above, except that the + Xs and Ys columns will be used to + determine the coordinate of each + row in the table. +- + +**I. Binning or Histogramming Specification + +The optional binning specifier is enclosed in square brackets and can +be distinguished from a general row filter specification by the fact +that it begins with the keyword 'bin' not immediately followed by an +equals sign. When binning is specified, a temporary N-dimensional FITS +primary array is created by computing the histogram of the values in +the specified columns of a FITS table extension. After the histogram +is computed the input FITS file containing the table is then closed and +the temporary FITS primary array is opened and passed to the +application program. Thus, the application program never sees the +original FITS table and only sees the image in the new temporary file +(which has no additional extensions). Obviously, the application +program must be expecting to open a FITS image and not a FITS table in +this case. + +The data type of the FITS histogram image may be specified by appending +'b' (for 8-bit byte), 'i' (for 16-bit integers), 'j' (for 32-bit +integer), 'r' (for 32-bit floating points), or 'd' (for 64-bit double +precision floating point) to the 'bin' keyword (e.g. '[binr X]' +creates a real floating point image). If the datatype is not +explicitly specified then a 32-bit integer image will be created by +default, unless the weighting option is also specified in which case +the image will have a 32-bit floating point data type by default. + +The histogram image may have from 1 to 4 dimensions (axes), depending +on the number of columns that are specified. The general form of the +binning specification is: +- + [bin{bijrd} Xcol=min:max:binsize, Ycol= ..., Zcol=..., Tcol=...; weight] +- +in which up to 4 columns, each corresponding to an axis of the image, +are listed. The column names are case insensitive, and the column +number may be given instead of the name, preceded by a pound sign +(e.g., [bin \#4=1:512]). If the column name is not specified, then +CFITSIO will first try to use the 'preferred column' as specified by +the CPREF keyword if it exists (e.g., 'CPREF = 'DETX,DETY'), otherwise +column names 'X', 'Y', 'Z', and 'T' will be assumed for each of the 4 +axes, respectively. In cases where the column name could be confused +with an arithmetic expression, enclose the column name in parentheses to +force the name to be interpreted literally. + +Each column name may be followed by an equals sign and then the lower +and upper range of the histogram, and the size of the histogram bins, +separated by colons. Spaces are allowed before and after the equals +sign but not within the 'min:max:binsize' string. The min, max and +binsize values may be integer or floating point numbers, or they may be +the names of keywords in the header of the table. If the latter, then +the value of that keyword is substituted into the expression. + +Default values for the min, max and binsize quantities will be +used if not explicitly given in the binning expression as shown +in these examples: +- + [bin x = :512:2] - use default minimum value + [bin x = 1::2] - use default maximum value + [bin x = 1:512] - use default bin size + [bin x = 1:] - use default maximum value and bin size + [bin x = :512] - use default minimum value and bin size + [bin x = 2] - use default minimum and maximum values + [bin x] - use default minimum, maximum and bin size + [bin 4] - default 2-D image, bin size = 4 in both axes + [bin] - default 2-D image +- +CFITSIO will use the value of the TLMINn, TLMAXn, and TDBINn keywords, +if they exist, for the default min, max, and binsize, respectively. If +they do not exist then CFITSIO will use the actual minimum and maximum +values in the column for the histogram min and max values. The default +binsize will be set to 1, or (max - min) / 10., whichever is smaller, +so that the histogram will have at least 10 bins along each axis. + +A shortcut notation is allowed if all the columns/axes have the same +binning specification. In this case all the column names may be listed +within parentheses, followed by the (single) binning specification, as +in: +- + [bin (X,Y)=1:512:2] + [bin (X,Y) = 5] +- + +The optional weighting factor is the last item in the binning specifier +and, if present, is separated from the list of columns by a +semi-colon. As the histogram is accumulated, this weight is used to +incremented the value of the appropriated bin in the histogram. If the +weighting factor is not specified, then the default weight = 1 is +assumed. The weighting factor may be a constant integer or floating +point number, or the name of a keyword containing the weighting value. +Or the weighting factor may be the name of a table column in which case +the value in that column, on a row by row basis, will be used. + +In some cases, the column or keyword may give the reciprocal of the +actual weight value that is needed. In this case, precede the weight +keyword or column name by a slash '/' to tell CFITSIO to use the +reciprocal of the value when constructing the histogram. + +For complex or commonly used histograms, one can also place its +description into a text file and import it into the binning +specification using the syntax '[bin @filename.txt]'. The file's +contents can extend over multiple lines, although it must still +conform to the no-spaces rule for the min:max:binsize syntax and each +axis specification must still be comma-separated. Any lines in the +external text file that begin with 2 slash characters ('//') will be +ignored and may be used to add comments into the file. + + Examples: + +- + [bini detx, dety] - 2-D, 16-bit integer histogram + of DETX and DETY columns, using + default values for the histogram + range and binsize + + [bin (detx, dety)=16; /exposure] - 2-D, 32-bit real histogram of DETX + and DETY columns with a bin size = 16 + in both axes. The histogram values + are divided by the EXPOSURE keyword + value. + + [bin time=TSTART:TSTOP:0.1] - 1-D lightcurve, range determined by + the TSTART and TSTOP keywords, + with 0.1 unit size bins. + + [bin pha, time=8000.:8100.:0.1] - 2-D image using default binning + of the PHA column for the X axis, + and 1000 bins in the range + 8000. to 8100. for the Y axis. + + [bin @binFilter.txt] - Use the contents of the text file + binFilter.txt for the binning + specifications. + +- + + +*V. Template Files + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described in the following sections. + +**A Detailed Template Line Format + +The format of each ASCII template line closely follows the format of a +FITS keyword record: +- + KEYWORD = KEYVALUE / COMMENT +- +except that free format may be used (e.g., the equals sign may appear +at any position in the line) and TAB characters are allowed and are +treated the same as space characters. The KEYVALUE and COMMENT fields +are optional. The equals sign character is also optional, but it is +recommended that it be included for clarity. Any template line that +begins with the pound '\#' character is ignored by the template parser +and may be use to insert comments into the template file itself. + +The KEYWORD name field is limited to 8 characters in length and only +the letters A-Z, digits 0-9, and the hyphen and underscore characters +may be used, without any embedded spaces. Lowercase letters in the +template keyword name will be converted to uppercase. Leading spaces +in the template line preceding the keyword name are generally ignored, +except if the first 8 characters of a template line are all blank, then +the entire line is treated as a FITS comment keyword (with a blank +keyword name) and is copied verbatim into the FITS header. + +The KEYVALUE field may have any allowed FITS data type: character +string, logical, integer, real, complex integer, or complex real. The +character string values need not be enclosed in single quote characters +unless they are necessary to distinguish the string from a different +data type (e.g. 2.0 is a real but '2.0' is a string). The keyword has +an undefined (null) value if the template record only contains blanks +following the "=" or between the "=" and the "/" comment field +delimiter. + +String keyword values longer than 68 characters (the maximum length +that will fit in a single FITS keyword record) are permitted using the +CFITSIO long string convention. They can either be specified as a +single long line in the template, or by using multiple lines where the +continuing lines contain the 'CONTINUE' keyword, as in this example: +- + LONGKEY = 'This is a long string value that is contin&' + CONTINUE 'ued over 2 records' / comment field goes here +- +The format of template lines with CONTINUE keyword is very strict: 3 +spaces must follow CONTINUE and the rest of the line is copied verbatim +to the FITS file. + +The start of the optional COMMENT field must be preceded by "/", which +is used to separate it from the keyword value field. Exceptions are if +the KEYWORD name field contains COMMENT, HISTORY, CONTINUE, or if the +first 8 characters of the template line are blanks. + +More than one Header-Data Unit (HDU) may be defined in the template +file. The start of an HDU definition is denoted with a SIMPLE or +XTENSION template line: + +1) SIMPLE begins a Primary HDU definition. SIMPLE may only appear as +the first keyword in the template file. If the template file begins +with XTENSION instead of SIMPLE, then a default empty Primary HDU is +created, and the template is then assumed to define the keywords +starting with the first extension following the Primary HDU. + +2) XTENSION marks the beginning of a new extension HDU definition. The +previous HDU will be closed at this point and processing of the next +extension begins. + +**B Auto-indexing of Keywords + +If a template keyword name ends with a "\#" character, it is said to be +'auto-indexed'. Each "\#" character will be replaced by the current +integer index value, which gets reset = 1 at the start of each new HDU +in the file (or 7 in the special case of a GROUP definition). The +FIRST indexed keyword in each template HDU definition is used as the +'incrementor'; each subsequent occurrence of this SAME keyword will +cause the index value to be incremented. This behavior can be rather +subtle, as illustrated in the following examples in which the TTYPE +keyword is the incrementor in both cases: +- + TTYPE# = TIME + TFORM# = 1D + TTYPE# = RATE + TFORM# = 1E +- +will create TTYPE1, TFORM1, TTYPE2, and TFORM2 keywords. But if the +template looks like, +- + TTYPE# = TIME + TTYPE# = RATE + TFORM# = 1D + TFORM# = 1E +- +this results in a FITS files with TTYPE1, TTYPE2, TFORM2, and TFORM2, +which is probably not what was intended! + +**C Template Parser Directives + +In addition to the template lines which define individual keywords, the +template parser recognizes 3 special directives which are each preceded +by the backslash character: \verb+ \include, \group+, and \verb+ \end+. + +The 'include' directive must be followed by a filename. It forces the +parser to temporarily stop reading the current template file and begin +reading the include file. Once the parser reaches the end of the +include file it continues parsing the current template file. Include +files can be nested, and HDU definitions can span multiple template +files. + +The start of a GROUP definition is denoted with the 'group' directive, +and the end of a GROUP definition is denoted with the 'end' directive. +Each GROUP contains 0 or more member blocks (HDUs or GROUPs). Member +blocks of type GROUP can contain their own member blocks. The GROUP +definition itself occupies one FITS file HDU of special type (GROUP +HDU), so if a template specifies 1 group with 1 member HDU like: +- +\group +grpdescr = 'demo' +xtension bintable +# this bintable has 0 cols, 0 rows +\end +- +then the parser creates a FITS file with 3 HDUs : +- +1) dummy PHDU +2) GROUP HDU (has 1 member, which is bintable in HDU number 3) +3) bintable (member of GROUP in HDU number 2) +- +Technically speaking, the GROUP HDU is a BINTABLE with 6 columns. Applications +can define additional columns in a GROUP HDU using TFORMn and TTYPEn +(where n is 7, 8, ....) keywords or their auto-indexing equivalents. + +For a more complicated example of a template file using the group directives, +look at the sample.tpl file that is included in the CFITSIO distribution. + +**D Formal Template Syntax + +The template syntax can formally be defined as follows: +- + TEMPLATE = BLOCK [ BLOCK ... ] + + BLOCK = { HDU | GROUP } + + GROUP = \GROUP [ BLOCK ... ] \END + + HDU = XTENSION [ LINE ... ] { XTENSION | \GROUP | \END | EOF } + + LINE = [ KEYWORD [ = ] ] [ VALUE ] [ / COMMENT ] + + X ... - X can be present 1 or more times + { X | Y } - X or Y + [ X ] - X is optional +- + +At the topmost level, the template defines 1 or more template blocks. Blocks +can be either HDU (Header Data Unit) or a GROUP. For each block the parser +creates 1 (or more for GROUPs) FITS file HDUs. + + +**E Errors + +In general the fits\_execute\_template() function tries to be as atomic +as possible, so either everything is done or nothing is done. If an +error occurs during parsing of the template, fits\_execute\_template() +will (try to) delete the top level BLOCK (with all its children if any) +in which the error occurred, then it will stop reading the template file +and it will return with an error. + +**F Examples + +1. This template file will create a 200 x 300 pixel image, with 4-byte +integer pixel values, in the primary HDU: +- + SIMPLE = T + BITPIX = 32 + NAXIS = 2 / number of dimensions + NAXIS1 = 100 / length of first axis + NAXIS2 = 200 / length of second axis + OBJECT = NGC 253 / name of observed object +- +The allowed values of BITPIX are 8, 16, 32, -32, or -64, +representing, respectively, 8-bit integer, 16-bit integer, 32-bit +integer, 32-bit floating point, or 64 bit floating point pixels. + +2. To create a FITS table, the template first needs to include +XTENSION = TABLE or BINTABLE to define whether it is an ASCII or binary +table, and NAXIS2 to define the number of rows in the table. Two +template lines are then needed to define the name (TTYPEn) and FITS data +format (TFORMn) of the columns, as in this example: +- + xtension = bintable + naxis2 = 40 + ttype# = Name + tform# = 10a + ttype# = Npoints + tform# = j + ttype# = Rate + tunit# = counts/s + tform# = e +- +The above example defines a null primary array followed by a 40-row +binary table extension with 3 columns called 'Name', 'Npoints', and +'Rate', with data formats of '10A' (ASCII character string), '1J' +(integer) and '1E' (floating point), respectively. Note that the other +required FITS keywords (BITPIX, NAXIS, NAXIS1, PCOUNT, GCOUNT, TFIELDS, +and END) do not need to be explicitly defined in the template because +their values can be inferred from the other keywords in the template. +This example also illustrates that the templates are generally +case-insensitive (the keyword names and TFORMn values are converted to +upper-case in the FITS file) and that string keyword values generally +do not need to be enclosed in quotes. + +*V. FITSIO Conventions and Guidelines + +**A. CFITSIO Size Limitations + +CFITSIO places few restrictions on the size of FITS files that it +reads or writes. There are a few limits, however, which may affect +some extreme cases: + +1. The maximum number of FITS files that may be simultaneously opened +by CFITSIO is set by NMAXFILES as defined in fitsio2.h. It is currently +set = 300 by default. CFITSIO will allocate about 80 * NMAXFILES bytes +of memory for internal use. Note that the underlying C compiler or +operating system, may have a smaller limit on the number of opened files. +The C symbolic constant FOPEN\_MAX is intended to define the maximum +number of files that may open at once (including any other text or +binary files that may be open, not just FITS files). On some systems it +has been found that gcc supports a maximum of 255 opened files. + +Note that opening and operating on many FITS files simultaneously in +parallel may be less efficient than operating on smaller groups of files +in series. CFITSIO only has NIOBUF number of internal buffers (set = 40 +by default) that are used for temporary storage of the most recent data +records that have been read or written in the FITS files. If the number +of opened files is greater than NIOBUF, then CFITSIO may waste more time +flushing and re-reading or re-writing the same records in the FITS files. + +2. By default, CFITSIO can handle FITS files up to 2.1 GB in size (2**31 +bytes). This file size limit is often imposed by 32-bit operating +systems. More recently, as 64-bit operating systems become more common, an +industry-wide standard (at least on Unix systems) has been developed to +support larger sized files (see http://ftp.sas.com/standards/large.file/). +Starting with version 2.1 of CFITSIO, larger FITS files up to 6 terabytes +in size may be read and written on supported platforms. In order +to support these larger files, CFITSIO must be compiled with the +'-D\_LARGEFILE\_SOURCE' and `-D\_FILE\_OFFSET\_BITS=64' compiler flags. +Some platforms may also require the `-D\_LARGE\_FILES' compiler flag. + This causes the compiler to allocate 8-bytes instead of +4-bytes for the `off\_t' datatype which is used to store file offset +positions. It appears that in most cases it is not necessary to +also include these compiler flags when compiling programs that link to +the CFITSIO library. + +If CFITSIO is compiled with the -D\_LARGEFILE\_SOURCE +and -D\_FILE\_OFFSET\_BITS=64 flags on a +platform that supports large files, then it can read and write FITS +files that contain up to 2**31 2880-byte FITS records, or approximately +6 terabytes in size. It is still required that the value of the NAXISn +and PCOUNT keywords in each extension be within the range of a signed +4-byte integer (max value = 2,147,483,648). Thus, each dimension of an +image (given by the NAXISn keywords), the total width of a table +(NAXIS1 keyword), the number of rows in a table (NAXIS2 keyword), and +the total size of the variable-length array heap in binary tables +(PCOUNT keyword) must be less than this limit. + +Currently, support for large files within CFITSIO has been tested +on the Linux, Solaris, and IBM AIX operating systems. + +**B. Multiple Access to the Same FITS File + +CFITSIO supports simultaneous read and write access to multiple HDUs in +the same FITS file. Thus, one can open the same FITS file twice within +a single program and move to 2 different HDUs in the file, and then +read and write data or keywords to the 2 extensions just as if one were +accessing 2 completely separate FITS files. Since in general it is +not possible to physically open the same file twice and then expect to +be able to simultaneously (or in alternating succession) write to 2 +different locations in the file, CFITSIO recognizes when the file to be +opened (in the call to fits\_open\_file) has already been opened and +instead of actually opening the file again, just logically links the +new file to the old file. (This only applies if the file is opened +more than once within the same program, and does not prevent the same +file from being simultaneously opened by more than one program). Then +before CFITSIO reads or writes to either (logical) file, it makes sure +that any modifications made to the other file have been completely +flushed from the internal buffers to the file. Thus, in principle, one +could open a file twice, in one case pointing to the first extension +and in the other pointing to the 2nd extension and then write data to +both extensions, in any order, without danger of corrupting the file, +There may be some efficiency penalties in doing this however, since +CFITSIO has to flush all the internal buffers related to one file +before switching to the other, so it would still be prudent to +minimize the number of times one switches back and forth between doing +I/O to different HDUs in the same file. + +**C. Current Header Data Unit (CHDU) + +In general, a FITS file can contain multiple Header Data Units, also +called extensions. CFITSIO only operates within one HDU at any given +time, and the currently selected HDU is called the Current Header Data +Unit (CHDU). When a FITS file is first created or opened the CHDU is +automatically defined to be the first HDU (i.e., the primary array). +CFITSIO routines are provided to move to and open any other existing +HDU within the FITS file or to append or insert a new HDU in the FITS +file which then becomes the CHDU. + +**D. Subroutine Names + +All FITSIO subroutine names begin with the letters 'ft' to distinguish +them from other subroutines and are 5 or 6 characters long. Users should +not name their own subroutines beginning with 'ft' to avoid conflicts. +(The SPP interface routines all begin with 'fs'). Subroutines which read +or get information from the FITS file have names beginning with +'ftg...'. Subroutines which write or put information into the FITS file +have names beginning with 'ftp...'. + +**E. Subroutine Families and Datatypes + +Many of the subroutines come in families which differ only in the +datatype of the associated parameter(s) . The datatype of these +subroutines is indicated by the last letter of the subroutine name +(e.g., 'j' in 'ftpkyj') as follows: +- + x - bit + b - character*1 (unsigned byte) + i - short integer (I*2) + j - integer (I*4) + e - real exponential floating point (R*4) + f - real fixed-format floating point (R*4) + d - double precision real floating-point (R*8) + g - double precision fixed-format floating point (R*8) + c - complex reals (pairs of R*4 values) + m - double precision complex (pairs of R*8 values) + l - logical (L*4) + s - character string +- + +When dealing with the FITS byte datatype, it is important to remember +that the raw values (before any scaling by the BSCALE and BZERO, or +TSCALn and TZEROn keyword values) in byte arrays (BITPIX = 8) or byte +columns (TFORMn = 'B') are interpreted as unsigned bytes with values +ranging from 0 to 255. Some Fortran compilers support a non-standard +byte datatype such as INTEGER*1, LOGICAL*1, or BYTE, which can sometimes +be used instead of CHARACTER*1 variables. Many machines permit passing a +numeric datatype (such as INTEGER*1) to the FITSIO subroutines which are +expecting a CHARACTER*1 datatype, but this technically violates the +Fortran-77 standard and is not supported on all machines (e.g., on a VAX/VMS +machine one must use the VAX-specific \%DESCR function). + +One feature of the CFITSIO routines is that they can operate on a `X' +(bit) column in a binary table as though it were a `B' (byte) column. +For example a `11X' datatype column can be interpreted the same as a +`2B' column (i.e., 2 unsigned 8-bit bytes). In some instances, it can +be more efficient to read and write whole bytes at a time, rather than +reading or writing each individual bit. + +The double precision complex datatype is not a standard Fortran-77 +datatype. If a particular Fortran compiler does not directly support +this datatype, then one may instead pass an array of pairs of double +precision values to these subroutines. The first value in each pair +is the real part, and the second is the imaginary part. + +**F. Implicit Data Type Conversion + +The FITSIO routines that read and write numerical data can perform +implicit data type conversion. This means that the data type of the +variable or array in the program does not need to be the same as the +data type of the value in the FITS file. Data type conversion is +supported for numerical and string data types (if the string contains a +valid number enclosed in quotes) when reading a FITS header keyword +value and for numeric values when reading or writing values in the +primary array or a table column. CFITSIO returns status = +NUM\_OVERFLOW if the converted data value exceeds the range of the +output data type. Implicit data type conversion is not supported +within binary tables for string, logical, complex, or double complex +data types. + +In addition, any table column may be read as if it contained string values. +In the case of numeric columns the returned string will be formatted +using the TDISPn display format if it exists. + +**G. Data Scaling + +When reading numerical data values in the primary array or a +table column, the values will be scaled automatically by the BSCALE and +BZERO (or TSCALn and TZEROn) header keyword values if they are +present in the header. The scaled data that is returned to the reading +program will have +- + output value = (FITS value) * BSCALE + BZERO +- +(a corresponding formula using TSCALn and TZEROn is used when reading +from table columns). In the case of integer output values the floating +point scaled value is truncated to an integer (not rounded to the +nearest integer). The ftpscl and fttscl subroutines may be used to +override the scaling parameters defined in the header (e.g., to turn +off the scaling so that the program can read the raw unscaled values +from the FITS file). + +When writing numerical data to the primary array or to a table +column the data values will generally be automatically inversely scaled +by the value of the BSCALE and BZERO (or TSCALn and TZEROn) header +keyword values if they they exist in the header. These keywords must +have been written to the header before any data is written for them to +have any effect. Otherwise, one may use the ftpscl and fttscl +subroutines to define or override the scaling keywords in the header +(e.g., to turn off the scaling so that the program can write the raw +unscaled values into the FITS file). If scaling is performed, the +inverse scaled output value that is written into the FITS file will +have +- + FITS value = ((input value) - BZERO) / BSCALE +- +(a corresponding formula using TSCALn and TZEROn is used when +writing to table columns). Rounding to the nearest integer, rather +than truncation, is performed when writing integer datatypes to the +FITS file. + +**H. Error Status Values and the Error Message Stack + +The last parameter in nearly every FITSIO subroutine is the error +status value which is both an input and an output parameter. A +returned positive value for this parameter indicates an error was +detected. A listing of all the FITSIO status code values is given at +the end of this document. + +The FITSIO library uses an `inherited status' convention for the status +parameter which means that if a subroutine is called with a positive +input value of the status parameter, then the subroutine will exit +immediately without changing the value of the status parameter. Thus, +if one passes the status value returned from each FITSIO routine as +input to the next FITSIO subroutine, then whenever an error is detected +all further FITSIO processing will cease. This convention can simplify +the error checking in application programs because it is not necessary +to check the value of the status parameter after every single FITSIO +subroutine call. If a program contains a sequence of several FITSIO +calls, one can just check the status value after the last call. Since +the returned status values are generally distinctive, it should be +possible to determine which subroutine originally returned the error +status. + +FITSIO also maintains an internal stack of error messages (80-character +maximum length) which in many cases provide a more detailed explanation +of the cause of the error than is provided by the error status number +alone. It is recommended that the error message stack be printed out +whenever a program detects a FITSIO error. To do this, call the FTGMSG +routine repeatedly to get the successive messages on the stack. When the +stack is empty FTGMSG will return a blank string. Note that this is a +`First In -- First Out' stack, so the oldest error message is returned +first by ftgmsg. + +**I. Variable-Length Array Facility in Binary Tables + +FITSIO provides easy-to-use support for reading and writing data in +variable length fields of a binary table. The variable length columns +have TFORMn keyword values of the form `1Pt(len)' where `t' is the +datatype code (e.g., I, J, E, D, etc.) and `len' is an integer +specifying the maximum length of the vector in the table. If the value +of `len' is not specified when the table is created (e.g., if the TFORM +keyword value is simply specified as '1PE' instead of '1PE(400) ), then +FITSIO will automatically scan the table when it is closed to +determine the maximum length of the vector and will append this value +to the TFORMn value. + +The same routines which read and write data in an ordinary fixed length +binary table extension are also used for variable length fields, +however, the subroutine parameters take on a slightly different +interpretation as described below. + +All the data in a variable length field is written into an area called +the `heap' which follows the main fixed-length FITS binary table. The +size of the heap, in bytes, is specified with the PCOUNT keyword in the +FITS header. When creating a new binary table, the initial value of +PCOUNT should usually be set to zero. FITSIO will recompute the size +of the heap as the data is written and will automatically update the +PCOUNT keyword value when the table is closed. When writing variable +length data to a table, CFITSIO will automatically extend the size +of the heap area if necessary, so that any following HDUs do not +get overwritten. + +By default the heap data area starts immediately after the last row of +the fixed-length table. This default starting location may be +overridden by the THEAP keyword, but this is not recommended. +If additional rows of data are added to the table, CFITSIO will +automatically shift the the heap down to make room for the new +rows, but it is obviously be more efficient to initially +create the table with the necessary number of blank rows, so that +the heap does not needed to be constantly moved. + +When writing to a variable length field, the entire array of values for +a given row of the table must be written with a single call to FTPCLx. +The total length of the array is calculated from (NELEM+FELEM-1). One +cannot append more elements to an existing field at a later time; any +attempt to do so will simply overwrite all the data which was previously +written. Note also that the new data will be written to a new area of +the heap and the heap space used by the previous write cannot be +reclaimed. For this reason it is advised that each row of a variable +length field only be written once. An exception to this general rule +occurs when setting elements of an array as undefined. One must first +write a dummy value into the array with FTPCLx, and then call FTPCLU to +flag the desired elements as undefined. (Do not use the FTPCNx family +of routines with variable length fields). Note that the rows of a table, +whether fixed or variable length, do not have to be written +consecutively and may be written in any order. + +When writing to a variable length ASCII character field (e.g., TFORM = +'1PA') only a single character string written. FTPCLS writes the whole +length of the input string (minus any trailing blank characters), thus +the NELEM and FELEM parameters are ignored. If the input string is +completely blank then FITSIO will write one blank character to the FITS +file. Similarly, FTGCVS and FTGCFS read the entire string (truncated +to the width of the character string argument in the subroutine call) +and also ignore the NELEM and FELEM parameters. + +The FTPDES subroutine is useful in situations where multiple rows of a +variable length column have the identical array of values. One can +simply write the array once for the first row, and then use FTPDES to +write the same descriptor values into the other rows (use the FTGDES +routine to read the first descriptor value); all the rows will then +point to the same storage location thus saving disk space. + +When reading from a variable length array field one can only read as +many elements as actually exist in that row of the table; reading does +not automatically continue with the next row of the table as occurs +when reading an ordinary fixed length table field. Attempts to read +more than this will cause an error status to be returned. One can +determine the number of elements in each row of a variable column with +the FTGDES subroutine. + +**I. Support for IEEE Special Values + +The ANSI/IEEE-754 floating-point number standard defines certain +special values that are used to represent such quantities as +Not-a-Number (NaN), denormalized, underflow, overflow, and infinity. +(See the Appendix in the NOST FITS standard or the NOST FITS User's +Guide for a list of these values). The FITSIO subroutines that read +floating point data in FITS files recognize these IEEE special values +and by default interpret the overflow and infinity values as being +equivalent to a NaN, and convert the underflow and denormalized values +into zeros. In some cases programmers may want access to the raw IEEE +values, without any modification by FITSIO. This can be done by +calling the FTGPVx or FTGCVx routines while specifying 0.0 as the value +of the NULLVAL parameter. This will force FITSIO to simply pass the +IEEE values through to the application program, without any +modification. This does not work for double precision values on +VAX/VMS machines, however, where there is no easy way to bypass the +default interpretation of the IEEE special values. + +**J. When the Final Size of the FITS HDU is Unknown + +It is not required to know the total size of a FITS data array or table +before beginning to write the data to the FITS file. In the case of +the primary array or an image extension, one should initially create +the array with the size of the highest dimension (largest NAXISn +keyword) set to a dummy value, such as 1. Then after all the data have +been written and the true dimensions are known, then the NAXISn value +should be updated using the fits\_ update\_key routine before moving to +another extension or closing the FITS file. + +When writing to FITS tables, CFITSIO automatically keeps track of the +highest row number that is written to, and will increase the size of +the table if necessary. CFITSIO will also automatically insert space +in the FITS file if necessary, to ensure that the data 'heap', if it +exists, and/or any additional HDUs that follow the table do not get +overwritten as new rows are written to the table. + +As a general rule it is best to specify the initial number of rows = 0 +when the table is created, then let CFITSIO keep track of the number of +rows that are actually written. The application program should not +manually update the number of rows in the table (as given by the NAXIS2 +keyword) since CFITSIO does this automatically. If a table is +initially created with more than zero rows, then this will usually be +considered as the minimum size of the table, even if fewer rows are +actually written to the table. Thus, if a table is initially created +with NAXIS2 = 20, and CFITSIO only writes 10 rows of data before +closing the table, then NAXIS2 will remain equal to 20. If however, 30 +rows of data are written to this table, then NAXIS2 will be increased +from 20 to 30. The one exception to this automatic updating of the +NAXIS2 keyword is if the application program directly modifies the +value of NAXIS2 (up or down) itself just before closing the table. In this +case, CFITSIO does not update NAXIS2 again, since it assumes that the +application program must have had a good reason for changing the value +directly. This is not recommended, however, and is only provided for +backward compatibility with software that initially creates a table +with a large number of rows, than decreases the NAXIS2 value to the +actual smaller value just before closing the table. + +**K. Local FITS Conventions supported by FITSIO + +CFITSIO supports several local FITS conventions which are not +defined in the official NOST FITS standard and which are not +necessarily recognized or supported by other FITS software packages. +Programmers should be cautious about using these features, especially +if the FITS files that are produced are expected to be processed by +other software systems which do not use the CFITSIO interface. + +***1. Support for Long String Keyword Values. + +The length of a standard FITS string keyword is limited to 68 +characters because it must fit entirely within a single FITS header +keyword record. In some instances it is necessary to encode strings +longer than this limit, so FITSIO supports a local convention in which +the string value is continued over multiple keywords. This +continuation convention uses an ampersand character at the end of each +substring to indicate that it is continued on the next keyword, and the +continuation keywords all have the name CONTINUE without an equal sign +in column 9. The string value may be continued in this way over as many +additional CONTINUE keywords as is required. The following lines +illustrate this continuation convention which is used in the value of +the STRKEY keyword: +- +LONGSTRN= 'OGIP 1.0' / The OGIP Long String Convention may be used. +STRKEY = 'This is a very long string keyword&' / Optional Comment +CONTINUE ' value that is continued over 3 keywords in the & ' +CONTINUE 'FITS header.' / This is another optional comment. +- +It is recommended that the LONGSTRN keyword, as shown +here, always be included in any HDU that uses this longstring +convention. A subroutine called FTPLSW +has been provided in CFITSIO to write this keyword if it does not +already exist. + +This long string convention is supported by the following FITSIO +subroutines that deal with string-valued keywords: +- + ftgkys - read a string keyword + ftpkls - write (append) a string keyword + ftikls - insert a string keyword + ftmkls - modify the value of an existing string keyword + ftukls - update an existing keyword, or write a new keyword + ftdkey - delete a keyword +- +These routines will transparently read, write, or delete a long string +value in the FITS file, so programmers in general do not have to be +concerned about the details of the convention that is used to encode +the long string in the FITS header. When reading a long string, one +must ensure that the character string parameter used in these +subroutine calls has been declared long enough to hold the entire +string, otherwise the returned string value will be truncated. + +Note that the more commonly used FITSIO subroutine to write string +valued keywords (FTPKYS) does NOT support this long string convention +and only supports strings up to 68 characters in length. This has been +done deliberately to prevent programs from inadvertently writing +keywords using this non-standard convention without the explicit intent +of the programmer or user. The FTPKLS subroutine must be called +instead to write long strings. This routine can also be used to write +ordinary string values less than 68 characters in length. + +***2. Arrays of Fixed-Length Strings in Binary Tables + +The definition of the FITS binary table extension format does not +provide a simple way to specify that a character column contains an +array of fixed-length strings. To support this feature, FITSIO uses a +local convention for the format of the TFORMn keyword value of the form +'rAw' where 'r' is an integer specifying the total width in characters +of the column, and 'w' is an integer specifying the (fixed) length of +an individual unit string within the vector. For example, TFORM1 = +'120A10' would indicate that the binary table column is 120 characters +wide and consists of 12 10-character length strings. This convention +is recognized by the FITSIO subroutines that read or write strings in +binary tables. The Binary Table definition document specifies that +other optional characters may follow the datatype code in the TFORM +keyword, so this local convention is in compliance with the +FITS standard, although other FITS readers are not required to +recognize this convention. + +The Binary Table definition document that was approved by the IAU in +1994 contains an appendix describing an alternate convention for +specifying arrays of fixed or variable length strings in a binary table +character column (with the form 'rA:SSTRw/nnn)'. This appendix was not +officially voted on by the IAU and hence is still provisional. FITSIO +does not currently support this proposal. + +***3. Keyword Units Strings + +One deficiency of the current FITS Standard is that it does not define +a specific convention for recording the physical units of a keyword +value. The TUNITn keyword can be used to specify the physical units of +the values in a table column, but there is no analogous convention for +keyword values. The comment field of the keyword is often used for +this purpose, but the units are usually not specified in a well defined +format that FITS readers can easily recognize and extract. + +To solve this deficiency, FITSIO uses a local convention in which the +keyword units are enclosed in square brackets as the first token in the +keyword comment field; more specifically, the opening square bracket +immediately follows the slash '/' comment field delimiter and a single +space character. The following examples illustrate keywords that use +this convention: + +- +EXPOSURE= 1800.0 / [s] elapsed exposure time +V_HELIO = 16.23 / [km s**(-1)] heliocentric velocity +LAMBDA = 5400. / [angstrom] central wavelength +FLUX = 4.9033487787637465E-30 / [J/cm**2/s] average flux +- + +In general, the units named in the IAU(1988) Style Guide are +recommended, with the main exception that the preferred unit for angle +is 'deg' for degrees. + +The FTPUNT and FTGUNT subroutines in FITSIO write and read, +respectively, the keyword unit strings in an existing keyword. + +***4. HIERARCH Convention for Extended Keyword Names + +CFITSIO supports the HIERARCH keyword convention which allows keyword +names that are longer then 8 characters and may contain the full range +of printable ASCII text characters. This convention +was developed at the European Southern Observatory (ESO) to support +hierarchical FITS keyword such as: +- +HIERARCH ESO INS FOCU POS = -0.00002500 / Focus position +- +Basically, this convention uses the FITS keyword 'HIERARCH' to indicate +that this convention is being used, then the actual keyword name +({\tt'ESO INS FOCU POS'} in this example) begins in column 10 and can +contain any printable ASCII text characters, including spaces. The +equals sign marks the end of the keyword name and is followed by the +usual value and comment fields just as in standard FITS keywords. +Further details of this convention are described at +http://arcdev.hq.eso.org/dicb/dicd/dic-1-1.4.html (search for +HIERARCH). + +This convention allows a much broader range of keyword names +than is allowed by the FITS Standard. Here are more examples +of such keywords: +- +HIERARCH LongKeyword = 47.5 / Keyword has > 8 characters, and mixed case +HIERARCH XTE$TEMP = 98.6 / Keyword contains the '$' character +HIERARCH Earth is a star = F / Keyword contains embedded spaces +- +CFITSIO will transparently read and write these keywords, so application +programs do not in general need to know anything about the specific +implementation details of the HIERARCH convention. In particular, +application programs do not need to specify the `HIERARCH' part of the +keyword name when reading or writing keywords (although it +may be included if desired). When writing a keyword, CFITSIO first +checks to see if the keyword name is legal as a standard FITS keyword +(no more than 8 characters long and containing only letters, digits, or +a minus sign or underscore). If so it writes it as a standard FITS +keyword, otherwise it uses the hierarch convention to write the +keyword. The maximum keyword name length is 67 characters, which +leaves only 1 space for the value field. A more practical limit is +about 40 characters, which leaves enough room for most keyword values. +CFITSIO returns an error if there is not enough room for both the +keyword name and the keyword value on the 80-character card, except for +string-valued keywords which are simply truncated so that the closing +quote character falls in column 80. In the current implementation, +CFITSIO preserves the case of the letters when writing the keyword +name, but it is case-insensitive when reading or searching for a +keyword. The current implementation allows any ASCII text character +(ASCII 32 to ASCII 126) in the keyword name except for the '=' +character. A space is also required on either side of the equal sign. + +**L. Optimizing Code for Maximum Processing Speed + +CFITSIO has been carefully designed to obtain the highest possible +speed when reading and writing FITS files. In order to achieve the +best performance, however, application programmers must be careful to +call the CFITSIO routines appropriately and in an efficient sequence; +inappropriate usage of CFITSIO routines can greatly slow down the +execution speed of a program. + +The maximum possible I/O speed of CFITSIO depends of course on the type +of computer system that it is running on. As a rough guide, the +current generation of workstations can achieve speeds of 2 -- 10 MB/s +when reading or writing FITS images and similar, or slightly slower +speeds with FITS binary tables. Reading of FITS files can occur at +even higher rates (30MB/s or more) if the FITS file is still cached in +system memory following a previous read or write operation on the same +file. To more accurately predict the best performance that is possible +on any particular system, a diagnostic program called ``speed.c'' is +included with the CFITSIO distribution which can be run to +approximately measure the maximum possible speed of writing and reading +a test FITS file. + +The following 2 sections provide some background on how CFITSIO +internally manages the data I/O and describes some strategies that may +be used to optimize the processing speed of software that uses +CFITSIO. + +***1. Background Information: How CFITSIO Manages Data I/O + +Many CFITSIO operations involve transferring only a small number of +bytes to or from the FITS file (e.g, reading a keyword, or writing a +row in a table); it would be very inefficient to physically read or +write such small blocks of data directly in the FITS file on disk, +therefore CFITSIO maintains a set of internal Input--Output (IO) +buffers in RAM memory that each contain one FITS block (2880 bytes) of +data. Whenever CFITSIO needs to access data in the FITS file, it first +transfers the FITS block containing those bytes into one of the IO +buffers in memory. The next time CFITSIO needs to access bytes in the +same block it can then go to the fast IO buffer rather than using a +much slower system disk access routine. The number of available IO +buffers is determined by the NIOBUF parameter (in fitsio2.h) and is +currently set to 40. + +Whenever CFITSIO reads or writes data it first checks to see if that +block of the FITS file is already loaded into one of the IO buffers. +If not, and if there is an empty IO buffer available, then it will load +that block into the IO buffer (when reading a FITS file) or will +initialize a new block (when writing to a FITS file). If all the IO +buffers are already full, it must decide which one to reuse (generally +the one that has been accessed least recently), and flush the contents +back to disk if it has been modified before loading the new block. + +The one major exception to the above process occurs whenever a large +contiguous set of bytes are accessed, as might occur when reading or +writing a FITS image. In this case CFITSIO bypasses the internal IO +buffers and simply reads or writes the desired bytes directly in the +disk file with a single call to a low-level file read or write +routine. The minimum threshold for the number of bytes to read or +write this way is set by the MINDIRECT parameter and is currently set +to 3 FITS blocks = 8640 bytes. This is the most efficient way to read +or write large chunks of data and can achieve IO transfer rates of +5 -- 10MB/s or greater. Note that this fast direct IO process is not +applicable when accessing columns of data in a FITS table because the +bytes are generally not contiguous since they are interleaved by the +other columns of data in the table. This explains why the speed for +accessing FITS tables is generally slower than accessing +FITS images. + +Given this background information, the general strategy for efficiently +accessing FITS files should now be apparent: when dealing with FITS +images, read or write large chunks of data at a time so that the direct +IO mechanism will be invoked; when accessing FITS headers or FITS +tables, on the other hand, once a particular FITS block has been +loading into one of the IO buffers, try to access all the needed +information in that block before it gets flushed out of the IO buffer. +It is important to avoid the situation where the same FITS block is +being read then flushed from a IO buffer multiple times. + +The following section gives more specific suggestions for optimizing +the use of CFITSIO. + +1. When dealing with a FITS primary array or IMAGE extension, it is +more efficient to read or write large chunks of the image at a time +(at least 3 FITS blocks = 8640 bytes) so that the direct IO mechanism +will be used as described in the previous section. Smaller chunks of +data are read or written via the IO buffers, which is somewhat less +efficient because of the extra copy operation and additional +bookkeeping steps that are required. In principle it is more efficient +to read or write as big an array of image pixels at one time as +possible, however, if the array becomes so large that the operating +system cannot store it all in RAM, then the performance may be degraded +because of the increased swapping of virtual memory to disk. + +2. When dealing with FITS tables, the most important efficiency factor +in the software design is to read or write the data in the FITS file in +a single pass through the file. An example of poor program design +would be to read a large, 3-column table by sequentially reading the +entire first column, then going back to read the 2nd column, and +finally the 3rd column; this obviously requires 3 passes through the +file which could triple the execution time of an I/O limited program. +For small tables this is not important, but when reading multi-megabyte +sized tables these inefficiencies can become significant. The more +efficient procedure in this case is to read or write only as many rows +of the table as will fit into the available internal I/O buffers, then +access all the necessary columns of data within that range of rows. +Then after the program is completely finished with the data in those +rows it can move on to the next range of rows that will fit in the +buffers, continuing in this way until the entire file has been +processed. By using this procedure of accessing all the columns of a +table in parallel rather than sequentially, each block of the FITS file +will only be read or written once. + +The optimal number of rows to read or write at one time in a given +table depends on the width of the table row, on the number of I/O +buffers that have been allocated in FITSIO, and also on the number of +other FITS files that are open at the same time (since one I/O buffer +is always reserved for each open FITS file). Fortunately, a FITSIO +routine is available that will return the optimal number of rows for a +given table: call ftgrsz(unit, nrows, status). It is not critical to +use exactly the value of nrows returned by this routine, as long as one +does not exceed it. Using a very small value however can also lead to +poor performance because of the overhead from the larger number of +subroutine calls. + +The optimal number of rows returned by ftgrsz is valid only as long as +the application program is only reading or writing data in the +specified table. Any other calls to access data in the table header or +in any other FITS file would cause additional blocks of data to be +loaded into the I/O buffers displacing data from the original table, +and should be avoided during the critical period while the table is +being read or written. + +Occasionally it is necessary to simultaneously access more than one +FITS table, for example when transferring values from an input table to +an output table. In cases like this, one should call ftgrsz to get the +optimal number of rows for each table separately, than reduce the +number of rows proportionally. For example, if the optimal number of +rows in the input table is 3600 and is 1400 in the output table, then +these values should be cut in half to 1800 and 700, respectively, if +both tables are going to be accessed at the same time. + +3. Use binary table extensions rather than ASCII table +extensions for better efficiency when dealing with tabular data. The +I/O to ASCII tables is slower because of the overhead in formatting or +parsing the ASCII data fields, and because ASCII tables are about twice +as large as binary tables with the same information content. + +4. Design software so that it reads the FITS header keywords in the +same order in which they occur in the file. When reading keywords, +FITSIO searches forward starting from the position of the last keyword +that was read. If it reaches the end of the header without finding the +keyword, it then goes back to the start of the header and continues the +search down to the position where it started. In practice, as long as +the entire FITS header can fit at one time in the available internal I/O +buffers, then the header keyword access will be very fast and it makes +little difference which order they are accessed. + +5. Avoid the use of scaling (by using the BSCALE and BZERO or TSCAL and +TZERO keywords) in FITS files since the scaling operations add to the +processing time needed to read or write the data. In some cases it may +be more efficient to temporarily turn off the scaling (using ftpscl or +fttscl) and then read or write the raw unscaled values in the FITS +file. + +6. Avoid using the 'implicit datatype conversion' capability in +FITSIO. For instance, when reading a FITS image with BITPIX = -32 +(32-bit floating point pixels), read the data into a single precision +floating point data array in the program. Forcing FITSIO to convert +the data to a different datatype can significantly slow the program. + +7. Where feasible, design FITS binary tables using vector column +elements so that the data are written as a contiguous set of bytes, +rather than as single elements in multiple rows. For example, it is +faster to access the data in a table that contains a single row +and 2 columns with TFORM keywords equal to '10000E' and '10000J', than +it is to access the same amount of data in a table with 10000 rows +which has columns with the TFORM keywords equal to '1E' and '1J'. In +the former case the 10000 floating point values in the first column are +all written in a contiguous block of the file which can be read or +written quickly, whereas in the second case each floating point value +in the first column is interleaved with the integer value in the second +column of the same row so CFITSIO has to explicitly move to the +position of each element to be read or written. + +8. Avoid the use of variable length vector columns in binary tables, +since any reading or writing of these data requires that CFITSIO first +look up or compute the starting address of each row of data in the +heap. + +9. When copying data from one FITS table to another, it is faster to +transfer the raw bytes instead of reading then writing each column of +the table. The FITSIO subroutines FTGTBS and FTPTBS (for ASCII +tables), and FTGTBB and FTPTBB (for binary tables) will perform +low-level reads or writes of any contiguous range of bytes in a table +extension. These routines can be used to read or write a whole row (or +multiple rows) of a table with a single subroutine call. These +routines are fast because they bypass all the usual data scaling, error +checking and machine dependent data conversion that is normally done by +FITSIO, and they allow the program to write the data to the output file +in exactly the same byte order. For these same reasons, use of these +routines can be somewhat risky because no validation or machine +dependent conversion is performed by these routines. In general these +routines are only recommended for optimizing critical pieces of code +and should only be used by programmers who thoroughly understand the +internal byte structure of the FITS tables they are reading or +writing. + +10. Another strategy for improving the speed of writing a FITS table, +similar to the previous one, is to directly construct the entire byte +stream for a whole table row (or multiple rows) within the application +program and then write it to the FITS file with +ftptbb. This avoids all the overhead normally present +in the column-oriented CFITSIO write routines. This technique should +only be used for critical applications, because it makes the code more +difficult to understand and maintain, and it makes the code more system +dependent (e.g., do the bytes need to be swapped before writing to the +FITS file?). + +11. Finally, external factors such as the type of magnetic disk +controller (SCSI or IDE), the size of the disk cache, the average seek +speed of the disk, the amount of disk fragmentation, and the amount of +RAM available on the system can all have a significant impact on +overall I/O efficiency. For critical applications, a system +administrator should review the proposed system hardware to identify any +potential I/O bottlenecks. + + +*VI. The CFITSIO Iterator Function + +The fits\_iterate\_data function in CFITSIO provides a unique method of +executing an arbitrary user-supplied `work' function that operates on +rows of data in FITS tables or on pixels in FITS images. Rather than +explicitly reading and writing the FITS images or columns of data, one +instead calls the CFITSIO iterator routine, passing to it the name of +the user's work function that is to be executed along with a list of +all the table columns or image arrays that are to be passed to the work +function. The CFITSIO iterator function then does all the work of +allocating memory for the arrays, reading the input data from the FITS +file, passing them to the work function, and then writing any output +data back to the FITS file after the work function exits. Because +it is often more efficient to process only a subset of the total table +rows at one time, the iterator function can determine the optimum +amount of data to pass in each iteration and repeatly call the work +function until the entire table been processed. + +For many applications this single CFITSIO iterator function can +effectively replace all the other CFITSIO routines for reading or +writing data in FITS images or tables. Using the iterator has several +important advantages over the traditional method of reading and writing +FITS data files: + +\begin{itemize} +\item +It cleanly separates the data I/O from the routine that operates on +the data. This leads to a more modular and `object oriented' +programming style. + +\item +It simplifies the application program by eliminating the need to allocate +memory for the data arrays and eliminates most of the calls to the CFITSIO +routines that explicitly read and write the data. + +\item +It ensures that the data are processed as efficiently as possible. +This is especially important when processing tabular data since +the iterator function will calculate the most efficient number +of rows in the table to be passed at one time to the user's work +function on each iteration. + +\item +Makes it possible for larger projects to develop a library of work +functions that all have a uniform calling sequence and are all +independent of the details of the FITS file format. + +\end{itemize} + +There are basically 2 steps in using the CFITSIO iterator function. +The first step is to design the work function itself which must have a +prescribed set of input parameters. One of these parameters is a +structure containing pointers to the arrays of data; the work function +can perform any desired operations on these arrays and does not need to +worry about how the input data were read from the file or how the +output data get written back to the file. + +The second step is to design the driver routine that opens all the +necessary FITS files and initializes the input parameters to the +iterator function. The driver program calls the CFITSIO iterator +function which then reads the data and passes it to the user's work +function. + +Further details on using the iterator function can be found in the +companion CFITSIO User's Guide, and in the iter\_a.f, iter\_b.f and +iter\_c.f example programs. + + + +*VII. Basic Interface Routines + +This section defines a basic set of subroutines that can be +used to perform the most common types of read and write operations +on FITS files. New users should start with these subroutines and +then, as needed, explore the more advance routines described in +the following chapter to perform more complex or specialized operations. + +A right arrow symbol ($>$) is used to separate the input parameters from +the output parameters in the definition of each routine. This symbol +is not actually part of the calling sequence. Note that +the status parameter is both an input and an output parameter +and must be initialized = 0 prior to calling the FITSIO subroutines. + +Refer to Chapter 9 for the definition of all the parameters +used by these interface routines. + +**A. FITSIO Error Status Routines \label{FTVERS} + +>1 Return the current version number of the fitsio library. + The version number will be incremented with each new +> release of CFITSIO. +- + FTVERS( > version) +- +>2 Return the descriptive text string corresponding to a FITSIO error + status code. The 30-character length string contains a brief +> description of the cause of the error. +- + FTGERR(status, > errtext) +- +>3 Return the top (oldest) 80-character error message from the + internal FITSIO stack of error messages and shift any remaining + messages on the stack up one level. Any FITSIO error will + generate one or more messages on the stack. Call this routine + repeatedly to get each message in sequence. The error stack is empty +> when a blank string is returned. +- + FTGMSG( > errmsg) +- +>4 The FTPMRK routine puts an invisible marker on the + CFITSIO error stack. The FTCMRK routine can then be + used to delete any more recent error messages on the stack, back to + the position of the marker. This preserves any older error messages + on the stack. FTCMSG simply clears the entire error message stack. +> These routines are called without any arguments. +- + FTPMRK + FTCMRK + FTCMSG +- + +>5 Print out the error message corresponding to the input status + value and all the error messages on the FITSIO stack to the specified + file stream (stream can be either the string 'STDOUT' or 'STDERR'). +> If the input status value = 0 then this routine does nothing. +- + FTRPRT (stream, > status) +- +>6 Write an 80-character message to the FITSIO error stack. Application + programs should not normally write to the stack, but there may be +> some situations where this is desirable. +- + FTPMSG(errmsg) +- + +**B. File I/O Routines + +>1 Open an existing FITS file with readonly or readwrite access. + This routine always opens the primary array (the first HDU) of + the file, and does not move to a following extension, if one was + specified as part of the filename. Use the FTNOPN routine to + automatically move to the extension. This routine will also + open IRAF images (.imh format files) and raw binary data arrays + with READONLY access by first converting them on the fly into + virtual FITS images. See the `Extended File Name Syntax' chapter + for more details. The second routine simply opens the specified + file without trying to interpret the filename using the extended +> filename syntax. +- + FTOPEN(unit,filename,rwmode, > blocksize,status) + FTDKOPEN(unit,filename,rwmode, > blocksize,status) +- +>2 Open an existing FITS file with readonly or readwrite access + and move to a following extension, if one was specified as + part of the filename. (e.g., 'filename.fits+2' or + 'filename.fits[2]' will move to the 3rd HDU in the file). + Note that this routine differs from FTOPEN in that it does not +> have the redundant blocksize argument. +- + FTNOPN(unit,filename,rwmode, > status) +- +>3 Open an existing FITS file with readonly or readwrite access + and then move to the first HDU containing significant data, if a) an HDU + name or number to open was not explicitly specified as part of the + filename, and b) if the FITS file contains a null primary array (i.e., + NAXIS = 0). In this case, it will look for the first IMAGE HDU with + NAXIS > 0, or the first table that does not contain the strings `GTI' + (Good Time Interval) or `OBSTABLE' in the EXTNAME keyword value. FTTOPN + is similar, except it will move to the first significant table HDU + (skipping over any image HDUs) in the file if a specific HDU name + or number is not specified. FTIOPN will move to the first non-null +> image HDU, skipping over any tables. +- + FTDOPN(unit,filename,rwmode, > status) + FTTOPN(unit,filename,rwmode, > status) + FTIOPN(unit,filename,rwmode, > status) +- +>4 Open and initialize a new empty FITS file. A template file may also be + specified to define the structure of the new file (see section 4.2.4). + The second routine simply creates the specified + file without trying to interpret the filename using the extended +> filename syntax. +- + FTINIT(unit,filename,blocksize, > status) + FTDKINIT(unit,filename,blocksize, > status) +- +>>5 Close a FITS file previously opened with ftopen or ftinit +- + FTCLOS(unit, > status) +- +>6 Move to a specified (absolute) HDU in the FITS file (nhdu = 1 for the +> FITS primary array) +- + FTMAHD(unit,nhdu, > hdutype,status) +- +>7 Create a primary array (if none already exists), or insert a + new IMAGE extension immediately following the CHDU, or + insert a new Primary Array at the beginning of the file. Any + following extensions in the file will be shifted down to make room + for the new extension. If the CHDU is the last HDU in the file + then the new image extension will simply be appended to the end of + the file. One can force a new primary array to be inserted at the + beginning of the FITS file by setting status = -9 prior + to calling the routine. In this case the old primary array will be + converted to an IMAGE extension. The new extension (or primary +> array) will become the CHDU. +- + FTIIMG(unit,bitpix,naxis,naxes, > status) +- +>8 Insert a new ASCII TABLE extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new table extension will simply be appended to the +> end of the file. The new extension will become the CHDU. +- + FTITAB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) +- +>9 Insert a new binary table extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new bintable extension will simply be appended to the +> end of the file. The new extension will become the CHDU. +- + FTIBIN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) +- +**C. Keyword I/O Routines + +>>1 Put (append) an 80-character record into the CHU. +- + FTPREC(unit,card, > status) +- +>2 Put (append) a new keyword of the appropriate datatype into the CHU. + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, +> depending on the magnitude of the value. +- + FTPKY[JLS](unit,keyword,keyval,comment, > status) + FTPKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +- +>3 Get the nth 80-character header record from the CHU. The first keyword + in the header is at key\_no = 1; if key\_no = 0 then this subroutine + simple moves the internal pointer to the beginning of the header + so that subsequent keyword operations will start at the top of +> the header; it also returns a blank card value in this case. +- + FTGREC(unit,key_no, > card,status) +- +>4 Get a keyword value (with the appropriate datatype) and comment from +> the CHU +- + FTGKY[EDJLS](unit,keyword, > keyval,comment,status) +- +>>5 Delete an existing keyword record. +- + FTDKEY(unit,keyword, > status) +- + +**D. Data I/O Routines + +The following routines read or write data values in the current HDU of +the FITS file. Automatic datatype conversion +will be attempted for numerical datatypes if the specified datatype is +different from the actual datatype of the FITS array or table column. + +>>1 Write elements into the primary data array or image extension. +- + FTPPR[BIJED](unit,group,fpixel,nelements,values, > status) +- +>2 Read elements from the primary data array or image extension. + Undefined array elements will be + returned with a value = nullval, unless nullval = 0 in which case no + checks for undefined pixels will be performed. The anyf parameter is + set to true (= .true.) if any of the returned +> elements were undefined. +- + FTGPV[BIJED](unit,group,fpixel,nelements,nullval, > values,anyf,status) +- +>3 Write elements into an ASCII or binary table column. The `felem' + parameter applies only to vector columns in binary tables and is +> ignored when writing to ASCII tables. +- + FTPCL[SLBIJEDCM](unit,colnum,frow,felem,nelements,values, > status) +- +>4 Read elements from an ASCII or binary table column. Undefined + array elements will be returned with a value = nullval, unless nullval = 0 + (or = ' ' for ftgcvs) in which case no checking for undefined values will + be performed. The ANYF parameter is set to true if any of the returned + elements are undefined. + + Any column, regardless of it's intrinsic datatype, may be read as a + string. It should be noted however that reading a numeric column + as a string is 10 - 100 times slower than reading the same column + as a number due to the large overhead in constructing the formatted + strings. The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + datatype of the column. The length of the returned strings can be + determined with the ftgcdw routine. The following TDISPn display + formats are currently supported: +- + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +- + where w is the width in characters of the displayed values, m is the minimum + number of digits displayed, and d is the number of digits to the right of the +> decimal. The .m field is optional. + +- + FTGCV[SBIJEDCM](unit,colnum,frow,felem,nelements,nullval, > + values,anyf,status) +- +>5 Get the table column number and full name of the column whose name + matches the input template string. See the `Advanced Interface Routines' +> chapter for a full description of this routine. +- + FTGCNN(unit,casesen,coltemplate, > colname,colnum,status) +- + + +*VIII Advanced Interface Subroutines + +This chapter defines all the available subroutines in the FITSIO user +interface. For completeness, the basic subroutines described in the +previous chapter are also repeated here. A right arrow symbol is used +here to separate the input parameters from the output parameters in the +definition of each subroutine. This symbol is not actually part of the +calling sequence. An alphabetical list and definition of all the +parameters is given at the end of this section. + +**A. FITS File Open and Close Subroutines: \label{FTOPEN} + +>1 Open an existing FITS file with readonly or readwrite access. FTDOPN +also moves to the first HDU containing significant data, if no specific +HDU is specified as part of the filename. FTTOPN and FTIOPN are similar +except that they will move to the first table HDU or image HDU, respectively, +>if a HDU name or number is not specified as part of the filename. +- + FTOPEN(unit,filename,rwmode, > blocksize,status) + FTDOPN(unit,filename,rwmode, > status) + FTTOPN(unit,filename,rwmode, > status) + FTIOPN(unit,filename,rwmode, > status) +- + +>2 Open an existing FITS file with readonly or readwrite access + and move to a following extension, if one was specified as + part of the filename. (e.g., 'filename.fits+2' or + 'filename.fits[2]' will move to the 3rd HDU in the file). + Note that this routine differs from FTOPEN in that it does not +> have the redundant blocksize argument. +- + FTNOPN(unit,filename,rwmode, > status) +- +>3 Reopen a FITS file that was previously opened with + FTOPEN, FTNOPN, or FTINIT. The newunit number + may then be treated as a separate file, and one may + simultaneously read or write to 2 (or more) different extensions in + the same file. The FTOPEN and FTNOPN routines (above) automatically + detects cases where a previously opened file is being opened again, + and then internally call FTREOPEN, so programs should rarely +> need to explicitly call this routine. +- + FTREOPEN(unit, > newunit, status) +- +>>4 Open and initialize a new empty FITS file +- + FTINIT(unit,filename,blocksize, > status) +- +>5 Create a new FITS file, using a template file to define its + initial size and structure. The template may be another FITS HDU + or an ASCII template file. If the input template file name + is blank, then this routine behaves the same as FTINIT. + The currently supported format of the ASCII template file is described + under the fits\_parse\_template routine (in the general Utilities + section), but this may change slightly later releases of +> CFITSIO. +- + FTTPLT(unit, filename, tplfilename, > status) +- +>6 Flush internal buffers of data to the output FITS file + previously opened with ftopen or ftinit. The routine usually + never needs to be called, but doing so will ensure that + if the program subsequently aborts, then the FITS file will +> have at least been closed properly. +- + FTFLUS(unit, > status) +- +>>7 Close a FITS file previously opened with ftopen or ftinit +- + FTCLOS(unit, > status) +- +>8 Close and DELETE a FITS file previously opened with ftopen or ftinit. + This routine may be useful in cases where a FITS file is created, but +> an error occurs which prevents the complete file from being written. +- + FTDELT(unit, > status) +- +>9 Get the value of an unused I/O unit number which may then be used + as input to FTOPEN or FTINIT. This routine searches for the first + unused unit number in the range from with 99 down to 50. This + routine just keeps an internal list of the allocated unit numbers + and does not physically check that the Fortran unit is available (to be + compatible with the SPP version of FITSIO). Thus users must not + independently allocate any unit numbers in the range 50 - 99 + if this routine is also to be used in the same program. This + routine is provided for convenience only, and it is not required +> that the unit numbers used by FITSIO be allocated by this routine. +- + FTGIOU( > iounit, status) +- +>10 Free (deallocate) an I/O unit number which was previously allocated + with FTGIOU. All previously allocated unit numbers may be +> deallocated at once by calling FTFIOU with iounit = -1. +- + FTFIOU(iounit, > status) +- +>11 Return the Fortran unit number that corresponds to the C fitsfile +pointer value, or vice versa. These 2 C routines may be useful in +mixed language programs where both C and Fortran subroutines need +to access the same file. For example, if a FITS file is opened +with unit 12 by a Fortran subroutine, then a C routine within the +same program could get the fitfile pointer value to access the same file +by calling 'fptr = CUnit2FITS(12)'. These routines return a value +>of zero if an error occurs. +- + int CFITS2Unit(fitsfile *ptr); + fitsfile* CUnit2FITS(int unit); +- + +>11 Parse the input filename and return the HDU number that would be +moved to if the file were opened with FTNOPN. The returned HDU +number begins with 1 for the primary array, so for example, if the +input filename = `myfile.fits[2]' then hdunum = 3 will be returned. +FITSIO does not open the file to check if the extension actually exists +if an extension number is specified. If an extension *name* is included +in the file name specification (e.g. `myfile.fits[EVENTS]' then this +routine will have to open the FITS file and look for the position of +the named extension, then close file again. This is not possible if +the file is being read from the stdin stream, and an error will be +returned in this case. If the filename does not specify an explicit +extension (e.g. 'myfile.fits') then hdunum = -99 will be returned, +which is functionally equivalent to hdunum = 1. This routine is mainly +used for backward compatibility in the ftools software package and is +not recommended for general use. It is generally better and more +efficient to first open the FITS file with FTNOPN, then use FTGHDN to +determine which HDU in the file has been opened, rather than calling +> FTEXTN followed by a call to FTNOPN. +- + FTEXTN(filename, > nhdu, status) +- +>>12 Return the name of the opened FITS file. +- + FTFLNM(unit, > filename, status) +- +>>13 Return the I/O mode of the open FITS file (READONLY = 0, READWRITE = 1). +- + FTFLMD(unit, > iomode, status) +- +>14 Return the file type of the opened FITS file (e.g. 'file://', 'ftp://', +> etc.). +- + FTURLT(unit, > urltype, status) +- +>15 Parse the input filename or URL into its component parts: the file +type (file://, ftp://, http://, etc), the base input file name, the +name of the output file that the input file is to be copied to prior +to opening, the HDU or extension specification, the filtering +specifier, the binning specifier, and the column specifier. Blank +strings will be returned for any components that are not present +>in the input file name. +- + FTIURL(filename, > filetype, infile, outfile, extspec, filter, + binspec, colspec, status) +- +>16 Parse the input file name and return the root file name. The root +name includes the file type if specified, (e.g. 'ftp://' or 'http://') +and the full path name, to the extent that it is specified in the input +filename. It does not include the HDU name or number, or any filtering +>specifications. +- + FTRTNM(filename, > rootname, status) +- + +>16 Test if the input file or a compressed version of the file (with +a .gz, .Z, .z, or .zip extension) exists on disk. The returned value of +the 'exists' parameter will have 1 of the 4 following values: +- + 2: the file does not exist, but a compressed version does exist + 1: the disk file does exist + 0: neither the file nor a compressed version of the file exist + -1: the input file name is not a disk file (could be a ftp, http, + smem, or mem file, or a file piped in on the STDIN stream) +- +> +- + FTEXIST(filename, > exists, status); +- +**B. HDU-Level Operations \label{FTMAHD} + +When a FITS file is first opened or created, the internal buffers in +FITSIO automatically point to the first HDU in the file. The following +routines may be used to move to another HDU in the file. Note that +the HDU numbering convention used in FITSIO denotes the primary array +as the first HDU, the first extension in a FITS file is the second HDU, +and so on. + +>1 Move to a specified (absolute) HDU in the FITS file (nhdu = 1 for the +> FITS primary array) +- + FTMAHD(unit,nhdu, > hdutype,status) +- +>>2 Move to a new (existing) HDU forward or backwards relative to the CHDU +- + FTMRHD(unit,nmove, > hdutype,status) +- +>3 Move to the (first) HDU which has the specified extension type and + EXTNAME (or HDUNAME) and EXTVER keyword values. The hdutype parameter + may have + a value of IMAGE\_HDU, ASCII\_TBL, BINARY\_TBL, or ANY\_HDU where + ANY\_HDU means that only the extname and extver values will be + used to locate the correct extension. If the input value of + extver is 0 then the EXTVER keyword is ignored and the first HDU + with a matching EXTNAME (or HDUNAME) keyword will be found. If no + matching HDU is found in the file then the current HDU will remain + unchanged +> and a status = BAD\_HDU\_NUM (301) will be returned. +- + FTMNHD(unit, hdutype, extname, extver, > status) +- +>>4 Get the number of the current HDU in the FITS file (primary array = 1) +- + FTGHDN(unit, > nhdu) +- +>5 Return the type of the current HDU in the FITS file. The possible +> values for hdutype are IMAGE\_HDU (0), ASCII\_TBL (1), or BINARY\_TBL (2). +- + FTGHDT(unit, > hdutype, status) +- +>6 Return the total number of HDUs in the FITS file. +> The CHDU remains unchanged. +- + FTTHDU(unit, > hdunum, status) +- +>7 Create (append) a new empty HDU following the last extension that + has been previously accessed by the program. This will overwrite + any extensions in an existing FITS file if the program has not already + moved to that (or a later) extension using the FTMAHD or FTMRHD routines. + For example, if an existing FITS file contains a primary array and 5 + extensions and a program (1) opens the FITS file, (2) moves to + extension 4, (3) moves back to the primary array, and (4) then calls + FTCRHD, then the new extension will be written following the 4th +> extension, overwriting the existing 5th extension. +- + FTCRHD(unit, > status) +- +>8 Insert a new IMAGE extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new image extension will simply be appended to the +> end of the file. The new extension will become the CHDU. +- + FTIIMG(unit,bitpix,naxis,naxes, > status) +- +>9 Insert a new ASCII TABLE extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new table extension will simply be appended to the +> end of the file. The new extension will become the CHDU. +- + FTITAB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) +- +>10 Insert a new binary table extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new bintable extension will simply be appended to the +> end of the file. The new extension will become the CHDU. +- + FTIBIN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) +- +>11 Resize an image by modifing the size, dimensions, and/or datatype of the + current primary array or image extension. If the new image, as specified + by the input arguments, is larger than the current existing image + in the FITS file then zero fill data will be inserted at the end + of the current image and any following extensions will be moved + further back in the file. Similarly, if the new image is + smaller than the current image then any following extensions + will be shifted up towards the beginning of the FITS file + and the image data will be truncated to the new size. + This routine rewrites the BITPIX, NAXIS, and NAXISn keywords +> with the appropriate values for new image. +- + FTRSIM(unit,bitpix,naxis,naxes,status) +- +>12 Delete the CHDU in the FITS file. Any following HDUs will be shifted + forward in the file, to fill in the gap created by the deleted + HDU. In the case of deleting the primary array (the first HDU in + the file) then the current primary array will be replace by a null + primary array containing the minimum set of required keywords and + no data. If there are more extensions in the file following the + one that is deleted, then the the CHDU will be redefined to point + to the following extension. If there are no following extensions + then the CHDU will be redefined to point to the previous HDU. The + output HDUTYPE parameter indicates the type of the new CHDU after +> the previous CHDU has been deleted. +- + FTDHDU(unit, > hdutype,status) +- +>13 Copy all or part of the input FITS file and append it + to the end of the output FITS file. If 'previous' is + true (not 0), then any HDUs preceding the current HDU in the input file + will be copied to the output file. Similarly, 'current' and 'following' + determine whether the current HDU, and/or any following HDUs in the + input file will be copied to the output file. If all 3 parameters are + true, then the entire input file will be copied. On return, the current + HDU in the input file will be unchanged, and the last copied HDU will be the +> current HDU in the output file. +- + FTCPFL(iunit, ounit, previous, current, following, > status) +- +>14 Copy the entire CHDU from the FITS file associated with IUNIT to the CHDU + of the FITS file associated with OUNIT. The output HDU must be empty and + not already contain any keywords. Space will be reserved for MOREKEYS + additional keywords in the output header if there is not already enough +> space. +- + FTCOPY(iunit,ounit,morekeys, > status) +- +>15 Copy the header (and not the data) from the CHDU associated with inunit + to the CHDU associated with outunit. If the current output HDU + is not completely empty, then the CHDU will be closed and a new + HDU will be appended to the output file. This routine will automatically + transform the necessary keywords when copying a primary array to + and image extension, or an image extension to a primary array. +> An empty output data unit will be created (all values = 0). +- + FTCPHD(inunit, outunit, > status) +- +>16 Copy just the data from the CHDU associated with IUNIT + to the CHDU associated with OUNIT. This will overwrite + any data previously in the OUNIT CHDU. This low level routine is used + by FTCOPY, but it may also be useful in certain application programs + which want to copy the data from one FITS file to another but also + want to modify the header keywords in the process. all the required + header keywords must be written to the OUNIT CHDU before calling +> this routine +- + FTCPDT(iunit,ounit, > status) +- + +**C. Define or Redefine the structure of the CHDU \label{FTRDEF} + +It should rarely be necessary to call the subroutines in this section. +FITSIO internally calls these routines whenever necessary, so any calls +to these routines by application programs will likely be redundant. + +>1 This routine forces FITSIO to scan the current header keywords that + define the structure of the HDU (such as the NAXISn, PCOUNT and GCOUNT + keywords) so that it can initialize the internal buffers that describe + the HDU structure. This routine may be used instead of the more + complicated calls to ftpdef, ftadef or ftbdef. This routine is + also very useful for reinitializing the structure of an HDU, + if the number of rows in a table, as specified by the NAXIS2 keyword, +> has been modified from its initial value. +- + FTRDEF(unit, > status) (DEPRECATED) +- +>2 Define the structure of the primary array or IMAGE extension. When + writing GROUPed FITS files that by convention set the NAXIS1 keyword + equal to 0, ftpdef must be called with naxes(1) = 1, NOT 0, otherwise + FITSIO will report an error status=308 when trying to write data + to a group. Note: it is usually simpler to call FTRDEF rather +> than this routine. +- + FTPDEF(unit,bitpix,naxis,naxes,pcount,gcount, > status) (DEPRECATED) +- +>3 Define the structure of an ASCII table (TABLE) extension. Note: it +> is usually simpler to call FTRDEF rather than this routine. +- + FTADEF(unit,rowlen,tfields,tbcol,tform,nrows > status) (DEPRECATED) +- +>4 Define the structure of a binary table (BINTABLE) extension. Note: it +> is usually simpler to call FTRDEF rather than this routine. +- + FTBDEF(unit,tfields,tform,varidat,nrows > status) (DEPRECATED) +- +>5 Define the size of the Current Data Unit, overriding the length + of the data unit as previously defined by ftpdef, ftadef, or ftbdef. + This is useful if one does not know the total size of the data unit until + after the data have been written. The size (in bytes) of an ASCII or + Binary table is given by NAXIS1 * NAXIS2. (Note that to determine the + value of NAXIS1 it is often more convenient to read the value of the + NAXIS1 keyword from the output file, rather than computing the row + length directly from all the TFORM keyword values). Note: it +> is usually simpler to call FTRDEF rather than this routine. +- + FTDDEF(unit,bytlen, > status) (DEPRECATED) +- +>6 Define the zero indexed byte offset of the 'heap' measured from + the start of the binary table data. By default the heap is assumed + to start immediately following the regular table data, i.e., at + location NAXIS1 x NAXIS2. This routine is only relevant for + binary tables which contain variable length array columns (with + TFORMn = 'Pt'). This subroutine also automatically writes + the value of theap to a keyword in the extension header. This + subroutine must be called after the required keywords have been + written (with ftphbn) and after the table structure has been defined +> (with ftbdef) but before any data is written to the table. +- + FTPTHP(unit,theap, > status) +- + +**D. FITS Header I/O Subroutines + +***1. Header Space and Position Routines \label{FTHDEF} + +>1 Reserve space in the CHU for MOREKEYS more header keywords. + This subroutine may be called to reserve space for keywords which are + to be written at a later time, after the data unit or subsequent + extensions have been written to the FITS file. If this subroutine is + not explicitly called, then the initial size of the FITS header will be + limited to the space available at the time that the first data is written + to the associated data unit. FITSIO has the ability to dynamically + add more space to the header if needed, however it is more efficient +> to preallocate the required space if the size is known in advance. +- + FTHDEF(unit,morekeys, > status) +- +>2 Return the number of existing keywords in the CHU (NOT including the + END keyword which is not considered a real keyword) and the remaining + space available to write additional keywords in the CHU. (returns + KEYSADD = -1 if the header has not yet been closed). + Note that FITSIO will attempt to dynamically add space for more +> keywords if required when appending new keywords to a header. +- + FTGHSP(iunit, > keysexist,keysadd,status) +- +>3 Return the number of keywords in the header and the current position + in the header. This returns the number of the keyword record that + will be read next (or one greater than the position of the last keyword + that was read or written). A value of 1 is returned if the pointer is +> positioned at the beginning of the header. +- + FTGHPS(iunit, > keysexist,key_no,status) +- +***2. Read or Write Standard Header Routines \label{FTPHPR} + +These subroutines provide a simple method of reading or writing most of +the keyword values that are normally required in a FITS files. These +subroutines are provided for convenience only and are not required to +be used. If preferred, users may call the lower-level subroutines +described in the previous section to individually read or write the +required keywords. Note that in most cases, the required keywords such +as NAXIS, TFIELD, TTYPEn, etc, which define the structure of the HDU +must be written to the header before any data can be written to the +image or table. + +>1 Put the primary header or IMAGE extension keywords into the CHU. +There are 2 available routines: The simpler FTPHPS routine is +equivalent to calling ftphpr with the default values of SIMPLE = true, +pcount = 0, gcount = 1, and EXTEND = true. PCOUNT, GCOUNT and EXTEND +keywords are not required in the primary header and are only written if +pcount is not equal to zero, gcount is not equal to zero or one, and if +extend is TRUE, respectively. When writing to an IMAGE extension, the +>SIMPLE and EXTEND parameters are ignored. +- + FTPHPS(unit,bitpix,naxis,naxes, > status) + + FTPHPR(unit,simple,bitpix,naxis,naxes,pcount,gcount,extend, > status) +- +>2 Get primary header or IMAGE extension keywords from the CHU. When + reading from an IMAGE extension the SIMPLE and EXTEND parameters are +> ignored. +- + FTGHPR(unit,maxdim, > simple,bitpix,naxis,naxes,pcount,gcount,extend, + status) +- +>3 Put the ASCII table header keywords into the CHU. The optional +TUNITn and EXTNAME keywords are written only if the input string +>values are not blank. +- + FTPHTB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) +- +>>4 Get the ASCII table header keywords from the CHU +- + FTGHTB(unit,maxdim, > rowlen,nrows,tfields,ttype,tbcol,tform,tunit, + extname,status) +- +>5 Put the binary table header keywords into the CHU. The optional + TUNITn and EXTNAME keywords are written only if the input string + values are not blank. The pcount parameter, which specifies the + size of the variable length array heap, should initially = 0; + FITSIO will automatically update the PCOUNT keyword value if any + variable length array data is written to the heap. The TFORM keyword + value for variable length vector columns should have the form 'Pt(len)' + or '1Pt(len)' where `t' is the data type code letter (A,I,J,E,D, etc.) + and `len' is an integer specifying the maximum length of the vectors + in that column (len must be greater than or equal to the longest + vector in the column). If `len' is not specified when the table is + created (e.g., the input TFORMn value is just '1Pt') then FITSIO will + scan the column when the table is first closed and will append the + maximum length to the TFORM keyword value. Note that if the table + is subsequently modified to increase the maximum length of the vectors + then the modifying program is responsible for also updating the TFORM +> keyword value. + +- + FTPHBN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat, > status) +- +>>6 Get the binary table header keywords from the CHU +- + FTGHBN(unit,maxdim, > nrows,tfields,ttype,tform,tunit,extname,varidat, + status) +- +***3. Write Keyword Subroutines \label{FTPREC} + +>>1 Put (append) an 80-character record into the CHU. +- + FTPREC(unit,card, > status) +- +>2 Put (append) a COMMENT keyword into the CHU. Multiple COMMENT keywords +> will be written if the input comment string is longer than 72 characters. +- + FTPCOM(unit,comment, > status) +- +>3 Put (append) a HISTORY keyword into the CHU. Multiple HISTORY keywords +> will be written if the input history string is longer than 72 characters. +- + FTPHIS(unit,history, > status) +- +>4 Put (append) the DATE keyword into the CHU. The keyword value will contain + the current system date as a character string in 'dd/mm/yy' format. If + a DATE keyword already exists in the header, then this subroutine will +> simply update the keyword value in-place with the current date. +- + FTPDAT(unit, > status) +- +>5 Put (append) a new keyword of the appropriate datatype into the CHU. + Note that FTPKYS will only write string values up to 68 characters in + length; longer strings will be truncated. The FTPKLS routine can be + used to write longer strings, using a non-standard FITS convention. + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, +> depending on the magnitude of the value. +- + FTPKY[JLS](unit,keyword,keyval,comment, > status) + FTPKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +- +>6 Put (append) a string valued keyword into the CHU which may be longer + than 68 characters in length. This uses the Long String Keyword + convention that is described in the "Usage Guidelines and Suggestions" + section of this document. Since this uses a non-standard FITS + convention to encode the long keyword string, programs which use + this routine should also call the FTPLSW routine to add some COMMENT + keywords to warn users of the FITS file that this convention is + being used. FTPLSW also writes a keyword called LONGSTRN to record + the version of the longstring convention that has been used, in case + a new convention is adopted at some point in the future. If the + LONGSTRN keyword is already present in the header, then FTPLSW will +> simply return and will not write duplicate keywords. +- + FTPKLS(unit,keyword,keyval,comment, > status) + FTPLSW(unit, > status) +- +>7 Put (append) a new keyword with an undefined, or null, value into the CHU. +> The value string of the keyword is left blank in this case. +- + FTPKYU(unit,keyword,comment, > status) +- +>8 Put (append) a numbered sequence of keywords into the CHU. One may + append the same comment to every keyword (and eliminate the need + to have an array of identical comment strings, one for each keyword) by + including the ampersand character as the last non-blank character in the + (first) COMMENTS string parameter. This same string + will then be used for the comment field in all the keywords. (Note + that the SPP version of these routines only supports a single comment +> string). +- + FTPKN[JLS](unit,keyroot,startno,no_keys,keyvals,comments, > status) + FTPKN[EDFG](unit,keyroot,startno,no_keys,keyvals,decimals,comments, > + status) +- +>9 Copy an indexed keyword from one HDU to another, modifying + the index number of the keyword name in the process. For example, + this routine could read the TLMIN3 keyword from the input HDU + (by giving keyroot = "TLMIN" and innum = 3) and write it to the + output HDU with the keyword name TLMIN4 (by setting outnum = 4). + If the input keyword does not exist, then this routine simply +> returns without indicating an error. +- + FTCPKYinunit, outunit, innum, outnum, keyroot, > status) +- +>10 Put (append) a 'triple precision' keyword into the CHU in F28.16 format. + The floating point keyword value is constructed by concatenating the + input integer value with the input double precision fraction value + (which must have a value between 0.0 and 1.0). The FTGKYT routine should + be used to read this keyword value, because the other keyword reading +> subroutines will not preserve the full precision of the value. +- + FTPKYT(unit,keyword,intval,dblval,comment, > status) +- +>11 Write keywords to the CHDU that are defined in an ASCII template file. + The format of the template file is described under the ftgthd +> routine below. +- + FTPKTP(unit, filename, > status) +- +>12 Append the physical units string to an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are enclosed in square brackets in the +> beginning of the keyword comment field. + +- + VELOCITY= 12.3 / [km/s] orbital speed + + FTPUNT(unit,keyword,units, > status) +- +***4. Insert Keyword Subroutines \label{FTIREC} + +>1 Insert a new keyword record into the CHU at the specified position + (i.e., immediately preceding the (keyno)th keyword in the header.) + This 'insert record' subroutine is somewhat less efficient + then the 'append record' subroutine (FTPREC) described above because +> the remaining keywords in the header have to be shifted down one slot. +- + FTIREC(unit,key_no,card, > status) +- +>2 Insert a new keyword into the CHU. The new keyword is inserted + immediately following the last keyword that has been read from the header. + The FTIKLS subroutine works the same as the FTIKYS subroutine, except + it also supports long string values greater than 68 characters in length. + These 'insert keyword' subroutines are somewhat less efficient then + the 'append keyword' subroutines described above because the remaining +> keywords in the header have to be shifted down one slot. +- + FTIKEY(unit, card, > status) + FTIKY[JLS](unit,keyword,keyval,comment, > status) + FTIKLS(unit,keyword,keyval,comment, > status) + FTIKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +- +>3 Insert a new keyword with an undefined, or null, value into the CHU. +> The value string of the keyword is left blank in this case. +- + FTIKYU(unit,keyword,comment, > status) +- +***5. Read Keyword Subroutines \label{FTGREC} + +These routines return the value of the specified keyword(s). Wild card +characters (*, ?, or \#) may be used when specifying the name of the keyword +to be read: a '?' will match any single character at that position in the +keyword name and a '*' will match any length (including zero) string of +characters. The '\#' character will match any consecutive string of +decimal digits (0 - 9). Note that when a wild card is used in the input +keyword name, the routine will only search for a match from the current +header position to the end of the header. It will not resume the search +from the top of the header back to the original header position as is done +when no wildcards are included in the keyword name. If the desired +keyword string is 8-characters long (the maximum length of a keyword +name) then a '*' may be appended as the ninth character of the input +name to force the keyword search to stop at the end of the header +(e.g., 'COMMENT *' will search for the next COMMENT keyword). The +ffgrec routine may be used to set the starting position when doing +wild card searches. + +>1 Get the nth 80-character header record from the CHU. The first keyword + in the header is at key\_no = 1; if key\_no = 0 then this subroutine + simple moves the internal pointer to the beginning of the header + so that subsequent keyword operations will start at the top of +> the header; it also returns a blank card value in this case. +- + FTGREC(unit,key_no, > card,status) +- +>2 Get the name, value (as a string), and comment of the nth keyword in CHU. + This routine also checks that the returned keyword name (KEYWORD) contains + only legal ASCII characters. Call FTGREC and FTPSVC to bypass this error +> check. +- + FTGKYN(unit,key_no, > keyword,value,comment,status) +- +>>3 Get the 80-character header record for the named keyword +- + FTGCRD(unit,keyword, > card,status) +- +>4 Get the next keyword whose name matches one of the strings in + 'inclist' but does not match any of the strings in 'exclist'. + The strings in inclist and exclist may contain wild card characters + (*, ?, and \#) as described at the beginning of this section. + This routine searches from the current header position to the + end of the header, only, and does not continue the search from + the top of the header back to the original position. The current + header position may be reset with the ftgrec routine. Note + that nexc may be set = 0 if there are no keywords to be excluded. + This routine returns status = 202 if a matching +> keyword is not found. +- + FTGNXK(unit,inclist,ninc,exclist,nexc, > card,status) +- +>5 Get the literal keyword value as a character string. Regardless + of the datatype of the keyword, this routine simply returns the + string of characters in the value field of the keyword along with +> the comment field. +- + FTGKEY(unit,keyword, > value,comment,status) +- +>6 Get a keyword value (with the appropriate datatype) and comment from +> the CHU +- + FTGKY[EDJLS](unit,keyword, > keyval,comment,status) +- +>7 Get a sequence of numbered keyword values. These +> routines do not support wild card characters in the root name. +- + FTGKN[EDJLS](unit,keyroot,startno,max_keys, > keyvals,nfound,status) +- +>8 Get the value of a floating point keyword, returning the integer and + fractional parts of the value in separate subroutine arguments. + This subroutine may be used to read any keyword but is especially +> useful for reading the 'triple precision' keywords written by FTPKYT. +- + FTGKYT(unit,keyword, > intval,dblval,comment,status) +- +>9 Get the physical units string in an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are + enclosed in square brackets in the beginning of the keyword comment + field. A blank string is returned if no units are defined +> for the keyword. +- + VELOCITY= 12.3 / [km/s] orbital speed + + FTGUNT(unit,keyword, > units,status) +- +***6. Modify Keyword Subroutines \label{FTMREC} + +Wild card characters, as described in the Read Keyword section, above, +may be used when specifying the name of the keyword to be modified. + +>>1 Modify (overwrite) the nth 80-character header record in the CHU +- + FTMREC(unit,key_no,card, > status) +- +>2 Modify (overwrite) the 80-character header record for the named keyword + in the CHU. This can be used to overwrite the name of the keyword as +> well as its value and comment fields. +- + FTMCRD(unit,keyword,card, > status) +- +>3 Modify (overwrite) the name of an existing keyword in the CHU +> preserving the current value and comment fields. +- + FTMNAM(unit,oldkey,keyword, > status) +- +>>4 Modify (overwrite) the comment field of an existing keyword in the CHU +- + FTMCOM(unit,keyword,comment, > status) +- +>5 Modify the value and comment fields of an existing keyword in the CHU. + The FTMKLS subroutine works the same as the FTMKYS subroutine, except + it also supports long string values greater than 68 characters in length. + Optionally, one may modify only the value field and leave the comment + field unchanged by setting the input COMMENT parameter equal to + the ampersand character (\&). + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, +> depending on the magnitude of the value. +- + FTMKY[JLS](unit,keyword,keyval,comment, > status) + FTMKLS(unit,keyword,keyval,comment, > status) + FTMKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +- +>6 Modify the value of an existing keyword to be undefined, or null. + The value string of the keyword is set to blank. + Optionally, one may leave the comment field unchanged by setting the +> input COMMENT parameter equal to the ampersand character (\&). +- + FTMKYU(unit,keyword,comment, > status) +- +***7. Update Keyword Subroutines \label{FTUCRD} + +>1 Update an 80-character record in the CHU. If the specified keyword + already exists then that header record will be replaced with + the input CARD string. If it does not exist then the new record will + be added to the header. + The FTUKLS subroutine works the same as the FTUKYS subroutine, except +> it also supports long string values greater than 68 characters in length. +- + FTUCRD(unit,keyword,card, > status) +- +>2 Update the value and comment fields of a keyword in the CHU. + The specified keyword is modified if it already exists (by calling + FTMKYx) otherwise a new keyword is created by calling FTPKYx. + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, +> depending on the magnitude of the value. +- + FTUKY[JLS](unit,keyword,keyval,comment, > status) + FTUKLS(unit,keyword,keyval,comment, > status) + FTUKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +- +>3 Update the value of an existing keyword to be undefined, or null, + or insert a new undefined-value keyword if it doesn't already exist. +> The value string of the keyword is left blank in this case. +- + FTUKYU(unit,keyword,comment, > status) +- +***8. Delete Keyword Subroutines \label{FTDREC} + +>1 Delete an existing keyword record. The space previously occupied by + the keyword is reclaimed by moving all the following header records up + one row in the header. The first routine deletes a keyword at a + specified position in the header (the first keyword is at position 1), + whereas the second routine deletes a specifically named keyword. + Wild card characters, as described in the Read Keyword section, above, + may be used when specifying the name of the keyword to be deleted +> (be careful!). +- + FTDREC(unit,key_no, > status) + FTDKEY(unit,keyword, > status) +- + +**F. Data Scaling and Undefined Pixel Parameters \label{FTPSCL} + +These subroutines define or modify the internal parameters used by +FITSIO to either scale the data or to represent undefined pixels. +Generally FITSIO will scale the data according to the values of the BSCALE +and BZERO (or TSCALn and TZEROn) keywords, however these subroutines +may be used to override the keyword values. This may be useful when +one wants to read or write the raw unscaled values in the FITS file. +Similarly, FITSIO generally uses the value of the BLANK or TNULLn +keyword to signify an undefined pixel, but these routines may be used +to override this value. These subroutines do not create or modify the +corresponding header keyword values. + +>1 Reset the scaling factors in the primary array or image extension; does + not change the BSCALE and BZERO keyword values and only affects the + automatic scaling performed when the data elements are written/read + to/from the FITS file. When reading from a FITS file the returned + data value = (the value given in the FITS array) * BSCALE + BZERO. + The inverse formula is used when writing data values to the FITS + file. (NOTE: BSCALE and BZERO must be declared as Double Precision +> variables). +- + FTPSCL(unit,bscale,bzero, > status) +- +>2 Reset the scaling parameters for a table column; does not change + the TSCALn or TZEROn keyword values and only affects the automatic + scaling performed when the data elements are written/read to/from + the FITS file. When reading from a FITS file the returned data + value = (the value given in the FITS array) * TSCAL + TZERO. The + inverse formula is used when writing data values to the FITS file. + (NOTE: TSCAL and TZERO must be declared as Double Precision +> variables). +- + FTTSCL(unit,colnum,tscal,tzero, > status) +- +>3 Define the integer value to be used to signify undefined pixels in the + primary array or image extension. This is only used if BITPIX = 8, 16, + or 32. This does not create or change the value of the BLANK keyword in +> the header. +- + FTPNUL(unit,blank, > status) +- +>4 Define the string to be used to signify undefined pixels in + a column in an ASCII table. This does not create or change the value +> of the TNULLn keyword. +- + FTSNUL(unit,colnum,snull > status) +- +>5 Define the value to be used to signify undefined pixels in + an integer column in a binary table (where TFORMn = 'B', 'I', or 'J'). +> This does not create or change the value of the TNULLn keyword. +- + FTTNUL(unit,colnum,tnull > status) +- + +**G. FITS Primary Array or IMAGE Extension I/O Subroutines \label{FTPPR} + + These subroutines put or get data values in the primary data array +(i.e., the first HDU in the FITS file) or an IMAGE extension. The +data array is represented as a single one-dimensional array of +pixels regardless of the actual dimensionality of the array, and the +FPIXEL parameter gives the position within this 1-D array of the first +pixel to read or write. Automatic data type conversion is performed +for numeric data (except for complex data types) if the data type of +the primary array (defined by the BITPIX keyword) differs from the data +type of the array in the calling subroutine. The data values are also +scaled by the BSCALE and BZERO header values as they are being written +or read from the FITS array. The ftpscl subroutine MUST be +called to define the scaling parameters when writing data to the FITS +array or to override the default scaling value given in the header when +reading the FITS array. + + Two sets of subroutines are provided to read the data array which +differ in the way undefined pixels are handled. The first set of +routines (FTGPVx) simply return an array of data elements in which +undefined pixels are set equal to a value specified by the user in the +'nullval' parameter. An additional feature of these subroutines is +that if the user sets nullval = 0, then no checks for undefined pixels +will be performed, thus increasing the speed of the program. The +second set of routines (FTGPFx) returns the data element array and, in +addition, a logical array which defines whether the corresponding data +pixel is undefined. The latter set of subroutines may be more +convenient to use in some circumstances, however, it requires an +additional array of logical values which can be unwieldy when working +with large data arrays. Also for programmer convenience, sets of +subroutines to directly read or write 2 and 3 dimensional arrays have +been provided, as well as a set of subroutines to read or write any +contiguous rectangular subset of pixels within the n-dimensional array. + +>1 Get the data type of the image (= BITPIX value). Possible returned + values are: 8, 16, 32, -32, or -64 corresponding to unsigned byte, + signed 2-byte integer, signed 4-byte integer, real, and double. + + The second subroutine is similar to FTGIDT, except that if the image + pixel values are scaled, with non-default values for the BZERO and + BSCALE keywords, then this routine will return the 'equivalent' + data type that is needed to store the scaled values. For example, + if BITPIX = 16 and BSCALE = 0.1 then the equivalent data type is + floating point, and -32 will be returned. There are 2 special cases: + if the image contains unsigned 2-byte integer values, with BITPIX = + 16, BSCALE = 1, and BZERO = 32768, then this routine will return + a non-standard value of 20 for the bitpix value. Similarly if the + image contains unsigned 4-byte integers, then bitpix will +> be returned with a value of 40. + +- + FTGIDT(unit, > bitpix,status) + FTGIET(unit, > bitpix,status) +- +>>2 Get the dimension (number of axes = NAXIS) of the image +- + FTGIDM(unit, > naxis,status) +- +>>3 Get the size of all the dimensions of the image +- + FTGISZ(unit, maxdim, > naxes,status) +- +>4 Get the parameters that define the type and size of the image. This +> routine simply combines calls to the above 3 routines. +- + FTGIPR(unit, maxdim, > bitpix, naxis, naxes, int *status) +- +>>5 Put elements into the data array +- + FTPPR[BIJED](unit,group,fpixel,nelements,values, > status) +- +>6 Put elements into the data array, substituting the appropriate FITS null + value for all elements which are equal to the value of NULLVAL. For + integer FITS arrays, the null value defined by the previous call to FTPNUL + will be substituted; for floating point FITS arrays (BITPIX = -32 + or -64) then the special IEEE NaN (Not-a-Number) value will be +> substituted. +- + FTPPN[BIJED](unit,group,fpixel,nelements,values,nullval > status) +- +>>7 Set data array elements as undefined +- + FTPPRU(unit,group,fpixel,nelements, > status) +- +>8 Get elements from the data array. Undefined array elements will be + returned with a value = nullval, unless nullval = 0 in which case no +> checks for undefined pixels will be performed. +- + FTGPV[BIJED](unit,group,fpixel,nelements,nullval, > values,anyf,status) +- +>9 Get elements and nullflags from data array. + Any undefined array elements will have the corresponding flagvals element +> set equal to .TRUE. +- + FTGPF[BIJED](unit,group,fpixel,nelements, > values,flagvals,anyf,status) +- +>>10 Put values into group parameters +- + FTPGP[BIJED](unit,group,fparm,nparm,values, > status) +- +>>11 Get values from group parameters +- + FTGGP[BIJED](unit,group,fparm,nparm, > values,status) +- +The following 4 subroutines transfer FITS images with 2 or 3 dimensions +to or from a data array which has been declared in the calling program. +The dimensionality of the FITS image is passed by the naxis1, naxis2, +and naxis3 parameters and the declared dimensions of the program array +are passed in the dim1 and dim2 parameters. Note that the program array +does not have to have the same dimensions as the FITS array, but must +be at least as big. For example if a FITS image with NAXIS1 = NAXIS2 = 400 +is read into a program array which is dimensioned as 512 x 512 pixels, +then the image will just fill the lower left corner of the array +with pixels in the range 1 - 400 in the X an Y directions. This has +the effect of taking a contiguous set of pixel value in the FITS array +and writing them to a non-contiguous array in program memory +(i.e., there are now some blank pixels around the edge of the image +in the program array). + +>>11 Put 2-D image into the data array +- + FTP2D[BIJED](unit,group,dim1,naxis1,naxis2,image, > status) +- +>>12 Put 3-D cube into the data array +- + FTP3D[BIJED](unit,group,dim1,dim2,naxis1,naxis2,naxis3,cube, > status) +- +>13 Get 2-D image from the data array. Undefined + pixels in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will +> be performed. +- + FTG2D[BIJED](unit,group,nullval,dim1,naxis1,naxis2, > image,anyf,status) +- +>14 Get 3-D cube from the data array. Undefined + pixels in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will +> be performed. +- + FTG3D[BIJED](unit,group,nullval,dim1,dim2,naxis1,naxis2,naxis3, > + cube,anyf,status) +- + +The following subroutines transfer a rectangular subset of the pixels +in a FITS N-dimensional image to or from an array which has been +declared in the calling program. The fpixels and lpixels parameters +are integer arrays which specify the starting and ending pixels in each +dimension of the FITS image that are to be read or written. (Note that +these are the starting and ending pixels in the FITS image, not in the +declared array). The array parameter is treated simply as a large +one-dimensional array of the appropriate datatype containing the pixel +values; The pixel values in the FITS array are read/written from/to +this program array in strict sequence without any gaps; it is up to +the calling routine to correctly interpret the dimensionality of this +array. The two families of FITS reading routines (FTGSVx and FTGSFx +subroutines) also have an 'incs' parameter which defines the +data sampling interval in each dimension of the FITS array. For +example, if incs(1)=2 and incs(2)=3 when reading a 2-dimensional +FITS image, then only every other pixel in the first dimension +and every 3rd pixel in the second dimension will be returned in +the 'array' parameter. [Note: the FTGSSx family of routines which +were present in previous versions of FITSIO have been superseded +by the more general FTGSVx family of routines.] + +>>15 Put an arbitrary data subsection into the data array. +- + FTPSS[BIJED](unit,group,naxis,naxes,fpixels,lpixels,array, > status) +- +>16 Get an arbitrary data subsection from the data array. Undefined + pixels in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will +> be performed. +- + FTGSV[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) +- +>17 Get an arbitrary data subsection from the data array. Any Undefined + pixels in the array will have the corresponding 'flagvals' +> element set equal to .TRUE. +- + FTGSF[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) +- + +**H. FITS ASCII and Binary Table Data I/O Subroutines + +***1. Column Information Subroutines \label{FTGCNO} + +>1 Get the number of rows or columns in the current FITS table. + The number of rows is given by the NAXIS2 keyword and the + number of columns is given by the TFIELDS keyword in the header +> of the table. +- + FTGNRW(unit, > nrows, status) + FTGNCL(unit, > ncols, status) +- +>2 Get the table column number (and name) of the column whose name +matches an input template name. The table column names are defined by +the TTYPEn keywords in the FITS header. If a column does not have a +TTYPEn keyword, then these routines assume that the name consists of +all blank characters. These 2 subroutines perform the same function +except that FTGCNO only returns the number of the matching column whereas +FTGCNN also returns the name of the column. If CASESEN = .true. then +the column name match will be case-sensitive. + +The input column name template (COLTEMPLATE) is (1) either the exact +name of the column to be searched for, or (2) it may contain wild cards +characters (*, ?, or \#), or (3) it may contain the number of the desired +column (where the number is expressed as ASCII digits). The first 2 wild +cards behave similarly to UNIX filename matching: the '*' character matches +any sequence of characters (including zero characters) and the '?' +character matches any single character. The \# wildcard will match +any consecutive string of decimal digits (0-9). As an example, the template +strings 'AB?DE', 'AB*E', and 'AB*CDE' will all match the string +'ABCDE'. If more than one column name in the table matches the +template string, then the first match is returned and the status value +will be set to 237 as a warning that a unique match was not found. To +find the other cases that match the template, simply call the +subroutine again leaving the input status value equal to 237 and the +next matching name will then be returned. Repeat this process until a +status = 219 (column name not found) is returned. If these subroutines +fail to match the template to any of the columns in the table, they +lastly check if the template can be interpreted as a simple positive +integer (e.g., '7', or '512') and if so, they return that column +number. If no matches are found then a status = 219 error is +returned. + +Note that the FITS Standard recommends that only letters, digits, and +the underscore character be used in column names (with no embedded +spaces in the name). Trailing blank characters are not significant. +It is recommended that the column names in a given table be unique +>within the first 8 characters. +- + FTGCNO(unit,casesen,coltemplate, > colnum,status) + FTGCNN(unit,casesen,coltemplate, > colname,colnum,status) +- +>3 Get the datatype of a column in an ASCII or binary table. This + routine returns an integer code value corresponding to the datatype + of the column. (See the FTBNFM and FTASFM subroutines in the Utilities + section of this document for a list of the code values). The vector + repeat count (which is alway 1 for ASCII table columns) is also returned. + If the specified column has an ASCII character datatype (code = 16) then + the width of a unit string in the column is also returned. Note that + this routine supports the local convention for specifying arrays of + strings within a binary table character column, using the syntax + TFORM = 'rAw' where 'r' is the total number of characters (= the width + of the column) and 'w' is the width of a unit string within the column. + Thus if the column has TFORM = '60A12' then this routine will return + datacode = 16, repeat = 60, and width = 12. + + The second routine, FTEQTY is similar except that in + the case of scaled integer columns it returns the 'equivalent' data + type that is needed to store the scaled values, and not necessarily + the physical data type of the unscaled values as stored in the FITS + table. For example if a '1I' column in a binary table has TSCALn = + 1 and TZEROn = 32768, then this column effectively contains unsigned + short integer values, and thus the returned value of typecode will + be the code for an unsigned short integer, not a signed short integer. + Similarly, if a column has TTYPEn = '1I' + and TSCALn = 0.12, then the returned typecode +> will be the code for a 'real' column. +- + FTGTCL(unit,colnum, > datacode,repeat,width,status) + FTEQTY(unit,colnum, > datacode,repeat,width,status) +- +>4 Return the display width of a column. This is the length + of the string that will be returned + when reading the column as a formatted string. The display width is + determined by the TDISPn keyword, if present, otherwise by the data +> type of the column. +- + FTGCDW(unit, colnum, > dispwidth, status) +- +>5 Get information about an existing ASCII table column. (NOTE: TSCAL and + TZERO must be declared as Double Precision variables). All the +> returned parameters are scalar quantities. +- + FTGACL(unit,colnum, > + ttype,tbcol,tunit,tform,tscal,tzero,snull,tdisp,status) +- +>6 Get information about an existing binary table column. (NOTE: TSCAL and + TZERO must be declared as Double Precision variables). DATATYPE is a + character string which returns the datatype of the column as defined + by the TFORMn keyword (e.g., 'I', 'J','E', 'D', etc.). In the case + of an ASCII character column, DATATYPE will have a value of the + form 'An' where 'n' is an integer expressing the width of the field + in characters. For example, if TFORM = '160A8' then FTGBCL will return + DATATYPE='A8' and REPEAT=20. All the returned parameters are scalar +> quantities. +- + FTGBCL(unit,colnum, > + ttype,tunit,datatype,repeat,tscal,tzero,tnull,tdisp,status) +- +>7 Put (append) a TDIMn keyword whose value has the form '(l,m,n...)' + where l, m, n... are the dimensions of a multidimension array +> column in a binary table. +- + FTPTDM(unit,colnum,naxis,naxes, > status) +- +>8 Return the number of and size of the dimensions of a table column. + Normally this information is given by the TDIMn keyword, but if + this keyword is not present then this routine returns NAXIS = 1 +> and NAXES(1) equal to the repeat count in the TFORM keyword. +- + FTGTDM(unit,colnum,maxdim, > naxis,naxes,status) +- +>9 Decode the input TDIMn keyword string (e.g. '(100,200)') and return the + number of and size of the dimensions of a binary table column. If the input + tdimstr character string is null, then this routine returns naxis = 1 + and naxes[0] equal to the repeat count in the TFORM keyword. This routine +> is called by FTGTDM. +- + FTDTDM(unit,tdimstr,colnum,maxdim, > naxis,naxes, status) +- +>10 Return the optimal number of rows to read or write at one time for + maximum I/O efficiency. Refer to the ``Optimizing Code'' section +> in Chapter 5 for more discussion on how to use this routine. + +- + FFGRSZ(unit, > nrows,status) +- + +***2. Low-Level Table Access Subroutines \label{FTGTBS} + +The following subroutines provide low-level access to the data in ASCII +or binary tables and are mainly useful as an efficient way to copy all +or part of a table from one location to another. These routines simply +read or write the specified number of consecutive bytes in an ASCII or +binary table, without regard for column boundaries or the row length in +the table. The first two subroutines read or write consecutive bytes +in a table to or from a character string variable, while the last two +subroutines read or write consecutive bytes to or from a variable +declared as a numeric data type (e.g., INTEGER, INTEGER*2, REAL, DOUBLE +PRECISION). These routines do not perform any machine dependent data +conversion or byte swapping, except that conversion to/from ASCII +format is performed by the FTGTBS and FTPTBS routines on machines which +do not use ASCII character codes in the internal data representations +(e.g., on IBM mainframe computers). + +>1 Read a consecutive string of characters from an ASCII table + into a character variable (spanning columns and multiple rows if necessary) + This routine should not be used with binary tables because of +> complications related to passing string variables between C and Fortran. +- + FTGTBS(unit,frow,startchar,nchars, > string,status) +- +>2 Write a consecutive string of characters to an ASCII table + from a character variable (spanning columns and multiple rows if necessary) + This routine should not be used with binary tables because of +> complications related to passing string variables between C and Fortran. +- + FTPTBS(unit,frow,startchar,nchars,string, > status) +- +>3 Read a consecutive array of bytes from an ASCII or binary table + into a numeric variable (spanning columns and multiple rows if necessary). + The array parameter may be declared as any numerical datatype as long + as the array is at least 'nchars' bytes long, e.g., if nchars = 17, +> then declare the array as INTEGER*4 ARRAY(5). +- + FTGTBB(unit,frow,startchar,nchars, > array,status) +- +>4 Write a consecutive array of bytes to an ASCII or binary table + from a numeric variable (spanning columns and multiple rows if necessary) + The array parameter may be declared as any numerical datatype as long + as the array is at least 'nchars' bytes long, e.g., if nchars = 17, +> then declare the array as INTEGER*4 ARRAY(5). +- + FTPTBB(unit,frow,startchar,nchars,array, > status) +- + +***3. Edit Rows or Columns \label{FTIROW} + +>1 Insert blank rows into an existing ASCII or binary table (in the CDU). + All the rows FOLLOWING row FROW are shifted down by NROWS rows. If + FROW = 0 then the blank rows are inserted at the beginning of the + table. This routine modifies the NAXIS2 keyword to reflect the new +> number of rows in the table. +- + FTIROW(unit,frow,nrows, > status) +- +>2 Delete rows from an existing ASCII or binary table (in the CDU). + The NROWS number of rows are deleted, starting with row FROW, and + any remaining rows in the table are shifted up to fill in the space. + This routine modifies the NAXIS2 keyword to reflect the new number +> of rows in the table. +- + FTDROW(unit,frow,nrows, > status) +- +>3 Delete a list of rows from an ASCII or binary table (in the CDU). + In the first routine, 'rowrange' is a character string listing the + rows or row ranges to delete (e.g., '2-4, 5, 8-9'). In the second + routine, 'rowlist' is an integer array of row numbers to be deleted + from the table. nrows is the number of row numbers in the list. + The first row in the table is 1 not 0. The list of row numbers +> must be sorted in ascending order. +- + FTDRRG(unit,rowrange, > status) + FTDRWS(unit,rowlist,nrows, > status) +- +>4 Insert a blank column (or columns) into an existing ASCII or binary + table (in the CDU). COLNUM specifies the column number that the (first) + new column should occupy in the table. NCOLS specifies how many + columns are to be inserted. Any existing columns from this position and + higher are moved over to allow room for the new column(s). + The index number on all the following keywords will be incremented + if necessary to reflect the new position of the column(s) in the table: + TBCOLn, TFORMn, TTYPEn, TUNITn, TNULLn, TSCALn, TZEROn, TDISPn, TDIMn, + TLMINn, TLMAXn, TDMINn, TDMAXn, TCTYPn, TCRPXn, TCRVLn, TCDLTn, TCROTn, +> and TCUNIn. +- + FTICOL(unit,colnum,ttype,tform, > status) + FTICLS(unit,colnum,ncols,ttype,tform, > status) +- +>5 Modify the vector length of a binary table column (e.g., + change a column from TFORMn = '1E' to '20E'). The vector +> length may be increased or decreased from the current value. +- + FTMVEC(unit,colnum,newveclen, > status) +- +>6 Delete a column from an existing ASCII or binary table (in the CDU). + The index number of all the keywords listed above (for FTICOL) will be + decremented if necessary to reflect the new position of the column(s) in + the table. Those index keywords that refer to the deleted column will + also be deleted. Note that the physical size of the FITS file will + not be reduced by this operation, and the empty FITS blocks if any +> at the end of the file will be padded with zeros. +- + FTDCOL(unit,colnum, > status) +- +>7 Copy a column from one HDU to another (or to the same HDU). If + createcol = TRUE, then a new column will be inserted in the output + table, at position `outcolumn', otherwise the existing output column will + be overwritten (in which case it must have a compatible datatype). +> Note that the first column in a table is at colnum = 1. +- + FTCPCL(inunit,outunit,incolnum,outcolnum,createcol, > status); +- +***4. Read and Write Column Data Routines \label{FTPCLS} + +These subroutines put or get data values in the current ASCII or Binary table +extension. Automatic data type conversion is performed for numerical data +types (B,I,J,E,D) if the data type of the column (defined by the TFORM keyword) +differs from the data type of the calling subroutine. The data values are also +scaled by the TSCALn and TZEROn header values as they are being written to +or read from the FITS array. The fttscl subroutine MUST be used to define the +scaling parameters when writing data to the table or to override the default +scaling values given in the header +when reading from the table. + + In the case of binary tables with vector elements, the 'felem' +parameter defines the starting pixel within the element vector. This +parameter is ignored with ASCII tables. Similarly, in the case of +binary tables the 'nelements' parameter specifies the total number of +vector values read or written (continuing on subsequent rows if +required) and not the number of table elements. Two sets of +subroutines are provided to get the column data which differ in the way +undefined pixels are handled. The first set of routines (FTGCV) +simply return an array of data elements in which undefined pixels are +set equal to a value specified by the user in the 'nullval' parameter. +An additional feature of these subroutines is that if the user sets +nullval = 0, then no checks for undefined pixels will be performed, +thus increasing the speed of the program. The second set of routines +(FTGCF) returns the data element array and in addition a logical array +of flags which defines whether the corresponding data pixel is undefined. + + Any column, regardless of it's intrinsic datatype, may be read as a + string. It should be noted however that reading a numeric column + as a string is 10 - 100 times slower than reading the same column as + a number due to the large overhead in constructing the formatted + strings. The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + datatype of the column. The length of the returned strings can be + determined with the ftgcdw routine. The following TDISPn display + formats are currently supported: +- + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +- + where w is the width in characters of the displayed values, m is the minimum + number of digits displayed, and d is the number of digits to the right of the + decimal. The .m field is optional. + +>1 Put elements into an ASCII or binary table column (in the CDU). + (The SPP FSPCLS routine has an additional integer argument after + the VALUES character string which specifies the size of the 1st +> dimension of this 2-D CHAR array). +- + FTPCL[SLBIJEDCM](unit,colnum,frow,felem,nelements,values, > status) +- +>2 Put elements into an ASCII or binary table column (in the CDU) + substituting the appropriate FITS null value for any elements that + are equal to NULLVAL. This family of routines must NOT be used to + write to variable length array columns. For ASCII TABLE extensions, the + null value defined by the previous call to FTSNUL will be substituted; + For integer FITS columns, in a binary table the null value + defined by the previous call to FTTNUL will be substituted; + For floating point FITS columns a special IEEE NaN (Not-a-Number) +> value will be substituted. +- + FTPCN[BIJED](unit,colnum,frow,felem,nelements,values,nullval > status) +- +>3 Put bit values into a binary byte ('B') or bit ('X') table column (in the + CDU). LRAY is an array of logical values corresponding to the sequence of + bits to be written. If LRAY is true then the corresponding bit is + set to 1, otherwise the bit is set to 0. Note that in the case of + 'X' columns, FITSIO will write to all 8 bits of each byte whether + they are formally valid or not. Thus if the column is defined as + '4X', and one calls FTPCLX with fbit=1 and nbit=8, then all 8 bits + will be written into the first byte (as opposed to writing the + first 4 bits into the first row and then the next 4 bits into the + next row), even though the last 4 bits of each byte are formally +> not defined. +- + FTPCLX(unit,colnum,frow,fbit,nbit,lray, > status) +- +>>4 Set table elements in a column as undefined +- + FTPCLU(unit,colnum,frow,felem,nelements, > status) +- +>5 Get elements from an ASCII or binary table column (in the CDU). These + routines return the values of the table column array elements. Undefined + array elements will be returned with a value = nullval, unless nullval = 0 + (or = ' ' for ftgcvs) in which case no checking for undefined values will + be performed. The ANYF parameter is set to true if any of the returned + elements are undefined. (Note: the ftgcl routine simple gets an array + of logical data values without any checks for undefined values; use + the ftgcfl routine to check for undefined logical elements). + (The SPP FSGCVS routine has an additional integer argument after + the VALUES character string which specifies the size of the 1st +> dimension of this 2-D CHAR array). +- + FTGCL(unit,colnum,frow,felem,nelements, > values,status) + FTGCV[SBIJEDCM](unit,colnum,frow,felem,nelements,nullval, > + values,anyf,status) +- +>6 Get elements and null flags from an ASCII or binary table column (in the + CHDU). These routines return the values of the table column array elements. + Any undefined array elements will have the corresponding flagvals element + set equal to .TRUE. The ANYF parameter is set to true if any of the + returned elements are undefined. + (The SPP FSGCFS routine has an additional integer argument after + the VALUES character string which specifies the size of the 1st +> dimension of this 2-D CHAR array). +- + FTGCF[SLBIJEDCM](unit,colnum,frow,felem,nelements, > + values,flagvals,anyf,status) +- +>7 Get an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Undefined pixels + in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will + be performed. The first and last rows in the table to be read + are specified by fpixels(naxis+1) and lpixels(naxis+1), and hence + are treated as the next higher dimension of the FITS N-dimensional + array. The INCS parameter specifies the sampling interval in +> each dimension between the data elements that will be returned. +- + FTGSV[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) +- +>8 Get an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Any Undefined + pixels in the array will have the corresponding 'flagvals' + element set equal to .TRUE. The first and last rows in the table + to be read are specified by fpixels(naxis+1) and lpixels(naxis+1), + and hence are treated as the next higher dimension of the FITS + N-dimensional array. The INCS parameter specifies the sampling + interval in each dimension between the data elements that will be +> returned. +- + FTGSF[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) +- +>9 Get bit values from a byte ('B') or bit (`X`) table column (in the + CDU). LRAY is an array of logical values corresponding to the + sequence of bits to be read. If LRAY is true then the + corresponding bit was set to 1, otherwise the bit was set to 0. + Note that in the case of 'X' columns, FITSIO will read all 8 bits + of each byte whether they are formally valid or not. Thus if the + column is defined as '4X', and one calls FTGCX with fbit=1 and + nbit=8, then all 8 bits will be read from the first byte (as + opposed to reading the first 4 bits from the first row and then the + first 4 bits from the next row), even though the last 4 bits of +> each byte are formally not defined. +- + FTGCX(unit,colnum,frow,fbit,nbit, > lray,status) +- +>10 Read any consecutive set of bits from an 'X' or 'B' column and + interpret them as an unsigned n-bit integer. NBIT must be less than + or equal to 16 when calling FTGCXI, and less than or equal to 32 when + calling FTGCXJ; there is no limit on the value of NBIT for FTGCXD, but + the returned double precision value only has 48 bits of precision on + most 32-bit word machines. The NBITS bits are interpreted as an + unsigned integer unless NBITS = 16 (in FTGCXI) or 32 (in FTGCXJ) in which + case the string of bits are interpreted as 16-bit or 32-bit 2's + complement signed integers. If NROWS is greater than 1 then the + same set of bits will be read from sequential rows in the table + starting with row FROW. Note that the numbering convention + used here for the FBIT parameter adopts 1 for the first element of the +> vector of bits; this is the Most Significant Bit of the integer value. +- + FTGCX[IJD](unit,colnum,frow,nrows,fbit,nbit, > array,status) +- +>11 Get the descriptor for a variable length column in a binary table. + The descriptor consists of 2 integer parameters: the number of elements + in the array and the starting offset relative to the start of the heap. + The first routine returns a single descriptor whereas the second routine +> returns the descriptors for a range of rows in the table. +- + FTGDES(unit,colnum,rownum, > nelements,offset,status) + FFGDESSunit,colnum,firstrow,nrows > nelements,offset, status) +- +>12 Put the descriptor for a variable length column in a binary table. + This subroutine can be used in conjunction with FTGDES to enable + 2 or more arrays to point to the same storage location to save +> storage space if the arrays are identical. +- + FTPDES(unit,colnum,rownum,nelements,offset, > status) +- + +**I. Row Selection and Calculator Routines \label{FTFROW} + +These routines all parse and evaluate an input string containing a user +defined arithmetic expression. The first 3 routines select rows in a +FITS table, based on whether the expression evaluates to true (not +equal to zero) or false (zero). The other routines evaluate the +expression and calculate a value for each row of the table. The +allowed expression syntax is described in the row filter section in the +earlier `Extended File Name Syntax' chapter of this document. The +expression may also be written to a text file, and the name of the +file, prepended with a '@' character may be supplied for the 'expr' +parameter (e.g. '@filename.txt'). The expression in the file can +be arbitrarily complex and extend over multiple lines of the file. +Lines that begin with 2 slash characters ('//') will be ignored and +may be used to add comments to the file. + +>1 Evaluate a boolean expression over the indicated rows, returning an +> array of flags indicating which rows evaluated to TRUE/FALSE +- + FTFROW(unit,expr,firstrow, nrows, > n_good_rows, row_status, status) +- +>>2 Find the first row which satisfies the input boolean expression +- + FTFFRW(unit, expr, > rownum, status) +- +>3 Evaluate an expression on all rows of a table. If the input and output +files are not the same, copy the TRUE rows to the output file. If the +>files are the same, delete the FALSE rows (preserve the TRUE rows). +- + FTSROW(inunit, outunit, expr, > status) +- +>4 Calculate an expression for the indicated rows of a table, returning +the results, cast as datatype (TSHORT, TDOUBLE, etc), in array. If +nulval==NULL, UNDEFs will be zeroed out. For vector results, the number +of elements returned may be less than nelements if nelements is not an +even multiple of the result dimension. Call FTTEXP to obtain +>the dimensions of the results. +- + FTCROW(unit,datatype,expr,firstrow,nelements,nulval, > + array,anynul,status) +- +>5 Evaluate an expression and write the result either to a column (if +the expression is a function of other columns in the table) or to a +keyword (if the expression evaluates to a constant and is not a +function of other columns in the table). In the former case, the +parName parameter is the name of the column (which may or may not already +exist) into which to write the results, and parInfo contains an +optional TFORM keyword value if a new column is being created. If a +TFORM value is not specified then a default format will be used, +depending on the expression. If the expression evaluates to a constant, +then the result will be written to the keyword name given by the +parName parameter, and the parInfo parameter may be used to supply an +optional comment for the keyword. If the keyword does not already +exist, then the name of the keyword must be preceded with a '\#' character, +>otherwise the result will be written to a column with that name. + +- + FTCALC(inunit, expr, outunit, parName, parInfo, > status) +- +>6 This calculator routine is similar to the previous routine, except +that the expression is only evaluated over the specified +row ranges. nranges specifies the number of row ranges, and firstrow +>and lastrow give the starting and ending row number of each range. +- + FTCALC_RNG(inunit, expr, outunit, parName, parInfo, + nranges, firstrow, lastrow, > status) +- +>>7 Evaluate the given expression and return information on the result. +- + FTTEXP(unit, expr, > datatype, nelem, naxis, naxes, status) +- + + +**J. Celestial Coordinate System Subroutines \label{FTGICS} + +The FITS community has adopted a set of keyword conventions that define +the transformations needed to convert between pixel locations in an +image and the corresponding celestial coordinates on the sky, or more +generally, that define world coordinates that are to be associated with +any pixel location in an n-dimensional FITS array. CFITSIO is distributed +with a couple of self-contained World Coordinate System (WCS) routines, +however, these routines DO NOT support all the latest WCS conventions, +so it is STRONGLY RECOMMENDED that software developers use a more robust +external WCS library. Several recommended libraries are: +- + WCSLIB - supported by Mark Calabretta + WCSTools - supported by Doug Mink + AST library - developed by the U.K. Starlink project +- + +More information about the WCS keyword conventions and links to all of +these WCS libraries can be found on the FITS Support Office web site at +http://fits.gsfc.nasa.gov under the WCS link. + +The functions provided in these external WCS libraries will need access to +the WCS information contained in the FITS file headers. One convenient +way to pass this information to the extermal library is to use FITSIO +to copy the header keywords into one long character string, and then +pass this string to an interface routine in the external library that +will extract the necessary WCS information (e.g., see the astFitsChan +and astPutCards routines in the Starlink AST library). + +The following FITSIO routines DO NOT support the more recent WCS conventions +that have been approved as part of the FITS standard. Consequently, +the following routines ARE NOW DEPRECATED. It is STRONGLY RECOMMENDED +that software developers not use these routines, and instead use an +external WCS library, as described above. + +These routines are included mainly for backward compatibility with +existing software. They support the following standard map +projections: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, and -AIT (these are the +legal values for the coordtype parameter). These routines are based +on similar functions in Classic AIPS. All the angular quantities are +given in units of degrees. + +>1 Get the values of all the standard FITS celestial coordinate system + keywords from the header of a FITS image (i.e., the primary array or + an image extension). These values may then be passed to the subroutines + that perform the coordinate transformations. If any or all of the WCS + keywords are not present, then default values will be returned. If + the first coordinate axis is the declination-like coordinate, then + this routine will swap them so that the longitudinal-like coordinate + is returned as the first axis. + + If the file uses the newer 'CDj\_i' WCS transformation matrix + keywords instead of old style 'CDELTn' and 'CROTA2' keywords, then + this routine will calculate and return the values of the equivalent + old-style keywords. Note that the conversion from the new-style + keywords to the old-style values is sometimes only an + approximation, so if the approximation is larger than an internally + defined threshold level, then CFITSIO will still return the + approximate WCS keyword values, but will also return with status = + 506, to warn the calling program that approximations have been + made. It is then up to the calling program to decide whether the + approximations are sufficiently accurate for the particular + application, or whether more precise WCS transformations must be +> performed using new-style WCS keywords directly. +- + FTGICS(unit, > xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) +- +>2 Get the values of all the standard FITS celestial coordinate system + keywords from the header of a FITS table where the X and Y (or RA and + DEC coordinates are stored in 2 separate columns of the table. + These values may then be passed to the subroutines that perform the +> coordinate transformations. +- + FTGTCS(unit,xcol,ycol, > + xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) +- +>3 Calculate the celestial coordinate corresponding to the input +> X and Y pixel location in the image. +- + FTWLDP(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpos,ypos,status) +- +>4 Calculate the X and Y pixel location corresponding to the input +> celestial coordinate in the image. +- + FTXYPX(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpix,ypix,status) +- + +**K. File Checksum Subroutines \label{FTPCKS} + +The following routines either compute or validate the checksums for the +CHDU. The DATASUM keyword is used to store the numerical value of the +32-bit, 1's complement checksum for the data unit alone. If there is +no data unit then the value is set to zero. The numerical value is +stored as an ASCII string of digits, enclosed in quotes, because the +value may be too large to represent as a 32-bit signed integer. The +CHECKSUM keyword is used to store the ASCII encoded COMPLEMENT of the +checksum for the entire HDU. Storing the complement, rather than the +actual checksum, forces the checksum for the whole HDU to equal zero. +If the file has been modified since the checksums were computed, then +the HDU checksum will usually not equal zero. These checksum keyword +conventions are based on a paper by Rob Seaman published in the +proceedings of the ADASS IV conference in Baltimore in November 1994 +and a later revision in June 1995. + +>1 Compute and write the DATASUM and CHECKSUM keyword values for the CHDU + into the current header. The DATASUM value is the 32-bit checksum + for the data unit, expressed as a decimal integer enclosed in single + quotes. The CHECKSUM keyword value is a 16-character string which + is the ASCII-encoded value for the complement of the checksum for + the whole HDU. If these keywords already exist, their values + will be updated only if necessary (i.e., if the file has been modified +> since the original keyword values were computed). +- + FTPCKS(unit, > status) +- +>2 Update the CHECKSUM keyword value in the CHDU, assuming that the + DATASUM keyword exists and already has the correct value. This routine + calculates the new checksum for the current header unit, adds it to the + data unit checksum, encodes the value into an ASCII string, and writes +> the string to the CHECKSUM keyword. +- + FTUCKS(unit, > status) +- +>3 Verify the CHDU by computing the checksums and comparing + them with the keywords. The data unit is verified correctly + if the computed checksum equals the value of the DATASUM + keyword. The checksum for the entire HDU (header plus data unit) is + correct if it equals zero. The output DATAOK and HDUOK parameters + in this subroutine are integers which will have a value = 1 + if the data or HDU is verified correctly, a value = 0 + if the DATASUM or CHECKSUM keyword is not present, or value = -1 +> if the computed checksum is not correct. +- + FTVCKS(unit, > dataok,hduok,status) +- +>4 Compute and return the checksum values for the CHDU (as + double precision variables) without creating or modifying the + CHECKSUM and DATASUM keywords. This routine is used internally by +> FTVCKS, but may be useful in other situations as well. +- + FTGCKS(unit, > datasum,hdusum,status) +- +>5 Encode a checksum value (stored in a double precision variable) + into a 16-character string. If COMPLEMENT = .true. then the 32-bit +> sum value will be complemented before encoding. +- + FTESUM(sum,complement, > checksum) +- +>6 Decode a 16 character checksum string into a double precision value. + If COMPLEMENT = .true. then the 32-bit sum value will be complemented +> after decoding. +- + FTDSUM(checksum,complement, > sum) +- + +**L. Date and Time Utility Routines \label{FTGSDT} + +The following routines help to construct or parse the FITS date/time +strings. Starting in the year 2000, the FITS DATE keyword values (and +the values of other `DATE-' keywords) must have the form 'YYYY-MM-DD' +(date only) or 'YYYY-MM-DDThh:mm:ss.ddd...' (date and time) where the +number of decimal places in the seconds value is optional. These times +are in UTC. The older 'dd/mm/yy' date format may not be used for dates +after 01 January 2000. + +>1 Get the current system date. The returned year has 4 digits +> (1999, 2000, etc.) +- + FTGSDT( > day, month, year, status ) +- + +>2 Get the current system date and time string ('YYYY-MM-DDThh:mm:ss'). +The time will be in UTC/GMT if available, as indicated by a returned timeref +value = 0. If the returned value of timeref = 1 then this indicates that +it was not possible to convert the local time to UTC, and thus the local +>time was returned. +- + FTGSTM(> datestr, timeref, status) +- + +>3 Construct a date string from the input date values. If the year +is between 1900 and 1998, inclusive, then the returned date string will +have the old FITS format ('dd/mm/yy'), otherwise the date string will +have the new FITS format ('YYYY-MM-DD'). Use FTTM2S instead +> to always return a date string using the new FITS format. +- + FTDT2S( year, month, day, > datestr, status) +- + +>4 Construct a new-format date + time string ('YYYY-MM-DDThh:mm:ss.ddd...'). + If the year, month, and day values all = 0 then only the time is encoded + with format 'hh:mm:ss.ddd...'. The decimals parameter specifies how many + decimal places of fractional seconds to include in the string. If `decimals' +> is negative, then only the date will be return ('YYYY-MM-DD'). +- + FTTM2S( year, month, day, hour, minute, second, decimals, + > datestr, status) +- + +>5 Return the date as read from the input string, where the string may be +in either the old ('dd/mm/yy') or new ('YYYY-MM-DDThh:mm:ss' or +>'YYYY-MM-DD') FITS format. +- + FTS2DT(datestr, > year, month, day, status) +- + +>6 Return the date and time as read from the input string, where the +string may be in either the old or new FITS format. The returned hours, +minutes, and seconds values will be set to zero if the input string +does not include the time ('dd/mm/yy' or 'YYYY-MM-DD') . Similarly, +the returned year, month, and date values will be set to zero if the +>date is not included in the input string ('hh:mm:ss.ddd...'). +- + FTS2TM(datestr, > year, month, day, hour, minute, second, status) +- + +**M. General Utility Subroutines \label{FTGHAD} + +The following utility subroutines may be useful for certain applications: + +>>1 Return the starting byte address of the CHDU and the next HDU. +- + FTGHAD(iunit, > curaddr,nextaddr) +- +>>2 Convert a character string to uppercase (operates in place). +- + FTUPCH(string) +- +>3 Compare the input template string against the reference string + to see if they match. The template string may contain wildcard + characters: '*' will match any sequence of characters (including + zero characters) and '%' will match any single character in the + reference string. If CASESN = .true. then the match will be + case sensitive. The returned MATCH parameter will be .true. if + the 2 strings match, and EXACT will be .true. if the match is + exact (i.e., if no wildcard characters were used in the match). +> Both strings must be 68 characters or less in length. +- + FTCMPS(str_template,string,casesen, > match,exact) +- + +>4 Test that the keyword name contains only legal characters: A-Z,0-9, +> hyphen, and underscore. +- + FTTKEY(keyword, > status) +- +>5 Test that the keyword record contains only legal printable ASCII +> characters +- + FTTREC(card, > status) +- +>6 Test whether the current header contains any NULL (ASCII 0) characters. + These characters are illegal in the header, but they will go undetected + by most of the CFITSIO keyword header routines, because the null is + interpreted as the normal end-of-string terminator. This routine returns + the position of the first null character in the header, or zero if there + are no nulls. For example a returned value of 110 would indicate that + the first NULL is located in the 30th character of the second keyword + in the header (recall that each header record is 80 characters long). + Note that this is one of the few FITSIO routines in which the returned +> value is not necessarily equal to the status value). +- + FTNCHK(unit, > status) +- +>7 Parse a header keyword record and return the name of the keyword + and the length of the name. + The keyword name normally occupies the first 8 characters of the + record, except under the HIERARCH convention where the name can +> be up to 70 characters in length. +- + FTGKNM(card, > keyname, keylength, status) +- +>8 Parse a header keyword record. + This subroutine parses the input header record to return the value (as + a character string) and comment strings. If the keyword has no + value (columns 9-10 not equal to '= '), then the value string is returned + blank and the comment string is set equal to column 9 - 80 of the +> input string. +- + FTPSVC(card, > value,comment,status) +- +>9 Construct a sequence keyword name (ROOT + nnn). + This subroutine appends the sequence number to the root string to create +> a keyword name (e.g., 'NAXIS' + 2 = 'NAXIS2') +- + FTKEYN(keyroot,seq_no, > keyword,status) +- +>10 Construct a sequence keyword name (n + ROOT). + This subroutine concatenates the sequence number to the front of the +> root string to create a keyword name (e.g., 1 + 'CTYP' = '1CTYP') +- + FTNKEY(seq_no,keyroot, > keyword,status) +- +>11 Determine the datatype of a keyword value string. + This subroutine parses the keyword value string (usually columns 11-30 +> of the header record) to determine its datatype. +- + FTDTYP(value, > dtype,status) +- +>11 Return the class of input header record. The record is classified + into one of the following categories (the class values are + defined in fitsio.h). Note that this is one of the few FITSIO +> routines that does not return a status value. +- + Class Value Keywords + TYP_STRUC_KEY 10 SIMPLE, BITPIX, NAXIS, NAXISn, EXTEND, BLOCKED, + GROUPS, PCOUNT, GCOUNT, END + XTENSION, TFIELDS, TTYPEn, TBCOLn, TFORMn, THEAP, + and the first 4 COMMENT keywords in the primary array + that define the FITS format. + TYP_CMPRS_KEY 20 The experimental keywords used in the compressed + image format ZIMAGE, ZCMPTYPE, ZNAMEn, ZVALn, + ZTILEn, ZBITPIX, ZNAXISn, ZSCALE, ZZERO, ZBLANK + TYP_SCAL_KEY 30 BSCALE, BZERO, TSCALn, TZEROn + TYP_NULL_KEY 40 BLANK, TNULLn + TYP_DIM_KEY 50 TDIMn + TYP_RANG_KEY 60 TLMINn, TLMAXn, TDMINn, TDMAXn, DATAMIN, DATAMAX + TYP_UNIT_KEY 70 BUNIT, TUNITn + TYP_DISP_KEY 80 TDISPn + TYP_HDUID_KEY 90 EXTNAME, EXTVER, EXTLEVEL, HDUNAME, HDUVER, HDULEVEL + TYP_CKSUM_KEY 100 CHECKSUM, DATASUM + TYP_WCS_KEY 110 CTYPEn, CUNITn, CRVALn, CRPIXn, CROTAn, CDELTn + CDj_is, PVj_ms, LONPOLEs, LATPOLEs + TCTYPn, TCTYns, TCUNIn, TCUNns, TCRVLn, TCRVns, TCRPXn, + TCRPks, TCDn_k, TCn_ks, TPVn_m, TPn_ms, TCDLTn, TCROTn + jCTYPn, jCTYns, jCUNIn, jCUNns, jCRVLn, jCRVns, iCRPXn, + iCRPns, jiCDn, jiCDns, jPVn_m, jPn_ms, jCDLTn, jCROTn + (i,j,m,n are integers, s is any letter) + TYP_REFSYS_KEY 120 EQUINOXs, EPOCH, MJD-OBSs, RADECSYS, RADESYSs + TYP_COMM_KEY 130 COMMENT, HISTORY, (blank keyword) + TYP_CONT_KEY 140 CONTINUE + TYP_USER_KEY 150 all other keywords + + class = FTGKCL (char *card) +- +>12 Parse the 'TFORM' binary table column format string. + This subroutine parses the input TFORM character string and returns the + integer datatype code, the repeat count of the field, and, in the case + of character string fields, the length of the unit string. The following + datatype codes are returned (the negative of the value is returned +> if the column contains variable-length arrays): +- + Datatype DATACODE value + bit, X 1 + byte, B 11 + logical, L 14 + ASCII character, A 16 + short integer, I 21 + integer, J 41 + real, E 42 + double precision, D 82 + complex 83 + double complex 163 + + FTBNFM(tform, > datacode,repeat,width,status) +- +>13 Parse the 'TFORM' keyword value that defines the column format in + an ASCII table. This routine parses the input TFORM character + string and returns the datatype code, the width of the column, + and (if it is a floating point column) the number of decimal places + to the right of the decimal point. The returned datatype codes are + the same as for the binary table, listed above, with the following + additional rules: integer columns that are between 1 and 4 characters + wide are defined to be short integers (code = 21). Wider integer + columns are defined to be regular integers (code = 41). Similarly, + Fixed decimal point columns (with TFORM = 'Fw.d') are defined to + be single precision reals (code = 42) if w is between 1 and 7 characters + wide, inclusive. Wider 'F' columns will return a double precision + data code (= 82). 'Ew.d' format columns will have datacode = 42, +> and 'Dw.d' format columns will have datacode = 82. +- + FTASFM(tform, > datacode,width,decimals,status) +- +>14 Calculate the starting column positions and total ASCII table width + based on the input array of ASCII table TFORM values. The SPACE input + parameter defines how many blank spaces to leave between each column + (it is recommended to have one space between columns for better human +> readability). +- + FTGABC(tfields,tform,space, > rowlen,tbcol,status) +- +>15 Parse a template string and return a formatted 80-character string + suitable for appending to (or deleting from) a FITS header file. + This subroutine is useful for parsing lines from an ASCII template file + and reformatting them into legal FITS header records. The formatted + string may then be passed to the FTPREC, FTMCRD, or FTDKEY subroutines +> to append or modify a FITS header record. +- + FTGTHD(template, > card,hdtype,status) +- + The input TEMPLATE character string generally should contain 3 tokens: + (1) the KEYNAME, (2) the VALUE, and (3) the COMMENT string. The + TEMPLATE string must adhere to the following format: + +>- The KEYNAME token must begin in columns 1-8 and be a maximum of 8 + characters long. If the first 8 characters of the template line are + blank then the remainder of the line is considered to be a FITS comment + (with a blank keyword name). A legal FITS keyword name may only + contain the characters A-Z, 0-9, and '-' (minus sign) and + underscore. This subroutine will automatically convert any lowercase + characters to uppercase in the output string. If KEYNAME = 'COMMENT' + or 'HISTORY' then the remainder of the line is considered to be a FITS +> COMMENT or HISTORY record, respectively. + +>- The VALUE token must be separated from the KEYNAME token by one or more + spaces and/or an '=' character. The datatype of the VALUE token + (numeric, logical, or character string) is automatically determined + and the output CARD string is formatted accordingly. The value + token may be forced to be interpreted as a string (e.g. if it is a +> string of numeric digits) by enclosing it in single quotes. + +>- The COMMENT token is optional, but if present must be separated from + the VALUE token by at least one blank space. A leading '/' character + may be used to mark the beginning of the comment field, otherwise the + comment field begins with the first non-blank character following the +> value token. + +>- One exception to the above rules is that if the first non-blank + character in the template string is a minus sign ('-') followed + by a single token, or a single token followed by an equal sign, + then it is interpreted as the name of a keyword which is to be +> deleted from the FITS header. + +>- The second exception is that if the template string starts with + a minus sign and is followed by 2 tokens then the second token + is interpreted as the new name for the keyword specified by + first token. In this case the old keyword name (first token) + is returned in characters 1-8 of the returned CARD string, and + the new keyword name (the second token) is returned in characters + 41-48 of the returned CARD string. These old and new names + may then be passed to the FTMNAM subroutine which will change +> the keyword name. + + The HDTYPE output parameter indicates how the returned CARD string + should be interpreted: +- + hdtype interpretation + ------ ------------------------------------------------- + -2 Modify the name of the keyword given in CARD(1:8) + to the new name given in CARD(41:48) + + -1 CARD(1:8) contains the name of a keyword to be deleted + from the FITS header. + + 0 append the CARD string to the FITS header if the + keyword does not already exist, otherwise update + the value/comment if the keyword is already present + in the header. + + 1 simply append this keyword to the FITS header (CARD + is either a HISTORY or COMMENT keyword). + + 2 This is a FITS END record; it should not be written + to the FITS header because FITSIO automatically + appends the END record when the header is closed. +- + EXAMPLES: The following lines illustrate valid input template strings: +- + INTVAL 7 This is an integer keyword + RVAL 34.6 / This is a floating point keyword + EVAL=-12.45E-03 This is a floating point keyword in exponential notation + lval F This is a boolean keyword + This is a comment keyword with a blank keyword name + SVAL1 = 'Hello world' / this is a string keyword + SVAL2 '123.5' this is also a string keyword + sval3 123+ / this is also a string keyword with the value '123+ ' + # the following template line deletes the DATE keyword + - DATE + # the following template line modifies the NAME keyword to OBJECT + - NAME OBJECT +- +>16 Parse the input string containing a list of rows or row ranges, and + return integer arrays containing the first and last row in each + range. For example, if rowlist = "3-5, 6, 8-9" then it will + return numranges = 3, rangemin = 3, 6, 8 and rangemax = 5, 6, 9. + At most, 'maxranges' number of ranges will be returned. 'maxrows' + is the maximum number of rows in the table; any rows or ranges + larger than this will be ignored. The rows must be specified in + increasing order, and the ranges must not overlap. A minus sign + may be use to specify all the rows to the upper or lower bound, so + "50-" means all the rows from 50 to the end of the table, and "-" +> means all the rows in the table, from 1 - maxrows. +- + FTRWRG(rowlist, maxrows, maxranges, > + numranges, rangemin, rangemax, status) +- + + +*IX Summary of all FITSIO User-Interface Subroutines + + Error Status Routines page~\pageref{FTVERS} +- + FTVERS( > version) + FTGERR(status, > errtext) + FTGMSG( > errmsg) + FTRPRT (stream, > status) + FTPMSG(errmsg) + FTPMRK + FTCMSG + FTCMRK +- + FITS File Open and Close Subroutines: page~\pageref{FTOPEN} +- + FTOPEN(unit,filename,rwmode, > blocksize,status) + FTDKOPEN(unit,filename,rwmode, > blocksize,status) + FTNOPN(unit,filename,rwmode, > status) + FTDOPN(unit,filename,rwmode, > status) + FTTOPN(unit,filename,rwmode, > status) + FTIOPN(unit,filename,rwmode, > status) + FTREOPEN(unit, > newunit, status) + FTINIT(unit,filename,blocksize, > status) + FTDKINIT(unit,filename,blocksize, > status) + FTTPLT(unit, filename, tplfilename, > status) + FTFLUS(unit, > status) + FTCLOS(unit, > status) + FTDELT(unit, > status) + FTGIOU( > iounit, status) + FTFIOU(iounit, > status) + CFITS2Unit(fitsfile *ptr) (C routine) + CUnit2FITS(int unit) (C routine) + FTEXTN(filename, > nhdu, status) + FTFLNM(unit, > filename, status) + FTFLMD(unit, > iomode, status) + FFURLT(unit, > urltype, status) + FTIURL(filename, > filetype, infile, outfile, extspec, filter, + binspec, colspec, status) + FTRTNM(filename, > rootname, status) + FTEXIST(filename, > exist, status) +- + HDU-Level Operations: page~\pageref{FTMAHD} +- + FTMAHD(unit,nhdu, > hdutype,status) + FTMRHD(unit,nmove, > hdutype,status) + FTGHDN(unit, > nhdu) + FTMNHD(unit, hdutype, extname, extver, > status) + FTGHDT(unit, > hdutype, status) + FTTHDU(unit, > hdunum, status) + FTCRHD(unit, > status) + FTIIMG(unit,bitpix,naxis,naxes, > status) + FTITAB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) + FTIBIN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) + FTRSIM(unit,bitpix,naxis,naxes,status) + FTDHDU(unit, > hdutype,status) + FTCPFL(iunit,ounit,previous, current, following, > status) + FTCOPY(iunit,ounit,morekeys, > status) + FTCPHD(inunit, outunit, > status) + FTCPDT(iunit,ounit, > status) +- + Subroutines to specify or modify the structure of the CHDU: page~\pageref{FTRDEF} +- + FTRDEF(unit, > status) (DEPRECATED) + FTPDEF(unit,bitpix,naxis,naxes,pcount,gcount, > status) (DEPRECATED) + FTADEF(unit,rowlen,tfields,tbcol,tform,nrows > status) (DEPRECATED) + FTBDEF(unit,tfields,tform,varidat,nrows > status) (DEPRECATED) + FTDDEF(unit,bytlen, > status) (DEPRECATED) + FTPTHP(unit,theap, > status) +- + Header Space and Position Subroutines: page~\pageref{FTHDEF} +- + FTHDEF(unit,morekeys, > status) + FTGHSP(iunit, > keysexist,keysadd,status) + FTGHPS(iunit, > keysexist,key_no,status) +- + Read or Write Standard Header Subroutines: page~\pageref{FTPHPR} +- + FTPHPS(unit,bitpix,naxis,naxes, > status) + FTPHPR(unit,simple,bitpix,naxis,naxes,pcount,gcount,extend, > status) + FTGHPR(unit,maxdim, > simple,bitpix,naxis,naxes,pcount,gcount,extend, + status) + FTPHTB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) + FTGHTB(unit,maxdim, > rowlen,nrows,tfields,ttype,tbcol,tform,tunit, + extname,status) + FTPHBN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) + FTGHBN(unit,maxdim, > nrows,tfields,ttype,tform,tunit,extname,varidat, + status) +- + Write Keyword Subroutines: page~\pageref{FTPREC} +- + FTPREC(unit,card, > status) + FTPCOM(unit,comment, > status) + FTPHIS(unit,history, > status) + FTPDAT(unit, > status) + FTPKY[JLS](unit,keyword,keyval,comment, > status) + FTPKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTPKLS(unit,keyword,keyval,comment, > status) + FTPLSW(unit, > status) + FTPKYU(unit,keyword,comment, > status) + FTPKN[JLS](unit,keyroot,startno,no_keys,keyvals,comments, > status) + FTPKN[EDFG](unit,keyroot,startno,no_keys,keyvals,decimals,comments, > + status) + FTCPKYinunit, outunit, innum, outnum, keyroot, > status) + FTPKYT(unit,keyword,intval,dblval,comment, > status) + FTPKTP(unit, filename, > status) + FTPUNT(unit,keyword,units, > status) +- + Insert Keyword Subroutines: page~\pageref{FTIREC} +- + FTIREC(unit,key_no,card, > status) + FTIKY[JLS](unit,keyword,keyval,comment, > status) + FTIKLS(unit,keyword,keyval,comment, > status) + FTIKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTIKYU(unit,keyword,comment, > status) +- + Read Keyword Subroutines: page~\pageref{FTGREC} +- + FTGREC(unit,key_no, > card,status) + FTGKYN(unit,key_no, > keyword,value,comment,status) + FTGCRD(unit,keyword, > card,status) + FTGNXK(unit,inclist,ninc,exclist,nexc, > card,status) + FTGKEY(unit,keyword, > value,comment,status) + FTGKY[EDJLS](unit,keyword, > keyval,comment,status) + FTGKN[EDJLS](unit,keyroot,startno,max_keys, > keyvals,nfound,status) + FTGKYT(unit,keyword, > intval,dblval,comment,status) + FTGUNT(unit,keyword, > units,status) +- + Modify Keyword Subroutines: page~\pageref{FTMREC} +- + FTMREC(unit,key_no,card, > status) + FTMCRD(unit,keyword,card, > status) + FTMNAM(unit,oldkey,keyword, > status) + FTMCOM(unit,keyword,comment, > status) + FTMKY[JLS](unit,keyword,keyval,comment, > status) + FTMKLS(unit,keyword,keyval,comment, > status) + FTMKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTMKYU(unit,keyword,comment, > status) +- + Update Keyword Subroutines: page~\pageref{FTUCRD} +- + FTUCRD(unit,keyword,card, > status) + FTUKY[JLS](unit,keyword,keyval,comment, > status) + FTUKLS(unit,keyword,keyval,comment, > status) + FTUKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTUKYU(unit,keyword,comment, > status) +- + Delete Keyword Subroutines: page~\pageref{FTDREC} +- + FTDREC(unit,key_no, > status) + FTDKEY(unit,keyword, > status) +- + Define Data Scaling Parameters and Undefined Pixel Flags: page~\pageref{FTPSCL} +- + FTPSCL(unit,bscale,bzero, > status) + FTTSCL(unit,colnum,tscal,tzero, > status) + FTPNUL(unit,blank, > status) + FTSNUL(unit,colnum,snull > status) + FTTNUL(unit,colnum,tnull > status) +- + FITS Primary Array or IMAGE Extension I/O Subroutines: page~\pageref{FTPPR} +- + FTGIDT(unit, > bitpix,status) + FTGIET(unit, > bitpix,status) + FTGIDM(unit, > naxis,status) + FTGISZ(unit, maxdim, > naxes,status) + FTGIPR(unit, maxdim, > bitpix,naxis,naxes,status) + FTPPR[BIJED](unit,group,fpixel,nelements,values, > status) + FTPPN[BIJED](unit,group,fpixel,nelements,values,nullval > status) + FTPPRU(unit,group,fpixel,nelements, > status) + FTGPV[BIJED](unit,group,fpixel,nelements,nullval, > values,anyf,status) + FTGPF[BIJED](unit,group,fpixel,nelements, > values,flagvals,anyf,status) + FTPGP[BIJED](unit,group,fparm,nparm,values, > status) + FTGGP[BIJED](unit,group,fparm,nparm, > values,status) + FTP2D[BIJED](unit,group,dim1,naxis1,naxis2,image, > status) + FTP3D[BIJED](unit,group,dim1,dim2,naxis1,naxis2,naxis3,cube, > status) + FTG2D[BIJED](unit,group,nullval,dim1,naxis1,naxis2, > image,anyf,status) + FTG3D[BIJED](unit,group,nullval,dim1,dim2,naxis1,naxis2,naxis3, > + cube,anyf,status) + FTPSS[BIJED](unit,group,naxis,naxes,fpixels,lpixels,array, > status) + FTGSV[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) + FTGSF[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) +- + Table Column Information Subroutines: page~\pageref{FTGCNO} +- + FTGNRW(unit, > nrows, status) + FTGNCL(unit, > ncols, status) + FTGCNO(unit,casesen,coltemplate, > colnum,status) + FTGCNN(unit,casesen,coltemplate, > colnam,colnum,status) + FTGTCL(unit,colnum, > datacode,repeat,width,status) + FTEQTY(unit,colnum, > datacode,repeat,width,status) + FTGCDW(unit,colnum, > dispwidth,status) + FTGACL(unit,colnum, > + ttype,tbcol,tunit,tform,tscal,tzero,snull,tdisp,status) + FTGBCL(unit,colnum, > + ttype,tunit,datatype,repeat,tscal,tzero,tnull,tdisp,status) + FTPTDM(unit,colnum,naxis,naxes, > status) + FTGTDM(unit,colnum,maxdim, > naxis,naxes,status) + FTDTDM(unit,tdimstr,colnum,maxdim, > naxis,naxes, status) + FFGRSZ(unit, > nrows,status) +- + Low-Level Table Access Subroutines: page~\pageref{FTGTBS} +- + FTGTBS(unit,frow,startchar,nchars, > string,status) + FTPTBS(unit,frow,startchar,nchars,string, > status) + FTGTBB(unit,frow,startchar,nchars, > array,status) + FTPTBB(unit,frow,startchar,nchars,array, > status) +- + Edit Rows or Columns page~\pageref{FTIROW} +- + FTIROW(unit,frow,nrows, > status) + FTDROW(unit,frow,nrows, > status) + FTDRRG(unit,rowrange, > status) + FTDRWS(unit,rowlist,nrows, > status) + FTICOL(unit,colnum,ttype,tform, > status) + FTICLS(unit,colnum,ncols,ttype,tform, > status) + FTMVEC(unit,colnum,newveclen, > status) + FTDCOL(unit,colnum, > status) + FTCPCL(inunit,outunit,incolnum,outcolnum,createcol, > status); +- + Read and Write Column Data Routines page~\pageref{FTPCLS} +- + FTPCL[SLBIJEDCM](unit,colnum,frow,felem,nelements,values, > status) + FTPCN[BIJED](unit,colnum,frow,felem,nelements,values,nullval > status) + FTPCLX(unit,colnum,frow,fbit,nbit,lray, > status) + FTPCLU(unit,colnum,frow,felem,nelements, > status) + FTGCL(unit,colnum,frow,felem,nelements, > values,status) + FTGCV[SBIJEDCM](unit,colnum,frow,felem,nelements,nullval, > + values,anyf,status) + FTGCF[SLBIJEDCM](unit,colnum,frow,felem,nelements, > + values,flagvals,anyf,status) + FTGSV[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) + FTGSF[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) + FTGCX(unit,colnum,frow,fbit,nbit, > lray,status) + FTGCX[IJD](unit,colnum,frow,nrows,fbit,nbit, > array,status) + FTGDES(unit,colnum,rownum, > nelements,offset,status) + FTPDES(unit,colnum,rownum,nelements,offset, > status) +- + Row Selection and Calculator Routines: page~\pageref{FTFROW} +- + FTFROW(unit,expr,firstrow, nrows, > n_good_rows, row_status, status) + FTFFRW(unit, expr, > rownum, status) + FTSROW(inunit, outunit, expr, > status ) + FTCROW(unit,datatype,expr,firstrow,nelements,nulval, > + array,anynul,status) + FTCALC(inunit, expr, outunit, parName, parInfo, > status) + FTCALC_RNG(inunit, expr, outunit, parName, parInfo, + nranges, firstrow, lastrow, > status) + FTTEXP(unit, expr, > datatype, nelem, naxis, naxes, status) +- + Celestial Coordinate System Subroutines: page~\pageref{FTGICS} +- + FTGICS(unit, > xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) + FTGTCS(unit,xcol,ycol, > + xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) + FTWLDP(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpos,ypos,status) + FTXYPX(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpix,ypix,status) +- + File Checksum Subroutines: page~\pageref{FTPCKS} +- + FTPCKS(unit, > status) + FTUCKS(unit, > status) + FTVCKS(unit, > dataok,hduok,status) + FTGCKS(unit, > datasum,hdusum,status) + FTESUM(sum,complement, > checksum) + FTDSUM(checksum,complement, > sum) + +- + Time and Date Utility Subroutines: page~\pageref{FTGSDT} +- + FTGSDT( > day, month, year, status ) + FTGSTM(> datestr, timeref, status) + FTDT2S( year, month, day, > datestr, status) + FTTM2S( year, month, day, hour, minute, second, decimals, + > datestr, status) + FTS2DT(datestr, > year, month, day, status) + FTS2TM(datestr, > year, month, day, hour, minute, second, status) +- + General Utility Subroutines: page~\pageref{FTGHAD} +- + FTGHAD(unit, > curaddr,nextaddr) + FTUPCH(string) + FTCMPS(str_template,string,casesen, > match,exact) + FTTKEY(keyword, > status) + FTTREC(card, > status) + FTNCHK(unit, > status) + FTGKNM(unit, > keyword, keylength, status) + FTPSVC(card, > value,comment,status) + FTKEYN(keyroot,seq_no, > keyword,status) + FTNKEY(seq_no,keyroot, > keyword,status) + FTDTYP(value, > dtype,status) + class = FTGKCL(card) + FTASFM(tform, > datacode,width,decimals,status) + FTBNFM(tform, > datacode,repeat,width,status) + FTGABC(tfields,tform,space, > rowlen,tbcol,status) + FTGTHD(template, > card,hdtype,status) + FTRWRG(rowlist, maxrows, maxranges, > numranges, rangemin, + rangemax, status) +- + +*X. Parameter Definitions +- +anyf - (logical) set to TRUE if any of the returned data values are undefined +array - (any datatype except character) array of bytes to be read or written. +bitpix - (integer) bits per pixel: 8, 16, 32, -32, or -64 +blank - (integer) value used for undefined pixels in integer primary array +blocksize - (integer) 2880-byte logical record blocking factor + (if 0 < blocksize < 11) or the actual block size in bytes + (if 10 < blocksize < 28800). As of version 3.3 of FITSIO, + blocksizes greater than 2880 are no longer supported. +bscale - (double precision) scaling factor for the primary array +bytlen - (integer) length of the data unit, in bytes +bzero - (double precision) zero point for primary array scaling +card - (character*80) header record to be read or written +casesen - (logical) will string matching be case sensitive? +checksum - (character*16) encoded checksum string +colname - (character) ASCII name of the column +colnum - (integer) number of the column (first column = 1) +coltemplate - (character) template string to be matched to column names +comment - (character) the keyword comment field +comments - (character array) keyword comment fields +compid - (integer) the type of computer that the program is running on +complement - (logical) should the checksum be complemented? +coordtype - (character) type of coordinate projection (-SIN, -TAN, -ARC, + -NCP, -GLS, -MER, or -AIT) +cube - 3D data cube of the appropriate datatype +curaddr - (integer) starting address (in bytes) of the CHDU +datacode - (integer) symbolic code of the binary table column datatype +dataok - (integer) was the data unit verification successful (=1) or + not (= -1). Equals zero if the DATASUM keyword is not present. +datasum - (double precision) 32-bit 1's complement checksum for the data unit +datatype - (character) datatype (format) of the binary table column +datestr - (string) FITS date/time string: 'YYYY-MM-DDThh:mm:ss.ddd', + 'YYYY-MM-dd', or 'dd/mm/yy' +day - (integer) current day of the month +dblval - (double precision) fractional part of the keyword value +decimals - (integer) number of decimal places to be displayed +dim1 - (integer) actual size of the first dimension of the image or cube array +dim2 - (integer) actual size of the second dimension of the cube array +dispwidth - (integer) - the display width (length of string) for a column +dtype - (character) datatype of the keyword ('C', 'L', 'I', or 'F') + C = character string + L = logical + I = integer + F = floating point number +errmsg - (character*80) oldest error message on the internal stack +errtext - (character*30) descriptive error message corresponding to error number +casesen - (logical) true if column name matching is case sensitive +exact - (logical) do the strings match exactly, or were wildcards used? +exclist (character array) list of names to be excluded from search +exists - flag indicating whether the file or compressed file exists on disk +extend - (logical) true if there may be extensions following the primary data +extname - (character) value of the EXTNAME keyword (if not blank) +fbit - (integer) first bit in the field to be read or written +felem - (integer) first pixel of the element vector (ignored for ASCII tables) +filename - (character) name of the FITS file +flagvals - (logical array) True if corresponding data element is undefined +fparm - (integer) sequence number of the first group parameter to read or write +fpixel - (integer) the first pixel position +fpixels - (integer array) the first included pixel in each dimension +frow - (integer) beginning row number (first row of table = 1) +gcount - (integer) value of the GCOUNT keyword (usually = 1) +group - (integer) sequence number of the data group (=0 for non-grouped data) +hdtype - (integer) header record type: -1=delete; 0=append or replace; + 1=append; 2=this is the END keyword +hduok - (integer) was the HDU verification successful (=1) or + not (= -1). Equals zero if the CHECKSUM keyword is not present. +hdusum - (double precision) 32 bit 1's complement checksum for the entire CHDU +hdutype - (integer) type of HDU: 0 = primary array or IMAGE, 1 = ASCII table, + 2 = binary table, -1 = unknown +history - (character) the HISTORY keyword comment string +hour - (integer) hour from 0 - 23 +image - 2D image of the appropriate datatype +inclist (character array) list of names to be included in search +incs - (integer array) sampling interval for pixels in each FITS dimension +intval - (integer) integer part of the keyword value +iounit - (integer) value of an unused I/O unit number +iunit - (integer) logical unit number associated with the input FITS file, 1-199 +key_no - (integer) sequence number (starting with 1) of the keyword record +keylength - (integer) length of the keyword name +keyroot - (character) root string for the keyword name +keysadd -(integer) number of new keyword records which can fit in the CHU +keysexist - (integer) number of existing keyword records in the CHU +keyval - value of the keyword in the appropriate datatype +keyvals - (array) value of the keywords in the appropriate datatype +keyword - (character*8) name of a keyword +lray - (logical array) array of logical values corresponding to the bit array +lpixels - (integer array) the last included pixel in each dimension +match - (logical) do the 2 strings match? +maxdim - (integer) dimensioned size of the NAXES, TTYPE, TFORM or TUNIT arrays +max_keys - (integer) maximum number of keywords to search for +minute - (integer) minute of an hour (0 - 59) +month - (integer) current month of the year (1 - 12) +morekeys - (integer) will leave space in the header for this many more keywords +naxes - (integer array) size of each dimension in the FITS array +naxis - (integer) number of dimensions in the FITS array +naxis1 - (integer) length of the X/first axis of the FITS array +naxis2 - (integer) length of the Y/second axis of the FITS array +naxis3 - (integer) length of the Z/third axis of the FITS array +nbit - (integer) number of bits in the field to read or write +nchars - (integer) number of characters to read and return +ncols - (integer) number of columns +nelements - (integer) number of data elements to read or write +nexc (integer) number of names in the exclusion list (may = 0) +nhdu - (integer) absolute number of the HDU (1st HDU = 1) +ninc (integer) number of names in the inclusion list +nmove - (integer) number of HDUs to move (+ or -), relative to current position +nfound - (integer) number of keywords found (highest keyword number) +no_keys - (integer) number of keywords to write in the sequence +nparm - (integer) number of group parameters to read or write +nrows - (integer) number of rows in the table +nullval - value to represent undefined pixels, of the appropriate datatype +nextaddr - (integer) starting address (in bytes) of the HDU following the CHDU +offset - (integer) byte offset in the heap to the first element of the array +oldkey - (character) old name of keyword to be modified +ounit - (integer) logical unit number associated with the output FITS file 1-199 +pcount - (integer) value of the PCOUNT keyword (usually = 0) +repeat - (integer) length of element vector (e.g. 12J); ignored for ASCII table +rot - (double precision) celestial coordinate rotation angle (degrees) +rowlen - (integer) length of a table row, in characters or bytes +rowlist - (integer array) list of row numbers to be deleted in increasing order +rownum - (integer) number of the row (first row = 1) +rowrange- (string) list of rows or row ranges to be deleted +rwmode - (integer) file access mode: 0 = readonly, 1 = readwrite +second (double)- second within minute (0 - 60.9999999999) (leap second!) +seq_no - (integer) the sequence number to append to the keyword root name +simple - (logical) does the FITS file conform to all the FITS standards +snull - (character) value used to represent undefined values in ASCII table +space - (integer) number of blank spaces to leave between ASCII table columns +startchar - (integer) first character in the row to be read +startno - (integer) value of the first keyword sequence number (usually 1) +status - (integer) returned error status code (0 = OK) +str_template (character) template string to be matched to reference string +stream - (character) output stream for the report: either 'STDOUT' or 'STDERR' +string - (character) character string +sum - (double precision) 32 bit unsigned checksum value +tbcol - (integer array) column number of the first character in the field(s) +tdisp - (character) Fortran type display format for the table column +template-(character) template string for a FITS header record +tfields - (integer) number of fields (columns) in the table +tform - (character array) format of the column(s); allowed values are: + For ASCII tables: Iw, Aw, Fww.dd, Eww.dd, or Dww.dd + For binary tables: rL, rX, rB, rI, rJ, rA, rAw, rE, rD, rC, rM + where 'w'=width of the field, 'd'=no. of decimals, 'r'=repeat count + Note that the 'rAw' form is non-standard extension to the + TFORM keyword syntax that is not specifically defined in the + Binary Tables definition document. +theap - (integer) zero indexed byte offset of starting address of the heap + relative to the beginning of the binary table data +tnull - (integer) value used to represent undefined values in binary table +ttype - (character array) label for table column(s) +tscal - (double precision) scaling factor for table column +tunit - (character array) physical unit for table column(s) +tzero - (double precision) scaling zero point for table column +unit - (integer) logical unit number associated with the FITS file (1-199) +units - (character) the keyword units string (e.g., 'km/s') +value - (character) the keyword value string +values - array of data values of the appropriate datatype +varidat - (integer) size in bytes of the 'variable length data area' + following the binary table data (usually = 0) +version - (real) current revision number of the library +width - (integer) width of the character string field +xcol - (integer) number of the column containing the X coordinate values +xinc - (double precision) X axis coordinate increment at reference pixel (deg) +xpix - (double precision) X axis pixel location +xpos - (double precision) X axis celestial coordinate (usually RA) (deg) +xrpix - (double precision) X axis reference pixel array location +xrval - (double precision) X axis coordinate value at the reference pixel (deg) +ycol - (integer) number of the column containing the X coordinate values +year - (integer) last 2 digits of the year (00 - 99) +yinc - (double precision) Y axis coordinate increment at reference pixel (deg) +ypix - (double precision) y axis pixel location +ypos - (double precision) y axis celestial coordinate (usually DEC) (deg) +yrpix - (double precision) Y axis reference pixel array location +yrval - (double precision) Y axis coordinate value at the reference pixel (deg) +- + +*XI. FITSIO Error Status Codes +- +Status codes in the range -99 to -999 and 1 to 999 are reserved for future +FITSIO use. + + 0 OK, no error +101 input and output files are the same +103 too many FITS files open at once; all internal buffers full +104 error opening existing file +105 error creating new FITS file; (does a file with this name already exist?) +106 error writing record to FITS file +107 end-of-file encountered while reading record from FITS file +108 error reading record from file +110 error closing FITS file +111 internal array dimensions exceeded +112 Cannot modify file with readonly access +113 Could not allocate memory +114 illegal logical unit number; must be between 1 - 199, inclusive +115 NULL input pointer to routine +116 error seeking position in file + +121 invalid URL prefix on file name +122 tried to register too many IO drivers +123 driver initialization failed +124 matching driver is not registered +125 failed to parse input file URL +126 parse error in range list + +151 bad argument in shared memory driver +152 null pointer passed as an argument +153 no more free shared memory handles +154 shared memory driver is not initialized +155 IPC error returned by a system call +156 no memory in shared memory driver +157 resource deadlock would occur +158 attempt to open/create lock file failed +159 shared memory block cannot be resized at the moment + + +201 header not empty; can't write required keywords +202 specified keyword name was not found in the header +203 specified header record number is out of bounds +204 keyword value field is blank +205 keyword value string is missing the closing quote character +207 illegal character in keyword name or header record +208 keyword does not have expected name. Keyword out of sequence? +209 keyword does not have expected integer value +210 could not find the required END header keyword +211 illegal BITPIX keyword value +212 illegal NAXIS keyword value +213 illegal NAXISn keyword value: must be 0 or positive integer +214 illegal PCOUNT keyword value +215 illegal GCOUNT keyword value +216 illegal TFIELDS keyword value +217 negative ASCII or binary table width value (NAXIS1) +218 negative number of rows in ASCII or binary table (NAXIS2) +219 column name (TTYPE keyword) not found +220 illegal SIMPLE keyword value +221 could not find the required SIMPLE header keyword +222 could not find the required BITPIX header keyword +223 could not find the required NAXIS header keyword +224 could not find all the required NAXISn keywords in the header +225 could not find the required XTENSION header keyword +226 the CHDU is not an ASCII table extension +227 the CHDU is not a binary table extension +228 could not find the required PCOUNT header keyword +229 could not find the required GCOUNT header keyword +230 could not find the required TFIELDS header keyword +231 could not find all the required TBCOLn keywords in the header +232 could not find all the required TFORMn keywords in the header +233 the CHDU is not an IMAGE extension +234 illegal TBCOL keyword value; out of range +235 this operation only allowed for ASCII or BINARY table extension +236 column is too wide to fit within the specified width of the ASCII table +237 the specified column name template matched more than one column name +241 binary table row width is not equal to the sum of the field widths +251 unrecognizable type of FITS extension +252 unrecognizable FITS record +253 END keyword contains non-blank characters in columns 9-80 +254 Header fill area contains non-blank characters +255 Data fill area contains non-blank on non-zero values +261 unable to parse the TFORM keyword value string +262 unrecognizable TFORM datatype code +263 illegal TDIMn keyword value + +301 illegal HDU number; less than 1 or greater than internal buffer size +302 column number out of range (1 - 999) +304 attempt to move to negative file record number +306 attempted to read or write a negative number of bytes in the FITS file +307 illegal starting row number for table read or write operation +308 illegal starting element number for table read or write operation +309 attempted to read or write character string in non-character table column +310 attempted to read or write logical value in non-logical table column +311 illegal ASCII table TFORM format code for attempted operation +312 illegal binary table TFORM format code for attempted operation +314 value for undefined pixels has not been defined +317 attempted to read or write descriptor in a non-descriptor field +320 number of array dimensions out of range +321 first pixel number is greater than the last pixel number +322 attempt to set BSCALE or TSCALn scaling parameter = 0 +323 illegal axis length less than 1 + +340 NOT_GROUP_TABLE 340 Grouping function error +341 HDU_ALREADY_MEMBER +342 MEMBER_NOT_FOUND +343 GROUP_NOT_FOUND +344 BAD_GROUP_ID +345 TOO_MANY_HDUS_TRACKED +346 HDU_ALREADY_TRACKED +347 BAD_OPTION +348 IDENTICAL_POINTERS +349 BAD_GROUP_ATTACH +350 BAD_GROUP_DETACH + +360 NGP_NO_MEMORY malloc failed +361 NGP_READ_ERR read error from file +362 NGP_NUL_PTR null pointer passed as an argument. + Passing null pointer as a name of + template file raises this error +363 NGP_EMPTY_CURLINE line read seems to be empty (used + internally) +364 NGP_UNREAD_QUEUE_FULL cannot unread more then 1 line (or single + line twice) +365 NGP_INC_NESTING too deep include file nesting (infinite + loop, template includes itself ?) +366 NGP_ERR_FOPEN fopen() failed, cannot open template file +367 NGP_EOF end of file encountered and not expected +368 NGP_BAD_ARG bad arguments passed. Usually means + internal parser error. Should not happen +369 NGP_TOKEN_NOT_EXPECT token not expected here + +401 error attempting to convert an integer to a formatted character string +402 error attempting to convert a real value to a formatted character string +403 cannot convert a quoted string keyword to an integer +404 attempted to read a non-logical keyword value as a logical value +405 cannot convert a quoted string keyword to a real value +406 cannot convert a quoted string keyword to a double precision value +407 error attempting to read character string as an integer +408 error attempting to read character string as a real value +409 error attempting to read character string as a double precision value +410 bad keyword datatype code +411 illegal number of decimal places while formatting floating point value +412 numerical overflow during implicit datatype conversion +413 error compressing image +414 error uncompressing image +420 error in date or time conversion + +431 syntax error in parser expression +432 expression did not evaluate to desired type +433 vector result too large to return in array +434 data parser failed not sent an out column +435 bad data encounter while parsing column +436 parse error: output file not of proper type + +501 celestial angle too large for projection +502 bad celestial coordinate or pixel value +503 error in celestial coordinate calculation +504 unsupported type of celestial projection +505 required celestial coordinate keywords not found +506 approximate wcs keyword values were returned +- +\end{document} diff --git a/pkg/tbtables/cfitsio/fitsio.h b/pkg/tbtables/cfitsio/fitsio.h new file mode 100644 index 00000000..f38f8ad6 --- /dev/null +++ b/pkg/tbtables/cfitsio/fitsio.h @@ -0,0 +1,1565 @@ +/* Version Info: This file is distributed with version 2.510 of CFITSIO */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ +/* + +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER." + +*/ + +#ifndef _FITSIO_H +#define _FITSIO_H + +#include + +#if defined(linux) || defined(__APPLE__) +# include /* apparently needed on debian linux systems */ +#endif /* to define off_t */ + +#include /* apparently needed to define size_t with gcc 2.8.1 */ +#include /* needed for LLONG_MAX and INT64_MAX definitions */ + +/* Define the datatype for variables which store file offset values. */ +/* The new 'off_t' datatype should be used for this purpose, but some */ +/* older compilers do not recognize this type, in which case we use 'long' */ +/* instead. Note that _OFF_T is defined (or not) in stdio.h depending */ +/* on whether _LARGEFILE_SOURCE is defined in sys/feature_tests.h */ +/* (at least on Solaris platforms using cc) */ + +/* Debian systems require the 2nd test, below, */ +/* i.e, "(defined(linux) && defined(__off_t_defined))" */ +#if defined(_OFF_T) || (defined(linux) && defined(__off_t_defined)) || defined(_MIPS_SZLONG) || defined(__APPLE__) || defined(_AIX) +# define OFF_T off_t +#else +# define OFF_T long +#endif + +/* typedef the 'LONGLONG' data type to the intrinsice 8-byte integer type */ + +#if defined(HAVE_LONGLONG) || defined(__APPLE__) + typedef long long LONGLONG; +# ifndef HAVE_LONGLONG +# define HAVE_LONGLONG 1 +# endif +#elif defined(_MSC_VER) /* Windows PCs; Visual C++, but not Borland C++ */ + typedef __int64 LONGLONG; +# ifndef HAVE_LONGLONG +# define HAVE_LONGLONG 1 +# endif +#else + typedef long LONGLONG; /* intrinsic 8-byte integer not supported */ +#endif + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +#include "longnam.h" +#endif + +/* global variables */ + +#define FLEN_FILENAME 1025 /* max length of a filename */ +#define FLEN_KEYWORD 72 /* max length of a keyword (HIERARCH convention) */ +#define FLEN_CARD 81 /* length of a FITS header card */ +#define FLEN_VALUE 71 /* max length of a keyword value string */ +#define FLEN_COMMENT 73 /* max length of a keyword comment string */ +#define FLEN_ERRMSG 81 /* max length of a FITSIO error message */ +#define FLEN_STATUS 31 /* max length of a FITSIO status text string */ + +#define TBIT 1 /* codes for FITS table data types */ +#define TBYTE 11 +#define TSBYTE 12 +#define TLOGICAL 14 +#define TSTRING 16 +#define TUSHORT 20 +#define TSHORT 21 +#define TUINT 30 +#define TINT 31 +#define TULONG 40 +#define TLONG 41 +#define TINT32BIT 41 /* used when returning datatype of a column */ +#define TFLOAT 42 +#define TLONGLONG 81 +#define TDOUBLE 82 +#define TCOMPLEX 83 +#define TDBLCOMPLEX 163 + +#define TYP_STRUC_KEY 10 +#define TYP_CMPRS_KEY 20 +#define TYP_SCAL_KEY 30 +#define TYP_NULL_KEY 40 +#define TYP_DIM_KEY 50 +#define TYP_RANG_KEY 60 +#define TYP_UNIT_KEY 70 +#define TYP_DISP_KEY 80 +#define TYP_HDUID_KEY 90 +#define TYP_CKSUM_KEY 100 +#define TYP_WCS_KEY 110 +#define TYP_REFSYS_KEY 120 +#define TYP_COMM_KEY 130 +#define TYP_CONT_KEY 140 +#define TYP_USER_KEY 150 + + +#define INT32BIT int /* 32-bit integer datatype. Currently this */ + /* datatype is an 'int' on all useful platforms */ + /* however, it is possible that that are cases */ + /* where 'int' is a 2-byte integer, in which case */ + /* INT32BIT would need to be defined as 'long'. */ + +#define BYTE_IMG 8 /* BITPIX code values for FITS image types */ +#define SHORT_IMG 16 +#define LONG_IMG 32 +#define LONGLONG_IMG 64 +#define FLOAT_IMG -32 +#define DOUBLE_IMG -64 + /* The following 2 codes are not true FITS */ + /* datatypes; these codes are only used internally */ + /* within cfitsio to make it easier for users */ + /* to deal with unsigned integers. */ +#define SBYTE_IMG 10 +#define USHORT_IMG 20 +#define ULONG_IMG 40 + +#define IMAGE_HDU 0 /* Primary Array or IMAGE HDU */ +#define ASCII_TBL 1 /* ASCII table HDU */ +#define BINARY_TBL 2 /* Binary table HDU */ +#define ANY_HDU -1 /* matches any HDU type */ + +#define READONLY 0 /* options when opening a file */ +#define READWRITE 1 + +/* adopt a hopefully obscure number to use as a null value flag */ +/* could be problems if the FITS files contain data with these values */ +#define FLOATNULLVALUE -9.11912E-36F +#define DOUBLENULLVALUE -9.1191291391491E-36 + +/* Image compression algorithm types */ +#define MAX_COMPRESS_DIM 6 +#define RICE_1 11 +#define GZIP_1 21 +#define PLIO_1 31 +#define HCOMPRESS_1 41 + +#ifndef TRUE +#define TRUE 1 +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + +#define CASESEN 1 /* do case-sensitive string match */ +#define CASEINSEN 0 /* do case-insensitive string match */ + +#define GT_ID_ALL_URI 0 /* hierarchical grouping parameters */ +#define GT_ID_REF 1 +#define GT_ID_POS 2 +#define GT_ID_ALL 3 +#define GT_ID_REF_URI 11 +#define GT_ID_POS_URI 12 + +#define OPT_RM_GPT 0 +#define OPT_RM_ENTRY 1 +#define OPT_RM_MBR 2 +#define OPT_RM_ALL 3 + +#define OPT_GCP_GPT 0 +#define OPT_GCP_MBR 1 +#define OPT_GCP_ALL 2 + +#define OPT_MCP_ADD 0 +#define OPT_MCP_NADD 1 +#define OPT_MCP_REPL 2 +#define OPT_MCP_MOV 3 + +#define OPT_MRG_COPY 0 +#define OPT_MRG_MOV 1 + +#define OPT_CMT_MBR 1 +#define OPT_CMT_MBR_DEL 11 + +typedef struct /* structure used to store table column information */ +{ + char ttype[70]; /* column name = FITS TTYPEn keyword; */ + long tbcol; /* offset in row to first byte of each column */ + int tdatatype; /* datatype code of each column */ + OFF_T trepeat; /* repeat count of column; number of elements */ + double tscale; /* FITS TSCALn linear scaling factor */ + double tzero; /* FITS TZEROn linear scaling zero point */ + long tnull; /* FITS null value for int image or binary table cols */ + char strnull[20]; /* FITS null value string for ASCII table columns */ + char tform[10]; /* FITS tform keyword value */ + long twidth; /* width of each ASCII table column */ +}tcolumn; + +#define VALIDSTRUC 555 /* magic value used to identify if structure is valid */ + +typedef struct /* structure used to store basic FITS file information */ +{ + int filehandle; /* handle returned by the file open function */ + int driver; /* defines which set of I/O drivers should be used */ + int open_count; /* number of opened 'fitsfiles' using this structure */ + char *filename; /* file name */ + int validcode; /* magic value used to verify that structure is valid */ + OFF_T filesize; /* current size of the physical disk file in bytes */ + OFF_T logfilesize; /* logical size of file, including unflushed buffers */ + int lasthdu; /* is this the last HDU in the file? 0 = no, else yes */ + OFF_T bytepos; /* current logical I/O pointer position in file */ + OFF_T io_pos; /* current I/O pointer position in the physical file */ + int curbuf; /* number of I/O buffer currently in use */ + int curhdu; /* current HDU number; 0 = primary array */ + int hdutype; /* 0 = primary array, 1 = ASCII table, 2 = binary table */ + int writemode; /* 0 = readonly, 1 = readwrite */ + int maxhdu; /* highest numbered HDU known to exist in the file */ + int MAXHDU; /* dynamically allocated dimension of headstart array */ + OFF_T *headstart; /* byte offset in file to start of each HDU */ + OFF_T headend; /* byte offest in file to end of the current HDU header */ + OFF_T nextkey; /* byte offset in file to beginning of next keyword */ + OFF_T datastart;/* byte offset in file to start of the current data unit */ + int tfield; /* number of fields in the table (primary array has 2 */ + long origrows; /* original number of rows (value of NAXIS2 keyword) */ + long numrows; /* number of rows in the table (dynamically updated) */ + OFF_T rowlength; /* length of a table row or image size (bytes) */ + tcolumn *tableptr; /* pointer to the table structure */ + OFF_T heapstart; /* heap start byte relative to start of data unit */ + long heapsize; /* size of the heap, in bytes */ + + /* the following elements are related to compressed images */ + int request_compress_type; /* requested image compression algorithm */ + long request_tilesize[MAX_COMPRESS_DIM]; /* requested tiling size */ + int request_rice_nbits; /* requested noise bit parameter value */ + + int compressimg; /* 1 if HDU contains a compressed image, else 0 */ + char zcmptype[12]; /* compression type string */ + int compress_type; /* type of compression algorithm */ + int zbitpix; /* FITS data type of image (BITPIX) */ + int zndim; /* dimension of image */ + long znaxis[MAX_COMPRESS_DIM]; /* length of each axis */ + long tilesize[MAX_COMPRESS_DIM]; /* size of compression tiles */ + long maxtilelen; /* max number of pixels in each image tile */ + long maxelem; /* maximum length of variable length arrays */ + + int cn_compressed; /* column number for COMPRESSED_DATA column */ + int cn_uncompressed; /* column number for UNCOMPRESSED_DATA column */ + int cn_zscale; /* column number for ZSCALE column */ + int cn_zzero; /* column number for ZZERO column */ + int cn_zblank; /* column number for the ZBLANK column */ + + double zscale; /* scaling value, if same for all tiles */ + double zzero; /* zero pt, if same for all tiles */ + double cn_bscale; /* value of the BSCALE keyword in header */ + double cn_bzero; /* value of the BZERO keyword in header */ + int zblank; /* value for null pixels, if not a column */ + + int rice_blocksize; /* first compression parameter */ + int rice_nbits; /* second compression parameter */ +} FITSfile; + +typedef struct /* structure used to store basic HDU information */ +{ + int HDUposition; /* HDU position in file; 0 = first HDU */ + FITSfile *Fptr; /* pointer to FITS file structure */ +}fitsfile; + +typedef struct /* structure for the iterator function column information */ +{ + /* elements required as input to fits_iterate_data: */ + + fitsfile *fptr; /* pointer to the HDU containing the column */ + int colnum; /* column number in the table (use name if < 1) */ + char colname[70]; /* name (= TTYPEn value) of the column (optional) */ + int datatype; /* output datatype (converted if necessary */ + int iotype; /* = InputCol, InputOutputCol, or OutputCol */ + + /* output elements that may be useful for the work function: */ + + void *array; /* pointer to the array (and the null value) */ + long repeat; /* binary table vector repeat value */ + long tlmin; /* legal minimum data value */ + long tlmax; /* legal maximum data value */ + char tunit[70]; /* physical unit string */ + char tdisp[70]; /* suggested display format */ + +} iteratorCol; + +#define InputCol 0 /* flag for input only iterator column */ +#define InputOutputCol 1 /* flag for input and output iterator column */ +#define OutputCol 2 /* flag for output only iterator column */ + +/* error status codes */ + +#define CREATE_DISK_FILE -106 /* create disk file, without extended filename syntax */ +#define OPEN_DISK_FILE -105 /* open disk file, without extended filename syntax */ +#define SKIP_TABLE -104 /* move to 1st image when opening file */ +#define SKIP_IMAGE -103 /* move to 1st table when opening file */ +#define SKIP_NULL_PRIMARY -102 /* skip null primary array when opening file */ +#define USE_MEM_BUFF -101 /* use memory buffer when opening file */ +#define OVERFLOW_ERR -11 /* overflow during datatype conversion */ +#define PREPEND_PRIMARY -9 /* used in ffiimg to insert new primary array */ +#define SAME_FILE 101 /* input and output files are the same */ +#define TOO_MANY_FILES 103 /* tried to open too many FITS files */ +#define FILE_NOT_OPENED 104 /* could not open the named file */ +#define FILE_NOT_CREATED 105 /* could not create the named file */ +#define WRITE_ERROR 106 /* error writing to FITS file */ +#define END_OF_FILE 107 /* tried to move past end of file */ +#define READ_ERROR 108 /* error reading from FITS file */ +#define FILE_NOT_CLOSED 110 /* could not close the file */ +#define ARRAY_TOO_BIG 111 /* array dimensions exceed internal limit */ +#define READONLY_FILE 112 /* Cannot write to readonly file */ +#define MEMORY_ALLOCATION 113 /* Could not allocate memory */ +#define BAD_FILEPTR 114 /* invalid fitsfile pointer */ +#define NULL_INPUT_PTR 115 /* NULL input pointer to routine */ +#define SEEK_ERROR 116 /* error seeking position in file */ + +#define BAD_URL_PREFIX 121 /* invalid URL prefix on file name */ +#define TOO_MANY_DRIVERS 122 /* tried to register too many IO drivers */ +#define DRIVER_INIT_FAILED 123 /* driver initialization failed */ +#define NO_MATCHING_DRIVER 124 /* matching driver is not registered */ +#define URL_PARSE_ERROR 125 /* failed to parse input file URL */ +#define RANGE_PARSE_ERROR 126 /* failed to parse input file URL */ + +#define SHARED_ERRBASE (150) +#define SHARED_BADARG (SHARED_ERRBASE + 1) +#define SHARED_NULPTR (SHARED_ERRBASE + 2) +#define SHARED_TABFULL (SHARED_ERRBASE + 3) +#define SHARED_NOTINIT (SHARED_ERRBASE + 4) +#define SHARED_IPCERR (SHARED_ERRBASE + 5) +#define SHARED_NOMEM (SHARED_ERRBASE + 6) +#define SHARED_AGAIN (SHARED_ERRBASE + 7) +#define SHARED_NOFILE (SHARED_ERRBASE + 8) +#define SHARED_NORESIZE (SHARED_ERRBASE + 9) + +#define HEADER_NOT_EMPTY 201 /* header already contains keywords */ +#define KEY_NO_EXIST 202 /* keyword not found in header */ +#define KEY_OUT_BOUNDS 203 /* keyword record number is out of bounds */ +#define VALUE_UNDEFINED 204 /* keyword value field is blank */ +#define NO_QUOTE 205 /* string is missing the closing quote */ +#define BAD_KEYCHAR 207 /* illegal character in keyword name or card */ +#define BAD_ORDER 208 /* required keywords out of order */ +#define NOT_POS_INT 209 /* keyword value is not a positive integer */ +#define NO_END 210 /* couldn't find END keyword */ +#define BAD_BITPIX 211 /* illegal BITPIX keyword value*/ +#define BAD_NAXIS 212 /* illegal NAXIS keyword value */ +#define BAD_NAXES 213 /* illegal NAXISn keyword value */ +#define BAD_PCOUNT 214 /* illegal PCOUNT keyword value */ +#define BAD_GCOUNT 215 /* illegal GCOUNT keyword value */ +#define BAD_TFIELDS 216 /* illegal TFIELDS keyword value */ +#define NEG_WIDTH 217 /* negative table row size */ +#define NEG_ROWS 218 /* negative number of rows in table */ +#define COL_NOT_FOUND 219 /* column with this name not found in table */ +#define BAD_SIMPLE 220 /* illegal value of SIMPLE keyword */ +#define NO_SIMPLE 221 /* Primary array doesn't start with SIMPLE */ +#define NO_BITPIX 222 /* Second keyword not BITPIX */ +#define NO_NAXIS 223 /* Third keyword not NAXIS */ +#define NO_NAXES 224 /* Couldn't find all the NAXISn keywords */ +#define NO_XTENSION 225 /* HDU doesn't start with XTENSION keyword */ +#define NOT_ATABLE 226 /* the CHDU is not an ASCII table extension */ +#define NOT_BTABLE 227 /* the CHDU is not a binary table extension */ +#define NO_PCOUNT 228 /* couldn't find PCOUNT keyword */ +#define NO_GCOUNT 229 /* couldn't find GCOUNT keyword */ +#define NO_TFIELDS 230 /* couldn't find TFIELDS keyword */ +#define NO_TBCOL 231 /* couldn't find TBCOLn keyword */ +#define NO_TFORM 232 /* couldn't find TFORMn keyword */ +#define NOT_IMAGE 233 /* the CHDU is not an IMAGE extension */ +#define BAD_TBCOL 234 /* TBCOLn keyword value < 0 or > rowlength */ +#define NOT_TABLE 235 /* the CHDU is not a table */ +#define COL_TOO_WIDE 236 /* column is too wide to fit in table */ +#define COL_NOT_UNIQUE 237 /* more than 1 column name matches template */ +#define BAD_ROW_WIDTH 241 /* sum of column widths not = NAXIS1 */ +#define UNKNOWN_EXT 251 /* unrecognizable FITS extension type */ +#define UNKNOWN_REC 252 /* unrecognizable FITS record */ +#define END_JUNK 253 /* END keyword is not blank */ +#define BAD_HEADER_FILL 254 /* Header fill area not blank */ +#define BAD_DATA_FILL 255 /* Data fill area not blank or zero */ +#define BAD_TFORM 261 /* illegal TFORM format code */ +#define BAD_TFORM_DTYPE 262 /* unrecognizable TFORM datatype code */ +#define BAD_TDIM 263 /* illegal TDIMn keyword value */ +#define BAD_HEAP_PTR 264 /* invalid BINTABLE heap address */ + +#define BAD_HDU_NUM 301 /* HDU number < 1 or > MAXHDU */ +#define BAD_COL_NUM 302 /* column number < 1 or > tfields */ +#define NEG_FILE_POS 304 /* tried to move before beginning of file */ +#define NEG_BYTES 306 /* tried to read or write negative bytes */ +#define BAD_ROW_NUM 307 /* illegal starting row number in table */ +#define BAD_ELEM_NUM 308 /* illegal starting element number in vector */ +#define NOT_ASCII_COL 309 /* this is not an ASCII string column */ +#define NOT_LOGICAL_COL 310 /* this is not a logical datatype column */ +#define BAD_ATABLE_FORMAT 311 /* ASCII table column has wrong format */ +#define BAD_BTABLE_FORMAT 312 /* Binary table column has wrong format */ +#define NO_NULL 314 /* null value has not been defined */ +#define NOT_VARI_LEN 317 /* this is not a variable length column */ +#define BAD_DIMEN 320 /* illegal number of dimensions in array */ +#define BAD_PIX_NUM 321 /* first pixel number greater than last pixel */ +#define ZERO_SCALE 322 /* illegal BSCALE or TSCALn keyword = 0 */ +#define NEG_AXIS 323 /* illegal axis length < 1 */ + +#define NOT_GROUP_TABLE 340 +#define HDU_ALREADY_MEMBER 341 +#define MEMBER_NOT_FOUND 342 +#define GROUP_NOT_FOUND 343 +#define BAD_GROUP_ID 344 +#define TOO_MANY_HDUS_TRACKED 345 +#define HDU_ALREADY_TRACKED 346 +#define BAD_OPTION 347 +#define IDENTICAL_POINTERS 348 +#define BAD_GROUP_ATTACH 349 +#define BAD_GROUP_DETACH 350 + +#define BAD_I2C 401 /* bad int to formatted string conversion */ +#define BAD_F2C 402 /* bad float to formatted string conversion */ +#define BAD_INTKEY 403 /* can't interprete keyword value as integer */ +#define BAD_LOGICALKEY 404 /* can't interprete keyword value as logical */ +#define BAD_FLOATKEY 405 /* can't interprete keyword value as float */ +#define BAD_DOUBLEKEY 406 /* can't interprete keyword value as double */ +#define BAD_C2I 407 /* bad formatted string to int conversion */ +#define BAD_C2F 408 /* bad formatted string to float conversion */ +#define BAD_C2D 409 /* bad formatted string to double conversion */ +#define BAD_DATATYPE 410 /* bad keyword datatype code */ +#define BAD_DECIM 411 /* bad number of decimal places specified */ +#define NUM_OVERFLOW 412 /* overflow during datatype conversion */ + +# define DATA_COMPRESSION_ERR 413 /* error in imcompress routines */ +# define DATA_DECOMPRESSION_ERR 414 /* error in imcompress routines */ +# define NO_COMPRESSED_TILE 415 /* compressed tile doesn't exist */ + +#define BAD_DATE 420 /* error in date or time conversion */ + +#define PARSE_SYNTAX_ERR 431 /* syntax error in parser expression */ +#define PARSE_BAD_TYPE 432 /* expression did not evaluate to desired type */ +#define PARSE_LRG_VECTOR 433 /* vector result too large to return in array */ +#define PARSE_NO_OUTPUT 434 /* data parser failed not sent an out column */ +#define PARSE_BAD_COL 435 /* bad data encounter while parsing column */ +#define PARSE_BAD_OUTPUT 436 /* Output file not of proper type */ + +#define ANGLE_TOO_BIG 501 /* celestial angle too large for projection */ +#define BAD_WCS_VAL 502 /* bad celestial coordinate or pixel value */ +#define WCS_ERROR 503 /* error in celestial coordinate calculation */ +#define BAD_WCS_PROJ 504 /* unsupported type of celestial projection */ +#define NO_WCS_KEY 505 /* celestial coordinate keywords not found */ +#define APPROX_WCS_KEY 506 /* approximate WCS keywords were calculated */ + +#define NO_CLOSE_ERROR 999 /* special value used internally to switch off */ + /* the error message from ffclos and ffchdu */ + +/*------- following error codes are used in the grparser.c file -----------*/ +#define NGP_ERRBASE (360) /* base chosen so not to interfere with CFITSIO */ +#define NGP_OK (0) +#define NGP_NO_MEMORY (NGP_ERRBASE + 0) /* malloc failed */ +#define NGP_READ_ERR (NGP_ERRBASE + 1) /* read error from file */ +#define NGP_NUL_PTR (NGP_ERRBASE + 2) /* null pointer passed as argument */ +#define NGP_EMPTY_CURLINE (NGP_ERRBASE + 3) /* line read seems to be empty */ +#define NGP_UNREAD_QUEUE_FULL (NGP_ERRBASE + 4) /* cannot unread more then 1 line (or single line twice) */ +#define NGP_INC_NESTING (NGP_ERRBASE + 5) /* too deep include file nesting (inf. loop ?) */ +#define NGP_ERR_FOPEN (NGP_ERRBASE + 6) /* fopen() failed, cannot open file */ +#define NGP_EOF (NGP_ERRBASE + 7) /* end of file encountered */ +#define NGP_BAD_ARG (NGP_ERRBASE + 8) /* bad arguments passed */ +#define NGP_TOKEN_NOT_EXPECT (NGP_ERRBASE + 9) /* token not expected here */ + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +/* the following 3 lines are needed to support C++ compilers */ +#ifdef __cplusplus +extern "C" { +#endif +#endif + +int CFITS2Unit( fitsfile *fptr ); +fitsfile* CUnit2FITS(int unit); + +/*---------------- FITS file URL parsing routines -------------*/ +int fits_get_token(char **ptr, char *delimiter, char *token, int *isanumber); +char *fits_split_names(char *list); +int ffiurl(char *url, char *urltype, char *infile, + char *outfile, char *extspec, char *rowfilter, + char *binspec, char *colspec, int *status); +int ffrtnm(char *url, char *rootname, int *status); +int ffexist(const char *infile, int *exists, int *status); +int ffexts(char *extspec, int *extnum, char *extname, int *extvers, + int *hdutype, char *colname, char *rowexpress, int *status); +int ffextn(char *url, int *extension_num, int *status); +int ffurlt(fitsfile *fptr, char *urlType, int *status); +int ffbins(char *binspec, int *imagetype, int *haxis, + char colname[4][FLEN_VALUE], double *minin, + double *maxin, double *binsizein, + char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE], + char binname[4][FLEN_VALUE], double *weight, char *wtname, + int *recip, int *status); +int ffbinr(char **binspec, char *colname, double *minin, + double *maxin, double *binsizein, char *minname, + char *maxname, char *binname, int *status); +int ffimport_file( char *filename, char **contents, int *status ); +int ffrwrg( char *rowlist, long maxrows, int maxranges, int *numranges, + long *minrow, long *maxrow, int *status); + +/*---------------- FITS file I/O routines -------------*/ +int ffomem(fitsfile **fptr, const char *name, int mode, void **buffptr, + size_t *buffsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), + int *status); +int ffopen(fitsfile **fptr, const char *filename, int iomode, int *status); +int ffdopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int fftopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int ffiopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int ffdkopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int ffreopen(fitsfile *openfptr, fitsfile **newfptr, int *status); +int ffinit( fitsfile **fptr, const char *filename, int *status); +int ffdkinit(fitsfile **fptr, const char *filename, int *status); +int ffimem(fitsfile **fptr, void **buffptr, + size_t *buffsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), + int *status); +int fftplt(fitsfile **fptr, const char *filename, const char *tempname, + int *status); +int ffflus(fitsfile *fptr, int *status); +int ffflsh(fitsfile *fptr, int clearbuf, int *status); +int ffclos(fitsfile *fptr, int *status); +int ffdelt(fitsfile *fptr, int *status); +int ffflnm(fitsfile *fptr, char *filename, int *status); +int ffflmd(fitsfile *fptr, int *filemode, int *status); + +/*---------------- utility routines -------------*/ +float ffvers(float *version); +void ffupch(char *string); +void ffgerr(int status, char *errtext); +void ffpmsg(const char *err_message); +void ffpmrk(void); +int ffgmsg(char *err_message); +void ffcmsg(void); +void ffcmrk(void); +void ffrprt(FILE *stream, int status); +void ffcmps(char *templt, char *colname, int casesen, int *match, + int *exact); +int fftkey(char *keyword, int *status); +int fftrec(char *card, int *status); +int ffnchk(fitsfile *fptr, int *status); +int ffkeyn(char *keyroot, int value, char *keyname, int *status); +int ffnkey(int value, char *keyroot, char *keyname, int *status); +int ffgkcl(char *card); +int ffdtyp(char *cval, char *dtype, int *status); +int ffpsvc(char *card, char *value, char *comm, int *status); +int ffgknm(char *card, char *name, int *length, int *status); +int ffgthd(char *tmplt, char *card, int *hdtype, int *status); +int ffasfm(char *tform, int *datacode, long *width, int *decim, int *status); +int ffbnfm(char *tform, int *datacode, long *repeat, long *width, int *status); +int ffgabc(int tfields, char **tform, int space, long *rowlen, long *tbcol, + int *status); +int fits_get_section_range(char **ptr,long *secmin,long *secmax,long *incre, + int *status); + +/*----------------- write single keywords --------------*/ +int ffpky(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int ffprec(fitsfile *fptr, const char *card, int *status); +int ffpcom(fitsfile *fptr, const char *comm, int *status); +int ffpunt(fitsfile *fptr, char *keyname, char *unit, int *status); +int ffphis(fitsfile *fptr, const char *history, int *status); +int ffpdat(fitsfile *fptr, int *status); +int ffgstm(char *timestr, int *timeref, int *status); +int ffgsdt(int *day, int *month, int *year, int *status); +int ffdt2s(int year, int month, int day, char *datestr, int *status); +int fftm2s(int year, int month, int day, int hour, int minute, double second, + int decimals, char *datestr, int *status); +int ffs2dt(char *datestr, int *year, int *month, int *day, int *status); +int ffs2tm(char *datestr, int *year, int *month, int *day, int *hour, + int *minute, double *second, int *status); +int ffpkyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffpkys(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffpkls(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffplsw(fitsfile *fptr, int *status); +int ffpkyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffpkyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffpkyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffpkye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffpkyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffpkyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffpkyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffpkym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffpkfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffpkfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffpkyt(fitsfile *fptr, char *keyname, long intval, double frac, char *comm, + int *status); +int ffptdm( fitsfile *fptr, int colnum, int naxis, long naxes[], int *status); + +/*----------------- write array of keywords --------------*/ +int ffpkns(fitsfile *fptr, char *keyroot, int nstart, int nkey, char *value[], + char *comm[], int *status); +int ffpknl(fitsfile *fptr, char *keyroot, int nstart, int nkey, int *value, + char *comm[], int *status); +int ffpknj(fitsfile *fptr, char *keyroot, int nstart, int nkey, long *value, + char *comm[], int *status); +int ffpknf(fitsfile *fptr, char *keyroot, int nstart, int nkey, float *value, + int decim, char *comm[], int *status); +int ffpkne(fitsfile *fptr, char *keyroot, int nstart, int nkey, float *value, + int decim, char *comm[], int *status); +int ffpkng(fitsfile *fptr, char *keyroot, int nstart, int nkey, double *value, + int decim, char *comm[], int *status); +int ffpknd(fitsfile *fptr, char *keyroot, int nstart, int nkey, double *value, + int decim, char *comm[], int *status); +int ffcpky(fitsfile *infptr,fitsfile *outfptr,int incol,int outcol, + char *rootname, int *status); + +/*----------------- write required header keywords --------------*/ +int ffphps( fitsfile *fptr, int bitpix, int naxis, long naxes[], int *status); +int ffphpr( fitsfile *fptr, int simple, int bitpix, int naxis, long naxes[], + long pcount, long gcount, int extend, int *status); +int ffphtb(fitsfile *fptr, long naxis1, long naxis2, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, char *extname, int *status); +int ffphbn(fitsfile *fptr, long naxis2, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, int *status); + +/*----------------- write template keywords --------------*/ +int ffpktp(fitsfile *fptr, const char *filename, int *status); + +/*------------------ get header information --------------*/ +int ffghsp(fitsfile *fptr, int *nexist, int *nmore, int *status); +int ffghps(fitsfile *fptr, int *nexist, int *position, int *status); + +/*------------------ move position in header -------------*/ +int ffmaky(fitsfile *fptr, int nrec, int *status); +int ffmrky(fitsfile *fptr, int nrec, int *status); + +/*------------------ read single keywords -----------------*/ +int ffgnxk(fitsfile *fptr, char **inclist, int ninc, char **exclist, + int nexc, char *card, int *status); +int ffgrec(fitsfile *fptr, int nrec, char *card, int *status); +int ffgcrd(fitsfile *fptr, char *keyname, char *card, int *status); +int ffgunt(fitsfile *fptr, char *keyname, char *unit, int *status); +int ffgkyn(fitsfile *fptr, int nkey, char *keyname, char *keyval, char *comm, + int *status); +int ffgkey(fitsfile *fptr, char *keyname, char *keyval, char *comm, + int *status); + +int ffgky( fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int ffgkys(fitsfile *fptr, char *keyname, char *value, char *comm, int *status); +int ffgkls(fitsfile *fptr, char *keyname, char **value, char *comm, int *status) +; +int ffgkyl(fitsfile *fptr, char *keyname, int *value, char *comm, int *status); +int ffgkyj(fitsfile *fptr, char *keyname, long *value, char *comm, int *status); +int ffgkye(fitsfile *fptr, char *keyname, float *value, char *comm,int *status); +int ffgkyd(fitsfile *fptr, char *keyname, double *value,char *comm,int *status); +int ffgkyc(fitsfile *fptr, char *keyname, float *value, char *comm,int *status); +int ffgkym(fitsfile *fptr, char *keyname, double *value,char *comm,int *status); +int ffgkyt(fitsfile *fptr, char *keyname, long *ivalue, double *dvalue, + char *comm, int *status); +int ffgtdm(fitsfile *fptr, int colnum, int maxdim, int *naxis, long naxes[], + int *status); +int ffdtdm(fitsfile *fptr, char *tdimstr, int colnum, int maxdim, + int *naxis, long naxes[], int *status); + +/*------------------ read array of keywords -----------------*/ +int ffgkns(fitsfile *fptr, char *keyname, int nstart, int nmax, char *value[], + int *nfound, int *status); +int ffgknl(fitsfile *fptr, char *keyname, int nstart, int nmax, int *value, + int *nfound, int *status); +int ffgknj(fitsfile *fptr, char *keyname, int nstart, int nmax, long *value, + int *nfound, int *status); +int ffgkne(fitsfile *fptr, char *keyname, int nstart, int nmax, float *value, + int *nfound, int *status); +int ffgknd(fitsfile *fptr, char *keyname, int nstart, int nmax, double *value, + int *nfound, int *status); +int ffh2st(fitsfile *fptr, char **header, int *status); +int ffhdr2str( fitsfile *fptr, int exclude_comm, char **exclist, + int nexc, char **header, int *nkeys, int *status); + +/*----------------- read required header keywords --------------*/ +int ffghpr(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis, + long naxes[], long *pcount, long *gcount, int *extend, int *status); + +int ffghtb(fitsfile *fptr,int maxfield, long *naxis1, long *naxis2, + int *tfields, char **ttype, long *tbcol, char **tform, char **tunit, + char *extname, int *status); + +int ffghbn(fitsfile *fptr, int maxfield, long *naxis2, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + long *pcount, int *status); + +/*--------------------- update keywords ---------------*/ +int ffuky(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int ffucrd(fitsfile *fptr, char *keyname, char *card, int *status); +int ffukyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffukys(fitsfile *fptr, char *keyname, char *value, char *comm, int *status); +int ffukls(fitsfile *fptr, char *keyname, char *value, char *comm, int *status); +int ffukyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffukyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffukyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffukye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffukyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffukyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffukyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffukym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffukfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffukfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); + +/*--------------------- modify keywords ---------------*/ +int ffmrec(fitsfile *fptr, int nkey, char *card, int *status); +int ffmcrd(fitsfile *fptr, char *keyname, char *card, int *status); +int ffmnam(fitsfile *fptr, char *oldname, char *newname, int *status); +int ffmcom(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffmkyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffmkys(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffmkls(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffmkyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffmkyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffmkyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffmkye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffmkyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffmkyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffmkyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffmkym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffmkfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffmkfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); + +/*--------------------- insert keywords ---------------*/ +int ffirec(fitsfile *fptr, int nkey, char *card, int *status); +int ffikey(fitsfile *fptr, char *card, int *status); +int ffikyu(fitsfile *fptr, char *keyname, char *comm, int *status); +int ffikys(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffikls(fitsfile *fptr, char *keyname, char *value, char *comm,int *status); +int ffikyl(fitsfile *fptr, char *keyname, int value, char *comm, int *status); +int ffikyj(fitsfile *fptr, char *keyname, long value, char *comm, int *status); +int ffikyf(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffikye(fitsfile *fptr, char *keyname, float value, int decim, char *comm, + int *status); +int ffikyg(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffikyd(fitsfile *fptr, char *keyname, double value, int decim, char *comm, + int *status); +int ffikyc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffikym(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); +int ffikfc(fitsfile *fptr, char *keyname, float *value, int decim, char *comm, + int *status); +int ffikfm(fitsfile *fptr, char *keyname, double *value, int decim, char *comm, + int *status); + +/*--------------------- delete keywords ---------------*/ +int ffdkey(fitsfile *fptr, char *keyname, int *status); +int ffdrec(fitsfile *fptr, int keypos, int *status); + +/*--------------------- get HDU information -------------*/ +int ffghdn(fitsfile *fptr, int *chdunum); +int ffghdt(fitsfile *fptr, int *exttype, int *status); +int ffghad(fitsfile *fptr, long *headstart, long *datastart, long *dataend, + int *status); +int ffghof(fitsfile *fptr, OFF_T *headstart, OFF_T *datastart, OFF_T *dataend, + int *status); +int ffgipr(fitsfile *fptr, int maxaxis, int *imgtype, int *naxis, + long *naxes, int *status); +int ffgidt(fitsfile *fptr, int *imgtype, int *status); +int ffgiet(fitsfile *fptr, int *imgtype, int *status); +int ffgidm(fitsfile *fptr, int *naxis, int *status); +int ffgisz(fitsfile *fptr, int nlen, long *naxes, int *status); + +/*--------------------- HDU operations -------------*/ +int ffmahd(fitsfile *fptr, int hdunum, int *exttype, int *status); +int ffmrhd(fitsfile *fptr, int hdumov, int *exttype, int *status); +int ffmnhd(fitsfile *fptr, int exttype, char *hduname, int hduvers, + int *status); +int ffthdu(fitsfile *fptr, int *nhdu, int *status); +int ffcrhd(fitsfile *fptr, int *status); +int ffcrim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int ffcrtb(fitsfile *fptr, int tbltype, long naxis2, int tfields, char **ttype, + char **tform, char **tunit, char *extname, int *status); +int ffiimg(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int ffitab(fitsfile *fptr, long naxis1, long naxis2, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, char *extname, int *status); +int ffibin(fitsfile *fptr,long naxis2, int tfields, char **ttype, char **tform, + char **tunit, char *extname, long pcount, int *status); +int ffrsim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int ffdhdu(fitsfile *fptr, int *hdutype, int *status); +int ffcopy(fitsfile *infptr, fitsfile *outfptr, int morekeys, int *status); +int ffcpfl(fitsfile *infptr, fitsfile *outfptr, int prev, int cur, int follow, + int *status); +int ffcphd(fitsfile *infptr, fitsfile *outfptr, int *status); +int ffcpdt(fitsfile *infptr, fitsfile *outfptr, int *status); +int ffchfl(fitsfile *fptr, int *status); +int ffcdfl(fitsfile *fptr, int *status); + +int ffrdef(fitsfile *fptr, int *status); +int ffhdef(fitsfile *fptr, int morekeys, int *status); +int ffpthp(fitsfile *fptr, long theap, int *status); + +int ffcsum(fitsfile *fptr, long nrec, unsigned long *sum, int *status); +void ffesum(unsigned long sum, int complm, char *ascii); +unsigned long ffdsum(char *ascii, int complm, unsigned long *sum); +int ffpcks(fitsfile *fptr, int *status); +int ffupck(fitsfile *fptr, int *status); +int ffvcks(fitsfile *fptr, int *datastatus, int *hdustatus, int *status); +int ffgcks(fitsfile *fptr, unsigned long *datasum, unsigned long *hdusum, + int *status); + +/*--------------------- define scaling or null values -------------*/ +int ffpscl(fitsfile *fptr, double scale, double zero, int *status); +int ffpnul(fitsfile *fptr, long nulvalue, int *status); +int fftscl(fitsfile *fptr, int colnum, double scale, double zero, int *status); +int fftnul(fitsfile *fptr, int colnum, long nulvalue, int *status); +int ffsnul(fitsfile *fptr, int colnum, char *nulstring, int *status); + +/*--------------------- get column information -------------*/ +int ffgcno(fitsfile *fptr, int casesen, char *templt, int *colnum, + int *status); +int ffgcnn(fitsfile *fptr, int casesen, char *templt, char *colname, + int *colnum, int *status); + +int ffgtcl(fitsfile *fptr, int colnum, int *typecode, long *repeat, + long *width, int *status); +int ffeqty(fitsfile *fptr, int colnum, int *typecode, long *repeat, + long *width, int *status); +int ffgncl(fitsfile *fptr, int *ncols, int *status); +int ffgnrw(fitsfile *fptr, long *nrows, int *status); +int ffgacl(fitsfile *fptr, int colnum, char *ttype, long *tbcol, + char *tunit, char *tform, double *tscal, double *tzero, + char *tnull, char *tdisp, int *status); +int ffgbcl(fitsfile *fptr, int colnum, char *ttype, char *tunit, + char *dtype, long *repeat, double *tscal, double *tzero, + long *tnull, char *tdisp, int *status); +int ffgrsz(fitsfile *fptr, long *nrows, int *status); +int ffgcdw(fitsfile *fptr, int colnum, int *width, int *status); + +/*--------------------- read primary array or image elements -------------*/ +int ffgpxv(fitsfile *fptr, int datatype, long *firstpix, long nelem, + void *nulval, void *array, int *anynul, int *status); +int ffgpxf(fitsfile *fptr, int datatype, long *firstpix, long nelem, + void *array, char *nullarray, int *anynul, int *status); +int ffgsv(fitsfile *fptr, int datatype, long *blc, long *trc, long *inc, + void *nulval, void *array, int *anynul, int *status); +int ffgpv(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *nulval, void *array, int *anynul, int *status); +int ffgpf(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, char *nullarray, int *anynul, int *status); +int ffgpvb(fitsfile *fptr, long group, long firstelem, long nelem, unsigned + char nulval, unsigned char *array, int *anynul, int *status); +int ffgpvsb(fitsfile *fptr, long group, long firstelem, long nelem, signed + char nulval, signed char *array, int *anynul, int *status); +int ffgpvui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short nulval, unsigned short *array, int *anynul, + int *status); +int ffgpvi(fitsfile *fptr, long group, long firstelem, long nelem, + short nulval, short *array, int *anynul, int *status); +int ffgpvuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long nulval, unsigned long *array, int *anynul, + int *status); +int ffgpvj(fitsfile *fptr, long group, long firstelem, long nelem, + long nulval, long *array, int *anynul, int *status); +int ffgpvjj(fitsfile *fptr, long group, long firstelem, long nelem, + LONGLONG nulval, LONGLONG *array, int *anynul, int *status); +int ffgpvuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int nulval, unsigned int *array, int *anynul, int *status); +int ffgpvk(fitsfile *fptr, long group, long firstelem, long nelem, + int nulval, int *array, int *anynul, int *status); +int ffgpve(fitsfile *fptr, long group, long firstelem, long nelem, + float nulval, float *array, int *anynul, int *status); +int ffgpvd(fitsfile *fptr, long group, long firstelem, long nelem, + double nulval, double *array, int *anynul, int *status); + +int ffgpfb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, char *nularray, int *anynul, int *status); +int ffgpfsb(fitsfile *fptr, long group, long firstelem, long nelem, + signed char *array, char *nularray, int *anynul, int *status); +int ffgpfui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short *array, char *nularray, int *anynul, int *status); +int ffgpfi(fitsfile *fptr, long group, long firstelem, long nelem, + short *array, char *nularray, int *anynul, int *status); +int ffgpfuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, char *nularray, int *anynul, int *status); +int ffgpfj(fitsfile *fptr, long group, long firstelem, long nelem, + long *array, char *nularray, int *anynul, int *status); +int ffgpfjj(fitsfile *fptr, long group, long firstelem, long nelem, + LONGLONG *array, char *nularray, int *anynul, int *status); +int ffgpfuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, char *nularray, int *anynul, int *status); +int ffgpfk(fitsfile *fptr, long group, long firstelem, long nelem, + int *array, char *nularray, int *anynul, int *status); +int ffgpfe(fitsfile *fptr, long group, long firstelem, long nelem, + float *array, char *nularray, int *anynul, int *status); +int ffgpfd(fitsfile *fptr, long group, long firstelem, long nelem, + double *array, char *nularray, int *anynul, int *status); + +int ffg2db(fitsfile *fptr, long group, unsigned char nulval, long ncols, + long naxis1, long naxis2, unsigned char *array, + int *anynul, int *status); +int ffg2dsb(fitsfile *fptr, long group, signed char nulval, long ncols, + long naxis1, long naxis2, signed char *array, + int *anynul, int *status); +int ffg2dui(fitsfile *fptr, long group, unsigned short nulval, long ncols, + long naxis1, long naxis2, unsigned short *array, + int *anynul, int *status); +int ffg2di(fitsfile *fptr, long group, short nulval, long ncols, + long naxis1, long naxis2, short *array, + int *anynul, int *status); +int ffg2duj(fitsfile *fptr, long group, unsigned long nulval, long ncols, + long naxis1, long naxis2, unsigned long *array, + int *anynul, int *status); +int ffg2dj(fitsfile *fptr, long group, long nulval, long ncols, + long naxis1, long naxis2, long *array, + int *anynul, int *status); +int ffg2djj(fitsfile *fptr, long group, LONGLONG nulval, long ncols, + long naxis1, long naxis2, LONGLONG *array, + int *anynul, int *status); +int ffg2duk(fitsfile *fptr, long group, unsigned int nulval, long ncols, + long naxis1, long naxis2, unsigned int *array, + int *anynul, int *status); +int ffg2dk(fitsfile *fptr, long group, int nulval, long ncols, + long naxis1, long naxis2, int *array, + int *anynul, int *status); +int ffg2de(fitsfile *fptr, long group, float nulval, long ncols, + long naxis1, long naxis2, float *array, + int *anynul, int *status); +int ffg2dd(fitsfile *fptr, long group, double nulval, long ncols, + long naxis1, long naxis2, double *array, + int *anynul, int *status); + +int ffg3db(fitsfile *fptr, long group, unsigned char nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned char *array, int *anynul, int *status); +int ffg3dsb(fitsfile *fptr, long group, signed char nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + signed char *array, int *anynul, int *status); +int ffg3dui(fitsfile *fptr, long group, unsigned short nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned short *array, int *anynul, int *status); +int ffg3di(fitsfile *fptr, long group, short nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + short *array, int *anynul, int *status); +int ffg3duj(fitsfile *fptr, long group, unsigned long nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned long *array, int *anynul, int *status); +int ffg3dj(fitsfile *fptr, long group, long nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + long *array, int *anynul, int *status); +int ffg3djj(fitsfile *fptr, long group, LONGLONG nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + LONGLONG *array, int *anynul, int *status); +int ffg3duk(fitsfile *fptr, long group, unsigned int nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + unsigned int *array, int *anynul, int *status); +int ffg3dk(fitsfile *fptr, long group, int nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + int *array, int *anynul, int *status); +int ffg3de(fitsfile *fptr, long group, float nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + float *array, int *anynul, int *status); +int ffg3dd(fitsfile *fptr, long group, double nulval, long ncols, + long nrows, long naxis1, long naxis2, long naxis3, + double *array, int *anynul, int *status); + +int ffgsvb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned char nulval, unsigned char *array, + int *anynul, int *status); +int ffgsvsb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, signed char nulval, signed char *array, + int *anynul, int *status); +int ffgsvui(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned short nulval, unsigned short *array, + int *anynul, int *status); +int ffgsvi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, short nulval, short *array, int *anynul, int *status); +int ffgsvuj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned long nulval, unsigned long *array, + int *anynul, int *status); +int ffgsvj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, long nulval, long *array, int *anynul, int *status); +int ffgsvjj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, LONGLONG nulval, LONGLONG *array, int *anynul, + int *status); +int ffgsvuk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned int nulval, unsigned int *array, + int *anynul, int *status); +int ffgsvk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, int nulval, int *array, int *anynul, int *status); +int ffgsve(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, float nulval, float *array, int *anynul, int *status); +int ffgsvd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, double nulval, double *array, int *anynul, + int *status); + +int ffgsfb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned char *array, char *flagval, + int *anynul, int *status); +int ffgsfsb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, signed char *array, char *flagval, + int *anynul, int *status); +int ffgsfui(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned short *array, char *flagval, int *anynul, + int *status); +int ffgsfi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, short *array, char *flagval, int *anynul, int *status); +int ffgsfuj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned long *array, char *flagval, int *anynul, + int *status); +int ffgsfj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, long *array, char *flagval, int *anynul, int *status); +int ffgsfjj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, LONGLONG *array, char *flagval, int *anynul, + int *status); +int ffgsfuk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, unsigned int *array, char *flagval, int *anynul, + int *status); +int ffgsfk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, int *array, char *flagval, int *anynul, int *status); +int ffgsfe(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, float *array, char *flagval, int *anynul, int *status); +int ffgsfd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, double *array, char *flagval, int *anynul, + int *status); + +int ffggpb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, int *status); +int ffggpsb(fitsfile *fptr, long group, long firstelem, long nelem, + signed char *array, int *status); +int ffggpui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short *array, int *status); +int ffggpi(fitsfile *fptr, long group, long firstelem, long nelem, + short *array, int *status); +int ffggpuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, int *status); +int ffggpj(fitsfile *fptr, long group, long firstelem, long nelem, + long *array, int *status); +int ffggpjj(fitsfile *fptr, long group, long firstelem, long nelem, + LONGLONG *array, int *status); +int ffggpuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, int *status); +int ffggpk(fitsfile *fptr, long group, long firstelem, long nelem, + int *array, int *status); +int ffggpe(fitsfile *fptr, long group, long firstelem, long nelem, + float *array, int *status); +int ffggpd(fitsfile *fptr, long group, long firstelem, long nelem, + double *array, int *status); + +/*--------------------- read column elements -------------*/ +int ffgcv( fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *nulval, void *array, int *anynul, + int *status); +int ffgcf( fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, char *nullarray, + int *anynul, int *status); +int ffgcvs(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *nulval, char **array, int *anynul, int *status); +int ffgcl (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *array, int *status); +int ffgcvl (fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char nulval, char *array, int *anynul, int *status); +int ffgcvb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned char nulval, unsigned char *array, + int *anynul, int *status); +int ffgcvsb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, signed char nulval, signed char *array, + int *anynul, int *status); +int ffgcvui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short nulval, unsigned short *array, + int *anynul, int *status); +int ffgcvi(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short nulval, short *array, int *anynul, int *status); +int ffgcvuj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long nulval, unsigned long *array, int *anynul, + int *status); +int ffgcvj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long nulval, long *array, int *anynul, int *status); +int ffgcvjj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, LONGLONG nulval, LONGLONG *array, int *anynul, + int *status); +int ffgcvuk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int nulval, unsigned int *array, int *anynul, + int *status); +int ffgcvk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int nulval, int *array, int *anynul, int *status); +int ffgcve(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float nulval, float *array, int *anynul, int *status); +int ffgcvd(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double nulval, double *array, int *anynul, int *status); +int ffgcvc(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float nulval, float *array, int *anynul, int *status); +int ffgcvm(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double nulval, double *array, int *anynul, int *status); +int ffgcx(fitsfile *fptr, int colnum, long firstrow, long firstbit, + long nbits, char *larray, int *status); +int ffgcxui(fitsfile *fptr, int colnum, long firstrow, long nrows, + long firstbit, int nbits, unsigned short *array, int *status); +int ffgcxuk(fitsfile *fptr, int colnum, long firstrow, long nrows, + long firstbit, int nbits, unsigned int *array, int *status); + +int ffgcfs(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, char **array, char *nularray, int *anynul, int *status); +int ffgcfl(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, char *array, char *nularray, int *anynul, int *status); +int ffgcfb(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, unsigned char *array, char *nularray, int *anynul, int *status); +int ffgcfsb(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, signed char *array, char *nularray, int *anynul, int *status); +int ffgcfui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short *array, char *nularray, int *anynul, + int *status); +int ffgcfi(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short *array, char *nularray, int *anynul, int *status); +int ffgcfuj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long *array, char *nularray, int *anynul, + int *status); +int ffgcfj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long *array, char *nularray, int *anynul, int *status); +int ffgcfjj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, LONGLONG *array, char *nularray, int *anynul, int *status); +int ffgcfuk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int *array, char *nularray, int *anynul, + int *status); +int ffgcfk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *array, char *nularray, int *anynul, int *status); +int ffgcfe(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, char *nularray, int *anynul, int *status); +int ffgcfd(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, char *nularray, int *anynul, int *status); +int ffgcfc(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, char *nularray, int *anynul, int *status); +int ffgcfm(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, char *nularray, int *anynul, int *status); + +int ffgdes(fitsfile *fptr, int colnum, long rownum, long *length, + long *heapaddr, int *status); + +int ffgdess(fitsfile *fptr, int colnum, long firstrow, long nrows, long *length, + long *heapaddr, int *status); + +int fftheap(fitsfile *fptr, long *heapsize, long *unused, long *overlap, + int *valid, int *status); +int ffcmph(fitsfile *fptr, int *status); + +int ffgtbb(fitsfile *fptr, long firstrow, long firstchar, long nchars, + unsigned char *values, int *status); + +/*------------ write primary array or image elements -------------*/ +int ffppx(fitsfile *fptr, int datatype, long *firstpix, long nelem, + void *array, int *status); +int ffppxn(fitsfile *fptr, int datatype, long *firstpix, long nelem, + void *array, void *nulval, int *status); +int ffppr(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, int *status); +int ffpprb(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned char *array, int *status); +int ffpprsb(fitsfile *fptr, long group, long firstelem, + long nelem, signed char *array, int *status); +int ffpprui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, int *status); +int ffppri(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, int *status); +int ffppruj(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned long *array, int *status); +int ffpprj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, int *status); +int ffppruk(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned int *array, int *status); +int ffpprk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int *status); +int ffppre(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, int *status); +int ffpprd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, int *status); +int ffpprjj(fitsfile *fptr, long group, long firstelem, + long nelem, LONGLONG *array, int *status); + +int ffppru(fitsfile *fptr, long group, long firstelem, long nelem, + int *status); +int ffpprn(fitsfile *fptr, long firstelem, long nelem, int *status); + +int ffppn(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, void *nulval, int *status); +int ffppnb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, unsigned char nulval, int *status); +int ffppnsb(fitsfile *fptr, long group, long firstelem, long nelem, + signed char *array, signed char nulval, int *status); +int ffppnui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, unsigned short nulval, + int *status); +int ffppni(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, short nulval, int *status); +int ffppnj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, long nulval, int *status); +int ffppnuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, unsigned long nulval, int *status); +int ffppnuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, unsigned int nulval, int *status); +int ffppnk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int nulval, int *status); +int ffppne(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, float nulval, int *status); +int ffppnd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, double nulval, int *status); +int ffppnjj(fitsfile *fptr, long group, long firstelem, + long nelem, LONGLONG *array, long nulval, int *status); + +int ffp2db(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned char *array, int *status); +int ffp2dsb(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, signed char *array, int *status); +int ffp2dui(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned short *array, int *status); +int ffp2di(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, short *array, int *status); +int ffp2duj(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned long *array, int *status); +int ffp2dj(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, long *array, int *status); +int ffp2duk(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, unsigned int *array, int *status); +int ffp2dk(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, int *array, int *status); +int ffp2de(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, float *array, int *status); +int ffp2dd(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, double *array, int *status); +int ffp2djj(fitsfile *fptr, long group, long ncols, long naxis1, + long naxis2, LONGLONG *array, int *status); + +int ffp3db(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned char *array, int *status); +int ffp3dsb(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, signed char *array, int *status); +int ffp3dui(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned short *array, int *status); +int ffp3di(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, short *array, int *status); +int ffp3duj(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned long *array, int *status); +int ffp3dj(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, long *array, int *status); +int ffp3duk(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, unsigned int *array, int *status); +int ffp3dk(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, int *array, int *status); +int ffp3de(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, float *array, int *status); +int ffp3dd(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, double *array, int *status); +int ffp3djj(fitsfile *fptr, long group, long ncols, long nrows, long naxis1, + long naxis2, long naxis3, LONGLONG *array, int *status); + +int ffpss(fitsfile *fptr, int datatype, + long *fpixel, long *lpixel, void *array, int *status); +int ffpssb(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned char *array, int *status); +int ffpsssb(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, signed char *array, int *status); +int ffpssui(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned short *array, int *status); +int ffpssi(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, short *array, int *status); +int ffpssuj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned long *array, int *status); +int ffpssj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, long *array, int *status); +int ffpssuk(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned int *array, int *status); +int ffpssk(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, int *array, int *status); +int ffpsse(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, float *array, int *status); +int ffpssd(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, double *array, int *status); +int ffpssjj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, LONGLONG *array, int *status); + +int ffpgpb(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned char *array, int *status); +int ffpgpsb(fitsfile *fptr, long group, long firstelem, + long nelem, signed char *array, int *status); +int ffpgpui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, int *status); +int ffpgpi(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, int *status); +int ffpgpuj(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned long *array, int *status); +int ffpgpj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, int *status); +int ffpgpuk(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned int *array, int *status); +int ffpgpk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int *status); +int ffpgpe(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, int *status); +int ffpgpd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, int *status); +int ffpgpjj(fitsfile *fptr, long group, long firstelem, + long nelem, LONGLONG *array, int *status); + +/*--------------------- iterator functions -------------*/ +int fits_iter_set_by_name(iteratorCol *col, fitsfile *fptr, char *colname, + int datatype, int iotype); +int fits_iter_set_by_num(iteratorCol *col, fitsfile *fptr, int colnum, + int datatype, int iotype); +int fits_iter_set_file(iteratorCol *col, fitsfile *fptr); +int fits_iter_set_colname(iteratorCol *col, char *colname); +int fits_iter_set_colnum(iteratorCol *col, int colnum); +int fits_iter_set_datatype(iteratorCol *col, int datatype); +int fits_iter_set_iotype(iteratorCol *col, int iotype); + +fitsfile * fits_iter_get_file(iteratorCol *col); +char * fits_iter_get_colname(iteratorCol *col); +int fits_iter_get_colnum(iteratorCol *col); +int fits_iter_get_datatype(iteratorCol *col); +int fits_iter_get_iotype(iteratorCol *col); +void * fits_iter_get_array(iteratorCol *col); +long fits_iter_get_tlmin(iteratorCol *col); +long fits_iter_get_tlmax(iteratorCol *col); +long fits_iter_get_repeat(iteratorCol *col); +char * fits_iter_get_tunit(iteratorCol *col); +char * fits_iter_get_tdisp(iteratorCol *col); + +int ffiter(int ncols, iteratorCol *data, long offset, long nPerLoop, + int (*workFn)( long totaln, long offset, long firstn, + long nvalues, int narrays, iteratorCol *data, void *userPointer), + void *userPointer, int *status); + +/*--------------------- write column elements -------------*/ +int ffpcl(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, int *status); +int ffpcls(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char **array, int *status); +int ffpcll(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *array, int *status); +int ffpclb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned char *array, int *status); +int ffpclsb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, signed char *array, int *status); +int ffpclui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short *array, int *status); +int ffpcli(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short *array, int *status); +int ffpcluj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long *array, int *status); +int ffpclj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long *array, int *status); +int ffpcluk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int *array, int *status); +int ffpclk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *array, int *status); +int ffpcle(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, int *status); +int ffpcld(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, int *status); +int ffpclc(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, int *status); +int ffpclm(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, int *status); +int ffpclu(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *status); +int ffpclx(fitsfile *fptr, int colnum, long frow, long fbit, long nbit, + char *larray, int *status); +int ffpcljj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, LONGLONG *array, int *status); + +int ffpcn(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, void *nulval, int *status); +int ffpcns( fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char **array, char *nulvalue, int *status); +int ffpcnl( fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, char *array, char nulvalue, int *status); +int ffpcnb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned char *array, unsigned char nulvalue, + int *status); +int ffpcnsb(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, signed char *array, signed char nulvalue, + int *status); +int ffpcnui(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned short *array, unsigned short nulvalue, + int *status); +int ffpcni(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, short *array, short nulvalue, int *status); +int ffpcnuj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned long *array, unsigned long nulvalue, + int *status); +int ffpcnj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, long *array, long nulvalue, int *status); +int ffpcnuk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, unsigned int *array, unsigned int nulvalue, + int *status); +int ffpcnk(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int *array, int nulvalue, int *status); +int ffpcne(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, float *array, float nulvalue, int *status); +int ffpcnd(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, double *array, double nulvalue, int *status); +int ffpcnjj(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, LONGLONG *array, LONGLONG nulvalue, int *status); + +int ffpdes(fitsfile *fptr, int colnum, long rownum, long length, + long heapaddr, int *status); + +int ffptbb(fitsfile *fptr, long firstrow, long firstchar, long nchars, + unsigned char *values, int *status); + +int ffirow(fitsfile *fptr, long firstrow, long nrows, int *status); +int ffdrow(fitsfile *fptr, long firstrow, long nrows, int *status); +int ffdrrg(fitsfile *fptr, char *ranges, int *status); +int ffdrws(fitsfile *fptr, long *rownum, long nrows, int *status); +int fficol(fitsfile *fptr, int numcol, char *ttype, char *tform, int *status); +int fficls(fitsfile *fptr, int firstcol, int ncols, char **ttype, + char **tform, int *status); +int ffmvec(fitsfile *fptr, int colnum, long newveclen, int *status); +int ffdcol(fitsfile *fptr, int numcol, int *status); +int ffcpcl(fitsfile *infptr, fitsfile *outfptr, int incol, int outcol, + int create_col, int *status); + +/*--------------------- WCS Utilities ------------------*/ +int ffgics(fitsfile *fptr, double *xrval, double *yrval, double *xrpix, + double *yrpix, double *xinc, double *yinc, double *rot, + char *type, int *status); +int ffgtcs(fitsfile *fptr, int xcol, int ycol, double *xrval, + double *yrval, double *xrpix, double *yrpix, double *xinc, + double *yinc, double *rot, char *type, int *status); +int ffwldp(double xpix, double ypix, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *type, double *xpos, double *ypos, int *status); +int ffxypx(double xpos, double ypos, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, + double rot, char *type, double *xpix, double *ypix, int *status); + +/* WCS support routines (provide interface to Doug Mink's WCS library */ +int ffgiwcs(fitsfile *fptr, char **header, int *status); +int ffgtwcs(fitsfile *fptr, int xcol, int ycol, char **header, int *status); + +/*--------------------- lexical parsing routines ------------------*/ +int fftexp( fitsfile *fptr, char *expr, int maxdim, + int *datatype, long *nelem, int *naxis, + long *naxes, int *status ); + +int fffrow( fitsfile *infptr, char *expr, + long firstrow, long nrows, + long *n_good_rows, char *row_status, int *status); + +int ffffrw( fitsfile *fptr, char *expr, long *rownum, int *status); + +int fffrwc( fitsfile *fptr, char *expr, char *timeCol, + char *parCol, char *valCol, long ntimes, + double *times, char *time_status, int *status ); + +int ffsrow( fitsfile *infptr, fitsfile *outfptr, char *expr, + int *status); + +int ffcrow( fitsfile *fptr, int datatype, char *expr, + long firstrow, long nelements, void *nulval, + void *array, int *anynul, int *status ); + +int ffcalc_rng( fitsfile *infptr, char *expr, fitsfile *outfptr, + char *parName, char *parInfo, int nRngs, + long *start, long *end, int *status ); + +int ffcalc( fitsfile *infptr, char *expr, fitsfile *outfptr, + char *parName, char *parInfo, int *status ); + + /* ffhist is not really intended as a user-callable routine */ + /* but it may be useful for some specialized applications */ + +int ffhist(fitsfile **fptr, char *outfile, int imagetype, int naxis, + char colname[4][FLEN_VALUE], + double *minin, double *maxin, double *binsizein, + char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE], + char binname[4][FLEN_VALUE], + double weightin, char wtcol[FLEN_VALUE], + int recip, char *rowselect, int *status); + +int fits_select_image_section(fitsfile **fptr, char *outfile, + char *imagesection, int *status); +int fits_select_section( fitsfile *infptr, fitsfile *outfptr, + char *imagesection, int *status); + +/*--------------------- grouping routines ------------------*/ + +int ffgtcr(fitsfile *fptr, char *grpname, int grouptype, int *status); +int ffgtis(fitsfile *fptr, char *grpname, int grouptype, int *status); +int ffgtch(fitsfile *gfptr, int grouptype, int *status); +int ffgtrm(fitsfile *gfptr, int rmopt, int *status); +int ffgtcp(fitsfile *infptr, fitsfile *outfptr, int cpopt, int *status); +int ffgtmg(fitsfile *infptr, fitsfile *outfptr, int mgopt, int *status); +int ffgtcm(fitsfile *gfptr, int cmopt, int *status); +int ffgtvf(fitsfile *gfptr, long *firstfailed, int *status); +int ffgtop(fitsfile *mfptr,int group,fitsfile **gfptr,int *status); +int ffgtam(fitsfile *gfptr, fitsfile *mfptr, int hdupos, int *status); +int ffgtnm(fitsfile *gfptr, long *nmembers, int *status); +int ffgmng(fitsfile *mfptr, long *nmembers, int *status); +int ffgmop(fitsfile *gfptr, long member, fitsfile **mfptr, int *status); +int ffgmcp(fitsfile *gfptr, fitsfile *mfptr, long member, int cpopt, + int *status); +int ffgmtf(fitsfile *infptr, fitsfile *outfptr, long member, int tfopt, + int *status); +int ffgmrm(fitsfile *fptr, long member, int rmopt, int *status); + +/*--------------------- group template parser routines ------------------*/ + +int fits_execute_template(fitsfile *ff, char *ngp_template, int *status); + +/*--------------------- image compression routines ------------------*/ + +int fits_set_compression_type(fitsfile *fptr, int ctype, int *status); +int fits_set_tile_dim(fitsfile *fptr, int ndim, long *dims, int *status); +int fits_set_noise_bits(fitsfile *fptr, int noisebits, int *status); + +int fits_get_compression_type(fitsfile *fptr, int *ctype, int *status); +int fits_get_tile_dim(fitsfile *fptr, int ndim, long *dims, int *status); +int fits_get_noise_bits(fitsfile *fptr, int *noisebits, int *status); + +int fits_compress_img(fitsfile *infptr, fitsfile *outfptr, int compress_type, + long *tilesize, int parm1, int parm2, int *status); +int fits_is_compressed_image(fitsfile *fptr, int *status); +int fits_decompress_img (fitsfile *infptr, fitsfile *outfptr, int *status); + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +#ifdef __cplusplus +} +#endif +#endif + +#endif + diff --git a/pkg/tbtables/cfitsio/fitsio.ps b/pkg/tbtables/cfitsio/fitsio.ps new file mode 100644 index 00000000..ec62e304 --- /dev/null +++ b/pkg/tbtables/cfitsio/fitsio.ps @@ -0,0 +1,9852 @@ +%!PS-Adobe-2.0 +%%Creator: dvips(k) 5.86 Copyright 1999 Radical Eye Software +%%Title: fitsio.dvi +%%Pages: 132 +%%PageOrder: Ascend +%%BoundingBox: 0 0 612 792 +%%EndComments +%DVIPSWebPage: (www.radicaleye.com) +%DVIPSCommandLine: dvips -N0 fitsio +%DVIPSParameters: dpi=600, compressed +%DVIPSSource: TeX output 2004.12.03:1404 +%%BeginProcSet: texc.pro +%! +/TeXDict 300 dict def TeXDict begin/N{def}def/B{bind def}N/S{exch}N/X{S +N}B/A{dup}B/TR{translate}N/isls false N/vsize 11 72 mul N/hsize 8.5 72 +mul N/landplus90{false}def/@rigin{isls{[0 landplus90{1 -1}{-1 1}ifelse 0 +0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{ +landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize +mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[ +matrix currentmatrix{A A round sub abs 0.00001 lt{round}if}forall round +exch round exch]setmatrix}N/@landscape{/isls true N}B/@manualfeed{ +statusdict/manualfeed true put}B/@copies{/#copies X}B/FMat[1 0 0 -1 0 0] +N/FBB[0 0 0 0]N/nn 0 N/IEn 0 N/ctr 0 N/df-tail{/nn 8 dict N nn begin +/FontType 3 N/FontMatrix fntrx N/FontBBox FBB N string/base X array +/BitMaps X/BuildChar{CharBuilder}N/Encoding IEn N end A{/foo setfont}2 +array copy cvx N load 0 nn put/ctr 0 N[}B/sf 0 N/df{/sf 1 N/fntrx FMat N +df-tail}B/dfs{div/sf X/fntrx[sf 0 0 sf neg 0 0]N df-tail}B/E{pop nn A +definefont setfont}B/Cw{Cd A length 5 sub get}B/Ch{Cd A length 4 sub get +}B/Cx{128 Cd A length 3 sub get sub}B/Cy{Cd A length 2 sub get 127 sub} +B/Cdx{Cd A length 1 sub get}B/Ci{Cd A type/stringtype ne{ctr get/ctr ctr +1 add N}if}B/id 0 N/rw 0 N/rc 0 N/gp 0 N/cp 0 N/G 0 N/CharBuilder{save 3 +1 roll S A/base get 2 index get S/BitMaps get S get/Cd X pop/ctr 0 N Cdx +0 Cx Cy Ch sub Cx Cw add Cy setcachedevice Cw Ch true[1 0 0 -1 -.1 Cx +sub Cy .1 sub]/id Ci N/rw Cw 7 add 8 idiv string N/rc 0 N/gp 0 N/cp 0 N{ +rc 0 ne{rc 1 sub/rc X rw}{G}ifelse}imagemask restore}B/G{{id gp get/gp +gp 1 add N A 18 mod S 18 idiv pl S get exec}loop}B/adv{cp add/cp X}B +/chg{rw cp id gp 4 index getinterval putinterval A gp add/gp X adv}B/nd{ +/cp 0 N rw exit}B/lsh{rw cp 2 copy get A 0 eq{pop 1}{A 255 eq{pop 254}{ +A A add 255 and S 1 and or}ifelse}ifelse put 1 adv}B/rsh{rw cp 2 copy +get A 0 eq{pop 128}{A 255 eq{pop 127}{A 2 idiv S 128 and or}ifelse} +ifelse put 1 adv}B/clr{rw cp 2 index string putinterval adv}B/set{rw cp +fillstr 0 4 index getinterval putinterval adv}B/fillstr 18 string 0 1 17 +{2 copy 255 put pop}for N/pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add +chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{ +1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]A{bind pop} +forall N/D{/cc X A type/stringtype ne{]}if nn/base get cc ctr put nn +/BitMaps get S ctr S sf 1 ne{A A length 1 sub A 2 index S get sf div put +}if put/ctr ctr 1 add N}B/I{cc 1 add D}B/bop{userdict/bop-hook known{ +bop-hook}if/SI save N @rigin 0 0 moveto/V matrix currentmatrix A 1 get A +mul exch 0 get A mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N/eop{ +SI restore userdict/eop-hook known{eop-hook}if showpage}N/@start{ +userdict/start-hook known{start-hook}if pop/VResolution X/Resolution X +1000 div/DVImag X/IEn 256 array N 2 string 0 1 255{IEn S A 360 add 36 4 +index cvrs cvn put}for pop 65781.76 div/vsize X 65781.76 div/hsize X}N +/p{show}N/RMat[1 0 0 -1 0 0]N/BDot 260 string N/Rx 0 N/Ry 0 N/V{}B/RV/v{ +/Ry X/Rx X V}B statusdict begin/product where{pop false[(Display)(NeXT) +(LaserWriter 16/600)]{A length product length le{A length product exch 0 +exch getinterval eq{pop true exit}if}{pop}ifelse}forall}{false}ifelse +end{{gsave TR -.1 .1 TR 1 1 scale Rx Ry false RMat{BDot}imagemask +grestore}}{{gsave TR -.1 .1 TR Rx Ry scale 1 1 false RMat{BDot} +imagemask grestore}}ifelse B/QV{gsave newpath transform round exch round +exch itransform moveto Rx 0 rlineto 0 Ry neg rlineto Rx neg 0 rlineto +fill grestore}B/a{moveto}B/delta 0 N/tail{A/delta X 0 rmoveto}B/M{S p +delta add tail}B/b{S p tail}B/c{-4 M}B/d{-3 M}B/e{-2 M}B/f{-1 M}B/g{0 M} +B/h{1 M}B/i{2 M}B/j{3 M}B/k{4 M}B/w{0 rmoveto}B/l{p -4 w}B/m{p -3 w}B/n{ +p -2 w}B/o{p -1 w}B/q{p 1 w}B/r{p 2 w}B/s{p 3 w}B/t{p 4 w}B/x{0 S +rmoveto}B/y{3 2 roll p a}B/bos{/SS save N}B/eos{SS restore}B end + +%%EndProcSet +TeXDict begin 40258431 52099146 1000 600 600 (fitsio.dvi) +@start +%DVIPSBitmapFont: Fa cmmi10 10.95 1 +/Fa 1 63 df<126012F8B4FCEA7FC0EA1FF0EA07FCEA01FF38007FC0EB1FF0EB07FCEB01 +FF9038007FC0EC1FF0EC07FCEC01FF9138007FC0ED1FF0ED07FCED01FF9238007FC0EE1F +F0EE07FCEE01FF9338007FC0EF1FF0EF07F8EF01FCA2EF07F8EF1FF0EF7FC0933801FF00 +EE07FCEE1FF0EE7FC04B48C7FCED07FCED1FF0ED7FC04A48C8FCEC07FCEC1FF0EC7FC049 +48C9FCEB07FCEB1FF0EB7FC04848CAFCEA07FCEA1FF0EA7FC048CBFC12FC1270363678B1 +47>62 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fb cmbx12 12 58 +/Fb 58 122 df12 D45 DII49 DII<163FA25E5E5D5DA25D5D5D5DA25D92B5FCEC01F7EC03E7140715C7EC0F +87EC1F07143E147E147C14F8EB01F0EB03E0130714C0EB0F80EB1F00133E5BA25B485A48 +5A485A120F5B48C7FC123E5A12FCB91280A5C8000F90C7FCAC027FB61280A531417DC038 +>I<0007150301E0143F01FFEB07FF91B6FC5E5E5E5E5E16804BC7FC5D15E092C8FC01C0 +C9FCAAEC3FF001C1B5FC01C714C001DF14F09039FFE03FFC9138000FFE01FC6D7E01F06D +13804915C0497F6C4815E0C8FC6F13F0A317F8A4EA0F80EA3FE0487E12FF7FA317F05B5D +6C4815E05B007EC74813C0123E003F4A1380D81FC0491300D80FF0495AD807FEEBFFFC6C +B612F0C65D013F1480010F01FCC7FC010113C02D427BC038>I<4AB47E021F13F0027F13 +FC49B6FC01079038807F8090390FFC001FD93FF014C04948137F4948EBFFE048495A5A14 +00485A120FA248486D13C0EE7F80EE1E00003F92C7FCA25B127FA2EC07FC91381FFF8000 +FF017F13E091B512F89039F9F01FFC9039FBC007FE9039FF8003FF17804A6C13C05B6F13 +E0A24915F0A317F85BA4127FA5123FA217F07F121FA2000F4A13E0A26C6C15C06D491380 +6C018014006C6D485A6C9038E01FFC6DB55A011F5C010714C0010191C7FC9038003FF02D +427BC038>I<121E121F13FC90B712FEA45A17FC17F817F017E017C0A2481680007EC8EA +3F00007C157E5E00785D15014B5A00F84A5A484A5A5E151FC848C7FC157E5DA24A5A1403 +5D14074A5AA2141F5D143FA2147F5D14FFA25BA35B92C8FCA35BA55BAA6D5A6D5A6D5A2F +447AC238>IIII65 DIIIIIIII75 DIII<923807FFC092B512FE0207ECFFC0021F15F091 +267FFE0013FC902601FFF0EB1FFF01070180010313C04990C76C7FD91FFC6E6C7E49486F +7E49486F7E01FF8348496F7E48496F1380A248496F13C0A24890C96C13E0A24819F04982 +003F19F8A3007F19FC49177FA400FF19FEAD007F19FC6D17FFA3003F19F8A26D5E6C19F0 +A26E5D6C19E0A26C6D4B13C06C19806E5D6C6D4B13006C6D4B5A6D6C4B5A6D6C4B5A6D6C +4A5B6D01C001075B6D01F0011F5B010101FE90B5C7FC6D90B65A023F15F8020715C00200 +4AC8FC030713C047467AC454>II82 DI<003FBA12E0A59026FE000FEB8003D87FE09338003FF0 +49171F90C71607A2007E1803007C1801A300781800A400F819F8481978A5C81700B3B3A2 +0107B8FCA545437CC24E>IIII<903801FF +E0011F13FE017F6D7E48B612E03A03FE007FF84848EB1FFC6D6D7E486C6D7EA26F7FA36F +7F6C5A6C5AEA00F090C7FCA40203B5FC91B6FC1307013F13F19038FFFC01000313E0000F +1380381FFE00485A5B127F5B12FF5BA35DA26D5B6C6C5B4B13F0D83FFE013EEBFFC03A1F +FF80FC7F0007EBFFF86CECE01FC66CEB8007D90FFCC9FC322F7DAD36>97 +DIIIIIII<137C48 +B4FC4813804813C0A24813E0A56C13C0A26C13806C1300EA007C90C7FCAAEB7FC0EA7FFF +A512037EB3AFB6FCA518467CC520>I107 DI<90277F8007FEEC0FFCB590263FFFC090387FFF8092B5D8F001B512E002816E48 +80913D87F01FFC0FE03FF8913D8FC00FFE1F801FFC0003D99F009026FF3E007F6C019E6D +013C130F02BC5D02F86D496D7EA24A5D4A5DA34A5DB3A7B60081B60003B512FEA5572D7C +AC5E>I<90397F8007FEB590383FFF8092B512E0028114F8913987F03FFC91388F801F00 +0390399F000FFE6C139E14BC02F86D7E5CA25CA35CB3A7B60083B512FEA5372D7CAC3E> +II<90397FC00FF8B590B57E +02C314E002CF14F89139DFC03FFC9139FF001FFE000301FCEB07FF6C496D13804A15C04A +6D13E05C7013F0A2EF7FF8A4EF3FFCACEF7FF8A318F017FFA24C13E06E15C06E5B6E4913 +806E4913006E495A9139DFC07FFC02CFB512F002C314C002C091C7FCED1FF092C9FCADB6 +7EA536407DAC3E>I<90387F807FB53881FFE0028313F0028F13F8ED8FFC91389F1FFE00 +0313BE6C13BC14F8A214F0ED0FFC9138E007F8ED01E092C7FCA35CB3A5B612E0A5272D7D +AC2E>114 D<90391FFC038090B51287000314FF120F381FF003383FC00049133F48C712 +1F127E00FE140FA215077EA27F01E090C7FC13FE387FFFF014FF6C14C015F06C14FC6C80 +0003806C15806C7E010F14C0EB003F020313E0140000F0143FA26C141F150FA27EA26C15 +C06C141FA26DEB3F8001E0EB7F009038F803FE90B55A00FC5CD8F03F13E026E007FEC7FC +232F7CAD2C>IIIIIII E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fc cmsy10 10.95 4 +/Fc 4 107 df15 +D<153FEC03FFEC0FE0EC3F80EC7E00495A5C495AA2495AB3AA130F5C131F495A91C7FC13 +FEEA03F8EA7FE048C8FCEA7FE0EA03F8EA00FE133F806D7E130F801307B3AA6D7EA26D7E +80EB007EEC3F80EC0FE0EC03FFEC003F205B7AC32D>102 D<12FCEAFFC0EA07F0EA01FC +EA007E6D7E131F6D7EA26D7EB3AA801303806D7E1300147FEC1FC0EC07FEEC00FFEC07FE +EC1FC0EC7F0014FC1301495A5C13075CB3AA495AA2495A133F017EC7FC485AEA07F0EAFF +C000FCC8FC205B7AC32D>I<126012F0B3B3B3B3B11260045B76C319>106 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fd cmbx12 14.4 63 +/Fd 63 123 df<922601FFFC903801FFE0033F9026FF801F13F84AB6D8E07F13FE020F03 +F9B6FC023FD9C00FB500C0138091277FFC0003D9FE0113C0902601FFE049495A49494949 +4813E04990C714F049484A13E0495A19C0495A7413C0017F17804A6E6E1380719138007E +007192C7FCAEBCFCA526007FF8C7000301C0C8FCB3B3A7007FB5D8F803B612F0A553547D +D34E>11 DI<151E153E157E15FCEC01F8EC07F0EC0FE0EC1FC01580143FEC7F00 +14FE1301495A5C1307495AA2495A133F5C137FA2495AA24890C7FCA25A5BA21207A2485A +A3121F5BA3123FA25BA3127FA55B12FFB3A3127F7FA5123FA37FA2121FA37F120FA36C7E +A21203A27F7EA26C7FA26D7EA2133F80131F6D7EA26D7E1303806D7E1300147FEC3F8014 +1F15C0EC0FE0EC07F0EC01F8EC00FC157E153E151E1F7973D934>40 +D<127012F8127C127E7EEA1FC06C7E6C7E12037F6C7E6C7E7F6D7E133F806D7EA26D7E80 +130780A26D7EA26D7EA215807FA215C0A2EC7FE0A315F0143FA315F8A2141FA315FCA514 +0F15FEB3A315FC141FA515F8A3143FA215F0A3147F15E0A3ECFFC0A21580A25B1500A249 +5AA2495AA25C130F5C495AA2495A5C137F49C7FC5B485A485A5B1207485A485A48C8FC12 +7E127C5A12701F7979D934>I45 DII<913803FFC0023F13 +FC91B6FC010315C0010F018113F0903A1FFC003FF849486D7E49486D7E49486D7E48496D +138048496D13C0A24817E04890C813F0A34817F8A24817FC49157FA3007F17FEA600FF17 +FFB3A5007F17FEA6003F17FCA26D15FFA26C17F8A36C17F0A26C6D4913E0A26C6D4913C0 +6C17806E5B6C6D4913006D6C495AD91FFCEB3FF8903A0FFF81FFF06D90B55A01011580D9 +003F01FCC7FC020313C0384F7BCD43>I<157815FC14031407141F14FF130F0007B5FCB6 +FCA2147F13F0EAF800C7FCB3B3B3A6007FB712FEA52F4E76CD43>II<91380FFFC091B512FC0107ECFF80011F15E090263FF8077F9026FF8001 +13FC4848C76C7ED803F86E7E491680D807FC8048B416C080486D15E0A4805CA36C17C06C +5B6C90C75AD801FC1680C9FC4C13005FA24C5A4B5B4B5B4B13C04B5BDBFFFEC7FC91B512 +F816E016FCEEFF80DA000713E0030113F89238007FFE707E7013807013C018E07013F0A2 +18F8A27013FCA218FEA2EA03E0EA0FF8487E487E487EB57EA318FCA25E18F891C7FC6C17 +F0495C6C4816E001F04A13C06C484A1380D80FF84A13006CB44A5A6CD9F0075BC690B612 +F06D5D011F1580010302FCC7FCD9001F1380374F7ACD43>I<177C17FEA2160116031607 +160FA2161F163F167FA216FF5D5DA25D5DED1FBFED3F3F153E157C15FCEC01F815F0EC03 +E01407EC0FC01580EC1F005C147E147C5C1301495A495A5C495A131F49C7FC133E5B13FC +485A5B485A1207485A485A90C8FC123E127E5ABA12C0A5C96C48C7FCAF020FB712C0A53A +4F7CCE43>III<121F7F7FEBFF8091B81280A45A19 +00606060A2606060485F0180C86CC7FC007EC95A4C5A007C4B5A5F4C5A160F4C5A484B5A +4C5A94C8FC16FEC812014B5A5E4B5A150F4B5AA24B5AA24B5A15FFA24A90C9FCA25C5D14 +07A2140FA25D141FA2143FA4147F5DA314FFA55BAC6D5BA2EC3FC06E5A395279D043>I< +913807FFC0027F13FC0103B67E010F15E090261FFC0113F8903A3FE0003FFCD97F80EB0F +FE49C76C7E48488048486E1380000717C04980120F18E0177FA2121F7FA27F7F6E14FF02 +E015C014F802FE4913806C7FDBC00313009238F007FE6C02F85B9238FE1FF86C9138FFBF +F06CEDFFE017806C4BC7FC6D806D81010F15E06D81010115FC010781011F81491680EBFF +E748018115C048D9007F14E04848011F14F048487F48481303030014F8484880161F4848 +020713FC1601824848157F173FA2171FA2170FA218F8A27F007F17F06D151FA26C6CED3F +E0001F17C06D157F6C6CEDFF806C6C6C010313006C01E0EB0FFE6C01FCEBFFFC6C6CB612 +F06D5D010F1580010102FCC7FCD9000F13C0364F7ACD43>I<91380FFF8091B512F80103 +14FE010F6E7E4901037F90267FF8007F4948EB3FF048496D7E484980486F7E4849808248 +17805A91C714C05A7013E0A218F0B5FCA318F8A618FCA46C5DA37EA25E6C7F6C5DA26C5D +6C7F6C6D137B6C6D13F390387FF803011FB512E36D14C30103028313F89039007FFE03EC +00401500A218F05EA3D801F816E0487E486C16C0487E486D491380A218005E5F4C5A91C7 +FC6C484A5A494A5A49495B6C48495BD803FC010F5B9027FF807FFEC7FC6C90B55A6C6C14 +F06D14C0010F49C8FC010013F0364F7ACD43>II<171F4D7E4D7EA24D7EA34C7FA24C7FA34C7FA34C7FA24C7FA34C +8083047F80167E8304FE804C7E03018116F8830303814C7E03078116E083030F814C7E03 +1F81168083033F8293C77E4B82157E8403FE824B800201835D840203834B800207835D84 +4AB87EA24A83A3DA3F80C88092C97E4A84A2027E8202FE844A82010185A24A820103854A +82010785A24A82010F855C011F717FEBFFFCB600F8020FB712E0A55B547BD366>65 +DI<932601FFFCEC01C0047F +D9FFC013030307B600F81307033F03FE131F92B8EA803F0203DAE003EBC07F020F01FCC7 +383FF0FF023F01E0EC0FF94A01800203B5FC494848C9FC4901F882494982494982494982 +4949824990CA7E494883A2484983485B1B7F485B481A3FA24849181FA3485B1B0FA25AA2 +98C7FC5CA2B5FCAE7EA280A2F307C07EA36C7FA21B0F6C6D1980A26C1A1F6C7F1C006C6D +606C6D187EA26D6C606D6D4C5A6D6D16036D6D4C5A6D6D4C5A6D01FC4C5A6D6DEE7F806D +6C6C6C4BC7FC6E01E0EC07FE020F01FEEC1FF80203903AFFE001FFF0020091B612C0033F +93C8FC030715FCDB007F14E0040101FCC9FC525479D261>IIII<9326 +01FFFCEC01C0047FD9FFC013030307B600F81307033F03FE131F92B8EA803F0203DAE003 +EBC07F020F01FCC7383FF0FF023F01E0EC0FF94A01800203B5FC494848C9FC4901F88249 +49824949824949824949824990CA7E494883A2484983485B1B7F485B481A3FA24849181F +A3485B1B0FA25AA298C8FC5CA2B5FCAE6C057FB712E0A280A36C94C7003FEBC000A36C7F +A36C7FA27E6C7FA26C7F6C7FA26D7E6D7F6D7F6D6D5E6D7F6D01FC93B5FC6D13FF6D6C6D +5C6E01F0EC07FB020F01FEEC1FF10203903AFFF001FFE0020091B6EAC07F033FEE001F03 +0703FC1307DB007F02E01301040149CAFC5B5479D26A>III75 DIII<93380FFFC00303B6FC031F15E092B712FC0203D9FC0013FF +020F01C0010F13C0023F90C7000313F0DA7FFC02007F494848ED7FFE4901E0ED1FFF4949 +6F7F49496F7F4990C96C7F49854948707F4948707FA24849717E48864A83481B804A8348 +1BC0A2481BE04A83A2481BF0A348497113F8A5B51AFCAF6C1BF86E5FA46C1BF0A26E5F6C +1BE0A36C6D4D13C0A26C6D4D1380A26C1B006C6D4D5A6E5E6C626D6C4C5B6D6D4B5B6D6D +4B5B6D6D4B5B6D6D4B5B6D6D4B90C7FC6D6D4B5A6D01FF02035B023F01E0011F13F0020F +01FC90B512C0020390B7C8FC020016FC031F15E0030392C9FCDB001F13E0565479D265> +II82 D<91260FFF80130791B500F8 +5B010702FF5B011FEDC03F49EDF07F9026FFFC006D5A4801E0EB0FFD4801800101B5FC48 +48C87E48488149150F001F824981123F4981007F82A28412FF84A27FA26D82A27F7F6D93 +C7FC14C06C13F014FF15F86CECFF8016FC6CEDFFC017F06C16FC6C16FF6C17C06C836C83 +6D826D82010F821303010082021F16801400030F15C0ED007F040714E01600173F050F13 +F08383A200788200F882A3187FA27EA219E07EA26CEFFFC0A27F6D4B13806D17006D5D01 +FC4B5A01FF4B5A02C04A5A02F8EC7FF0903B1FFFC003FFE0486C90B65AD8FC0393C7FC48 +C66C14FC48010F14F048D9007F90C8FC3C5479D24B>I<003FBC1280A59126C0003F9038 +C0007F49C71607D87FF8060113C001E08449197F49193F90C8171FA2007E1A0FA3007C1A +07A500FC1BE0481A03A6C994C7FCB3B3AC91B912F0A553517BD05E>IIII97 +DI<913801FFF8021FEBFF8091B612F0010315FC010F9038C00FFE903A1FFE0001 +FFD97FFC491380D9FFF05B4817C048495B5C5A485BA2486F138091C7FC486F1300705A48 +92C8FC5BA312FFAD127F7FA27EA2EF03E06C7F17076C6D15C07E6E140F6CEE1F806C6DEC +3F006C6D147ED97FFE5C6D6CEB03F8010F9038E01FF0010390B55A01001580023F49C7FC +020113E033387CB63C>I<4DB47E0407B5FCA5EE001F1707B3A4913801FFE0021F13FC91 +B6FC010315C7010F9038E03FE74990380007F7D97FFC0101B5FC49487F4849143F484980 +485B83485B5A91C8FC5AA3485AA412FFAC127FA36C7EA37EA26C7F5F6C6D5C7E6C6D5C6C +6D49B5FC6D6C4914E0D93FFED90FEFEBFF80903A0FFFC07FCF6D90B5128F0101ECFE0FD9 +003F13F8020301C049C7FC41547CD24B>I<913803FFC0023F13FC49B6FC010715C04901 +817F903A3FFC007FF849486D7E49486D7E4849130F48496D7E48178048497F18C0488191 +C7FC4817E0A248815B18F0A212FFA490B8FCA318E049CAFCA6127FA27F7EA218E06CEE01 +F06E14037E6C6DEC07E0A26C6DEC0FC06C6D141F6C6DEC3F806D6CECFF00D91FFEEB03FE +903A0FFFC03FF8010390B55A010015C0021F49C7FC020113F034387CB63D>IIII<137F497E +000313E0487FA2487FA76C5BA26C5BC613806DC7FC90C8FCADEB3FF0B5FCA512017EB3B3 +A6B612E0A51B547BD325>I +107 DIII<913801FFE0021F13FE91B612C0010315F0010F9038 +807FFC903A1FFC000FFED97FF86D6C7E49486D7F48496D7F48496D7F4A147F48834890C8 +6C7EA24883A248486F7EA3007F1880A400FF18C0AC007F1880A3003F18006D5DA26C5FA2 +6C5F6E147F6C5F6C6D4A5A6C6D495B6C6D495B6D6C495BD93FFE011F90C7FC903A0FFF80 +7FFC6D90B55A010015C0023F91C8FC020113E03A387CB643>I<903A3FF001FFE0B5010F +13FE033FEBFFC092B612F002F301017F913AF7F8007FFE0003D9FFE0EB1FFFC602806D7F +92C76C7F4A824A6E7F4A6E7FA2717FA285187F85A4721380AC1A0060A36118FFA2615F61 +6E4A5BA26E4A5B6E4A5B6F495B6F4990C7FC03F0EBFFFC9126FBFE075B02F8B612E06F14 +80031F01FCC8FC030313C092CBFCB1B612F8A5414D7BB54B>I<90397FE003FEB590380F +FF80033F13E04B13F09238FE1FF89139E1F83FFC0003D9E3E013FEC6ECC07FECE78014EF +150014EE02FEEB3FFC5CEE1FF8EE0FF04A90C7FCA55CB3AAB612FCA52F367CB537>114 +D<903903FFF00F013FEBFE1F90B7FC120348EB003FD80FF81307D81FE0130148487F4980 +127F90C87EA24881A27FA27F01F091C7FC13FCEBFFC06C13FF15F86C14FF16C06C15F06C +816C816C81C681013F1580010F15C01300020714E0EC003F030713F015010078EC007F00 +F8153F161F7E160FA27E17E07E6D141F17C07F6DEC3F8001F8EC7F0001FEEB01FE9039FF +C00FFC6DB55AD8FC1F14E0D8F807148048C601F8C7FC2C387CB635>I<143EA6147EA414 +FEA21301A313031307A2130F131F133F13FF5A000F90B6FCB8FCA426003FFEC8FCB3A9EE +07C0AB011FEC0F8080A26DEC1F0015806DEBC03E6DEBF0FC6DEBFFF86D6C5B021F5B0203 +13802A4D7ECB34>IIII<007FB500 +F090387FFFFEA5C66C48C7000F90C7FC6D6CEC07F86D6D5C6D6D495A6D4B5A6F495A6D6D +91C8FC6D6D137E6D6D5B91387FFE014C5A6E6C485A6EEB8FE06EEBCFC06EEBFF806E91C9 +FCA26E5B6E5B6F7E6F7EA26F7F834B7F4B7F92B5FCDA01FD7F03F87F4A486C7E4A486C7E +020F7FDA1FC0804A486C7F4A486C7F02FE6D7F4A6D7F495A49486D7F01076F7E49486E7E +49486E7FEBFFF0B500FE49B612C0A542357EB447>II<001F +B8FC1880A3912680007F130001FCC7B5FC01F0495B495D49495B495B4B5B48C75C5D4B5B +5F003E4A90C7FC92B5FC4A5B5E4A5B5CC7485B5E4A5B5C4A5B93C8FC91B5FC495B5D4949 +EB0F805B495B5D495B49151F4949140092C7FC495A485E485B5C485E485B4A5C48495B48 +15074849495A91C712FFB8FCA37E31357CB43C>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fe cmtt10 10.95 93 +/Fe 93 127 df<121C127FEAFF80B3EA7F00B2123EC7FCA8121C127FA2EAFF80A3EA7F00 +A2121C09396DB830>33 D<00101304007C131F00FEEB3F80A26C137FA248133FB2007E14 +00007C7F003C131E00101304191C75B830>I<903907C007C0A2496C487EA8011F131FA2 +02C05BA3007FB7FCA2B81280A36C16006C5D3A007F807F80A2020090C7FCA9495BA2003F +90B512FE4881B81280A36C1600A22701FC01FCC7FCA300031303A201F85BA76C486C5AA2 +29387DB730>I<1438147C14FCA4EB03FF011F13E090B512FC4880000780481580261FFE +FD13C09039F0FC3FE0D83FC0131FD87F80EB0FF001001307007E15F800FE14035A1507A3 +6CEC03F0A2007F91C7FC138013C0EA3FF0EA1FFE13FF6C13FF6C14E0000114F86C6C7F01 +1F7F01037F0100148002FD13C09138FC7FE0151FED0FF015070018EC03F8127E1501B4FC +A35AA26CEC03F07E01801307ED0FE0D83FC0131F01F0EB7FC0D81FFEB512806CB612006C +5C6C5CC614F0013F13C0D907FEC7FCEB00FCA5147C143825477BBE30>II +II<141E147F14FF5BEB03 +FEEB07FCEB0FF0EB1FE0EB3FC0EB7F80EBFF00485A5B12035B485A120F5BA2485AA2123F +5BA2127F90C7FCA412FEAD127FA47F123FA27F121FA26C7EA27F12076C7E7F12017F6C7E +EB7F80EB3FC0EB1FE0EB0FF0EB07FCEB03FEEB01FF7F147F141E184771BE30>I<127812 +FE7E7F6C7E6C7EEA0FF06C7E6C7E6C7E6C7EEB7F80133F14C0131FEB0FE014F01307A2EB +03F8A214FC1301A214FE1300A4147FAD14FEA4130114FCA2130314F8A2EB07F0A2130F14 +E0EB1FC0133F1480137FEBFF00485A485A485A485AEA3FE0485A485A90C7FC5A12781847 +78BE30>I<14E0497E497EA60038EC0380007EEC0FC0D8FF83EB3FE001C3137F9038F3F9 +FF267FFBFB13C06CB61280000FECFE00000314F86C5C6C6C13C0011F90C7FC017F13C048 +B512F04880000F14FE003FECFF80267FFBFB13C026FFF3F913E09038C3F87F0183133FD8 +7E03EB0FC00038EC0380000091C7FCA66D5A6D5A23277AAE30>I<143EA2147FAF007FB7 +FCA2B81280A36C1600A2C76CC8FCAF143EA229297DAF30>II<007FB612F0A2B712F8A36C15F0A225077B9E30>I<120F +EA3FC0EA7FE0A2EAFFF0A4EA7FE0A2EA3FC0EA0F000C0C6E8B30>I<16F01501ED03F8A2 +1507A2ED0FF0A2ED1FE0A2ED3FC0A2ED7F80A2EDFF00A24A5AA25D1403A24A5AA24A5AA2 +4A5AA24A5AA24A5AA24AC7FCA2495AA25C1303A2495AA2495AA2495AA2495AA2495AA249 +C8FCA2485AA25B1203A2485AA2485AA2485AA2485AA2485AA248C9FCA25AA2127CA22547 +7BBE30>I<14FE903807FFC0497F013F13F8497F90B57E48EB83FF4848C6138049137F48 +48EB3FC04848EB1FE049130F001F15F0491307A24848EB03F8A290C712014815FCA400FE +EC00FEAD6C14016C15FCA36D1303003F15F8A26D1307001F15F0A26D130F6C6CEB1FE0A2 +6C6CEB3FC06C6CEB7F806D13FF2601FF8313006CEBFFFE6D5B6D5B010F13E06D5BD900FE +C7FC273A7CB830>IIIII<000FB6128048 +15C05AA316800180C8FCAEEB83FF019F13C090B512F015FC8181D9FE0313809039F0007F +C049133F0180EB1FE06CC7120F000E15F0C81207A216F81503A31218127EA2B4FC150716 +F048140F6C15E06C141F6DEB3FC06D137F3A3FE001FF80261FFC0F13006CB55A6C5C6C5C +6C14E06C6C1380D90FFCC7FC25397BB730>II<127CB712FC16FEA416FC48C7EA +0FF816F0ED1FE0007CEC3FC0C8EA7F80EDFF00A24A5A4A5A5D14075D140F5D4A5AA24A5A +A24AC7FCA25C5C13015CA213035CA213075CA4495AA6131F5CA96D5A6DC8FC273A7CB830 +>I<49B4FC011F13F0017F13FC90B57E0003ECFF804815C048010113E03A1FF8003FF049 +131FD83FC0EB07F8A24848EB03FC90C71201A56D1303003F15F86D13076C6CEB0FF06C6C +EB1FE0D807FCEB7FC03A03FF83FF806C90B512006C6C13FC011F13F0497F90B512FE4880 +2607FE0013C0D80FF8EB3FE0D81FE0EB0FF04848EB07F8491303007F15FC90C712014815 +FE481400A66C14016C15FC6D1303003F15F86D1307D81FF0EB1FF06D133F3A0FFF01FFE0 +6C90B512C06C1580C6ECFE006D5B011F13F0010190C7FC273A7CB830>I<49B4FC010F13 +E0013F13F890B57E4880488048010113803A0FFC007FC0D81FF0EB3FE04848131F49EB0F +F048481307A290C7EA03F85A4815FC1501A416FEA37E7E6D1303A26C6C13076C6C130F6D +133FD80FFC13FF6CB6FC7E6C14FE6C14F9013FEBE1FC010F138190380060011400ED03F8 +A2150716F0150F000F15E0486C131F486CEB3FC0157FEDFF804A1300EC07FE391FF01FFC +90B55A6C5C6C5C6C1480C649C7FCEB3FF0273A7CB830>I<120FEA3FC0EA7FE0A2EAFFF0 +A4EA7FE0A2EA3FC0EA0F00C7FCAF120FEA3FC0EA7FE0A2EAFFF0A4EA7FE0A2EA3FC0EA0F +000C276EA630>II<16F01503ED07F8151F157FEDFFF0 +14034A13C0021F138091383FFE00ECFFF8495B010713C0495BD93FFEC7FC495A3801FFF0 +485B000F13804890C8FCEA7FFC5BEAFFE05B7FEA7FF87FEA1FFF6C7F000313E06C7F3800 +7FFC6D7E90380FFF806D7F010113F06D7FEC3FFE91381FFF80020713C06E13F01400ED7F +F8151F1507ED03F01500252F7BB230>I<007FB7FCA2B81280A36C16006C5DCBFCA7003F +B612FE4881B81280A36C1600A229157DA530>I<1278127EB4FC13C07FEA7FF813FEEA1F +FF6C13C000037F6C13F86C6C7EEB1FFF6D7F010313E06D7F9038007FFC6E7E91380FFF80 +6E13C0020113F080ED3FF8151F153FEDFFF05C020713C04A138091383FFE004A5A903801 +FFF0495B010F13804990C7FCEB7FFC48485A4813E0000F5B4890C8FCEA7FFE13F8EAFFE0 +5B90C9FC127E1278252F7BB230>III<147F4A7EA2497FA4497F14F7A401077F14E3A301 +0F7FA314C1A2011F7FA490383F80FEA590387F007FA4498049133F90B6FCA34881A39038 +FC001F00038149130FA4000781491307A2D87FFFEB7FFFB56CB51280A46C496C13002939 +7DB830>I<007FB512F0B612FE6F7E82826C813A03F8001FF815076F7E1501A26F7EA615 +015EA24B5A1507ED1FF0ED7FE090B65A5E4BC7FC6F7E16E0829039F8000FF8ED03FC6F7E +1500167FA3EE3F80A6167F1700A25E4B5A1503ED1FFC007FB6FCB75A5E16C05E6C02FCC7 +FC29387EB730>I<91387F803C903903FFF03E49EBFC7E011F13FE49EBFFFE5B9038FFE0 +7F48EB801F3903FE000F484813075B48481303A2484813015B123F491300A2127F90C8FC +167C16005A5AAC7E7EA2167C6D14FE123FA27F121F6D13016C6C14FCA26C6CEB03F86D13 +076C6CEB0FF03901FF801F6C9038E07FE06DB512C06D14806D1400010713FC6D13F09038 +007FC0273A7CB830>I<003FB512E04814FCB67E6F7E6C816C813A03F8007FF0ED1FF815 +0F6F7E6F7E15016F7EA2EE7F80A2163F17C0161FA4EE0FE0AC161F17C0A3163F1780A216 +7F17005E4B5A15034B5A150F4B5AED7FF0003FB65A485DB75A93C7FC6C14FC6C14E02B38 +7FB730>I<007FB7FCB81280A47ED803F8C7123FA8EE1F0093C7FCA4157C15FEA490B5FC +A6EBF800A4157C92C8FCA5EE07C0EE0FE0A9007FB7FCB8FCA46C16C02B387EB730>I<00 +3FB712804816C0B8FCA27E7ED801FCC7121FA8EE0F8093C7FCA5153E157FA490B6FCA690 +38FC007FA4153E92C8FCAE383FFFF8487FB5FCA27E6C5B2A387EB730>I<02FF13F00103 +EBC0F8010F13F1013F13FD4913FF90B6FC4813C1EC007F4848133F4848131F49130F485A +491307121F5B123F491303A2127F90C7FC6F5A92C8FC5A5AA892B5FC4A14805CA26C7F6C +6D1400ED03F8A27F003F1407A27F121F6D130F120F7F6C6C131FA2D803FE133F6C6C137F +ECC1FF6C90B5FC7F6D13FB010F13F30103EBC1F0010090C8FC293A7DB830>I<3B3FFF80 +0FFFE0486D4813F0B56C4813F8A26C496C13F06C496C13E0D803F8C7EAFE00B290B6FCA6 +01F8C7FCB3A23B3FFF800FFFE0486D4813F0B56C4813F8A26C496C13F06C496C13E02D38 +7FB730>I<007FB6FCB71280A46C1500260007F0C7FCB3B3A8007FB6FCB71280A46C1500 +213879B730>I<49B512F04914F85BA27F6D14F090C7EAFE00B3B3123C127EB4FCA24A5A +1403EB8007397FF01FF86CB55A5D6C5C00075C000149C7FC38003FF025397AB730>II<383FFFF8487FB57EA26C5B6C5BD801FCC9FCB3B0EE0F80EE1FC0A9003FB7FC5AB8 +FCA27E6C16802A387EB730>III<90383FFFE048B512FC000714FF4815804815C04815 +E0EBF80001E0133FD87F80EB0FF0A290C71207A44815F8481403B3A96C1407A26C15F0A3 +6D130FA26D131F6C6CEB3FE001F813FF90B6FC6C15C06C15806C1500000114FCD8003F13 +E0253A7BB830>I<007FB512F0B612FE6F7E16E0826C813903F8003FED0FFCED03FE1501 +6F7EA2821780163FA6167F17005EA24B5A1503ED0FFCED3FF890B6FC5E5E16804BC7FC15 +F001F8C9FCB0387FFFC0B57EA46C5B29387EB730>I<90383FFFE048B512FC000714FF48 +15804815C04815E0EBF80001E0133F4848EB1FF049130F90C71207A44815F8481403B3A8 +147E14FE6CEBFF076C15F0EC7F87A2EC3FC7018013CF9038C01FFFD83FE014E0EBF80F90 +B6FC6C15C06C15806C1500000114FCD8003F7FEB00016E7EA21680157F16C0153F16E015 +1F16F0150FED07E025467BB830>I<003FB57E4814F0B612FC15FF6C816C812603F8017F +9138003FF0151F6F7E15071503821501A515035E1507150F4B5A153F4AB45A90B65A5E93 +C7FC5D8182D9F8007FED3FE0151F150F821507A817F8EEF1FCA53A3FFF8003FB4801C0EB +FFF8B56C7E17F06C496C13E06C49EB7FC0C9EA1F002E397FB730>I<90390FF803C0D97F +FF13E048B512C74814F74814FF5A381FF80F383FE001497E4848137F90C7123F5A48141F +A2150FA37EED07C06C91C7FC7F7FEA3FF0EA1FFEEBFFF06C13FF6C14E0000114F86C8001 +1F13FF01031480D9003F13C014019138007FE0151FED0FF0A2ED07F8A2007C140312FEA5 +6C140716F07F6DEB0FE06D131F01F8EB3FC001FF13FF91B51280160000FD5CD8FC7F13F8 +D8F81F5BD878011380253A7BB830>I<003FB712C04816E0B8FCA43AFE003F800FA8007C +ED07C0C791C7FCB3B1011FB5FC4980A46D91C7FC2B387EB730>I<3B7FFFC007FFFCB56C +4813FEA46C496C13FCD803F8C7EA3F80B3B16D147F00011600A36C6C14FE6D13016D5CEC +800390393FE00FF890391FF83FF06DB55A6D5C6D5C6D91C7FC9038007FFCEC1FF02F3980 +B730>III<3A3FFF01FF +F84801837F02C77FA202835B6C01015B3A01FC007F806D91C7FC00005C6D5BEB7F01EC81 +FCEB3F8314C3011F5B14E7010F5B14FF6D5BA26D5BA26D5BA26D90C8FCA4497FA2497FA2 +815B81EB0FE781EB1FC381EB3F8181EB7F0081497F49800001143F49800003141F498000 +07140FD87FFEEB7FFFB590B5128080A25C6C486D130029387DB730>II<001FB612 +FC4815FE5AA490C7EA03FCED07F816F0150FED1FE016C0153FED7F80003E1500C85A4A5A +5D14034A5A5D140F4A5A5D143F4A5A92C7FC5C495A5C1303495A5C130F495A5C133F495A +91C8FC5B4848147C4914FE1203485A5B120F485A5B123F485A90B6FCB7FCA46C15FC2738 +7CB730>I<007FB5FCB61280A4150048C8FCB3B3B3A5B6FC1580A46C140019476DBE30>I< +127CA212FEA27EA26C7EA26C7EA26C7EA26C7EA26C7EA26C7EA212017FA26C7EA26D7EA2 +6D7EA26D7EA26D7EA26D7EA26D7EA2130180A26D7EA26E7EA26E7EA26E7EA26E7EA26E7E +A26E7EA2140181A26E7EA2ED7F80A2ED3FC0A2ED1FE0A2ED0FF0A2ED07F8A21503A2ED01 +F0150025477BBE30>I<007FB5FCB61280A47EC7123FB3B3B3A5007FB5FCB6FCA46C1400 +19477DBE30>I<1307EB1FC0EB7FF0497E000313FE000FEBFF80003F14E0D87FFD13F039 +FFF07FF8EBC01FEB800F38FE0003007CEB01F00010EB00401D0E77B730>I<007FB612F0 +A2B712F8A36C15F0A225077B7D30>I97 +DII<913801FFE04A7F5C +A28080EC0007AAEB03FE90381FFF874913E790B6FC5A5A481303380FFC00D81FF0133F49 +131F485A150F4848130790C7FCA25AA25AA87E6C140FA27F003F141F6D133F6C7E6D137F +390FF801FF2607FE07EBFFC06CB712E06C16F06C14F76D01C713E0011F010313C0D907FC +C8FC2C397DB730>I<49B4FC010713E0011F13F8017F7F90B57E488048018113803A07FC +007FC04848133FD81FE0EB1FE0150F484814F0491307127F90C7FCED03F85A5AB7FCA516 +F048C9FC7E7EA27F003FEC01F06DEB03F86C7E6C7E6D1307D807FEEB1FF03A03FFC07FE0 +6C90B5FC6C15C0013F14806DEBFE00010713F8010013C0252A7CA830>IIII< +14E0EB03F8A2497EA36D5AA2EB00E091C8FCA9381FFFF8487F5AA27E7EEA0001B3A9003F +B612C04815E0B7FCA27E6C15C023397AB830>III<387FFFF8B57EA47EEA0001B3B3A8007FB612F0B712F8A46C15F025387BB7 +30>I<02FC137E3B7FC3FF01FF80D8FFEF01877F90B500CF7F15DF92B57E6C010F138726 +07FE07EB03F801FC13FE9039F803FC01A201F013F8A301E013F0B3A23C7FFE0FFF07FF80 +B548018F13C0A46C486C01071380322881A730>II< +49B4FC010F13E0013F13F8497F90B57E0003ECFF8014013A07FC007FC04848EB3FE0D81F +E0EB0FF0A24848EB07F8491303007F15FC90C71201A300FEEC00FEA86C14016C15FCA26D +1303003F15F86D13076D130F6C6CEB1FF06C6CEB3FE06D137F3A07FF01FFC06C90B51280 +6C15006C6C13FC6D5B010F13E0010190C7FC272A7CA830>II<49B413F8010FEBC1FC013F13F14913FD48B6FC5A4813 +81390FFC007F49131F4848130F491307485A491303127F90C7FC15015A5AA77E7E15037F +A26C6C1307150F6C6C131F6C6C133F01FC137F3907FF01FF6C90B5FC6C14FD6C14F9013F +13F1010F13C1903803FE0190C7FCAD92B512F84A14FCA46E14F82E3C7DA730>II<90381FFC1E48B5129F000714FF5A5A5A387FF007EB800100FEC7FC4880A46C143E +007F91C7FC13E06CB4FC6C13FC6CEBFF806C14E0000114F86C6C7F01037F9038000FFF02 +001380007C147F00FEEC1FC0A2150F7EA27F151F6DEB3F806D137F9039FC03FF0090B6FC +5D5D00FC14F0D8F83F13C026780FFEC7FC222A79A830>III<3B3F +FFC07FFF80486DB512C0B515E0A26C16C06C496C13803B01F80003F000A26D130700005D +A26D130F017E5CA2017F131F6D5CA2EC803F011F91C7FCA26E5A010F137EA2ECE0FE0107 +5BA214F101035BA3903801FBF0A314FF6D5BA36E5A6E5A2B277EA630>I<3B3FFFC01FFF +E0486D4813F0B515F8A26C16F06C496C13E0D807E0C7EA3F00A26D5C0003157EA56D14FE +00015DEC0F80EC1FC0EC3FE0A33A00FC7FF1F8A2147DA2ECFDF9017C5C14F8A3017E13FB +A290393FF07FE0A3ECE03FA2011F5C90390F800F802D277FA630>I<3A3FFF81FFFC4801 +C37FB580A26C5D6C01815BC648C66CC7FC137FEC80FE90383F81FC90381FC3F8EB0FE3EC +E7F06DB45A6D5B7F6D5B92C8FC147E147F5C497F81903803F7E0EB07E790380FE3F0ECC1 +F890381F81FC90383F80FE90387F007E017E137F01FE6D7E48486D7E267FFF80B5FCB500 +C1148014E3A214C16C0180140029277DA630>I<3B3FFFC07FFF80486DB512C0B515E0A2 +6C16C06C496C13803B01FC0003F000A2000014076D5C137E150F017F5C7F151FD91F805B +A214C0010F49C7FCA214E00107137EA2EB03F0157C15FCEB01F85DA2EB00F9ECFDF0147D +147FA26E5AA36E5AA35DA2143F92C8FCA25C147EA2000F13FE486C5AEA3FC1EBC3F81387 +EB8FF0EBFFE06C5B5C6C90C9FC6C5AEA01F02B3C7EA630>I<001FB612FC4815FE5AA316 +FC90C7EA0FF8ED1FF0ED3FE0ED7FC0EDFF80003E491300C7485A4A5A4A5A4A5A4A5A4A5A +4A5A4990C7FC495A495A495A495A495A495A4948133E4890C7127F485A485A485A485A48 +5A48B7FCB8FCA46C15FE28277DA630>II< +127CA212FEB3B3B3AD127CA207476CBE30>II<017C13 +3848B4137C48EB80FE4813C14813C348EBEFFC397FEFFFF0D8FF8713E0010713C0486C13 +80D87C0113003838007C1F0C78B730>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Ff cmbx12 20.74 17 +/Ff 17 117 df48 DI<9238 +0FFFE04AB67E020F15F0027F15FE49B87E4917E0010F17F8013F8349D9C01F14FF9027FF +FC0001814801E06D6C80480180021F804890C86C8048486F8048486F8001FF6F804801C0 +6E8002F081486D18806E816E18C0B5821BE06E81A37214F0A56C5BA36C5B6C5B6C5B0003 +13C0C690C9FC90CA15E060A34E14C0A21B80601B0060626295B55A5F624D5C624D5C4D91 +C7FC614D5B4D13F04D5B6194B55A4C49C8FC4C5B4C5B4C13E04C5B604C90C9FCEE7FFC4C +5A4B5B4B5B4B0180EC0FF04B90C8FC4B5A4B5A4B48ED1FE0EDFFE04A5B4A5B4A90C9FC4A +48163F4A5ADA3FF017C05D4A48167F4A5A4990CA12FFD903FC160749BAFC5B4919805B5B +90BBFC5A5A5A5A481A005A5ABCFCA462A44C7176F061>I<923801FFFE033FEBFFF84AB7 +FC020F16E0023F16F84A16FE49B97E49DA003F80010F01F0010714F04901800101804948 +C880D97FF86F7F02E081496C834801FC6F148014FF486E6E14C08181481AE081A96C5C1B +C06C4A5C6C5C6D90C815806D5AD90FF85D90CA150062606295B55A4D5C624D5C4D5C4D91 +C7FC4D13FC4D5B4CB512E0047F1480037FB548C8FC92B612F818C018F8F0FF806F15F092 +C7003F13FC050713FF050114C071807213F8727F727F867214801BC07214E01BF0A27214 +F81BFCA37214FEA31BFFEBFF80000313E0487F001F13FC487FA2487FA2B67EA31BFEA360 +1BFCA292C8FC6C1AF84A5D4A18F06C494B14E05C6C01C04B14C06C90C915804E14006C6D +4B5B6C01F092B55A6C01FC4A5C27007FFFC001075C6D01FE013F14C0010F90B85A6D4DC7 +FC010117F8D9003F16E0020F93C8FC020015F0030749C9FC507378F061>II<0170187001FEEF01F86D6C160F02F8167FDAFF80 +EC07FF03FE49B5FC92B85A6262A26297C7FC61616119E061614EC8FC18F86018C095C9FC +17F817C0020701F8CAFC91CDFCB0923801FFFC031FEBFFE092B612FC020315FF020F16C0 +4A16F0027FD9003F7FDAFFF0010F13FE038001037F4AC76C8002F86E804A6F7F4A6F7F4A +834A6F7F91C980137E017C707F90CAFC1B80A21BC0A2841BE0A51BF0A313FE3803FF8000 +0F7F4813F0487F5A80B5FCA41BE0A44E14C05C7E4A18805C4A5D6C90C9150001E0606C6C +5E6D606C6C4C5B7F000794B55A6C6C6C4A5C6C6D4A5C6E4A5C26007FF8021F49C7FC6DB4 +027F5B6DD9F007B55A6D90B712E0010317806D4CC8FC6D6C15F8021F15C002034AC9FCDA +003F13804C7376F061>I<94381FFF800403B512F8043F14FE4BB77E030782031F16F003 +7F8292B5D8FC017F02039139C0001FFE4A49C7EA07FF021F01F8804A496E13804A01C014 +0F91B548023F13C04991C85A494992B5FC49494A14E0495B495E5D5B495BA290B55A5A5D +487114C0A24891C91480731300735A48F00FF896C8FC485BA45AA44849903803FFE0041F +13FE047FEBFFC04BB612F84B81030F15FFB590261FF8038092273FE0007F13E00480011F +7F4BC76C7F03FE6E7F4B6E7FDAFDF86E7FDAFFF017804B6E14C01BE05D7313F05D1BF8A2 +92C914FC85A21BFE5CA31BFFA26C5BA87EA4807EA21BFE7EA37E1BFC6E5E6C1AF8A27E6F +17F06C95B512E06D7F1BC06D6D4A14806D4C1400816D6D4A5B6D6D4A5B6D01FF4A13F001 +006E017F5B6ED9F007B55A6E90B7C7FC020F5E020316F86E16E0DA003F1580030702FCC8 +FCDB007F1380507378F061>II<93B57E031F14FC92B77E020316F0020F16FC023F16FF4A8349B5D8 +800314E04901F8C7003F7F4901C0020F7F4990C800037FD91FFC6F7F49486F6C7E137F4A +7013804948827313C05A4A821BE05AA285487FA38080806E5E8003C017C08103F85D03FE +17806F6C5C6C6F160004F05C04FC4A5A6C6F5D706C13FFDDE0015B6CDCF8035BDDFC0F13 +C06DDBFF1F5B6D93B5C7FC19FC6D17F06D5F6D17806D17E06D836D6C16FC6E16FF020F83 +6E17E06E83020F83023F8391B97E4984010701F0178049D9C07F16C0013FD9801F16E049 +EB00074948010116F048497F4849023F15F84849140F4A6E15FC48160148496E6C14FE4A +151F488391C9120348050014FF193F49838500FF84854983A28586A3861BFEA27FA2007F +1AFC7F1A7F1BF86C7FF2FFF06C7F6E4C13E06C6D4C13C06C6D5E6E4C13806C6D4C13006C +6D6CED7FFE6C02E04A485A013F01FC020F13F06D9026FFC001B55A010791B712806D95C7 +FC010017FC021F16F002071680DA007F02FCC8FC030191C9FC507378F061>I<93B5FC03 +1F14F092B612FE02076F7E021F16E04A16F891B87E49DAF00713FF0107DA0001804901FC +6D6C7F49496E7F49496E7F49496E7F90B5486E7F484A8048854891C86C7FA2487114805C +481AC0A2487213E0A2484918F0A31BF8A2B5FCA27313FCA51BFEA71BFF61A27EA396B6FC +7EA2806C5FA27E606C7F607E6C6E5C6CEF1FBF6D6DEC3F3F6D6D147F6D6D14FE6D6DEB01 +FC6D01FE130701019039FFC01FF86D91B500F014FE023F15C06E15800203ECFE00DA007F +13F8030713C092C9FC4F13FCA41BF8A31BF0D91FF093B5FCEB7FFC496C18E0487F486E17 +C06048801B804E1400A26260624E5B4B5C626C91C8485B4A4B5B4A92B55A6C01F04A91C7 +FC02804A5B6C01E0020F5B6D6C023F13F002FE91B55A90273FFFE00F5C6D90B7C8FC0107 +16FC6D16F0010016C0023F92C9FC020714F09126007FFECAFC507378F061>I<96267FFF +E01670063FB6ED01F80503B700F01403053F04FC14074CB96C130F040706E0131F043F72 +133F93BA00FC137F0303DC00076D13FF030F03C09039003FFF814B02FCC8000713C3037F +02E0030113F792B600806F6CB5FC02034ACA121F4A02F8834A02E0834A4A1701027F4A83 +91B548CC7E494A85495C4C854988494A85494A85495C8A4991CDFC90B54886A2484A1B7F +A2481E3F5D481E1F5D5A1F0FA2485CA3481E075DA2F703F0489BC7FCA45DA2B6FCB27EA2 +81A47EA2F703F06FF307F87EA36C80A21F0F7E6F1CF07E6F1B1F7E20E06C6E1B3F816DF5 +7FC06D80F7FF806D806D6E4F13006D6E616D525A826D6E4F5A6D6E4F5A6E6D6C4E5A021F +6EF0FFE06E6E4D5B6E02F84D5B6E02FE050F90C7FC02006E6CEE3FFE6F02F0EEFFFC031F +02FE03035B6FDAFFC0021F13E0030303FF0103B55A030093B7C8FC043F18FC040718F004 +0118C0DC003F94C9FC050316F8DD003F1580DE007F01F0CAFC757A75F78C>67 +D<92383FFFF80207B612E0027F15FC49B87E010717E0011F83499026F0007F13FC4948C7 +000F7F90B502036D7E486E6D806F6D80727F486E6E7F8486727FA28684A26C5C72806C5C +6D90C8FC6D5AEB0FF8EB03E090CAFCA70507B6FC041FB7FC0303B8FC157F0203B9FC021F +ECFE0391B612800103ECF800010F14C04991C7FC017F13FC90B512F04814C0485C4891C8 +FC485B5A485B5C5A5CA2B5FC5CA360A36E5DA26C5F6E5D187E6C6D846E4A48806C6D4A48 +14FC6C6ED90FF0ECFFFC6C02E090263FE07F14FE00019139FC03FFC06C91B6487E013F4B +487E010F4B1307010303F01301D9003F0280D9003F13FC020101F8CBFC57507ACE5E>97 +D<93387FFF80030FB512FC037FECFF804AB712E0020716F8021F16FE027FD9F8077F49B5 +D8C000804991C7003F13E04901FC020F7F49496E7F49498049496E7F49496E7F90B55A48 +727E92C914804884485B1BC048841BE0485BA27313F05AA25C5AA21BF885A2B5FCA391BA +FCA41BF002F8CCFCA67EA3807EA47E806CF103F0F207F86C7F1A0F6C6E17F06C191F6F17 +E06C6E163F6D6DEE7FC06D6D16FF6D6D4B13806D6D4B13006D6D6CEC0FFE6D02E0EC3FFC +6D02F8ECFFF86D9126FFC00F5B023F91B65A020F178002034CC7FC020016F8031F15E003 +0392C8FCDB000F13E04D507BCE58>101 D<903801FFFCB6FCA8C67E131F7FB3AD95380F +FFE095B512FE05036E7E050F15E0053F15F84D81932701FFF01F7F4CD900077FDC07FC6D +80DC0FF06D80DC1FC07F4C48824CC8FC047E6F7F5EEDFDF85E03FF707F5EA25EA25EA293 +C9FCA45DB3B3A6B8D8E003B81280A8617879F76C>104 D<902601FFFCEC7FFEB6020FB5 +12F0057F14FE4CB712C0040716F0041F82047F16FE93B5C66C7F92B500F0010F14C0C66C +0380010380011F4AC76C806D4A6E8004F06F7F4C6F7F4C6F7F4C8193C915804B7014C086 +1DE0A27414F0A27414F8A47513FCA57513FEAF5113FCA598B512F8A31DF0621DE0621DC0 +621D806F5E701800704B5B505B704B5B7092B55A04FC4A5C704A5C706C010F5C05E0013F +49C7FC9227FE7FFC01B55A70B712F0040F16C0040393C8FC040015F8053F14C0050301F0 +C9FC94CCFCB3A6B812E0A85F6F7ACD6C>112 D<902601FFF8EB07FEB691383FFFC094B5 +12F00403804C14FE4C8093261FFC3F138093263FE07F13C0DC7F80B5FCC66C5D011FDAFE +0114E06DEBF9FC16F815FB16F016E015FF16C07114C05E72138095381FFE0093C76C5AF0 +01E095C8FCA25DA65DB3B3A2B812F8A8434E7ACD4F>114 D<15FFA75CA55CA45CA25CA2 +5CA25CA25C91B5FCA25B5B5B131F5B90B9FC120FBAFCA6D8000791C9FCB3B3A3F01FE0AE +183F7014C07F187F7014806D16FF826D4B13006E6D485AEEFE0F6E90B55A020F5D6E5D02 +0115C06E6C5C031F49C7FC030113F03B6E7CEC4B>116 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fg cmsl10 10.95 38 +/Fg 38 91 df<007FB5FCA2B512FEA418067C961E>45 D<121EEA3F80EA7FC012FFA413 +80EA7F00123C0A0A788919>I<1703EF0780170FA2EF1F00A2173EA25FA25FA24C5AA24C +5AA24C5AA24C5AA24CC7FCA2163E167E167C5EA24B5AA24B5AA24B5AA24B5AA24BC8FCA2 +153EA25DA25DA24A5AA24A5AA24A5AA24A5AA24AC9FCA2143EA25CA25CA2495AA2495AA2 +495AA2495A131F91CAFC133EA25BA25BA2485AA2485AA2485AA2485AA248CBFCA2123EA2 +5AA25AA21270315B7FC32D>II<157015F014011407143F903803FFE0137FEBFF +CFEBF80F1300141F15C0A5143F1580A5147F1500A55C5CA513015CA513035CA513075CA5 +130F5CA3131F497EB612F8A31D3D78BC2D>III<16 +1C163C167CA216FCED01F815031507150FA2151DED3BF0157315E315C31401EC03839138 +0707E0140E141CA2143814709138E00FC0EB01C014801303EB0700130E49EB1F805B1330 +13705B485A4848EB3F0090C7FC5A120E5A5A48147E1260B8FCA3C73801FE00A25DA41403 +A25DA314074A7E0107B512F8A3283E7BBD2D>I<01061403D90780131F90390FF801FE91 +B512FC16F816F016E0168049EBFE0015F890381C7FC091C8FCA3133C1338A513781370A2 +EC1FE0ECFFF8903873E03E9038FF001F01FCEB0F804914C049EB07E04914F049130390C7 +FC16F8A61507A21206EA3F80487EA2150F00FF15F0A24914E090C7121F00FC15C000F014 +3F00701580ED7F0012786C14FE4A5A6C495A390F800FE03907E03FC06CB5C7FCC613FCEB +1FE0283F7ABC2D>IIIII<13F0EA01FC1203EA07 +FEA313FCA2EA03F8EA01E0C7FCB3121EEA3F80EA7FC012FFA41380EA7F00123C0F2778A6 +19>I<17E016011603831607A2160FA2161F83163FA2167F167716F7EEE7FCED01E316C3 +150316831507EE03FEED0F01150E151E151C153C03387FED7800157015F05D4A4880177F +4A5AA24AC7FCA2020E81173F5C021FB6FC5CA20270C7EA3FE0171F5CA2495AA249488117 +0F49C8FCA2130EA24982013C1507A2137CD801FE4B7E2607FF80EC3FFEB500F00107B512 +FC19F85E3E417DC044>65 D<013FB7FC18E018FC903B007FE00007FE6E48903801FF8094 +38007FC05DF03FE0F01FF0A3027F16F892C8FCA54A16F04A153F19E0187F19C0F0FF8001 +014B13004A4A5A4D5AEF1FF04D5ADC03FFC7FC49B612F8EFFF8002F8C7EA3FE0EF0FF0EF +07FC717E010715014A81711380A319C0130F5CA5011F4B13805C19005F601707013F4B5A +4A4A5A4D5A4D5A017F913801FF8001FF020F90C7FCB812FC17F094C8FC3D3E7DBD40>I< +DCFFC01338030F01F01378037F01FC13F0913A01FF803F01913A07FC000781DA1FE0EB03 +C3DA7FC0EB01E74AC812FF4948ED7FE0D907FC153F495A4948151F495A4948150F494816 +C018074890C9FC485AA2485A000F1880491603121FA248481607A295C7FC485AA412FF5B +A75BA2181C183C1838A27F007F1778187018F0003F5F6D150160001F16036C6C4B5A95C7 +FC6C6C5D6C6C151E6C6C5D6C6C15F86D6C495A6D6CEB07C0D91FF0EB1F80D907FE01FEC8 +FC0101B512F86D6C13E0DA07FEC9FC3D4276BF42>I<013FB7FC18E018F8903B007FF000 +0FFE6E48EB01FF9438007FC04B6E7E180F85727E727E147F4B6E7EA2727EA302FF178092 +C9FCA54918C05CA41A8013034A5DA41A0013074A5DA261A24E5A130F4A5E180F61181F61 +011F4C5A5C4E5A4EC7FC4D5A4D5A013F4B5A4A4A5AEF3FE0EF7F80017F4A48C8FC01FFEC +1FFCB812F0178004FCC9FC423E7DBD45>I<013FB812F8A39026007FF0C7127F6E48140F +18034B14011800A31978147F4B1570A502FF147092C7FCA3190017F0495D4A1301A21607 +161F91B6FC495DA29138FC003F160F1607160301075D5CA219E0180119C0010FEC07004A +90C712031980A218071900011F5E5C181EA2183E183C013F167C4A15FC4D5A1707017F15 +1F01FF4AB45AB9FCA2603D3E7DBD3E>I<013FB812E0A3903A007FF000016E48EB003F18 +0F4B14071803A31801147F4B15C0A514FF92C71270A395C7FC17F0495D5C160116031607 +161F49B65AA39138FC003F160F160701075D4A1303A5010F4AC8FC5C93C9FCA4131F5CA5 +133F5CA3137FEBFFF0B612F8A33B3E7DBD3B>I<4BB46C1370031F01F013F0037F9038FC +01E0913A03FF807E03913A0FF8000F83DA1FE0EB07C7DA7F80EB01EF4AC812FFD903FE16 +C04948157F4948153F495A4948151F495A4948168091C9120F5A485AA2485A000F180049 +82121FA248485EA295C7FC485AA412FF5BA6043FB512E05BA29339001FFC00715AA2607F +127FA2171F123F6D5EA2121F7F000F163F6C7E6C6C4B5A7F6C6C15FF6C6DEB01EFD93FC0 +EB07C7D91FF0EB1F87D907FE9038FE03800101B5EAF8016D6C01E0C8FCDA07FEC9FC3C42 +76BF47>I<013FB5D8F807B6FC04F015FEA29026007FF0C7380FFE006E486E5AA24B5DA4 +180F147F4B5DA4181F14FF92C85BA4183F5B4A5EA491B8FC5B6102FCC8127FA318FF1307 +4A93C7FCA45F130F4A5DA41703131F4A5DA41707133F4A5DA3017F150F496C4A7EB6D8E0 +1FB512FC6115C0483E7DBD44>I<011FB512FC5BA29039003FF8006E5AA25DA5143F5DA5 +147F5DA514FF92C7FCA55B5CA513035CA513075CA5130F5CA5131F5CA3133F497E007FB5 +12F0A2B6FC263E7EBD21>I<013FB500F8010FB5FC4C5BA29026007FF0C7000313E06E48 +6E130019FC4B15F04E5A4E5A4E5A061EC7FC027F5D4B5C4D5A4D5AEF07804DC8FC02FF14 +1E92C7127C5FEE01E04C5A4C5A49021FC9FC4A5B5E4C7E5D03077F01035B9139FC1F3FE0 +153C4B6C7E15F09139FFE00FF84913C092380007FC5C4A6D7E5C707E130F4A6D7F84177F +717EA2011F6F7E5C717EA2717EA2013F6F7E5C84A2017F83496C4A13E0B600E0017F13FF +A24B90B6FC483E7DBD47>75 D<013FB512FEA25E9026007FF8C8FCEC3FE0A25DA5147F5D +A514FF92C9FCA55B5CA513035CA513075CA21838A21870130F5CA218E0A3011F15014A15 +C01703A21707EF0F80013F151F4A143F177FEFFF00017F140301FF143FB9FC5FA2353E7D +BD39>I<90263FFFF093381FFFF85013F0629026007FF8EFF000023F4D5AA2023B933801 +DFC0A2DA39FCED039FA2F1073F14790271040E5BEC70FE191C19381A7F02F01670DAE07F +94C7FC19E0A2F001C06201016D6C495A02C05FF00700A2180E6F6C14010103161C028003 +385BA218706F7EF0E00313070200DA01C05BA2923907F00380A294380700075B010E9026 +03F80E5C5FA25F190F011E6D6C5A011C605FA2EEFDC0DB00FF141F013C5D013860013C92 +C7FC017C5C01FE027E143F2607FF80017C4A7EB500FC037FB512E004785E4A1338553E7C +BD53>I<90263FFFE0023FB5FC6F16FEA29026003FF8020313C0021F030013004A6C157C +023B163C6F15381439810238167802787FDA707F157082153F82031F15F002F07FDAE00F +5D8215078203031401010180DAC0015D82811780047F1303010315C04A013F5C17E0161F +17F0040F1307010715F891C7000791C7FC17FC160317FE04015B4915FF010E6E130E188E +177F18CEEF3FDE011E16FE011C6F5AA2170FA21707133C01386F5A133C017C150113FE26 +07FF801400B512FC18705C483E7DBD44>I<923803FF80031F13F09238FE01FE913903F0 +003FDA0FC0EB1FC0DA3F80EB07E0027EC76C7E49486E7E49488149486E7E4948157F495A +013F17804948ED3FC049C9FCA24848EE1FE012035B000718F05B120FA2485A19F8123F5B +A2127FA219F04848163FA5F07FE0A35BF0FFC0A219805F19007F4D5A127F4D5A60003F16 +0F6D5E001F4C5A4D5A6C6C4B5A95C7FC6C6C15FE00034B5A6C6C4A5A6C6C4A5A017FEC1F +C06D6C495AD90FE001FEC8FC903903F807F80100B512C0DA0FFCC9FC3D4276BF47>I<01 +3FB612FEEFFFE018F8903B007FF0000FFC6E48EB01FF7113804BEC7FC0183F19E0F01FF0 +A2147F5D19F8A402FFED3FF092C8FCA219E0A2F07FC05B4AEDFF8019004D5A4D5AEF0FF8 +0103ED3FE04A903801FF8091B648C7FC17F002FCCAFCA213075CA5130F5CA5131F5CA513 +3F5CA3137F497EB612E0A25D3D3E7DBD3E>I<013FB612F017FF18E0903B007FF0003FF8 +6E48EB07FCEF01FE4B6D7EF07F8019C0183F19E0147F4B15F0A502FFED7FE092C8FCA219 +C0F0FF80A2494B13004A5D4D5AEF0FF04D5AEF7F800103DA07FEC7FC91B612F017809139 +FC0007E0EE03F8EE00FC0107814A147F717EA284A2130F5CA484011F157F5CA41902013F +17075CA2F0F00F017F170E496C143FB600E0011F131C94380FF83C4B01071378CA3801FF +E09438003F8040407DBD43>82 D<9238FF80070207EBE00F021FEBF81E91387F00FE02FC +EB1F3ED903F0EB0FFE49481307494813034AEB01FC49C7FC491400133E137E177C491578 +A57F1770A26D1500808080EB7FFEECFFE06D13FEEDFFC06D14F06D14FC01038001008014 +3F02031480DA003F13C015031500EE7FE0163F161FA2160F121CA31607160F003C16C0A3 +1780003E151F1700007E5D007F153E6D5C16FC01E0495AD87DF0495AD8FCFCEB0FC03AF8 +7F803F8027F01FFFFEC7FCD8E00713F839C0007FC030427BBF33>I<0007B912F0A33C0F +FE000FF8003F01F0160F01C04A13034848160190C7FC121EF000E048141F5E1238A21278 +1270153F5E5AA3C81600157F5EA515FF93C9FCA55C5DA514035DA514075DA5140F5DA314 +1FEC7FFC0003B7FCA33C3D76BC42>IIII<010FB500F090B512F85B5FD9003F902680 +003F1300DA0FFEC7EA1FF84BEC0FE00207168096C7FC6E6C141E181C6E6C143C606E6D5B +4D5ADB7FC05B4D5A92383FE0074DC8FC92381FF01E171C6F6C5A5F923807FCF0EEFDE06F +B45A5F6F90C9FCA26F7FA2707EA216FF4B7FED03DF9238079FF0ED0F1F92380E0FF8151C +92383C07FC15784B6C7EEC01E04B6C7EEC038002076D7F4AC7FC021E6E7E5C02386E7E5C +02F06E7E495A49486E7E130749486E7E497E017F4B7E2603FFF091383FFF80007F01FC49 +B512FEB55CA2453E7EBD44>II<010FB712FEA39239C00007FCD91FFCC7EA0FF814F0 +4AEC1FF00280EC3FE091C8EA7FC0013EEDFF80A2013C4A13004C5A494A5A4C5A13704C5A +4C5A494A5A4C5AA290C74890C7FC4B5A4B5A4B5AA24B5A4B5A4B5A4B5AA24A90C8FC4A5A +4A5A4A5AA24A5A4A5A4A48EB01C04A5AEF03804990C7FC495A495A494814071800495A49 +485C495A495A171E4890C8123E485A4848157E484815FE4C5A484814074848141F4848EB +01FFB8FC5FA2373E7BBD38>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fh cmbx10 10.95 49 +/Fh 49 122 df12 +D45 D<161C163E167EA216FE16FC150116F8A2150316F0A21507 +16E0150F16C0A2151F1680153F1600A25D157E15FE5DA214015DA214035D14075DA2140F +5D141F5DA2143F92C7FC5C147EA214FE5CA213015C13035CA213075C130F5CA2131F5C13 +3F91C8FCA25B137EA213FE5B12015BA212035B12075BA2120F5B121F5BA2123F90C9FCA2 +5A127E12FE5AA25A1278275B7AC334>47 DI<14 +0F143F5C495A130F48B5FCB6FCA313F7EAFE071200B3B3A8007FB612F0A5243C78BB34> +I<903803FF80013F13F890B512FE00036E7E4881260FF80F7F261FC0037F4848C67F486C +6D7E6D6D7E487E6D6D7EA26F1380A46C5A6C5A6C5A0007C7FCC8FC4B1300A25E153F5E4B +5AA24B5A5E4A5B4A5B4A48C7FC5D4A5AEC1FE04A5A4A5A9139FF000F80EB01FC495A4948 +EB1F00495AEB1F8049C7FC017E5C5B48B7FC485D5A5A5A5A5AB7FC5EA4293C7BBB34>I< +903801FFE0010F13FE013F6D7E90B612E04801817F3A03FC007FF8D807F06D7E82D80FFC +131F6D80121F7FA56C5A5E6C48133FD801F05CC8FC4B5A5E4B5A4A5B020F5B902607FFFE +C7FC15F815FEEDFFC0D9000113F06E6C7E6F7E6F7E6F7E1780A26F13C0A217E0EA0FC048 +7E487E487E487EA317C0A25D491580127F49491300D83FC0495A6C6C495A3A0FFE01FFF8 +6CB65A6C5DC61580013F49C7FC010313E02B3D7CBB34>II<00071538D80FE0EB01F801FE133F90B6FC5E5E5E5E93 +C7FC5D15F85D15C04AC8FC0180C9FCA9ECFFC0018713FC019F13FF90B67E020113E09039 +F8007FF0496D7E01C06D7E5B6CC77FC8120F82A31780A21207EA1FC0487E487E12FF7FA2 +1700A25B4B5A6C5A01805C6CC7123F6D495AD81FE0495A260FFC075B6CB65A6C92C7FCC6 +14FC013F13F0010790C8FC293D7BBB34>II<121F7F13F890B712F0A45A17E017C0178017005E5E5A007EC7EA01F84B5A +007C4A5A4B5A4B5A93C7FC485C157E5DC7485A4A5AA24A5A140F5D141F143F5D147FA214 +FF92C8FC5BA25BA3495AA3130FA5131FAA6D5A6D5A6D5A2C3F7ABD34>II<903801FFE0010F13FC013F13FF90B612C04801E07F489038003FF048486D +7E000F6E7E485A6F7E123F48488081178012FFA217C0A517E0A4007F5CA4003F5C6C7E5D +6C7E00075C3903FF80FB6C13FF6C6C13F36D13C3010F018313C090380008031400A24B13 +80EA03F0487E486C1500487E4B5AA25E151F4B5A495C6C48EBFFE049485B2607FC0F5B6C +B6C7FC6C14FC6C14F06D13C0D90FFEC8FC2B3D7CBB34>I<16FCA24B7EA24B7EA34B7FA2 +4B7FA34B7FA24B7FA34B7F157C03FC7FEDF87FA2020180EDF03F0203804B7E02078115C0 +82020F814B7E021F811500824A81023E7F027E81027C7FA202FC814A147F49B77EA34982 +A2D907E0C7001F7F4A80010F835C83011F8391C87E4983133E83017E83017C81B500FC91 +B612FCA5463F7CBE4F>65 DI<922607FFC0130E92B500FC131E020702FF133E023FEDC07E91B7EA +E1FE01039138803FFB499039F80003FF4901C01300013F90C8127F4948151FD9FFF8150F +48491507485B4A1503481701485B18004890CAFC197E5A5B193E127FA349170012FFAC12 +7F7F193EA2123FA27F6C187E197C6C7F19FC6C6D16F86C6D150119F06C6D15036C6DED07 +E0D97FFEED0FC06D6CED3F80010F01C0ECFF006D01F8EB03FE6D9039FF801FFC010091B5 +5A023F15E002071580020002FCC7FC030713C03F407ABE4C>II< +BAFCA4198026003FFEC7123F1707170183183FA2181FF00FC0A31807EE07C0A3F003E0A3 +160F95C7FC161F163F16FF91B6FCA54AC6FC163F161F040F147CA2160719F8A593C71201 +A219F01803A21807A2180FF01FE0183F18FF1703173FBAFCA219C0A33E3D7DBC45>II<922607FFC0130E92B500FC131E020702FF133E023FEDC07E91B7EAE1FE01 +039138803FFB499039F80003FF4901C01300013F90C8127F4948151FD9FFF8150F484915 +07485B4A1503481701485B18004890CAFC197E5A5B193E127FA34994C7FC12FFAB0407B6 +12FC127F7FA3003F92C7383FFE00A27F7EA26C7FA26C7F6C7FA26C7F6C7FD97FFE157F6D +6C7E010F01E014FF6D01F813036D9038FF801F010091B512F3023F15C00207ED803E0200 +9138FE000E030701E090C7FC46407ABE52>I73 D78 DII82 +D<903A03FFC001C0011FEBF803017FEBFE0748B6128F4815DF48010013FFD80FF8130F48 +481303497F4848EB007F127F49143F161F12FF160FA27F1607A27F7F01FC91C7FCEBFF80 +6C13F8ECFFC06C14FCEDFF806C15E016F86C816C816C816C16806C6C15C07F010715E0EB +007F020714F0EC003F1503030013F8167F163F127800F8151FA2160FA27EA217F07E161F +6C16E06D143F01E015C001F8EC7F8001FEEB01FF9026FFE00713004890B55A486C14F8D8 +F81F5CD8F00314C027E0003FFEC7FC2D407ABE3A>I<003FB912FCA5903BFE003FFE003F +D87FF0EE0FFE01C0160349160190C71500197E127EA2007C183EA400FC183F48181FA5C8 +1600B3AF010FB712F8A5403D7CBC49>II<903807FFC0013F13F848B6FC48812607FE037F260FF8007F6DEB3FF0486C80 +6F7EA36F7EA26C5A6C5AEA01E0C8FC153F91B5FC130F137F3901FFFE0F4813E0000F1380 +381FFE00485A5B485A12FF5BA4151F7F007F143F6D90387BFF806C6C01FB13FE391FFF07 +F36CEBFFE100031480C6EC003FD91FF890C7FC2F2B7DA933>97 D<13FFB5FCA512077EAF +EDFFE0020713FC021FEBFF80027F80DAFF8113F09139FC003FF802F06D7E4A6D7E4A1307 +4A80701380A218C082A318E0AA18C0A25E1880A218005E6E5C6E495A6E495A02FCEB7FF0 +903AFCFF01FFE0496CB55AD9F01F91C7FCD9E00713FCC7000113C033407DBE3A>IIIII<903A03FF8007F0013F9038F83FF8499038 +FCFFFC48B712FE48018313F93A07FC007FC34848EB3FE1001FEDF1FC4990381FF0F81700 +003F81A7001F5DA26D133F000F5D6C6C495A3A03FF83FF8091B5C7FC4814FC01BF5BD80F +03138090CAFCA2487EA27F13F06CB6FC16F016FC6C15FF17806C16C06C16E01207001F16 +F0393FE000034848EB003F49EC1FF800FF150F90C81207A56C6CEC0FF06D141F003F16E0 +01F0147FD81FFC903801FFC02707FF800F13006C90B55AC615F8013F14E0010101FCC7FC +2F3D7DA834>I<13FFB5FCA512077EAFED1FF8EDFFFE02036D7E4A80DA0FE07F91381F00 +7F023C805C4A6D7E5CA25CA35CB3A4B5D8FE0FB512E0A5333F7CBE3A>II<13FFB5FCA512077EB3B3AFB512FCA5163F7CBE1D>108 D<01FFD91FF8ECFFC0B5 +90B5010713F80203DAC01F13FE4A6E487FDA0FE09026F07F077F91261F003FEBF8010007 +013EDAF9F0806C0178ECFBC04A6DB4486C7FA24A92C7FC4A5CA34A5CB3A4B5D8FE07B5D8 +F03FEBFF80A551297CA858>I<01FFEB1FF8B5EBFFFE02036D7E4A80DA0FE07F91381F00 +7F0007013C806C5B4A6D7E5CA25CA35CB3A4B5D8FE0FB512E0A533297CA83A>II<01FFEBFFE0B5000713FC021FEBFF80027F +80DAFF8113F09139FC007FF8000701F06D7E6C496D7E4A130F4A6D7E1880A27013C0A382 +18E0AA4C13C0A318805E18005E6E5C6E495A6E495A02FCEBFFF0DAFF035B92B55A029F91 +C7FC028713FC028113C00280C9FCACB512FEA5333B7DA83A>I<3901FE01FE00FF903807 +FF804A13E04A13F0EC3F1F91387C3FF8000713F8000313F0EBFFE0A29138C01FF0ED0FE0 +91388007C092C7FCA391C8FCB3A2B6FCA525297DA82B>114 D<90383FFC1E48B512BE00 +0714FE5A381FF00F383F800148C7FC007E147EA200FE143EA27E7F6D90C7FC13F8EBFFE0 +6C13FF15C06C14F06C806C806C806C80C61580131F1300020713C014000078147F00F814 +3F151F7EA27E16806C143F6D140001E013FF9038F803FE90B55A15F0D8F87F13C026E00F +FEC7FC222B7DA929>IIII120 DI E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fi cmr10 10.95 93 +/Fi 93 124 df<4AB4EB0FE0021F9038E03FFC913A7F00F8FC1ED901FC90383FF03FD907 +F090397FE07F80494801FF13FF4948485BD93F805C137F0200ED7F00EF003E01FE6D91C7 +FC82ADB97EA3C648C76CC8FCB3AE486C4A7E007FD9FC3FEBFF80A339407FBF35>11 +DIII<121EEA7F80EAFFC0A9EA7F80ACEA3F00AC +121EAB120CC7FCA8121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A4179C019>33 +D<001E130F397F803FC000FF137F01C013E0A201E013F0A3007F133F391E600F30000013 +00A401E01370491360A3000114E04913C00003130101001380481303000EEB070048130E +0018130C0038131C003013181C1C7DBE2D>I<4B6C130C4B6C131EA20307143EA24C133C +A2030F147CA293C71278A24B14F8A2031E5CA2033E1301A2033C5CA3037C1303A203785C +A203F81307A24B5CA20201140F007FBAFCBB1280A26C1900C72707C0003EC8FC4B133CA3 +020F147CA292C71278A24A14F8A2021E5CA3023E1301007FBAFCBB1280A26C1900C727F8 +0007C0C8FC4A5CA20101140FA24A91C9FCA301035CA24A131EA20107143EA24A133CA201 +0F147CA291C71278A34914F8A2011E5CA2013E1301A2013C5CA201186D5A41517BBE4C> +I<14E0A4EB07FC90383FFF8090B512E03901F8E3F03903E0E0FCD807C0133CD80F807FD8 +1F007F003E80003C1580007C140316C00078141F00F8143F157FA47EED3F806CEC0E0092 +C7FC127F138013C0EA3FF013FEEA1FFF6C13FC6C13FF6C14C06C806C6C13F8011F7F1303 +01007FECE7FF14E102E01380157F153FED1FC0A2003E140F127FD8FF801307A5130000FC +158000F0140F1270007815005D6C141E153E6C5C6C5C3907C0E1F03903F8EFE0C6B51280 +D93FFEC7FCEB0FF8EB00E0A422497BC32D>I<013F1603D9FFC04B7E2601E0E0150F2607 +C070151F48486C4BC7FC023E157E48486C15FE48D90FC0EB03FC003ED90EF0EB0FF8DA0F +3F13FD007E903A070FFFF1F0007C0200EB03E0160000FC6D6C495A170F604DC8FC5F173E +5F17FC5F4C5A1603007CD907005B4C5A007E150F003E495C020E49C9FC003F5D6C49133E +260F803C5B023813FC6C6C485B3A01E0E001F03800FFC090273F0003E0133F90C70007EC +FFC09339C001E0E0923A0F8007C070031F49487E0400143C033E90381F001C037E497F03 +7C133E4B150F0201027E7F4B137C4A5A020702FCEB03805D4A5A141F92C7FC143E147E14 +7C5CA2495A0103037CEB07005C4948147E010F033E5B4A160E49C8123F496F5B013E9238 +0F803C49173801FC6F6C5A49923801E0E0496FB45A0160043FC7FC41497BC34C>II<121EEA7F8012FF13C0A213E0A3127FEA1E601200A413E013C0A312 +011380120313005A120E5A1218123812300B1C79BE19>I<1430147014E0EB01C0EB0380 +1307EB0F00131E133E133C5B13F85B12015B1203A2485AA2120F5BA2121F90C7FCA25AA3 +123E127EA6127C12FCB2127C127EA6123E123FA37EA27F120FA27F1207A26C7EA212017F +12007F13787F133E131E7FEB07801303EB01C0EB00E014701430145A77C323>I<12C07E +12707E7E121E7E6C7E7F12036C7E7F12007F1378137CA27FA2133F7FA21480130FA214C0 +A3130714E0A6130314F0B214E01307A614C0130FA31480A2131F1400A25B133EA25BA213 +7813F85B12015B485A12075B48C7FC121E121C5A5A5A5A145A7BC323>II<1506150FB3A9 +007FB912E0BA12F0A26C18E0C8000FC9FCB3A915063C3C7BB447>I<121EEA7F8012FF13 +C0A213E0A3127FEA1E601200A413E013C0A312011380120313005A120E5A121812381230 +0B1C798919>II<121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A0A +798919>IIIIII<150E151E153EA2157EA215FE1401A21403 +EC077E1406140E141CA214381470A214E0EB01C0A2EB0380EB0700A2130E5BA25B5BA25B +5B1201485A90C7FC5A120E120C121C5AA25A5AB8FCA3C8EAFE00AC4A7E49B6FCA3283E7E +BD2D>I<00061403D80780131F01F813FE90B5FC5D5D5D15C092C7FC14FCEB3FE090C9FC +ACEB01FE90380FFF8090383E03E090387001F8496C7E49137E497F90C713800006141FC8 +13C0A216E0150FA316F0A3120C127F7F12FFA416E090C7121F12FC007015C012780038EC +3F80123C6CEC7F00001F14FE6C6C485A6C6C485A3903F80FE0C6B55A013F90C7FCEB07F8 +243F7CBC2D>II<1238123C123F90 +B612FCA316F85A16F016E00078C712010070EC03C0ED078016005D48141E151C153C5DC8 +127015F04A5A5D14034A5A92C7FC5C141EA25CA2147C147814F8A213015C1303A31307A3 +130F5CA2131FA6133FAA6D5A0107C8FC26407BBD2D>III< +121EEA7F80A2EAFFC0A4EA7F80A2EA1E00C7FCB3121EEA7F80A2EAFFC0A4EA7F80A2EA1E +000A2779A619>I<121EEA7F80A2EAFFC0A4EA7F80A2EA1E00C7FCB3121E127FEAFF80A2 +13C0A4127F121E1200A412011380A3120313005A1206120E120C121C5A1230A20A3979A6 +19>I<121EEA7F80A2EAFFC0A4EA7F80A2EA1E00C7FCA8120C121EAB123FACEA7F80ACEA +FFC0A9EA7F80EA1E000A4179AC19>I<007FB912E0BA12F0A26C18E0CDFCAE007FB912E0 +BA12F0A26C18E03C167BA147>IIII<15074B7EA34B7EA34B7EA34B7EA34B7E15E7A291 +3801C7FC15C3A291380381FEA34AC67EA3020E6D7EA34A6D7EA34A6D7EA34A6D7EA34A6D +7EA349486D7E91B6FCA249819138800001A249C87EA24982010E157FA2011E82011C153F +A2013C820138151FA2017882170F13FC00034C7ED80FFF4B7EB500F0010FB512F8A33D41 +7DC044>III< +B712FCEEFF8017E000019039C0001FF86C6C48EB03FEEE00FF717E717EEF0FE084717E71 +7E170184717EA21980187F19C0A3F03FE0A519F0AB19E0A5F07FC0A21980A218FF19004D +5AA24D5A6017074D5A4D5AEF7FC04DC7FCEE03FE48486CEB1FF8B85A178004FCC8FC3C3E +7DBD45>IIIIII<011FB512FCA3D9000713006E5A1401B3B3A6 +123FEA7F80EAFFC0A44A5A1380D87F005B007C130700385C003C495A6C495A6C495A2603 +E07EC7FC3800FFF8EB3FC026407CBD2F>II< +B612F8A3000101E0C9FC38007F80B3B0EF0380A517071800A45FA35FA25F5F5F4C5A1607 +48486C133FB8FCA3313E7DBD39>IIIIIIII<003FB91280A3903AF0007FE001018090393F +C0003F48C7ED1FC0007E1707127C00781703A300701701A548EF00E0A5C81600B3B14B7E +4B7E0107B612FEA33B3D7DBC42>IIII<007FB5D8C003B512E0A3C6 +49C7EBFC00D93FF8EC3FE06D48EC1F806D6C92C7FC171E6D6C141C6D6C143C5F6D6C1470 +6D6D13F04C5ADA7FC05B023F13036F485ADA1FF090C8FC020F5BEDF81E913807FC1C163C +6E6C5A913801FF7016F06E5B6F5AA26F7E6F7EA28282153FED3BFEED71FF15F103E07F91 +3801C07F0203804B6C7EEC07004A6D7E020E6D7E5C023C6D7E02386D7E14784A6D7E4A6D +7F130149486E7E4A6E7E130749C86C7E496F7E497ED9FFC04A7E00076DEC7FFFB500FC01 +03B512FEA33F3E7EBD44>II<003F +B712F8A391C7EA1FF013F801E0EC3FE00180EC7FC090C8FC003EEDFF80A2003C4A130000 +7C4A5A12784B5A4B5AA200704A5AA24B5A4B5AA2C8485A4A90C7FCA24A5A4A5AA24A5AA2 +4A5A4A5AA24A5A4A5AA24990C8FCA2495A4948141CA2495A495AA2495A495A173C495AA2 +4890C8FC485A1778485A484815F8A24848140116034848140F4848143FED01FFB8FCA32E +3E7BBD38>II<486C13C000031301 +01001380481303000EEB070048130E0018130C0038131C003013180070133800601330A3 +00E01370481360A400CFEB678039FFC07FE001E013F0A3007F133FA2003F131F01C013E0 +390F0007801C1C73BE2D>II96 DII<49B4FC010F13E090383F00F8017C131E4848131F484813 +7F0007ECFF80485A5B121FA24848EB7F00151C007F91C7FCA290C9FC5AAB6C7EA3003FEC +01C07F001F140316806C6C13076C6C14000003140E6C6C131E6C6C137890383F01F09038 +0FFFC0D901FEC7FC222A7DA828>IIII<167C903903F801FF903A +1FFF078F8090397E0FDE1F9038F803F83803F001A23B07E000FC0600000F6EC7FC49137E +001F147FA8000F147E6D13FE00075C6C6C485AA23901F803E03903FE0FC026071FFFC8FC +EB03F80006CAFC120EA3120FA27F7F6CB512E015FE6C6E7E6C15E06C810003813A0FC000 +1FFC48C7EA01FE003E140048157E825A82A46C5D007C153E007E157E6C5D6C6C495A6C6C +495AD803F0EB0FC0D800FE017FC7FC90383FFFFC010313C0293D7EA82D>III<1478EB01FEA2EB03FFA4EB01FEA2EB00781400AC147FEB7FFFA313017F14 +7FB3B3A5123E127F38FF807E14FEA214FCEB81F8EA7F01387C03F0381E07C0380FFF8038 +01FC00185185BD1C>III<2701 +F801FE14FF00FF902707FFC00313E0913B1E07E00F03F0913B7803F03C01F80007903BE0 +01F87000FC2603F9C06D487F000101805C01FBD900FF147F91C75B13FF4992C7FCA2495C +B3A6486C496CECFF80B5D8F87FD9FC3F13FEA347287DA74C>I<3901F801FE00FF903807 +FFC091381E07E091387803F000079038E001F82603F9C07F0001138001FB6D7E91C7FC13 +FF5BA25BB3A6486C497EB5D8F87F13FCA32E287DA733>I<14FF010713E090381F81F890 +387E007E01F8131F4848EB0F804848EB07C04848EB03E0000F15F04848EB01F8A2003F15 +FCA248C812FEA44815FFA96C15FEA36C6CEB01FCA3001F15F86C6CEB03F0A26C6CEB07E0 +6C6CEB0FC06C6CEB1F80D8007EEB7E0090383F81FC90380FFFF0010090C7FC282A7EA82D +>I<3901FC03FC00FF90381FFF8091387C0FE09039FDE003F03A07FFC001FC6C496C7E6C +90C7127F49EC3F805BEE1FC017E0A2EE0FF0A3EE07F8AAEE0FF0A4EE1FE0A2EE3FC06D15 +80EE7F007F6E13FE9138C001F89039FDE007F09039FC780FC0DA3FFFC7FCEC07F891C9FC +AD487EB512F8A32D3A7EA733>I<02FF131C0107EBC03C90381F80F090397F00387C01FC +131CD803F8130E4848EB0FFC150748481303121F485A1501485AA448C7FCAA6C7EA36C7E +A2001F14036C7E15076C6C130F6C7E6C6C133DD8007E137990383F81F190380FFFC19038 +01FE0190C7FCAD4B7E92B512F8A32D3A7DA730>I<3901F807E000FFEB1FF8EC787CECE1 +FE3807F9C100031381EA01FB1401EC00FC01FF1330491300A35BB3A5487EB512FEA31F28 +7EA724>I<90383FC0603901FFF8E03807C03F381F000F003E1307003C1303127C007813 +0112F81400A27E7E7E6D1300EA7FF8EBFFC06C13F86C13FE6C7F6C1480000114C0D8003F +13E0010313F0EB001FEC0FF800E01303A214017E1400A27E15F07E14016C14E06CEB03C0 +903880078039F3E01F0038E0FFFC38C01FE01D2A7DA824>I<131CA6133CA4137CA213FC +A2120112031207001FB512C0B6FCA2D801FCC7FCB3A215E0A912009038FE01C0A2EB7F03 +013F138090381F8700EB07FEEB01F81B397EB723>IIIIII<001FB61280A2EBE0000180140049485A001E495A121C4A5A003C495A14 +1F00385C4A5A147F5D4AC7FCC6485AA2495A495A130F5C495A90393FC00380A2EB7F80EB +FF005A5B484813071207491400485A48485BA248485B4848137F00FF495A90B6FCA22127 +7EA628>II E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fj cmr12 14.4 16 +/Fj 16 122 df<120FEA3FC0EA7FE0EAFFF0A6EA7FE0EA3FC0EA0F000C0C768B21>46 +D48 D50 D<160F5EA25E5EA25E5DA25D5DA25D151E151C153C5D157015F04A5A5D14035D4A5A +5C140E5C143C14385C14F05C495A13035C130749C7FC130E131E5B133813785B5B120148 +5A5B120748C8FC120E121E5A123812785AB912F0A4C8000190C7FCAF4B7F4B7F020FB612 +E0A434507DCF3B>52 D<000316C001C0140301F8141F903AFFC003FF8091B612005E5E5E +16E016804BC7FC019F13F8018113800180C9FCB0EC0FF0ECFFFE01836D7E903987F01FE0 +90399F0007F801BE6D7E01F86D7E496D7E49EC7F805BEE3FC04915E0C9121F17F0A317F8 +160FA317FCA5120EEA3F80487E12FF7FA217F85B161F5B48C813F012700078ED3FE0A26C +16C0167F6CEDFF80001F16006C6C495A6C6C13036C6CEB07F8D801F8EB1FF06CB4EB7FE0 +6DB51280011F49C7FC010713F8010013C02E517ACE3B>I<49B612FEA490C7003F138092 +380FFE001507B3B3B3A21206EA3FC0487E487EA44B5AA25B007F5D0180131F0078C75B6C +143F003E4A5A6C5D6C6C495A2707E003FEC7FC3901FC07FC6CB512F0013F13C0D907FCC8 +FC2F547BD13C>74 D86 +D101 D<1378EA01FE487E487FA66C90C7FC6C5AEA00 +7890C8FCB0EB7F80B5FCA41203C6FC137FB3B3A43801FFE0B61280A419507CCF21>105 +D108 +D<01FFEB07FCB590383FFF8092B512E0913901F00FF8913903C007FC000349C66C7EC601 +0E13016D486D7E5C143002706E7E146014E05CA35CB3AD2601FFE0903801FFE0B600C0B6 +12C0A43A347CB341>110 DI<01FFEB1F80B5EB7FF09138 +01FFF8913803E1FC91380783FE0003EB0F07C6131EEB7F1C1438143091387003FC913860 +00F0160014E05CA45CB3AA8048487EB612F0A427347DB32E>114 +DI117 D121 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fk cmbx12 17.28 21 +/Fk 21 118 df65 +D70 D73 +D80 D83 +D<001FBEFCA64849C79126E0000F148002E0180091C8171F498601F81A0349864986A249 +1B7FA2491B3F007F1DC090C9181FA4007E1C0FA600FE1DE0481C07A5CA95C7FCB3B3B3A3 +021FBAFCA663617AE070>I<913803FFFE027FEBFFF00103B612FE010F6F7E4916E09027 +3FFE001F7FD97FE001077FD9FFF801017F486D6D7F717E486D6E7F85717FA2717FA36C49 +6E7FA26C5B6D5AEB1FC090C9FCA74BB6FC157F0207B7FC147F49B61207010F14C0013FEB +FE004913F048B512C04891C7FC485B4813F85A5C485B5A5CA2B55AA45FA25F806C5E806C +047D7F6EEB01F96C6DD903F1EBFF806C01FED90FE114FF6C9027FFC07FC01580000191B5 +487E6C6C4B7E011F02FC130F010302F001011400D9001F90CBFC49437CC14E>97 +D<903807FF80B6FCA6C6FC7F7FB3A8EFFFF8040FEBFF80047F14F00381B612FC038715FF +038F010014C0DBBFF0011F7FDBFFC001077F93C76C7F4B02007F03F8824B6F7E4B6F1380 +4B17C0851BE0A27313F0A21BF8A37313FCA41BFEAE1BFCA44F13F8A31BF0A24F13E0A24F +13C06F17804F1300816F4B5A6F4A5B4AB402075B4A6C6C495B9126F83FE0013F13C09127 +F00FFC03B55A4A6CB648C7FCDAC00115F84A6C15E091C7001F91C8FC90C8000313E04F65 +7BE35A>I<92380FFFF04AB67E020F15F0023F15FC91B77E01039039FE001FFF4901F801 +0113804901E0010713C04901804913E0017F90C7FC49484A13F0A2485B485B5A5C5A7113 +E0485B7113C048701380943800FE0095C7FC485BA4B5FCAE7EA280A27EA2806C18FCA26C +6D150119F87E6C6D15036EED07F06C18E06C6D150F6D6DEC1FC06D01E0EC7F806D6DECFF +00010701FCEB03FE6D9039FFC03FFC010091B512F0023F5D020F1580020102FCC7FCDA00 +0F13C03E437BC148>I<92380FFFC04AB512FC020FECFF80023F15E091B712F80103D9FE +037F499039F0007FFF011F01C0011F7F49496D7F4990C76C7F49486E7F48498048844A80 +4884485B727E5A5C48717EA35A5C721380A2B5FCA391B9FCA41A0002C0CBFCA67EA380A2 +7EA27E6E160FF11F806C183F6C7FF17F006C7F6C6D16FE6C17016D6C4B5A6D6D4A5A6D01 +E04A5A6D6DEC3FE0010301FC49B45A6D9026FFC01F90C7FC6D6C90B55A021F15F8020715 +E0020092C8FC030713F041437CC14A>101 DII105 D<903807FF80B6FCA6C6FC +7F7FB3B3B3B3ADB712E0A623647BE32C>108 D<902607FF80D91FFFEEFFF8B691B500F0 +0207EBFF80040702FC023F14E0041F02FF91B612F84C6F488193267FE07F6D4801037F92 +2781FE001F9027E00FF0007FC6DA83F86D9026F01FC06D7F6DD987F06D4A487F6DD98FC0 +DBF87EC7804C6D027C80039FC76E488203BEEEFDF003BC6E4A8003FC04FF834B5FA24B5F +A24B94C8FCA44B5EB3B2B7D8F007B7D8803FB612FCA67E417BC087>I<902607FF80EB1F +FFB691B512F0040714FC041F14FF4C8193267FE07F7F922781FE001F7FC6DA83F86D7F6D +D987F07F6DD98FC0814C7F039FC78015BE03BC8003FC825DA25DA25DA45DB3B2B7D8F007 +B71280A651417BC05A>I<923807FFE092B6FC020715E0021F15F8027F15FE494848C66C +6C7E010701F0010F13E04901C001037F49496D7F4990C87F49486F7E49486F7E48496F13 +804819C04A814819E048496F13F0A24819F8A348496F13FCA34819FEA4B518FFAD6C19FE +A46C6D4B13FCA36C19F8A26C6D4B13F0A26C19E06C6D4B13C0A26C6D4B13806C6D4B1300 +6D6C4B5A6D6D495B6D6D495B010701F0010F13E06D01FE017F5B010090B7C7FC023F15FC +020715E0020092C8FC030713E048437CC151>I +114 D<913A3FFF8007800107B5EAF81F011FECFE7F017F91B5FC48B8FC48EBE0014890C7 +121FD80FFC1407D81FF0801600485A007F167F49153FA212FF171FA27F7F7F6D92C7FC13 +FF14E014FF6C14F8EDFFC06C15FC16FF6C16C06C16F06C826C826C826C82013F1680010F +16C01303D9007F15E0020315F0EC001F1500041F13F81607007C150100FC81177F6C163F +A2171F7EA26D16F0A27F173F6D16E06D157F6D16C001FEEDFF806D0203130002C0EB0FFE +02FCEB7FFC01DFB65A010F5DD8FE0315C026F8007F49C7FC48010F13E035437BC140>I< +EC07E0A6140FA5141FA3143FA2147FA214FF5BA25B5B5B5B137F48B5FC000F91B512FEB8 +FCA5D8001F01E0C8FCB3AFEF0FC0AC171F6D6D1480A2173F6D16006F5B6D6D137E6D6D5B +6DEBFF836EEBFFF86E5C020F14C002035C9126003FFCC7FC325C7DDA3F>I<902607FFC0 +ED3FFEB60207B5FCA6C6EE00076D826D82B3B3A260A360A2607F60183E6D6D147E4E7F6D +6D4948806D6DD907F0ECFF806D01FFEB3FE06D91B55A6E1500021F5C020314F8DA003F01 +8002F0C7FC51427BC05A>I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fl cmbx12 24.88 40 +/Fl 40 122 df[<96380FFFFE060FB612E04DB712FC051F16FF94B912C0040784041F18 +F8047F9126FC001F7F4BB6008001017F030702F8C8EA3FFF4B02E0030F7F033F02804B7F +4B49C9127F92B54893B57E4A02F05D4A4A4B804A4A5D4A4A84634A91C9FC4A5BA24A5B51 +80755C91B5FC5EA3755CA2755C755C755CE23FFEC8FCF40FF899CAFCAF083FB612FCBFFC +A9C702FCC912038787B3B3B3B2003FB800F0013FB812F0A9>116 +144 123 271 129 12 D[33 70 111 270 65 39 +D45 D[<1CFC517E517E1D8063A263A3511300A2515AA3515AA2 +515AA3505BA2505BA3505BA2505BA35090C7FCA2505AA3505AA2505AA34F5BA24F5BA34F +5BA26361A24F90C8FCA34F5AA24F5AA34F5AA24E5BA34E5BA24E5BA34E5BA24E90C9FCA3 +4E5AA24E5AA34E5AA24D5BA34D5BA2615FA24D5BA34D90CAFCA24D5AA34D5AA24D5AA34C +5BA24C5BA34C5BA24C5BA34C90CBFCA24C5AA34C5AA24C5AA34B5BA25F5DA24B5BA34B5B +A24B90CCFCA34B5AA24B5AA34B5AA24A5BA34A5BA24A5BA34A5BA24A90CDFCA34A5AA24A +5AA34A5AA25D5BA2495BA3495BA2495BA34990CEFCA2495AA3495AA2495AA3485BA2485B +A3485BA2485BA34890CFFCA2485AA3485AA2485AA35BA25B127F6C5A6C5A>89 +207 115 282 116 47 D[158 +145 120 272 175 65 D[143 142 120 +269 165 I[<0803B500C0EE01F00703B600FEEE03F8077FDBFFE015070607B800FC150F +063F05FF151F4DBA00E0143F050F07F8147F053F07FE14FF94BC5B04039326F8000FECC0 +03040F4BC86CEBF007043F03C0030F6D5A93B648C900036D5A4B03F09339007FFF3F0307 +03C0051F90B5FC4B92CB7E033F02FC18034B02F08492B648844A0380193F4A92CD7E4A4A +864A4A864A02F0864A4A864A8991B65A494B874992CF7E4C885B494A885E498B494A88A2 +495C8D90B65A8D5A5E48217FA24892D1FC223FA25A5DA248211FA3485CFA0FF09FC7FCA2 +5AA45DA3B6FCB27EA381A47EA46C80FA07F0FA0FF87EA2817EA36C6F1D1F23F07E827E22 +3F6D6E1EE0A26D6E1D7F23C06D6E1DFF7F705213806D806D55130070646D6F646D6F515A +6E6E1B1F6E6E515A6E6E515A6E6E1BFF6E6E505B6E6E505B6E6F4F5B6E03E04F90C7FC6F +6EF13FFE6F02FC4F5A030F02FF4E485A6F03C005075B030103F0051F5B6F03FE057F1380 +043FDAFFE00303B5C8FC040F03FE033F13FC0403DBFFF80107B55A040093B812E0053F1A +80050F4FC9FC050119F8DD003F18C0060795CAFCDE007F16F0070393CBFCDF000314C0> +141 146 115 271 168 I[156 142 120 269 178 I[138 141 120 268 +153 I[127 141 120 +268 146 I[<0803B500C0EE01F00703B600FE4C7E077FDBFFE015070607B800FC150F06 +3F05FF151F4DBA00E0143F050F07F8147F053F07FE14FF94BC5B04039326F8000FECC003 +040F4BC86CEBF007043F03C0030F6D5A93B648C900036D5A4B03F09339007FFF3F030703 +C0051F90B5FC4B92CB7E033F02FC18034B02F08492B648844A0380193F4A92CD7E4A4A86 +4A4A864A02F0864A4A864A8991B65A494B874992CF7E4C885B494A885E498B494A88A249 +5C8D90B65A8D5A5E48217FA24892D1FC223FA25A5DA248211FA3485C7C5A9FC9FCA25AA4 +5DA3B6FCB27EA381A20A0FBB12F8A27EA46C80A36C98C96C02F8C7FCA2817EA36C81A27E +827E827FA26D80A26D806D80A26D806D80A26D816D816E806E806E806E6E97B6FC6E806E +806E03C0606E816F02F8606F02FE60030F6E606F03E0173F030103F85F6F03FF933801FF +FC043F03E00307497E040F03FF033F497E040304FC0107B5EAE00F040093B8487E053FF2 +0001050F07FCEB007F050107F0141FDD003F06C01407060795C81201DE007F04F8ED0070 +0703048093C8FCDF000302E0CDFC>157 146 115 271 183 I[74 142 122 269 87 73 D[165 +142 120 269 182 78 D[<97B512F0077FECFFE00607B712FE067FEEFFE00503B912FC05 +1FF0FF80057F19E00403BB12FC040F9226E0007F14FF043F02FCC7000315C04C02E0DA00 +7F804BB60080031F14F8030702FCC9000314FE4B4A70804B02E0706C80037F0280051F14 +E092B6CB6C804A4A72804A4A72804A02F00600804A4A737F4A4A73804A8B4A4A738091B6 +CD6C80494A7480A2494A7480494A7480498C4C86498D4C87498D494A7580A290B68B4C87 +488EA24892CF6C80A3488E4B88A2488EA3484A761580A34823C0A5484A7615E0A7B621F0 +B36C23E0A26F64A56C23C0A46F646C2380A36C23006F64A26C6AA270636C6AA26C6A7063 +6C6A70636D69A26D6E98B65AA26D6E505DA26D6E5092C7FC6D6870626D6E505C6D686D6F +4F5C6E6E4F5C6E6E4F5CA26E6E96B65A6E6E4E92C8FC6E6E4E5C020102FF060F14F86E6F +4D5C6F6E4D5C6F02F094B65A030F6E4C92C9FC6F02FE04075C03016E6C031F14F86F03F0 +92B65A043F02FE020715C0040FDAFFF090B7CAFC040392B812FC04001AF0051F19800507 +4ECBFCDD007F17E0060F94CCFCDE007F15E0070002F0CDFC>148 +146 115 271 175 I[137 142 120 269 159 I[163 144 120 269 173 82 D[<93260FFFF8163E4BB600E0153F031F03 +FE5D037FDBFFC05C0203B800F05B020F05FC5B4A05FF5B027FF0C00F91B526FE000FECF0 +1F010302C0D9007F6D5A4991C800076D5A4901FC030090B6FC4901F0163F4949160F4901 +808290B5170192CBFC4849844849181F87484984A2484984874886A248498588A24887A3 +88A2B58680A36E85A280A26E8580A2818103F0725A6C6E96C7FC15FE8116E06C15FEEEFF +E017FF6C17F0F0FF806C18F8F1FFC06C19FCF2FF806C1AE01BF86C1AFE6C747E6D1AE088 +6D866D866D1AFF6D876D87010087806E86020F86020386020086153F030F851501DB001F +19801601DC000F18C0EF007F060717E0F0003F070316F0F1003F1A0F080315F81A00871B +1F877514FCA287007F86486C85A288A388A36D86A31EF87FA37F1EF0A26D626D1CE0A27F +6D5013C0A26E1B806E96B5FC6E1B0002F8606E4E5B6E626E6C5F03E04D5B03F84D5B03FE +057F5BDBFFC093B55A04F803035C496CD9FF80021F91C7FCD9FC1F02FF49B55AD9F80792 +B75A496C19F049C66149011F18804901074DC8FC90C817F848031F16C048030003FCC9FC +007C04011480>102 146 115 271 129 I[<000FC312F8A6488EA304C0C7001F4AC71201 +03F8C8F0000F03C01C0192C9737E02FC1E1F4A1E0702E08A4A8A4A8A4890CA757EA24920 +3F49201FA349200FA2492007A4492003007F8EA4498CA848487A1380A6CC99C7FCB3B3B3 +B3AA030FBD12FCA9>145 140 120 267 162 I[162 +144 120 269 179 I<93B512FC037FECFFF00207B8FC023F17E091B912F84918FE010772 +7E499126C0007F14E04901E0C7000F80496D020380496D020014FE6F6F7F90B570806F6F +8085486E6F807380A27380A28885886C5CA26D4982886D5B6D5B010713C0010190CAFC90 +CCFCA90603B7FC050FB8FC0403B9FC167F0307BAFC153F4AB7EA807F020FEDE000023F02 +FCC7FC91B612E0010392C8FC4914FC011F14F04914C0495C90B548C9FC485C485C485C48 +5C5A5D485CA24891CAFCA3B6FC5CA397B6FCA461806C60F107EF6C6E150F6F16CF6C183F +6FDB7F8F806C6EDBFF0F14E06C02FCDA03FE15FE6C6E91260FFC0791B5FC6C6E6CD93FF8 +17806C923AF803FFF003013F91B6487E010FEF8000010394C77E010004FC141F021F03F0 +140702010380DA007F1400DA000701F8CDFC695F79DD71>97 D[113 144 121 270 +129 I<94387FFFF0041FB612E093B712FE0307707E031F17F092B97E4A18FE020784021F +9126F8000F14804A0280010014C04A49C74814E049B500F85C494A17F0494A5C495C494A +4A14F84991C8FC5D495B90B5FC5D5A485C7314F05A4B6F14E05A7314C0487214804B9338 +3FFE00F20FF84896C8FCA4485CA5B6FCB07EA281A37EA36C80A37E6F18FE6CF201FFA26C +6E5F1CFE6C801B076C6EEF0FFC6D7F70EE1FF86DF13FF06D6E167F6D6EEEFFE06D02F84B +13C06D6E5D6D02FF030F13806D03C0023F1300023F02F0903801FFFC6E9126FF801F5B02 +0792B65A6E18C0020060033F4CC7FC030716F8030016C0041F4AC8FCDC007F13C0585F78 +DD67>I[113 144 +120 270 129 I<94387FFFC0040FB6FC93B712E0030716FC031F16FF037F17C04AB912F0 +0207DAF80380021F912680003F13FE4A49C7000F7F4A01F802038049B5486E804902C06E +6C7F494A6F7F4991C9FC49727F4949707F4B84498490B548707F5A4B198048855D481CC0 +86481CE05D5A871DF05AA25D5AA21DF887A2B6FCA392BBFCA51DF00380CDFCA77EA4817E +A37EA2817EA26CF307F06FF00FF87E816C1B1F6F19F06C1B3F6D6DF07FE06D7FF4FFC06D +6E4C13806D6E5E6D02F04C13006D6EEE1FFE6D6E4C5A6D6C01FFEEFFF86E02E002035B6E +02FC021F5B02079126FFC003B55A6E92B7C7FC020060033F17F8030F17E003011780DB00 +3F03FCC8FC040315C0DC000F01F8C9FC5D5F7ADD6A>I[<95383FFF80050FB512F094B612 +FE040781041F16C0047F824BB87E0307DAF8077F031FDAC00F7F4B49C6487F4B495B92B5 +00F0814A4A5B4A5C4A93B612805F4A91C7FC5C5E5C5E5C731400A24C6E5B91B56F5BA273 +5B070313E00700138097C8FCB3A4BA12F8A9C702FCCBFCB3B3B3B3A2003FB9FCA9>81 +144 121 271 71 II[ +114 143 119 270 129 I[49 144 +119 271 65 I[ +50 143 119 270 65 108 DII<94381FFFF00407B612C004 +7F15FC0303B87E030F17E0037F17FC4ABAFC4A9126FC007F80020F02C0010714E04A49C8 +80027F01F8033F13FC91B5486F7F4902C003077F494A6F804991C96C8049497080494971 +7F49874949717FA290B548717F48884B83481D80A2481DC04B83481DE0A2481DF0A3484A +7114F8A4481DFCA5B61BFEAF6C1DFCA56C6E4D14F8A36C1DF0A36C1DE06F5F6C1DC0A26C +6E4D1480A26C1D006F5F6C646D6D4D5B6F94B5FC6D636D6D4C5C6D6E4B5C6D6E4B5C6D02 +F0031F5C6D6E4B91C7FC6D6C01FE92B512FC6ED9FFC001075C6E02FC017F5C020791B812 +C0020196C8FC6E6C17FC031F17F003031780DB007F03FCC9FC040715C0DC001F01F0CAFC +675F7ADD74>II114 D<92261FFFF814F80203B638C001FC023FEDFC0791B8121F010317FF +130F013F9038F8001F4990C8FCD9FFF8153F4801E0150F484915034849814890CAFC197F +4848173F191F485AA2007F180FA31907487EA27FA28002E0705A6E93C8FC14FC14FF15F0 +6CECFF8016FCEEFFF06CEEFF8018F06C17FE727E6C18E0856C18FC6C846C727E6C856D84 +011F846D841303010084023F83140F020183EC001FDB007F16801603DC000F15C0170018 +3F060F14E0007F1703486C82727E857F85857FA2857F1BC07FA27F1B806D5F7F1B006E5E +6E5F6E163F6E4C5A02FC4C5A6E03035B6E6C4A5B03F0023F5B03FF0107B55A01F991B7C7 +FCD9F07F16FCD9E01F16F0D9800716C0D9000193C8FC48D9003F14F8007C020349C9FC4B +5F78DD5C>I[72 +132 124 258 90 III<007FB86C49B712FEA9C792C9000F02C0C7FC6E6E +030101F0C8FC715F6E6E4B5B6E6E4B5B6E4E90C9FC6E6E5E71151F6E6E4B5A6E6E4B5A6E +4E5A6F6E495B72495B6F6E495B6F806F6E4990CAFC6F4C5A72495A6F6E495A6F6E495A6F +03815B705E7014C307E75B7091B5CBFC705D705D705D6282705D715C8386718071807180 +837180864D814D815F4D81874D814D81DDFFF3804C13E14C01C1804C0180814E6C804C6E +804C487F4C48824C486D804C486D804B496D804B497F73804B49834B90C86C804B486F80 +4B48814B486F804B48844C6F804A71804A496F804A49814A90CA814A487180023F728001 +0FB500E07080B8031FB812E0A9735C7CDB7B>120 D<007FB800C04AB71280A9D800034A +CA000791C7FC6D080013F0775A6D6E4E5AA26E6E6064836E4F90C8FC836E4F5A836E4F5A +A26E6E4C5AA26E6E5F1C3F6E6E5F1C7F836E4F5A846F4D5B846F4D90C9FCA26F6E4A5AA2 +6F6E5D1B0F846F4D5A846F4D5A846F4D5AA26F6E4A5AA2706E5C627002C091CAFC6219E0 +704B5A19F0704B5AA2706E485AA2706E485AA27002FE5B1A7F19FF704B5AA2715DA27192 +CBFCA2715CA2715CA3715CA2715CA2715CA2715CA2725BA27290CCFCA3725AA2725AA24E +5AA24E5AA261187FA24E5AA24D5B13FE2603FF804A90CDFC000F13E0486D4A5A487F486D +4A5AA260B56C141F4D5AA24D5A17FF604C5B4A4990CEFC6C5D4C5A6C49EB3FFC4A495A6C +4948485A9026FE80075B270FFFC03F5B6C90B6CFFC6C5D6C15F86C6C5C011F14C0010749 +D0FC9038007FE071857CDB7B>I E +%EndDVIPSBitmapFont +end +%%EndProlog +%%BeginSetup +%%Feature: *Resolution 600dpi +TeXDict begin + +%%EndSetup +%%Page: 1 1 +1 0 bop 861 1940 a Fl(FITSIO)76 b(User's)g(Guide)356 +2399 y Fk(A)54 b(Subroutine)e(In)l(terface)h(to)g(FITS)h(F)-13 +b(ormat)53 b(Files)1055 2659 y(for)h(F)-13 b(ortran)53 +b(Programmers)1667 3155 y Fj(V)-10 b(ersion)38 b(2.5)1727 +4058 y Fi(HEASAR)m(C)1764 4170 y(Co)s(de)30 b(662)1363 +4283 y(Go)s(ddard)f(Space)i(Fligh)m(t)f(Cen)m(ter)1522 +4396 y(Green)m(b)s(elt,)g(MD)i(20771)1857 4509 y(USA)1704 +5298 y Fj(July)38 b(2004)p eop +%%Page: 2 2 +2 1 bop 0 299 a Fi(ii)p eop +%%Page: 3 3 +3 2 bop 0 1267 a Fl(Con)-6 b(ten)g(ts)0 1858 y Fh(1)84 +b(In)m(tro)s(duction)3136 b(1)0 2118 y(2)119 b(Creating)34 +b(FITSIO/CFITSIO)2405 b(3)136 2280 y Fi(2.1)94 b(Building)28 +b(the)i(Library)57 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)f(.)131 b(3)136 2442 y(2.2)94 b(T)-8 +b(esting)31 b(the)f(Library)i(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(6)136 2604 +y(2.3)94 b(Linking)29 b(Programs)h(with)f(FITSIO)40 b(.)46 +b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(7)136 +2766 y(2.4)94 b(Getting)31 b(Started)g(with)e(FITSIO)55 +b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)131 +b(8)136 2928 y(2.5)94 b(Example)30 b(Program)86 b(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +f(.)131 b(8)136 3090 y(2.6)94 b(Legal)31 b(Stu\013)92 +b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)131 b(9)136 3252 y(2.7)94 +b(Ac)m(kno)m(wledgemen)m(ts)60 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(10)0 3511 +y Fh(3)119 b(A)35 b(FITS)f(Primer)2917 b(13)0 3771 y(4)119 +b(Extended)35 b(File)f(Name)g(Syn)m(tax)2330 b(15)136 +3933 y Fi(4.1)94 b(Ov)m(erview)83 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(15)136 4095 y(4.2)94 b(Filet)m(yp)s(e)60 b(.)45 b(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)85 b(18)345 4257 y(4.2.1)106 b(Notes)32 b(ab)s(out)e(HTTP)g(pro) +m(xy)g(serv)m(ers)k(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(18)345 4419 y(4.2.2)106 b(Notes)32 b(ab)s(out)e(the)h(ro)s(ot)f +(\014let)m(yp)s(e)67 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(18)345 4581 y(4.2.3)106 b(Notes)32 b(ab)s(out)e(the)h(shmem)e +(\014let)m(yp)s(e:)69 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(20)136 4742 y(4.3)94 b(Base)32 b(Filename)88 b(.)45 +b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)f(.)85 b(21)136 4904 y(4.4)94 b(Output)30 b(File)f(Name)i(when) +f(Op)s(ening)e(an)i(Existing)f(File)79 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(23)136 +5066 y(4.5)94 b(T)-8 b(emplate)31 b(File)f(Name)h(when)e(Creating)h(a)h +(New)f(File)55 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(24)136 5228 y(4.6)94 +b(HDU)32 b(Lo)s(cation)e(Sp)s(eci\014cation)45 b(.)g(.)h(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(24)136 5390 y(4.7)94 +b(Image)32 b(Section)38 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(25)136 +5552 y(4.8)94 b(Column)29 b(and)h(Keyw)m(ord)g(Filtering)e(Sp)s +(eci\014cation)89 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(26)136 5714 +y(4.9)94 b(Ro)m(w)31 b(Filtering)e(Sp)s(eci\014cation)80 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(28)1912 5942 y(iii)p eop +%%Page: 4 4 +4 3 bop 0 299 a Fi(iv)3310 b Fg(CONTENTS)345 555 y Fi(4.9.1)106 +b(General)31 b(Syn)m(tax)44 b(.)i(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(28)345 716 y(4.9.2)106 +b(Bit)31 b(Masks)43 b(.)j(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(30)345 876 y(4.9.3)106 +b(V)-8 b(ector)32 b(Columns)91 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(31)345 1037 y(4.9.4)106 +b(Go)s(o)s(d)30 b(Time)g(In)m(terv)-5 b(al)30 b(Filtering)59 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(33)345 1197 +y(4.9.5)106 b(Spatial)29 b(Region)i(Filtering)56 b(.)46 +b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(33)345 +1358 y(4.9.6)106 b(Example)30 b(Ro)m(w)h(Filters)f(.)45 +b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(36)136 1518 y(4.10)80 b(Binning)28 b(or)i(Histogramming)g(Sp)s +(eci\014cation)f(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(37)0 +1771 y Fh(5)f(T)-9 b(emplate)34 b(Files)2985 b(41)136 +1931 y Fi(5.1)94 b(Detailed)31 b(T)-8 b(emplate)30 b(Line)g(F)-8 +b(ormat)48 b(.)e(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(41)136 2092 y(5.2)94 b(Auto-indexing)29 b(of)i(Keyw)m(ords)73 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(42)136 2252 y(5.3)94 b(T)-8 b(emplate)31 b(P)m(arser)g(Directiv)m(es) +85 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(43)136 2412 y(5.4)94 b(F)-8 b(ormal)31 b(T)-8 b(emplate)31 +b(Syn)m(tax)j(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)85 b(43)136 2573 y(5.5)94 b(Errors)63 b(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(44)136 2733 y(5.6)94 +b(Examples)71 b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(44)0 +2986 y Fh(6)f(FITSIO)34 b(Con)m(v)m(en)m(tions)h(and)g(Guidelines)1993 +b(47)136 3146 y Fi(6.1)94 b(CFITSIO)29 b(Size)h(Limitations)39 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(47)136 3307 y(6.2)94 b(Multiple)29 b(Access)i(to)g(the)g(Same)f(FITS) +g(File)f(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(48)136 +3467 y(6.3)94 b(Curren)m(t)30 b(Header)h(Data)h(Unit)d(\(CHDU\))87 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(48)136 3628 +y(6.4)94 b(Subroutine)28 b(Names)79 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(48)136 +3788 y(6.5)94 b(Subroutine)28 b(F)-8 b(amilies)30 b(and)f(Datat)m(yp)s +(es)44 b(.)i(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(49)136 +3949 y(6.6)94 b(Implicit)28 b(Data)k(T)m(yp)s(e)e(Con)m(v)m(ersion)64 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(50)136 4109 y(6.7)94 b(Data)32 b(Scaling)87 b(.)46 +b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)f(.)85 b(50)136 4270 y(6.8)94 b(Error)30 +b(Status)g(V)-8 b(alues)31 b(and)e(the)i(Error)e(Message)j(Stac)m(k)44 +b(.)i(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)85 b(51)136 4430 y(6.9)94 b(V)-8 b(ariable-Length)31 +b(Arra)m(y)f(F)-8 b(acilit)m(y)31 b(in)e(Binary)g(T)-8 +b(ables)25 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(51)136 4591 y(6.10)49 +b(Supp)s(ort)29 b(for)h(IEEE)g(Sp)s(ecial)e(V)-8 b(alues)67 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(52)136 +4751 y(6.11)49 b(When)31 b(the)f(Final)f(Size)h(of)h(the)f(FITS)g(HDU)h +(is)e(Unkno)m(wn)34 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(53)136 4912 y(6.12)49 +b(Lo)s(cal)31 b(FITS)e(Con)m(v)m(en)m(tions)i(supp)s(orted)d(b)m(y)j +(FITSIO)72 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(53)345 5072 y(6.12.1)61 +b(Supp)s(ort)29 b(for)h(Long)g(String)f(Keyw)m(ord)h(V)-8 +b(alues.)61 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)f(.)85 b(54)345 5232 y(6.12.2)61 +b(Arra)m(ys)31 b(of)f(Fixed-Length)g(Strings)f(in)g(Binary)h(T)-8 +b(ables)69 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)85 b(54)345 5393 y(6.12.3)61 b(Keyw)m(ord)30 b(Units)g(Strings)i +(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(55)345 5553 y(6.12.4)61 b(HIERAR)m(CH)31 b(Con)m(v)m(en)m(tion)g(for) +f(Extended)g(Keyw)m(ord)g(Names)83 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)f(.)85 b(55)136 5714 y(6.13)49 b(Optimizing)28 +b(Co)s(de)i(for)g(Maxim)m(um)g(Pro)s(cessing)g(Sp)s(eed)44 +b(.)i(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)85 b(56)p eop +%%Page: 5 5 +5 4 bop 0 299 a Fg(CONTENTS)3334 b Fi(v)345 555 y(6.13.1)61 +b(Bac)m(kground)31 b(Information:)40 b(Ho)m(w)31 b(CFITSIO)e(Manages)j +(Data)g(I/O)91 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(57)0 816 y Fh(7)119 b(The)35 b(CFITSIO)e(Iterator)g(F)-9 +b(unction)2154 b(61)0 1077 y(8)119 b(Basic)36 b(In)m(terface)e +(Routines)2504 b(63)136 1239 y Fi(8.1)94 b(FITSIO)30 +b(Error)f(Status)h(Routines)83 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)f(.)85 b(63)136 1401 y(8.2)94 b(File)30 b(I/O)g(Routines)d(.)46 +b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)f(.)85 b(64)136 1563 y(8.3)94 b(Keyw)m(ord)31 b(I/O)f(Routines)35 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)85 b(66)136 1725 y(8.4)94 b(Data)32 b(I/O)f(Routines)52 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)85 b(66)0 1986 y Fh(9)119 b(Adv)-6 b(anced)36 +b(In)m(terface)e(Subroutines)2159 b(69)136 2148 y Fi(9.1)94 +b(FITS)30 b(File)g(Op)s(en)f(and)g(Close)h(Subroutines:)75 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(69)136 2310 y(9.2)94 +b(HDU-Lev)m(el)32 b(Op)s(erations)107 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(72)136 2472 +y(9.3)94 b(De\014ne)31 b(or)f(Rede\014ne)g(the)h(structure)f(of)g(the)h +(CHDU)99 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(75)136 2634 y(9.4)94 +b(FITS)30 b(Header)h(I/O)f(Subroutines)h(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)f(.)85 b(76)345 2796 y(9.4.1)106 +b(Header)31 b(Space)g(and)f(P)m(osition)f(Routines)59 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)f(.)85 b(76)345 2958 y(9.4.2)106 +b(Read)31 b(or)f(W)-8 b(rite)31 b(Standard)e(Header)i(Routines)66 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)f(.)85 b(77)345 3120 y(9.4.3)106 b(W)-8 b(rite)31 +b(Keyw)m(ord)f(Subroutines)115 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.) +85 b(78)345 3283 y(9.4.4)106 b(Insert)30 b(Keyw)m(ord)g(Subroutines)107 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(80)345 3445 +y(9.4.5)106 b(Read)31 b(Keyw)m(ord)f(Subroutines)63 b(.)46 +b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h +(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(81)345 3607 +y(9.4.6)106 b(Mo)s(dify)29 b(Keyw)m(ord)i(Subroutines)54 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(82)345 3769 +y(9.4.7)106 b(Up)s(date)31 b(Keyw)m(ord)f(Subroutines)115 +b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(83)345 3931 +y(9.4.8)106 b(Delete)32 b(Keyw)m(ord)e(Subroutines)86 +b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.) +h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(84)136 4093 +y(9.5)94 b(Data)32 b(Scaling)e(and)f(Unde\014ned)g(Pixel)g(P)m +(arameters)113 b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(84)136 4255 y(9.6)94 +b(FITS)30 b(Primary)f(Arra)m(y)i(or)f(IMA)m(GE)h(Extension)f(I/O)g +(Subroutines)116 b(.)46 b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f +(.)85 b(85)136 4417 y(9.7)94 b(FITS)30 b(ASCI)s(I)f(and)h(Binary)f(T)-8 +b(able)30 b(Data)i(I/O)e(Subroutines)c(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f +(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(88)345 +4579 y(9.7.1)106 b(Column)29 b(Information)g(Subroutines)120 +b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 b(88)345 4741 y(9.7.2)106 +b(Lo)m(w-Lev)m(el)32 b(T)-8 b(able)30 b(Access)h(Subroutines)59 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)f(.)85 b(91)345 4903 y(9.7.3)106 +b(Edit)30 b(Ro)m(ws)g(or)h(Columns)105 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)f(.)85 b(92)345 5066 y(9.7.4)106 b(Read)31 +b(and)f(W)-8 b(rite)30 b(Column)f(Data)j(Routines)65 +b(.)46 b(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)f(.)85 b(93)136 5228 y(9.8)94 b(Ro)m(w)31 +b(Selection)f(and)g(Calculator)g(Routines)94 b(.)46 b(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.) +g(.)f(.)85 b(96)136 5390 y(9.9)94 b(Celestial)30 b(Co)s(ordinate)f +(System)h(Subroutines)97 b(.)46 b(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(98)136 5552 y(9.10)49 b(File)30 b(Chec)m(ksum)g(Subroutines)74 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)85 +b(99)136 5714 y(9.11)80 b(Date)32 b(and)d(Time)h(Utilit)m(y)f(Routines) +68 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 +b(101)p eop +%%Page: 6 6 +6 5 bop 0 299 a Fi(vi)3310 b Fg(CONTENTS)136 555 y Fi(9.12)49 +b(General)31 b(Utilit)m(y)e(Subroutines)60 b(.)45 b(.)h(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)40 b(102)0 806 y Fh(10)67 +b(Summary)34 b(of)h(all)f(FITSIO)g(User-In)m(terface)h(Subroutines)1215 +b(109)0 1057 y(11)67 b(P)m(arameter)34 b(De\014nitions)2563 +b(117)0 1308 y(12)67 b(FITSIO)33 b(Error)i(Status)g(Co)s(des)2295 +b(123)p eop +%%Page: 1 7 +1 6 bop 0 1225 a Ff(Chapter)65 b(1)0 1687 y Fl(In)-6 +b(tro)6 b(duction)0 2180 y Fi(This)32 b(do)s(cumen)m(t)j(describ)s(es)d +(the)i(F)-8 b(ortran-callable)35 b(subroutine)d(in)m(terface)j(that)g +(is)e(pro)m(vided)g(as)h(part)g(of)h(the)0 2293 y(CFITSIO)f(library)f +(\(whic)m(h)i(is)g(written)g(in)f(ANSI)h(C\).)h(This)e(is)h(a)h +(companion)f(do)s(cumen)m(t)g(to)i(the)e(CFITSIO)0 2406 +y(User's)k(Guide)e(whic)m(h)h(should)e(b)s(e)i(consulted)g(for)g +(further)g(information)f(ab)s(out)h(the)h(underlying)c(CFITSIO)0 +2518 y(library)-8 b(.)48 b(In)32 b(the)i(remainder)e(of)h(this)g(do)s +(cumen)m(t,)h(the)g(terms)f(FITSIO)f(and)h(CFITSIO)f(are)i(in)m(terc)m +(hangeable)0 2631 y(and)c(refer)g(to)h(the)g(same)f(library)-8 +b(.)0 2791 y(FITSIO/CFITSIO)31 b(is)i(a)g(mac)m(hine-indep)s(enden)m(t) +e(library)g(of)j(routines)e(for)h(reading)g(and)g(writing)e(data)j +(\014les)0 2904 y(in)29 b(the)h(FITS)g(\(Flexible)f(Image)i(T)-8 +b(ransp)s(ort)29 b(System\))h(data)h(format.)41 b(It)31 +b(can)f(also)g(read)h(IRAF)f(format)h(image)0 3017 y(\014les)39 +b(and)f(ra)m(w)i(binary)e(data)i(arra)m(ys)g(b)m(y)g(con)m(v)m(erting)g +(them)f(on)h(the)g(\015y)f(in)m(to)g(a)h(virtual)e(FITS)h(format)h +(\014le.)0 3130 y(This)31 b(library)g(w)m(as)i(written)f(to)i(pro)m +(vide)e(a)i(p)s(o)m(w)m(erful)e(y)m(et)i(simple)d(in)m(terface)i(for)g +(accessing)h(FITS)e(\014les)g(whic)m(h)0 3243 y(will)h(run)h(on)h(most) +h(commonly)f(used)f(computers)h(and)g(w)m(orkstations.)56 +b(FITSIO)34 b(supp)s(orts)g(all)g(the)i(features)0 3356 +y(describ)s(ed)20 b(in)i(the)g(o\016cial)g(NOST)g(de\014nition)e(of)j +(the)f(FITS)g(format)h(and)f(can)h(read)f(and)g(write)g(all)f(the)i +(curren)m(tly)0 3469 y(de\014ned)40 b(t)m(yp)s(es)h(of)g(extensions,)i +(including)38 b(ASCI)s(I)h(tables)i(\(T)-8 b(ABLE\),)42 +b(Binary)e(tables)h(\(BINT)-8 b(ABLE\))43 b(and)0 3582 +y(IMA)m(GE)36 b(extensions.)55 b(The)34 b(FITSIO)g(subroutines)f +(insulate)h(the)h(programmer)g(from)g(ha)m(ving)g(to)h(deal)e(with)0 +3695 y(the)25 b(complicated)f(formatting)h(details)e(in)g(the)i(FITS)f +(\014le,)h(ho)m(w)m(ev)m(er,)j(it)c(is)f(assumed)h(that)h(users)f(ha)m +(v)m(e)i(a)f(general)0 3808 y(kno)m(wledge)30 b(ab)s(out)g(the)h +(structure)f(and)g(usage)h(of)f(FITS)g(\014les.)0 3968 +y(The)20 b(CFITSIO)f(pac)m(k)-5 b(age)23 b(w)m(as)e(initially)d(dev)m +(elop)s(ed)i(b)m(y)g(the)h(HEASAR)m(C)g(\(High)g(Energy)f(Astroph)m +(ysics)g(Science)0 4081 y(Arc)m(hiv)m(e)34 b(Researc)m(h)h(Cen)m(ter\)) +f(at)h(the)f(NASA)g(Go)s(ddard)e(Space)j(Fligh)m(t)e(Cen)m(ter)h(to)h +(con)m(v)m(ert)g(v)-5 b(arious)33 b(existing)0 4194 y(and)25 +b(newly)g(acquired)g(astronomical)h(data)g(sets)h(in)m(to)f(FITS)f +(format)h(and)f(to)i(further)e(analyze)h(data)h(already)e(in)0 +4307 y(FITS)i(format.)41 b(New)28 b(features)g(con)m(tin)m(ue)g(to)h(b) +s(e)e(added)h(to)g(CFITSIO)f(in)f(large)i(part)g(due)g(to)g(con)m +(tributions)f(of)0 4419 y(ideas)32 b(or)h(actual)g(co)s(de)g(from)f +(users)g(of)h(the)g(pac)m(k)-5 b(age.)49 b(The)33 b(In)m(tegral)g +(Science)f(Data)i(Cen)m(ter)f(in)f(Switzerland,)0 4532 +y(and)h(the)g(XMM/ESTEC)h(pro)5 b(ject)34 b(in)e(The)h(Netherlands)f +(made)h(esp)s(ecially)f(signi\014can)m(t)g(con)m(tributions)g(that)0 +4645 y(resulted)d(in)g(man)m(y)i(of)f(the)h(new)f(features)g(that)h +(app)s(eared)f(in)f(v2.0)j(of)e(CFITSIO.)0 4805 y(The)22 +b(latest)h(v)m(ersion)f(of)h(the)f(CFITSIO)f(source)i(co)s(de,)h(do)s +(cumen)m(tation,)h(and)c(example)i(programs)f(are)h(a)m(v)-5 +b(ailable)0 4918 y(on)30 b(the)h(W)-8 b(orld-Wide)30 +b(W)-8 b(eb)31 b(or)f(via)g(anon)m(ymous)g(ftp)g(from:)382 +5178 y Fe(http://heasarc.gsfc.nasa)o(.go)o(v/fi)o(tsio)382 +5291 y(ftp://legacy.gsfc.nasa.g)o(ov/)o(soft)o(ware)o(/fi)o(tsio)o(/c) +1927 5942 y Fi(1)p eop +%%Page: 2 8 +2 7 bop 0 299 a Fi(2)2452 b Fg(CHAPTER)30 b(1.)71 b(INTR)m(ODUCTION)0 +555 y Fi(An)m(y)28 b(questions,)f(bug)g(rep)s(orts,)h(or)f(suggested)i +(enhancemen)m(ts)f(related)f(to)i(the)e(CFITSIO)f(pac)m(k)-5 +b(age)30 b(should)c(b)s(e)0 668 y(sen)m(t)31 b(to)g(the)g(primary)d +(author:)382 928 y Fe(Dr.)47 b(William)f(Pence)810 b(Telephone:)92 +b(\(301\))47 b(286-4599)382 1041 y(HEASARC,)e(Code)i(662)811 +b(E-mail:)45 b(pence@tetra.gsfc.nasa.gov)382 1154 y(NASA/Goddard)f +(Space)j(Flight)f(Center)382 1267 y(Greenbelt,)f(MD)i(20771,)f(USA)0 +1526 y Fi(This)39 b(User's)j(Guide)e(assumes)h(that)h(readers)f +(already)f(ha)m(v)m(e)j(a)f(general)f(understanding)d(of)k(the)f +(de\014nition)0 1639 y(and)31 b(structure)g(of)h(FITS)e(format)i +(\014les.)43 b(F)-8 b(urther)32 b(information)d(ab)s(out)j(FITS)f +(formats)g(is)g(a)m(v)-5 b(ailable)31 b(from)g(the)0 +1752 y(FITS)h(Supp)s(ort)f(O\016ce)i(at)g Fe(http://fits.gsfc.nasa.gov) +o Fi(.)42 b(In)32 b(particular,)g(the)h('NOST)f(FITS)g(Standard')0 +1865 y(giv)m(es)i(the)h(authoritativ)m(e)f(de\014nition)e(of)i(the)g +(FITS)g(data)h(format,)g(and)f(the)g(`FITS)g(User's)g(Guide')f(pro)m +(vides)0 1978 y(additional)28 b(historical)h(bac)m(kground)h(and)g +(practical)g(advice)g(on)g(using)f(FITS)h(\014les.)0 +2138 y(CFITSIO)j(users)g(ma)m(y)h(also)g(b)s(e)g(in)m(terested)g(in)f +(the)h(FTOOLS)f(pac)m(k)-5 b(age)36 b(of)e(programs)g(that)g(can)h(b)s +(e)e(used)g(to)0 2251 y(manipulate)i(and)g(analyze)i(FITS)f(format)g +(\014les.)58 b(Information)35 b(ab)s(out)h(FTOOLS)f(can)i(b)s(e)f +(obtained)f(on)i(the)0 2364 y(W)-8 b(eb)31 b(or)f(via)g(anon)m(ymous)h +(ftp)f(at:)382 2624 y Fe(http://heasarc.gsfc.nasa)o(.go)o(v/ft)o(ools) +382 2737 y(ftp://legacy.gsfc.nasa.g)o(ov/)o(soft)o(ware)o(/ft)o(ools)o +(/rel)o(eas)o(e)p eop +%%Page: 3 9 +3 8 bop 0 1225 a Ff(Chapter)65 b(2)0 1687 y Fl(Creating)77 +b(FITSIO/CFITSIO)0 2216 y Fd(2.1)135 b(Building)45 b(the)h(Library)0 +2467 y Fi(T)-8 b(o)43 b(use)g(the)g(FITSIO)f(subroutines)e(one)k(m)m +(ust)e(\014rst)g(build)e(the)j(CFITSIO)f(library)-8 b(,)44 +b(whic)m(h)e(requires)f(a)i(C)0 2580 y(compiler.)71 b(gcc)43 +b(is)d(ideal,)i(or)f(most)h(other)f(ANSI-C)g(compilers)e(will)g(also)i +(w)m(ork.)73 b(The)40 b(CFITSIO)g(co)s(de)h(is)0 2692 +y(con)m(tained)24 b(in)f(ab)s(out)g(40)i(C)f(source)g(\014les)e +(\(*.c\))k(and)d(header)h(\014les)f(\(*.h\).)39 b(On)23 +b(V)-10 b(AX/VMS)25 b(systems)f(2)g(assem)m(bly-)0 2805 +y(co)s(de)31 b(\014les)e(\(vmsieeed.mar)h(and)g(vmsieeer.mar\))g(are)h +(also)f(needed.)0 2965 y(The)45 b(F)-8 b(ortran)46 b(in)m(terface)f +(subroutines)e(to)j(the)f(C)g(CFITSIO)f(routines)g(are)h(lo)s(cated)h +(in)e(the)h(f77)p 3538 2965 28 4 v 33 w(wrap1.c,)0 3078 +y(through)22 b(f77)p 459 3078 V 33 w(wrap4.c)h(\014les.)37 +b(These)22 b(are)h(relativ)m(ely)f(simple)e('wrapp)s(ers')h(that)i +(translate)g(the)g(argumen)m(ts)g(in)e(the)0 3191 y(F)-8 +b(ortran)26 b(subroutine)d(in)m(to)j(the)f(appropriate)g(format)h(for)f +(the)g(corresp)s(onding)f(C)h(routine.)38 b(This)23 b(translation)i(is) +0 3304 y(p)s(erformed)19 b(transparen)m(tly)h(to)h(the)g(user)f(b)m(y)g +(a)h(set)h(of)e(C)h(macros)g(lo)s(cated)g(in)e(the)i(cfortran.h)f +(\014le.)37 b(Unfortunately)0 3417 y(cfortran.h)28 b(do)s(es)g(not)g +(supp)s(ort)f(ev)m(ery)h(com)m(bination)g(of)g(C)g(and)f(F)-8 +b(ortran)29 b(compilers)e(so)h(the)h(F)-8 b(ortran)28 +b(in)m(terface)0 3530 y(is)h(not)i(supp)s(orted)e(on)h(all)f +(platforms.)40 b(\(see)31 b(further)e(notes)i(b)s(elo)m(w\).)0 +3690 y(A)f(standard)f(com)m(bination)h(of)g(C)f(and)h(F)-8 +b(ortran)30 b(compilers)f(will)e(b)s(e)i(assumed)h(b)m(y)f(default,)h +(but)f(one)h(ma)m(y)h(also)0 3803 y(sp)s(ecify)e(a)i(particular)d(F)-8 +b(ortran)32 b(compiler)c(b)m(y)j(doing:)48 4064 y Fe(>)95 +b(setenv)46 b(CFLAGS)g(-DcompilerName=1)0 4324 y Fi(\(where)33 +b('compilerName')f(is)g(the)h(name)f(of)h(the)g(compiler\))f(b)s(efore) +g(running)e(the)j(con\014gure)f(command.)47 b(The)0 4437 +y(curren)m(tly)29 b(recognized)i(compiler)e(names)h(are:)48 +4698 y Fe(g77Fortran)48 4811 y(IBMR2Fortran)48 4924 y(CLIPPERFortran)48 +5036 y(pgiFortran)48 5149 y(NAGf90Fortran)48 5262 y(f2cFortran)48 +5375 y(hpuxFortran)48 5488 y(apolloFortran)48 5601 y(sunFortran)48 +5714 y(CRAYFortran)1927 5942 y Fi(3)p eop +%%Page: 4 10 +4 9 bop 0 299 a Fi(4)1896 b Fg(CHAPTER)30 b(2.)111 b(CREA)-8 +b(TING)31 b(FITSIO/CFITSIO)48 555 y Fe(mipsFortran)48 +668 y(DECFortran)48 781 y(vmsFortran)48 894 y(CONVEXFortran)48 +1007 y(PowerStationFortran)48 1120 y(AbsoftUNIXFortran)48 +1233 y(AbsoftProFortran)48 1346 y(SXFortran)0 1580 y +Fi(Alternativ)m(ely)-8 b(,)39 b(one)f(ma)m(y)g(edit)f(the)g(CFLA)m(GS)h +(line)d(in)i(the)g(Mak)m(e\014le)h(to)g(add)f(the)h('-DcompilerName')g +(\015ag)0 1692 y(after)31 b(running)d(the)i('./con\014gure')h(command.) +0 1853 y(The)f(CFITSIO)f(library)f(is)h(built)f(on)j(Unix)e(systems)h +(b)m(y)g(t)m(yping:)48 2087 y Fe(>)95 b(./configure)45 +b([--prefix=/target/insta)o(llat)o(ion)o(/pat)o(h])48 +2199 y(>)95 b(make)476 b(\(or)95 b('make)46 b(shared'\))48 +2312 y(>)95 b(make)47 b(install)93 b(\(this)46 b(step)h(is)g +(optional\))0 2546 y Fi(at)24 b(the)g(op)s(erating)f(system)h(prompt.) +38 b(The)23 b(con\014gure)g(command)g(customizes)h(the)g(Mak)m(e\014le) +g(for)g(the)g(particular)0 2659 y(system,)g(then)d(the)g(`mak)m(e')i +(command)e(compiles)f(the)h(source)h(\014les)e(and)h(builds)d(the)j +(library)-8 b(.)36 b(T)m(yp)s(e)21 b(`./con\014gure')0 +2772 y(and)34 b(not)h(simply)d(`con\014gure')j(to)h(ensure)e(that)h +(the)g(con\014gure)g(script)e(in)h(the)h(curren)m(t)f(directory)g(is)g +(run)g(and)0 2885 y(not)29 b(some)g(other)g(system-wide)f(con\014gure)g +(script.)39 b(The)29 b(optional)f('pre\014x')g(argumen)m(t)h(to)g +(con\014gure)g(giv)m(es)g(the)0 2998 y(path)f(to)i(the)f(directory)f +(where)g(the)h(CFITSIO)f(library)e(and)i(include)f(\014les)g(should)g +(b)s(e)h(installed)f(via)h(the)h(later)0 3111 y('mak)m(e)j(install')c +(command.)41 b(F)-8 b(or)31 b(example,)143 3345 y Fe(>)48 +b(./configure)c(--prefix=/usr1/local)0 3579 y Fi(will)22 +b(cause)k(the)f('mak)m(e)h(install')d(command)i(to)h(cop)m(y)g(the)f +(CFITSIO)e(lib)s(c\014tsio)f(\014le)j(to)g(/usr1/lo)s(cal/lib)e(and)i +(the)0 3692 y(necessary)36 b(include)c(\014le)j(to)h(/usr1/lo)s +(cal/include)d(\(assuming)h(of)h(course)g(that)h(the)f(pro)s(cess)g +(has)g(p)s(ermission)0 3805 y(to)c(write)f(to)h(these)g(directories\).) +0 3965 y(By)d(default)g(this)f(also)h(builds)c(the)29 +b(set)f(of)h(F)-8 b(ortran-callable)28 b(wrapp)s(er)e(routines)h(whose) +h(calling)e(sequences)j(are)0 4078 y(describ)s(ed)f(later)j(in)e(this)g +(do)s(cumen)m(t.)0 4238 y(The)f('mak)m(e)h(shared')f(option)g(builds)d +(a)k(shared)e(or)i(dynamic)e(v)m(ersion)h(of)g(the)h(CFITSIO)d(library) +-8 b(.)38 b(When)28 b(using)0 4351 y(the)f(shared)f(library)f(the)i +(executable)g(co)s(de)g(is)f(not)h(copied)f(in)m(to)h(y)m(our)g +(program)g(at)g(link)e(time)h(and)h(instead)f(the)0 4464 +y(program)h(lo)s(cates)h(the)g(necessary)g(library)d(co)s(de)j(at)g +(run)e(time,)i(normally)e(through)g(LD)p 3065 4464 28 +4 v 33 w(LIBRAR)-8 b(Y)p 3514 4464 V 34 w(P)g(A)g(TH)28 +b(or)0 4577 y(some)j(other)f(metho)s(d.)41 b(The)29 b(adv)-5 +b(an)m(tages)33 b(of)d(using)f(a)i(shared)e(library)f(are:)143 +4811 y Fe(1.)95 b(Less)47 b(disk)f(space)h(if)g(you)g(build)f(more)h +(than)f(1)i(program)143 4924 y(2.)95 b(Less)47 b(memory)f(if)h(more)g +(than)f(one)h(copy)g(of)g(a)g(program)f(using)h(the)g(shared)334 +5036 y(library)f(is)h(running)f(at)h(the)g(same)g(time)f(since)h(the)g +(system)f(is)h(smart)334 5149 y(enough)f(to)h(share)g(copies)f(of)h +(the)g(shared)f(library)g(at)h(run)g(time.)143 5262 y(3.)95 +b(Possibly)46 b(easier)g(maintenance)e(since)j(a)g(new)g(version)f(of)h +(the)g(shared)334 5375 y(library)f(can)h(be)g(installed)e(without)h +(relinking)f(all)i(the)g(software)334 5488 y(that)g(uses)f(it)i(\(as)e +(long)h(as)g(the)g(subroutine)e(names)i(and)f(calling)334 +5601 y(sequences)f(remain)h(unchanged\).)143 5714 y(4.)95 +b(No)47 b(run-time)f(penalty.)p eop +%%Page: 5 11 +5 10 bop 0 299 a Fg(2.1.)72 b(BUILDING)31 b(THE)f(LIBRAR)-8 +b(Y)2507 b Fi(5)0 555 y(The)30 b(disadv)-5 b(an)m(tages)31 +b(are:)143 819 y Fe(1.)47 b(More)g(hassle)f(at)h(runtime.)94 +b(You)46 b(have)h(to)g(either)f(build)h(the)g(programs)286 +932 y(specially)f(or)h(have)f(LD_LIBRARY_PATH)e(set)j(right.)143 +1045 y(2.)g(There)g(may)g(be)g(a)g(slight)f(start)h(up)g(penalty,)e +(depending)h(on)h(where)f(you)h(are)286 1158 y(reading)f(the)h(shared)f +(library)g(and)h(the)g(program)f(from)g(and)h(if)g(your)g(CPU)g(is)286 +1271 y(either)f(really)h(slow)f(or)h(really)f(heavily)g(loaded.)0 +1535 y Fi(On)30 b(HP/UX)i(systems,)g(the)f(en)m(vironmen)m(t)g(v)-5 +b(ariable)30 b(CFLA)m(GS)h(should)e(b)s(e)i(set)g(to)h(-Ae)g(b)s(efore) +f(running)d(con-)0 1648 y(\014gure)i(to)h(enable)f("extended)h(ANSI")f +(features.)0 1808 y(It)f(ma)m(y)h(not)f(b)s(e)f(p)s(ossible)f(to)i +(staticly)g(link)e(programs)i(that)g(use)g(CFITSIO)e(on)i(some)h +(platforms)d(\(namely)-8 b(,)30 b(on)0 1921 y(Solaris)k(2.6\))j(due)e +(to)i(the)e(net)m(w)m(ork)i(driv)m(ers)d(\(whic)m(h)h(pro)m(vide)g(FTP) +g(and)g(HTTP)g(access)i(to)g(FITS)e(\014les\).)56 b(It)0 +2034 y(is)32 b(p)s(ossible)e(to)k(mak)m(e)f(b)s(oth)g(a)g(dynamic)e +(and)h(a)i(static)f(v)m(ersion)f(of)h(the)g(CFITSIO)e(library)-8 +b(,)32 b(but)g(net)m(w)m(ork)i(\014le)0 2147 y(access)e(will)27 +b(not)k(b)s(e)f(p)s(ossible)e(using)h(the)h(static)h(v)m(ersion.)0 +2307 y(On)d(V)-10 b(AX/VMS)31 b(and)d(ALPHA/VMS)i(systems)f(the)h(mak)m +(e)p 2100 2307 28 4 v 34 w(g\015oat.com)h(command)e(\014le)f(ma)m(y)i +(b)s(e)f(executed)h(to)0 2420 y(build)j(the)k(c\014tsio.olb)e(ob)5 +b(ject)37 b(library)d(using)h(the)h(default)g(G-\015oating)g(p)s(oin)m +(t)g(option)f(for)h(double)f(v)-5 b(ariables.)0 2533 +y(The)37 b(mak)m(e)p 405 2533 V 33 w(d\015oat.com)i(and)d(mak)m(e)p +1279 2533 V 34 w(ieee.com)i(\014les)f(ma)m(y)g(b)s(e)g(used)f(instead)h +(to)h(build)c(the)j(library)e(with)h(the)0 2646 y(other)26 +b(\015oating)h(p)s(oin)m(t)e(options.)38 b(Note)28 b(that)f(the)f +(getcwd)h(function)e(that)i(is)e(used)g(in)g(the)i(group.c)f(mo)s(dule) +e(ma)m(y)0 2758 y(require)43 b(that)j(programs)e(using)f(CFITSIO)g(b)s +(e)h(link)m(ed)g(with)f(the)i(ALPHA$LIBRAR)-8 b(Y:V)e(AX)m(CR)i(TL.OLB) +0 2871 y(library)g(.)39 b(See)30 b(the)h(example)f(link)e(line)h(in)g +(the)i(next)f(section)h(of)f(this)g(do)s(cumen)m(t.)0 +3032 y(On)25 b(Windo)m(ws)g(IBM-PC)h(t)m(yp)s(e)g(platforms)e(the)i +(situation)f(is)f(more)i(complicated)g(b)s(ecause)f(of)h(the)g(wide)f +(v)-5 b(ariet)m(y)0 3144 y(of)43 b(F)-8 b(ortran)43 b(compilers)f(that) +h(are)g(a)m(v)-5 b(ailable)42 b(and)g(b)s(ecause)h(of)g(the)g(inheren)m +(t)f(complexities)g(of)g(calling)g(the)0 3257 y(CFITSIO)25 +b(C)g(routines)g(from)h(F)-8 b(ortran.)40 b(Tw)m(o)26 +b(di\013eren)m(t)g(v)m(ersions)f(of)h(the)h(CFITSIO)d(dll)g(library)g +(are)i(a)m(v)-5 b(ailable,)0 3370 y(compiled)26 b(with)f(the)j(Borland) +e(C++)g(compiler)g(and)g(the)i(Microsoft)f(Visual)f(C++)g(compiler,)g +(resp)s(ectiv)m(ely)-8 b(,)28 b(in)0 3483 y(the)i(\014les)f(c\014tsio)s +(dll)p 682 3483 V 30 w(2xxx)p 901 3483 V 34 w(b)s(orland.zip)e(and)i +(c\014tsio)s(dll)p 1927 3483 V 30 w(2xxx)p 2146 3483 +V 33 w(v)m(cc.zip,)i(where)f('2xxx')h(represen)m(ts)f(the)g(curren)m(t) +0 3596 y(release)43 b(n)m(um)m(b)s(er.)76 b(Both)43 b(these)g(dll)e +(libraries)f(con)m(tain)j(a)g(set)g(of)f(F)-8 b(ortran)44 +b(wrapp)s(er)d(routines)g(whic)m(h)g(ma)m(y)0 3709 y(b)s(e)c +(compatible)g(with)f(some,)k(but)d(probably)f(not)h(all,)i(a)m(v)-5 +b(ailable)37 b(F)-8 b(ortran)38 b(compilers.)61 b(T)-8 +b(o)38 b(test)g(if)f(they)h(are)0 3822 y(compatible,)27 +b(compile)f(the)h(program)g(testf77.f)h(and)f(try)f(linking)f(to)i +(these)h(dll)c(libraries.)37 b(If)27 b(these)g(libraries)d(do)0 +3935 y(not)29 b(w)m(ork)g(with)e(a)i(particular)e(F)-8 +b(ortran)30 b(compiler,)e(then)g(there)h(are)g(2)g(p)s(ossible)e +(solutions.)38 b(The)28 b(\014rst)g(solution)0 4048 y(w)m(ould)g(b)s(e) +i(to)g(mo)s(dify)e(the)i(\014le)e(cfortran.h)i(for)f(that)i(particular) +d(com)m(bination)h(of)h(C)f(and)g(F)-8 b(ortran)30 b(compilers,)0 +4161 y(and)k(then)g(rebuild)d(the)k(CFITSIO)d(dll)h(library)-8 +b(.)50 b(This)33 b(will)f(require,)i(ho)m(w)m(ev)m(er,)j(a)e(some)f +(exp)s(ertise)g(in)f(mixed)0 4274 y(language)e(programming.)39 +b(The)30 b(other)h(solution)d(is)i(to)h(use)f(the)g(older)g(v5.03)i(F) +-8 b(ortran-77)32 b(implemen)m(tation)d(of)0 4386 y(FITSIO)c(that)h(is) +f(still)f(a)m(v)-5 b(ailable)25 b(from)g(the)h(FITSIO)f(w)m(eb-site.)39 +b(This)24 b(v)m(ersion)h(is)g(no)h(longer)f(supp)s(orted,)g(but)g(it)0 +4499 y(do)s(es)k(pro)m(vide)g(the)h(basic)g(functions)e(for)h(reading)g +(and)g(writing)f(FITS)h(\014les)g(and)g(should)f(b)s(e)h(compatible)g +(with)0 4612 y(most)i(F)-8 b(ortran)31 b(compilers.)0 +4772 y(CFITSIO)e(has)h(curren)m(tly)f(b)s(een)h(tested)h(on)f(the)h +(follo)m(wing)e(platforms:)95 5036 y Fe(OPERATING)46 +b(SYSTEM)523 b(COMPILER)143 5149 y(Sun)47 b(OS)1002 b(gcc)47 +b(and)g(cc)g(\(3.0.1\))143 5262 y(Sun)g(Solaris)762 b(gcc)47 +b(and)g(cc)143 5375 y(Silicon)f(Graphics)g(IRIX)285 b(gcc)47 +b(and)g(cc)143 5488 y(Silicon)f(Graphics)g(IRIX64)189 +b(MIPS)143 5601 y(Dec)47 b(Alpha)f(OSF/1)572 b(gcc)47 +b(and)g(cc)143 5714 y(DECstation)93 b(Ultrix)428 b(gcc)p +eop +%%Page: 6 12 +6 11 bop 0 299 a Fi(6)1896 b Fg(CHAPTER)30 b(2.)111 b(CREA)-8 +b(TING)31 b(FITSIO/CFITSIO)143 555 y Fe(Dec)47 b(Alpha)f(OpenVMS)476 +b(cc)143 668 y(DEC)47 b(VAX/VMS)762 b(gcc)47 b(and)g(cc)143 +781 y(HP-UX)1049 b(gcc)143 894 y(IBM)47 b(AIX)954 b(gcc)143 +1007 y(Linux)1049 b(gcc)143 1120 y(MkLinux)953 b(DR3)143 +1233 y(Windows)46 b(95/98/NT)523 b(Borland)46 b(C++)h(V4.5)143 +1346 y(Windows)f(95/98/NT/ME/XP)235 b(Microsoft/Compaq)43 +b(Visual)j(C++)h(v5.0,)g(v6.0)143 1458 y(Windows)f(95/98/NT)523 +b(Cygwin)46 b(gcc)143 1571 y(OS/2)1097 b(gcc)47 b(+)g(EMX)143 +1684 y(MacOS)g(7.1)f(or)i(greater)332 b(Metrowerks)45 +b(10.+)0 1949 y Fi(CFITSIO)26 b(will)g(probably)g(run)g(on)i(most)g +(other)h(Unix)d(platforms.)39 b(Cra)m(y)28 b(sup)s(ercomputers)e(are)j +(curren)m(tly)e(not)0 2061 y(supp)s(orted.)0 2400 y Fd(2.2)135 +b(T)-11 b(esting)46 b(the)f(Library)0 2652 y Fi(The)40 +b(CFITSIO)e(library)g(should)g(b)s(e)h(tested)i(b)m(y)f(building)c(and) +j(running)f(the)i(testprog.c)h(program)f(that)h(is)0 +2765 y(included)28 b(with)h(the)h(release.)41 b(On)30 +b(Unix)f(systems)h(t)m(yp)s(e:)191 3029 y Fe(\045)47 +b(make)g(testprog)191 3142 y(\045)g(testprog)f(>)h(testprog.lis)191 +3255 y(\045)g(diff)g(testprog.lis)d(testprog.out)191 +3368 y(\045)j(cmp)g(testprog.fit)e(testprog.std)0 3632 +y Fi(On)30 b(VMS)g(systems,)g(\(assuming)g(cc)h(is)e(the)i(name)f(of)h +(the)f(C)g(compiler)f(command\),)i(t)m(yp)s(e:)191 3896 +y Fe($)47 b(cc)h(testprog.c)191 4009 y($)f(link)g(testprog,)e +(cfitsio/lib,)g(alpha$library:vaxcrtl/l)o(ib)191 4122 +y($)i(run)g(testprog)0 4386 y Fi(The)30 b(testprog)h(program)g(should)d +(pro)s(duce)h(a)i(FITS)f(\014le)f(called)h(`testprog.\014t')i(that)f +(is)e(iden)m(tical)h(to)h(the)f(`test-)0 4499 y(prog.std')25 +b(FITS)f(\014le)f(included)f(with)h(this)h(release.)39 +b(The)24 b(diagnostic)g(messages)i(\(whic)m(h)d(w)m(ere)i(pip)s(ed)e +(to)i(the)g(\014le)0 4612 y(testprog.lis)f(in)f(the)i(Unix)e(example\)) +i(should)d(b)s(e)i(iden)m(tical)g(to)h(the)g(listing)d(con)m(tained)j +(in)e(the)i(\014le)e(testprog.out.)0 4725 y(The)30 b('di\013)7 +b(')30 b(and)f('cmp')i(commands)f(sho)m(wn)g(ab)s(o)m(v)m(e)h(should)e +(not)h(rep)s(ort)g(an)m(y)h(di\013erences)f(in)f(the)h(\014les.)40 +b(\(There)0 4838 y(ma)m(y)35 b(b)s(e)e(some)h(minor)f(formatting)g +(di\013erences,)i(suc)m(h)e(as)i(the)f(presence)g(or)g(absence)g(of)g +(leading)f(zeros,)j(or)e(3)0 4951 y(digit)29 b(exp)s(onen)m(ts)h(in)f +(n)m(um)m(b)s(ers,)h(whic)m(h)f(can)h(b)s(e)g(ignored\).)0 +5111 y(The)f(F)-8 b(ortran)31 b(wrapp)s(ers)d(in)g(CFITSIO)g(ma)m(y)j +(b)s(e)e(tested)h(with)f(the)h(testf77)h(program.)40 +b(On)29 b(Unix)g(systems)h(the)0 5224 y(fortran)g(compilation)f(and)h +(link)e(command)i(ma)m(y)h(b)s(e)f(called)f('f77')j(or)e('g77',)j(dep)s +(ending)28 b(on)i(the)g(system.)143 5488 y Fe(\045)48 +b(f77)f(-o)g(testf77)f(testf77.f)f(-L.)i(-lcfitsio)e(-lnsl)h(-lsocket) +48 5601 y(or)143 5714 y(\045)i(f77)f(-f)g(-o)g(testf77)f(testf77.f)f +(-L.)i(-lcfitsio)188 b(\(under)46 b(SUN)h(O/S\))p eop +%%Page: 7 13 +7 12 bop 0 299 a Fg(2.3.)72 b(LINKING)30 b(PR)m(OGRAMS)h(WITH)f(FITSIO) +2041 b Fi(7)48 555 y Fe(or)143 668 y(\045)48 b(f77)f(-o)g(testf77)f +(testf77.f)f(-Wl,-L.)h(-lcfitsio)f(-lm)i(-lnsl)f(-lsocket)g(\(HP/UX\)) +48 781 y(or)143 894 y(\045)i(g77)f(-o)g(testf77)f(-s)h(testf77.f)e +(-lcfitsio)g(-lcc_dynamic)g(-lncurses)g(\(Mac)i(OS-X\))143 +1120 y(\045)h(testf77)d(>)j(testf77.lis)143 1233 y(\045)g(diff)e +(testf77.lis)f(testf77.out)143 1346 y(\045)j(cmp)f(testf77.fit)d +(testf77.std)0 1591 y Fi(On)31 b(mac)m(hines)g(running)f(SUN)h(O/S,)h +(F)-8 b(ortran)33 b(programs)e(m)m(ust)h(b)s(e)f(compiled)f(with)h(the) +h('-f)7 b(')32 b(option)g(to)g(force)0 1704 y(double)24 +b(precision)g(v)-5 b(ariables)24 b(to)i(b)s(e)f(aligned)f(on)i(8-b)m +(yte)h(b)s(oundarys)c(to)j(mak)m(e)h(the)e(fortran-declared)g(v)-5 +b(ariables)0 1817 y(compatible)32 b(with)f(C.)h(A)h(similar)d(compiler) +h(option)h(ma)m(y)h(b)s(e)f(required)f(on)h(other)h(platforms.)47 +b(F)-8 b(ailing)31 b(to)i(use)0 1930 y(this)25 b(option)g(ma)m(y)h +(cause)h(the)f(program)f(to)i(crash)e(on)h(FITSIO)f(routines)f(that)j +(read)f(or)f(write)g(double)g(precision)0 2043 y(v)-5 +b(ariables.)0 2203 y(Also)30 b(note)h(that)f(on)g(some)h(systems,)f +(the)h(output)e(listing)f(of)j(the)f(testf77)i(program)d(ma)m(y)i +(di\013er)e(sligh)m(tly)f(from)0 2316 y(the)j(testf77.std)h(template,)f +(if)f(leading)f(zeros)i(are)g(not)g(prin)m(ted)e(b)m(y)i(default)f(b)s +(efore)g(the)h(decimal)e(p)s(oin)m(t)h(when)0 2429 y(using)f(F)i +(format.)0 2589 y(A)f(few)h(other)f(utilit)m(y)f(programs)h(are)h +(included)c(with)i(CFITSIO:)191 2835 y Fe(speed)46 b(-)i(measures)d +(the)i(maximum)f(throughput)f(\(in)i(MB)g(per)g(second\))668 +2947 y(for)g(writing)f(and)h(reading)f(FITS)g(files)h(with)f(CFITSIO) +191 3173 y(listhead)f(-)j(lists)e(all)h(the)g(header)f(keywords)g(in)h +(any)g(FITS)f(file)191 3399 y(fitscopy)f(-)j(copies)e(any)h(FITS)g +(file)f(\(especially)f(useful)h(in)h(conjunction)811 +3512 y(with)g(the)g(CFITSIO's)e(extended)h(input)g(filename)g(syntax\)) +191 3738 y(cookbook)f(-)j(a)f(sample)f(program)g(that)h(peforms)f +(common)g(read)g(and)811 3851 y(write)h(operations)e(on)i(a)g(FITS)g +(file.)191 4077 y(iter_a,)f(iter_b,)g(iter_c)g(-)h(examples)f(of)h(the) +g(CFITSIO)f(iterator)f(routine)0 4322 y Fi(The)30 b(\014rst)f(4)i(of)g +(these)g(utilit)m(y)d(programs)i(can)h(b)s(e)f(compiled)f(and)g(link)m +(ed)g(b)m(y)h(t)m(yping)143 4568 y Fe(\045)95 b(make)47 +b(program_name)0 4899 y Fd(2.3)135 b(Linking)45 b(Programs)h(with)f +(FITSIO)0 5149 y Fi(When)31 b(linking)d(applications)i(soft)m(w)m(are)i +(with)e(the)h(FITSIO)f(library)-8 b(,)30 b(sev)m(eral)i(system)f +(libraries)d(usually)h(need)0 5262 y(to)d(b)s(e)f(sp)s(eci\014ed)f(on)h +(the)h(link)e(comman)h(Unix)g(systems,)i(the)e(most)h(reliable)e(w)m(a) +m(y)i(to)h(determine)d(what)i(libraries)0 5375 y(are)32 +b(required)e(is)g(to)j(t)m(yp)s(e)e('mak)m(e)i(testprog')g(and)e(see)h +(what)f(libraries)e(the)j(con\014gure)f(script)g(has)g(added.)43 +b(The)0 5488 y(t)m(ypical)23 b(libraries)e(that)j(ma)m(y)g(need)f(to)h +(b)s(e)f(added)g(are)g(-lm)g(\(the)h(math)f(library\))f(and)h(-lnsl)e +(and)i(-lso)s(c)m(k)m(et)i(\(needed)0 5601 y(only)h(for)g(FTP)g(and)g +(HTTP)g(\014le)g(access\).)41 b(These)26 b(latter)h(2)g(libraries)d +(are)j(not)g(needed)f(on)g(VMS)h(and)f(Windo)m(ws)0 5714 +y(platforms,)k(b)s(ecause)g(FTP)g(\014le)g(access)h(is)f(not)g(curren)m +(tly)g(supp)s(orted)e(on)i(those)h(platforms.)p eop +%%Page: 8 14 +8 13 bop 0 299 a Fi(8)1896 b Fg(CHAPTER)30 b(2.)111 b(CREA)-8 +b(TING)31 b(FITSIO/CFITSIO)0 555 y Fi(Note)36 b(that)f(when)e +(upgrading)f(to)j(a)g(new)m(er)f(v)m(ersion)g(of)h(CFITSIO)d(it)i(is)g +(usually)e(necessa)m(y)j(to)g(recompile,)g(as)0 668 y(w)m(ell)29 +b(as)i(relink,)e(the)h(programs)g(that)h(use)f(CFITSIO,)f(b)s(ecause)i +(the)f(de\014nitions)e(in)h(\014tsio.h)h(often)g(c)m(hange.)0 +1001 y Fd(2.4)135 b(Getting)46 b(Started)g(with)f(FITSIO)0 +1251 y Fi(In)32 b(order)h(to)h(e\013ectiv)m(ely)g(use)f(the)g(FITSIO)f +(library)f(as)j(quic)m(kly)e(as)h(p)s(ossible,)f(it)h(is)f(recommended) +h(that)g(new)0 1364 y(users)d(follo)m(w)f(these)i(steps:)0 +1524 y(1.)62 b(Read)38 b(the)f(follo)m(wing)f(`FITS)h(Primer')f(c)m +(hapter)i(for)g(a)f(brief)f(o)m(v)m(erview)i(of)g(the)g(structure)e(of) +i(FITS)f(\014les.)0 1637 y(This)24 b(is)h(esp)s(ecially)f(imp)s(ortan)m +(t)i(for)f(users)h(who)f(ha)m(v)m(e)i(not)g(previously)c(dealt)j(with)f +(the)h(FITS)f(table)h(and)g(image)0 1750 y(extensions.)0 +1910 y(2.)41 b(W)-8 b(rite)31 b(a)g(simple)d(program)i(to)h(read)g(or)f +(write)f(a)i(FITS)f(\014le)f(using)g(the)i(Basic)f(In)m(terface)i +(routines.)0 2071 y(3.)41 b(Refer)28 b(to)i(the)f(co)s(okb)s(o)s(ok.f)g +(program)f(that)i(is)e(included)e(with)h(this)h(release)h(for)f +(examples)h(of)g(routines)e(that)0 2183 y(p)s(erform)i(v)-5 +b(arious)29 b(common)i(FITS)f(\014le)f(op)s(erations.)0 +2344 y(4.)52 b(Read)34 b(Chapters)g(4)g(and)f(5)i(to)g(b)s(ecome)f +(familiar)e(with)g(the)j(con)m(v)m(en)m(tions)g(and)e(adv)-5 +b(anced)34 b(features)h(of)f(the)0 2457 y(FITSIO)29 b(in)m(terface.)0 +2617 y(5.)47 b(Scan)32 b(through)f(the)h(more)h(extensiv)m(e)f(set)h +(of)g(routines)e(that)h(are)h(pro)m(vided)e(in)g(the)h(`Adv)-5 +b(anced)32 b(In)m(terface'.)0 2730 y(These)22 b(routines)e(p)s(erform)h +(more)h(sp)s(ecialized)e(functions)g(than)h(are)i(pro)m(vided)d(b)m(y)i +(the)g(Basic)g(In)m(terface)h(routines.)0 3063 y Fd(2.5)135 +b(Example)46 b(Program)0 3313 y Fi(The)32 b(follo)m(wing)f(listing)f +(sho)m(ws)i(an)g(example)h(of)f(ho)m(w)h(to)g(use)f(the)g(FITSIO)g +(routines)f(in)g(a)i(F)-8 b(ortran)33 b(program.)0 3426 +y(Refer)38 b(to)h(the)g(co)s(okb)s(o)s(ok.f)f(program)g(that)h(is)e +(included)e(with)i(the)i(FITSIO)e(distribution)d(for)k(examples)g(of)0 +3539 y(other)31 b(FITS)e(programs.)286 3794 y Fe(program)46 +b(writeimage)0 4020 y(C)238 b(Create)46 b(a)i(FITS)f(primary)e(array)i +(containing)e(a)i(2-D)g(image)286 4246 y(integer)f +(status,unit,blocksize,bit)o(pix,)o(nax)o(is,n)o(axes)o(\(2\))286 +4359 y(integer)g(i,j,group,fpixel,nelement)o(s,ar)o(ray)o(\(300)o(,200) +o(\))286 4472 y(character)g(filename*80)286 4585 y(logical)g +(simple,extend)286 4811 y(status=0)0 4924 y(C)238 b(Name)47 +b(of)g(the)g(FITS)g(file)f(to)i(be)f(created:)286 5036 +y(filename='ATESTFILE.FITS')0 5262 y(C)238 b(Get)47 b(an)g(unused)g +(Logical)e(Unit)i(Number)f(to)h(use)g(to)g(create)f(the)h(FITS)g(file) +286 5375 y(call)g(ftgiou\(unit,status\))0 5601 y(C)238 +b(create)46 b(the)h(new)g(empty)g(FITS)f(file)286 5714 +y(blocksize=1)p eop +%%Page: 9 15 +9 14 bop 0 299 a Fg(2.6.)72 b(LEGAL)30 b(STUFF)2995 b +Fi(9)286 555 y Fe(call)47 b(ftinit\(unit,filename,blo)o(cksi)o(ze,s)o +(tat)o(us\))0 781 y(C)238 b(initialize)45 b(parameters)g(about)i(the)g +(FITS)f(image)h(\(300)f(x)i(200)f(16-bit)f(integers\))286 +894 y(simple=.true.)286 1007 y(bitpix=16)286 1120 y(naxis=2)286 +1233 y(naxes\(1\)=300)286 1346 y(naxes\(2\)=200)286 1458 +y(extend=.true.)0 1684 y(C)238 b(write)47 b(the)g(required)e(header)h +(keywords)286 1797 y(call)h(ftphpr\(unit,simple,bitpi)o(x,na)o(xis,)o +(nax)o(es,0)o(,1,e)o(xte)o(nd,s)o(tatu)o(s\))0 2023 y(C)238 +b(initialize)45 b(the)i(values)f(in)i(the)e(image)h(with)f(a)i(linear)e +(ramp)h(function)286 2136 y(do)h(j=1,naxes\(2\))477 2249 +y(do)f(i=1,naxes\(1\))668 2362 y(array\(i,j\)=i+j)477 +2475 y(end)g(do)286 2588 y(end)g(do)0 2813 y(C)238 b(write)47 +b(the)g(array)f(to)h(the)g(FITS)g(file)286 2926 y(group=1)286 +3039 y(fpixel=1)286 3152 y(nelements=naxes\(1\)*naxes\(2)o(\))286 +3265 y(call)g(ftpprj\(unit,group,fpixel)o(,nel)o(emen)o(ts,)o(arra)o +(y,st)o(atu)o(s\))0 3491 y(C)238 b(write)47 b(another)f(optional)f +(keyword)h(to)h(the)g(header)286 3604 y(call)g +(ftpkyj\(unit,'EXPOSURE',1)o(500,)o('Tot)o(al)41 b(Exposure)46 +b(Time',status\))0 3830 y(C)238 b(close)47 b(the)g(file)f(and)h(free)g +(the)g(unit)f(number)286 3942 y(call)h(ftclos\(unit,)d(status\))286 +4055 y(call)j(ftfiou\(unit,)d(status\))286 4168 y(end)0 +4527 y Fd(2.6)135 b(Legal)46 b(Stu\013)0 4782 y Fi(Cop)m(yrigh)m(t)36 +b(\(Unpublished{all)d(righ)m(ts)j(reserv)m(ed)h(under)e(the)i(cop)m +(yrigh)m(t)g(la)m(ws)f(of)h(the)g(United)f(States\),)k(U.S.)0 +4895 y(Go)m(v)m(ernmen)m(t)30 b(as)g(represen)m(ted)e(b)m(y)h(the)g +(Administrator)e(of)i(the)g(National)f(Aeronautics)h(and)f(Space)h +(Adminis-)0 5008 y(tration.)41 b(No)31 b(cop)m(yrigh)m(t)f(is)g +(claimed)f(in)g(the)i(United)e(States)i(under)e(Title)h(17,)h(U.S.)f +(Co)s(de.)0 5168 y(P)m(ermission)e(to)i(freely)e(use,)i(cop)m(y)-8 +b(,)31 b(mo)s(dify)-8 b(,)28 b(and)h(distribute)e(this)h(soft)m(w)m +(are)j(and)e(its)g(do)s(cumen)m(tation)g(without)0 5281 +y(fee)g(is)e(hereb)m(y)h(gran)m(ted,)i(pro)m(vided)d(that)i(this)e(cop) +m(yrigh)m(t)i(notice)f(and)g(disclaimer)e(of)i(w)m(arran)m(t)m(y)i(app) +s(ears)d(in)g(all)0 5394 y(copies.)41 b(\(Ho)m(w)m(ev)m(er,)33 +b(see)e(the)f(restriction)f(on)i(the)f(use)g(of)h(the)f(gzip)g +(compression)g(co)s(de,)h(b)s(elo)m(w\).)0 5554 y(DISCLAIMER:)0 +5714 y(THE)i(SOFTW)-10 b(ARE)32 b(IS)g(PR)m(O)m(VIDED)i('AS)f(IS')g +(WITHOUT)f(ANY)i(W)-10 b(ARRANTY)33 b(OF)g(ANY)h(KIND,)f(EI-)p +eop +%%Page: 10 16 +10 15 bop 0 299 a Fi(10)1851 b Fg(CHAPTER)30 b(2.)111 +b(CREA)-8 b(TING)31 b(FITSIO/CFITSIO)0 555 y Fi(THER)42 +b(EXPRESSED,)f(IMPLIED,)i(OR)e(ST)-8 b(A)g(TUTOR)g(Y,)43 +b(INCLUDING,)f(BUT)h(NOT)e(LIMITED)h(TO,)0 668 y(ANY)33 +b(W)-10 b(ARRANTY)33 b(THA)-8 b(T)32 b(THE)g(SOFTW)-10 +b(ARE)32 b(WILL)g(CONF)m(ORM)g(TO)g(SPECIFICA)-8 b(TIONS,)30 +b(ANY)0 781 y(IMPLIED)38 b(W)-10 b(ARRANTIES)37 b(OF)h(MER)m(CHANT)-8 +b(ABILITY,)38 b(FITNESS)f(F)m(OR)h(A)g(P)-8 b(AR)g(TICULAR)38 +b(PUR-)0 894 y(POSE,)24 b(AND)i(FREEDOM)f(FR)m(OM)h(INFRINGEMENT,)g +(AND)f(ANY)h(W)-10 b(ARRANTY)25 b(THA)-8 b(T)25 b(THE)g(DOC-)0 +1007 y(UMENT)-8 b(A)g(TION)31 b(WILL)f(CONF)m(ORM)h(TO)e(THE)h(SOFTW) +-10 b(ARE,)30 b(OR)g(ANY)h(W)-10 b(ARRANTY)31 b(THA)-8 +b(T)30 b(THE)0 1120 y(SOFTW)-10 b(ARE)31 b(WILL)h(BE)g(ERR)m(OR)g +(FREE.)g(IN)g(NO)f(EVENT)h(SHALL)f(NASA)h(BE)g(LIABLE)g(F)m(OR)g(ANY)0 +1233 y(D)m(AMA)m(GES,)26 b(INCLUDING,)e(BUT)f(NOT)g(LIMITED)h(TO,)f +(DIRECT,)g(INDIRECT,)g(SPECIAL)f(OR)h(CON-)0 1346 y(SEQUENTIAL)28 +b(D)m(AMA)m(GES,)k(ARISING)d(OUT)g(OF,)h(RESUL)-8 b(TING)29 +b(FR)m(OM,)h(OR)f(IN)h(ANY)g(W)-10 b(A)i(Y)30 b(CON-)0 +1458 y(NECTED)25 b(WITH)g(THIS)f(SOFTW)-10 b(ARE,)25 +b(WHETHER)g(OR)g(NOT)g(BASED)g(UPON)g(W)-10 b(ARRANTY,)26 +b(CON-)0 1571 y(TRA)m(CT,)d(TOR)-8 b(T)23 b(,)g(OR)g(OTHER)-10 +b(WISE,)22 b(WHETHER)i(OR)f(NOT)f(INJUR)-8 b(Y)24 b(W)-10 +b(AS)23 b(SUST)-8 b(AINED)23 b(BY)h(PER-)0 1684 y(SONS)h(OR)i(PR)m +(OPER)-8 b(TY)26 b(OR)g(OTHER)-10 b(WISE,)26 b(AND)h(WHETHER)g(OR)f +(NOT)g(LOSS)f(W)-10 b(AS)26 b(SUST)-8 b(AINED)0 1797 +y(FR)m(OM,)37 b(OR)e(AR)m(OSE)h(OUT)f(OF)h(THE)g(RESUL)-8 +b(TS)35 b(OF,)h(OR)f(USE)h(OF,)g(THE)g(SOFTW)-10 b(ARE)35 +b(OR)g(SER-)0 1910 y(VICES)29 b(PR)m(O)m(VIDED)j(HEREUNDER.")0 +2070 y(The)i(\014le)h(compress.c)g(con)m(tains)g(\(sligh)m(tly)f(mo)s +(di\014ed\))f(source)i(co)s(de)g(that)h(originally)c(came)k(from)f +(gzip-1.2.4,)0 2183 y(cop)m(yrigh)m(t)26 b(\(C\))g(1992-1993)k(b)m(y)c +(Jean-loup)f(Gailly)-8 b(.)38 b(This)24 b(gzip)h(co)s(de)h(is)f +(distributed)e(under)i(the)h(GNU)g(General)0 2296 y(Public)k(License)i +(and)f(th)m(us)h(requires)f(that)i(an)m(y)f(soft)m(w)m(are)i(that)f +(uses)f(the)g(CFITSIO)f(library)f(\(whic)m(h)h(in)g(turn)0 +2409 y(uses)e(the)g(gzip)g(co)s(de\))h(m)m(ust)f(conform)g(to)h(the)f +(pro)m(visions)e(in)h(the)i(GNU)g(General)f(Public)e(License.)40 +b(A)29 b(cop)m(y)h(of)0 2522 y(the)h(GNU)g(license)e(is)g(included)f +(at)j(the)g(b)s(eginning)c(of)k(compress.c)g(\014le.)0 +2682 y(An)h(alternate)i(v)m(ersion)e(of)h(the)g(compress.c)g(\014le)f +(\(called)g(compress)p 2381 2682 28 4 v 33 w(alternate.c\))i(is)e(pro)m +(vided)f(for)i(users)e(who)0 2795 y(w)m(an)m(t)24 b(to)g(use)e(the)i +(CFITSIO)d(library)g(but)h(are)h(un)m(willing)d(or)j(unable)e(to)j +(publicly)c(release)j(their)f(soft)m(w)m(are)i(under)0 +2908 y(the)i(terms)g(of)g(the)g(GNU)h(General)e(Public)f(License.)39 +b(This)24 b(alternate)i(v)m(ersion)g(con)m(tains)g(non-functional)e +(stubs)0 3021 y(for)g(the)h(\014le)e(compression)h(and)f(uncompression) +g(routines)g(used)h(b)m(y)g(CFITSIO.)f(Replace)i(the)f(\014le)g +(`compress.c')0 3134 y(with)32 b(`compress)p 600 3134 +V 33 w(alternate.c')j(b)s(efore)e(compiling)e(the)i(CFITSIO)f(library) +-8 b(.)48 b(This)31 b(will)g(pro)s(duce)h(a)i(v)m(ersion)f(of)0 +3247 y(CFITSIO)20 b(whic)m(h)h(do)s(es)g(not)h(supp)s(ort)e(reading)h +(or)h(writing)e(compressed)h(FITS)g(\014les)g(but)g(is)g(otherwise)g +(iden)m(tical)0 3360 y(to)31 b(the)g(standard)e(v)m(ersion.)0 +3733 y Fd(2.7)135 b(Ac)l(kno)l(wledgemen)l(ts)0 3991 +y Fi(The)29 b(dev)m(elopmen)m(t)g(of)h(man)m(y)f(of)h(the)f(p)s(o)m(w)m +(erful)f(features)h(in)f(CFITSIO)g(w)m(as)i(made)f(p)s(ossible)e +(through)h(collab-)0 4104 y(orations)34 b(with)f(man)m(y)i(p)s(eople)e +(or)i(organizations)f(from)g(around)f(the)i(w)m(orld.)51 +b(The)34 b(follo)m(wing,)g(in)f(particular,)0 4217 y(ha)m(v)m(e)f(made) +e(esp)s(ecially)f(signi\014can)m(t)g(con)m(tributions:)0 +4377 y(Programmers)c(from)h(the)f(In)m(tegral)h(Science)g(Data)h(Cen)m +(ter,)g(Switzerland)d(\(namely)-8 b(,)27 b(Jurek)d(Bork)m(o)m(wski,)k +(Bruce)0 4490 y(O'Neel,)33 b(and)f(Don)h(Jennings\),)e(designed)g(the)i +(concept)g(for)f(the)h(plug-in)d(I/O)i(driv)m(ers)f(that)i(w)m(as)g(in) +m(tro)s(duced)0 4603 y(with)h(CFITSIO)f(2.0.)56 b(The)34 +b(use)h(of)g(`driv)m(ers')f(greatly)h(simpli\014ed)d(the)j(lo)m(w-lev)m +(el)g(I/O,)g(whic)m(h)e(in)h(turn)g(made)0 4716 y(other)40 +b(new)f(features)i(in)d(CFITSIO)g(\(e.g.,)45 b(supp)s(ort)38 +b(for)h(compressed)h(FITS)f(\014les)g(and)g(supp)s(ort)f(for)i(IRAF)0 +4829 y(format)32 b(image)f(\014les\))g(m)m(uc)m(h)g(easier)h(to)g +(implemen)m(t.)42 b(Jurek)31 b(Bork)m(o)m(wski)g(wrote)h(the)g(Shared)e +(Memory)i(driv)m(er,)0 4942 y(and)23 b(Bruce)i(O'Neel)f(wrote)g(the)g +(driv)m(ers)f(for)g(accessing)i(FITS)e(\014les)g(o)m(v)m(er)i(the)f +(net)m(w)m(ork)h(using)d(the)j(FTP)-8 b(,)24 b(HTTP)-8 +b(,)0 5055 y(and)30 b(R)m(OOT)g(proto)s(cols.)0 5215 +y(The)45 b(ISDC)g(also)g(pro)m(vided)f(the)i(template)g(parsing)e +(routines)g(\(written)h(b)m(y)g(Jurek)g(Bork)m(o)m(wski\))h(and)f(the)0 +5328 y(hierarc)m(hical)36 b(grouping)f(routines)h(\(written)h(b)m(y)g +(Don)h(Jennings\).)59 b(The)37 b(ISDC)f(D)m(AL)i(\(Data)h(Access)f(La)m +(y)m(er\))0 5441 y(routines)29 b(are)i(la)m(y)m(ered)g(on)f(top)h(of)f +(CFITSIO)f(and)h(mak)m(e)h(extensiv)m(e)g(use)f(of)h(these)g(features.) +0 5601 y(Uw)m(e)25 b(Lammers)e(\(XMM/ESA/ESTEC,)h(The)g(Netherlands\))f +(designed)g(the)h(high-p)s(erformance)e(lexical)h(pars-)0 +5714 y(ing)41 b(algorithm)g(that)h(is)f(used)g(to)i(do)e(on-the-\015y)h +(\014ltering)e(of)i(FITS)f(tables.)75 b(This)40 b(algorithm)h(essen)m +(tially)p eop +%%Page: 11 17 +11 16 bop 0 299 a Fg(2.7.)72 b(A)m(CKNO)m(WLEDGEMENTS)2515 +b Fi(11)0 555 y(pre-compiles)34 b(the)i(user-supplied)c(selection)k +(expression)e(in)m(to)i(a)g(form)g(that)g(can)g(b)s(e)f(rapidly)e(ev)-5 +b(aluated)36 b(for)0 668 y(eac)m(h)31 b(ro)m(w.)40 b(P)m(eter)31 +b(Wilson)d(\(RSTX,)h(NASA/GSF)m(C\))i(then)e(wrote)h(the)g(parsing)e +(routines)g(used)h(b)m(y)g(CFITSIO)0 781 y(based)i(on)f(Lammers')h +(design,)f(com)m(bined)g(with)g(other)h(tec)m(hniques)f(suc)m(h)h(as)g +(the)g(CFITSIO)f(iterator)h(routine)0 894 y(to)h(further)e(enhance)h +(the)h(data)g(pro)s(cessing)e(throughput.)42 b(This)30 +b(e\013ort)i(also)f(b)s(ene\014ted)f(from)h(a)h(m)m(uc)m(h)f(earlier)0 +1007 y(lexical)22 b(parsing)h(routine)f(that)i(w)m(as)g(dev)m(elop)s +(ed)f(b)m(y)h(Ken)m(t)g(Blac)m(kburn)e(\(NASA/GSF)m(C\).)j(More)g +(recen)m(tly)-8 b(,)26 b(Craig)0 1120 y(Markw)m(ardt)j(\(NASA/GSF)m +(C\))g(implemen)m(ted)e(additional)f(functions)h(\(median,)h(a)m(v)m +(erage,)k(stddev\))c(and)g(other)0 1233 y(enhancemen)m(ts)j(to)g(the)g +(lexical)e(parser.)0 1393 y(The)40 b(CFITSIO)g(iterator)h(function)e +(is)h(lo)s(osely)g(based)h(on)f(similar)f(ideas)h(dev)m(elop)s(ed)g +(for)h(the)g(XMM)g(Data)0 1506 y(Access)31 b(La)m(y)m(er.)0 +1666 y(P)m(eter)25 b(Wilson)e(\(RSTX,)h(NASA/GSF)m(C\))h(wrote)g(the)f +(complete)h(set)f(of)h(F)-8 b(ortran-callable)24 b(wrapp)s(ers)e(for)i +(all)f(the)0 1779 y(CFITSIO)29 b(routines,)g(whic)m(h)g(in)g(turn)h +(rely)f(on)i(the)f(CF)m(OR)-8 b(TRAN)31 b(macro)g(dev)m(elop)s(ed)f(b)m +(y)g(Burkhard)f(Buro)m(w.)0 1939 y(The)h(syn)m(tax)i(used)e(b)m(y)h +(CFITSIO)f(for)g(\014ltering)g(or)h(binning)c(input)i(FITS)i(\014les)f +(is)g(based)g(on)h(ideas)g(dev)m(elop)s(ed)0 2052 y(for)41 +b(the)g(AXAF)h(Science)f(Cen)m(ter)h(Data)h(Mo)s(del)d(b)m(y)h +(Jonathan)g(McDo)m(w)m(ell,)k(An)m(tonella)c(F)-8 b(ruscione,)44 +b(Aneta)0 2165 y(Siemigino)m(wsk)-5 b(a)24 b(and)h(Bill)f(Jo)m(y)m(e.) +41 b(See)26 b(h)m(ttp://heasarc.gsfc.nasa.go)m(v/do)s +(cs/journal/axaf7.h)m(t)q(ml)31 b(for)25 b(further)0 +2278 y(description)j(of)j(the)g(AXAF)g(Data)h(Mo)s(del.)0 +2438 y(The)j(\014le)f(decompression)g(co)s(de)h(w)m(ere)h(tak)m(en)g +(directly)e(from)g(the)i(gzip)e(\(GNU)i(zip\))f(program)g(dev)m(elop)s +(ed)f(b)m(y)0 2551 y(Jean-loup)29 b(Gailly)g(and)h(others.)0 +2711 y(Doug)h(Mink,)f(SA)m(O,)g(pro)m(vided)f(the)i(routines)e(for)h +(con)m(v)m(erting)h(IRAF)g(format)g(images)f(in)m(to)g(FITS)g(format.)0 +2871 y(In)d(addition,)g(man)m(y)h(other)g(p)s(eople)f(ha)m(v)m(e)i +(made)f(v)-5 b(aluable)27 b(con)m(tributions)f(to)j(the)f(dev)m +(elopmen)m(t)g(of)g(CFITSIO.)0 2984 y(These)i(include)e(\(with)i(ap)s +(ologies)g(to)h(others)f(that)h(ma)m(y)g(ha)m(v)m(e)h(inadv)m(erten)m +(tly)e(b)s(een)f(omitted\):)0 3144 y(Stev)m(e)g(Allen,)e(Carl)g(Ak)m +(erlof,)h(Keith)f(Arnaud,)h(Morten)g(Krabb)s(e)e(Barfo)s(ed,)j(Ken)m(t) +f(Blac)m(kburn,)g(G)g(Bo)s(dammer,)0 3257 y(Romk)m(e)h(Bon)m(tek)m(o)s +(e,)i(Lucio)c(Chiapp)s(etti,)f(Keith)h(Costorf,)h(Robin)f(Corb)s(et,)h +(John)e(Da)m(vis,)j(Ric)m(hard)e(Fink,)h(Ning)0 3370 +y(Gan,)h(Emily)c(Greene,)k(Jo)s(e)f(Harrington,)g(Cheng)f(Ho,)i(Phil)c +(Ho)s(dge,)k(Jim)e(Ingham,)h(Y)-8 b(oshitak)j(a)28 b(Ishisaki,)e(Diab)0 +3483 y(Jerius,)k(Mark)i(Levine,)f(T)-8 b(o)s(dd)30 b(Karak)-5 +b(askian,)31 b(Edw)m(ard)g(King,)f(Scott)j(Ko)s(c)m(h,)e(Claire)f +(Larkin,)g(Rob)i(Managan,)0 3596 y(Eric)37 b(Mandel,)i(John)e(Matto)m +(x,)43 b(Carsten)37 b(Mey)m(er,)42 b(Emi)36 b(Miy)m(ata,)42 +b(Stefan)c(Mo)s(c)m(hnac)m(ki,)i(Mik)m(e)f(Noble,)g(Oliv)m(er)0 +3709 y(Ob)s(erdorf,)d(Cliv)m(e)g(P)m(age,)k(Arvind)34 +b(P)m(armar,)k(Je\013)f(P)m(edelt)m(y)-8 b(,)39 b(Tim)c(P)m(earson,)k +(Maren)e(Purv)m(es,)h(Scott)f(Randall,)0 3822 y(Chris)c(Rogers,)k +(Arnold)d(Rots,)j(Barry)f(Sc)m(hlesinger,)f(Robin)f(Stebbins,)g(Andrew) +g(Szymk)m(o)m(wiak,)j(Allyn)d(T)-8 b(en-)0 3934 y(nan)m(t,)31 +b(P)m(eter)g(T)-8 b(eub)s(en,)30 b(James)g(Theiler,)f(Doug)i(T)-8 +b(o)s(dy)g(,)31 b(Shiro)d(Ueno,)k(Stev)m(e)f(W)-8 b(alton,)32 +b(Arc)m(hie)e(W)-8 b(arno)s(c)m(k,)32 b(Alan)0 4047 y(W)-8 +b(atson,)32 b(Dan)f(Whipple,)d(Wim)i(Wimmers,)g(P)m(eter)h(Y)-8 +b(oung,)31 b(Jianjun)d(Xu,)i(and)g(Nelson)g(Zarate.)p +eop +%%Page: 12 18 +12 17 bop 0 299 a Fi(12)1851 b Fg(CHAPTER)30 b(2.)111 +b(CREA)-8 b(TING)31 b(FITSIO/CFITSIO)p eop +%%Page: 13 19 +13 18 bop 0 1225 a Ff(Chapter)65 b(3)0 1687 y Fl(A)78 +b(FITS)f(Primer)0 2180 y Fi(This)22 b(section)j(giv)m(es)f(a)h(brief)d +(o)m(v)m(erview)j(of)f(the)h(structure)e(of)i(FITS)e(\014les.)37 +b(Users)24 b(should)f(refer)g(to)i(the)g(do)s(cumen-)0 +2293 y(tation)i(a)m(v)-5 b(ailable)27 b(from)g(the)g(NOST,)f(as)i +(describ)s(ed)d(in)h(the)h(in)m(tro)s(duction,)f(for)h(more)g(detailed) +g(information)e(on)0 2406 y(FITS)30 b(formats.)0 2566 +y(FITS)37 b(w)m(as)g(\014rst)g(dev)m(elop)s(ed)g(in)f(the)h(late)h +(1970's)h(as)f(a)f(standard)g(data)h(in)m(terc)m(hange)g(format)g(b)s +(et)m(w)m(een)g(v)-5 b(ar-)0 2679 y(ious)37 b(astronomical)g(observ)-5 +b(atories.)63 b(Since)36 b(then)h(FITS)g(has)h(b)s(ecome)g(the)g +(defacto)g(standard)f(data)i(format)0 2791 y(supp)s(orted)29 +b(b)m(y)h(most)h(astronomical)f(data)h(analysis)e(soft)m(w)m(are)i(pac) +m(k)-5 b(ages.)0 2952 y(A)34 b(FITS)f(\014le)f(consists)h(of)h(one)g +(or)g(more)g(Header)g(+)f(Data)i(Units)e(\(HDUs\),)j(where)d(the)h +(\014rst)f(HDU)h(is)f(called)0 3065 y(the)k(`Primary)e(HDU',)j(or)f +(`Primary)e(Arra)m(y'.)60 b(The)36 b(primary)f(arra)m(y)i(con)m(tains)g +(an)f(N-dimensional)f(arra)m(y)i(of)0 3177 y(pixels,)28 +b(suc)m(h)g(as)h(a)h(1-D)g(sp)s(ectrum,)e(a)h(2-D)h(image,)g(or)f(a)g +(3-D)h(data)g(cub)s(e.)39 b(Fiv)m(e)30 b(di\013eren)m(t)e(primary)f +(datat)m(yp)s(es)0 3290 y(are)f(supp)s(orted:)37 b(Unsigned)24 +b(8-bit)i(b)m(ytes,)h(16)g(and)e(32-bit)h(signed)e(in)m(tegers,)j(and)f +(32)g(and)f(64-bit)h(\015oating)g(p)s(oin)m(t)0 3403 +y(reals.)40 b(FITS)29 b(also)h(has)g(a)g(con)m(v)m(en)m(tion)i(for)d +(storing)h(16)h(and)e(32-bit)h(unsigned)e(in)m(tegers)j(\(see)g(the)f +(later)g(section)0 3516 y(en)m(titled)d(`Unsigned)g(In)m(tegers')i(for) +e(more)h(details\).)39 b(The)27 b(primary)f(HDU)j(ma)m(y)f(also)g +(consist)f(of)h(only)f(a)h(header)0 3629 y(with)h(a)i(n)m(ull)d(arra)m +(y)j(con)m(taining)f(no)g(data)h(pixels.)0 3789 y(An)m(y)i(n)m(um)m(b)s +(er)e(of)h(additional)f(HDUs)i(ma)m(y)g(follo)m(w)f(the)g(primary)f +(arra)m(y;)j(these)f(additional)e(HDUs)i(are)g(called)0 +3902 y(FITS)d(`extensions'.)40 b(There)30 b(are)h(curren)m(tly)e(3)i(t) +m(yp)s(es)g(of)f(extensions)g(de\014ned)f(b)m(y)h(the)h(FITS)f +(standard:)136 4171 y Fc(\017)46 b Fi(Image)31 b(Extension)f(-)h(a)f +(N-dimensional)e(arra)m(y)j(of)g(pixels,)e(lik)m(e)g(in)g(a)i(primary)d +(arra)m(y)136 4368 y Fc(\017)46 b Fi(ASCI)s(I)29 b(T)-8 +b(able)30 b(Extension)g(-)g(ro)m(ws)h(and)e(columns)g(of)i(data)g(in)e +(ASCI)s(I)g(c)m(haracter)j(format)136 4564 y Fc(\017)46 +b Fi(Binary)30 b(T)-8 b(able)30 b(Extension)f(-)i(ro)m(ws)f(and)g +(columns)f(of)i(data)g(in)e(binary)f(represen)m(tation)0 +4833 y(In)33 b(eac)m(h)i(case)g(the)f(HDU)h(consists)f(of)g(an)g(ASCI)s +(I)e(Header)i(Unit)g(follo)m(w)m(ed)f(b)m(y)h(an)g(optional)f(Data)i +(Unit.)51 b(F)-8 b(or)0 4946 y(historical)34 b(reasons,)j(eac)m(h)f +(Header)g(or)g(Data)h(unit)d(m)m(ust)h(b)s(e)g(an)g(exact)i(m)m +(ultiple)c(of)j(2880)h(8-bit)e(b)m(ytes)h(long.)0 5059 +y(An)m(y)30 b(un)m(used)g(space)g(is)g(padded)f(with)g(\014ll)f(c)m +(haracters)k(\(ASCI)s(I)d(blanks)g(or)i(zeros\).)0 5219 +y(Eac)m(h)i(Header)f(Unit)g(consists)g(of)g(an)m(y)g(n)m(um)m(b)s(er)f +(of)i(80-c)m(haracter)i(k)m(eyw)m(ord)d(records)g(or)g(`card)h(images') +f(whic)m(h)0 5332 y(ha)m(v)m(e)g(the)e(general)h(form:)95 +5601 y Fe(KEYNAME)46 b(=)i(value)e(/)i(comment)d(string)95 +5714 y(NULLKEY)h(=)334 b(/)48 b(comment:)d(This)i(keyword)f(has)g(no)i +(value)1905 5942 y Fi(13)p eop +%%Page: 14 20 +14 19 bop 0 299 a Fi(14)2398 b Fg(CHAPTER)30 b(3.)112 +b(A)30 b(FITS)g(PRIMER)0 555 y Fi(The)35 b(k)m(eyw)m(ord)i(names)f(ma)m +(y)g(b)s(e)g(up)f(to)h(8)h(c)m(haracters)g(long)f(and)f(can)h(only)g +(con)m(tain)g(upp)s(ercase)f(letters,)j(the)0 668 y(digits)23 +b(0-9,)k(the)e(h)m(yphen,)g(and)f(the)h(underscore)e(c)m(haracter.)41 +b(The)24 b(k)m(eyw)m(ord)h(name)g(is)e(\(usually\))g(follo)m(w)m(ed)i +(b)m(y)f(an)0 781 y(equals)k(sign)g(and)g(a)g(space)i(c)m(haracter)g +(\(=)e(\))h(in)e(columns)h(9)h(-)f(10)i(of)f(the)f(record,)h(follo)m(w) +m(ed)g(b)m(y)f(the)h(v)-5 b(alue)28 b(of)h(the)0 894 +y(k)m(eyw)m(ord)34 b(whic)m(h)f(ma)m(y)h(b)s(e)f(either)g(an)h(in)m +(teger,)h(a)f(\015oating)f(p)s(oin)m(t)g(n)m(um)m(b)s(er,)h(a)g(c)m +(haracter)h(string)d(\(enclosed)i(in)0 1007 y(single)26 +b(quotes\),)k(or)e(a)g(b)s(o)s(olean)f(v)-5 b(alue)27 +b(\(the)h(letter)g(T)g(or)f(F\).)i(A)f(k)m(eyw)m(ord)g(ma)m(y)h(also)e +(ha)m(v)m(e)i(a)g(n)m(ull)c(or)j(unde\014ned)0 1120 y(v)-5 +b(alue)30 b(if)f(there)i(is)e(no)h(sp)s(eci\014ed)f(v)-5 +b(alue)30 b(string,)g(as)g(in)f(the)i(second)f(example.)0 +1280 y(The)42 b(last)g(k)m(eyw)m(ord)h(in)e(the)i(header)f(is)f(alw)m +(a)m(ys)i(the)g(`END')g(k)m(eyw)m(ord)g(whic)m(h)e(has)h(no)h(v)-5 +b(alue)41 b(or)i(commen)m(t)0 1393 y(\014elds.)c(There)30 +b(are)h(man)m(y)f(rules)f(go)m(v)m(erning)i(the)f(exact)i(format)f(of)f +(a)h(k)m(eyw)m(ord)f(record)h(\(see)g(the)f(NOST)g(FITS)0 +1506 y(Standard\))h(so)h(it)f(is)f(b)s(etter)i(to)g(rely)f(on)g +(standard)g(in)m(terface)h(soft)m(w)m(are)h(lik)m(e)e(FITSIO)f(to)j +(correctly)f(construct)0 1619 y(or)e(to)h(parse)g(the)f(k)m(eyw)m(ord)h +(records)f(rather)g(than)h(try)f(to)h(deal)f(directly)f(with)g(the)h +(ra)m(w)h(FITS)f(formats.)0 1779 y(Eac)m(h)37 b(Header)g(Unit)e(b)s +(egins)g(with)g(a)h(series)g(of)g(required)f(k)m(eyw)m(ords)h(whic)m(h) +f(dep)s(end)g(on)h(the)g(t)m(yp)s(e)h(of)f(HDU.)0 1892 +y(These)31 b(required)f(k)m(eyw)m(ords)i(sp)s(ecify)f(the)g(size)h(and) +f(format)h(of)g(the)g(follo)m(wing)e(Data)j(Unit.)44 +b(The)31 b(header)g(ma)m(y)0 2005 y(con)m(tain)g(other)g(optional)e(k)m +(eyw)m(ords)i(to)h(describ)s(e)d(other)h(asp)s(ects)h(of)g(the)g(data,) +g(suc)m(h)g(as)g(the)f(units)f(or)i(scaling)0 2118 y(v)-5 +b(alues.)43 b(Other)31 b(COMMENT)g(or)g(HISTOR)-8 b(Y)30 +b(k)m(eyw)m(ords)i(are)g(also)f(frequen)m(tly)g(added)f(to)i(further)e +(do)s(cumen)m(t)0 2230 y(the)h(data)g(\014le.)0 2391 +y(The)36 b(optional)f(Data)j(Unit)e(immediately)e(follo)m(ws)i(the)g +(last)g(2880-b)m(yte)j(blo)s(c)m(k)d(in)f(the)h(Header)h(Unit.)58 +b(Some)0 2503 y(HDUs)31 b(do)f(not)h(ha)m(v)m(e)g(a)g(Data)h(Unit)e +(and)g(only)f(consist)h(of)h(the)f(Header)h(Unit.)0 2664 +y(If)24 b(there)i(is)e(more)h(than)f(one)h(HDU)h(in)e(the)h(FITS)f +(\014le,)h(then)g(the)g(Header)h(Unit)e(of)h(the)g(next)g(HDU)h +(immediately)0 2777 y(follo)m(ws)e(the)g(last)h(2880-b)m(yte)i(blo)s(c) +m(k)d(of)h(the)f(previous)f(Data)k(Unit)c(\(or)i(Header)g(Unit)f(if)f +(there)i(is)f(no)g(Data)i(Unit\).)0 2937 y(The)k(main)f(required)g(k)m +(eyw)m(ords)h(in)f(FITS)h(primary)f(arra)m(ys)h(or)h(image)f +(extensions)g(are:)136 3172 y Fc(\017)46 b Fi(BITPIX)25 +b({)h(de\014nes)f(the)g(datat)m(yp)s(e)i(of)e(the)h(arra)m(y:)39 +b(8,)27 b(16,)g(32,)h(-32,)g(-64)e(for)f(unsigned)f(8{bit)h(b)m(yte,)j +(16{bit)227 3284 y(signed)38 b(in)m(teger,)j(32{bit)e(signed)e(in)m +(teger,)k(32{bit)e(IEEE)f(\015oating)g(p)s(oin)m(t,)i(and)e(64{bit)h +(IEEE)e(double)227 3397 y(precision)29 b(\015oating)h(p)s(oin)m(t,)g +(resp)s(ectiv)m(ely)-8 b(.)136 3585 y Fc(\017)46 b Fi(NAXIS)30 +b({)h(the)g(n)m(um)m(b)s(er)e(of)h(dimensions)e(in)h(the)i(arra)m(y)-8 +b(,)31 b(usually)d(0,)j(1,)g(2,)g(3,)g(or)g(4.)136 3773 +y Fc(\017)46 b Fi(NAXISn)30 b({)h(\(n)f(ranges)g(from)g(1)h(to)g +(NAXIS\))g(de\014nes)e(the)i(size)f(of)h(eac)m(h)g(dimension.)0 +4008 y(FITS)e(tables)h(start)h(with)e(the)h(k)m(eyw)m(ord)g(XTENSION)g +(=)f(`T)-8 b(ABLE')31 b(\(for)f(ASCI)s(I)f(tables\))h(or)g(XTENSION)f +(=)0 4120 y(`BINT)-8 b(ABLE')32 b(\(for)e(binary)f(tables\))h(and)g(ha) +m(v)m(e)i(the)e(follo)m(wing)f(main)g(k)m(eyw)m(ords:)136 +4355 y Fc(\017)46 b Fi(TFIELDS)30 b({)h(n)m(um)m(b)s(er)e(of)h +(\014elds)f(or)i(columns)e(in)g(the)h(table)136 4543 +y Fc(\017)46 b Fi(NAXIS2)31 b({)g(n)m(um)m(b)s(er)e(of)h(ro)m(ws)h(in)e +(the)h(table)136 4731 y Fc(\017)46 b Fi(TTYPEn)29 b({)i(for)f(eac)m(h)i +(column)d(\(n)h(ranges)h(from)f(1)g(to)h(TFIELDS\))g(giv)m(es)f(the)h +(name)f(of)h(the)f(column)136 4918 y Fc(\017)46 b Fi(TF)m(ORMn)31 +b({)f(the)h(datat)m(yp)s(e)g(of)g(the)f(column)136 5106 +y Fc(\017)46 b Fi(TUNITn)30 b({)g(the)h(ph)m(ysical)e(units)g(of)h(the) +h(column)e(\(optional\))0 5341 y(Users)e(should)e(refer)i(to)g(the)h +(FITS)e(Supp)s(ort)f(O\016ce)i(at)h Fe(http://fits.gsfc.nasa.go)o(v)21 +b Fi(for)27 b(futher)f(informa-)0 5454 y(tion)k(ab)s(out)g(the)h(FITS)e +(format)i(and)f(related)g(soft)m(w)m(are)i(pac)m(k)-5 +b(ages.)p eop +%%Page: 15 21 +15 20 bop 0 1225 a Ff(Chapter)65 b(4)0 1687 y Fl(Extended)77 +b(File)g(Name)g(Syn)-6 b(tax)0 2216 y Fd(4.1)135 b(Ov)l(erview)0 +2466 y Fi(CFITSIO)30 b(supp)s(orts)f(an)j(extended)f(syn)m(tax)h(when)f +(sp)s(ecifying)e(the)j(name)f(of)h(the)g(data)g(\014le)e(to)i(b)s(e)f +(op)s(ened)g(or)0 2579 y(created)g(that)g(includes)d(the)j(follo)m +(wing)e(features:)136 2813 y Fc(\017)46 b Fi(CFITSIO)40 +b(can)i(read)f(IRAF)h(format)g(images)f(whic)m(h)f(ha)m(v)m(e)j(header) +e(\014le)g(names)g(that)h(end)f(with)f(the)227 2926 y('.imh')d +(extension,)i(as)f(w)m(ell)e(as)i(reading)e(and)h(writing)e(FITS)i +(\014les,)h(This)e(feature)i(is)e(implemen)m(ted)g(in)227 +3039 y(CFITSIO)29 b(b)m(y)i(\014rst)e(con)m(v)m(erting)j(the)e(IRAF)h +(image)g(in)m(to)f(a)h(temp)s(orary)f(FITS)g(format)h(\014le)e(in)g +(memory)-8 b(,)227 3152 y(then)35 b(op)s(ening)e(the)i(FITS)f(\014le.) +53 b(An)m(y)35 b(of)g(the)g(usual)e(CFITSIO)h(routines)f(then)i(ma)m(y) +g(b)s(e)f(used)g(to)i(read)227 3265 y(the)31 b(image)f(header)g(or)h +(data.)41 b(Similarly)-8 b(,)27 b(ra)m(w)j(binary)f(data)i(arra)m(ys)f +(can)h(b)s(e)f(read)g(b)m(y)g(con)m(v)m(erting)h(them)227 +3378 y(on)g(the)f(\015y)g(in)m(to)g(virtual)f(FITS)h(images.)136 +3557 y Fc(\017)46 b Fi(FITS)37 b(\014les)g(on)g(the)h(in)m(ternet)g +(can)g(b)s(e)f(read)g(\(and)g(sometimes)h(written\))f(using)f(the)i +(FTP)-8 b(,)38 b(HTTP)-8 b(,)38 b(or)227 3670 y(R)m(OOT)30 +b(proto)s(cols.)136 3849 y Fc(\017)46 b Fi(FITS)30 b(\014les)f(can)i(b) +s(e)f(pip)s(ed)e(b)s(et)m(w)m(een)j(tasks)f(on)h(the)f(stdin)f(and)h +(stdout)g(streams.)136 4028 y Fc(\017)46 b Fi(FITS)20 +b(\014les)g(can)h(b)s(e)f(read)g(and)g(written)g(in)f(shared)h(memory) +-8 b(.)38 b(This)19 b(can)i(p)s(oten)m(tially)e(ac)m(hiev)m(e)j(m)m(uc) +m(h)f(b)s(etter)227 4141 y(data)26 b(I/O)e(p)s(erformance)g(compared)h +(to)h(reading)e(and)g(writing)e(the)j(same)h(FITS)e(\014les)f(on)i +(magnetic)g(disk.)136 4320 y Fc(\017)46 b Fi(Compressed)30 +b(FITS)f(\014les)h(in)f(gzip)h(or)g(Unix)f(COMPRESS)g(format)h(can)h(b) +s(e)f(directly)f(read.)136 4499 y Fc(\017)46 b Fi(Output)28 +b(FITS)h(\014les)f(can)h(b)s(e)g(written)f(directly)g(in)f(compressed)i +(gzip)g(format,)h(th)m(us)e(sa)m(ving)h(disk)f(space.)136 +4678 y Fc(\017)46 b Fi(FITS)26 b(table)g(columns)f(can)i(b)s(e)f +(created,)i(mo)s(di\014ed,)e(or)g(deleted)g('on-the-\015y')h(as)g(the)g +(table)f(is)f(op)s(ened)h(b)m(y)227 4791 y(CFITSIO.)32 +b(This)g(creates)j(a)e(virtual)f(FITS)h(\014le)f(con)m(taining)h(the)h +(mo)s(di\014cations)d(that)j(is)f(then)g(op)s(ened)227 +4904 y(b)m(y)e(the)f(application)f(program.)136 5083 +y Fc(\017)46 b Fi(T)-8 b(able)28 b(ro)m(ws)f(ma)m(y)i(b)s(e)e +(selected,)i(or)f(\014ltered)f(out,)h(on)g(the)g(\015y)f(when)g(the)h +(table)g(is)f(op)s(ened)g(b)m(y)g(CFITSIO,)227 5196 y(based)f(on)h(an)f +(arbitrary)g(user-sp)s(eci\014ed)e(expression.)38 b(Only)25 +b(ro)m(ws)i(for)f(whic)m(h)f(the)i(expression)e(ev)-5 +b(aluates)227 5309 y(to)31 b('TR)m(UE')g(are)g(retained)f(in)f(the)h +(cop)m(y)i(of)e(the)h(table)f(that)h(is)e(op)s(ened)h(b)m(y)g(the)h +(application)d(program.)136 5488 y Fc(\017)46 b Fi(Histogram)27 +b(images)g(ma)m(y)g(b)s(e)f(created)h(on)f(the)h(\015y)f(b)m(y)g +(binning)e(the)i(v)-5 b(alues)26 b(in)f(table)i(columns,)f(resulting) +227 5601 y(in)35 b(a)h(virtual)f(N-dimensional)e(FITS)j(image.)58 +b(The)35 b(application)f(program)i(then)g(only)f(sees)h(the)h(FITS)227 +5714 y(image)31 b(\(in)e(the)i(primary)d(arra)m(y\))k(instead)d(of)i +(the)f(original)f(FITS)g(table.)1905 5942 y(15)p eop +%%Page: 16 22 +16 21 bop 0 299 a Fi(16)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fi(The)43 +b(latter)h(3)g(features)g(in)e(particular)g(add)h(v)m(ery)h(p)s(o)m(w)m +(erful)e(data)i(pro)s(cessing)e(capabilities)g(directly)g(in)m(to)0 +668 y(CFITSIO,)29 b(and)g(hence)h(in)m(to)g(ev)m(ery)g(task)h(that)f +(uses)g(CFITSIO)e(to)j(read)f(or)g(write)f(FITS)g(\014les.)39 +b(F)-8 b(or)31 b(example,)0 781 y(these)d(features)f(transform)f(a)i(v) +m(ery)f(simple)e(program)i(that)h(just)f(copies)g(an)g(input)e(FITS)h +(\014le)g(to)i(a)g(new)e(output)0 894 y(\014le)35 b(\(lik)m(e)g(the)h +(`\014tscop)m(y')h(program)f(that)g(is)f(distributed)e(with)h +(CFITSIO\))h(in)m(to)h(a)g(m)m(ultipurp)s(ose)d(FITS)i(\014le)0 +1007 y(pro)s(cessing)23 b(to)s(ol.)39 b(By)25 b(app)s(ending)e(fairly)f +(simple)h(quali\014ers)g(on)m(to)i(the)g(name)g(of)g(the)g(input)e +(FITS)h(\014le,)h(the)g(user)0 1120 y(can)37 b(p)s(erform)f(quite)h +(complex)g(table)g(editing)f(op)s(erations)g(\(e.g.,)41 +b(create)e(new)d(columns,)i(or)f(\014lter)g(out)g(ro)m(ws)0 +1233 y(in)f(a)h(table\))g(or)g(create)h(FITS)f(images)g(b)m(y)g +(binning)c(or)k(histogramming)f(the)h(v)-5 b(alues)36 +b(in)g(table)h(columns.)59 b(In)0 1346 y(addition,)31 +b(these)i(functions)d(ha)m(v)m(e)k(b)s(een)d(co)s(ded)h(using)e(new)i +(state-of-the)i(art)f(algorithms)e(that)i(are,)g(in)e(some)0 +1458 y(cases,)h(10)f(-)f(100)i(times)e(faster)h(than)f(previous)f +(widely)f(used)i(implemen)m(tations.)0 1619 y(Before)k(describing)d +(the)j(complete)g(syn)m(tax)g(for)f(the)h(extended)f(FITS)g(\014le)f +(names)h(in)f(the)i(next)g(section,)g(here)0 1732 y(are)d(a)g(few)f +(examples)g(of)g(FITS)g(\014le)f(names)i(that)f(giv)m(e)h(a)g(quic)m(k) +f(o)m(v)m(erview)h(of)g(the)f(allo)m(w)m(ed)g(syn)m(tax:)136 +1960 y Fc(\017)46 b Fe('myfile.fits')p Fi(:)37 b(the)31 +b(simplest)d(case)k(of)e(a)h(FITS)f(\014le)f(on)i(disk)d(in)i(the)g +(curren)m(t)g(directory)-8 b(.)136 2137 y Fc(\017)46 +b Fe('myfile.imh')p Fi(:)37 b(op)s(ens)28 b(an)h(IRAF)g(format)g(image) +h(\014le)e(and)g(con)m(v)m(erts)i(it)f(on)g(the)g(\015y)f(in)m(to)h(a)g +(temp)s(orary)227 2250 y(FITS)h(format)h(image)f(in)f(memory)i(whic)m +(h)e(can)h(then)g(b)s(e)g(read)g(with)f(an)m(y)i(other)g(CFITSIO)e +(routine.)136 2427 y Fc(\017)46 b Fe(rawfile.dat[i512,512])p +Fi(:)35 b(op)s(ens)30 b(a)g(ra)m(w)h(binary)d(data)j(arra)m(y)g(\(a)g +(512)g(x)f(512)i(short)e(in)m(teger)g(arra)m(y)h(in)227 +2540 y(this)h(case\))j(and)d(con)m(v)m(erts)j(it)d(on)h(the)g(\015y)g +(in)m(to)g(a)g(temp)s(orary)g(FITS)f(format)h(image)h(in)d(memory)i +(whic)m(h)227 2652 y(can)e(then)f(b)s(e)g(read)g(with)f(an)m(y)i(other) +f(CFITSIO)f(routine.)136 2830 y Fc(\017)46 b Fe(myfile.fits.gz)p +Fi(:)d(if)32 b(this)g(is)g(the)h(name)g(of)h(a)f(new)g(output)g +(\014le,)g(the)g('.gz')i(su\016x)d(will)e(cause)k(it)f(to)h(b)s(e)227 +2942 y(compressed)c(in)f(gzip)h(format)h(when)e(it)h(is)g(written)f(to) +i(disk.)136 3120 y Fc(\017)46 b Fe('myfile.fits.gz[events,)c(2]')p +Fi(:)59 b(op)s(ens)40 b(and)f(uncompresses)g(the)i(gzipp)s(ed)d(\014le) +i(m)m(y\014le.\014ts)f(then)227 3232 y(mo)m(v)m(es)34 +b(to)f(the)f(extension)g(whic)m(h)f(has)g(the)i(k)m(eyw)m(ords)f +(EXTNAME)g(=)g('EVENTS')g(and)g(EXTVER)f(=)227 3345 y(2.)136 +3522 y Fc(\017)46 b Fe('-')p Fi(:)40 b(a)31 b(dash)f(\(min)m(us)f +(sign\))h(signi\014es)e(that)j(the)g(input)e(\014le)g(is)h(to)h(b)s(e)f +(read)g(from)g(the)h(stdin)e(\014le)g(stream,)227 3635 +y(or)i(that)g(the)f(output)g(\014le)g(is)f(to)i(b)s(e)f(written)f(to)i +(the)g(stdout)f(stream.)136 3812 y Fc(\017)46 b Fe +('ftp://legacy.gsfc.nasa.g)o(ov/t)o(est/)o(vel)o(a.fi)o(ts')p +Fi(:)33 b(FITS)28 b(\014les)f(in)g(an)m(y)h(ftp)g(arc)m(hiv)m(e)h(site) +f(on)g(the)227 3925 y(in)m(ternet)i(ma)m(y)h(b)s(e)f(directly)f(op)s +(ened)h(with)f(read-only)h(access.)136 4102 y Fc(\017)46 +b Fe('http://legacy.gsfc.nasa.)o(gov/)o(soft)o(war)o(e/te)o(st.f)o(its) +o(')p Fi(:)d(an)m(y)34 b(v)-5 b(alid)33 b(URL)h(to)h(a)f(FITS)g(\014le) +f(on)227 4215 y(the)e(W)-8 b(eb)31 b(ma)m(y)g(b)s(e)f(op)s(ened)f(with) +g(read-only)h(access.)136 4392 y Fc(\017)46 b Fe +('root://legacy.gsfc.nasa.)o(gov/)o(test)o(/ve)o(la.f)o(its')o +Fi(:)32 b(similar)21 b(to)j(ftp)f(access)i(except)g(that)f(it)f(pro-) +227 4505 y(vides)29 b(write)h(as)g(w)m(ell)f(as)i(read)f(access)h(to)g +(the)f(\014les)g(across)g(the)h(net)m(w)m(ork.)41 b(This)28 +b(uses)i(the)h(ro)s(ot)f(proto)s(col)227 4618 y(dev)m(elop)s(ed)g(at)h +(CERN.)136 4795 y Fc(\017)46 b Fe('shmem://h2[events]')p +Fi(:)35 b(op)s(ens)30 b(the)g(FITS)f(\014le)h(in)f(a)h(shared)f(memory) +i(segmen)m(t)g(and)e(mo)m(v)m(es)j(to)f(the)227 4908 +y(EVENTS)f(extension.)136 5085 y Fc(\017)46 b Fe('mem://')p +Fi(:)52 b(creates)39 b(a)e(scratc)m(h)i(output)d(\014le)h(in)e(core)j +(computer)f(memory)-8 b(.)62 b(The)37 b(resulting)e('\014le')i(will)227 +5198 y(disapp)s(ear)24 b(when)g(the)i(program)f(exits,)h(so)g(this)e +(is)h(mainly)e(useful)h(for)h(testing)h(purp)s(oses)d(when)i(one)g(do)s +(es)227 5311 y(not)31 b(w)m(an)m(t)g(a)g(p)s(ermanen)m(t)f(cop)m(y)h +(of)f(the)h(output)f(\014le.)136 5488 y Fc(\017)46 b +Fe('myfile.fits[3;)e(Images\(10\)]')p Fi(:)49 b(op)s(ens)35 +b(a)i(cop)m(y)g(of)f(the)g(image)h(con)m(tained)f(in)f(the)i(10th)f(ro) +m(w)h(of)227 5601 y(the)26 b('Images')i(column)c(in)h(the)h(binary)f +(table)g(in)g(the)h(3th)h(extension)e(of)h(the)h(FITS)e(\014le.)38 +b(The)26 b(application)227 5714 y(just)k(sees)h(this)e(single)g(image)i +(as)f(the)h(primary)d(arra)m(y)-8 b(.)p eop +%%Page: 17 23 +17 22 bop 0 299 a Fg(4.1.)72 b(O)m(VER)-10 b(VIEW)3086 +b Fi(17)136 555 y Fc(\017)46 b Fe('myfile.fits[1:512:2,)c(1:512:2]')p +Fi(:)49 b(op)s(ens)35 b(a)h(section)g(of)f(the)h(input)e(image)i +(ranging)f(from)g(the)227 668 y(1st)26 b(to)g(the)f(512th)h(pixel)e(in) +f(X)j(and)e(Y,)i(and)e(selects)i(ev)m(ery)f(second)h(pixel)d(in)h(b)s +(oth)g(dimensions,)g(resulting)227 781 y(in)29 b(a)i(256)h(x)e(256)i +(pixel)c(image)j(in)e(this)g(case.)136 981 y Fc(\017)46 +b Fe('myfile.fits[EVENTS][col)41 b(Rad)47 b(=)h(sqrt\(X**2)d(+)j +(Y**2\)]')p Fi(:)38 b(creates)30 b(and)f(op)s(ens)f(a)h(temp)s(orary) +227 1094 y(\014le)e(on)g(the)g(\015y)g(\(in)f(memory)h(or)g(on)h +(disk\))e(that)h(is)g(iden)m(tical)f(to)i(m)m(y\014le.\014ts)e(except)i +(that)g(it)f(will)e(con)m(tain)227 1207 y(a)41 b(new)f(column)f(in)h +(the)g(EVENTS)g(extension)g(called)g('Rad')h(whose)f(v)-5 +b(alue)40 b(is)f(computed)i(using)e(the)227 1320 y(indicated)29 +b(expresson)h(whic)m(h)f(is)h(a)g(function)f(of)i(the)g(v)-5 +b(alues)29 b(in)g(the)i(X)f(and)g(Y)h(columns.)136 1520 +y Fc(\017)46 b Fe('myfile.fits[EVENTS][PHA)41 b(>)48 +b(5]')p Fi(:)37 b(creates)27 b(and)e(op)s(ens)g(a)h(temp)s(orary)f +(FITS)g(\014les)f(that)i(is)f(iden)m(ti-)227 1633 y(cal)k(to)h('m)m +(y\014le.\014ts')e(except)i(that)f(the)g(EVENTS)f(table)h(will)d(only)i +(con)m(tain)h(the)g(ro)m(ws)g(that)h(ha)m(v)m(e)g(v)-5 +b(alues)227 1746 y(of)28 b(the)g(PHA)f(column)f(greater)j(than)e(5.)40 +b(In)27 b(general,)h(an)m(y)g(arbitrary)e(b)s(o)s(olean)h(expression)f +(using)g(a)i(C)f(or)227 1859 y(F)-8 b(ortran-lik)m(e)29 +b(syn)m(tax,)g(whic)m(h)e(ma)m(y)i(com)m(bine)f(AND)h(and)f(OR)f(op)s +(erators,)i(ma)m(y)g(b)s(e)f(used)f(to)i(select)g(ro)m(ws)227 +1972 y(from)h(a)h(table.)136 2172 y Fc(\017)46 b Fe +('myfile.fits[EVENTS][bin)41 b(\(X,Y\)=1,2048,4]')p Fi(:)46 +b(creates)37 b(a)e(temp)s(orary)g(FITS)f(primary)f(arra)m(y)227 +2285 y(image)c(whic)m(h)f(is)g(computed)g(on)h(the)g(\015y)f(b)m(y)g +(binning)e(\(i.e,)k(computing)d(the)i(2-dimensional)e(histogram\))227 +2398 y(of)34 b(the)f(v)-5 b(alues)33 b(in)f(the)i(X)g(and)e(Y)i +(columns)e(of)i(the)f(EVENTS)g(extension.)49 b(In)33 +b(this)f(case)j(the)e(X)h(and)f(Y)227 2511 y(co)s(ordinates)g(range)h +(from)f(1)h(to)g(2048)h(and)e(the)h(image)f(pixel)f(size)h(is)g(4)g +(units)f(in)g(b)s(oth)h(dimensions,)f(so)227 2624 y(the)f(resulting)d +(image)j(is)e(512)j(x)e(512)i(pixels)d(in)g(size.)136 +2824 y Fc(\017)46 b Fi(The)31 b(\014nal)f(example)i(com)m(bines)f(man)m +(y)g(of)h(these)g(feature)g(in)m(to)f(one)h(complex)f(expression)f +(\(it)i(is)e(brok)m(en)227 2937 y(in)m(to)h(sev)m(eral)f(lines)f(for)h +(clarit)m(y\):)323 3206 y Fe('ftp://legacy.gsfc.nasa)o(.gov)o(/dat)o +(a/s)o(ampl)o(e.fi)o(ts.)o(gz[E)o(VENT)o(S])370 3319 +y([col)47 b(phacorr)f(=)h(pha)g(*)h(1.1)f(-)g(0.3][phacorr)e(>=)i(5.0)g +(&&)g(phacorr)f(<=)h(14.0])370 3432 y([bin)g(\(X,Y\)=32]')227 +3701 y Fi(In)37 b(this)g(case,)k(CFITSIO)36 b(\(1\))j(copies)f(and)f +(uncompresses)g(the)h(FITS)f(\014le)g(from)g(the)h(ftp)f(site)h(on)g +(the)227 3814 y(legacy)f(mac)m(hine,)h(\(2\))f(mo)m(v)m(es)g(to)g(the)g +('EVENTS')f(extension,)h(\(3\))g(calculates)g(a)f(new)g(column)f +(called)227 3927 y('phacorr',)30 b(\(4\))f(selects)g(the)g(ro)m(ws)g +(in)e(the)i(table)g(that)g(ha)m(v)m(e)h(phacorr)e(in)f(the)i(range)g(5) +g(to)h(14,)g(and)e(\014nally)227 4040 y(\(5\))35 b(bins)c(the)i +(remaining)e(ro)m(ws)i(on)h(the)f(X)g(and)g(Y)g(column)f(co)s +(ordinates,)i(using)d(a)j(pixel)d(size)i(=)g(32)h(to)227 +4153 y(create)d(a)f(2D)g(image.)41 b(All)28 b(this)g(pro)s(cessing)g +(is)h(completely)g(transparen)m(t)g(to)i(the)e(application)f(program,) +227 4266 y(whic)m(h)h(simply)f(sees)j(the)g(\014nal)e(2-D)i(image)g(in) +e(the)h(primary)f(arra)m(y)i(of)f(the)h(op)s(ened)f(\014le.)0 +4538 y(The)c(full)f(extended)i(CFITSIO)e(FITS)h(\014le)g(name)h(can)g +(con)m(tain)g(sev)m(eral)g(di\013eren)m(t)g(comp)s(onen)m(ts)g(dep)s +(ending)d(on)0 4651 y(the)31 b(con)m(text.)42 b(These)30 +b(comp)s(onen)m(ts)h(are)g(describ)s(ed)d(in)h(the)h(follo)m(wing)f +(sections:)0 4924 y Fe(When)47 b(creating)e(a)j(new)f(file:)143 +5036 y(filetype://BaseFilename\(t)o(empl)o(ate)o(Name)o(\))0 +5262 y(When)g(opening)e(an)j(existing)d(primary)h(array)g(or)i(image)e +(HDU:)143 5375 y(filetype://BaseFilename\(o)o(utNa)o(me\))o([HDU)o +(loca)o(tio)o(n][I)o(mage)o(Sec)o(tion)o(])0 5601 y(When)h(opening)e +(an)j(existing)d(table)i(HDU:)143 5714 y(filetype://BaseFilename\(o)o +(utNa)o(me\))o([HDU)o(loca)o(tio)o(n][c)o(olFi)o(lte)o(r][r)o(owFi)o +(lte)o(r][b)o(inSp)o(ec])p eop +%%Page: 18 24 +18 23 bop 0 299 a Fi(18)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fi(The)41 +b(\014let)m(yp)s(e,)j(BaseFilename,)h(outName,)g(HDUlo)s(cation,)g(and) +c(ImageSection)h(comp)s(onen)m(ts,)j(if)c(presen)m(t,)0 +668 y(m)m(ust)30 b(b)s(e)g(giv)m(en)h(in)e(that)i(order,)g(but)f(the)g +(colFilter,)g(ro)m(wFilter,)h(and)e(binSp)s(ec)g(sp)s(eci\014ers)f(ma)m +(y)k(follo)m(w)d(in)h(an)m(y)0 781 y(order.)39 b(Regardless)28 +b(of)h(the)f(order,)g(ho)m(w)m(ev)m(er,)i(the)f(colFilter)e(sp)s +(eci\014er,)g(if)g(presen)m(t,)i(will)d(b)s(e)h(pro)s(cessed)h(\014rst) +f(b)m(y)0 894 y(CFITSIO,)i(follo)m(w)m(ed)h(b)m(y)g(the)h(ro)m(wFilter) +f(sp)s(eci\014er,)f(and)g(\014nally)g(b)m(y)h(the)g(binSp)s(ec)e(sp)s +(eci\014er.)0 1221 y Fd(4.2)135 b(Filet)l(yp)t(e)0 1471 +y Fi(The)37 b(t)m(yp)s(e)g(of)g(\014le)f(determines)g(the)h(medium)e +(on)i(whic)m(h)f(the)h(\014le)f(is)h(lo)s(cated)g(\(e.g.,)j(disk)c(or)h +(net)m(w)m(ork\))h(and,)0 1584 y(hence,)f(whic)m(h)d(in)m(ternal)g +(device)h(driv)m(er)f(is)g(used)g(b)m(y)h(CFITSIO)f(to)i(read)f(and/or) +g(write)f(the)h(\014le.)55 b(Curren)m(tly)0 1697 y(supp)s(orted)29 +b(t)m(yp)s(es)h(are)382 1913 y Fe(file://)93 b(-)48 b(file)e(on)i +(local)e(magnetic)g(disk)g(\(default\))382 2026 y(ftp://)141 +b(-)48 b(a)f(readonly)f(file)g(accessed)g(with)h(the)g(anonymous)e(FTP) +i(protocol.)907 2139 y(It)g(also)g(supports)93 b +(ftp://username:password@)o(host)o(nam)o(e/..)o(.)907 +2252 y(for)47 b(accessing)e(password-protected)e(ftp)k(sites.)382 +2365 y(http://)93 b(-)48 b(a)f(readonly)f(file)g(accessed)g(with)h(the) +g(HTTP)f(protocol.)93 b(It)907 2478 y(does)46 b(not)95 +b(support)46 b(username:password)d(like)k(the)g(ftp)f(driver.)907 +2591 y(Proxy)g(HTTP)h(servers)f(are)h(supported)e(using)h(the)h +(http_proxy)907 2704 y(environment)e(variable.)382 2817 +y(root://)93 b(-)48 b(uses)e(the)h(CERN)g(root)g(protocol)e(for)i +(writing)f(as)h(well)g(as)907 2930 y(reading)f(files)g(over)h(the)g +(network.)382 3042 y(shmem://)e(-)j(opens)e(or)h(creates)f(a)i(file)e +(which)h(persists)e(in)i(the)g(computer's)907 3155 y(shared)f(memory.) +382 3268 y(mem://)141 b(-)48 b(opens)e(a)i(temporary)d(file)i(in)g +(core)f(memory.)94 b(The)47 b(file)907 3381 y(disappears)e(when)h(the)h +(program)f(exits)h(so)g(this)f(is)i(mainly)907 3494 y(useful)e(for)h +(test)f(purposes)g(when)h(a)g(permanent)e(output)h(file)907 +3607 y(is)h(not)g(desired.)0 3824 y Fi(If)35 b(the)h(\014let)m(yp)s(e)f +(is)f(not)i(sp)s(eci\014ed,)g(then)f(t)m(yp)s(e)h(\014le://)g(is)e +(assumed.)56 b(The)35 b(double)f(slashes)h('//')i(are)f(optional)0 +3937 y(and)30 b(ma)m(y)h(b)s(e)e(omitted)i(in)e(most)i(cases.)0 +4220 y Fb(4.2.1)112 b(Notes)37 b(ab)s(out)i(HTTP)d(pro)m(xy)i(serv)m +(ers)0 4439 y Fi(A)32 b(pro)m(xy)g(HTTP)f(serv)m(er)h(ma)m(y)h(b)s(e)e +(used)g(b)m(y)h(de\014ning)e(the)i(address)f(\(URL\))i(and)e(p)s(ort)g +(n)m(um)m(b)s(er)g(of)h(the)g(pro)m(xy)0 4552 y(serv)m(er)f(with)e(the) +h(h)m(ttp)p 801 4552 28 4 v 33 w(pro)m(xy)g(en)m(vironmen)m(t)g(v)-5 +b(ariable.)40 b(F)-8 b(or)31 b(example)191 4769 y Fe(setenv)46 +b(http_proxy)f(http://heasarc.gsfc.nasa)o(.gov)o(:312)o(8)0 +4985 y Fi(will)35 b(cause)j(CFITSIO)f(to)h(use)g(p)s(ort)f(3128)i(on)f +(the)g(heasarc)g(pro)m(xy)g(serv)m(er)g(whenev)m(er)g(reading)f(a)h +(FITS)f(\014le)0 5098 y(with)29 b(HTTP)-8 b(.)0 5382 +y Fb(4.2.2)112 b(Notes)37 b(ab)s(out)i(the)e(ro)s(ot)g(\014let)m(yp)s +(e)0 5601 y Fi(The)20 b(original)g(ro)s(otd)g(serv)m(er)h(can)h(b)s(e)e +(obtained)g(from:)36 b Fe(ftp://root.cern.ch/root)o(/roo)o(td.t)o(ar.)o +(gz)15 b Fi(but,)22 b(for)0 5714 y(it)32 b(to)i(w)m(ork)f(correctly)g +(with)e(CFITSIO)h(one)h(has)f(to)i(use)e(a)i(mo)s(di\014ed)c(v)m +(ersion)j(whic)m(h)e(supp)s(orts)g(a)i(command)p eop +%%Page: 19 25 +19 24 bop 0 299 a Fg(4.2.)72 b(FILETYPE)3128 b Fi(19)0 +555 y(to)41 b(return)d(the)j(length)e(of)h(the)g(\014le.)69 +b(This)38 b(mo)s(di\014ed)f(v)m(ersion)j(is)f(a)m(v)-5 +b(ailable)39 b(in)g(ro)s(otd)g(sub)s(directory)f(in)h(the)0 +668 y(CFITSIO)29 b(ftp)h(area)h(at)286 928 y Fe +(ftp://legacy.gsfc.nasa.gov)o(/so)o(ftwa)o(re/f)o(its)o(io/c)o(/roo)o +(t/r)o(ootd)o(.tar)o(.gz)o(.)0 1187 y Fi(This)i(small)f(serv)m(er)j(is) +f(started)g(either)g(b)m(y)h(inetd)e(when)g(a)i(clien)m(t)f(requests)g +(a)h(connection)g(to)g(a)f(ro)s(otd)h(serv)m(er)0 1300 +y(or)30 b(b)m(y)g(hand)f(\(i.e.)41 b(from)30 b(the)g(command)g(line\).) +40 b(The)29 b(ro)s(otd)h(serv)m(er)h(w)m(orks)f(with)f(the)h(R)m(OOT)g +(TNetFile)g(class.)0 1413 y(It)g(allo)m(ws)e(remote)j(access)f(to)h(R)m +(OOT)e(database)h(\014les)e(in)g(either)h(read)h(or)f(write)g(mo)s(de.) +40 b(By)30 b(default)e(TNetFile)0 1526 y(assumes)38 b(p)s(ort)g(432)h +(\(whic)m(h)e(requires)g(ro)s(otd)h(to)h(b)s(e)f(started)h(as)f(ro)s +(ot\).)65 b(T)-8 b(o)39 b(run)e(ro)s(otd)h(via)g(inetd)f(add)h(the)0 +1639 y(follo)m(wing)29 b(line)g(to)i(/etc/services:)95 +1898 y Fe(rootd)238 b(432/tcp)0 2158 y Fi(and)30 b(to)h +(/etc/inetd.conf,)h(add)e(the)g(follo)m(wing)f(line:)95 +2417 y Fe(rootd)47 b(stream)f(tcp)h(nowait)f(root)h +(/user/rdm/root/bin/root)o(d)42 b(rootd)k(-i)0 2677 y +Fi(F)-8 b(orce)34 b(inetd)d(to)j(reread)e(its)g(conf)g(\014le)g(with)f +("kill)f(-HUP)j(".)46 b(Y)-8 b(ou)33 b(can)g(also)f(start) +h(ro)s(otd)g(b)m(y)f(hand)0 2790 y(running)i(directly)h(under)f(y)m +(our)j(priv)-5 b(ate)36 b(accoun)m(t)h(\(no)g(ro)s(ot)g(system)f +(privileges)e(needed\).)59 b(F)-8 b(or)37 b(example)f(to)0 +2903 y(start)f(ro)s(otd)e(listening)f(on)i(p)s(ort)f(5151)j(just)d(t)m +(yp)s(e:)49 b Fe(rootd)d(-p)h(5151)33 b Fi(Notice:)49 +b(no)34 b(&)f(is)g(needed.)51 b(Ro)s(otd)35 b(will)0 +3016 y(go)c(in)m(to)g(bac)m(kground)f(b)m(y)g(itself.)95 +3275 y Fe(Rootd)47 b(arguments:)191 3388 y(-i)763 b(says)47 +b(we)g(were)f(started)g(by)h(inetd)191 3501 y(-p)g(port#)476 +b(specifies)45 b(a)j(different)d(port)i(to)g(listen)f(on)191 +3614 y(-d)h(level)476 b(level)46 b(of)i(debug)e(info)h(written)e(to)j +(syslog)1050 3727 y(0)f(=)h(no)f(debug)f(\(default\))1050 +3840 y(1)h(=)h(minimum)1050 3953 y(2)f(=)h(medium)1050 +4066 y(3)f(=)h(maximum)0 4325 y Fi(Ro)s(otd)29 b(can)f(also)g(b)s(e)g +(con\014gured)g(for)g(anon)m(ymous)g(usage)h(\(lik)m(e)f(anon)m(ymous)g +(ftp\).)40 b(T)-8 b(o)29 b(setup)f(ro)s(otd)g(to)h(accept)0 +4438 y(anon)m(ymous)h(logins)f(do)i(the)f(follo)m(wing)f(\(while)g(b)s +(eing)g(logged)i(in)e(as)h(ro)s(ot\):)143 4698 y Fe(-)48 +b(Add)f(the)f(following)g(line)g(to)i(/etc/passwd:)239 +4924 y(rootd:*:71:72:Anonymous)41 b(rootd:/var/spool/rootd:/b)o(in/)o +(fals)o(e)239 5149 y(where)46 b(you)h(may)g(modify)f(the)h(uid,)f(gid)h +(\(71,)g(72\))g(and)g(the)g(home)f(directory)239 5262 +y(to)h(suite)f(your)h(system.)143 5488 y(-)h(Add)f(the)f(following)g +(line)g(to)i(/etc/group:)239 5714 y(rootd:*:72:rootd)p +eop +%%Page: 20 26 +20 25 bop 0 299 a Fi(20)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)239 668 y +Fe(where)46 b(the)h(gid)g(must)f(match)h(the)g(gid)g(in)g(/etc/passwd.) +143 894 y(-)h(Create)e(the)h(directories:)239 1120 y(mkdir)f +(/var/spool/rootd)239 1233 y(mkdir)g(/var/spool/rootd/tmp)239 +1346 y(chmod)g(777)h(/var/spool/rootd/tmp)239 1571 y(Where)f +(/var/spool/rootd)d(must)k(match)f(the)h(rootd)g(home)f(directory)g(as) +239 1684 y(specified)f(in)i(the)g(rootd)f(/etc/passwd)f(entry.)143 +1910 y(-)j(To)f(make)f(writeable)g(directories)e(for)j(anonymous)f(do,) +h(for)f(example:)239 2136 y(mkdir)g(/var/spool/rootd/pub)239 +2249 y(chown)g(rootd:rootd)f(/var/spool/rootd/pub)0 2492 +y Fi(That's)d(all.)74 b(Sev)m(eral)42 b(additional)e(remarks:)64 +b(y)m(ou)42 b(can)g(login)f(to)i(an)f(anon)m(ymous)f(serv)m(er)i +(either)e(with)g(the)0 2605 y(names)31 b("anon)m(ymous")h(or)f("ro)s +(otd".)43 b(The)31 b(passw)m(ord)f(should)f(b)s(e)i(of)g(t)m(yp)s(e)g +(user@host.do.main.)42 b(Only)29 b(the)i(@)0 2718 y(is)d(enforced)g +(for)h(the)f(time)h(b)s(eing.)38 b(In)28 b(anon)m(ymous)h(mo)s(de)f +(the)g(top)h(of)g(the)g(\014le)e(tree)j(is)d(set)i(to)h(the)e(ro)s(otd) +h(home)0 2831 y(directory)-8 b(,)38 b(therefore)f(only)e(\014les)h(b)s +(elo)m(w)f(the)i(home)f(directory)g(can)g(b)s(e)g(accessed.)60 +b(Anon)m(ymous)36 b(mo)s(de)g(only)0 2944 y(w)m(orks)30 +b(when)g(the)g(serv)m(er)h(is)e(started)i(via)f(inetd.)0 +3232 y Fb(4.2.3)112 b(Notes)37 b(ab)s(out)i(the)e(shmem)g(\014let)m(yp) +s(e:)0 3451 y Fi(Shared)d(memory)h(\014les)f(are)h(curren)m(tly)f(supp) +s(orted)f(on)i(most)h(Unix)e(platforms,)h(where)g(the)g(shared)f +(memory)0 3564 y(segmen)m(ts)d(are)g(managed)g(b)m(y)f(the)g(op)s +(erating)g(system)h(k)m(ernel)e(and)h(`liv)m(e')g(indep)s(enden)m(tly)d +(of)k(pro)s(cesses.)40 b(They)0 3677 y(are)34 b(not)g(deleted)g(\(b)m +(y)g(default\))f(when)g(the)h(pro)s(cess)f(whic)m(h)g(created)i(them)f +(terminates,)g(although)g(they)g(will)0 3790 y(disapp)s(ear)d(if)h(the) +i(system)f(is)f(reb)s(o)s(oted.)49 b(Applications)31 +b(can)j(create)h(shared)d(memory)h(\014les)f(in)g(CFITSIO)g(b)m(y)0 +3903 y(calling:)143 4146 y Fe(fit_create_file\(&fitsfile)o(ptr,)41 +b("shmem://h2",)j(&status\);)0 4389 y Fi(where)22 b(the)g(ro)s(ot)h +(`\014le')f(names)g(are)g(curren)m(tly)g(restricted)g(to)h(b)s(e)e +('h0',)k('h1',)f('h2',)h('h3',)f(etc.,)i(up)21 b(to)i(a)g(maxim)m(umn)0 +4502 y(n)m(um)m(b)s(er)d(de\014ned)f(b)m(y)i(the)g(the)g(v)-5 +b(alue)21 b(of)g(SHARED)p 1746 4502 28 4 v 33 w(MAXSEG)g(\(equal)g(to)g +(16)h(b)m(y)f(default\).)37 b(This)19 b(is)h(a)h(protot)m(yp)s(e)0 +4615 y(implemen)m(tation)27 b(of)i(the)g(shared)f(memory)g(in)m +(terface)h(and)f(a)h(more)g(robust)f(in)m(terface,)i(whic)m(h)d(will)f +(ha)m(v)m(e)k(few)m(er)0 4728 y(restrictions)f(on)h(the)h(n)m(um)m(b)s +(er)e(of)i(\014les)e(and)h(on)g(their)f(names,)i(ma)m(y)g(b)s(e)f(dev)m +(elop)s(ed)f(in)g(the)i(future.)0 4888 y(When)23 b(op)s(ening)g(an)g +(already)g(existing)g(FITS)g(\014le)g(in)f(shared)h(memory)h(one)g +(calls)e(the)i(usual)f(CFITSIO)f(routine:)143 5132 y +Fe(fits_open_file\(&fitsfilep)o(tr,)41 b("shmem://h7",)j(mode,)j +(&status\))0 5375 y Fi(The)26 b(\014le)g(mo)s(de)h(can)g(b)s(e)f(READ)m +(WRITE)h(or)g(READONL)-8 b(Y)28 b(just)e(as)h(with)e(disk)h(\014les.)38 +b(More)28 b(than)e(one)h(pro)s(cess)0 5488 y(can)35 b(op)s(erate)g(on)f +(READONL)-8 b(Y)35 b(mo)s(de)f(\014les)g(at)h(the)f(same)h(time.)53 +b(CFITSIO)33 b(supp)s(orts)f(prop)s(er)h(\014le)h(lo)s(c)m(king)0 +5601 y(\(b)s(oth)27 b(in)g(READONL)-8 b(Y)29 b(and)e(READ)m(WRITE)h(mo) +s(des\),)h(so)f(calls)f(to)h(\014ts)p 2572 5601 V 33 +w(op)s(en)p 2795 5601 V 32 w(\014le)f(ma)m(y)h(b)s(e)f(lo)s(c)m(k)m(ed) +i(out)f(un)m(til)0 5714 y(another)j(other)f(pro)s(cess)g(closes)h(the)f +(\014le.)p eop +%%Page: 21 27 +21 26 bop 0 299 a Fg(4.3.)72 b(BASE)30 b(FILENAME)2830 +b Fi(21)0 555 y(When)30 b(an)g(application)f(is)g(\014nished)f +(accessing)j(a)f(FITS)g(\014le)f(in)g(a)i(shared)e(memory)h(segmen)m +(t,)i(it)e(ma)m(y)h(close)f(it)0 668 y(\(and)k(the)g(\014le)f(will)e +(remain)h(in)h(the)h(system\))g(with)f(\014ts)p 1955 +668 28 4 v 32 w(close)p 2174 668 V 33 w(\014le,)h(or)g(delete)g(it)g +(with)e(\014ts)p 3191 668 V 33 w(delete)p 3456 668 V +33 w(\014le.)50 b(Ph)m(ys-)0 781 y(ical)34 b(deletion)g(is)g(p)s(ostp)s +(oned)f(un)m(til)h(the)h(last)f(pro)s(cess)h(calls)f +(\013clos/\013delt.)54 b(\014ts)p 2801 781 V 32 w(delete)p +3065 781 V 33 w(\014le)34 b(tries)h(to)g(obtain)g(a)0 +894 y(READ)m(WRITE)f(lo)s(c)m(k)f(on)g(the)g(\014le)g(to)h(b)s(e)e +(deleted,)i(th)m(us)f(it)g(can)g(b)s(e)g(blo)s(c)m(k)m(ed)g(if)f(the)i +(ob)5 b(ject)34 b(w)m(as)f(not)h(op)s(ened)0 1007 y(in)29 +b(READ)m(WRITE)i(mo)s(de.)0 1167 y(A)i(shared)f(memory)h(managemen)m(t) +h(utilit)m(y)d(program)i(called)f(`smem',)h(is)f(included)e(with)i(the) +h(CFITSIO)e(dis-)0 1280 y(tribution.)37 b(It)27 b(can)g(b)s(e)f(built)f +(b)m(y)i(t)m(yping)f(`mak)m(e)i(smem';)g(then)f(t)m(yp)s(e)g(`smem)f +(-h')h(to)h(get)g(a)f(list)e(of)i(v)-5 b(alid)25 b(options.)0 +1393 y(Executing)36 b(smem)g(without)f(an)m(y)i(options)f(causes)g(it)g +(to)h(list)e(all)g(the)i(shared)e(memory)i(segmen)m(ts)g(curren)m(tly)0 +1506 y(residing)31 b(in)h(the)h(system)h(and)e(managed)i(b)m(y)f(the)h +(shared)e(memory)h(driv)m(er.)48 b(T)-8 b(o)34 b(get)g(a)g(list)e(of)h +(all)f(the)i(shared)0 1619 y(memory)c(ob)5 b(jects,)32 +b(run)d(the)h(system)h(utilit)m(y)d(program)i(`ip)s(cs)g([-a]'.)0 +1978 y Fd(4.3)135 b(Base)46 b(Filename)0 2233 y Fi(The)31 +b(base)g(\014lename)g(is)f(the)i(name)f(of)h(the)f(\014le)g(optionally) +e(including)f(the)k(director/sub)s(directory)d(path,)j(and)0 +2346 y(in)d(the)i(case)g(of)g(`ftp',)f(`h)m(ttp',)i(and)d(`ro)s(ot')j +(\014let)m(yp)s(es,)d(the)i(mac)m(hine)f(iden)m(ti\014er.)39 +b(Examples:)191 2628 y Fe(myfile.fits)191 2741 y(!data.fits)191 +2854 y(/data/myfile.fits)191 2967 y(fits.gsfc.nasa.gov/ftp/s)o(ampl)o +(eda)o(ta/m)o(yfil)o(e.f)o(its.)o(gz)0 3248 y Fi(When)29 +b(creating)g(a)g(new)f(output)h(\014le)f(on)h(magnetic)g(disk)e(\(of)j +(t)m(yp)s(e)f(\014le://\))g(if)f(the)h(base)g(\014lename)f(b)s(egins)f +(with)0 3361 y(an)34 b(exclamation)h(p)s(oin)m(t)e(\(!\))54 +b(then)34 b(an)m(y)g(existing)g(\014le)f(with)g(that)i(same)g(basename) +g(will)d(b)s(e)h(deleted)h(prior)f(to)0 3474 y(creating)h(the)g(new)g +(FITS)f(\014le.)50 b(Otherwise)33 b(if)g(the)h(\014le)f(to)h(b)s(e)g +(created)h(already)e(exists,)i(then)e(CFITSIO)g(will)0 +3587 y(return)g(an)h(error)f(and)g(will)f(not)i(o)m(v)m(erwrite)g(the)g +(existing)f(\014le.)51 b(Note)35 b(that)g(the)f(exclamation)g(p)s(oin)m +(t,)g(')10 b(!',)36 b(is)d(a)0 3700 y(sp)s(ecial)26 b(UNIX)i(c)m +(haracter,)j(so)d(if)e(it)i(is)f(used)g(on)g(the)h(command)g(line)e +(rather)i(than)f(en)m(tered)h(at)h(a)f(task)h(prompt,)0 +3813 y(it)i(m)m(ust)g(b)s(e)g(preceded)g(b)m(y)h(a)g(bac)m(kslash)f(to) +h(force)g(the)g(UNIX)g(shell)d(to)j(pass)f(it)h(v)m(erbatim)f(to)h(the) +g(application)0 3926 y(program.)0 4086 y(If)24 b(the)i(output)e(disk)g +(\014le)g(name)h(ends)f(with)f(the)i(su\016x)f('.gz',)k(then)d(CFITSIO) +e(will)f(compress)j(the)g(\014le)f(using)g(the)0 4199 +y(gzip)g(compression)f(algorithm)g(b)s(efore)h(writing)e(it)i(to)h +(disk.)37 b(This)22 b(can)j(reduce)f(the)g(amoun)m(t)h(of)f(disk)f +(space)i(used)0 4312 y(b)m(y)34 b(the)h(\014le.)52 b(Note)36 +b(that)f(this)f(feature)h(requires)e(that)i(the)f(uncompressed)g +(\014le)f(b)s(e)h(constructed)h(in)e(memory)0 4425 y(b)s(efore)d(it)g +(is)f(compressed)h(and)g(written)g(to)h(disk,)e(so)h(it)g(can)h(fail)e +(if)g(there)i(is)e(insu\016cien)m(t)g(a)m(v)-5 b(ailable)30 +b(memory)-8 b(.)0 4585 y(An)45 b(input)f(FITS)g(\014le)h(ma)m(y)h(b)s +(e)f(compressed)g(with)g(the)g(gzip)g(or)h(Unix)e(compress)i +(algorithms,)i(in)c(whic)m(h)0 4698 y(case)38 b(CFITSIO)e(will)f +(uncompress)h(the)i(\014le)f(on)g(the)h(\015y)e(in)m(to)i(a)g(temp)s +(orary)f(\014le)f(\(in)h(memory)g(or)g(on)h(disk\).)0 +4811 y(Compressed)32 b(\014les)h(ma)m(y)h(only)e(b)s(e)h(op)s(ened)f +(with)g(read-only)h(p)s(ermission.)47 b(When)33 b(sp)s(ecifying)e(the)j +(name)f(of)h(a)0 4924 y(compressed)h(FITS)g(\014le)g(it)g(is)g(not)h +(necessary)g(to)g(app)s(end)e(the)i(\014le)f(su\016x)f(\(e.g.,)39 +b(`.gz')e(or)f(`.Z'\).)g(If)f(CFITSIO)0 5036 y(cannot)24 +b(\014nd)e(the)h(input)e(\014le)i(name)g(without)f(the)h(su\016x,)h +(then)f(it)g(will)e(automatically)i(searc)m(h)h(for)f(a)g(compressed)0 +5149 y(\014le)35 b(with)f(the)i(same)g(ro)s(ot)g(name.)57 +b(In)35 b(the)h(case)h(of)f(reading)f(ftp)g(and)g(h)m(ttp)h(t)m(yp)s(e) +g(\014les,)g(CFITSIO)f(generally)0 5262 y(lo)s(oks)i(for)h(a)g +(compressed)g(v)m(ersion)f(of)h(the)g(\014le)f(\014rst,)i(b)s(efore)e +(trying)g(to)i(op)s(en)e(the)h(uncompressed)e(\014le.)63 +b(By)0 5375 y(default,)36 b(CFITSIO)f(copies)g(\(and)h(uncompressed)e +(if)h(necessary\))h(the)g(ftp)f(or)h(h)m(ttp)g(FITS)f(\014le)f(in)m(to) +i(memory)0 5488 y(on)g(the)g(lo)s(cal)f(mac)m(hine)g(b)s(efore)h(op)s +(ening)e(it.)57 b(This)34 b(will)f(fail)h(if)h(the)h(lo)s(cal)f(mac)m +(hine)h(do)s(es)f(not)h(ha)m(v)m(e)h(enough)0 5601 y(memory)g(to)h +(hold)e(the)h(whole)g(FITS)f(\014le,)j(so)e(in)f(this)g(case,)41 +b(the)c(output)g(\014lename)f(sp)s(eci\014er)g(\(see)i(the)g(next)0 +5714 y(section\))31 b(can)g(b)s(e)e(used)h(to)h(further)e(con)m(trol)i +(ho)m(w)f(CFITSIO)f(reads)h(ftp)g(and)g(h)m(ttp)g(\014les.)p +eop +%%Page: 22 28 +22 27 bop 0 299 a Fi(22)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fi(If)32 +b(the)h(input)e(\014le)h(is)g(an)h(IRAF)g(image)g(\014le)f(\(*.imh)g +(\014le\))h(then)f(CFITSIO)f(will)g(automatically)h(con)m(v)m(ert)j(it) +d(on)0 668 y(the)27 b(\015y)g(in)m(to)g(a)h(virtual)d(FITS)h(image)i(b) +s(efore)f(it)f(is)g(op)s(ened)h(b)m(y)g(the)g(application)f(program.)39 +b(IRAF)27 b(images)h(can)0 781 y(only)h(b)s(e)h(op)s(ened)g(with)f +(READONL)-8 b(Y)31 b(\014le)e(access.)0 941 y(Similarly)-8 +b(,)28 b(if)i(the)h(input)e(\014le)i(is)f(a)h(ra)m(w)g(binary)e(data)j +(arra)m(y)-8 b(,)33 b(then)d(CFITSIO)g(will)e(con)m(v)m(ert)33 +b(it)d(on)h(the)h(\015y)e(in)m(to)0 1054 y(a)38 b(virtual)e(FITS)i +(image)g(with)e(the)i(basic)g(set)g(of)g(required)e(header)i(k)m(eyw)m +(ords)g(b)s(efore)g(it)f(is)g(op)s(ened)g(b)m(y)h(the)0 +1167 y(application)29 b(program)i(\(with)f(READONL)-8 +b(Y)31 b(access\).)44 b(In)30 b(this)g(case)i(the)f(data)g(t)m(yp)s(e)g +(and)g(dimensions)d(of)j(the)0 1280 y(image)c(m)m(ust)g(b)s(e)f(sp)s +(eci\014ed)f(in)h(square)h(brac)m(k)m(ets)h(follo)m(wing)d(the)i +(\014lename)f(\(e.g.)41 b(ra)m(w\014le.dat[ib512,512]\).)h(The)0 +1393 y(\014rst)30 b(c)m(haracter)i(\(case)f(insensitiv)m(e\))e +(de\014nes)h(the)g(datat)m(yp)s(e)h(of)g(the)g(arra)m(y:)239 +1671 y Fe(b)429 b(8-bit)46 b(unsigned)g(byte)239 1784 +y(i)381 b(16-bit)46 b(signed)g(integer)239 1897 y(u)381 +b(16-bit)46 b(unsigned)g(integer)239 2010 y(j)381 b(32-bit)46 +b(signed)g(integer)239 2123 y(r)h(or)g(f)143 b(32-bit)46 +b(floating)g(point)239 2235 y(d)381 b(64-bit)46 b(floating)g(point)0 +2514 y Fi(An)40 b(optional)f(second)h(c)m(haracter)i(sp)s(eci\014es)d +(the)i(b)m(yte)f(order)g(of)g(the)h(arra)m(y)g(v)-5 b(alues:)59 +b(b)40 b(or)g(B)h(indicates)e(big)0 2626 y(endian)g(\(as)i(in)e(FITS)g +(\014les)h(and)g(the)g(nativ)m(e)h(format)f(of)h(SUN)f(UNIX)h(w)m +(orkstations)f(and)g(Mac)i(PCs\))e(and)0 2739 y(l)g(or)h(L)g(indicates) +e(little)h(endian)g(\(nativ)m(e)h(format)h(of)f(DEC)f(OSF)h(w)m +(orkstations)g(and)f(IBM)i(PCs\).)72 b(If)40 b(this)0 +2852 y(c)m(haracter)32 b(is)d(omitted)i(then)f(the)g(arra)m(y)h(is)f +(assumed)f(to)i(ha)m(v)m(e)h(the)f(nativ)m(e)f(b)m(yte)h(order)f(of)h +(the)f(lo)s(cal)g(mac)m(hine.)0 2965 y(These)f(datat)m(yp)s(e)h(c)m +(haracters)h(are)e(then)g(follo)m(w)m(ed)g(b)m(y)g(a)h(series)e(of)h +(one)h(or)f(more)g(in)m(teger)h(v)-5 b(alues)28 b(separated)i(b)m(y)0 +3078 y(commas)h(whic)m(h)f(de\014ne)f(the)i(size)g(of)f(eac)m(h)i +(dimension)c(of)j(the)g(ra)m(w)f(arra)m(y)-8 b(.)43 b(Arra)m(ys)30 +b(with)g(up)f(to)j(5)f(dimensions)0 3191 y(are)f(curren)m(tly)f(supp)s +(orted.)38 b(Finally)-8 b(,)29 b(a)h(b)m(yte)g(o\013set)g(to)h(the)e(p) +s(osition)f(of)i(the)g(\014rst)e(pixel)g(in)h(the)g(data)i(\014le)d(ma) +m(y)0 3304 y(b)s(e)e(sp)s(eci\014ed)f(b)m(y)i(separating)g(it)f(with)g +(a)h(':')39 b(from)27 b(the)g(last)f(dimension)f(v)-5 +b(alue.)39 b(If)26 b(omitted,)i(it)e(is)g(assumed)g(that)0 +3417 y(the)35 b(o\013set)h(=)f(0.)54 b(This)34 b(parameter)h(ma)m(y)h +(b)s(e)e(used)g(to)i(skip)d(o)m(v)m(er)j(an)m(y)g(header)e(information) +g(in)f(the)i(\014le)f(that)0 3530 y(precedes)c(the)h(binary)e(data.)41 +b(F)-8 b(urther)30 b(examples:)95 3808 y Fe(raw.dat[b10000])521 +b(1-dimensional)45 b(10000)h(pixel)g(byte)h(array)95 +3921 y(raw.dat[rb400,400,12])233 b(3-dimensional)45 b(floating)g(point) +h(big-endian)f(array)95 4034 y(img.fits[ib512,512:2880])89 +b(reads)47 b(the)g(512)g(x)g(512)g(short)f(integer)g(array)g(in)1336 +4147 y(a)i(FITS)e(file,)h(skipping)e(over)i(the)g(2880)g(byte)f(header) +0 4425 y Fi(One)25 b(sp)s(ecial)e(case)j(of)f(input)e(\014le)h(is)g +(where)h(the)g(\014lename)f(=)h(`-')h(\(a)f(dash)g(or)g(min)m(us)e +(sign\))h(or)h('stdin')f(or)h('stdout',)0 4538 y(whic)m(h)c +(signi\014es)g(that)j(the)f(input)d(\014le)i(is)g(to)i(b)s(e)e(read)g +(from)h(the)g(stdin)e(stream,)k(or)e(written)e(to)j(the)f(stdout)g +(stream)0 4650 y(if)33 b(a)h(new)g(output)f(\014le)g(is)g(b)s(eing)g +(created.)52 b(In)33 b(the)h(case)h(of)f(reading)g(from)f(stdin,)g +(CFITSIO)g(\014rst)g(copies)h(the)0 4763 y(whole)g(stream)i(in)m(to)f +(a)g(temp)s(orary)g(FITS)f(\014le)h(\(in)f(memory)h(or)g(on)g(disk\),)g +(and)g(subsequen)m(t)f(reading)g(of)i(the)0 4876 y(FITS)c(\014le)g(o)s +(ccurs)h(in)e(this)h(cop)m(y)-8 b(.)49 b(When)33 b(writing)e(to)i +(stdout,)h(CFITSIO)d(\014rst)h(constructs)h(the)g(whole)f(\014le)g(in)0 +4989 y(memory)i(\(since)h(random)e(access)j(is)d(required\),)i(then)f +(\015ushes)f(it)h(out)h(to)g(the)f(stdout)h(stream)g(when)e(the)i +(\014le)0 5102 y(is)29 b(closed.)41 b(In)29 b(addition,)g(if)g(the)h +(output)g(\014lename)f(=)h('-.gz')i(or)e('stdout.gz')h(then)f(it)g +(will)d(b)s(e)j(gzip)f(compressed)0 5215 y(b)s(efore)h(b)s(eing)f +(written)g(to)i(stdout.)0 5375 y(This)24 b(abilit)m(y)h(to)h(read)g +(and)f(write)g(on)h(the)g(stdin)f(and)g(stdout)h(steams)g(allo)m(ws)g +(FITS)f(\014les)g(to)h(b)s(e)g(pip)s(ed)d(b)s(et)m(w)m(een)0 +5488 y(tasks)42 b(in)e(memory)h(rather)g(than)h(ha)m(ving)f(to)h +(create)h(temp)s(orary)e(in)m(termediate)g(FITS)f(\014les)h(on)g(disk.) +72 b(F)-8 b(or)0 5601 y(example)27 b(if)e(task1)j(creates)h(an)e +(output)f(FITS)g(\014le,)h(and)g(task2)g(reads)g(an)g(input)e(FITS)h +(\014le,)h(the)g(FITS)f(\014le)g(ma)m(y)0 5714 y(b)s(e)k(pip)s(ed)e(b)s +(et)m(w)m(een)j(the)f(2)h(tasks)g(b)m(y)f(sp)s(ecifying)p +eop +%%Page: 23 29 +23 28 bop 0 299 a Fg(4.4.)72 b(OUTPUT)30 b(FILE)g(NAME)h(WHEN)g +(OPENING)f(AN)h(EXISTING)e(FILE)967 b Fi(23)143 555 y +Fe(task1)47 b(-)g(|)g(task2)g(-)0 793 y Fi(where)30 b(the)h(v)m +(ertical)g(bar)g(is)e(the)i(Unix)f(piping)e(sym)m(b)s(ol.)41 +b(This)29 b(assumes)h(that)i(the)f(2)g(tasks)g(read)g(the)g(name)g(of)0 +906 y(the)g(FITS)e(\014le)h(o\013)g(of)h(the)g(command)f(line.)0 +1236 y Fd(4.4)135 b(Output)45 b(File)g(Name)h(when)f(Op)t(ening)g(an)g +(Existing)h(File)0 1486 y Fi(An)36 b(optional)g(output)g(\014lename)g +(ma)m(y)i(b)s(e)e(sp)s(eci\014ed)f(in)g(paren)m(theses)i(immediately)e +(follo)m(wing)g(the)i(base)g(\014le)0 1599 y(name)28 +b(to)h(b)s(e)f(op)s(ened.)39 b(This)27 b(is)g(mainly)f(useful)h(in)g +(those)h(cases)i(where)d(CFITSIO)g(creates)j(a)e(temp)s(orary)g(cop)m +(y)0 1712 y(of)i(the)f(input)f(FITS)g(\014le)h(b)s(efore)g(it)g(is)f +(op)s(ened)h(and)f(passed)h(to)h(the)g(application)e(program.)40 +b(This)27 b(happ)s(ens)h(b)m(y)0 1825 y(default)h(when)h(op)s(ening)f +(a)h(net)m(w)m(ork)h(FTP)g(or)f(HTTP-t)m(yp)s(e)g(\014le,)g(when)f +(reading)g(a)i(compressed)f(FITS)g(\014le)f(on)0 1938 +y(a)36 b(lo)s(cal)f(disk,)h(when)f(reading)g(from)h(the)g(stdin)e +(stream,)k(or)d(when)g(a)i(column)d(\014lter,)j(ro)m(w)f(\014lter,)g +(or)g(binning)0 2051 y(sp)s(eci\014er)28 b(is)g(included)f(as)j(part)f +(of)g(the)h(input)e(\014le)g(sp)s(eci\014cation.)39 b(By)30 +b(default)f(this)f(temp)s(orary)h(\014le)f(is)h(created)0 +2164 y(in)g(memory)-8 b(.)41 b(If)29 b(there)h(is)f(not)h(enough)g +(memory)g(to)h(create)g(the)g(\014le)e(cop)m(y)-8 b(,)31 +b(then)f(CFITSIO)e(will)f(exit)j(with)f(an)0 2277 y(error.)45 +b(In)32 b(these)g(cases)h(one)g(can)f(force)h(a)f(p)s(ermanen)m(t)g +(\014le)f(to)i(b)s(e)e(created)i(on)f(disk,)f(instead)h(of)g(a)g(temp)s +(orary)0 2390 y(\014le)37 b(in)f(memory)-8 b(,)40 b(b)m(y)d(supplying)d +(the)k(name)g(in)e(paren)m(theses)i(immediately)e(follo)m(wing)g(the)h +(base)h(\014le)f(name.)0 2503 y(The)30 b(output)g(\014lename)f(can)i +(include)d(the)j(')10 b(!')41 b(clobb)s(er)29 b(\015ag.)0 +2663 y(Th)m(us,)48 b(if)c(the)h(input)e(\014lename)h(to)h(CFITSIO)f +(is:)69 b Fe(file1.fits.gz\(file2.fit)o(s\))39 b Fi(then)44 +b(CFITSIO)g(will)0 2776 y(uncompress)39 b(`\014le1.\014ts.gz')i(in)m +(to)f(the)g(lo)s(cal)f(disk)f(\014le)h(`\014le2.\014ts')h(b)s(efore)g +(op)s(ening)e(it.)69 b(CFITSIO)38 b(do)s(es)i(not)0 2889 +y(automatically)30 b(delete)h(the)f(output)g(\014le,)g(so)h(it)f(will)d +(still)i(exist)h(after)h(the)f(application)f(program)h(exits.)0 +3049 y(In)35 b(some)i(cases,)h(sev)m(eral)e(di\013eren)m(t)g(temp)s +(orary)f(FITS)h(\014les)f(will)e(b)s(e)i(created)i(in)e(sequence,)j +(for)e(instance,)h(if)0 3162 y(one)g(op)s(ens)g(a)g(remote)h(\014le)e +(using)g(FTP)-8 b(,)37 b(then)g(\014lters)f(ro)m(ws)h(in)f(a)i(binary)d +(table)i(extension,)i(then)d(create)j(an)0 3275 y(image)e(b)m(y)g +(binning)d(a)j(pair)f(of)h(columns.)59 b(In)36 b(this)g(case,)k(the)d +(remote)h(\014le)e(will)e(b)s(e)i(copied)g(to)i(a)f(temp)s(orary)0 +3388 y(lo)s(cal)h(\014le,)i(then)e(a)h(second)f(temp)s(orary)h(\014le)e +(will)f(b)s(e)i(created)i(con)m(taining)e(the)g(\014ltered)g(ro)m(ws)g +(of)h(the)g(table,)0 3500 y(and)c(\014nally)e(a)j(third)d(temp)s(orary) +i(\014le)g(con)m(taining)f(the)i(binned)d(image)i(will)e(b)s(e)i +(created.)57 b(In)34 b(cases)i(lik)m(e)f(this)0 3613 +y(where)28 b(m)m(ultiple)e(\014les)h(are)i(created,)h(the)e(out\014le)g +(sp)s(eci\014er)f(will)e(b)s(e)j(in)m(terpreted)g(the)g(name)g(of)h +(the)f(\014nal)f(\014le)h(as)0 3726 y(describ)s(ed)g(b)s(elo)m(w,)i(in) +f(descending)g(priorit)m(y:)136 3964 y Fc(\017)46 b Fi(as)29 +b(the)g(name)g(of)g(the)g(\014nal)e(image)i(\014le)f(if)f(an)i(image)g +(within)d(a)j(single)e(binary)g(table)i(cell)f(is)f(op)s(ened)h(or)h +(if)227 4077 y(an)i(image)f(is)g(created)h(b)m(y)f(binning)e(a)i(table) +h(column.)136 4257 y Fc(\017)46 b Fi(as)33 b(the)f(name)h(of)f(the)h +(\014le)e(con)m(taining)h(the)g(\014ltered)f(table)i(if)e(a)i(column)e +(\014lter)g(and/or)h(a)h(ro)m(w)f(\014lter)g(are)227 +4370 y(sp)s(eci\014ed.)136 4551 y Fc(\017)46 b Fi(as)31 +b(the)f(name)h(of)f(the)h(lo)s(cal)f(cop)m(y)h(of)f(the)h(remote)g(FTP) +f(or)h(HTTP)e(\014le.)136 4731 y Fc(\017)46 b Fi(as)31 +b(the)g(name)g(of)g(the)f(uncompressed)g(v)m(ersion)g(of)h(the)f(FITS)g +(\014le,)g(if)g(a)h(compressed)f(FITS)g(\014le)g(on)h(lo)s(cal)227 +4844 y(disk)e(has)h(b)s(een)g(op)s(ened.)136 5024 y Fc(\017)46 +b Fi(otherwise,)30 b(the)h(output)f(\014lename)f(is)h(ignored.)0 +5262 y(The)f(output)f(\014le)g(sp)s(eci\014er)g(is)g(useful)f(when)h +(reading)g(FTP)h(or)g(HTTP-t)m(yp)s(e)g(FITS)f(\014les)g(since)g(it)h +(can)g(b)s(e)g(used)0 5375 y(to)34 b(create)i(a)e(lo)s(cal)f(disk)f +(cop)m(y)j(of)f(the)g(\014le)e(that)j(can)f(b)s(e)f(reused)g(in)f(the)i +(future.)50 b(If)33 b(the)h(output)g(\014le)e(name)i(=)0 +5488 y(`*')i(then)f(a)g(lo)s(cal)f(\014le)g(with)g(the)h(same)g(name)g +(as)g(the)h(net)m(w)m(ork)f(\014le)f(will)f(b)s(e)h(created.)56 +b(Note)36 b(that)f(CFITSIO)0 5601 y(will)27 b(b)s(eha)m(v)m(e)j +(di\013eren)m(tly)f(dep)s(ending)e(on)j(whether)f(the)h(remote)g +(\014le)f(is)g(compressed)g(or)h(not)g(as)g(sho)m(wn)f(b)m(y)h(the)0 +5714 y(follo)m(wing)f(examples:)p eop +%%Page: 24 30 +24 29 bop 0 299 a Fi(24)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)136 555 y +Fc(\017)46 b Fi(`ftp://remote.mac)m(hine/tmp/m)m +(y\014le.\014ts.gz\(*\)')i(-)43 b(the)g(remote)h(compressed)f(\014le)f +(is)g(copied)h(to)h(the)227 668 y(lo)s(cal)24 b(compressed)g(\014le)f +(`m)m(y\014le.\014ts.gz',)k(whic)m(h)c(is)g(then)i(uncompressed)e(in)g +(lo)s(cal)g(memory)h(b)s(efore)g(b)s(eing)227 781 y(op)s(ened)30 +b(and)g(passed)g(to)h(the)f(application)f(program.)136 +979 y Fc(\017)46 b Fi(`ftp://remote.mac)m(hine/tmp/m)m +(y\014le.\014ts.gz\(m)m(y\014le.\014ts\)')40 b(-)d(the)g(remote)g +(compressed)f(\014le)g(is)f(copied)227 1092 y(and)i(uncompressed)g(in)m +(to)g(the)h(lo)s(cal)f(\014le)g(`m)m(y\014le.\014ts'.)63 +b(This)35 b(example)j(requires)e(less)h(lo)s(cal)g(memory)227 +1205 y(than)30 b(the)h(previous)e(example)h(since)g(the)g(\014le)g(is)f +(uncompressed)g(on)h(disk)f(instead)h(of)g(in)g(memory)-8 +b(.)136 1403 y Fc(\017)46 b Fi(`ftp://remote.mac)m(hine/tmp/m)m +(y\014le.\014ts\(m)m(y\014le.\014ts.gz\)')25 b(-)c(this)f(will)f +(usually)g(pro)s(duce)h(an)h(error)g(since)227 1516 y(CFITSIO)29 +b(itself)g(cannot)i(compress)f(\014les.)0 1759 y(The)36 +b(exact)i(b)s(eha)m(vior)d(of)i(CFITSIO)e(in)g(the)i(latter)f(case)i +(dep)s(ends)c(on)j(the)f(t)m(yp)s(e)h(of)g(ftp)f(serv)m(er)g(running)e +(on)0 1872 y(the)d(remote)g(mac)m(hine)f(and)g(ho)m(w)g(it)g(is)f +(con\014gured.)40 b(In)30 b(some)h(cases,)g(if)e(the)i(\014le)e(`m)m +(y\014le.\014ts.gz')j(exists)e(on)g(the)0 1985 y(remote)38 +b(mac)m(hine,)g(then)f(the)g(serv)m(er)g(will)e(cop)m(y)i(it)g(to)g +(the)h(lo)s(cal)e(mac)m(hine.)60 b(In)36 b(other)h(cases)h(the)f(ftp)g +(serv)m(er)0 2098 y(will)c(automatically)j(create)h(and)f(transmit)f(a) +h(compressed)g(v)m(ersion)f(of)h(the)g(\014le)f(if)g(only)g(the)h +(uncompressed)0 2211 y(v)m(ersion)26 b(exists.)40 b(This)25 +b(can)i(get)h(rather)f(confusing,)g(so)g(users)f(should)f(use)i(a)g +(certain)g(amoun)m(t)h(of)f(caution)g(when)0 2324 y(using)33 +b(the)i(output)f(\014le)g(sp)s(eci\014er)f(with)h(FTP)g(or)h(HTTP)f +(\014le)g(t)m(yp)s(es,)i(to)f(mak)m(e)h(sure)e(they)h(get)h(the)f(b)s +(eha)m(vior)0 2437 y(that)c(they)g(exp)s(ect.)0 2783 +y Fd(4.5)135 b(T)-11 b(emplate)46 b(File)g(Name)f(when)g(Creating)h(a)g +(New)f(File)0 3035 y Fi(When)38 b(a)h(new)f(FITS)g(\014le)g(is)g +(created)h(with)f(a)g(call)g(to)i(\014ts)p 2101 3035 +28 4 v 32 w(create)p 2369 3035 V 35 w(\014le,)f(the)g(name)g(of)g(a)g +(template)g(\014le)e(ma)m(y)0 3148 y(b)s(e)i(supplied)e(in)i(paren)m +(theses)h(immediately)e(follo)m(wing)g(the)j(name)f(of)g(the)g(new)f +(\014le)g(to)i(b)s(e)e(created.)71 b(This)0 3261 y(template)26 +b(is)e(used)h(to)h(de\014ne)f(the)h(structure)f(of)h(one)f(or)h(more)g +(HDUs)g(in)e(the)i(new)f(\014le.)38 b(The)25 b(template)h(\014le)e(ma)m +(y)0 3374 y(b)s(e)32 b(another)h(FITS)f(\014le,)h(in)f(whic)m(h)f(case) +j(the)f(newly)f(created)i(\014le)e(will)e(ha)m(v)m(e)k(exactly)g(the)f +(same)g(k)m(eyw)m(ords)g(in)0 3487 y(eac)m(h)25 b(HDU)g(as)g(in)e(the)h +(template)h(FITS)e(\014le,)i(but)e(all)h(the)g(data)h(units)d(will)g(b) +s(e)i(\014lled)e(with)g(zeros.)40 b(The)24 b(template)0 +3600 y(\014le)h(ma)m(y)i(also)f(b)s(e)f(an)h(ASCI)s(I)e(text)j(\014le,) +f(where)g(eac)m(h)h(line)d(\(in)h(general\))i(describ)s(es)d(one)i +(FITS)f(k)m(eyw)m(ord)i(record.)0 3713 y(The)j(format)h(of)f(the)h +(ASCI)s(I)e(template)h(\014le)g(is)f(describ)s(ed)f(b)s(elo)m(w.)0 +4059 y Fd(4.6)135 b(HDU)46 b(Lo)t(cation)f(Sp)t(eci\014cation)0 +4312 y Fi(The)c(optional)f(HDU)j(lo)s(cation)e(sp)s(eci\014er)e +(de\014nes)i(whic)m(h)f(HDU)i(\(Header-Data)i(Unit,)g(also)d(kno)m(wn)g +(as)h(an)0 4425 y(`extension'\))35 b(within)c(the)k(FITS)e(\014le)g(to) +i(initially)c(op)s(en.)51 b(It)34 b(m)m(ust)g(immediately)f(follo)m(w)g +(the)h(base)h(\014le)e(name)0 4538 y(\(or)h(the)g(output)g(\014le)f +(name)g(if)g(presen)m(t\).)52 b(If)33 b(it)g(is)g(not)h(sp)s(eci\014ed) +f(then)g(the)h(\014rst)f(HDU)i(\(the)f(primary)e(arra)m(y\))0 +4650 y(is)g(op)s(ened.)46 b(The)32 b(HDU)h(lo)s(cation)f(sp)s +(eci\014er)f(is)h(required)f(if)g(the)i(colFilter,)f(ro)m(wFilter,)h +(or)g(binSp)s(ec)d(sp)s(eci\014ers)0 4763 y(are)g(presen)m(t,)f(b)s +(ecause)h(the)f(primary)e(arra)m(y)j(is)e(not)i(a)f(v)-5 +b(alid)28 b(HDU)i(for)f(these)g(op)s(erations.)40 b(The)29 +b(HDU)h(ma)m(y)g(b)s(e)0 4876 y(sp)s(eci\014ed)d(either)i(b)m(y)f +(absolute)h(p)s(osition)e(n)m(um)m(b)s(er,)h(starting)h(with)e(0)j(for) +e(the)h(primary)e(arra)m(y)-8 b(,)31 b(or)e(b)m(y)f(reference)0 +4989 y(to)h(the)g(HDU)g(name,)g(and)f(optionally)-8 b(,)28 +b(the)h(v)m(ersion)f(n)m(um)m(b)s(er)f(and)h(the)h(HDU)g(t)m(yp)s(e)g +(of)f(the)h(desired)e(extension.)0 5102 y(The)32 b(lo)s(cation)f(of)h +(an)g(image)h(within)c(a)k(single)d(cell)i(of)g(a)g(binary)f(table)h +(ma)m(y)g(also)g(b)s(e)g(sp)s(eci\014ed,)f(as)h(describ)s(ed)0 +5215 y(b)s(elo)m(w.)0 5375 y(The)26 b(absolute)g(p)s(osition)e(of)i +(the)h(extension)f(is)f(sp)s(eci\014ed)f(either)i(b)m(y)g(enclosed)g +(the)h(n)m(um)m(b)s(er)e(in)g(square)g(brac)m(k)m(ets)0 +5488 y(\(e.g.,)k(`[1]')g(=)d(the)h(\014rst)f(extension)g(follo)m(wing)g +(the)h(primary)d(arra)m(y\))k(or)f(b)m(y)f(preceded)h(the)g(n)m(um)m(b) +s(er)e(with)h(a)h(plus)0 5601 y(sign)36 b(\(`+1'\).)63 +b(T)-8 b(o)38 b(sp)s(ecify)e(the)h(HDU)h(b)m(y)g(name,)h(giv)m(e)f(the) +f(name)h(of)f(the)h(desired)e(HDU)i(\(the)f(v)-5 b(alue)37 +b(of)h(the)0 5714 y(EXTNAME)e(or)g(HDUNAME)h(k)m(eyw)m(ord\))g(and)f +(optionally)e(the)i(extension)g(v)m(ersion)f(n)m(um)m(b)s(er)g(\(v)-5 +b(alue)36 b(of)g(the)p eop +%%Page: 25 31 +25 30 bop 0 299 a Fg(4.7.)72 b(IMA)m(GE)31 b(SECTION)2835 +b Fi(25)0 555 y(EXTVER)27 b(k)m(eyw)m(ord\))i(and)e(the)h(extension)g +(t)m(yp)s(e)f(\(v)-5 b(alue)28 b(of)g(the)g(XTENSION)f(k)m(eyw)m(ord:) +40 b(IMA)m(GE,)29 b(ASCI)s(I)d(or)0 668 y(T)-8 b(ABLE,)36 +b(or)f(BINT)-8 b(ABLE\),)36 b(separated)f(b)m(y)g(commas)h(and)e(all)g +(enclosed)h(in)f(square)h(brac)m(k)m(ets.)56 b(If)34 +b(the)h(v)-5 b(alue)0 781 y(of)34 b(EXTVER)f(and)f(XTENSION)h(are)h +(not)f(sp)s(eci\014ed,)g(then)g(the)h(\014rst)e(extension)i(with)e(the) +h(correct)i(v)-5 b(alue)33 b(of)0 894 y(EXTNAME)39 b(is)f(op)s(ened.)67 +b(The)38 b(extension)h(name)g(and)f(t)m(yp)s(e)i(are)f(not)h(case)g +(sensitiv)m(e,)h(and)d(the)h(extension)0 1007 y(t)m(yp)s(e)29 +b(ma)m(y)g(b)s(e)f(abbreviated)g(to)h(a)g(single)e(letter)i(\(e.g.,)i +(I)d(=)g(IMA)m(GE)i(extension)e(or)g(primary)f(arra)m(y)-8 +b(,)30 b(A)f(or)f(T)g(=)0 1120 y(ASCI)s(I)d(table)h(extension,)h(and)f +(B)h(=)f(binary)f(table)h(BINT)-8 b(ABLE)27 b(extension\).)40 +b(If)26 b(the)g(HDU)h(lo)s(cation)g(sp)s(eci\014er)0 +1233 y(is)i(equal)h(to)h(`[PRIMAR)-8 b(Y]')32 b(or)f(`[P]',)g(then)f +(the)h(primary)d(arra)m(y)j(\(the)g(\014rst)f(HDU\))h(will)d(b)s(e)i +(op)s(ened.)0 1393 y(FITS)k(images)h(are)g(most)h(commonly)e(stored)h +(in)f(the)h(primary)e(arra)m(y)i(or)g(an)g(image)g(extension,)h(but)e +(images)0 1506 y(can)d(also)g(b)s(e)f(stored)h(as)h(a)f(v)m(ector)h(in) +e(a)h(single)f(cell)g(of)h(a)h(binary)d(table)i(\(i.e.)42 +b(eac)m(h)32 b(ro)m(w)f(of)g(the)h(v)m(ector)g(column)0 +1619 y(con)m(tains)c(a)h(di\013eren)m(t)e(image\).)41 +b(Suc)m(h)27 b(an)h(image)h(can)f(b)s(e)g(op)s(ened)f(with)g(CFITSIO)f +(b)m(y)i(sp)s(ecifying)e(the)i(desired)0 1732 y(column)j(name)h(and)f +(the)h(ro)m(w)g(n)m(um)m(b)s(er)f(after)h(the)g(binary)e(table)i(HDU)h +(sp)s(eci\014er)d(as)i(sho)m(wn)g(in)e(the)i(follo)m(wing)0 +1844 y(examples.)70 b(The)40 b(column)f(name)i(is)e(separated)i(from)f +(the)h(HDU)g(sp)s(eci\014er)e(b)m(y)h(a)h(semicolon)e(and)h(the)h(ro)m +(w)0 1957 y(n)m(um)m(b)s(er)29 b(is)g(enclosed)h(in)e(paren)m(theses.) +41 b(In)30 b(this)f(case)i(CFITSIO)d(copies)i(the)g(image)h(from)e(the) +i(table)f(cell)f(in)m(to)0 2070 y(a)j(temp)s(orary)e(primary)g(arra)m +(y)h(b)s(efore)g(it)g(is)f(op)s(ened.)43 b(The)30 b(application)g +(program)h(then)g(just)g(sees)g(the)h(image)0 2183 y(in)h(the)i +(primary)d(arra)m(y)-8 b(,)37 b(without)c(an)m(y)i(extensions.)52 +b(The)34 b(particular)e(ro)m(w)j(to)g(b)s(e)e(op)s(ened)h(ma)m(y)h(b)s +(e)f(sp)s(eci\014ed)0 2296 y(either)27 b(b)m(y)g(giving)f(an)h +(absolute)g(in)m(teger)h(ro)m(w)g(n)m(um)m(b)s(er)e(\(starting)h(with)f +(1)i(for)f(the)g(\014rst)g(ro)m(w\),)i(or)e(b)m(y)g(sp)s(ecifying)0 +2409 y(a)33 b(b)s(o)s(olean)e(expression)g(that)i(ev)-5 +b(aluates)33 b(to)g(TR)m(UE)g(for)f(the)g(desired)f(ro)m(w.)47 +b(The)32 b(\014rst)f(ro)m(w)i(that)g(satis\014es)f(the)0 +2522 y(expression)27 b(will)e(b)s(e)j(used.)39 b(The)28 +b(ro)m(w)g(selection)g(expression)f(has)h(the)g(same)g(syn)m(tax)h(as)f +(describ)s(ed)e(in)h(the)h(Ro)m(w)0 2635 y(Filter)i(Sp)s(eci\014er)e +(section,)j(b)s(elo)m(w.)0 2795 y(Examples:)143 3051 +y Fe(myfile.fits[3])44 b(-)k(open)e(the)h(3rd)g(HDU)g(following)e(the)i +(primary)f(array)143 3164 y(myfile.fits+3)92 b(-)48 b(same)e(as)h +(above,)f(but)h(using)g(the)g(FTOOLS-style)d(notation)143 +3277 y(myfile.fits[EVENTS])f(-)k(open)g(the)g(extension)e(that)i(has)g +(EXTNAME)e(=)j('EVENTS')143 3390 y(myfile.fits[EVENTS,)43 +b(2])95 b(-)47 b(same)g(as)g(above,)f(but)h(also)g(requires)e(EXTVER)h +(=)i(2)143 3503 y(myfile.fits[events,2,b])42 b(-)47 b(same,)f(but)h +(also)g(requires)f(XTENSION)f(=)j('BINTABLE')143 3616 +y(myfile.fits[3;)c(images\(17\)])h(-)i(opens)g(the)g(image)f(in)h(row)g +(17)g(of)g(the)g('images')1527 3728 y(column)f(in)i(the)e(3rd)h +(extension)f(of)h(the)g(file.)143 3841 y(myfile.fits[3;)d +(images\(exposure)g(>)j(100\)])g(-)g(as)g(above,)f(but)h(opens)g(the)f +(image)907 3954 y(in)h(the)g(first)f(row)h(that)g(has)g(an)g +('exposure')e(column)h(value)907 4067 y(greater)g(than)g(100.)0 +4400 y Fd(4.7)135 b(Image)46 b(Section)0 4650 y Fi(A)41 +b(virtual)e(\014le)g(con)m(taining)h(a)h(rectangular)g(subsection)e(of) +i(an)g(image)f(can)h(b)s(e)f(extracted)i(and)e(op)s(ened)g(b)m(y)0 +4763 y(sp)s(ecifying)30 b(the)j(range)g(of)g(pixels)e(\(start:end\))i +(along)g(eac)m(h)h(axis)e(to)h(b)s(e)f(extracted)i(from)e(the)h +(original)d(image.)0 4876 y(One)g(can)h(also)g(sp)s(ecify)e(an)i +(optional)f(pixel)f(incremen)m(t)h(\(start:end:step\))i(for)f(eac)m(h)h +(axis)e(of)h(the)g(input)d(image.)0 4989 y(A)g(pixel)d(step)j(=)f(1)h +(will)d(b)s(e)i(assumed)f(if)h(it)g(is)f(not)i(sp)s(eci\014ed.)38 +b(If)27 b(the)h(start)g(pixel)e(is)g(larger)i(then)f(the)h(end)e +(pixel,)0 5102 y(then)32 b(the)g(image)g(will)d(b)s(e)i(\015ipp)s(ed)e +(\(pro)s(ducing)h(a)i(mirror)f(image\))h(along)g(that)g(dimension.)43 +b(An)32 b(asterisk,)g('*',)0 5215 y(ma)m(y)39 b(b)s(e)e(used)h(to)h(sp) +s(ecify)e(the)h(en)m(tire)g(range)h(of)f(an)h(axis,)h(and)d('-*')j +(will)35 b(\015ip)i(the)h(en)m(tire)g(axis.)64 b(The)38 +b(input)0 5328 y(image)30 b(can)g(b)s(e)f(in)f(the)i(primary)e(arra)m +(y)-8 b(,)31 b(in)d(an)h(image)h(extension,)g(or)g(con)m(tained)f(in)g +(a)h(v)m(ector)h(cell)e(of)h(a)g(binary)0 5441 y(table.)39 +b(In)25 b(the)h(later)g(2)g(cases)h(the)f(extension)g(name)g(or)f(n)m +(um)m(b)s(er)g(m)m(ust)h(b)s(e)f(sp)s(eci\014ed)f(b)s(efore)i(the)g +(image)g(section)0 5554 y(sp)s(eci\014er.)0 5714 y(Examples:)p +eop +%%Page: 26 32 +26 31 bop 0 299 a Fi(26)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)95 555 y Fe +(myfile.fits[1:512:2,)43 b(2:512:2])i(-)95 b(open)47 +b(a)h(256x256)d(pixel)i(image)668 668 y(consisting)e(of)i(the)g(odd)g +(numbered)f(columns)g(\(1st)g(axis\))h(and)668 781 y(the)g(even)g +(numbered)e(rows)i(\(2nd)g(axis\))f(of)h(the)g(image)f(in)i(the)668 +894 y(primary)e(array)g(of)i(the)e(file.)95 1120 y(myfile.fits[*,)e +(512:256])i(-)h(open)g(an)g(image)g(consisting)e(of)i(all)g(the)g +(columns)668 1233 y(in)g(the)g(input)g(image,)f(but)h(only)f(rows)h +(256)g(through)f(512.)668 1346 y(The)h(image)f(will)h(be)g(flipped)f +(along)g(the)h(2nd)g(axis)g(since)668 1458 y(the)g(starting)f(pixel)g +(is)h(greater)f(than)h(the)g(ending)f(pixel.)95 1684 +y(myfile.fits[*:2,)e(512:256:2])h(-)i(same)g(as)g(above)f(but)h +(keeping)f(only)668 1797 y(every)h(other)f(row)h(and)g(column)f(in)h +(the)g(input)f(image.)95 2023 y(myfile.fits[-*,)e(*])j(-)h(copy)e(the)h +(entire)f(image,)g(flipping)g(it)h(along)668 2136 y(the)g(first)f +(axis.)95 2362 y(myfile.fits[3][1:256,1:256)o(])c(-)47 +b(opens)g(a)g(subsection)e(of)i(the)g(image)g(that)668 +2475 y(is)g(in)h(the)e(3rd)h(extension)f(of)h(the)g(file.)95 +2700 y(myfile.fits[4;)d(images\(12\)][1:10,1:10])e(-)48 +b(open)e(an)h(image)g(consisting)286 2813 y(of)h(the)e(first)h(10)g +(pixels)f(in)h(both)g(dimensions.)e(The)i(original)286 +2926 y(image)g(resides)f(in)h(the)g(12th)f(row)h(of)g(the)g('images')f +(vector)286 3039 y(column)g(in)i(the)f(table)f(in)h(the)g(4th)g +(extension)e(of)i(the)g(file.)0 3336 y Fi(When)23 b(CFITSIO)f(op)s(ens) +h(an)g(image)g(section)h(it)f(\014rst)g(creates)h(a)g(temp)s(orary)f +(\014le)g(con)m(taining)g(the)g(image)h(section)0 3449 +y(plus)31 b(a)j(cop)m(y)g(of)g(an)m(y)g(other)f(HDUs)h(in)e(the)i +(\014le.)49 b(This)31 b(temp)s(orary)i(\014le)g(is)f(then)h(op)s(ened)g +(b)m(y)g(the)h(application)0 3562 y(program,)28 b(so)g(it)f(is)f(not)i +(p)s(ossible)d(to)j(write)f(to)h(or)g(mo)s(dify)e(the)h(input)f(\014le) +g(when)h(sp)s(ecifying)e(an)j(image)g(section.)0 3675 +y(Note)39 b(that)f(CFITSIO)e(automatically)h(up)s(dates)g(the)g(w)m +(orld)g(co)s(ordinate)g(system)h(k)m(eyw)m(ords)f(in)f(the)i(header)0 +3788 y(of)33 b(the)h(image)f(section,)h(if)e(they)i(exist,)g(so)f(that) +h(the)f(co)s(ordinate)g(asso)s(ciated)h(with)e(eac)m(h)i(pixel)d(in)h +(the)i(image)0 3901 y(section)d(will)c(b)s(e)j(computed)g(correctly)-8 +b(.)0 4279 y Fd(4.8)135 b(Column)45 b(and)g(Keyw)l(ord)h(Filtering)g +(Sp)t(eci\014cation)0 4538 y Fi(The)27 b(optional)g(column/k)m(eyw)m +(ord)h(\014ltering)e(sp)s(eci\014er)g(is)h(used)g(to)i(mo)s(dify)d(the) +i(column)f(structure)g(and/or)h(the)0 4650 y(header)38 +b(k)m(eyw)m(ords)h(in)e(the)i(HDU)g(that)h(w)m(as)f(selected)g(with)e +(the)i(previous)e(HDU)i(lo)s(cation)f(sp)s(eci\014er.)64 +b(This)0 4763 y(\014ltering)40 b(sp)s(eci\014er)g(m)m(ust)i(b)s(e)f +(enclosed)h(in)e(square)i(brac)m(k)m(ets)h(and)e(can)h(b)s(e)f +(distinguished)d(from)k(a)g(general)0 4876 y(ro)m(w)d(\014lter)f(sp)s +(eci\014er)f(\(describ)s(ed)g(b)s(elo)m(w\))h(b)m(y)h(the)g(fact)h +(that)f(it)f(b)s(egins)f(with)h(the)h(string)f('col)h(')g(and)f(is)g +(not)0 4989 y(immediately)27 b(follo)m(w)m(ed)h(b)m(y)g(an)g(equals)g +(sign.)39 b(The)28 b(original)e(\014le)h(is)h(not)g(c)m(hanged)h(b)m(y) +f(this)g(\014ltering)e(op)s(eration,)0 5102 y(and)40 +b(instead)g(the)h(mo)s(di\014cations)e(are)i(made)f(on)h(a)g(cop)m(y)g +(of)g(the)g(input)e(FITS)h(\014le)f(\(usually)g(in)g(memory\),)0 +5215 y(whic)m(h)32 b(also)h(con)m(tains)g(a)g(cop)m(y)h(of)f(all)f(the) +i(other)f(HDUs)h(in)d(the)i(\014le.)48 b(This)32 b(temp)s(orary)g +(\014le)g(is)g(passed)h(to)h(the)0 5328 y(application)c(program)i(and)f +(will)e(p)s(ersist)h(only)h(un)m(til)f(the)i(\014le)f(is)g(closed)h(or) +g(un)m(til)e(the)i(program)f(exits,)i(unless)0 5441 y(the)e(out\014le)e +(sp)s(eci\014er)g(\(see)i(ab)s(o)m(v)m(e\))h(is)e(also)g(supplied.)0 +5601 y(The)h(column/k)m(eyw)m(ord)g(\014lter)f(can)h(b)s(e)g(used)f(to) +i(p)s(erform)e(the)i(follo)m(wing)d(op)s(erations.)43 +b(More)32 b(than)f(one)g(op)s(er-)0 5714 y(ation)f(ma)m(y)h(b)s(e)f(sp) +s(eci\014ed)f(b)m(y)h(separating)g(them)g(with)g(semi-colons.)p +eop +%%Page: 27 33 +27 32 bop 0 299 a Fg(4.8.)72 b(COLUMN)30 b(AND)h(KEYW)m(ORD)g(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)1120 b Fi(27)136 555 +y Fc(\017)46 b Fi(Cop)m(y)36 b(only)f(a)h(sp)s(eci\014ed)f(list)f(of)i +(columns)f(columns)f(to)j(the)f(\014ltered)f(input)f(\014le.)56 +b(The)36 b(list)e(of)i(column)227 668 y(name)c(should)e(b)s(e)i +(separated)g(b)m(y)g(semi-colons.)46 b(Wild)30 b(card)i(c)m(haracters)i +(ma)m(y)e(b)s(e)g(used)f(in)g(the)h(column)227 781 y(names)37 +b(to)h(matc)m(h)g(m)m(ultiple)d(columns.)60 b(If)37 b(the)g(expression) +f(con)m(tains)i(b)s(oth)e(a)i(list)d(of)j(columns)e(to)i(b)s(e)227 +894 y(included)f(and)h(columns)g(to)h(b)s(e)g(deleted,)i(then)d(all)g +(the)h(columns)f(in)g(the)h(original)e(table)i(except)h(the)227 +1007 y(explicitly)28 b(deleted)i(columns)f(will)e(app)s(ear)j(in)f(the) +h(\014ltered)f(table)h(\(i.e.,)h(there)f(is)g(no)g(need)f(to)i +(explicitly)227 1120 y(list)e(the)i(columns)e(to)i(b)s(e)f(included)d +(if)j(an)m(y)g(columns)f(are)i(b)s(eing)e(deleted\).)136 +1295 y Fc(\017)46 b Fi(Delete)31 b(a)e(column)f(or)h(k)m(eyw)m(ord)h(b) +m(y)f(listing)e(the)i(name)g(preceded)g(b)m(y)g(a)g(min)m(us)f(sign)g +(or)h(an)g(exclamation)227 1408 y(mark)c(\(!\),)h(e.g.,)i('-TIME')d +(will)d(delete)j(the)f(TIME)h(column)e(if)g(it)i(exists,)g(otherwise)f +(the)h(TIME)f(k)m(eyw)m(ord.)227 1520 y(An)35 b(error)f(is)g(returned)f +(if)h(neither)f(a)j(column)d(nor)h(k)m(eyw)m(ord)h(with)f(this)f(name)i +(exists.)53 b(Note)36 b(that)g(the)227 1633 y(exclamation)25 +b(p)s(oin)m(t,)h(')10 b(!',)27 b(is)d(a)h(sp)s(ecial)f(UNIX)h(c)m +(haracter,)j(so)d(if)f(it)h(is)f(used)g(on)h(the)g(command)g(line)e +(rather)227 1746 y(than)33 b(en)m(tered)h(at)g(a)g(task)g(prompt,)f(it) +g(m)m(ust)g(b)s(e)g(preceded)g(b)m(y)g(a)h(bac)m(kslash)f(to)h(force)g +(the)f(UNIX)h(shell)227 1859 y(to)d(ignore)f(it.)136 +2034 y Fc(\017)46 b Fi(Rename)29 b(an)g(existing)e(column)g(or)i(k)m +(eyw)m(ord)g(with)e(the)i(syn)m(tax)g('NewName)h(==)e(OldName'.)39 +b(An)28 b(error)227 2147 y(is)i(returned)f(if)g(neither)h(a)g(column)f +(nor)h(k)m(eyw)m(ord)h(with)e(this)h(name)g(exists.)136 +2322 y Fc(\017)46 b Fi(App)s(end)37 b(a)j(new)f(column)e(or)j(k)m(eyw)m +(ord)f(to)h(the)f(table.)67 b(T)-8 b(o)40 b(create)g(a)g(column,)g(giv) +m(e)g(the)f(new)g(name,)227 2435 y(optionally)34 b(follo)m(w)m(ed)h(b)m +(y)g(the)g(datat)m(yp)s(e)h(in)e(paren)m(theses,)j(follo)m(w)m(ed)e(b)m +(y)g(a)h(single)e(equals)g(sign)g(and)h(an)227 2548 y(expression)f(to)i +(b)s(e)e(used)g(to)i(compute)f(the)g(v)-5 b(alue)34 b(\(e.g.,)k('new)m +(col\(1J\))e(=)f(0')g(will)e(create)j(a)f(new)g(32-bit)227 +2661 y(in)m(teger)j(column)e(called)h('new)m(col')g(\014lled)f(with)g +(zeros\).)62 b(The)37 b(datat)m(yp)s(e)h(is)f(sp)s(eci\014ed)e(using)h +(the)i(same)227 2774 y(syn)m(tax)28 b(that)h(is)d(allo)m(w)m(ed)i(for)f +(the)h(v)-5 b(alue)27 b(of)h(the)g(FITS)f(TF)m(ORMn)g(k)m(eyw)m(ord)h +(\(e.g.,)i('I',)f('J',)f('E',)g('D',)h(etc.)227 2886 +y(for)37 b(binary)e(tables,)k(and)d('I8',)k(F12.3',)h('E20.12',)g(etc.) +62 b(for)37 b(ASCI)s(I)e(tables\).)61 b(If)37 b(the)g(datat)m(yp)s(e)h +(is)e(not)227 2999 y(sp)s(eci\014ed)23 b(then)g(an)h(appropriate)g +(datat)m(yp)s(e)h(will)c(b)s(e)j(c)m(hosen)g(dep)s(ending)e(on)i(the)g +(form)g(of)g(the)g(expression)227 3112 y(\(ma)m(y)f(b)s(e)d(a)i(c)m +(haracter)h(string,)g(logical,)f(bit,)h(long)e(in)m(teger,)j(or)d +(double)f(column\).)37 b(An)21 b(appropriate)f(v)m(ector)227 +3225 y(coun)m(t)31 b(\(in)f(the)g(case)i(of)e(binary)f(tables\))h(will) +e(also)i(b)s(e)g(added)g(if)f(not)i(explicitly)d(sp)s(eci\014ed.)227 +3369 y(When)e(creating)g(a)g(new)f(k)m(eyw)m(ord,)j(the)e(k)m(eyw)m +(ord)g(name)g(m)m(ust)g(b)s(e)f(preceded)g(b)m(y)h(a)g(p)s(ound)e(sign) +g('#',)k(and)227 3482 y(the)h(expression)e(m)m(ust)h(ev)-5 +b(aluate)29 b(to)g(a)g(scalar)f(\(i.e.,)h(cannot)g(ha)m(v)m(e)h(a)f +(column)e(name)h(in)f(the)i(expression\).)227 3595 y(The)j(commen)m(t)i +(string)e(for)g(the)h(k)m(eyw)m(ord)h(ma)m(y)f(b)s(e)f(sp)s(eci\014ed)f +(in)g(paren)m(theses)i(immediately)e(follo)m(wing)227 +3708 y(the)e(k)m(eyw)m(ord)f(name)g(\(instead)g(of)g(supplying)d(a)j +(datat)m(yp)s(e)h(as)g(in)d(the)j(case)g(of)f(creating)g(a)h(new)f +(column\).)136 3883 y Fc(\017)46 b Fi(Recompute)f(\(o)m(v)m(erwrite\))h +(the)e(v)-5 b(alues)43 b(in)g(an)h(existing)g(column)f(or)h(k)m(eyw)m +(ord)g(b)m(y)g(giving)g(the)g(name)227 3996 y(follo)m(w)m(ed)30 +b(b)m(y)h(an)f(equals)g(sign)f(and)h(an)g(arithmetic)g(expression.)0 +4217 y(The)23 b(expression)f(that)j(is)d(used)h(when)g(app)s(ending)e +(or)i(recomputing)g(columns)f(or)i(k)m(eyw)m(ords)g(can)g(b)s(e)f +(arbitrarily)0 4330 y(complex)35 b(and)h(ma)m(y)g(b)s(e)f(a)h(function) +f(of)h(other)g(header)g(k)m(eyw)m(ord)g(v)-5 b(alues)35 +b(and)g(other)h(columns)f(\(in)g(the)h(same)0 4443 y(ro)m(w\).)63 +b(The)37 b(full)e(syn)m(tax)k(and)e(a)m(v)-5 b(ailable)37 +b(functions)f(for)h(the)h(expression)e(are)i(describ)s(ed)e(b)s(elo)m +(w)h(in)f(the)i(ro)m(w)0 4556 y(\014lter)29 b(sp)s(eci\014cation)h +(section.)0 4716 y(If)d(the)h(expression)f(con)m(tains)g(b)s(oth)g(a)h +(list)f(of)h(columns)e(to)i(b)s(e)g(included)c(and)k(columns)e(to)i(b)s +(e)f(deleted,)i(then)e(all)0 4829 y(the)34 b(columns)f(in)g(the)h +(original)e(table)i(except)h(the)f(explicitly)e(deleted)i(columns)e +(will)g(app)s(ear)h(in)g(the)h(\014ltered)0 4942 y(table.)0 +5102 y(F)-8 b(or)30 b(complex)g(or)f(commonly)g(used)g(op)s(erations,)h +(one)f(can)h(also)g(place)g(the)f(op)s(erations)g(in)m(to)h(an)f +(external)h(text)0 5215 y(\014le)g(and)g(imp)s(ort)f(it)h(in)m(to)h +(the)g(column)f(\014lter)f(using)h(the)h(syn)m(tax)g('[col)g +(@\014lename.txt]'.)42 b(The)31 b(op)s(erations)f(can)0 +5328 y(extend)c(o)m(v)m(er)i(m)m(ultiple)c(lines)h(of)h(the)h(\014le,)g +(but)e(m)m(ultiple)f(op)s(erations)i(m)m(ust)g(still)f(b)s(e)g +(separated)i(b)m(y)g(semicolons.)0 5441 y(An)m(y)h(lines)f(in)g(the)h +(external)h(text)g(\014le)e(that)i(b)s(egin)e(with)g(2)i(slash)e(c)m +(haracters)j(\('//'\))g(will)c(b)s(e)h(ignored)h(and)f(ma)m(y)0 +5554 y(b)s(e)j(used)f(to)i(add)f(commen)m(ts)h(in)m(to)g(the)f(\014le.) +0 5714 y(Examples:)p eop +%%Page: 28 34 +28 33 bop 0 299 a Fi(28)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)143 555 y +Fe([col)47 b(Time;rate])713 b(-)47 b(only)g(the)g(Time)g(and)g(rate)f +(columns)g(will)1670 668 y(appear)h(in)g(the)g(filtered)e(input)i +(file.)143 894 y([col)g(Time;*raw])713 b(-)47 b(include)f(the)h(Time)g +(column)f(and)h(any)g(other)1670 1007 y(columns)f(whose)h(name)f(ends)h +(with)g('raw'.)143 1233 y([col)g(-TIME;)f(Good)h(==)g(STATUS])141 +b(-)47 b(deletes)f(the)h(TIME)g(column)f(and)1670 1346 +y(renames)g(the)h(status)f(column)g(to)i('Good')143 1571 +y([col)f(PI=PHA)f(*)h(1.1)g(+)h(0.2])285 b(-)47 b(creates)f(new)h(PI)g +(column)f(from)h(PHA)g(values)143 1797 y([col)g(rate)f(=)i +(rate/exposure])139 b(-)48 b(recomputes)d(the)i(rate)f(column)g(by)i +(dividing)1670 1910 y(it)g(by)f(the)g(EXPOSURE)e(keyword)h(value.)0 +2252 y Fd(4.9)135 b(Ro)l(w)46 b(Filtering)g(Sp)t(eci\014cation)0 +2503 y Fi(When)29 b(en)m(tering)g(the)g(name)g(of)g(a)g(FITS)f(table)h +(that)h(is)d(to)j(b)s(e)e(op)s(ened)h(b)m(y)f(a)i(program,)f(an)g +(optional)f(ro)m(w)h(\014lter)0 2616 y(ma)m(y)i(b)s(e)g(sp)s(eci\014ed) +e(to)i(select)g(a)h(subset)e(of)h(the)g(ro)m(ws)f(in)g(the)h(table.)42 +b(A)31 b(temp)s(orary)f(new)g(FITS)g(\014le)g(is)g(created)0 +2729 y(on)25 b(the)h(\015y)e(whic)m(h)g(con)m(tains)h(only)g(those)h +(ro)m(ws)f(for)g(whic)m(h)f(the)h(ro)m(w)g(\014lter)g(expression)f(ev) +-5 b(aluates)25 b(to)h(true.)39 b(\(The)0 2842 y(primary)25 +b(arra)m(y)i(and)f(an)m(y)g(other)h(extensions)f(in)f(the)i(input)e +(\014le)g(are)i(also)g(copied)f(to)h(the)f(temp)s(orary)h(\014le\).)38 +b(The)0 2955 y(original)27 b(FITS)i(\014le)f(is)g(closed)h(and)f(the)i +(new)e(virtual)g(\014le)g(is)g(op)s(ened)g(b)m(y)h(the)h(application)d +(program.)40 b(The)29 b(ro)m(w)0 3068 y(\014lter)36 b(expression)g(is)h +(enclosed)g(in)f(square)h(brac)m(k)m(ets)i(follo)m(wing)d(the)h(\014le) +g(name)g(and)g(extension)g(name)g(\(e.g.,)0 3181 y('\014le.\014ts[ev)m +(en)m(ts][GRADE==50]')28 b(selects)d(only)f(those)i(ro)m(ws)f(where)f +(the)h(GRADE)h(column)e(v)-5 b(alue)24 b(equals)g(50\).)0 +3294 y(When)33 b(dealing)f(with)g(tables)g(where)h(eac)m(h)h(ro)m(w)f +(has)g(an)g(asso)s(ciated)h(time)f(and/or)g(2D)g(spatial)g(p)s +(osition,)f(the)0 3407 y(ro)m(w)g(\014lter)g(expression)e(can)j(also)f +(b)s(e)g(used)f(to)i(select)g(ro)m(ws)f(based)g(on)g(the)g(times)g(in)f +(a)h(Go)s(o)s(d)g(Time)f(In)m(terv)-5 b(als)0 3520 y(\(GTI\))31 +b(extension,)f(or)g(on)h(spatial)e(p)s(osition)g(as)h(giv)m(en)h(in)e +(a)h(SA)m(O-st)m(yle)h(region)f(\014le.)0 3818 y Fb(4.9.1)112 +b(General)38 b(Syn)m(tax)0 4039 y Fi(The)32 b(ro)m(w)h(\014ltering)e +(expression)h(can)h(b)s(e)f(an)h(arbitrarily)d(complex)i(series)g(of)h +(op)s(erations)f(p)s(erformed)g(on)g(con-)0 4152 y(stan)m(ts,)39 +b(k)m(eyw)m(ord)e(v)-5 b(alues,)37 b(and)f(column)f(data)j(tak)m(en)f +(from)f(the)h(sp)s(eci\014ed)d(FITS)i(T)-8 b(ABLE)37 +b(extension.)58 b(The)0 4264 y(expression)36 b(m)m(ust)i(ev)-5 +b(aluate)38 b(to)h(a)f(b)s(o)s(olean)f(v)-5 b(alue)37 +b(for)g(eac)m(h)i(ro)m(w)f(of)g(the)f(table,)j(where)d(a)h(v)-5 +b(alue)38 b(of)f(F)-10 b(ALSE)0 4377 y(means)30 b(that)h(the)g(ro)m(w)f +(will)e(b)s(e)i(excluded.)0 4538 y(F)-8 b(or)34 b(complex)f(or)h +(commonly)e(used)h(\014lters,)g(one)h(can)g(place)f(the)h(expression)e +(in)m(to)h(a)h(text)g(\014le)f(and)g(imp)s(ort)e(it)0 +4650 y(in)m(to)37 b(the)f(ro)m(w)h(\014lter)f(using)f(the)i(syn)m(tax)g +('[@\014lename.txt]'.)60 b(The)36 b(expression)g(can)g(b)s(e)g +(arbitrarily)e(complex)0 4763 y(and)27 b(extend)i(o)m(v)m(er)g(m)m +(ultiple)d(lines)g(of)i(the)h(\014le.)39 b(An)m(y)28 +b(lines)e(in)h(the)h(external)g(text)h(\014le)e(that)i(b)s(egin)e(with) +g(2)h(slash)0 4876 y(c)m(haracters)k(\('//'\))g(will)c(b)s(e)i(ignored) +f(and)h(ma)m(y)h(b)s(e)f(used)f(to)i(add)f(commen)m(ts)h(in)m(to)g(the) +f(\014le.)0 5036 y(Keyw)m(ord)37 b(and)f(column)f(data)j(are)f +(referenced)g(b)m(y)g(name.)60 b(An)m(y)37 b(string)e(of)i(c)m +(haracters)i(not)e(surrounded)d(b)m(y)0 5149 y(quotes)41 +b(\(ie,)i(a)e(constan)m(t)h(string\))e(or)g(follo)m(w)m(ed)g(b)m(y)h +(an)f(op)s(en)g(paren)m(theses)h(\(ie,)i(a)e(function)e(name\))i(will)d +(b)s(e)0 5262 y(initially)33 b(in)m(terpreted)i(as)i(a)g(column)e(name) +h(and)g(its)g(con)m(ten)m(ts)i(for)e(the)h(curren)m(t)f(ro)m(w)g +(inserted)f(in)m(to)i(the)f(ex-)0 5375 y(pression.)j(If)28 +b(no)h(suc)m(h)g(column)f(exists,)h(a)h(k)m(eyw)m(ord)f(of)h(that)f +(name)g(will)e(b)s(e)h(searc)m(hed)i(for)f(and)f(its)h(v)-5 +b(alue)28 b(used,)0 5488 y(if)35 b(found.)55 b(T)-8 b(o)36 +b(force)g(the)g(name)g(to)h(b)s(e)e(in)m(terpreted)g(as)h(a)g(k)m(eyw)m +(ord)g(\(in)f(case)h(there)g(is)f(b)s(oth)g(a)h(column)f(and)0 +5601 y(k)m(eyw)m(ord)41 b(with)d(the)j(same)f(name\),)j(precede)d(the)h +(k)m(eyw)m(ord)f(name)g(with)f(a)i(single)d(p)s(ound)g(sign,)k('#',)h +(as)d(in)0 5714 y('#NAXIS2'.)g(Due)27 b(to)g(the)f(generalities)g(of)g +(FITS)g(column)f(and)h(k)m(eyw)m(ord)h(names,)g(if)e(the)i(column)e(or) +h(k)m(eyw)m(ord)p eop +%%Page: 29 35 +29 34 bop 0 299 a Fg(4.9.)72 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)2072 b Fi(29)0 555 +y(name)34 b(con)m(tains)g(a)g(space)h(or)e(a)i(c)m(haracter)g(whic)m(h) +e(migh)m(t)g(app)s(ear)g(as)i(an)e(arithmetic)g(term)h(then)g(inclose)f +(the)0 668 y(name)d(in)f('$')j(c)m(haracters)g(as)e(in)f($MAX)j(PHA$)f +(or)f(#$MAX-PHA$.)43 b(Names)31 b(are)f(case)i(insensitiv)m(e.)0 +828 y(T)-8 b(o)32 b(access)g(a)g(table)f(en)m(try)h(in)e(a)i(ro)m(w)f +(other)h(than)f(the)g(curren)m(t)g(one,)h(follo)m(w)f(the)g(column's)g +(name)g(with)f(a)i(ro)m(w)0 941 y(o\013set)37 b(within)c(curly)h +(braces.)57 b(F)-8 b(or)36 b(example,)h('PHA)p Fc(f)p +Fi(-3)p Fc(g)p Fi(')h(will)33 b(ev)-5 b(aluate)37 b(to)f(the)g(v)-5 +b(alue)35 b(of)h(column)e(PHA,)j(3)0 1054 y(ro)m(ws)28 +b(ab)s(o)m(v)m(e)i(the)e(ro)m(w)h(curren)m(tly)e(b)s(eing)g(pro)s +(cessed.)40 b(One)28 b(cannot)h(sp)s(ecify)e(an)h(absolute)g(ro)m(w)g +(n)m(um)m(b)s(er,)g(only)g(a)0 1167 y(relativ)m(e)i(o\013set.)42 +b(Ro)m(ws)31 b(that)g(fall)e(outside)h(the)g(table)g(will)e(b)s(e)i +(treated)h(as)g(unde\014ned,)d(or)j(NULLs.)0 1327 y(Bo)s(olean)g(op)s +(erators)g(can)g(b)s(e)f(used)f(in)h(the)g(expression)g(in)f(either)h +(their)g(F)-8 b(ortran)31 b(or)f(C)h(forms.)40 b(The)30 +b(follo)m(wing)0 1440 y(b)s(o)s(olean)f(op)s(erators)i(are)g(a)m(v)-5 +b(ailable:)191 1666 y Fe("equal")428 b(.eq.)46 b(.EQ.)h(==)95 +b("not)46 b(equal")476 b(.ne.)94 b(.NE.)h(!=)191 1779 +y("less)46 b(than")238 b(.lt.)46 b(.LT.)h(<)143 b("less)46 +b(than/equal")188 b(.le.)94 b(.LE.)h(<=)47 b(=<)191 1892 +y("greater)e(than")95 b(.gt.)46 b(.GT.)h(>)143 b("greater)45 +b(than/equal")g(.ge.)94 b(.GE.)h(>=)47 b(=>)191 2005 +y("or")572 b(.or.)46 b(.OR.)h(||)95 b("and")762 b(.and.)46 +b(.AND.)h(&&)191 2118 y("negation")236 b(.not.)46 b(.NOT.)h(!)95 +b("approx.)45 b(equal\(1e-7\)")92 b(~)0 2344 y Fi(Note)32 +b(that)g(the)f(exclamation)g(p)s(oin)m(t,)f(')10 b(!',)33 +b(is)d(a)h(sp)s(ecial)e(UNIX)j(c)m(haracter,)h(so)e(if)f(it)g(is)g +(used)g(on)h(the)g(command)0 2457 y(line)g(rather)h(than)h(en)m(tered)g +(at)g(a)g(task)g(prompt,)g(it)f(m)m(ust)g(b)s(e)g(preceded)h(b)m(y)f(a) +h(bac)m(kslash)f(to)i(force)f(the)g(UNIX)0 2570 y(shell)c(to)i(ignore)f +(it.)0 2730 y(The)i(expression)f(ma)m(y)j(also)e(include)e(arithmetic)i +(op)s(erators)h(and)f(functions.)46 b(T)-8 b(rigonometric)32 +b(functions)f(use)0 2843 y(radians,)22 b(not)h(degrees.)38 +b(The)22 b(follo)m(wing)e(arithmetic)h(op)s(erators)i(and)e(functions)f +(can)j(b)s(e)e(used)g(in)g(the)h(expression)0 2956 y(\(function)37 +b(names)g(are)h(case)g(insensitiv)m(e\).)61 b(A)37 b(n)m(ull)f(v)-5 +b(alue)37 b(will)d(b)s(e)j(returned)g(in)f(case)i(of)g(illegal)e(op)s +(erations)0 3069 y(suc)m(h)30 b(as)h(divide)d(b)m(y)i(zero,)i +(sqrt\(negativ)m(e\))g(log\(negativ)m(e\),)g(log10\(negativ)m(e\),)i +(arccos\(.gt.)43 b(1\),)32 b(arcsin\(.gt.)41 b(1\).)191 +3295 y Fe("addition")522 b(+)477 b("subtraction")d(-)191 +3408 y("multiplication")234 b(*)477 b("division")618 +b(/)191 3521 y("negation")522 b(-)477 b("exponentiation")330 +b(**)143 b(^)191 3634 y("absolute)45 b(value")237 b(abs\(x\))g +("cosine")714 b(cos\(x\))191 3747 y("sine")g(sin\(x\))237 +b("tangent")666 b(tan\(x\))191 3860 y("arc)47 b(cosine")427 +b(arccos\(x\))93 b("arc)47 b(sine")619 b(arcsin\(x\))191 +3973 y("arc)47 b(tangent")379 b(arctan\(x\))93 b("arc)47 +b(tangent")475 b(arctan2\(x,y\))191 4085 y("hyperbolic)45 +b(cos")237 b(cosh\(x\))189 b("hyperbolic)45 b(sin")333 +b(sinh\(x\))191 4198 y("hyperbolic)45 b(tan")237 b(tanh\(x\))189 +b("round)46 b(to)h(nearest)f(int")h(round\(x\))191 4311 +y("round)f(down)h(to)g(int")94 b(floor\(x\))141 b("round)46 +b(up)h(to)h(int")285 b(ceil\(x\))191 4424 y("exponential")378 +b(exp\(x\))237 b("square)46 b(root")476 b(sqrt\(x\))191 +4537 y("natural)45 b(log")381 b(log\(x\))237 b("common)46 +b(log")524 b(log10\(x\))191 4650 y("modulus")570 b(i)48 +b(\045)f(j)286 b("random)46 b(#)h([0.0,1.0\)")141 b(random\(\))191 +4763 y("minimum")570 b(min\(x,y\))141 b("maximum")666 +b(max\(x,y\))191 4876 y("cumulative)45 b(sum")189 b(accum\(x\))141 +b("sequential)45 b(difference")g(seqdiff\(x\))191 4989 +y("if-then-else")330 b(b?x:y)0 5215 y Fi(An)31 b(alternate)h(syn)m(tax) +g(for)f(the)g(min)f(and)h(max)g(functions)f(has)h(only)f(a)i(single)e +(argumen)m(t)i(whic)m(h)e(should)f(b)s(e)i(a)0 5328 y(v)m(ector)g(v)-5 +b(alue)29 b(\(see)h(b)s(elo)m(w\).)40 b(The)29 b(result)f(will)f(b)s(e) +h(the)i(minim)m(um/maxim)m(um)c(elemen)m(t)j(con)m(tained)h(within)d +(the)0 5441 y(v)m(ector.)0 5601 y(The)35 b(accum\(x\))i(function)e +(forms)g(the)h(cum)m(ulativ)m(e)g(sum)f(of)h(x,)h(elemen)m(t)g(b)m(y)f +(elemen)m(t.)57 b(V)-8 b(ector)38 b(columns)d(are)0 5714 +y(supp)s(orted)i(simply)f(b)m(y)i(p)s(erforming)e(the)j(summation)f +(pro)s(cess)g(through)f(all)h(the)h(v)-5 b(alues.)64 +b(Null)37 b(v)-5 b(alues)38 b(are)p eop +%%Page: 30 36 +30 35 bop 0 299 a Fi(30)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fi(treated)30 +b(as)f(0.)41 b(The)29 b(seqdi\013\(x\))g(function)e(forms)i(the)g +(sequen)m(tial)g(di\013erence)f(of)i(x,)f(elemen)m(t)h(b)m(y)f(elemen)m +(t.)40 b(The)0 668 y(\014rst)c(v)-5 b(alue)37 b(of)g(seqdi\013)f(is)g +(the)h(\014rst)g(v)-5 b(alue)36 b(of)h(x.)61 b(A)37 b(single)f(n)m(ull) +f(v)-5 b(alue)37 b(in)e(x)i(causes)h(a)f(pair)f(of)h(n)m(ulls)e(in)h +(the)0 781 y(output.)55 b(The)35 b(seqdi\013)f(and)h(accum)g(functions) +f(are)i(functional)d(in)m(v)m(erses,)k(i.e.,)g(seqdi\013\(accum\(x\)\)) +f(==)f(x)g(as)0 894 y(long)30 b(as)h(no)f(n)m(ull)e(v)-5 +b(alues)30 b(are)h(presen)m(t.)0 1054 y(The)38 b(follo)m(wing)f(t)m(yp) +s(e)i(casting)g(op)s(erators)g(are)g(a)m(v)-5 b(ailable,)41 +b(where)d(the)h(inclosing)e(paren)m(theses)i(are)g(required)0 +1167 y(and)30 b(tak)m(en)h(from)f(the)h(C)f(language)g(usage.)42 +b(Also,)30 b(the)h(in)m(teger)f(to)i(real)e(casts)h(v)-5 +b(alues)29 b(to)j(double)d(precision:)764 1398 y Fe("real)46 +b(to)h(integer")189 b(\(int\))46 b(x)239 b(\(INT\))46 +b(x)764 1510 y("integer)f(to)i(real")190 b(\(float\))46 +b(i)143 b(\(FLOAT\))45 b(i)0 1741 y Fi(In)30 b(addition,)e(sev)m(eral)j +(constan)m(ts)h(are)f(built)d(in)h(for)h(use)g(in)f(n)m(umerical)g +(expressions:)382 1972 y Fe(#pi)667 b(3.1415...)284 b(#e)620 +b(2.7182...)382 2085 y(#deg)f(#pi/180)380 b(#row)524 +b(current)46 b(row)h(number)382 2197 y(#null)428 b(undefined)45 +b(value)142 b(#snull)428 b(undefined)45 b(string)0 2428 +y Fi(A)40 b(string)e(constan)m(t)j(m)m(ust)e(b)s(e)g(enclosed)g(in)g +(quotes)h(as)f(in)g('Crab'.)67 b(The)39 b("n)m(ull")g(constan)m(ts)h +(are)g(useful)e(for)0 2541 y(conditionally)d(setting)j(table)g(v)-5 +b(alues)37 b(to)h(a)g(NULL,)g(or)g(unde\014ned,)f(v)-5 +b(alue)38 b(\(eg.,)j("col1==-99)e(?)62 b(#NULL)38 b(:)0 +2654 y(col1"\).)0 2814 y(There)27 b(is)f(also)i(a)f(function)f(for)i +(testing)f(if)f(t)m(w)m(o)j(v)-5 b(alues)27 b(are)h(close)f(to)i(eac)m +(h)f(other,)h(i.e.,)f(if)e(they)i(are)g("near")g(eac)m(h)0 +2927 y(other)c(to)h(within)c(a)j(user)g(sp)s(eci\014ed)e(tolerance.)39 +b(The)24 b(argumen)m(ts,)h(v)-5 b(alue)p 2503 2927 28 +4 v 33 w(1)24 b(and)f(v)-5 b(alue)p 2980 2927 V 32 w(2)25 +b(can)f(b)s(e)f(in)m(teger)h(or)g(real)0 3040 y(and)32 +b(represen)m(t)h(the)g(t)m(w)m(o)h(v)-5 b(alues)32 b(who's)g(pro)m +(ximit)m(y)g(is)g(b)s(eing)f(tested)i(to)h(b)s(e)e(within)e(the)j(sp)s +(eci\014ed)e(tolerance,)0 3153 y(also)f(an)h(in)m(teger)f(or)h(real:) +955 3383 y Fe(near\(value_1,)44 b(value_2,)h(tolerance\))0 +3614 y Fi(When)24 b(a)i(NULL,)e(or)h(unde\014ned,)f(v)-5 +b(alue)24 b(is)g(encoun)m(tered)h(in)f(the)g(FITS)g(table,)i(the)f +(expression)f(will)e(ev)-5 b(aluate)25 b(to)0 3727 y(NULL)31 +b(unless)e(the)i(unde\014ned)e(v)-5 b(alue)30 b(is)g(not)h(actually)f +(required)f(for)i(ev)-5 b(aluation,)31 b(e.g.)43 b("TR)m(UE)31 +b(.or.)43 b(NULL")0 3840 y(ev)-5 b(aluates)31 b(to)g(TR)m(UE.)g(The)f +(follo)m(wing)e(t)m(w)m(o)k(functions)d(allo)m(w)h(some)h(NULL)f +(detection)h(and)f(handling:)430 4070 y Fe("a)47 b(null)f(value?")667 +b(ISNULL\(x\))430 4183 y("define)45 b(a)j(value)e(for)h(null")190 +b(DEFNULL\(x,y\))0 4414 y Fi(The)36 b(former)h(returns)e(a)i(b)s(o)s +(olean)f(v)-5 b(alue)36 b(of)h(TR)m(UE)g(if)f(the)h(argumen)m(t)g(x)g +(is)f(NULL.)h(The)f(later)h("de\014nes")g(a)0 4527 y(v)-5 +b(alue)34 b(to)h(b)s(e)e(substituted)g(for)h(NULL)g(v)-5 +b(alues;)36 b(it)e(returns)f(the)h(v)-5 b(alue)34 b(of)g(x)g(if)f(x)i +(is)e(not)h(NULL,)h(otherwise)e(it)0 4640 y(returns)c(the)i(v)-5 +b(alue)30 b(of)g(y)-8 b(.)0 4926 y Fb(4.9.2)112 b(Bit)36 +b(Masks)0 5145 y Fi(Bit)f(masks)g(can)h(b)s(e)f(used)f(to)i(select)g +(out)f(ro)m(ws)h(from)e(bit)h(columns)f(\(TF)m(ORMn)h(=)g(#X\))h(in)e +(FITS)g(\014les.)54 b(T)-8 b(o)0 5257 y(represen)m(t)30 +b(the)h(mask,)g(binary)-8 b(,)29 b(o)s(ctal,)i(and)f(hex)g(formats)g +(are)h(allo)m(w)m(ed:)811 5488 y Fe(binary:)142 b +(b0110xx1010000101xxxx00)o(01)811 5601 y(octal:)190 b(o720x1)46 +b(->)h(\(b111010000xxx001\))811 5714 y(hex:)286 b(h0FxD)94 +b(->)47 b(\(b00001111xxxx1101\))p eop +%%Page: 31 37 +31 36 bop 0 299 a Fg(4.9.)72 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)2072 b Fi(31)0 555 +y(In)22 b(all)g(the)h(represen)m(tations,)i(an)d(x)h(or)g(X)g(is)f +(allo)m(w)m(ed)h(in)e(the)i(mask)g(as)g(a)h(wild)c(card.)38 +b(Note)25 b(that)e(the)g(x)g(represen)m(ts)0 668 y(a)k(di\013eren)m(t)g +(n)m(um)m(b)s(er)f(of)h(wild)d(card)j(bits)f(in)g(eac)m(h)i(represen)m +(tation.)40 b(All)25 b(represen)m(tations)i(are)h(case)g(insensitiv)m +(e.)0 828 y(T)-8 b(o)28 b(construct)g(the)g(b)s(o)s(olean)e(expression) +h(using)f(the)i(mask)f(as)h(the)g(b)s(o)s(olean)e(equal)h(op)s(erator)h +(describ)s(ed)e(ab)s(o)m(v)m(e)0 941 y(on)34 b(a)h(bit)f(table)h +(column.)52 b(F)-8 b(or)35 b(example,)h(if)d(y)m(ou)i(had)f(a)h(7)g +(bit)f(column)f(named)h(\015ags)h(in)e(a)i(FITS)f(table)h(and)0 +1054 y(w)m(an)m(ted)c(all)e(ro)m(ws)i(ha)m(ving)f(the)g(bit)g(pattern)g +(0010011,)k(the)c(selection)h(expression)e(w)m(ould)g(b)s(e:)1336 +1301 y Fe(flags)47 b(==)g(b0010011)191 1414 y(or)1336 +1526 y(flags)g(.eq.)f(b10011)0 1773 y Fi(It)35 b(is)f(also)h(p)s +(ossible)d(to)k(test)g(if)e(a)h(range)g(of)g(bits)f(is)g(less)g(than,)i +(less)e(than)h(equal,)h(greater)g(than)e(and)h(greater)0 +1886 y(than)30 b(equal)g(to)h(a)g(particular)e(b)s(o)s(olean)g(v)-5 +b(alue:)1336 2132 y Fe(flags)47 b(<=)g(bxxx010xx)1336 +2245 y(flags)g(.gt.)f(bxxx100xx)1336 2358 y(flags)h(.le.)f(b1xxxxxxx)0 +2605 y Fi(Notice)31 b(the)g(use)f(of)h(the)f(x)g(bit)g(v)-5 +b(alue)30 b(to)h(limit)d(the)i(range)h(of)g(bits)e(b)s(eing)g +(compared.)0 2765 y(It)j(is)g(not)g(necessary)h(to)g(sp)s(ecify)e(the)i +(leading)e(\(most)i(signi\014can)m(t\))f(zero)h(\(0\))g(bits)e(in)g +(the)i(mask,)g(as)g(sho)m(wn)e(in)0 2878 y(the)g(second)f(expression)f +(ab)s(o)m(v)m(e.)0 3038 y(Bit)43 b(wise)f(AND,)i(OR)e(and)g(NOT)h(op)s +(erations)f(are)h(also)g(p)s(ossible)d(on)j(t)m(w)m(o)h(or)f(more)g +(bit)f(\014elds)f(using)h(the)0 3151 y('&'\(AND\),)35 +b(')p Fc(j)p Fi('\(OR\),)g(and)e(the)h(')10 b(!'\(NOT\))34 +b(op)s(erators.)51 b(All)32 b(of)h(these)h(op)s(erators)g(result)e(in)h +(a)h(bit)e(\014eld)g(whic)m(h)0 3264 y(can)f(then)f(b)s(e)f(used)h +(with)f(the)i(equal)f(op)s(erator.)41 b(F)-8 b(or)31 +b(example:)1241 3510 y Fe(\(!flags\))45 b(==)j(b1101100)1241 +3623 y(\(flags)e(&)h(b1000001\))f(==)h(bx000001)0 3870 +y Fi(Bit)34 b(\014elds)f(can)h(b)s(e)f(app)s(ended)g(as)h(w)m(ell)f +(using)g(the)h('+')g(op)s(erator.)53 b(Strings)32 b(can)j(b)s(e)e +(concatenated)j(this)d(w)m(a)m(y)-8 b(,)0 3983 y(to)s(o.)0 +4271 y Fb(4.9.3)112 b(V)-9 b(ector)36 b(Columns)0 4490 +y Fi(V)-8 b(ector)37 b(columns)d(can)i(also)f(b)s(e)g(used)f(in)g +(building)e(the)j(expression.)55 b(No)36 b(sp)s(ecial)e(syn)m(tax)h(is) +g(required)e(if)i(one)0 4603 y(w)m(an)m(ts)46 b(to)f(op)s(erate)h(on)f +(all)f(elemen)m(ts)h(of)g(the)h(v)m(ector.)86 b(Simply)42 +b(use)j(the)g(column)f(name)h(as)g(for)g(a)g(scalar)0 +4716 y(column.)c(V)-8 b(ector)32 b(columns)e(can)h(b)s(e)f(freely)g(in) +m(termixed)g(with)f(scalar)i(columns)e(or)i(constan)m(ts)h(in)e +(virtually)e(all)0 4829 y(expressions.)39 b(The)29 b(result)f(will)e(b) +s(e)j(of)g(the)g(same)h(dimension)c(as)k(the)f(v)m(ector.)42 +b(Tw)m(o)29 b(v)m(ectors)i(in)d(an)h(expression,)0 4942 +y(though,)f(need)e(to)i(ha)m(v)m(e)g(the)f(same)g(n)m(um)m(b)s(er)f(of) +h(elemen)m(ts)g(and)f(ha)m(v)m(e)j(the)e(same)g(dimensions.)37 +b(The)26 b(only)g(places)0 5055 y(a)35 b(v)m(ector)h(column)d(cannot)i +(b)s(e)f(used)f(\(for)i(no)m(w,)g(an)m(yw)m(a)m(y\))h(are)f(the)g(SA)m +(O)f(region)g(functions)f(and)g(the)i(NEAR)0 5168 y(b)s(o)s(olean)29 +b(function.)0 5328 y(Arithmetic)22 b(and)g(logical)h(op)s(erations)f +(are)i(all)e(p)s(erformed)f(on)i(an)g(elemen)m(t)g(b)m(y)g(elemen)m(t)h +(basis.)37 b(Comparing)22 b(t)m(w)m(o)0 5441 y(v)m(ector)32 +b(columns,)d(eg)i("COL1)f(==)g(COL2",)g(th)m(us)g(results)f(in)g +(another)h(v)m(ector)i(of)e(b)s(o)s(olean)g(v)-5 b(alues)29 +b(indicating)0 5554 y(whic)m(h)g(elemen)m(ts)i(of)f(the)h(t)m(w)m(o)h +(v)m(ectors)f(are)g(equal.)0 5714 y(Eigh)m(t)f(functions)f(are)i(a)m(v) +-5 b(ailable)30 b(that)h(op)s(erate)g(on)f(a)h(v)m(ector)h(and)d +(return)h(a)g(scalar)h(result:)p eop +%%Page: 32 38 +32 37 bop 0 299 a Fi(32)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)191 555 y +Fe("minimum")284 b(MIN\(V\))475 b("maximum")714 b(MAX\(V\))191 +668 y("average")284 b(AVERAGE\(V\))f("median")762 b(MEDIAN\(V\))191 +781 y("sumation")236 b(SUM\(V\))475 b("standard)46 b(deviation")188 +b(STDDEV\(V\))191 894 y("#)47 b(of)g(values")94 b(NELEM\(V\))379 +b("#)48 b(of)f(non-null)e(values")94 b(NVALID\(V\))0 +1217 y Fi(where)40 b(V)h(represen)m(ts)g(the)g(name)g(of)h(a)f(v)m +(ector)h(column)e(or)h(a)h(man)m(ually)d(constructed)i(v)m(ector)i +(using)c(curly)0 1330 y(brac)m(k)m(ets)27 b(as)f(describ)s(ed)d(b)s +(elo)m(w.)38 b(The)25 b(\014rst)g(6)h(of)g(these)g(functions)e(ignore)h +(an)m(y)h(n)m(ull)d(v)-5 b(alues)25 b(in)f(the)i(v)m(ector)h(when)0 +1443 y(computing)i(the)i(result.)0 1603 y(The)h(SUM)h(function)e +(literally)g(sums)g(all)h(the)h(elemen)m(ts)g(in)f(x,)h(returning)e(a)i +(scalar)g(v)-5 b(alue.)47 b(If)32 b(x)h(is)f(a)h(b)s(o)s(olean)0 +1716 y(v)m(ector,)40 b(SUM)c(returns)f(the)h(n)m(um)m(b)s(er)f(of)i(TR) +m(UE)f(elemen)m(ts.)59 b(The)36 b(NELEM)g(function)f(returns)g(the)h(n) +m(um)m(b)s(er)0 1829 y(of)i(elemen)m(ts)g(in)f(v)m(ector)i(x)f(whereas) +f(NV)-10 b(ALID)39 b(return)d(the)i(n)m(um)m(b)s(er)f(of)h(non-n)m(ull) +d(elemen)m(ts)k(in)d(the)i(v)m(ector.)0 1942 y(\(NELEM)28 +b(also)g(op)s(erates)g(on)g(bit)e(and)h(string)g(columns,)g(returning)f +(their)h(column)f(widths.\))39 b(As)27 b(an)h(example,)0 +2055 y(to)42 b(test)g(whether)f(all)f(elemen)m(ts)i(of)g(t)m(w)m(o)g(v) +m(ectors)h(satisfy)e(a)h(giv)m(en)f(logical)g(comparison,)i(one)f(can)g +(use)f(the)0 2168 y(expression)668 2492 y Fe(SUM\()47 +b(COL1)f(>)i(COL2)f(\))g(==)g(NELEM\()f(COL1)h(\))0 2815 +y Fi(whic)m(h)31 b(will)e(return)i(TR)m(UE)h(if)f(all)g(elemen)m(ts)h +(of)g(COL1)g(are)g(greater)h(than)f(their)f(corresp)s(onding)f(elemen)m +(ts)i(in)0 2928 y(COL2.)0 3088 y(T)-8 b(o)32 b(sp)s(ecify)e(a)j(single) +d(elemen)m(t)i(of)g(a)g(v)m(ector,)i(giv)m(e)e(the)g(column)e(name)i +(follo)m(w)m(ed)f(b)m(y)h(a)g(comma-separated)h(list)0 +3201 y(of)c(co)s(ordinates)f(enclosed)h(in)e(square)i(brac)m(k)m(ets.) +41 b(F)-8 b(or)30 b(example,)f(if)e(a)i(v)m(ector)i(column)c(named)i +(PHAS)f(exists)g(in)0 3314 y(the)f(table)f(as)h(a)g(one)g(dimensional,) +e(256)j(comp)s(onen)m(t)f(list)e(of)i(n)m(um)m(b)s(ers)e(from)h(whic)m +(h)g(y)m(ou)h(w)m(an)m(ted)g(to)g(select)h(the)0 3427 +y(57th)k(comp)s(onen)m(t)g(for)f(use)g(in)f(the)i(expression,)e(then)i +(PHAS[57])g(w)m(ould)e(do)i(the)f(tric)m(k.)44 b(Higher)31 +b(dimensional)0 3540 y(arra)m(ys)41 b(of)h(data)f(ma)m(y)h(app)s(ear)f +(in)e(a)j(column.)72 b(But)41 b(in)f(order)g(to)i(in)m(terpret)e(them,) +k(the)e(TDIMn)e(k)m(eyw)m(ord)0 3653 y(m)m(ust)34 b(app)s(ear)g(in)f +(the)h(header.)52 b(Assuming)33 b(that)i(a)f(\(4,4,4,4\))k(arra)m(y)c +(is)g(pac)m(k)m(ed)h(in)m(to)f(eac)m(h)i(ro)m(w)e(of)g(a)h(column)0 +3766 y(named)26 b(ARRA)-8 b(Y4D,)28 b(the)f(\(1,2,3,4\))i(comp)s(onen)m +(t)e(elemen)m(t)f(of)h(eac)m(h)g(ro)m(w)g(is)e(accessed)j(b)m(y)e(ARRA) +-8 b(Y4D[1,2,3,4].)0 3878 y(Arra)m(ys)33 b(up)e(to)j(dimension)c(5)j +(are)f(curren)m(tly)g(supp)s(orted.)46 b(Eac)m(h)33 b(v)m(ector)h +(index)d(can)i(itself)e(b)s(e)h(an)h(expression,)0 3991 +y(although)38 b(it)g(m)m(ust)h(ev)-5 b(aluate)39 b(to)g(an)g(in)m +(teger)g(v)-5 b(alue)38 b(within)e(the)j(b)s(ounds)d(of)j(the)g(v)m +(ector.)67 b(V)-8 b(ector)40 b(columns)0 4104 y(whic)m(h)30 +b(con)m(tain)h(spaces)h(or)f(arithmetic)f(op)s(erators)i(m)m(ust)f(ha)m +(v)m(e)h(their)e(names)h(enclosed)g(in)f("$")i(c)m(haracters)h(as)0 +4217 y(with)c($ARRA)-8 b(Y-4D$[1,2,3,4].)0 4377 y(A)45 +b(more)f(C-lik)m(e)g(syn)m(tax)i(for)e(sp)s(ecifying)e(v)m(ector)47 +b(indices)42 b(is)i(also)h(a)m(v)-5 b(ailable.)82 b(The)45 +b(elemen)m(t)g(used)e(in)h(the)0 4490 y(preceding)27 +b(example)h(alternativ)m(ely)g(could)f(b)s(e)h(sp)s(eci\014ed)f(with)f +(the)j(syn)m(tax)g(ARRA)-8 b(Y4D[4][3][2][1].)45 b(Note)30 +b(the)0 4603 y(rev)m(erse)40 b(order)f(of)h(indices)d(\(as)j(in)e(C\),) +i(as)f(w)m(ell)g(as)g(the)h(fact)g(that)g(the)g(v)-5 +b(alues)39 b(are)g(still)f(ones-based)h(\(as)h(in)0 4716 +y(F)-8 b(ortran)39 b({)g(adopted)g(to)g(a)m(v)m(oid)g(am)m(biguit)m(y)f +(for)h(1D)g(v)m(ectors\).)67 b(With)38 b(this)g(syn)m(tax,)j(one)e(do)s +(es)f(not)h(need)f(to)0 4829 y(sp)s(ecify)29 b(all)g(of)i(the)f +(indices.)39 b(T)-8 b(o)31 b(extract)h(a)f(3D)g(slice)e(of)i(this)e(4D) +i(arra)m(y)-8 b(,)32 b(use)e(ARRA)-8 b(Y4D[4].)0 4989 +y(V)g(ariable-length)30 b(v)m(ector)i(columns)d(are)h(not)h(supp)s +(orted.)0 5149 y(V)-8 b(ectors)24 b(can)e(b)s(e)f(man)m(ually)f +(constructed)j(within)c(the)j(expression)f(using)f(a)i(comma-separated) +i(list)d(of)h(elemen)m(ts)0 5262 y(surrounded)35 b(b)m(y)j(curly)f +(braces)i(\(')p Fc(fg)p Fi('\).)66 b(F)-8 b(or)38 b(example,)i(')p +Fc(f)p Fi(1,3,6,1)p Fc(g)p Fi(')i(is)c(a)g(4-elemen)m(t)h(v)m(ector)h +(con)m(taining)e(the)0 5375 y(v)-5 b(alues)25 b(1,)i(3,)g(6,)g(and)e +(1.)40 b(The)25 b(v)m(ector)i(can)f(con)m(tain)g(only)f(b)s(o)s(olean,) +g(in)m(teger,)j(and)d(real)g(v)-5 b(alues)25 b(\(or)h(expressions\).)0 +5488 y(The)e(elemen)m(ts)g(will)e(b)s(e)i(promoted)g(to)h(the)g +(highest)e(datat)m(yp)s(e)i(presen)m(t.)39 b(An)m(y)24 +b(elemen)m(ts)h(whic)m(h)e(are)i(themselv)m(es)0 5601 +y(v)m(ectors,)40 b(will)34 b(b)s(e)i(expanded)g(out)h(with)f(eac)m(h)h +(of)g(its)f(elemen)m(ts)i(b)s(ecoming)d(an)i(elemen)m(t)g(in)f(the)h +(constructed)0 5714 y(v)m(ector.)p eop +%%Page: 33 39 +33 38 bop 0 299 a Fg(4.9.)72 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)2072 b Fi(33)0 555 +y Fb(4.9.4)112 b(Go)s(o)s(d)38 b(Time)e(In)m(terv)-6 +b(al)37 b(Filtering)0 774 y Fi(A)44 b(common)g(\014ltering)f(metho)s(d) +g(in)m(v)m(olv)m(es)h(selecting)g(ro)m(ws)g(whic)m(h)e(ha)m(v)m(e)k(a)e +(time)g(v)-5 b(alue)43 b(whic)m(h)g(lies)f(within)0 887 +y(what)37 b(is)f(called)h(a)h(Go)s(o)s(d)f(Time)f(In)m(terv)-5 +b(al)37 b(or)g(GTI.)g(The)g(time)g(in)m(terv)-5 b(als)36 +b(are)i(de\014ned)e(in)g(a)h(separate)i(FITS)0 1000 y(table)h +(extension)g(whic)m(h)e(con)m(tains)i(2)h(columns)e(giving)f(the)j +(start)f(and)g(stop)g(time)f(of)h(eac)m(h)i(go)s(o)s(d)e(in)m(terv)-5 +b(al.)0 1113 y(The)34 b(\014ltering)f(op)s(eration)i(accepts)h(only)d +(those)j(ro)m(ws)e(of)h(the)g(input)e(table)i(whic)m(h)e(ha)m(v)m(e)j +(an)f(asso)s(ciated)g(time)0 1226 y(whic)m(h)f(falls)h(within)e(one)j +(of)g(the)g(time)f(in)m(terv)-5 b(als)35 b(de\014ned)g(in)f(the)i(GTI)g +(extension.)56 b(A)36 b(high)f(lev)m(el)g(function,)0 +1339 y(gti\014lter\(a,b,c,d\),)42 b(is)d(a)m(v)-5 b(ailable)39 +b(whic)m(h)f(ev)-5 b(aluates)40 b(eac)m(h)h(ro)m(w)e(of)h(the)f(input)f +(table)h(and)g(returns)f(TR)m(UE)i(or)0 1452 y(F)-10 +b(ALSE)30 b(dep)s(ending)e(whether)i(the)g(ro)m(w)h(is)e(inside)f(or)i +(outside)g(the)h(go)s(o)s(d)f(time)g(in)m(terv)-5 b(al.)40 +b(The)30 b(syn)m(tax)h(is)286 1696 y Fe(gtifilter\()45 +b([)j("gtifile")d([,)i(expr)g([,)g("STARTCOL",)e("STOPCOL")g(])j(])f(]) +g(\))0 1941 y Fi(where)20 b(eac)m(h)h("[]")h(demarks)e(optional)f +(parameters.)38 b(Note)21 b(that)g(the)g(quotes)f(around)g(the)g +(gti\014le)g(and)f(ST)-8 b(AR)g(T/STOP)0 2054 y(column)32 +b(are)i(required.)49 b(Either)33 b(single)f(or)i(double)e(quotes)i(ma)m +(y)g(b)s(e)f(used.)50 b(In)33 b(cases)h(where)g(this)e(expression)0 +2167 y(is)d(en)m(tered)h(on)g(the)g(Unix)f(command)h(line,)e(enclose)i +(the)g(en)m(tire)g(expression)f(in)f(double)h(quotes,)h(and)g(then)f +(use)0 2280 y(single)23 b(quotes)i(within)c(the)k(expression)e(to)i +(enclose)f(the)h('gti\014le')f(and)f(other)i(terms.)38 +b(It)25 b(is)e(also)h(usually)e(p)s(ossible)0 2393 y(to)38 +b(do)e(the)h(rev)m(erse,)j(and)c(enclose)h(the)g(whole)f(expression)g +(in)f(single)h(quotes)h(and)f(then)h(use)f(double)f(quotes)0 +2506 y(within)c(the)i(expression.)49 b(The)33 b(gti\014le,)g(if)g(sp)s +(eci\014ed,)f(can)i(b)s(e)f(blank)f(\(""\))j(whic)m(h)d(will)e(mean)k +(to)g(use)f(the)h(\014rst)0 2619 y(extension)f(with)g(the)g(name)h +("*GTI*")h(in)e(the)g(curren)m(t)h(\014le,)g(a)g(plain)d(extension)i +(sp)s(eci\014er)f(\(eg,)k("+2",)g("[2]",)0 2731 y(or)30 +b("[STDGTI]"\))i(whic)m(h)d(will)f(b)s(e)i(used)f(to)j(select)f(an)f +(extension)g(in)f(the)i(curren)m(t)f(\014le,)g(or)g(a)h(regular)f +(\014lename)0 2844 y(with)f(or)i(without)e(an)i(extension)f(sp)s +(eci\014er)f(whic)m(h)g(in)g(the)i(latter)g(case)g(will)d(mean)i(to)i +(use)e(the)h(\014rst)e(extension)0 2957 y(with)36 b(an)h(extension)f +(name)i("*GTI*".)62 b(Expr)36 b(can)h(b)s(e)g(an)m(y)g(arithmetic)g +(expression,)g(including)d(simply)h(the)0 3070 y(time)g(column)g(name.) +57 b(A)36 b(v)m(ector)h(time)f(expression)e(will)f(pro)s(duce)i(a)h(v)m +(ector)h(b)s(o)s(olean)e(result.)56 b(ST)-8 b(AR)g(TCOL)0 +3183 y(and)27 b(STOPCOL)f(are)i(the)g(names)g(of)g(the)g(ST)-8 +b(AR)g(T/STOP)26 b(columns)h(in)f(the)i(GTI)g(extension.)40 +b(If)27 b(one)h(of)g(them)0 3296 y(is)h(sp)s(eci\014ed,)g(they)i(b)s +(oth)f(m)m(ust)g(b)s(e.)0 3456 y(In)21 b(its)g(simplest)f(form,)k(no)d +(parameters)h(need)g(to)h(b)s(e)e(pro)m(vided)f({)i(default)f(v)-5 +b(alues)21 b(will)f(b)s(e)h(used.)37 b(The)21 b(expression)0 +3569 y("gti\014lter\(\)")31 b(is)f(equiv)-5 b(alen)m(t)29 +b(to)334 3814 y Fe(gtifilter\()45 b("",)i(TIME,)f("*START*",)f +("*STOP*")h(\))0 4059 y Fi(This)30 b(will)e(searc)m(h)k(the)g(curren)m +(t)f(\014le)f(for)h(a)h(GTI)f(extension,)g(\014lter)g(the)g(TIME)g +(column)f(in)g(the)i(curren)m(t)f(table,)0 4172 y(using)i(ST)-8 +b(AR)g(T/STOP)34 b(times)h(tak)m(en)g(from)g(columns)e(in)h(the)h(GTI)g +(extension)f(with)g(names)g(con)m(taining)h(the)0 4284 +y(strings)c("ST)-8 b(AR)g(T")33 b(and)e("STOP".)46 b(The)32 +b(wildcards)d(\('*'\))34 b(allo)m(w)e(sligh)m(t)f(v)-5 +b(ariations)31 b(in)g(naming)g(con)m(v)m(en)m(tions)0 +4397 y(suc)m(h)38 b(as)g("TST)-8 b(AR)g(T")39 b(or)f("ST)-8 +b(AR)g(TTIME".)65 b(The)37 b(same)i(default)f(v)-5 b(alues)37 +b(apply)g(for)h(unsp)s(eci\014ed)e(parame-)0 4510 y(ters)g(when)f(the)h +(\014rst)f(one)i(or)f(t)m(w)m(o)h(parameters)f(are)h(sp)s(eci\014ed.)55 +b(The)36 b(function)e(automatically)i(searc)m(hes)h(for)0 +4623 y(TIMEZER)m(O/I/F)g(k)m(eyw)m(ords)f(in)f(the)i(curren)m(t)f(and)g +(GTI)g(extensions,)h(applying)e(a)h(relativ)m(e)h(time)f(o\013set,)j +(if)0 4736 y(necessary)-8 b(.)0 5024 y Fb(4.9.5)112 b(Spatial)37 +b(Region)g(Filtering)0 5243 y Fi(Another)h(common)g(\014ltering)e +(metho)s(d)h(selects)h(ro)m(ws)g(based)g(on)f(whether)h(the)g(spatial)f +(p)s(osition)e(asso)s(ciated)0 5356 y(with)c(eac)m(h)j(ro)m(w)e(is)g +(lo)s(cated)h(within)d(a)j(giv)m(en)f(2-dimensional)e(region.)47 +b(The)32 b(syn)m(tax)h(for)f(this)g(high-lev)m(el)f(\014lter)0 +5469 y(is)334 5714 y Fe(regfilter\()45 b("regfilename")f([)k(,)f +(Xexpr,)f(Yexpr)h([)g(,)h("wcs)e(cols")h(])g(])g(\))p +eop +%%Page: 34 40 +34 39 bop 0 299 a Fi(34)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)0 555 y Fi(where)22 +b(eac)m(h)i("[]")g(demarks)e(optional)g(parameters.)38 +b(The)22 b(region)g(\014le)g(name)g(is)g(required)f(and)h(m)m(ust)g(b)s +(e)g(enclosed)0 668 y(in)38 b(quotes.)70 b(The)39 b(remaining)f +(parameters)i(are)g(optional.)68 b(The)39 b(region)g(\014le)g(is)g(an)g +(ASCI)s(I)g(text)h(\014le)f(whic)m(h)0 781 y(con)m(tains)30 +b(a)f(list)f(of)i(one)f(or)h(more)f(geometric)i(shap)s(es)d(\(circle,)i +(ellipse,)d(b)s(o)m(x,)j(etc.\))42 b(whic)m(h)28 b(de\014nes)g(a)i +(region)f(on)0 894 y(the)i(celestial)f(sphere)g(or)h(an)g(area)g +(within)d(a)j(particular)f(2D)h(image.)42 b(The)30 b(region)h(\014le)f +(is)f(t)m(ypically)h(generated)0 1007 y(using)21 b(an)i(image)g(displa) +m(y)e(program)i(suc)m(h)f(as)h(fv/PO)m(W)h(\(distribute)c(b)m(y)j(the)g +(HEASAR)m(C\),)g(or)g(ds9)g(\(distributed)0 1120 y(b)m(y)k(the)g +(Smithsonian)d(Astroph)m(ysical)i(Observ)-5 b(atory\).)39 +b(Users)27 b(should)e(refer)h(to)i(the)f(do)s(cumen)m(tation)f(pro)m +(vided)0 1233 y(with)j(these)i(programs)f(for)g(more)h(details)e(on)h +(the)h(syn)m(tax)g(used)e(in)g(the)i(region)f(\014les.)0 +1393 y(In)44 b(its)g(simpliest)e(form,)47 b(\(e.g.,)j +(reg\014lter\("region.reg"\))c(\))f(the)g(co)s(ordinates)f(in)f(the)i +(default)e('X')i(and)f('Y')0 1506 y(columns)32 b(will)e(b)s(e)i(used)g +(to)i(determine)e(if)f(eac)m(h)j(ro)m(w)f(is)f(inside)f(or)i(outside)f +(the)h(area)h(sp)s(eci\014ed)d(in)g(the)i(region)0 1619 +y(\014le.)40 b(Alternate)31 b(p)s(osition)d(column)h(names,)i(or)f +(expressions,)f(ma)m(y)i(b)s(e)f(en)m(tered)h(if)e(needed,)i(as)f(in) +382 1867 y Fe(regfilter\("region.reg",)41 b(XPOS,)47 +b(YPOS\))0 2116 y Fi(Region)36 b(\014ltering)e(can)i(b)s(e)f(applied)e +(most)j(unam)m(biguously)d(if)i(the)h(p)s(ositions)e(in)g(the)i(region) +f(\014le)g(and)g(in)g(the)0 2229 y(table)g(to)h(b)s(e)e(\014ltered)g +(are)i(b)s(oth)e(giv)m(e)i(in)e(terms)h(of)g(absolute)g(celestial)g(co) +s(ordinate)g(units.)53 b(In)35 b(this)f(case)i(the)0 +2342 y(lo)s(cations)24 b(and)f(sizes)h(of)h(the)f(geometric)h(shap)s +(es)f(in)f(the)h(region)g(\014le)f(are)i(sp)s(eci\014ed)e(in)g(angular) +g(units)g(on)h(the)g(sky)0 2455 y(\(e.g.,)32 b(p)s(ositions)c(giv)m(en) +j(in)e(R.A.)h(and)g(Dec.)42 b(and)30 b(sizes)g(in)f(arcseconds)h(or)h +(arcmin)m(utes\).)40 b(Similarly)-8 b(,)27 b(eac)m(h)32 +b(ro)m(w)0 2568 y(of)h(the)h(\014ltered)e(table)h(will)d(ha)m(v)m(e)35 +b(a)e(celestial)g(co)s(ordinate)g(asso)s(ciated)g(with)f(it.)49 +b(This)31 b(asso)s(ciation)i(is)f(usually)0 2681 y(implemen)m(ted)37 +b(using)f(a)j(set)g(of)f(so-called)g('W)-8 b(orld)38 +b(Co)s(ordinate)g(System')g(\(or)h(W)m(CS\))f(FITS)g(k)m(eyw)m(ords)g +(that)0 2794 y(de\014ne)27 b(the)g(co)s(ordinate)g(transformation)g +(that)h(m)m(ust)f(b)s(e)f(applied)f(to)j(the)g(v)-5 b(alues)26 +b(in)g(the)i('X')g(and)e('Y')i(columns)0 2906 y(to)j(calculate)g(the)f +(co)s(ordinate.)0 3067 y(Alternativ)m(ely)-8 b(,)27 b(one)g(can)g(p)s +(erform)e(spatial)h(\014ltering)e(using)h(unitless)g('pixel')g(co)s +(ordinates)i(for)f(the)h(regions)f(and)0 3180 y(ro)m(w)33 +b(p)s(ositions.)47 b(In)33 b(this)f(case)i(the)f(user)g(m)m(ust)g(b)s +(e)f(careful)g(to)i(ensure)f(that)g(the)h(p)s(ositions)d(in)h(the)h(2)g +(\014les)g(are)0 3292 y(self-consisten)m(t.)52 b(A)34 +b(t)m(ypical)g(problem)e(is)h(that)i(the)f(region)g(\014le)f(ma)m(y)i +(b)s(e)e(generated)j(using)c(a)j(binned)c(image,)0 3405 +y(but)h(the)h(un)m(binned)d(co)s(ordinates)i(are)h(giv)m(en)g(in)e(the) +i(ev)m(en)m(t)i(table.)47 b(The)32 b(R)m(OSA)-8 b(T)33 +b(ev)m(en)m(ts)h(\014les,)f(for)f(example,)0 3518 y(ha)m(v)m(e)f(X)f +(and)f(Y)g(pixel)f(co)s(ordinates)h(that)i(range)f(from)f(1)h(-)g +(15360.)42 b(These)30 b(co)s(ordinates)f(are)h(t)m(ypically)e(binned)0 +3631 y(b)m(y)33 b(a)h(factor)g(of)f(32)h(to)g(pro)s(duce)e(a)i(480x480) +i(pixel)31 b(image.)50 b(If)32 b(one)i(then)f(uses)g(a)g(region)g +(\014le)f(generated)i(from)0 3744 y(this)29 b(image)i(\(in)f(image)g +(pixel)f(units\))h(to)h(\014lter)e(the)i(R)m(OSA)-8 b(T)30 +b(ev)m(en)m(ts)i(\014le,)e(then)g(the)h(X)g(and)f(Y)g(column)g(v)-5 +b(alues)0 3857 y(m)m(ust)30 b(b)s(e)g(con)m(v)m(erted)i(to)f(corresp)s +(onding)d(pixel)h(units)g(as)h(in:)382 4106 y Fe +(regfilter\("rosat.reg",)42 b(X/32.+.5,)j(Y/32.+.5\))0 +4354 y Fi(Note)h(that)f(this)e(binning)e(con)m(v)m(ersion)k(is)e(not)i +(necessary)g(if)e(the)i(region)f(\014le)f(is)h(sp)s(eci\014ed)e(using)h +(celestial)0 4467 y(co)s(ordinate)h(units)f(instead)g(of)h(pixel)f +(units)g(b)s(ecause)h(CFITSIO)e(is)i(then)f(able)h(to)h(directly)e +(compare)i(the)0 4580 y(celestial)27 b(co)s(ordinate)h(of)f(eac)m(h)i +(ro)m(w)f(in)e(the)i(table)f(with)g(the)g(celestial)h(co)s(ordinates)f +(in)f(the)i(region)f(\014le)g(without)0 4693 y(ha)m(ving)j(to)h(kno)m +(w)f(an)m(ything)g(ab)s(out)g(ho)m(w)h(the)f(image)h(ma)m(y)g(ha)m(v)m +(e)g(b)s(een)f(binned.)0 4853 y(The)f(last)g("w)m(cs)h(cols")g +(parameter)g(should)d(rarely)h(b)s(e)h(needed.)40 b(If)29 +b(supplied,)d(this)j(string)f(con)m(tains)i(the)f(names)0 +4966 y(of)37 b(the)g(2)h(columns)e(\(space)i(or)f(comma)g(separated\))h +(whic)m(h)e(ha)m(v)m(e)i(the)g(asso)s(ciated)f(W)m(CS)g(k)m(eyw)m +(ords.)61 b(If)37 b(not)0 5079 y(supplied,)d(the)i(\014lter)f(will)f +(scan)i(the)g(X)g(and)f(Y)h(expressions)f(for)h(column)e(names.)58 +b(If)35 b(only)g(one)i(is)e(found)f(in)0 5192 y(eac)m(h)e(expression,)d +(those)i(columns)e(will)f(b)s(e)h(used,)h(otherwise)g(an)g(error)g +(will)e(b)s(e)i(returned.)0 5352 y(These)g(region)g(shap)s(es)g(are)g +(supp)s(orted)f(\(names)h(are)h(case)h(insensitiv)m(e\):)334 +5601 y Fe(Point)428 b(\()48 b(X1,)f(Y1)g(\))715 b(<-)48 +b(One)f(pixel)f(square)g(region)334 5714 y(Line)476 b(\()48 +b(X1,)f(Y1,)g(X2,)f(Y2)i(\))333 b(<-)48 b(One)f(pixel)f(wide)h(region)p +eop +%%Page: 35 41 +35 40 bop 0 299 a Fg(4.9.)72 b(R)m(O)m(W)31 b(FIL)-8 +b(TERING)31 b(SPECIFICA)-8 b(TION)2072 b Fi(35)334 555 +y Fe(Polygon)332 b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2,)h(...)g(\))95 +b(<-)48 b(Rest)e(are)h(interiors)e(with)334 668 y(Rectangle)236 +b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2,)h(A)h(\))334 b(|)47 b(boundaries)e +(considered)334 781 y(Box)524 b(\()48 b(Xc,)f(Yc,)g(Wdth,)f(Hght,)g(A)i +(\))143 b(V)47 b(within)f(the)h(region)334 894 y(Diamond)332 +b(\()48 b(Xc,)f(Yc,)g(Wdth,)f(Hght,)g(A)i(\))334 1007 +y(Circle)380 b(\()48 b(Xc,)f(Yc,)g(R)g(\))334 1120 y(Annulus)332 +b(\()48 b(Xc,)f(Yc,)g(Rin,)f(Rout)h(\))334 1233 y(Ellipse)332 +b(\()48 b(Xc,)f(Yc,)g(Rx,)f(Ry,)h(A)h(\))334 1346 y(Elliptannulus)c(\() +k(Xc,)f(Yc,)g(Rinx,)f(Riny,)g(Routx,)g(Routy,)g(Ain,)h(Aout)g(\))334 +1458 y(Sector)380 b(\()48 b(Xc,)f(Yc,)g(Amin,)f(Amax)h(\))0 +1732 y Fi(where)28 b(\(Xc,Yc\))j(is)c(the)i(co)s(ordinate)g(of)f(the)h +(shap)s(e's)f(cen)m(ter;)j(\(X#,Y#\))e(are)g(the)g(co)s(ordinates)f(of) +h(the)g(shap)s(e's)0 1845 y(edges;)39 b(Rxxx)c(are)g(the)h(shap)s(es')f +(v)-5 b(arious)34 b(Radii)g(or)h(semima)5 b(jor/minor)34 +b(axes;)k(and)d(Axxx)g(are)h(the)g(angles)f(of)0 1958 +y(rotation)d(\(or)f(b)s(ounding)e(angles)i(for)g(Sector\))h(in)e +(degrees.)44 b(F)-8 b(or)32 b(rotated)h(shap)s(es,)e(the)g(rotation)h +(angle)f(can)h(b)s(e)0 2071 y(left)f(o\013,)i(indicating)c(no)i +(rotation.)45 b(Common)31 b(alternate)h(names)f(for)h(the)f(regions)g +(can)h(also)g(b)s(e)e(used:)43 b(rotb)s(o)m(x)0 2184 +y(=)29 b(b)s(o)m(x;)g(rotrectangle)h(=)f(rectangle;)h(\(rot\)rhom)m +(bus)f(=)f(\(rot\)diamond;)i(and)e(pie)g(=)g(sector.)42 +b(When)28 b(a)i(shap)s(e's)0 2297 y(name)e(is)f(preceded)g(b)m(y)h(a)g +(min)m(us)f(sign,)g('-',)j(the)e(de\014ned)e(region)i(is)f(instead)g +(the)h(area)h(*outside*)f(its)f(b)s(oundary)0 2410 y(\(ie,)35 +b(the)f(region)g(is)f(in)m(v)m(erted\).)52 b(All)32 b(the)i(shap)s(es)f +(within)f(a)i(single)f(region)g(\014le)h(are)g(OR'd)f(together)j(to)e +(create)0 2523 y(the)29 b(region,)h(and)e(the)i(order)f(is)f +(signi\014can)m(t.)39 b(The)29 b(o)m(v)m(erall)g(w)m(a)m(y)i(of)e(lo)s +(oking)f(at)i(region)f(\014les)f(is)g(that)i(if)e(the)i(\014rst)0 +2636 y(region)e(is)g(an)h(excluded)f(region)g(then)g(a)i(dumm)m(y)d +(included)f(region)j(of)g(the)g(whole)f(detector)i(is)e(inserted)f(in)h +(the)0 2749 y(fron)m(t.)40 b(Then)25 b(eac)m(h)j(region)e(sp)s +(eci\014cation)g(as)h(it)f(is)g(pro)s(cessed)g(o)m(v)m(errides)g(an)m +(y)h(selections)g(inside)d(of)j(that)g(region)0 2861 +y(sp)s(eci\014ed)35 b(b)m(y)h(previous)f(regions.)58 +b(Another)37 b(w)m(a)m(y)g(of)g(thinking)d(ab)s(out)i(this)f(is)h(that) +h(if)e(a)i(previous)e(excluded)0 2974 y(region)30 b(is)f(completely)h +(inside)f(of)h(a)h(subsequen)m(t)e(included)f(region)i(the)h(excluded)e +(region)h(is)f(ignored.)0 3135 y(The)44 b(p)s(ositional)f(co)s +(ordinates)i(ma)m(y)g(b)s(e)g(giv)m(en)g(either)f(in)g(pixel)f(units,)k +(decimal)d(degrees)i(or)f(hh:mm:ss.s,)0 3247 y(dd:mm:ss.s)25 +b(units.)37 b(The)26 b(shap)s(e)f(sizes)h(ma)m(y)g(b)s(e)g(giv)m(en)g +(in)e(pixels,)i(degrees,)h(arcmin)m(utes,)g(or)f(arcseconds.)40 +b(Lo)s(ok)0 3360 y(at)31 b(examples)f(of)g(region)g(\014le)g(pro)s +(duced)e(b)m(y)i(fv/PO)m(W)h(or)g(ds9)f(for)g(further)f(details)g(of)i +(the)f(region)g(\014le)f(format.)0 3521 y(There)37 b(are)g(three)g +(functions)f(that)h(are)h(primarily)c(for)i(use)h(with)f(SA)m(O)h +(region)f(\014les)g(and)h(the)g(FSA)m(OI)g(task,)0 3633 +y(but)e(they)h(can)h(b)s(e)e(used)g(directly)-8 b(.)57 +b(They)36 b(return)f(a)h(b)s(o)s(olean)f(true)h(or)g(false)f(dep)s +(ending)f(on)i(whether)f(a)i(t)m(w)m(o)0 3746 y(dimensional)28 +b(p)s(oin)m(t)h(is)g(in)g(the)i(region)f(or)g(not:)191 +4020 y Fe("point)46 b(in)h(a)h(circular)d(region")477 +4133 y(circle\(xcntr,ycntr,radius)o(,Xco)o(lumn)o(,Yc)o(olum)o(n\))191 +4359 y("point)h(in)h(an)g(elliptical)e(region")430 4472 +y(ellipse\(xcntr,ycntr,xhl)o(f_w)o(dth,)o(yhlf)o(_wd)o(th,r)o(otat)o +(ion)o(,Xco)o(lumn)o(,Yc)o(olum)o(n\))191 4698 y("point)h(in)h(a)h +(rectangular)c(region")620 4811 y(box\(xcntr,ycntr,xfll_wdth,)o(yfll)o +(_wd)o(th,r)o(otat)o(ion)o(,Xco)o(lumn)o(,Yc)o(olum)o(n\))191 +5036 y(where)334 5149 y(\(xcntr,ycntr\))g(are)j(the)g(\(x,y\))f +(position)g(of)h(the)g(center)f(of)h(the)g(region)334 +5262 y(\(xhlf_wdth,yhlf_wdth\))42 b(are)47 b(the)g(\(x,y\))f(half)h +(widths)f(of)h(the)g(region)334 5375 y(\(xfll_wdth,yfll_wdth\))42 +b(are)47 b(the)g(\(x,y\))f(full)h(widths)f(of)h(the)g(region)334 +5488 y(\(radius\))f(is)h(half)f(the)h(diameter)f(of)h(the)g(circle)334 +5601 y(\(rotation\))e(is)i(the)g(angle\(degrees\))d(that)j(the)g +(region)f(is)h(rotated)f(with)620 5714 y(respect)g(to)h +(\(xcntr,ycntr\))p eop +%%Page: 36 42 +36 41 bop 0 299 a Fi(36)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)334 555 y +Fe(\(Xcoord,Ycoord\))44 b(are)j(the)g(\(x,y\))f(coordinates)f(to)i +(test,)f(usually)g(column)620 668 y(names)334 781 y(NOTE:)g(each)h +(parameter)e(can)i(itself)f(be)i(an)f(expression,)d(not)j(merely)f(a) +620 894 y(column)h(name)f(or)h(constant.)0 1201 y Fb(4.9.6)112 +b(Example)37 b(Ro)m(w)g(Filters)191 1423 y Fe([)47 b(binary)f(&&)i(mag) +f(<=)g(5.0])380 b(-)48 b(Extract)e(all)h(binary)f(stars)g(brighter)1766 +1536 y(than)94 b(fifth)47 b(magnitude)e(\(note)h(that)1766 +1649 y(the)h(initial)f(space)g(is)h(necessary)e(to)1766 +1762 y(prevent)h(it)h(from)g(being)f(treated)g(as)h(a)1766 +1875 y(binning)f(specification\))191 2101 y([#row)g(>=)h(125)g(&&)h +(#row)e(<=)h(175])142 b(-)48 b(Extract)e(row)h(numbers)e(125)i(through) +f(175)191 2327 y([IMAGE[4,5])f(.gt.)h(100])476 b(-)48 +b(Extract)e(all)h(rows)f(that)h(have)g(the)1766 2439 +y(\(4,5\))f(component)g(of)h(the)g(IMAGE)f(column)1766 +2552 y(greater)g(than)g(100)191 2778 y([abs\(sin\(theta)e(*)j(#deg\)\)) +f(<)i(0.5])e(-)i(Extract)e(all)h(rows)f(having)g(the)1766 +2891 y(absolute)f(value)i(of)g(the)g(sine)g(of)g(theta)1766 +3004 y(less)94 b(than)47 b(a)g(half)g(where)f(the)h(angles)1766 +3117 y(are)g(tabulated)e(in)i(degrees)191 3343 y([SUM\()f(SPEC)h(>)g +(3*BACKGRND)e(\)>=1])94 b(-)48 b(Extract)e(all)h(rows)f(containing)f(a) +1766 3456 y(spectrum,)g(held)i(in)g(vector)f(column)1766 +3569 y(SPEC,)g(with)h(at)g(least)f(one)h(value)g(3)1766 +3681 y(times)f(greater)g(than)h(the)g(background)1766 +3794 y(level)f(held)h(in)g(a)h(keyword,)d(BACKGRND)191 +4020 y([VCOL=={1,4,2}])759 b(-)48 b(Extract)e(all)h(rows)f(whose)h +(vector)f(column)1766 4133 y(VCOL)h(contains)e(the)i(3-elements)e(1,)i +(4,)g(and)1766 4246 y(2.)191 4472 y([@rowFilter.txt])711 +b(-)48 b(Extract)e(rows)g(using)h(the)g(expression)1766 +4585 y(contained)e(within)h(the)h(text)g(file)1766 4698 +y(rowFilter.txt)191 4924 y([gtifilter\(\)])855 b(-)48 +b(Search)e(the)h(current)f(file)g(for)h(a)h(GTI)239 5036 +y(extension,)92 b(filter)i(the)47 b(TIME)239 5149 y(column)f(in)h(the)g +(current)f(table,)g(using)239 5262 y(START/STOP)f(times)h(taken)g(from) +239 5375 y(columns)f(in)j(the)f(GTI)94 b(extension)191 +5601 y([regfilter\("pow.reg"\)])423 b(-)48 b(Extract)e(rows)g(which)h +(have)f(a)i(coordinate)1766 5714 y(\(as)f(given)f(in)h(the)g(X)h(and)f +(Y)g(columns\))p eop +%%Page: 37 43 +37 42 bop 0 299 a Fg(4.10.)113 b(BINNING)31 b(OR)f(HISTOGRAMMING)h +(SPECIFICA)-8 b(TION)1313 b Fi(37)1766 555 y Fe(within)46 +b(the)h(spatial)f(region)g(specified)1766 668 y(in)h(the)g(pow.reg)f +(region)g(file.)191 894 y([regfilter\("pow.reg",)c(Xs,)47 +b(Ys\)])f(-)i(Same)f(as)g(above,)f(except)g(that)h(the)1766 +1007 y(Xs)g(and)g(Ys)g(columns)f(will)h(be)g(used)f(to)1766 +1120 y(determine)f(the)i(coordinate)e(of)i(each)1766 +1233 y(row)g(in)g(the)g(table.)0 1560 y Fd(4.10)180 b(Binning)45 +b(or)g(Histogramming)i(Sp)t(eci\014cation)0 1810 y Fi(The)22 +b(optional)g(binning)e(sp)s(eci\014er)h(is)h(enclosed)h(in)f(square)g +(brac)m(k)m(ets)j(and)d(can)h(b)s(e)f(distinguished)d(from)k(a)g +(general)0 1923 y(ro)m(w)32 b(\014lter)g(sp)s(eci\014cation)f(b)m(y)h +(the)h(fact)g(that)g(it)f(b)s(egins)f(with)g(the)h(k)m(eyw)m(ord)h +('bin')e(not)i(immediately)d(follo)m(w)m(ed)0 2036 y(b)m(y)41 +b(an)f(equals)h(sign.)71 b(When)41 b(binning)c(is)j(sp)s(eci\014ed,)i +(a)f(temp)s(orary)g(N-dimensional)d(FITS)i(primary)f(arra)m(y)0 +2149 y(is)j(created)i(b)m(y)f(computing)g(the)g(histogram)g(of)g(the)g +(v)-5 b(alues)43 b(in)e(the)j(sp)s(eci\014ed)d(columns)h(of)h(a)h(FITS) +e(table)0 2262 y(extension.)e(After)30 b(the)f(histogram)g(is)g +(computed)g(the)h(input)d(FITS)i(\014le)g(con)m(taining)g(the)g(table)h +(is)e(then)h(closed)0 2375 y(and)34 b(the)h(temp)s(orary)f(FITS)g +(primary)f(arra)m(y)i(is)f(op)s(ened)g(and)g(passed)g(to)h(the)g +(application)e(program.)54 b(Th)m(us,)0 2488 y(the)39 +b(application)e(program)i(nev)m(er)g(sees)g(the)g(original)e(FITS)h +(table)h(and)f(only)g(sees)i(the)f(image)g(in)e(the)i(new)0 +2601 y(temp)s(orary)32 b(\014le)g(\(whic)m(h)g(has)g(no)h(additional)d +(extensions\).)48 b(Ob)m(viously)-8 b(,)32 b(the)h(application)e +(program)h(m)m(ust)h(b)s(e)0 2714 y(exp)s(ecting)d(to)h(op)s(en)f(a)h +(FITS)e(image)i(and)f(not)g(a)h(FITS)f(table)g(in)f(this)g(case.)0 +2874 y(The)h(data)h(t)m(yp)s(e)f(of)h(the)f(FITS)g(histogram)f(image)i +(ma)m(y)g(b)s(e)f(sp)s(eci\014ed)e(b)m(y)i(app)s(ending)e('b')i(\(for)h +(8-bit)f(b)m(yte\),)h('i')0 2987 y(\(for)g(16-bit)f(in)m(tegers\),)h +('j')g(\(for)g(32-bit)f(in)m(teger\),)i('r')e(\(for)h(32-bit)f +(\015oating)h(p)s(oin)m(ts\),)e(or)i('d')f(\(for)h(64-bit)f(double)0 +3100 y(precision)c(\015oating)i(p)s(oin)m(t\))g(to)g(the)h('bin')d(k)m +(eyw)m(ord)j(\(e.g.)41 b('[binr)27 b(X]')h(creates)i(a)e(real)g +(\015oating)g(p)s(oin)m(t)f(image\).)40 b(If)0 3212 y(the)26 +b(datat)m(yp)s(e)h(is)e(not)h(explicitly)e(sp)s(eci\014ed)g(then)i(a)g +(32-bit)g(in)m(teger)h(image)f(will)d(b)s(e)i(created)i(b)m(y)f +(default,)h(unless)0 3325 y(the)i(w)m(eigh)m(ting)f(option)g(is)g(also) +h(sp)s(eci\014ed)e(in)g(whic)m(h)h(case)h(the)g(image)g(will)d(ha)m(v)m +(e)k(a)f(32-bit)g(\015oating)g(p)s(oin)m(t)e(data)0 3438 +y(t)m(yp)s(e)k(b)m(y)f(default.)0 3598 y(The)24 b(histogram)f(image)i +(ma)m(y)g(ha)m(v)m(e)g(from)f(1)g(to)h(4)g(dimensions)c(\(axes\),)27 +b(dep)s(ending)22 b(on)i(the)g(n)m(um)m(b)s(er)f(of)h(columns)0 +3711 y(that)31 b(are)g(sp)s(eci\014ed.)39 b(The)30 b(general)g(form)g +(of)g(the)h(binning)c(sp)s(eci\014cation)i(is:)48 3931 +y Fe([bin{bijrd})92 b(Xcol=min:max:binsize,)42 b(Ycol=)47 +b(...,)f(Zcol=...,)f(Tcol=...;)h(weight])0 4152 y Fi(in)38 +b(whic)m(h)g(up)g(to)i(4)g(columns,)g(eac)m(h)g(corresp)s(onding)d(to)j +(an)g(axis)e(of)i(the)f(image,)j(are)e(listed.)65 b(The)39 +b(column)0 4264 y(names)27 b(are)h(case)h(insensitiv)m(e,)d(and)h(the)h +(column)e(n)m(um)m(b)s(er)g(ma)m(y)i(b)s(e)f(giv)m(en)g(instead)g(of)h +(the)g(name,)g(preceded)f(b)m(y)0 4377 y(a)32 b(p)s(ound)e(sign)h +(\(e.g.,)j([bin)c(#4=1:512]\).)47 b(If)31 b(the)h(column)f(name)h(is)e +(not)i(sp)s(eci\014ed,)f(then)g(CFITSIO)g(will)e(\014rst)0 +4490 y(try)37 b(to)h(use)f(the)g('preferred)f(column')h(as)g(sp)s +(eci\014ed)f(b)m(y)h(the)g(CPREF)g(k)m(eyw)m(ord)h(if)e(it)g(exists)h +(\(e.g.,)k('CPREF)0 4603 y(=)i('DETX,DETY'\),)h(otherwise)f(column)f +(names)h('X',)h('Y',)g('Z',)f(and)f('T')i(will)c(b)s(e)i(assumed)h(for) +g(eac)m(h)h(of)0 4716 y(the)37 b(4)h(axes,)i(resp)s(ectiv)m(ely)-8 +b(.)60 b(In)37 b(cases)h(where)e(the)i(column)e(name)h(could)f(b)s(e)g +(confused)h(with)f(an)h(arithmetic)0 4829 y(expression,)29 +b(enclose)i(the)g(column)e(name)h(in)f(paren)m(theses)i(to)g(force)g +(the)f(name)h(to)g(b)s(e)f(in)m(terpreted)f(literally)-8 +b(.)0 4989 y(Eac)m(h)33 b(column)e(name)h(ma)m(y)h(b)s(e)f(follo)m(w)m +(ed)f(b)m(y)i(an)f(equals)f(sign)h(and)f(then)h(the)g(lo)m(w)m(er)h +(and)f(upp)s(er)e(range)i(of)h(the)0 5102 y(histogram,)e(and)f(the)h +(size)g(of)g(the)g(histogram)g(bins,)e(separated)i(b)m(y)g(colons.)42 +b(Spaces)31 b(are)g(allo)m(w)m(ed)g(b)s(efore)g(and)0 +5215 y(after)e(the)g(equals)f(sign)f(but)h(not)h(within)d(the)j +('min:max:binsize')d(string.)39 b(The)29 b(min,)e(max)i(and)f(binsize)f +(v)-5 b(alues)0 5328 y(ma)m(y)32 b(b)s(e)e(in)m(teger)h(or)g +(\015oating)g(p)s(oin)m(t)f(n)m(um)m(b)s(ers,)g(or)h(they)g(ma)m(y)g(b) +s(e)g(the)g(names)g(of)g(k)m(eyw)m(ords)g(in)f(the)h(header)g(of)0 +5441 y(the)g(table.)40 b(If)30 b(the)h(latter,)g(then)f(the)g(v)-5 +b(alue)30 b(of)h(that)g(k)m(eyw)m(ord)f(is)g(substituted)f(in)m(to)h +(the)h(expression.)0 5601 y(Default)36 b(v)-5 b(alues)35 +b(for)h(the)g(min,)g(max)g(and)g(binsize)e(quan)m(tities)h(will)e(b)s +(e)i(used)h(if)e(not)j(explicitly)c(giv)m(en)j(in)f(the)0 +5714 y(binning)27 b(expression)i(as)i(sho)m(wn)f(in)f(these)i +(examples:)p eop +%%Page: 38 44 +38 43 bop 0 299 a Fi(38)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)191 555 y +Fe([bin)47 b(x)g(=)g(:512:2])94 b(-)47 b(use)g(default)f(minimum)g +(value)191 668 y([bin)h(x)g(=)g(1::2])190 b(-)47 b(use)g(default)f +(maximum)g(value)191 781 y([bin)h(x)g(=)g(1:512])142 +b(-)47 b(use)g(default)f(bin)h(size)191 894 y([bin)g(x)g(=)g(1:])286 +b(-)47 b(use)g(default)f(maximum)g(value)g(and)h(bin)g(size)191 +1007 y([bin)g(x)g(=)g(:512])190 b(-)47 b(use)g(default)f(minimum)g +(value)g(and)h(bin)g(size)191 1120 y([bin)g(x)g(=)g(2])334 +b(-)47 b(use)g(default)f(minimum)g(and)h(maximum)f(values)191 +1233 y([bin)h(x])524 b(-)47 b(use)g(default)f(minimum,)g(maximum)g(and) +g(bin)h(size)191 1346 y([bin)g(4])524 b(-)47 b(default)f(2-D)h(image,)f +(bin)h(size)g(=)g(4)h(in)f(both)g(axes)191 1458 y([bin])619 +b(-)47 b(default)f(2-D)h(image)0 1713 y Fi(CFITSIO)31 +b(will)f(use)i(the)h(v)-5 b(alue)32 b(of)h(the)g(TLMINn,)f(TLMAXn,)h +(and)f(TDBINn)h(k)m(eyw)m(ords,)h(if)d(they)i(exist,)g(for)0 +1826 y(the)k(default)e(min,)i(max,)h(and)e(binsize,)g(resp)s(ectiv)m +(ely)-8 b(.)59 b(If)36 b(they)h(do)f(not)h(exist)f(then)g(CFITSIO)f +(will)f(use)i(the)0 1939 y(actual)c(minim)m(um)d(and)j(maxim)m(um)f(v) +-5 b(alues)31 b(in)g(the)h(column)e(for)i(the)g(histogram)g(min)e(and)i +(max)g(v)-5 b(alues.)44 b(The)0 2052 y(default)33 b(binsize)e(will)g(b) +s(e)i(set)h(to)h(1,)g(or)e(\(max)h(-)g(min\))e(/)i(10.,)i(whic)m(hev)m +(er)d(is)g(smaller,)g(so)g(that)i(the)e(histogram)0 2165 +y(will)28 b(ha)m(v)m(e)j(at)g(least)g(10)g(bins)e(along)h(eac)m(h)i +(axis.)0 2325 y(A)41 b(shortcut)g(notation)g(is)f(allo)m(w)m(ed)h(if)f +(all)g(the)h(columns/axes)g(ha)m(v)m(e)h(the)f(same)g(binning)d(sp)s +(eci\014cation.)72 b(In)0 2438 y(this)32 b(case)h(all)f(the)h(column)e +(names)i(ma)m(y)g(b)s(e)f(listed)f(within)f(paren)m(theses,)k(follo)m +(w)m(ed)f(b)m(y)f(the)h(\(single\))f(binning)0 2551 y(sp)s +(eci\014cation,)d(as)i(in:)191 2805 y Fe([bin)47 b(\(X,Y\)=1:512:2])191 +2918 y([bin)g(\(X,Y\))f(=)h(5])0 3172 y Fi(The)31 b(optional)g(w)m +(eigh)m(ting)h(factor)g(is)f(the)h(last)f(item)h(in)e(the)i(binning)d +(sp)s(eci\014er)h(and,)i(if)e(presen)m(t,)j(is)d(separated)0 +3285 y(from)38 b(the)g(list)f(of)h(columns)f(b)m(y)h(a)h(semi-colon.)63 +b(As)39 b(the)f(histogram)g(is)f(accum)m(ulated,)k(this)c(w)m(eigh)m(t) +i(is)e(used)0 3398 y(to)e(incremen)m(ted)e(the)h(v)-5 +b(alue)34 b(of)g(the)g(appropriated)e(bin)h(in)f(the)i(histogram.)51 +b(If)34 b(the)g(w)m(eigh)m(ting)g(factor)h(is)e(not)0 +3511 y(sp)s(eci\014ed,)23 b(then)g(the)g(default)f(w)m(eigh)m(t)i(=)e +(1)i(is)e(assumed.)37 b(The)23 b(w)m(eigh)m(ting)g(factor)h(ma)m(y)f(b) +s(e)g(a)g(constan)m(t)i(in)m(teger)e(or)0 3624 y(\015oating)29 +b(p)s(oin)m(t)f(n)m(um)m(b)s(er,)g(or)h(the)g(name)g(of)g(a)g(k)m(eyw)m +(ord)h(con)m(taining)e(the)i(w)m(eigh)m(ting)e(v)-5 b(alue.)40 +b(Or)28 b(the)h(w)m(eigh)m(ting)0 3737 y(factor)g(ma)m(y)g(b)s(e)e(the) +h(name)g(of)h(a)f(table)g(column)f(in)g(whic)m(h)f(case)k(the)e(v)-5 +b(alue)27 b(in)g(that)i(column,)e(on)h(a)h(ro)m(w)f(b)m(y)g(ro)m(w)0 +3850 y(basis,)h(will)f(b)s(e)i(used.)0 4010 y(In)35 b(some)h(cases,)i +(the)d(column)g(or)g(k)m(eyw)m(ord)h(ma)m(y)g(giv)m(e)g(the)g(recipro)s +(cal)e(of)i(the)g(actual)g(w)m(eigh)m(t)g(v)-5 b(alue)35 +b(that)h(is)0 4123 y(needed.)49 b(In)32 b(this)g(case,)j(precede)e(the) +h(w)m(eigh)m(t)f(k)m(eyw)m(ord)h(or)f(column)f(name)h(b)m(y)g(a)g +(slash)f('/')i(to)g(tell)e(CFITSIO)0 4236 y(to)f(use)f(the)h(recipro)s +(cal)e(of)h(the)h(v)-5 b(alue)30 b(when)f(constructing)h(the)h +(histogram.)0 4396 y(F)-8 b(or)35 b(complex)e(or)h(commonly)f(used)g +(histograms,)i(one)f(can)g(also)g(place)g(its)f(description)f(in)m(to)i +(a)g(text)h(\014le)e(and)0 4509 y(imp)s(ort)43 b(it)g(in)m(to)i(the)f +(binning)d(sp)s(eci\014cation)i(using)g(the)i(syn)m(tax)f('[bin)f +(@\014lename.txt]'.)83 b(The)44 b(\014le's)f(con-)0 4622 +y(ten)m(ts)37 b(can)e(extend)h(o)m(v)m(er)h(m)m(ultiple)c(lines,)j +(although)f(it)g(m)m(ust)g(still)f(conform)i(to)g(the)g(no-spaces)g +(rule)e(for)i(the)0 4735 y(min:max:binsize)e(syn)m(tax)k(and)e(eac)m(h) +i(axis)f(sp)s(eci\014cation)f(m)m(ust)h(still)d(b)s(e)j +(comma-separated.)62 b(An)m(y)37 b(lines)e(in)0 4848 +y(the)d(external)g(text)h(\014le)e(that)i(b)s(egin)d(with)h(2)h(slash)f +(c)m(haracters)i(\('//'\))h(will)29 b(b)s(e)j(ignored)f(and)g(ma)m(y)i +(b)s(e)e(used)g(to)0 4961 y(add)f(commen)m(ts)h(in)m(to)f(the)h +(\014le.)0 5121 y(Examples:)191 5375 y Fe([bini)46 b(detx,)h(dety])762 +b(-)47 b(2-D,)g(16-bit)f(integer)g(histogram)1861 5488 +y(of)i(DETX)e(and)h(DETY)g(columns,)e(using)1861 5601 +y(default)h(values)g(for)h(the)g(histogram)1861 5714 +y(range)g(and)g(binsize)p eop +%%Page: 39 45 +39 44 bop 0 299 a Fg(4.10.)113 b(BINNING)31 b(OR)f(HISTOGRAMMING)h +(SPECIFICA)-8 b(TION)1313 b Fi(39)191 668 y Fe([bin)47 +b(\(detx,)f(dety\)=16;)f(/exposure])g(-)i(2-D,)g(32-bit)f(real)h +(histogram)e(of)i(DETX)1861 781 y(and)g(DETY)g(columns)f(with)g(a)i +(bin)f(size)f(=)i(16)1861 894 y(in)g(both)e(axes.)h(The)f(histogram)g +(values)1861 1007 y(are)h(divided)f(by)h(the)g(EXPOSURE)f(keyword)1861 +1120 y(value.)191 1346 y([bin)h(time=TSTART:TSTOP:0.1])280 +b(-)47 b(1-D)g(lightcurve,)e(range)h(determined)f(by)1861 +1458 y(the)i(TSTART)f(and)h(TSTOP)g(keywords,)1861 1571 +y(with)g(0.1)g(unit)g(size)f(bins.)191 1797 y([bin)h(pha,)f +(time=8000.:8100.:0.1])90 b(-)47 b(2-D)g(image)g(using)f(default)g +(binning)1861 1910 y(of)i(the)e(PHA)h(column)f(for)h(the)g(X)h(axis,) +1861 2023 y(and)f(1000)g(bins)g(in)g(the)g(range)1861 +2136 y(8000.)g(to)g(8100.)f(for)h(the)g(Y)h(axis.)191 +2362 y([bin)f(@binFilter.txt])616 b(-)47 b(Use)g(the)g(contents)f(of)h +(the)g(text)f(file)1861 2475 y(binFilter.txt)f(for)h(the)h(binning)1861 +2588 y(specifications.)p eop +%%Page: 40 46 +40 45 bop 0 299 a Fi(40)1618 b Fg(CHAPTER)30 b(4.)112 +b(EXTENDED)30 b(FILE)h(NAME)f(SYNT)-8 b(AX)p eop +%%Page: 41 47 +41 46 bop 0 1225 a Ff(Chapter)65 b(5)0 1687 y Fl(T)-19 +b(emplate)76 b(Files)0 2180 y Fi(When)38 b(a)h(new)f(FITS)g(\014le)g +(is)g(created)h(with)f(a)g(call)g(to)i(\014ts)p 2101 +2180 28 4 v 32 w(create)p 2369 2180 V 35 w(\014le,)f(the)g(name)g(of)g +(a)g(template)g(\014le)e(ma)m(y)0 2293 y(b)s(e)i(supplied)e(in)i(paren) +m(theses)h(immediately)e(follo)m(wing)g(the)j(name)f(of)g(the)g(new)f +(\014le)g(to)i(b)s(e)e(created.)71 b(This)0 2406 y(template)26 +b(is)e(used)h(to)h(de\014ne)f(the)h(structure)f(of)h(one)f(or)h(more)g +(HDUs)g(in)e(the)i(new)f(\014le.)38 b(The)25 b(template)h(\014le)e(ma)m +(y)0 2518 y(b)s(e)32 b(another)h(FITS)f(\014le,)h(in)f(whic)m(h)f(case) +j(the)f(newly)f(created)i(\014le)e(will)e(ha)m(v)m(e)k(exactly)g(the)f +(same)g(k)m(eyw)m(ords)g(in)0 2631 y(eac)m(h)25 b(HDU)g(as)g(in)e(the)h +(template)h(FITS)e(\014le,)i(but)e(all)h(the)g(data)h(units)d(will)g(b) +s(e)i(\014lled)e(with)g(zeros.)40 b(The)24 b(template)0 +2744 y(\014le)h(ma)m(y)i(also)f(b)s(e)f(an)h(ASCI)s(I)e(text)j(\014le,) +f(where)g(eac)m(h)h(line)d(\(in)h(general\))i(describ)s(es)d(one)i +(FITS)f(k)m(eyw)m(ord)i(record.)0 2857 y(The)j(format)h(of)f(the)h +(ASCI)s(I)e(template)h(\014le)g(is)f(describ)s(ed)f(in)i(the)g(follo)m +(wing)f(sections.)0 3188 y Fd(5.1)135 b(Detailed)47 b(T)-11 +b(emplate)46 b(Line)f(F)-11 b(ormat)0 3438 y Fi(The)30 +b(format)h(of)f(eac)m(h)i(ASCI)s(I)c(template)j(line)e(closely)h(follo) +m(ws)f(the)i(format)g(of)f(a)h(FITS)f(k)m(eyw)m(ord)g(record:)95 +3682 y Fe(KEYWORD)46 b(=)i(KEYVALUE)d(/)j(COMMENT)0 3926 +y Fi(except)22 b(that)g(free)g(format)f(ma)m(y)h(b)s(e)f(used)f +(\(e.g.,)25 b(the)d(equals)e(sign)h(ma)m(y)g(app)s(ear)g(at)h(an)m(y)g +(p)s(osition)d(in)h(the)i(line\))e(and)0 4039 y(T)-8 +b(AB)34 b(c)m(haracters)g(are)g(allo)m(w)m(ed)f(and)g(are)g(treated)h +(the)g(same)f(as)h(space)f(c)m(haracters.)51 b(The)33 +b(KEYV)-10 b(ALUE)33 b(and)0 4152 y(COMMENT)d(\014elds)f(are)i +(optional.)41 b(The)30 b(equals)g(sign)f(c)m(haracter)k(is)c(also)i +(optional,)f(but)g(it)g(is)f(recommended)0 4264 y(that)42 +b(it)e(b)s(e)h(included)d(for)j(clarit)m(y)-8 b(.)73 +b(An)m(y)41 b(template)h(line)d(that)j(b)s(egins)e(with)f(the)j(p)s +(ound)d('#')i(c)m(haracter)i(is)0 4377 y(ignored)29 b(b)m(y)i(the)f +(template)h(parser)f(and)g(ma)m(y)h(b)s(e)e(use)h(to)h(insert)f(commen) +m(ts)h(in)m(to)f(the)h(template)g(\014le)e(itself.)0 +4538 y(The)d(KEYW)m(ORD)g(name)g(\014eld)f(is)g(limited)f(to)j(8)f(c)m +(haracters)h(in)e(length)h(and)f(only)g(the)h(letters)h(A-Z,)f(digits)f +(0-9,)0 4650 y(and)j(the)g(h)m(yphen)f(and)h(underscore)g(c)m +(haracters)h(ma)m(y)g(b)s(e)f(used,)g(without)g(an)m(y)g(em)m(b)s +(edded)g(spaces.)40 b(Lo)m(w)m(ercase)0 4763 y(letters)21 +b(in)f(the)i(template)f(k)m(eyw)m(ord)h(name)f(will)d(b)s(e)j(con)m(v)m +(erted)i(to)f(upp)s(ercase.)36 b(Leading)21 b(spaces)g(in)f(the)i +(template)0 4876 y(line)i(preceding)h(the)g(k)m(eyw)m(ord)h(name)g(are) +g(generally)f(ignored,)h(except)g(if)f(the)h(\014rst)f(8)h(c)m +(haracters)h(of)f(a)g(template)0 4989 y(line)d(are)j(all)e(blank,)h +(then)g(the)g(en)m(tire)g(line)f(is)g(treated)i(as)f(a)h(FITS)e(commen) +m(t)i(k)m(eyw)m(ord)g(\(with)e(a)i(blank)d(k)m(eyw)m(ord)0 +5102 y(name\))31 b(and)f(is)f(copied)h(v)m(erbatim)g(in)m(to)g(the)h +(FITS)e(header.)0 5262 y(The)37 b(KEYV)-10 b(ALUE)37 +b(\014eld)f(ma)m(y)i(ha)m(v)m(e)g(an)m(y)g(allo)m(w)m(ed)f(FITS)g(data) +h(t)m(yp)s(e:)54 b(c)m(haracter)39 b(string,)g(logical,)f(in)m(teger,)0 +5375 y(real,)33 b(complex)f(in)m(teger,)i(or)e(complex)h(real.)46 +b(The)32 b(c)m(haracter)j(string)c(v)-5 b(alues)32 b(need)g(not)h(b)s +(e)f(enclosed)g(in)f(single)0 5488 y(quote)e(c)m(haracters)h(unless)d +(they)h(are)h(necessary)g(to)g(distinguish)24 b(the)29 +b(string)e(from)h(a)h(di\013eren)m(t)f(data)h(t)m(yp)s(e)f(\(e.g.)0 +5601 y(2.0)h(is)d(a)i(real)g(but)f('2.0')i(is)e(a)h(string\).)39 +b(The)27 b(k)m(eyw)m(ord)h(has)f(an)h(unde\014ned)d(\(n)m(ull\))h(v)-5 +b(alue)28 b(if)e(the)i(template)g(record)0 5714 y(only)h(con)m(tains)i +(blanks)e(follo)m(wing)g(the)h("=")h(or)g(b)s(et)m(w)m(een)g(the)f("=") +h(and)f(the)g("/")i(commen)m(t)g(\014eld)c(delimiter.)1905 +5942 y(41)p eop +%%Page: 42 48 +42 47 bop 0 299 a Fi(42)2340 b Fg(CHAPTER)30 b(5.)71 +b(TEMPLA)-8 b(TE)30 b(FILES)0 555 y Fi(String)25 b(k)m(eyw)m(ord)i(v)-5 +b(alues)26 b(longer)g(than)g(68)h(c)m(haracters)h(\(the)f(maxim)m(um)e +(length)h(that)h(will)d(\014t)i(in)f(a)i(single)e(FITS)0 +668 y(k)m(eyw)m(ord)41 b(record\))g(are)g(p)s(ermitted)e(using)g(the)i +(CFITSIO)e(long)h(string)g(con)m(v)m(en)m(tion.)73 b(They)40 +b(can)h(either)f(b)s(e)0 781 y(sp)s(eci\014ed)27 b(as)j(a)f(single)f +(long)g(line)g(in)f(the)j(template,)g(or)f(b)m(y)f(using)g(m)m(ultiple) +f(lines)g(where)h(the)i(con)m(tin)m(uing)e(lines)0 894 +y(con)m(tain)j(the)f('CONTINUE')g(k)m(eyw)m(ord,)h(as)g(in)e(this)g +(example:)95 1139 y Fe(LONGKEY)46 b(=)i('This)e(is)h(a)h(long)e(string) +g(value)h(that)f(is)i(contin&')95 1252 y(CONTINUE)94 +b('ued)46 b(over)h(2)g(records')f(/)h(comment)f(field)h(goes)f(here)0 +1497 y Fi(The)29 b(format)h(of)g(template)g(lines)d(with)i(CONTINUE)f +(k)m(eyw)m(ord)i(is)f(v)m(ery)h(strict:)40 b(3)30 b(spaces)g(m)m(ust)f +(follo)m(w)g(CON-)0 1610 y(TINUE)h(and)g(the)g(rest)h(of)f(the)h(line)e +(is)g(copied)h(v)m(erbatim)g(to)h(the)g(FITS)e(\014le.)0 +1771 y(The)i(start)h(of)g(the)f(optional)g(COMMENT)g(\014eld)f(m)m(ust) +i(b)s(e)e(preceded)i(b)m(y)f("/",)i(whic)m(h)d(is)h(used)g(to)h +(separate)g(it)0 1883 y(from)e(the)g(k)m(eyw)m(ord)h(v)-5 +b(alue)29 b(\014eld.)40 b(Exceptions)29 b(are)i(if)e(the)i(KEYW)m(ORD)g +(name)f(\014eld)f(con)m(tains)h(COMMENT,)0 1996 y(HISTOR)-8 +b(Y,)30 b(CONTINUE,)g(or)g(if)f(the)i(\014rst)f(8)g(c)m(haracters)i(of) +f(the)f(template)h(line)e(are)i(blanks.)0 2157 y(More)c(than)f(one)h +(Header-Data)i(Unit)d(\(HDU\))h(ma)m(y)g(b)s(e)f(de\014ned)f(in)g(the)i +(template)g(\014le.)38 b(The)26 b(start)h(of)g(an)f(HDU)0 +2269 y(de\014nition)i(is)h(denoted)i(with)e(a)i(SIMPLE)e(or)i(XTENSION) +e(template)i(line:)0 2430 y(1\))j(SIMPLE)f(b)s(egins)f(a)i(Primary)f +(HDU)h(de\014nition.)48 b(SIMPLE)33 b(ma)m(y)h(only)f(app)s(ear)g(as)h +(the)g(\014rst)f(k)m(eyw)m(ord)h(in)0 2543 y(the)e(template)h(\014le.) +44 b(If)32 b(the)g(template)h(\014le)e(b)s(egins)f(with)h(XTENSION)g +(instead)g(of)h(SIMPLE,)g(then)f(a)i(default)0 2655 y(empt)m(y)d +(Primary)d(HDU)j(is)f(created,)i(and)d(the)i(template)g(is)e(then)h +(assumed)f(to)i(de\014ne)f(the)h(k)m(eyw)m(ords)f(starting)0 +2768 y(with)g(the)i(\014rst)e(extension)h(follo)m(wing)f(the)i(Primary) +e(HDU.)0 2928 y(2\))35 b(XTENSION)e(marks)g(the)i(b)s(eginning)c(of)j +(a)h(new)e(extension)h(HDU)g(de\014nition.)50 b(The)33 +b(previous)g(HDU)i(will)0 3041 y(b)s(e)30 b(closed)g(at)h(this)e(p)s +(oin)m(t)h(and)f(pro)s(cessing)h(of)g(the)h(next)f(extension)g(b)s +(egins.)0 3373 y Fd(5.2)135 b(Auto-indexing)45 b(of)h(Keyw)l(ords)0 +3623 y Fi(If)31 b(a)h(template)f(k)m(eyw)m(ord)h(name)f(ends)g(with)f +(a)h("#")h(c)m(haracter,)i(it)d(is)f(said)g(to)i(b)s(e)f +('auto-indexed'.)43 b(Eac)m(h)32 b("#")0 3736 y(c)m(haracter)i(will)c +(b)s(e)i(replaced)h(b)m(y)f(the)h(curren)m(t)g(in)m(teger)g(index)e(v) +-5 b(alue,)33 b(whic)m(h)f(gets)h(reset)h(=)e(1)h(at)h(the)e(start)i +(of)0 3849 y(eac)m(h)h(new)f(HDU)g(in)f(the)h(\014le)f(\(or)h(7)h(in)d +(the)i(sp)s(ecial)f(case)i(of)f(a)g(GR)m(OUP)h(de\014nition\).)49 +b(The)33 b(FIRST)g(indexed)0 3962 y(k)m(eyw)m(ord)c(in)e(eac)m(h)i +(template)g(HDU)g(de\014nition)d(is)h(used)g(as)i(the)f('incremen)m +(tor';)i(eac)m(h)f(subsequen)m(t)f(o)s(ccurrence)0 4075 +y(of)k(this)e(SAME)h(k)m(eyw)m(ord)h(will)d(cause)j(the)g(index)e(v)-5 +b(alue)31 b(to)h(b)s(e)f(incremen)m(ted.)43 b(This)30 +b(b)s(eha)m(vior)g(can)i(b)s(e)f(rather)0 4188 y(subtle,)c(as)h +(illustrated)e(in)g(the)i(follo)m(wing)e(examples)h(in)f(whic)m(h)h +(the)h(TTYPE)e(k)m(eyw)m(ord)i(is)f(the)h(incremen)m(tor)f(in)0 +4300 y(b)s(oth)j(cases:)95 4546 y Fe(TTYPE#)47 b(=)g(TIME)95 +4659 y(TFORM#)g(=)g(1D)95 4772 y(TTYPE#)g(=)g(RATE)95 +4884 y(TFORM#)g(=)g(1E)0 5130 y Fi(will)23 b(create)28 +b(TTYPE1,)e(TF)m(ORM1,)i(TTYPE2,)f(and)e(TF)m(ORM2)i(k)m(eyw)m(ords.)40 +b(But)26 b(if)f(the)h(template)g(lo)s(oks)f(lik)m(e,)95 +5375 y Fe(TTYPE#)47 b(=)g(TIME)95 5488 y(TTYPE#)g(=)g(RATE)95 +5601 y(TFORM#)g(=)g(1D)95 5714 y(TFORM#)g(=)g(1E)p eop +%%Page: 43 49 +43 48 bop 0 299 a Fg(5.3.)72 b(TEMPLA)-8 b(TE)30 b(P)-8 +b(ARSER)30 b(DIRECTIVES)2073 b Fi(43)0 555 y(this)30 +b(results)f(in)h(a)h(FITS)f(\014les)g(with)f(TTYPE1,)i(TTYPE2,)g(TF)m +(ORM2,)h(and)e(TF)m(ORM2,)i(whic)m(h)e(is)g(probably)0 +668 y(not)h(what)f(w)m(as)h(in)m(tended!)0 1000 y Fd(5.3)135 +b(T)-11 b(emplate)46 b(P)l(arser)g(Directiv)l(es)0 1251 +y Fi(In)29 b(addition)g(to)h(the)g(template)h(lines)d(whic)m(h)h +(de\014ne)g(individual)d(k)m(eyw)m(ords,)k(the)g(template)h(parser)e +(recognizes)0 1363 y(3)h(sp)s(ecial)f(directiv)m(es)g(whic)m(h)g(are)h +(eac)m(h)h(preceded)f(b)m(y)f(the)h(bac)m(kslash)g(c)m(haracter:)90 +b Fe(\\include,)45 b(\\group)p Fi(,)29 b(and)48 1476 +y Fe(\\end)p Fi(.)0 1637 y(The)37 b('include')f(directiv)m(e)i(m)m(ust) +f(b)s(e)h(follo)m(w)m(ed)f(b)m(y)h(a)g(\014lename.)62 +b(It)38 b(forces)g(the)g(parser)f(to)i(temp)s(orarily)d(stop)0 +1749 y(reading)e(the)h(curren)m(t)g(template)g(\014le)f(and)g(b)s(egin) +g(reading)g(the)h(include)d(\014le.)54 b(Once)35 b(the)g(parser)f(reac) +m(hes)i(the)0 1862 y(end)f(of)h(the)g(include)d(\014le)i(it)g(con)m +(tin)m(ues)g(parsing)g(the)g(curren)m(t)h(template)g(\014le.)55 +b(Include)34 b(\014les)h(can)h(b)s(e)f(nested,)0 1975 +y(and)30 b(HDU)h(de\014nitions)d(can)i(span)g(m)m(ultiple)e(template)j +(\014les.)0 2135 y(The)g(start)h(of)g(a)g(GR)m(OUP)h(de\014nition)c(is) +i(denoted)h(with)e(the)i('group')g(directiv)m(e,)f(and)h(the)f(end)h +(of)f(a)i(GR)m(OUP)0 2248 y(de\014nition)i(is)i(denoted)g(with)f(the)i +('end')f(directiv)m(e.)61 b(Eac)m(h)39 b(GR)m(OUP)e(con)m(tains)h(0)g +(or)f(more)h(mem)m(b)s(er)f(blo)s(c)m(ks)0 2361 y(\(HDUs)44 +b(or)f(GR)m(OUPs\).)79 b(Mem)m(b)s(er)42 b(blo)s(c)m(ks)h(of)g(t)m(yp)s +(e)g(GR)m(OUP)g(can)g(con)m(tain)g(their)f(o)m(wn)h(mem)m(b)s(er)f(blo) +s(c)m(ks.)0 2474 y(The)32 b(GR)m(OUP)g(de\014nition)e(itself)h(o)s +(ccupies)h(one)g(FITS)g(\014le)f(HDU)i(of)f(sp)s(ecial)f(t)m(yp)s(e)h +(\(GR)m(OUP)h(HDU\),)h(so)e(if)g(a)0 2587 y(template)f(sp)s(eci\014es)e +(1)i(group)e(with)g(1)i(mem)m(b)s(er)f(HDU)h(lik)m(e:)0 +2838 y Fe(\\group)0 2951 y(grpdescr)46 b(=)h('demo')0 +3064 y(xtension)f(bintable)0 3177 y(#)h(this)g(bintable)f(has)h(0)g +(cols,)f(0)i(rows)0 3290 y(\\end)0 3541 y Fi(then)30 +b(the)h(parser)e(creates)j(a)f(FITS)f(\014le)f(with)g(3)i(HDUs)g(:)0 +3792 y Fe(1\))47 b(dummy)g(PHDU)0 3905 y(2\))g(GROUP)g(HDU)f(\(has)h(1) +h(member,)d(which)i(is)g(bintable)e(in)j(HDU)f(number)f(3\))0 +4018 y(3\))h(bintable)f(\(member)g(of)h(GROUP)f(in)h(HDU)g(number)f +(2\))0 4269 y Fi(T)-8 b(ec)m(hnically)29 b(sp)s(eaking,)g(the)g(GR)m +(OUP)i(HDU)f(is)f(a)h(BINT)-8 b(ABLE)30 b(with)f(6)h(columns.)39 +b(Applications)28 b(can)i(de\014ne)0 4382 y(additional)20 +b(columns)h(in)f(a)j(GR)m(OUP)f(HDU)h(using)e(TF)m(ORMn)g(and)h(TTYPEn) +f(\(where)g(n)h(is)f(7,)j(8,)h(....\))39 b(k)m(eyw)m(ords)0 +4494 y(or)30 b(their)g(auto-indexing)f(equiv)-5 b(alen)m(ts.)0 +4655 y(F)d(or)26 b(a)f(more)g(complicated)f(example)g(of)h(a)h +(template)f(\014le)f(using)f(the)i(group)f(directiv)m(es,)i(lo)s(ok)e +(at)h(the)g(sample.tpl)0 4767 y(\014le)k(that)i(is)f(included)d(in)j +(the)g(CFITSIO)f(distribution.)0 5100 y Fd(5.4)135 b(F)-11 +b(ormal)46 b(T)-11 b(emplate)45 b(Syn)l(tax)0 5350 y +Fi(The)30 b(template)h(syn)m(tax)g(can)f(formally)f(b)s(e)h(de\014ned)f +(as)i(follo)m(ws:)191 5601 y Fe(TEMPLATE)45 b(=)j(BLOCK)e([)i(BLOCK)e +(...)h(])p eop +%%Page: 44 50 +44 49 bop 0 299 a Fi(44)2340 b Fg(CHAPTER)30 b(5.)71 +b(TEMPLA)-8 b(TE)30 b(FILES)334 555 y Fe(BLOCK)46 b(=)i({)f(HDU)g(|)h +(GROUP)e(})334 781 y(GROUP)g(=)i(\\GROUP)e([)h(BLOCK)g(...)g(])g(\\END) +430 1007 y(HDU)f(=)i(XTENSION)d([)j(LINE)f(...)f(])i({)f(XTENSION)f(|)h +(\\GROUP)f(|)i(\\END)f(|)g(EOF)g(})382 1233 y(LINE)f(=)i([)f(KEYWORD)f +([)i(=)f(])h(])f([)g(VALUE)g(])g([)h(/)f(COMMENT)f(])191 +1458 y(X)h(...)238 b(-)48 b(X)f(can)g(be)g(present)f(1)h(or)h(more)e +(times)191 1571 y({)h(X)h(|)f(Y)h(})f(-)h(X)f(or)g(Y)191 +1684 y([)g(X)h(])238 b(-)48 b(X)f(is)g(optional)0 1937 +y Fi(A)m(t)34 b(the)f(topmost)g(lev)m(el,)g(the)g(template)h(de\014nes) +d(1)j(or)e(more)h(template)g(blo)s(c)m(ks.)48 b(Blo)s(c)m(ks)33 +b(can)g(b)s(e)f(either)g(HDU)0 2050 y(\(Header)27 b(Data)h(Unit\))f(or) +f(a)h(GR)m(OUP)-8 b(.)28 b(F)-8 b(or)27 b(eac)m(h)g(blo)s(c)m(k)f(the)h +(parser)f(creates)i(1)f(\(or)g(more)f(for)h(GR)m(OUPs\))g(FITS)0 +2163 y(\014le)i(HDUs.)0 2495 y Fd(5.5)135 b(Errors)0 +2745 y Fi(In)24 b(general)g(the)g(\014ts)p 692 2745 28 +4 v 33 w(execute)p 1019 2745 V 34 w(template\(\))h(function)e(tries)h +(to)h(b)s(e)f(as)g(atomic)h(as)g(p)s(ossible,)e(so)h(either)g(ev)m +(erything)0 2858 y(is)f(done)h(or)g(nothing)e(is)h(done.)39 +b(If)23 b(an)h(error)f(o)s(ccurs)h(during)e(parsing)g(of)i(the)g +(template,)i(\014ts)p 3125 2858 V 33 w(execute)p 3452 +2858 V 34 w(template\(\))0 2971 y(will)i(\(try)j(to\))h(delete)f(the)g +(top)g(lev)m(el)f(BLOCK)g(\(with)g(all)f(its)i(c)m(hildren)d(if)i(an)m +(y\))h(in)f(whic)m(h)f(the)i(error)f(o)s(ccurred,)0 3084 +y(then)g(it)g(will)e(stop)i(reading)g(the)g(template)h(\014le)e(and)h +(it)g(will)e(return)h(with)g(an)h(error.)0 3417 y Fd(5.6)135 +b(Examples)0 3667 y Fi(1.)54 b(This)33 b(template)i(\014le)f(will)e +(create)k(a)f(200)h(x)e(300)i(pixel)d(image,)k(with)c(4-b)m(yte)j(in)m +(teger)f(pixel)e(v)-5 b(alues,)35 b(in)f(the)0 3780 y(primary)28 +b(HDU:)95 4032 y Fe(SIMPLE)47 b(=)g(T)95 4145 y(BITPIX)g(=)g(32)95 +4258 y(NAXIS)g(=)g(2)239 b(/)47 b(number)f(of)h(dimensions)95 +4371 y(NAXIS1)g(=)g(100)95 b(/)47 b(length)f(of)h(first)g(axis)95 +4484 y(NAXIS2)g(=)g(200)95 b(/)47 b(length)f(of)h(second)f(axis)95 +4597 y(OBJECT)h(=)g(NGC)g(253)g(/)g(name)g(of)g(observed)f(object)0 +4850 y Fi(The)35 b(allo)m(w)m(ed)g(v)-5 b(alues)35 b(of)g(BITPIX)g(are) +h(8,)h(16,)h(32,)g(-32,)g(or)d(-64,)j(represen)m(ting,)e(resp)s(ectiv)m +(ely)-8 b(,)37 b(8-bit)e(in)m(teger,)0 4962 y(16-bit)c(in)m(teger,)g +(32-bit)f(in)m(teger,)h(32-bit)g(\015oating)f(p)s(oin)m(t,)g(or)g(64)h +(bit)f(\015oating)g(p)s(oin)m(t)f(pixels.)0 5123 y(2.)39 +b(T)-8 b(o)23 b(create)h(a)f(FITS)e(table,)k(the)d(template)h(\014rst)f +(needs)g(to)i(include)c(XTENSION)i(=)g(T)-8 b(ABLE)23 +b(or)f(BINT)-8 b(ABLE)0 5235 y(to)31 b(de\014ne)e(whether)g(it)g(is)g +(an)g(ASCI)s(I)g(or)g(binary)f(table,)i(and)g(NAXIS2)g(to)g(de\014ne)f +(the)h(n)m(um)m(b)s(er)f(of)h(ro)m(ws)f(in)g(the)0 5348 +y(table.)49 b(Tw)m(o)34 b(template)f(lines)f(are)i(then)f(needed)f(to)i +(de\014ne)f(the)g(name)h(\(TTYPEn\))e(and)h(FITS)g(data)h(format)0 +5461 y(\(TF)m(ORMn\))d(of)f(the)h(columns,)e(as)i(in)e(this)g(example:) +95 5714 y Fe(xtension)46 b(=)h(bintable)p eop +%%Page: 45 51 +45 50 bop 0 299 a Fg(5.6.)72 b(EXAMPLES)3084 b Fi(45)95 +555 y Fe(naxis2)47 b(=)g(40)95 668 y(ttype#)g(=)g(Name)95 +781 y(tform#)g(=)g(10a)95 894 y(ttype#)g(=)g(Npoints)95 +1007 y(tform#)g(=)g(j)95 1120 y(ttype#)g(=)g(Rate)95 +1233 y(tunit#)g(=)g(counts/s)95 1346 y(tform#)g(=)g(e)0 +1605 y Fi(The)26 b(ab)s(o)m(v)m(e)j(example)d(de\014nes)g(a)i(n)m(ull)d +(primary)g(arra)m(y)i(follo)m(w)m(ed)g(b)m(y)g(a)g(40-ro)m(w)h(binary)d +(table)i(extension)g(with)f(3)0 1718 y(columns)h(called)g('Name',)j +('Np)s(oin)m(ts',)e(and)g('Rate',)i(with)d(data)i(formats)f(of)g('10A') +i(\(ASCI)s(I)d(c)m(haracter)i(string\),)0 1831 y('1J')k(\(in)m(teger\)) +h(and)e('1E')i(\(\015oating)e(p)s(oin)m(t\),)h(resp)s(ectiv)m(ely)-8 +b(.)48 b(Note)34 b(that)f(the)g(other)g(required)e(FITS)h(k)m(eyw)m +(ords)0 1944 y(\(BITPIX,)37 b(NAXIS,)g(NAXIS1,)h(PCOUNT,)e(GCOUNT,)h +(TFIELDS,)f(and)g(END\))h(do)g(not)g(need)f(to)h(b)s(e)f(ex-)0 +2057 y(plicitly)f(de\014ned)h(in)h(the)g(template)h(b)s(ecause)g(their) +f(v)-5 b(alues)37 b(can)h(b)s(e)f(inferred)e(from)j(the)f(other)h(k)m +(eyw)m(ords)g(in)0 2170 y(the)d(template.)54 b(This)33 +b(example)i(also)g(illustrates)d(that)k(the)f(templates)g(are)g +(generally)f(case-insensitiv)m(e)g(\(the)0 2283 y(k)m(eyw)m(ord)29 +b(names)g(and)g(TF)m(ORMn)f(v)-5 b(alues)29 b(are)g(con)m(v)m(erted)i +(to)e(upp)s(er-case)g(in)e(the)i(FITS)g(\014le\))f(and)g(that)i(string) +0 2396 y(k)m(eyw)m(ord)h(v)-5 b(alues)30 b(generally)f(do)h(not)h(need) +f(to)h(b)s(e)f(enclosed)g(in)f(quotes.)p eop +%%Page: 46 52 +46 51 bop 0 299 a Fi(46)2340 b Fg(CHAPTER)30 b(5.)71 +b(TEMPLA)-8 b(TE)30 b(FILES)p eop +%%Page: 47 53 +47 52 bop 0 1225 a Ff(Chapter)65 b(6)0 1687 y Fl(FITSIO)76 +b(Con)-6 b(v)g(en)g(tions)76 b(and)h(Guidelines)0 2216 +y Fd(6.1)135 b(CFITSIO)44 b(Size)h(Limitations)0 2476 +y Fi(CFITSIO)31 b(places)h(few)h(restrictions)e(on)i(the)f(size)h(of)f +(FITS)g(\014les)g(that)h(it)f(reads)g(or)h(writes.)46 +b(There)32 b(are)h(a)g(few)0 2589 y(limits,)28 b(ho)m(w)m(ev)m(er,)k +(whic)m(h)d(ma)m(y)i(a\013ect)h(some)f(extreme)g(cases:)0 +2749 y(1.)43 b(The)31 b(maxim)m(um)f(n)m(um)m(b)s(er)g(of)h(FITS)f +(\014les)g(that)i(ma)m(y)g(b)s(e)e(sim)m(ultaneously)f(op)s(ened)i(b)m +(y)g(CFITSIO)e(is)h(set)i(b)m(y)0 2862 y(NMAXFILES)i(as)g(de\014ned)f +(in)g(\014tsio2.h.)51 b(It)34 b(is)f(curren)m(tly)g(set)i(=)f(300)h(b)m +(y)f(default.)51 b(CFITSIO)32 b(will)f(allo)s(cate)0 +2975 y(ab)s(out)i(80)g(*)h(NMAXFILES)f(b)m(ytes)g(of)g(memory)g(for)g +(in)m(ternal)e(use.)48 b(Note)34 b(that)g(the)f(underlying)d(C)i +(compiler)0 3088 y(or)39 b(op)s(erating)g(system,)k(ma)m(y)d(ha)m(v)m +(e)g(a)g(smaller)e(limit)g(on)h(the)h(n)m(um)m(b)s(er)e(of)i(op)s(ened) +e(\014les.)67 b(The)39 b(C)h(sym)m(b)s(olic)0 3201 y(constan)m(t)31 +b(F)m(OPEN)p 690 3201 28 4 v 34 w(MAX)f(is)f(in)m(tended)g(to)i +(de\014ne)e(the)i(maxim)m(um)e(n)m(um)m(b)s(er)f(of)j(\014les)e(that)h +(ma)m(y)h(op)s(en)e(at)i(once)0 3314 y(\(including)d(an)m(y)j(other)g +(text)h(or)f(binary)e(\014les)h(that)i(ma)m(y)f(b)s(e)g(op)s(en,)f(not) +h(just)g(FITS)f(\014les\).)42 b(On)30 b(some)h(systems)0 +3427 y(it)f(has)g(b)s(een)g(found)f(that)i(gcc)g(supp)s(orts)e(a)h +(maxim)m(um)g(of)g(255)i(op)s(ened)e(\014les.)0 3587 +y(Note)d(that)e(op)s(ening)f(and)h(op)s(erating)g(on)g(man)m(y)g(FITS)g +(\014les)f(sim)m(ultaneously)f(in)h(parallel)f(ma)m(y)j(b)s(e)f(less)f +(e\016cien)m(t)0 3700 y(than)k(op)s(erating)g(on)g(smaller)f(groups)h +(of)h(\014les)e(in)g(series.)40 b(CFITSIO)27 b(only)g(has)h(NIOBUF)h(n) +m(um)m(b)s(er)f(of)g(in)m(ternal)0 3813 y(bu\013ers)j(\(set)j(=)e(40)i +(b)m(y)e(default\))h(that)g(are)g(used)f(for)g(temp)s(orary)g(storage)i +(of)f(the)g(most)g(recen)m(t)h(data)f(records)0 3926 +y(that)40 b(ha)m(v)m(e)g(b)s(een)e(read)h(or)g(written)f(in)f(the)i +(FITS)f(\014les.)66 b(If)38 b(the)h(n)m(um)m(b)s(er)f(of)h(op)s(ened)f +(\014les)g(is)g(greater)i(than)0 4039 y(NIOBUF,)j(then)f(CFITSIO)e(ma)m +(y)j(w)m(aste)h(more)e(time)g(\015ushing)d(and)j(re-reading)g(or)g +(re-writing)e(the)j(same)0 4152 y(records)30 b(in)f(the)i(FITS)e +(\014les.)0 4312 y(2.)54 b(By)35 b(default,)g(CFITSIO)e(can)i(handle)f +(FITS)g(\014les)f(up)h(to)h(2.1)h(GB)g(in)d(size)i(\(2**31)i(b)m +(ytes\).)54 b(This)33 b(\014le)h(size)0 4425 y(limit)k(is)i(often)g +(imp)s(osed)f(b)m(y)h(32-bit)h(op)s(erating)e(systems.)71 +b(More)41 b(recen)m(tly)-8 b(,)44 b(as)d(64-bit)f(op)s(erating)g +(systems)0 4538 y(b)s(ecome)33 b(more)g(common,)g(an)g(industry-wide)c +(standard)j(\(at)i(least)e(on)h(Unix)e(systems\))i(has)g(b)s(een)f(dev) +m(elop)s(ed)0 4650 y(to)39 b(supp)s(ort)d(larger)h(sized)h(\014les)f +(\(see)h(h)m(ttp://ftp.sas.com/standards/large.\014le/\).)66 +b(Starting)38 b(with)e(v)m(ersion)0 4763 y(2.1)45 b(of)e(CFITSIO,)f +(larger)h(FITS)g(\014les)f(up)h(to)h(6)g(terab)m(ytes)h(in)d(size)h(ma) +m(y)h(b)s(e)f(read)g(and)g(written)g(on)g(sup-)0 4876 +y(p)s(orted)f(platforms.)75 b(In)42 b(order)g(to)h(supp)s(ort)e(these)h +(larger)g(\014les,)j(CFITSIO)c(m)m(ust)h(b)s(e)g(compiled)f(with)g(the) +0 4989 y('-D)p 129 4989 V 34 w(LAR)m(GEFILE)p 696 4989 +V 33 w(SOUR)m(CE')h(and)g(`-D)p 1491 4989 V 34 w(FILE)p +1736 4989 V 33 w(OFFSET)p 2137 4989 V 32 w(BITS=64')h(compiler)e +(\015ags.)78 b(Some)43 b(platforms)0 5102 y(ma)m(y)c(also)f(require)f +(the)h(`-D)p 1002 5102 V 34 w(LAR)m(GE)p 1358 5102 V +33 w(FILES')g(compiler)f(\015ag.)64 b(This)37 b(causes)h(the)h +(compiler)e(to)i(allo)s(cate)f(8-)0 5215 y(b)m(ytes)44 +b(instead)f(of)h(4-b)m(ytes)h(for)f(the)g(`o\013)p 1473 +5215 V 33 w(t')g(datat)m(yp)s(e)h(whic)m(h)e(is)f(used)h(to)i(store)f +(\014le)f(o\013set)i(p)s(ositions.)79 b(It)0 5328 y(app)s(ears)31 +b(that)i(in)d(most)j(cases)g(it)e(is)g(not)h(necessary)h(to)f(also)g +(include)e(these)i(compiler)f(\015ags)h(when)f(compiling)0 +5441 y(programs)f(that)h(link)d(to)j(the)g(CFITSIO)e(library)-8 +b(.)0 5601 y(If)21 b(CFITSIO)e(is)h(compiled)g(with)g(the)h(-D)p +1386 5601 V 33 w(LAR)m(GEFILE)p 1952 5601 V 34 w(SOUR)m(CE)f(and)g(-D)p +2654 5601 V 34 w(FILE)p 2899 5601 V 33 w(OFFSET)p 3300 +5601 V 32 w(BITS=64)h(\015ags)0 5714 y(on)36 b(a)g(platform)f(that)h +(supp)s(orts)e(large)i(\014les,)h(then)e(it)h(can)g(read)g(and)f(write) +g(FITS)g(\014les)g(that)h(con)m(tain)g(up)f(to)1905 5942 +y(47)p eop +%%Page: 48 54 +48 53 bop 0 299 a Fi(48)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fi(2**31)39 b(2880-b)m(yte)g(FITS)d(records,)j(or)d(appro)m(ximately)g +(6)h(terab)m(ytes)h(in)e(size.)59 b(It)37 b(is)f(still)f(required)f +(that)k(the)0 668 y(v)-5 b(alue)29 b(of)g(the)g(NAXISn)f(and)h(PCOUNT)f +(k)m(eyw)m(ords)h(in)f(eac)m(h)i(extension)f(b)s(e)f(within)f(the)i +(range)h(of)f(a)g(signed)f(4-)0 781 y(b)m(yte)d(in)m(teger)g(\(max)g(v) +-5 b(alue)25 b(=)f(2,147,483,648\).)44 b(Th)m(us,)25 +b(eac)m(h)h(dimension)c(of)j(an)f(image)h(\(giv)m(en)g(b)m(y)g(the)g +(NAXISn)0 894 y(k)m(eyw)m(ords\),)32 b(the)f(total)h(width)d(of)i(a)g +(table)g(\(NAXIS1)h(k)m(eyw)m(ord\),)g(the)f(n)m(um)m(b)s(er)f(of)h(ro) +m(ws)g(in)e(a)i(table)g(\(NAXIS2)0 1007 y(k)m(eyw)m(ord\),)d(and)d(the) +h(total)h(size)f(of)g(the)g(v)-5 b(ariable-length)25 +b(arra)m(y)h(heap)g(in)f(binary)f(tables)i(\(PCOUNT)f(k)m(eyw)m(ord\))0 +1120 y(m)m(ust)30 b(b)s(e)g(less)g(than)g(this)f(limit.)0 +1280 y(Curren)m(tly)-8 b(,)30 b(supp)s(ort)f(for)i(large)g(\014les)f +(within)e(CFITSIO)h(has)i(b)s(een)f(tested)i(on)f(the)g(Lin)m(ux,)f +(Solaris,)f(and)h(IBM)0 1393 y(AIX)g(op)s(erating)g(systems.)0 +1750 y Fd(6.2)135 b(Multiple)46 b(Access)e(to)i(the)f(Same)g(FITS)f +(File)0 2005 y Fi(CFITSIO)35 b(supp)s(orts)g(sim)m(ultaneous)g(read)h +(and)g(write)g(access)h(to)h(m)m(ultiple)c(HDUs)j(in)e(the)i(same)g +(FITS)f(\014le.)0 2118 y(Th)m(us,)43 b(one)e(can)h(op)s(en)e(the)h +(same)h(FITS)e(\014le)g(t)m(wice)i(within)c(a)k(single)d(program)i(and) +g(mo)m(v)m(e)h(to)g(2)f(di\013eren)m(t)0 2231 y(HDUs)30 +b(in)e(the)i(\014le,)f(and)g(then)g(read)h(and)e(write)h(data)h(or)g(k) +m(eyw)m(ords)g(to)g(the)g(2)f(extensions)h(just)e(as)i(if)f(one)g(w)m +(ere)0 2344 y(accessing)e(2)g(completely)f(separate)h(FITS)f(\014les.) +38 b(Since)26 b(in)f(general)h(it)g(is)g(not)h(p)s(ossible)d(to)j(ph)m +(ysically)d(op)s(en)i(the)0 2457 y(same)36 b(\014le)f(t)m(wice)h(and)f +(then)g(exp)s(ect)h(to)g(b)s(e)f(able)g(to)i(sim)m(ultaneously)c(\(or)j +(in)e(alternating)h(succession\))h(write)0 2570 y(to)f(2)f(di\013eren)m +(t)g(lo)s(cations)g(in)e(the)j(\014le,)f(CFITSIO)f(recognizes)i(when)e +(the)h(\014le)f(to)i(b)s(e)f(op)s(ened)f(\(in)g(the)i(call)e(to)0 +2683 y(\014ts)p 127 2683 28 4 v 32 w(op)s(en)p 349 2683 +V 33 w(\014le\))28 b(has)g(already)g(b)s(een)g(op)s(ened)g(and)g +(instead)g(of)h(actually)f(op)s(ening)f(the)i(\014le)f(again,)h(just)f +(logically)0 2796 y(links)g(the)j(new)f(\014le)g(to)h(the)g(old)e +(\014le.)41 b(\(This)29 b(only)h(applies)e(if)i(the)h(\014le)e(is)h(op) +s(ened)g(more)g(than)g(once)i(within)c(the)0 2908 y(same)g(program,)g +(and)f(do)s(es)h(not)f(prev)m(en)m(t)i(the)f(same)g(\014le)e(from)h(b)s +(eing)g(sim)m(ultaneously)e(op)s(ened)i(b)m(y)g(more)h(than)0 +3021 y(one)h(program\).)40 b(Then)28 b(b)s(efore)g(CFITSIO)f(reads)h +(or)h(writes)f(to)h(either)f(\(logical\))h(\014le,)f(it)g(mak)m(es)i +(sure)d(that)j(an)m(y)0 3134 y(mo)s(di\014cations)g(made)h(to)h(the)g +(other)g(\014le)e(ha)m(v)m(e)j(b)s(een)e(completely)g(\015ushed)e(from) +i(the)h(in)m(ternal)e(bu\013ers)h(to)h(the)0 3247 y(\014le.)43 +b(Th)m(us,)30 b(in)g(principle,)f(one)i(could)f(op)s(en)h(a)h(\014le)e +(t)m(wice,)i(in)e(one)i(case)g(p)s(oin)m(ting)e(to)i(the)f(\014rst)g +(extension)g(and)0 3360 y(in)i(the)i(other)g(p)s(oin)m(ting)d(to)k(the) +e(2nd)g(extension)h(and)e(then)i(write)e(data)j(to)f(b)s(oth)f +(extensions,)h(in)e(an)m(y)i(order,)0 3473 y(without)24 +b(danger)i(of)f(corrupting)g(the)g(\014le,)h(There)f(ma)m(y)h(b)s(e)f +(some)h(e\016ciency)f(p)s(enalties)f(in)g(doing)h(this)f(ho)m(w)m(ev)m +(er,)0 3586 y(since)j(CFITSIO)g(has)h(to)h(\015ush)d(all)h(the)h(in)m +(ternal)f(bu\013ers)g(related)h(to)h(one)f(\014le)f(b)s(efore)h(switc)m +(hing)e(to)j(the)f(other,)0 3699 y(so)i(it)g(w)m(ould)f(still)f(b)s(e)i +(pruden)m(t)f(to)i(minimize)d(the)i(n)m(um)m(b)s(er)f(of)i(times)e(one) +i(switc)m(hes)f(bac)m(k)h(and)e(forth)h(b)s(et)m(w)m(een)0 +3812 y(doing)f(I/O)i(to)g(di\013eren)m(t)f(HDUs)h(in)e(the)h(same)h +(\014le.)0 4169 y Fd(6.3)135 b(Curren)l(t)46 b(Header)f(Data)h(Unit)g +(\(CHDU\))0 4424 y Fi(In)32 b(general,)i(a)g(FITS)e(\014le)h(can)g(con) +m(tain)g(m)m(ultiple)e(Header)j(Data)h(Units,)e(also)g(called)f +(extensions.)48 b(CFITSIO)0 4537 y(only)37 b(op)s(erates)i(within)d +(one)i(HDU)h(at)g(an)m(y)g(giv)m(en)f(time,)i(and)e(the)g(curren)m(tly) +f(selected)i(HDU)g(is)e(called)h(the)0 4650 y(Curren)m(t)h(Header)h +(Data)h(Unit)e(\(CHDU\).)i(When)f(a)g(FITS)f(\014le)g(is)f(\014rst)h +(created)i(or)f(op)s(ened)f(the)h(CHDU)g(is)0 4763 y(automatically)25 +b(de\014ned)e(to)j(b)s(e)e(the)h(\014rst)f(HDU)i(\(i.e.,)g(the)f +(primary)e(arra)m(y\).)40 b(CFITSIO)23 b(routines)h(are)h(pro)m(vided)0 +4876 y(to)36 b(mo)m(v)m(e)h(to)g(and)e(op)s(en)g(an)m(y)h(other)g +(existing)e(HDU)j(within)c(the)j(FITS)f(\014le)f(or)i(to)g(app)s(end)e +(or)i(insert)e(a)i(new)0 4989 y(HDU)31 b(in)e(the)i(FITS)e(\014le)h +(whic)m(h)f(then)h(b)s(ecomes)h(the)f(CHDU.)0 5346 y +Fd(6.4)135 b(Subroutine)45 b(Names)0 5601 y Fi(All)24 +b(FITSIO)h(subroutine)f(names)i(b)s(egin)e(with)h(the)h(letters)g('ft') +g(to)h(distinguish)22 b(them)k(from)f(other)h(subroutines)0 +5714 y(and)34 b(are)h(5)g(or)f(6)h(c)m(haracters)h(long.)53 +b(Users)34 b(should)f(not)h(name)h(their)f(o)m(wn)g(subroutines)e(b)s +(eginning)g(with)h('ft')p eop +%%Page: 49 55 +49 54 bop 0 299 a Fg(6.5.)72 b(SUBR)m(OUTINE)30 b(F)-10 +b(AMILIES)30 b(AND)h(D)m(A)-8 b(T)g(A)g(TYPES)1697 b +Fi(49)0 555 y(to)32 b(a)m(v)m(oid)h(con\015icts.)44 b(\(The)32 +b(SPP)f(in)m(terface)h(routines)e(all)h(b)s(egin)f(with)h('fs'\).)45 +b(Subroutines)29 b(whic)m(h)h(read)i(or)g(get)0 668 y(information)c +(from)i(the)h(FITS)e(\014le)g(ha)m(v)m(e)j(names)e(b)s(eginning)d(with) +i('ftg...'.)43 b(Subroutines)27 b(whic)m(h)i(write)g(or)i(put)0 +781 y(information)e(in)m(to)h(the)h(FITS)e(\014le)h(ha)m(v)m(e)h(names) +g(b)s(eginning)c(with)i('ftp...'.)0 1274 y Fd(6.5)135 +b(Subroutine)45 b(F)-11 b(amilies)46 b(and)f(Datat)l(yp)t(es)0 +1556 y Fi(Man)m(y)h(of)g(the)g(subroutines)d(come)k(in)d(families)f +(whic)m(h)i(di\013er)f(only)h(in)f(the)i(datat)m(yp)s(e)g(of)g(the)f +(asso)s(ciated)0 1669 y(parameter\(s\))34 b(.)47 b(The)32 +b(datat)m(yp)s(e)i(of)f(these)g(subroutines)d(is)i(indicated)f(b)m(y)i +(the)g(last)f(letter)h(of)g(the)g(subroutine)0 1781 y(name)d(\(e.g.,)j +('j')d(in)f('ftpkyj'\))i(as)f(follo)m(ws:)382 2176 y +Fe(x)47 b(-)h(bit)382 2289 y(b)f(-)h(character*1)c(\(unsigned)i(byte\)) +382 2402 y(i)h(-)h(short)e(integer)g(\(I*2\))382 2515 +y(j)h(-)h(integer)e(\(I*4\))382 2628 y(e)h(-)h(real)e(exponential)f +(floating)h(point)g(\(R*4\))382 2741 y(f)h(-)h(real)e(fixed-format)f +(floating)g(point)i(\(R*4\))382 2854 y(d)g(-)h(double)e(precision)f +(real)i(floating-point)d(\(R*8\))382 2967 y(g)j(-)h(double)e(precision) +f(fixed-format)g(floating)g(point)h(\(R*8\))382 3079 +y(c)h(-)h(complex)e(reals)g(\(pairs)g(of)h(R*4)g(values\))382 +3192 y(m)g(-)h(double)e(precision)f(complex)h(\(pairs)g(of)h(R*8)g +(values\))382 3305 y(l)g(-)h(logical)e(\(L*4\))382 3418 +y(s)h(-)h(character)d(string)0 3813 y Fi(When)23 b(dealing)f(with)g +(the)h(FITS)g(b)m(yte)g(datat)m(yp)s(e,)j(it)d(is)f(imp)s(ortan)m(t)h +(to)g(remem)m(b)s(er)g(that)h(the)f(ra)m(w)g(v)-5 b(alues)23 +b(\(b)s(efore)0 3926 y(an)m(y)i(scaling)e(b)m(y)h(the)h(BSCALE)e(and)h +(BZER)m(O,)g(or)h(TSCALn)d(and)i(TZER)m(On)f(k)m(eyw)m(ord)i(v)-5 +b(alues\))24 b(in)f(b)m(yte)i(arra)m(ys)0 4039 y(\(BITPIX)37 +b(=)f(8\))h(or)f(b)m(yte)i(columns)d(\(TF)m(ORMn)i(=)f('B'\))h(are)g +(in)m(terpreted)f(as)h(unsigned)d(b)m(ytes)j(with)f(v)-5 +b(alues)0 4152 y(ranging)39 b(from)g(0)i(to)f(255.)71 +b(Some)40 b(F)-8 b(ortran)40 b(compilers)f(supp)s(ort)f(a)i +(non-standard)f(b)m(yte)h(datat)m(yp)s(e)h(suc)m(h)f(as)0 +4264 y(INTEGER*1,)34 b(LOGICAL*1,)g(or)f(BYTE,)g(whic)m(h)e(can)i +(sometimes)g(b)s(e)f(used)g(instead)g(of)h(CHARA)m(CTER*1)0 +4377 y(v)-5 b(ariables.)37 b(Man)m(y)23 b(mac)m(hines)f(p)s(ermit)g +(passing)f(a)i(n)m(umeric)f(datat)m(yp)s(e)h(\(suc)m(h)g(as)g +(INTEGER*1\))h(to)f(the)g(FITSIO)0 4490 y(subroutines)40 +b(whic)m(h)i(are)h(exp)s(ecting)f(a)h(CHARA)m(CTER*1)h(datat)m(yp)s(e,) +j(but)42 b(this)f(tec)m(hnically)h(violates)h(the)0 4603 +y(F)-8 b(ortran-77)29 b(standard)d(and)g(is)g(not)h(supp)s(orted)e(on)i +(all)f(mac)m(hines)g(\(e.g.,)k(on)c(a)i(V)-10 b(AX/VMS)27 +b(mac)m(hine)g(one)g(m)m(ust)0 4716 y(use)j(the)h(V)-10 +b(AX-sp)s(eci\014c)30 b(\045DESCR)f(function\).)0 4876 +y(One)22 b(feature)h(of)g(the)g(CFITSIO)e(routines)h(is)f(that)j(they)f +(can)g(op)s(erate)g(on)f(a)h(`X')h(\(bit\))e(column)g(in)f(a)i(binary)e +(table)0 4989 y(as)35 b(though)e(it)h(w)m(ere)h(a)g(`B')g(\(b)m(yte\))g +(column.)52 b(F)-8 b(or)35 b(example)f(a)g(`11X')i(datat)m(yp)s(e)f +(column)e(can)i(b)s(e)f(in)m(terpreted)0 5102 y(the)28 +b(same)h(as)f(a)g(`2B')i(column)d(\(i.e.,)i(2)f(unsigned)e(8-bit)i(b)m +(ytes\).)41 b(In)27 b(some)i(instances,)f(it)f(can)i(b)s(e)e(more)h +(e\016cien)m(t)0 5215 y(to)j(read)f(and)g(write)g(whole)f(b)m(ytes)i +(at)g(a)g(time,)f(rather)h(than)f(reading)f(or)i(writing)d(eac)m(h)k +(individual)25 b(bit.)0 5375 y(The)41 b(double)g(precision)f(complex)h +(datat)m(yp)s(e)i(is)e(not)h(a)g(standard)f(F)-8 b(ortran-77)43 +b(datat)m(yp)s(e.)76 b(If)41 b(a)i(particular)0 5488 +y(F)-8 b(ortran)35 b(compiler)e(do)s(es)h(not)h(directly)e(supp)s(ort)g +(this)h(datat)m(yp)s(e,)i(then)f(one)f(ma)m(y)h(instead)f(pass)g(an)h +(arra)m(y)g(of)0 5601 y(pairs)c(of)i(double)e(precision)g(v)-5 +b(alues)31 b(to)j(these)f(subroutines.)44 b(The)33 b(\014rst)e(v)-5 +b(alue)32 b(in)f(eac)m(h)j(pair)d(is)h(the)h(real)f(part,)0 +5714 y(and)e(the)g(second)h(is)e(the)i(imaginary)e(part.)p +eop +%%Page: 50 56 +50 55 bop 0 299 a Fi(50)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fd(6.6)135 b(Implicit)46 b(Data)g(T)l(yp)t(e)f(Con)l(v)l(ersion)0 +816 y Fi(The)22 b(FITSIO)g(routines)g(that)i(read)e(and)h(write)f(n)m +(umerical)f(data)j(can)f(p)s(erform)f(implicit)e(data)j(t)m(yp)s(e)g +(con)m(v)m(ersion.)0 929 y(This)h(means)h(that)h(the)g(data)g(t)m(yp)s +(e)g(of)g(the)g(v)-5 b(ariable)24 b(or)i(arra)m(y)g(in)e(the)i(program) +f(do)s(es)g(not)h(need)g(to)g(b)s(e)f(the)h(same)0 1042 +y(as)i(the)f(data)h(t)m(yp)s(e)g(of)f(the)h(v)-5 b(alue)27 +b(in)f(the)h(FITS)g(\014le.)39 b(Data)28 b(t)m(yp)s(e)g(con)m(v)m +(ersion)g(is)e(supp)s(orted)g(for)h(n)m(umerical)f(and)0 +1155 y(string)32 b(data)i(t)m(yp)s(es)f(\(if)g(the)h(string)e(con)m +(tains)h(a)h(v)-5 b(alid)31 b(n)m(um)m(b)s(er)h(enclosed)h(in)f +(quotes\))i(when)f(reading)f(a)i(FITS)0 1268 y(header)d(k)m(eyw)m(ord)g +(v)-5 b(alue)30 b(and)h(for)f(n)m(umeric)g(v)-5 b(alues)30 +b(when)g(reading)g(or)h(writing)e(v)-5 b(alues)30 b(in)f(the)i(primary) +e(arra)m(y)0 1381 y(or)40 b(a)h(table)g(column.)69 b(CFITSIO)39 +b(returns)h(status)g(=)h(NUM)p 2185 1381 28 4 v 33 w(O)m(VERFLO)m(W)g +(if)f(the)g(con)m(v)m(erted)i(data)f(v)-5 b(alue)0 1493 +y(exceeds)33 b(the)g(range)g(of)g(the)f(output)g(data)i(t)m(yp)s(e.)47 +b(Implicit)30 b(data)j(t)m(yp)s(e)g(con)m(v)m(ersion)g(is)e(not)i(supp) +s(orted)d(within)0 1606 y(binary)f(tables)h(for)g(string,)f(logical,)i +(complex,)f(or)g(double)f(complex)h(data)h(t)m(yp)s(es.)0 +1767 y(In)g(addition,)f(an)m(y)h(table)g(column)f(ma)m(y)i(b)s(e)f +(read)g(as)h(if)e(it)h(con)m(tained)g(string)f(v)-5 b(alues.)43 +b(In)31 b(the)g(case)i(of)e(n)m(umeric)0 1879 y(columns)e(the)i +(returned)e(string)g(will)f(b)s(e)i(formatted)h(using)d(the)j(TDISPn)e +(displa)m(y)g(format)h(if)g(it)g(exists.)0 2266 y Fd(6.7)135 +b(Data)46 b(Scaling)0 2527 y Fi(When)38 b(reading)e(n)m(umerical)h +(data)h(v)-5 b(alues)37 b(in)f(the)i(primary)e(arra)m(y)i(or)g(a)g +(table)g(column,)h(the)e(v)-5 b(alues)37 b(will)f(b)s(e)0 +2640 y(scaled)h(automatically)h(b)m(y)f(the)h(BSCALE)f(and)g(BZER)m(O)h +(\(or)g(TSCALn)d(and)i(TZER)m(On\))g(header)g(k)m(eyw)m(ord)0 +2753 y(v)-5 b(alues)32 b(if)f(they)h(are)h(presen)m(t)g(in)e(the)h +(header.)47 b(The)31 b(scaled)i(data)g(that)g(is)e(returned)g(to)i(the) +g(reading)e(program)0 2866 y(will)d(ha)m(v)m(e)382 3171 +y Fe(output)46 b(value)g(=)i(\(FITS)e(value\))g(*)i(BSCALE)e(+)h(BZERO) +0 3476 y Fi(\(a)30 b(corresp)s(onding)d(form)m(ula)h(using)g(TSCALn)f +(and)i(TZER)m(On)e(is)h(used)h(when)f(reading)g(from)h(table)g +(columns\).)0 3589 y(In)i(the)i(case)g(of)f(in)m(teger)g(output)g(v)-5 +b(alues)31 b(the)i(\015oating)f(p)s(oin)m(t)f(scaled)g(v)-5 +b(alue)32 b(is)f(truncated)h(to)h(an)f(in)m(teger)g(\(not)0 +3702 y(rounded)38 b(to)i(the)g(nearest)g(in)m(teger\).)69 +b(The)39 b(ftpscl)f(and)h(fttscl)h(subroutines)d(ma)m(y)j(b)s(e)f(used) +g(to)h(o)m(v)m(erride)g(the)0 3815 y(scaling)28 b(parameters)h +(de\014ned)e(in)g(the)i(header)f(\(e.g.,)j(to)e(turn)f(o\013)h(the)f +(scaling)g(so)h(that)g(the)g(program)f(can)h(read)0 3928 +y(the)i(ra)m(w)f(unscaled)f(v)-5 b(alues)30 b(from)g(the)g(FITS)g +(\014le\).)0 4088 y(When)44 b(writing)f(n)m(umerical)g(data)i(to)g(the) +g(primary)e(arra)m(y)i(or)f(to)h(a)g(table)g(column)e(the)i(data)g(v)-5 +b(alues)44 b(will)0 4201 y(generally)27 b(b)s(e)h(automatically)g(in)m +(v)m(ersely)g(scaled)g(b)m(y)g(the)g(v)-5 b(alue)28 b(of)g(the)h +(BSCALE)e(and)h(BZER)m(O)g(\(or)h(TSCALn)0 4314 y(and)h(TZER)m(On\))g +(header)g(k)m(eyw)m(ord)h(v)-5 b(alues)30 b(if)g(they)h(they)g(exist)f +(in)f(the)i(header.)42 b(These)30 b(k)m(eyw)m(ords)h(m)m(ust)g(ha)m(v)m +(e)0 4426 y(b)s(een)f(written)g(to)i(the)g(header)e(b)s(efore)h(an)m(y) +h(data)f(is)f(written)h(for)f(them)i(to)f(ha)m(v)m(e)i(an)m(y)e +(e\013ect.)44 b(Otherwise,)31 b(one)0 4539 y(ma)m(y)j(use)f(the)g +(ftpscl)f(and)h(fttscl)g(subroutines)d(to)k(de\014ne)f(or)g(o)m(v)m +(erride)g(the)g(scaling)g(k)m(eyw)m(ords)g(in)f(the)h(header)0 +4652 y(\(e.g.,)h(to)f(turn)d(o\013)j(the)f(scaling)f(so)h(that)g(the)g +(program)g(can)g(write)f(the)h(ra)m(w)g(unscaled)f(v)-5 +b(alues)31 b(in)m(to)h(the)g(FITS)0 4765 y(\014le\).)42 +b(If)30 b(scaling)g(is)g(p)s(erformed,)f(the)i(in)m(v)m(erse)g(scaled)g +(output)f(v)-5 b(alue)31 b(that)g(is)f(written)g(in)m(to)h(the)g(FITS)f +(\014le)g(will)0 4878 y(ha)m(v)m(e)430 5183 y Fe(FITS)46 +b(value)h(=)g(\(\(input)f(value\))g(-)h(BZERO\))f(/)i(BSCALE)0 +5488 y Fi(\(a)39 b(corresp)s(onding)c(form)m(ula)i(using)g(TSCALn)f +(and)h(TZER)m(On)g(is)g(used)g(when)f(writing)g(to)j(table)f +(columns\).)0 5601 y(Rounding)18 b(to)j(the)g(nearest)g(in)m(teger,)h +(rather)f(than)f(truncation,)i(is)d(p)s(erformed)g(when)g(writing)f(in) +m(teger)j(datat)m(yp)s(es)0 5714 y(to)31 b(the)g(FITS)e(\014le.)p +eop +%%Page: 51 57 +51 56 bop 0 299 a Fg(6.8.)72 b(ERR)m(OR)30 b(ST)-8 b(A)g(TUS)30 +b(V)-10 b(ALUES)30 b(AND)h(THE)f(ERR)m(OR)g(MESSA)m(GE)h(ST)-8 +b(A)m(CK)848 b Fi(51)0 555 y Fd(6.8)135 b(Error)46 b(Status)f(V)-11 +b(alues)45 b(and)g(the)g(Error)g(Message)h(Stac)l(k)0 +809 y Fi(The)33 b(last)h(parameter)g(in)f(nearly)g(ev)m(ery)h(FITSIO)f +(subroutine)f(is)h(the)h(error)f(status)h(v)-5 b(alue)34 +b(whic)m(h)e(is)h(b)s(oth)g(an)0 922 y(input)i(and)g(an)i(output)f +(parameter.)60 b(A)36 b(returned)f(p)s(ositiv)m(e)h(v)-5 +b(alue)36 b(for)g(this)g(parameter)h(indicates)e(an)h(error)0 +1035 y(w)m(as)31 b(detected.)42 b(A)30 b(listing)e(of)j(all)e(the)i +(FITSIO)e(status)i(co)s(de)f(v)-5 b(alues)30 b(is)f(giv)m(en)i(at)g +(the)f(end)g(of)h(this)e(do)s(cumen)m(t.)0 1195 y(The)22 +b(FITSIO)g(library)e(uses)j(an)f(`inherited)f(status')i(con)m(v)m(en)m +(tion)h(for)f(the)g(status)g(parameter)g(whic)m(h)f(means)g(that)0 +1308 y(if)h(a)i(subroutine)e(is)g(called)h(with)f(a)i(p)s(ositiv)m(e)e +(input)g(v)-5 b(alue)24 b(of)h(the)f(status)h(parameter,)h(then)f(the)f +(subroutine)f(will)0 1421 y(exit)i(immediately)d(without)i(c)m(hanging) +h(the)f(v)-5 b(alue)24 b(of)h(the)g(status)g(parameter.)39 +b(Th)m(us,)25 b(if)f(one)g(passes)h(the)g(status)0 1533 +y(v)-5 b(alue)30 b(returned)f(from)h(eac)m(h)i(FITSIO)d(routine)g(as)i +(input)e(to)i(the)f(next)h(FITSIO)e(subroutine,)g(then)h(whenev)m(er)0 +1646 y(an)39 b(error)g(is)g(detected)h(all)f(further)f(FITSIO)g(pro)s +(cessing)g(will)f(cease.)69 b(This)38 b(con)m(v)m(en)m(tion)i(can)g +(simplify)c(the)0 1759 y(error)30 b(c)m(hec)m(king)i(in)d(application)g +(programs)i(b)s(ecause)g(it)f(is)g(not)h(necessary)g(to)g(c)m(hec)m(k)i +(the)e(v)-5 b(alue)30 b(of)h(the)g(status)0 1872 y(parameter)j(after)g +(ev)m(ery)g(single)f(FITSIO)f(subroutine)f(call.)50 b(If)33 +b(a)h(program)f(con)m(tains)h(a)g(sequence)g(of)g(sev)m(eral)0 +1985 y(FITSIO)23 b(calls,)h(one)g(can)g(just)g(c)m(hec)m(k)h(the)f +(status)g(v)-5 b(alue)23 b(after)i(the)f(last)f(call.)38 +b(Since)23 b(the)h(returned)e(status)j(v)-5 b(alues)0 +2098 y(are)36 b(generally)f(distinctiv)m(e,)h(it)f(should)f(b)s(e)h(p)s +(ossible)e(to)j(determine)f(whic)m(h)f(subroutine)g(originally)f +(returned)0 2211 y(the)e(error)f(status.)0 2371 y(FITSIO)i(also)h(main) +m(tains)e(an)i(in)m(ternal)f(stac)m(k)i(of)f(error)g(messages)h(\(80-c) +m(haracter)i(maxim)m(um)c(length\))g(whic)m(h)0 2484 +y(in)j(man)m(y)h(cases)h(pro)m(vide)e(a)h(more)g(detailed)g +(explanation)f(of)h(the)g(cause)h(of)f(the)g(error)g(than)f(is)g(pro)m +(vided)g(b)m(y)0 2597 y(the)40 b(error)e(status)i(n)m(um)m(b)s(er)e +(alone.)68 b(It)39 b(is)g(recommended)g(that)g(the)h(error)f(message)h +(stac)m(k)h(b)s(e)e(prin)m(ted)f(out)0 2710 y(whenev)m(er)31 +b(a)h(program)g(detects)g(a)g(FITSIO)e(error.)44 b(T)-8 +b(o)32 b(do)f(this,)g(call)g(the)h(FTGMSG)g(routine)e(rep)s(eatedly)h +(to)0 2823 y(get)i(the)g(successiv)m(e)f(messages)i(on)e(the)g(stac)m +(k.)48 b(When)32 b(the)h(stac)m(k)g(is)f(empt)m(y)g(FTGMSG)h(will)d +(return)h(a)h(blank)0 2936 y(string.)40 b(Note)31 b(that)g(this)e(is)g +(a)h(`First)g(In)f({)i(First)e(Out')h(stac)m(k,)i(so)e(the)h(oldest)f +(error)f(message)j(is)d(returned)g(\014rst)0 3049 y(b)m(y)h(ftgmsg.)0 +3399 y Fd(6.9)135 b(V)-11 b(ariable-Length)46 b(Arra)l(y)f(F)-11 +b(acilit)l(y)46 b(in)f(Binary)g(T)-11 b(ables)0 3653 +y Fi(FITSIO)38 b(pro)m(vides)h(easy-to-use)i(supp)s(ort)d(for)h +(reading)f(and)h(writing)f(data)i(in)e(v)-5 b(ariable)38 +b(length)h(\014elds)f(of)i(a)0 3766 y(binary)34 b(table.)55 +b(The)35 b(v)-5 b(ariable)34 b(length)g(columns)g(ha)m(v)m(e)j(TF)m +(ORMn)e(k)m(eyw)m(ord)h(v)-5 b(alues)34 b(of)i(the)f(form)g +(`1Pt\(len\)')0 3878 y(where)27 b(`t')g(is)f(the)i(datat)m(yp)s(e)g(co) +s(de)f(\(e.g.,)j(I,)d(J,)g(E,)g(D,)g(etc.\))41 b(and)27 +b(`len')f(is)h(an)f(in)m(teger)i(sp)s(ecifying)d(the)i(maxim)m(um)0 +3991 y(length)f(of)h(the)h(v)m(ector)g(in)e(the)h(table.)39 +b(If)27 b(the)g(v)-5 b(alue)26 b(of)h(`len')g(is)f(not)h(sp)s +(eci\014ed)e(when)h(the)h(table)g(is)f(created)i(\(e.g.,)0 +4104 y(if)e(the)i(TF)m(ORM)f(k)m(eyw)m(ord)h(v)-5 b(alue)27 +b(is)f(simply)f(sp)s(eci\014ed)h(as)h('1PE')h(instead)f(of)g +('1PE\(400\))j(\),)e(then)f(FITSIO)g(will)0 4217 y(automatically)i +(scan)g(the)g(table)g(when)f(it)h(is)f(closed)h(to)h(determine)e(the)h +(maxim)m(um)f(length)g(of)i(the)f(v)m(ector)i(and)0 4330 +y(will)d(app)s(end)g(this)i(v)-5 b(alue)30 b(to)h(the)f(TF)m(ORMn)g(v) +-5 b(alue.)0 4490 y(The)25 b(same)h(routines)f(whic)m(h)f(read)i(and)f +(write)g(data)h(in)e(an)i(ordinary)e(\014xed)h(length)g(binary)f(table) +h(extension)h(are)0 4603 y(also)k(used)f(for)h(v)-5 b(ariable)29 +b(length)h(\014elds,)e(ho)m(w)m(ev)m(er,)k(the)e(subroutine)e +(parameters)j(tak)m(e)h(on)e(a)g(sligh)m(tly)e(di\013eren)m(t)0 +4716 y(in)m(terpretation)i(as)g(describ)s(ed)f(b)s(elo)m(w.)0 +4876 y(All)35 b(the)h(data)h(in)e(a)i(v)-5 b(ariable)35 +b(length)g(\014eld)g(is)g(written)h(in)m(to)g(an)g(area)h(called)f(the) +g(`heap')g(whic)m(h)f(follo)m(ws)h(the)0 4989 y(main)25 +b(\014xed-length)g(FITS)g(binary)g(table.)39 b(The)25 +b(size)h(of)h(the)f(heap,)h(in)e(b)m(ytes,)i(is)e(sp)s(eci\014ed)g +(with)f(the)j(PCOUNT)0 5102 y(k)m(eyw)m(ord)21 b(in)e(the)i(FITS)f +(header.)37 b(When)20 b(creating)h(a)g(new)f(binary)f(table,)j(the)f +(initial)d(v)-5 b(alue)20 b(of)g(PCOUNT)g(should)0 5215 +y(usually)29 b(b)s(e)h(set)i(to)g(zero.)44 b(FITSIO)30 +b(will)e(recompute)k(the)f(size)g(of)h(the)f(heap)g(as)g(the)h(data)g +(is)e(written)g(and)h(will)0 5328 y(automatically)25 +b(up)s(date)f(the)i(PCOUNT)e(k)m(eyw)m(ord)h(v)-5 b(alue)25 +b(when)f(the)h(table)g(is)f(closed.)39 b(When)25 b(writing)e(v)-5 +b(ariable)0 5441 y(length)33 b(data)h(to)g(a)g(table,)h(CFITSIO)d(will) +e(automatically)k(extend)f(the)h(size)f(of)h(the)g(heap)f(area)h(if)f +(necessary)-8 b(,)0 5554 y(so)31 b(that)g(an)m(y)f(follo)m(wing)f(HDUs) +i(do)f(not)h(get)h(o)m(v)m(erwritten.)0 5714 y(By)e(default)e(the)i +(heap)f(data)i(area)f(starts)g(immediately)e(after)i(the)f(last)h(ro)m +(w)f(of)h(the)g(\014xed-length)e(table.)41 b(This)p eop +%%Page: 52 58 +52 57 bop 0 299 a Fi(52)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fi(default)26 b(starting)g(lo)s(cation)h(ma)m(y)g(b)s(e)f(o)m(v)m +(erridden)g(b)m(y)h(the)g(THEAP)f(k)m(eyw)m(ord,)i(but)f(this)e(is)h +(not)h(recommended.)0 668 y(If)34 b(additional)e(ro)m(ws)i(of)g(data)h +(are)g(added)e(to)i(the)f(table,)i(CFITSIO)c(will)g(automatically)i +(shift)e(the)j(the)f(heap)0 781 y(do)m(wn)g(to)i(mak)m(e)f(ro)s(om)g +(for)f(the)h(new)f(ro)m(ws,)i(but)e(it)h(is)e(ob)m(viously)h(b)s(e)g +(more)h(e\016cien)m(t)g(to)g(initially)c(create)37 b(the)0 +894 y(table)30 b(with)e(the)i(necessary)g(n)m(um)m(b)s(er)f(of)h(blank) +e(ro)m(ws,)i(so)g(that)g(the)g(heap)g(do)s(es)f(not)h(needed)g(to)g(b)s +(e)f(constan)m(tly)0 1007 y(mo)m(v)m(ed.)0 1167 y(When)40 +b(writing)f(to)i(a)g(v)-5 b(ariable)39 b(length)h(\014eld,)i(the)f(en)m +(tire)g(arra)m(y)g(of)f(v)-5 b(alues)40 b(for)g(a)h(giv)m(en)g(ro)m(w)g +(of)f(the)h(table)0 1280 y(m)m(ust)36 b(b)s(e)g(written)f(with)g(a)h +(single)f(call)h(to)h(FTPCLx.)57 b(The)36 b(total)h(length)f(of)g(the)g +(arra)m(y)h(is)e(calculated)h(from)0 1393 y(\(NELEM+FELEM-1\).)44 +b(One)30 b(cannot)i(app)s(end)d(more)i(elemen)m(ts)g(to)h(an)e +(existing)g(\014eld)g(at)h(a)h(later)f(time;)g(an)m(y)0 +1506 y(attempt)k(to)f(do)g(so)g(will)d(simply)g(o)m(v)m(erwrite)k(all)d +(the)i(data)h(whic)m(h)d(w)m(as)i(previously)e(written.)50 +b(Note)35 b(also)e(that)0 1619 y(the)h(new)g(data)g(will)e(b)s(e)h +(written)g(to)i(a)f(new)g(area)g(of)g(the)h(heap)e(and)h(the)g(heap)g +(space)g(used)f(b)m(y)h(the)g(previous)0 1732 y(write)i(cannot)i(b)s(e) +e(reclaimed.)60 b(F)-8 b(or)38 b(this)e(reason)h(it)g(is)f(advised)g +(that)i(eac)m(h)g(ro)m(w)f(of)h(a)f(v)-5 b(ariable)36 +b(length)g(\014eld)0 1844 y(only)c(b)s(e)h(written)f(once.)50 +b(An)33 b(exception)g(to)h(this)e(general)h(rule)f(o)s(ccurs)h(when)f +(setting)h(elemen)m(ts)h(of)f(an)g(arra)m(y)0 1957 y(as)38 +b(unde\014ned.)63 b(One)37 b(m)m(ust)i(\014rst)e(write)g(a)i(dumm)m(y)e +(v)-5 b(alue)38 b(in)m(to)g(the)h(arra)m(y)f(with)f(FTPCLx,)j(and)e +(then)g(call)0 2070 y(FTPCLU)33 b(to)i(\015ag)f(the)f(desired)g(elemen) +m(ts)h(as)f(unde\014ned.)49 b(\(Do)35 b(not)f(use)f(the)h(FTPCNx)f +(family)f(of)i(routines)0 2183 y(with)27 b(v)-5 b(ariable)28 +b(length)g(\014elds\).)39 b(Note)30 b(that)f(the)g(ro)m(ws)g(of)g(a)g +(table,)g(whether)f(\014xed)g(or)h(v)-5 b(ariable)27 +b(length,)i(do)g(not)0 2296 y(ha)m(v)m(e)j(to)f(b)s(e)e(written)h +(consecutiv)m(ely)g(and)g(ma)m(y)h(b)s(e)f(written)f(in)g(an)m(y)i +(order.)0 2456 y(When)40 b(writing)f(to)i(a)g(v)-5 b(ariable)39 +b(length)h(ASCI)s(I)f(c)m(haracter)j(\014eld)d(\(e.g.,)45 +b(TF)m(ORM)c(=)f('1P)-8 b(A'\))43 b(only)c(a)i(single)0 +2569 y(c)m(haracter)33 b(string)e(written.)43 b(FTPCLS)30 +b(writes)h(the)h(whole)e(length)h(of)h(the)g(input)d(string)i(\(min)m +(us)f(an)m(y)i(trailing)0 2682 y(blank)k(c)m(haracters\),)42 +b(th)m(us)37 b(the)h(NELEM)f(and)g(FELEM)h(parameters)g(are)g(ignored.) +61 b(If)37 b(the)h(input)d(string)i(is)0 2795 y(completely)26 +b(blank)g(then)g(FITSIO)g(will)e(write)i(one)h(blank)e(c)m(haracter)k +(to)e(the)g(FITS)f(\014le.)39 b(Similarly)-8 b(,)24 b(FTGCVS)0 +2908 y(and)35 b(FTGCFS)g(read)g(the)h(en)m(tire)f(string)g(\(truncated) +g(to)i(the)e(width)f(of)h(the)h(c)m(haracter)h(string)d(argumen)m(t)i +(in)0 3021 y(the)31 b(subroutine)d(call\))i(and)g(also)g(ignore)g(the)g +(NELEM)h(and)f(FELEM)g(parameters.)0 3181 y(The)35 b(FTPDES)h +(subroutine)d(is)i(useful)f(in)g(situations)h(where)g(m)m(ultiple)f(ro) +m(ws)h(of)h(a)g(v)-5 b(ariable)35 b(length)g(column)0 +3294 y(ha)m(v)m(e)d(the)e(iden)m(tical)f(arra)m(y)i(of)g(v)-5 +b(alues.)40 b(One)30 b(can)g(simply)e(write)i(the)g(arra)m(y)h(once)g +(for)g(the)f(\014rst)g(ro)m(w,)g(and)g(then)0 3407 y(use)36 +b(FTPDES)g(to)h(write)f(the)g(same)h(descriptor)f(v)-5 +b(alues)35 b(in)m(to)i(the)f(other)h(ro)m(ws)f(\(use)h(the)f(FTGDES)h +(routine)0 3520 y(to)f(read)f(the)h(\014rst)f(descriptor)f(v)-5 +b(alue\);)38 b(all)c(the)i(ro)m(ws)f(will)e(then)i(p)s(oin)m(t)f(to)i +(the)g(same)f(storage)i(lo)s(cation)e(th)m(us)0 3633 +y(sa)m(ving)30 b(disk)f(space.)0 3793 y(When)35 b(reading)f(from)g(a)i +(v)-5 b(ariable)33 b(length)i(arra)m(y)g(\014eld)f(one)h(can)g(only)g +(read)f(as)i(man)m(y)f(elemen)m(ts)g(as)g(actually)0 +3906 y(exist)h(in)e(that)j(ro)m(w)e(of)h(the)g(table;)j(reading)c(do)s +(es)h(not)g(automatically)f(con)m(tin)m(ue)h(with)f(the)h(next)g(ro)m +(w)g(of)g(the)0 4019 y(table)28 b(as)g(o)s(ccurs)g(when)f(reading)g(an) +h(ordinary)f(\014xed)g(length)g(table)h(\014eld.)39 b(A)m(ttempts)29 +b(to)g(read)f(more)g(than)g(this)0 4131 y(will)h(cause)k(an)e(error)h +(status)g(to)g(b)s(e)f(returned.)44 b(One)32 b(can)g(determine)f(the)h +(n)m(um)m(b)s(er)e(of)i(elemen)m(ts)g(in)f(eac)m(h)i(ro)m(w)0 +4244 y(of)e(a)f(v)-5 b(ariable)29 b(column)h(with)f(the)h(FTGDES)h +(subroutine.)0 4657 y Fd(6.10)136 b(Supp)t(ort)44 b(for)h(IEEE)g(Sp)t +(ecial)h(V)-11 b(alues)0 4924 y Fi(The)26 b(ANSI/IEEE-754)h +(\015oating-p)s(oin)m(t)f(n)m(um)m(b)s(er)f(standard)g(de\014nes)h +(certain)g(sp)s(ecial)f(v)-5 b(alues)25 b(that)i(are)g(used)e(to)0 +5036 y(represen)m(t)j(suc)m(h)g(quan)m(tities)f(as)h(Not-a-Num)m(b)s +(er)h(\(NaN\),)h(denormalized,)d(under\015o)m(w,)g(o)m(v)m(er\015o)m +(w,)j(and)d(in\014nit)m(y)-8 b(.)0 5149 y(\(See)29 b(the)f(App)s(endix) +d(in)i(the)h(NOST)g(FITS)f(standard)g(or)h(the)g(NOST)g(FITS)f(User's)h +(Guide)f(for)h(a)g(list)f(of)h(these)0 5262 y(v)-5 b(alues\).)40 +b(The)30 b(FITSIO)f(subroutines)f(that)j(read)f(\015oating)h(p)s(oin)m +(t)e(data)i(in)e(FITS)g(\014les)h(recognize)h(these)g(IEEE)0 +5375 y(sp)s(ecial)38 b(v)-5 b(alues)38 b(and)h(b)m(y)g(default)f(in)m +(terpret)h(the)g(o)m(v)m(er\015o)m(w)i(and)d(in\014nit)m(y)f(v)-5 +b(alues)39 b(as)g(b)s(eing)f(equiv)-5 b(alen)m(t)39 b(to)h(a)0 +5488 y(NaN,)35 b(and)e(con)m(v)m(ert)i(the)f(under\015o)m(w)e(and)h +(denormalized)f(v)-5 b(alues)33 b(in)m(to)h(zeros.)51 +b(In)33 b(some)h(cases)h(programmers)0 5601 y(ma)m(y)d(w)m(an)m(t)g +(access)g(to)g(the)g(ra)m(w)f(IEEE)g(v)-5 b(alues,)31 +b(without)f(an)m(y)i(mo)s(di\014cation)d(b)m(y)i(FITSIO.)g(This)e(can)j +(b)s(e)e(done)0 5714 y(b)m(y)k(calling)g(the)g(FTGPVx)h(or)g(FTGCVx)g +(routines)e(while)g(sp)s(ecifying)f(0.0)k(as)f(the)f(v)-5 +b(alue)34 b(of)h(the)g(NULL)-10 b(V)g(AL)p eop +%%Page: 53 59 +53 58 bop 0 299 a Fg(6.11.)73 b(WHEN)31 b(THE)f(FINAL)g(SIZE)f(OF)i +(THE)f(FITS)f(HDU)i(IS)f(UNKNO)m(WN)978 b Fi(53)0 555 +y(parameter.)72 b(This)38 b(will)g(force)j(FITSIO)e(to)j(simply)c(pass) +i(the)g(IEEE)g(v)-5 b(alues)40 b(through)g(to)h(the)g(application)0 +668 y(program,)30 b(without)f(an)m(y)h(mo)s(di\014cation.)39 +b(This)29 b(do)s(es)g(not)h(w)m(ork)g(for)g(double)f(precision)f(v)-5 +b(alues)29 b(on)h(V)-10 b(AX/VMS)0 781 y(mac)m(hines,)37 +b(ho)m(w)m(ev)m(er,)i(where)d(there)g(is)f(no)h(easy)g(w)m(a)m(y)h(to)g +(b)m(ypass)f(the)g(default)f(in)m(terpretation)g(of)h(the)h(IEEE)0 +894 y(sp)s(ecial)29 b(v)-5 b(alues.)0 1393 y Fd(6.11)136 +b(When)44 b(the)h(Final)h(Size)f(of)g(the)g(FITS)f(HDU)h(is)g(Unkno)l +(wn)0 1676 y Fi(It)27 b(is)g(not)g(required)e(to)j(kno)m(w)f(the)h +(total)g(size)f(of)g(a)h(FITS)e(data)i(arra)m(y)g(or)f(table)g(b)s +(efore)g(b)s(eginning)d(to)k(write)f(the)0 1789 y(data)32 +b(to)f(the)g(FITS)f(\014le.)42 b(In)30 b(the)h(case)h(of)f(the)g +(primary)e(arra)m(y)i(or)g(an)f(image)i(extension,)e(one)i(should)c +(initially)0 1902 y(create)j(the)e(arra)m(y)h(with)d(the)j(size)f(of)g +(the)g(highest)f(dimension)f(\(largest)j(NAXISn)e(k)m(eyw)m(ord\))i +(set)g(to)g(a)f(dumm)m(y)0 2015 y(v)-5 b(alue,)25 b(suc)m(h)f(as)g(1.) +39 b(Then)23 b(after)i(all)e(the)i(data)f(ha)m(v)m(e)i(b)s(een)d +(written)g(and)h(the)g(true)g(dimensions)e(are)i(kno)m(wn,)h(then)0 +2128 y(the)31 b(NAXISn)e(v)-5 b(alue)30 b(should)f(b)s(e)h(up)s(dated)f +(using)g(the)i(\014ts)p 2051 2128 28 4 v 62 w(up)s(date)p +2389 2128 V 32 w(k)m(ey)h(routine)d(b)s(efore)h(mo)m(ving)h(to)g +(another)0 2240 y(extension)f(or)g(closing)g(the)g(FITS)g(\014le.)0 +2401 y(When)f(writing)e(to)i(FITS)g(tables,)g(CFITSIO)e(automatically)i +(k)m(eeps)h(trac)m(k)g(of)f(the)g(highest)g(ro)m(w)g(n)m(um)m(b)s(er)e +(that)0 2514 y(is)k(written)g(to,)i(and)e(will)e(increase)j(the)g(size) +g(of)g(the)g(table)f(if)g(necessary)-8 b(.)46 b(CFITSIO)30 +b(will)f(also)j(automatically)0 2626 y(insert)j(space)i(in)e(the)h +(FITS)f(\014le)h(if)f(necessary)-8 b(,)39 b(to)e(ensure)e(that)i(the)f +(data)h('heap',)h(if)d(it)h(exists,)h(and/or)g(an)m(y)0 +2739 y(additional)26 b(HDUs)j(that)g(follo)m(w)e(the)i(table)f(do)g +(not)h(get)g(o)m(v)m(erwritten)g(as)f(new)g(ro)m(ws)g(are)h(written)e +(to)i(the)g(table.)0 2900 y(As)37 b(a)h(general)f(rule)f(it)h(is)f(b)s +(est)h(to)h(sp)s(ecify)e(the)i(initial)c(n)m(um)m(b)s(er)i(of)i(ro)m +(ws)f(=)g(0)g(when)g(the)g(table)g(is)g(created,)0 3012 +y(then)h(let)g(CFITSIO)f(k)m(eep)i(trac)m(k)g(of)g(the)f(n)m(um)m(b)s +(er)f(of)i(ro)m(ws)f(that)h(are)f(actually)g(written.)64 +b(The)38 b(application)0 3125 y(program)e(should)e(not)j(man)m(ually)e +(up)s(date)g(the)i(n)m(um)m(b)s(er)e(of)h(ro)m(ws)g(in)f(the)i(table)f +(\(as)h(giv)m(en)f(b)m(y)g(the)h(NAXIS2)0 3238 y(k)m(eyw)m(ord\))j +(since)e(CFITSIO)f(do)s(es)i(this)f(automatically)-8 +b(.)66 b(If)38 b(a)i(table)e(is)g(initially)e(created)k(with)d(more)i +(than)0 3351 y(zero)i(ro)m(ws,)j(then)c(this)g(will)d(usually)i(b)s(e)h +(considered)f(as)i(the)g(minim)m(um)d(size)i(of)h(the)g(table,)i(ev)m +(en)e(if)f(few)m(er)0 3464 y(ro)m(ws)30 b(are)g(actually)f(written)g +(to)i(the)f(table.)40 b(Th)m(us,)30 b(if)e(a)j(table)e(is)g(initially)d +(created)31 b(with)e(NAXIS2)h(=)f(20,)j(and)0 3577 y(CFITSIO)f(only)h +(writes)f(10)j(ro)m(ws)e(of)h(data)g(b)s(efore)f(closing)g(the)h +(table,)g(then)f(NAXIS2)h(will)d(remain)h(equal)h(to)0 +3690 y(20.)50 b(If)33 b(ho)m(w)m(ev)m(er,)i(30)g(ro)m(ws)e(of)g(data)h +(are)g(written)e(to)i(this)e(table,)i(then)f(NAXIS2)h(will)c(b)s(e)j +(increased)f(from)h(20)0 3803 y(to)f(30.)44 b(The)31 +b(one)g(exception)h(to)g(this)e(automatic)i(up)s(dating)d(of)i(the)h +(NAXIS2)f(k)m(eyw)m(ord)h(is)e(if)g(the)i(application)0 +3916 y(program)c(directly)e(mo)s(di\014es)g(the)j(v)-5 +b(alue)27 b(of)h(NAXIS2)g(\(up)f(or)h(do)m(wn\))g(itself)f(just)g(b)s +(efore)h(closing)f(the)h(table.)40 b(In)0 4029 y(this)27 +b(case,)j(CFITSIO)d(do)s(es)h(not)h(up)s(date)e(NAXIS2)i(again,)g +(since)f(it)g(assumes)g(that)h(the)f(application)f(program)0 +4142 y(m)m(ust)32 b(ha)m(v)m(e)h(had)f(a)g(go)s(o)s(d)g(reason)h(for)f +(c)m(hanging)g(the)g(v)-5 b(alue)32 b(directly)-8 b(.)45 +b(This)30 b(is)h(not)i(recommended,)f(ho)m(w)m(ev)m(er,)0 +4254 y(and)j(is)g(only)g(pro)m(vided)g(for)g(bac)m(kw)m(ard)h +(compatibilit)m(y)e(with)h(soft)m(w)m(are)i(that)g(initially)32 +b(creates)37 b(a)f(table)g(with)0 4367 y(a)e(large)g(n)m(um)m(b)s(er)f +(of)h(ro)m(ws,)h(than)f(decreases)g(the)h(NAXIS2)f(v)-5 +b(alue)33 b(to)i(the)f(actual)g(smaller)f(v)-5 b(alue)33 +b(just)g(b)s(efore)0 4480 y(closing)c(the)i(table.)0 +4979 y Fd(6.12)136 b(Lo)t(cal)45 b(FITS)e(Con)l(v)l(en)l(tions)k(supp)t +(orted)d(b)l(y)h(FITSIO)0 5262 y Fi(CFITSIO)25 b(supp)s(orts)g(sev)m +(eral)i(lo)s(cal)e(FITS)h(con)m(v)m(en)m(tions)i(whic)m(h)d(are)i(not)g +(de\014ned)e(in)g(the)i(o\016cial)f(NOST)g(FITS)0 5375 +y(standard)k(and)g(whic)m(h)g(are)h(not)g(necessarily)e(recognized)i +(or)g(supp)s(orted)e(b)m(y)i(other)g(FITS)f(soft)m(w)m(are)i(pac)m(k)-5 +b(ages.)0 5488 y(Programmers)36 b(should)e(b)s(e)h(cautious)h(ab)s(out) +f(using)g(these)h(features,)i(esp)s(ecially)c(if)h(the)h(FITS)f +(\014les)g(that)i(are)0 5601 y(pro)s(duced)31 b(are)i(exp)s(ected)g(to) +g(b)s(e)f(pro)s(cessed)g(b)m(y)h(other)f(soft)m(w)m(are)i(systems)f +(whic)m(h)e(do)i(not)f(use)h(the)f(CFITSIO)0 5714 y(in)m(terface.)p +eop +%%Page: 54 60 +54 59 bop 0 299 a Fi(54)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fb(6.12.1)113 b(Supp)s(ort)37 b(for)h(Long)g(String)e(Keyw)m(ord)i(V)-9 +b(alues.)0 774 y Fi(The)23 b(length)h(of)g(a)g(standard)f(FITS)g +(string)g(k)m(eyw)m(ord)h(is)f(limited)f(to)i(68)h(c)m(haracters)g(b)s +(ecause)f(it)f(m)m(ust)h(\014t)g(en)m(tirely)0 887 y(within)33 +b(a)j(single)f(FITS)g(header)h(k)m(eyw)m(ord)g(record.)57 +b(In)35 b(some)h(instances)f(it)h(is)e(necessary)j(to)f(enco)s(de)g +(strings)0 1000 y(longer)26 b(than)g(this)f(limit,)g(so)h(FITSIO)f +(supp)s(orts)f(a)j(lo)s(cal)e(con)m(v)m(en)m(tion)i(in)e(whic)m(h)g +(the)h(string)f(v)-5 b(alue)26 b(is)f(con)m(tin)m(ued)0 +1113 y(o)m(v)m(er)34 b(m)m(ultiple)d(k)m(eyw)m(ords.)49 +b(This)31 b(con)m(tin)m(uation)i(con)m(v)m(en)m(tion)i(uses)d(an)h(amp) +s(ersand)f(c)m(haracter)i(at)g(the)f(end)g(of)0 1226 +y(eac)m(h)c(substring)c(to)j(indicate)f(that)h(it)f(is)g(con)m(tin)m +(ued)g(on)g(the)h(next)g(k)m(eyw)m(ord,)h(and)d(the)i(con)m(tin)m +(uation)g(k)m(eyw)m(ords)0 1339 y(all)42 b(ha)m(v)m(e)j(the)f(name)f +(CONTINUE)g(without)f(an)i(equal)f(sign)f(in)g(column)h(9.)80 +b(The)43 b(string)g(v)-5 b(alue)42 b(ma)m(y)j(b)s(e)0 +1452 y(con)m(tin)m(ued)28 b(in)f(this)h(w)m(a)m(y)h(o)m(v)m(er)h(as)e +(man)m(y)h(additional)d(CONTINUE)i(k)m(eyw)m(ords)g(as)h(is)e +(required.)39 b(The)27 b(follo)m(wing)0 1564 y(lines)i(illustrate)f +(this)h(con)m(tin)m(uation)i(con)m(v)m(en)m(tion)g(whic)m(h)e(is)h +(used)f(in)g(the)i(v)-5 b(alue)30 b(of)g(the)h(STRKEY)e(k)m(eyw)m(ord:) +0 1802 y Fe(LONGSTRN=)45 b('OGIP)i(1.0')524 b(/)47 b(The)g(OGIP)g(Long) +f(String)g(Convention)f(may)i(be)g(used.)0 1915 y(STRKEY)94 +b(=)47 b('This)g(is)g(a)g(very)g(long)g(string)f(keyword&')93 +b(/)47 b(Optional)f(Comment)0 2028 y(CONTINUE)93 b(')48 +b(value)e(that)h(is)g(continued)e(over)i(3)g(keywords)f(in)h(the)g(&)95 +b(')0 2141 y(CONTINUE)e('FITS)47 b(header.')e(/)j(This)e(is)h(another)f +(optional)g(comment.)0 2379 y Fi(It)29 b(is)f(recommended)g(that)h(the) +g(LONGSTRN)f(k)m(eyw)m(ord,)i(as)f(sho)m(wn)f(here,)h(alw)m(a)m(ys)h(b) +s(e)e(included)e(in)h(an)m(y)i(HDU)0 2492 y(that)f(uses)e(this)g +(longstring)g(con)m(v)m(en)m(tion.)41 b(A)27 b(subroutine)e(called)h +(FTPLSW)h(has)g(b)s(een)f(pro)m(vided)g(in)f(CFITSIO)0 +2605 y(to)31 b(write)f(this)f(k)m(eyw)m(ord)i(if)e(it)h(do)s(es)g(not)h +(already)f(exist.)0 2765 y(This)22 b(long)i(string)g(con)m(v)m(en)m +(tion)h(is)e(supp)s(orted)g(b)m(y)h(the)g(follo)m(wing)f(FITSIO)g +(subroutines)f(that)j(deal)f(with)f(string-)0 2878 y(v)-5 +b(alued)29 b(k)m(eyw)m(ords:)286 3116 y Fe(ftgkys)46 +b(-)i(read)f(a)g(string)f(keyword)286 3229 y(ftpkls)g(-)i(write)e +(\(append\))g(a)h(string)f(keyword)286 3342 y(ftikls)g(-)i(insert)e(a)h +(string)g(keyword)286 3455 y(ftmkls)f(-)i(modify)e(the)h(value)f(of)h +(an)h(existing)d(string)h(keyword)286 3568 y(ftukls)g(-)i(update)e(an)h +(existing)f(keyword,)f(or)i(write)g(a)g(new)g(keyword)286 +3681 y(ftdkey)f(-)i(delete)e(a)h(keyword)0 3919 y Fi(These)41 +b(routines)e(will)f(transparen)m(tly)i(read,)k(write,)f(or)e(delete)g +(a)g(long)f(string)g(v)-5 b(alue)40 b(in)g(the)h(FITS)f(\014le,)j(so)0 +4031 y(programmers)36 b(in)f(general)h(do)g(not)h(ha)m(v)m(e)g(to)g(b)s +(e)f(concerned)g(ab)s(out)g(the)g(details)g(of)g(the)h(con)m(v)m(en)m +(tion)g(that)g(is)0 4144 y(used)32 b(to)i(enco)s(de)f(the)g(long)f +(string)g(in)g(the)h(FITS)f(header.)48 b(When)33 b(reading)f(a)h(long)g +(string,)g(one)g(m)m(ust)g(ensure)0 4257 y(that)h(the)f(c)m(haracter)i +(string)e(parameter)h(used)e(in)g(these)i(subroutine)d(calls)i(has)g(b) +s(een)f(declared)h(long)g(enough)0 4370 y(to)e(hold)e(the)i(en)m(tire)f +(string,)g(otherwise)f(the)i(returned)e(string)g(v)-5 +b(alue)30 b(will)e(b)s(e)i(truncated.)0 4530 y(Note)d(that)e(the)h +(more)f(commonly)g(used)f(FITSIO)g(subroutine)g(to)i(write)e(string)g +(v)-5 b(alued)24 b(k)m(eyw)m(ords)i(\(FTPKYS\))0 4643 +y(do)s(es)38 b(NOT)g(supp)s(ort)f(this)g(long)h(string)g(con)m(v)m(en)m +(tion)h(and)f(only)g(supp)s(orts)e(strings)h(up)h(to)h(68)g(c)m +(haracters)h(in)0 4756 y(length.)h(This)29 b(has)h(b)s(een)g(done)h +(delib)s(erately)d(to)k(prev)m(en)m(t)f(programs)g(from)f(inadv)m +(erten)m(tly)g(writing)f(k)m(eyw)m(ords)0 4869 y(using)37 +b(this)h(non-standard)f(con)m(v)m(en)m(tion)j(without)e(the)g(explicit) +f(in)m(ten)m(t)i(of)g(the)g(programmer)f(or)h(user.)64 +b(The)0 4982 y(FTPKLS)28 b(subroutine)f(m)m(ust)i(b)s(e)g(called)f +(instead)h(to)h(write)e(long)h(strings.)39 b(This)27 +b(routine)i(can)g(also)g(b)s(e)g(used)f(to)0 5095 y(write)i(ordinary)e +(string)i(v)-5 b(alues)29 b(less)h(than)g(68)h(c)m(haracters)h(in)d +(length.)0 5382 y Fb(6.12.2)113 b(Arra)m(ys)37 b(of)g(Fixed-Length)i +(Strings)e(in)f(Binary)h(T)-9 b(ables)0 5601 y Fi(The)29 +b(de\014nition)e(of)j(the)f(FITS)g(binary)e(table)j(extension)f(format) +g(do)s(es)h(not)f(pro)m(vide)g(a)g(simple)f(w)m(a)m(y)i(to)g(sp)s +(ecify)0 5714 y(that)f(a)f(c)m(haracter)i(column)d(con)m(tains)h(an)g +(arra)m(y)h(of)f(\014xed-length)f(strings.)39 b(T)-8 +b(o)29 b(supp)s(ort)d(this)h(feature,)i(FITSIO)p eop +%%Page: 55 61 +55 60 bop 0 299 a Fg(6.12.)73 b(LOCAL)29 b(FITS)h(CONVENTIONS)f(SUPPOR) +-8 b(TED)29 b(BY)i(FITSIO)1168 b Fi(55)0 555 y(uses)31 +b(a)h(lo)s(cal)f(con)m(v)m(en)m(tion)h(for)f(the)h(format)g(of)g(the)f +(TF)m(ORMn)g(k)m(eyw)m(ord)h(v)-5 b(alue)31 b(of)h(the)g(form)f('rAw')g +(where)g('r')0 668 y(is)c(an)g(in)m(teger)h(sp)s(ecifying)d(the)j +(total)g(width)e(in)g(c)m(haracters)j(of)f(the)g(column,)f(and)g('w')g +(is)g(an)g(in)m(teger)h(sp)s(ecifying)0 781 y(the)c(\(\014xed\))g +(length)g(of)g(an)g(individual)19 b(unit)k(string)g(within)e(the)j(v)m +(ector.)41 b(F)-8 b(or)24 b(example,)i(TF)m(ORM1)e(=)g('120A10')0 +894 y(w)m(ould)k(indicate)g(that)h(the)h(binary)d(table)i(column)f(is)g +(120)i(c)m(haracters)g(wide)e(and)h(consists)f(of)h(12)h(10-c)m +(haracter)0 1007 y(length)e(strings.)39 b(This)27 b(con)m(v)m(en)m +(tion)j(is)d(recognized)i(b)m(y)g(the)f(FITSIO)g(subroutines)e(that)j +(read)g(or)f(write)g(strings)0 1120 y(in)37 b(binary)f(tables.)64 +b(The)37 b(Binary)g(T)-8 b(able)38 b(de\014nition)e(do)s(cumen)m(t)i +(sp)s(eci\014es)e(that)j(other)f(optional)f(c)m(haracters)0 +1233 y(ma)m(y)f(follo)m(w)f(the)g(datat)m(yp)s(e)i(co)s(de)e(in)g(the)g +(TF)m(ORM)h(k)m(eyw)m(ord,)i(so)d(this)g(lo)s(cal)f(con)m(v)m(en)m +(tion)j(is)d(in)h(compliance)0 1346 y(with)23 b(the)i(FITS)f(standard,) +i(although)e(other)h(FITS)f(readers)g(are)h(not)g(required)e(to)i +(recognize)h(this)e(con)m(v)m(en)m(tion.)0 1506 y(The)h(Binary)g(T)-8 +b(able)26 b(de\014nition)d(do)s(cumen)m(t)j(that)h(w)m(as)f(appro)m(v)m +(ed)g(b)m(y)g(the)g(IA)m(U)g(in)f(1994)j(con)m(tains)e(an)f(app)s +(endix)0 1619 y(describing)20 b(an)j(alternate)g(con)m(v)m(en)m(tion)h +(for)f(sp)s(ecifying)d(arra)m(ys)j(of)g(\014xed)f(or)h(v)-5 +b(ariable)22 b(length)g(strings)f(in)h(a)h(binary)0 1732 +y(table)34 b(c)m(haracter)h(column)e(\(with)g(the)i(form)e +('rA:SSTRw/nnn\)'.)50 b(This)32 b(app)s(endix)f(w)m(as)k(not)f +(o\016cially)f(v)m(oted)0 1844 y(on)d(b)m(y)h(the)f(IA)m(U)h(and)f +(hence)g(is)g(still)e(pro)m(visional.)39 b(FITSIO)29 +b(do)s(es)h(not)h(curren)m(tly)e(supp)s(ort)g(this)g(prop)s(osal.)0 +2147 y Fb(6.12.3)113 b(Keyw)m(ord)37 b(Units)g(Strings)0 +2368 y Fi(One)g(de\014ciency)g(of)h(the)g(curren)m(t)g(FITS)f(Standard) +f(is)h(that)i(it)e(do)s(es)g(not)h(de\014ne)f(a)i(sp)s(eci\014c)d(con)m +(v)m(en)m(tion)j(for)0 2481 y(recording)29 b(the)h(ph)m(ysical)f(units) +g(of)h(a)g(k)m(eyw)m(ord)h(v)-5 b(alue.)40 b(The)30 b(TUNITn)f(k)m(eyw) +m(ord)h(can)g(b)s(e)g(used)f(to)i(sp)s(ecify)e(the)0 +2594 y(ph)m(ysical)34 b(units)g(of)h(the)h(v)-5 b(alues)35 +b(in)f(a)h(table)h(column,)f(but)g(there)g(is)g(no)g(analogous)h(con)m +(v)m(en)m(tion)g(for)f(k)m(eyw)m(ord)0 2707 y(v)-5 b(alues.)41 +b(The)30 b(commen)m(t)h(\014eld)f(of)g(the)h(k)m(eyw)m(ord)g(is)f +(often)h(used)f(for)g(this)f(purp)s(ose,)h(but)f(the)i(units)e(are)i +(usually)0 2819 y(not)g(sp)s(eci\014ed)d(in)h(a)i(w)m(ell)e(de\014ned)h +(format)g(that)h(FITS)f(readers)g(can)h(easily)e(recognize)i(and)f +(extract.)0 2980 y(T)-8 b(o)28 b(solv)m(e)g(this)e(de\014ciency)-8 +b(,)29 b(FITSIO)d(uses)h(a)h(lo)s(cal)f(con)m(v)m(en)m(tion)i(in)d +(whic)m(h)g(the)i(k)m(eyw)m(ord)g(units)e(are)i(enclosed)f(in)0 +3093 y(square)20 b(brac)m(k)m(ets)j(as)e(the)f(\014rst)g(tok)m(en)i(in) +e(the)g(k)m(eyw)m(ord)i(commen)m(t)f(\014eld;)i(more)e(sp)s +(eci\014cally)-8 b(,)21 b(the)g(op)s(ening)e(square)0 +3205 y(brac)m(k)m(et)28 b(immediately)d(follo)m(ws)g(the)i(slash)e('/') +i(commen)m(t)h(\014eld)d(delimiter)f(and)i(a)g(single)f(space)i(c)m +(haracter.)41 b(The)0 3318 y(follo)m(wing)29 b(examples)h(illustrate)e +(k)m(eyw)m(ords)j(that)g(use)f(this)f(con)m(v)m(en)m(tion:)0 +3588 y Fe(EXPOSURE=)713 b(1800.0)47 b(/)g([s])g(elapsed)f(exposure)f +(time)0 3701 y(V_HELIO)h(=)763 b(16.23)47 b(/)g([km)g(s**\(-1\)])e +(heliocentric)g(velocity)0 3814 y(LAMBDA)94 b(=)763 b(5400.)47 +b(/)g([angstrom])e(central)h(wavelength)0 3927 y(FLUX)190 +b(=)47 b(4.9033487787637465E-30)42 b(/)47 b([J/cm**2/s])e(average)h +(flux)0 4196 y Fi(In)28 b(general,)g(the)h(units)d(named)i(in)f(the)i +(IA)m(U\(1988\))i(St)m(yle)d(Guide)f(are)i(recommended,)f(with)f(the)i +(main)e(excep-)0 4309 y(tion)j(that)h(the)f(preferred)g(unit)e(for)j +(angle)f(is)f('deg')j(for)e(degrees.)0 4469 y(The)24 +b(FTPUNT)g(and)g(FTGUNT)h(subroutines)e(in)g(FITSIO)g(write)h(and)g +(read,)i(resp)s(ectiv)m(ely)-8 b(,)26 b(the)e(k)m(eyw)m(ord)h(unit)0 +4582 y(strings)k(in)g(an)i(existing)e(k)m(eyw)m(ord.)0 +4884 y Fb(6.12.4)113 b(HIERAR)m(CH)34 b(Con)m(v)m(en)m(tion)j(for)g +(Extended)h(Keyw)m(ord)f(Names)0 5106 y Fi(CFITSIO)k(supp)s(orts)g(the) +i(HIERAR)m(CH)g(k)m(eyw)m(ord)g(con)m(v)m(en)m(tion)h(whic)m(h)e(allo)m +(ws)g(k)m(eyw)m(ord)h(names)g(that)h(are)0 5218 y(longer)33 +b(then)f(8)i(c)m(haracters)g(and)f(ma)m(y)h(con)m(tain)f(the)g(full)e +(range)i(of)h(prin)m(table)d(ASCI)s(I)g(text)j(c)m(haracters.)51 +b(This)0 5331 y(con)m(v)m(en)m(tion)38 b(w)m(as)g(dev)m(elop)s(ed)e(at) +i(the)f(Europ)s(ean)f(Southern)g(Observ)-5 b(atory)37 +b(\(ESO\))f(to)i(supp)s(ort)d(hierarc)m(hical)0 5444 +y(FITS)30 b(k)m(eyw)m(ord)g(suc)m(h)h(as:)0 5714 y Fe(HIERARCH)46 +b(ESO)g(INS)h(FOCU)g(POS)g(=)g(-0.00002500)e(/)j(Focus)e(position)p +eop +%%Page: 56 62 +56 61 bop 0 299 a Fi(56)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fi(Basically)-8 b(,)52 b(this)46 b(con)m(v)m(en)m(tion)j(uses)e(the)h +(FITS)f(k)m(eyw)m(ord)h('HIERAR)m(CH')h(to)f(indicate)f(that)h(this)e +(con)m(v)m(en-)0 668 y(tion)e(is)f(b)s(eing)g(used,)k(then)d(the)g +(actual)h(k)m(eyw)m(ord)f(name)h(\()p Fe('ESO)i(INS)f(FOCU)h(POS')c +Fi(in)g(this)g(example\))h(b)s(e-)0 781 y(gins)39 b(in)f(column)g(10)j +(and)e(can)h(con)m(tain)f(an)m(y)h(prin)m(table)e(ASCI)s(I)g(text)j(c)m +(haracters,)i(including)37 b(spaces.)68 b(The)0 894 y(equals)43 +b(sign)h(marks)f(the)h(end)g(of)g(the)g(k)m(eyw)m(ord)h(name)f(and)f +(is)h(follo)m(w)m(ed)f(b)m(y)h(the)g(usual)f(v)-5 b(alue)44 +b(and)f(com-)0 1007 y(men)m(t)31 b(\014elds)e(just)h(as)h(in)e +(standard)h(FITS)g(k)m(eyw)m(ords.)41 b(F)-8 b(urther)30 +b(details)g(of)h(this)e(con)m(v)m(en)m(tion)j(are)f(describ)s(ed)d(at)0 +1120 y(h)m(ttp://arcdev.hq.eso.org/dicb/dicd/dic-1-1.4.h)m(tml)33 +b(\(searc)m(h)f(for)e(HIERAR)m(CH\).)0 1280 y(This)42 +b(con)m(v)m(en)m(tion)k(allo)m(ws)e(a)g(m)m(uc)m(h)h(broader)e(range)i +(of)f(k)m(eyw)m(ord)h(names)f(than)h(is)e(allo)m(w)m(ed)h(b)m(y)g(the)h +(FITS)0 1393 y(Standard.)40 b(Here)30 b(are)h(more)g(examples)f(of)g +(suc)m(h)g(k)m(eyw)m(ords:)0 1655 y Fe(HIERARCH)46 b(LongKeyword)e(=)k +(47.5)e(/)i(Keyword)e(has)h(>)g(8)g(characters,)e(and)i(mixed)f(case)0 +1768 y(HIERARCH)g(XTE$TEMP)f(=)j(98.6)e(/)i(Keyword)d(contains)h(the)h +('$')g(character)0 1881 y(HIERARCH)f(Earth)g(is)h(a)h(star)e(=)i(F)f(/) +h(Keyword)d(contains)h(embedded)f(spaces)0 2143 y Fi(CFITSIO)40 +b(will)f(transparen)m(tly)i(read)h(and)f(write)f(these)j(k)m(eyw)m +(ords,)i(so)d(application)e(programs)h(do)g(not)h(in)0 +2256 y(general)32 b(need)g(to)h(kno)m(w)f(an)m(ything)g(ab)s(out)g(the) +g(sp)s(eci\014c)f(implemen)m(tation)g(details)g(of)i(the)f(HIERAR)m(CH) +g(con-)0 2369 y(v)m(en)m(tion.)49 b(In)32 b(particular,)h(application)e +(programs)h(do)h(not)h(need)e(to)i(sp)s(ecify)e(the)h(`HIERAR)m(CH')h +(part)f(of)g(the)0 2482 y(k)m(eyw)m(ord)g(name)f(when)g(reading)f(or)h +(writing)f(k)m(eyw)m(ords)h(\(although)g(it)g(ma)m(y)h(b)s(e)f +(included)d(if)j(desired\).)45 b(When)0 2595 y(writing)33 +b(a)i(k)m(eyw)m(ord,)h(CFITSIO)d(\014rst)h(c)m(hec)m(ks)i(to)f(see)g +(if)f(the)h(k)m(eyw)m(ord)g(name)f(is)g(legal)g(as)h(a)g(standard)f +(FITS)0 2708 y(k)m(eyw)m(ord)k(\(no)g(more)f(than)h(8)g(c)m(haracters)h +(long)e(and)g(con)m(taining)g(only)f(letters,)k(digits,)e(or)g(a)g(min) +m(us)d(sign)i(or)0 2821 y(underscore\).)68 b(If)39 b(so)h(it)f(writes)g +(it)g(as)g(a)h(standard)f(FITS)g(k)m(eyw)m(ord,)k(otherwise)c(it)g +(uses)g(the)h(hierarc)m(h)e(con-)0 2934 y(v)m(en)m(tion)33 +b(to)g(write)f(the)g(k)m(eyw)m(ord.)48 b(The)32 b(maxim)m(um)f(k)m(eyw) +m(ord)i(name)f(length)g(is)g(67)h(c)m(haracters,)i(whic)m(h)c(lea)m(v)m +(es)0 3047 y(only)c(1)i(space)g(for)f(the)h(v)-5 b(alue)28 +b(\014eld.)38 b(A)29 b(more)f(practical)g(limit)e(is)i(ab)s(out)g(40)h +(c)m(haracters,)i(whic)m(h)c(lea)m(v)m(es)i(enough)0 +3160 y(ro)s(om)f(for)h(most)f(k)m(eyw)m(ord)h(v)-5 b(alues.)40 +b(CFITSIO)27 b(returns)g(an)h(error)h(if)e(there)i(is)e(not)i(enough)f +(ro)s(om)h(for)f(b)s(oth)g(the)0 3273 y(k)m(eyw)m(ord)k(name)f(and)f +(the)i(k)m(eyw)m(ord)f(v)-5 b(alue)31 b(on)g(the)h(80-c)m(haracter)h +(card,)f(except)g(for)f(string-v)-5 b(alued)30 b(k)m(eyw)m(ords)0 +3385 y(whic)m(h)i(are)h(simply)d(truncated)j(so)g(that)h(the)f(closing) +f(quote)i(c)m(haracter)g(falls)d(in)h(column)g(80.)49 +b(In)32 b(the)h(curren)m(t)0 3498 y(implemen)m(tation,)28 +b(CFITSIO)f(preserv)m(es)i(the)g(case)h(of)f(the)g(letters)g(when)f +(writing)f(the)i(k)m(eyw)m(ord)g(name,)g(but)f(it)0 3611 +y(is)c(case-insensitiv)m(e)g(when)g(reading)g(or)h(searc)m(hing)g(for)g +(a)g(k)m(eyw)m(ord.)40 b(The)24 b(curren)m(t)h(implemen)m(tation)e +(allo)m(ws)i(an)m(y)0 3724 y(ASCI)s(I)k(text)j(c)m(haracter)h(\(ASCI)s +(I)c(32)j(to)f(ASCI)s(I)f(126\))i(in)e(the)h(k)m(eyw)m(ord)g(name)g +(except)h(for)e(the)h('=')g(c)m(haracter.)0 3837 y(A)f(space)h(is)f +(also)g(required)f(on)h(either)g(side)f(of)i(the)f(equal)g(sign.)0 +4174 y Fd(6.13)136 b(Optimizing)45 b(Co)t(de)g(for)h(Maxim)l(um)f(Pro)t +(cessing)g(Sp)t(eed)0 4425 y Fi(CFITSIO)22 b(has)h(b)s(een)f(carefully) +g(designed)g(to)i(obtain)f(the)g(highest)g(p)s(ossible)d(sp)s(eed)j +(when)f(reading)g(and)h(writing)0 4538 y(FITS)33 b(\014les.)50 +b(In)33 b(order)h(to)g(ac)m(hiev)m(e)h(the)f(b)s(est)g(p)s(erformance,) +g(ho)m(w)m(ev)m(er,)i(application)d(programmers)g(m)m(ust)h(b)s(e)0 +4650 y(careful)23 b(to)i(call)e(the)h(CFITSIO)f(routines)f +(appropriately)h(and)g(in)g(an)g(e\016cien)m(t)i(sequence;)i +(inappropriate)21 b(usage)0 4763 y(of)31 b(CFITSIO)d(routines)i(can)g +(greatly)h(slo)m(w)f(do)m(wn)g(the)h(execution)f(sp)s(eed)g(of)g(a)h +(program.)0 4924 y(The)f(maxim)m(um)g(p)s(ossible)e(I/O)j(sp)s(eed)f +(of)h(CFITSIO)e(dep)s(ends)g(of)i(course)g(on)f(the)h(t)m(yp)s(e)g(of)g +(computer)g(system)0 5036 y(that)g(it)e(is)g(running)e(on.)41 +b(As)30 b(a)g(rough)g(guide,)f(the)h(curren)m(t)g(generation)g(of)g(w)m +(orkstations)g(can)h(ac)m(hiev)m(e)g(sp)s(eeds)0 5149 +y(of)k(2)g({)g(10)g(MB/s)h(when)e(reading)g(or)g(writing)f(FITS)h +(images)h(and)f(similar,)f(or)i(sligh)m(tly)e(slo)m(w)m(er)i(sp)s(eeds) +e(with)0 5262 y(FITS)c(binary)g(tables.)40 b(Reading)30 +b(of)g(FITS)g(\014les)f(can)i(o)s(ccur)f(at)h(ev)m(en)f(higher)f(rates) +i(\(30MB/s)i(or)d(more\))h(if)e(the)0 5375 y(FITS)d(\014le)g(is)f +(still)g(cac)m(hed)j(in)d(system)i(memory)f(follo)m(wing)g(a)h +(previous)e(read)h(or)h(write)f(op)s(eration)g(on)h(the)g(same)0 +5488 y(\014le.)43 b(T)-8 b(o)32 b(more)g(accurately)g(predict)e(the)i +(b)s(est)f(p)s(erformance)g(that)h(is)e(p)s(ossible)f(on)j(an)m(y)g +(particular)d(system,)k(a)0 5601 y(diagnostic)f(program)h(called)f +(\\sp)s(eed.c")h(is)f(included)e(with)i(the)h(CFITSIO)e(distribution)e +(whic)m(h)j(can)h(b)s(e)f(run)0 5714 y(to)f(appro)m(ximately)f(measure) +g(the)h(maxim)m(um)e(p)s(ossible)f(sp)s(eed)h(of)i(writing)d(and)i +(reading)g(a)g(test)i(FITS)d(\014le.)p eop +%%Page: 57 63 +57 62 bop 0 299 a Fg(6.13.)73 b(OPTIMIZING)29 b(CODE)h(F)m(OR)h +(MAXIMUM)g(PR)m(OCESSING)f(SPEED)971 b Fi(57)0 555 y(The)33 +b(follo)m(wing)e(2)j(sections)f(pro)m(vide)g(some)g(bac)m(kground)g(on) +h(ho)m(w)f(CFITSIO)f(in)m(ternally)f(manages)j(the)f(data)0 +668 y(I/O)g(and)g(describ)s(es)e(some)j(strategies)g(that)g(ma)m(y)g(b) +s(e)e(used)h(to)h(optimize)e(the)i(pro)s(cessing)e(sp)s(eed)g(of)h +(soft)m(w)m(are)0 781 y(that)e(uses)f(CFITSIO.)0 1080 +y Fb(6.13.1)113 b(Bac)m(kground)38 b(Information:)48 +b(Ho)m(w)37 b(CFITSIO)h(Manages)h(Data)f(I/O)0 1300 y +Fi(Man)m(y)22 b(CFITSIO)e(op)s(erations)h(in)m(v)m(olv)m(e)h +(transferring)e(only)h(a)h(small)e(n)m(um)m(b)s(er)h(of)h(b)m(ytes)g +(to)g(or)g(from)f(the)h(FITS)f(\014le)0 1413 y(\(e.g,)31 +b(reading)d(a)h(k)m(eyw)m(ord,)h(or)f(writing)e(a)i(ro)m(w)g(in)e(a)i +(table\);)h(it)f(w)m(ould)e(b)s(e)h(v)m(ery)i(ine\016cien)m(t)e(to)h +(ph)m(ysically)e(read)0 1526 y(or)32 b(write)g(suc)m(h)g(small)e(blo)s +(c)m(ks)i(of)g(data)h(directly)e(in)g(the)h(FITS)g(\014le)f(on)h(disk,) +g(therefore)g(CFITSIO)f(main)m(tains)0 1639 y(a)38 b(set)g(of)g(in)m +(ternal)f(Input{Output)e(\(IO\))j(bu\013ers)f(in)f(RAM)i(memory)g(that) +g(eac)m(h)h(con)m(tain)f(one)g(FITS)f(blo)s(c)m(k)0 1752 +y(\(2880)27 b(b)m(ytes\))f(of)f(data.)40 b(Whenev)m(er)25 +b(CFITSIO)f(needs)g(to)i(access)g(data)g(in)e(the)h(FITS)f(\014le,)i +(it)e(\014rst)g(transfers)h(the)0 1865 y(FITS)30 b(blo)s(c)m(k)g(con)m +(taining)g(those)h(b)m(ytes)g(in)m(to)f(one)h(of)f(the)h(IO)f +(bu\013ers)f(in)g(memory)-8 b(.)42 b(The)30 b(next)g(time)g(CFITSIO)0 +1977 y(needs)36 b(to)g(access)i(b)m(ytes)e(in)f(the)h(same)h(blo)s(c)m +(k)e(it)h(can)g(then)g(go)h(to)f(the)h(fast)f(IO)f(bu\013er)g(rather)h +(than)g(using)f(a)0 2090 y(m)m(uc)m(h)d(slo)m(w)m(er)h(system)f(disk)f +(access)i(routine.)45 b(The)32 b(n)m(um)m(b)s(er)f(of)h(a)m(v)-5 +b(ailable)32 b(IO)g(bu\013ers)f(is)g(determined)g(b)m(y)h(the)0 +2203 y(NIOBUF)f(parameter)g(\(in)e(\014tsio2.h\))h(and)g(is)g(curren)m +(tly)f(set)i(to)g(40.)0 2363 y(Whenev)m(er)24 b(CFITSIO)f(reads)g(or)h +(writes)f(data)h(it)g(\014rst)f(c)m(hec)m(ks)i(to)g(see)f(if)f(that)h +(blo)s(c)m(k)g(of)g(the)g(FITS)f(\014le)f(is)h(already)0 +2476 y(loaded)32 b(in)m(to)g(one)g(of)g(the)g(IO)g(bu\013ers.)44 +b(If)32 b(not,)h(and)e(if)g(there)h(is)f(an)h(empt)m(y)h(IO)e(bu\013er) +g(a)m(v)-5 b(ailable,)32 b(then)g(it)g(will)0 2589 y(load)g(that)i(blo) +s(c)m(k)e(in)m(to)g(the)h(IO)g(bu\013er)e(\(when)h(reading)g(a)h(FITS)f +(\014le\))g(or)h(will)d(initialize)g(a)j(new)f(blo)s(c)m(k)h(\(when)0 +2702 y(writing)i(to)j(a)g(FITS)f(\014le\).)61 b(If)37 +b(all)f(the)i(IO)e(bu\013ers)h(are)g(already)g(full,)g(it)g(m)m(ust)h +(decide)e(whic)m(h)g(one)i(to)g(reuse)0 2815 y(\(generally)32 +b(the)h(one)g(that)g(has)f(b)s(een)g(accessed)i(least)e(recen)m(tly\),) +i(and)e(\015ush)f(the)i(con)m(ten)m(ts)h(bac)m(k)g(to)f(disk)e(if)g(it) +0 2928 y(has)f(b)s(een)g(mo)s(di\014ed)e(b)s(efore)i(loading)f(the)i +(new)f(blo)s(c)m(k.)0 3088 y(The)g(one)g(ma)5 b(jor)30 +b(exception)h(to)g(the)f(ab)s(o)m(v)m(e)h(pro)s(cess)f(o)s(ccurs)g +(whenev)m(er)g(a)g(large)h(con)m(tiguous)f(set)h(of)f(b)m(ytes)h(are)0 +3201 y(accessed,)37 b(as)d(migh)m(t)h(o)s(ccur)f(when)f(reading)h(or)g +(writing)e(a)j(FITS)f(image.)53 b(In)34 b(this)f(case)i(CFITSIO)e(b)m +(ypasses)0 3314 y(the)i(in)m(ternal)f(IO)h(bu\013ers)f(and)g(simply)f +(reads)i(or)g(writes)g(the)g(desired)f(b)m(ytes)h(directly)f(in)g(the)h +(disk)f(\014le)g(with)0 3427 y(a)j(single)e(call)g(to)i(a)g(lo)m(w-lev) +m(el)f(\014le)f(read)h(or)h(write)e(routine.)57 b(The)36 +b(minim)m(um)e(threshold)g(for)i(the)h(n)m(um)m(b)s(er)e(of)0 +3540 y(b)m(ytes)40 b(to)g(read)f(or)g(write)f(this)h(w)m(a)m(y)h(is)e +(set)i(b)m(y)f(the)g(MINDIRECT)g(parameter)h(and)e(is)h(curren)m(tly)f +(set)i(to)g(3)0 3653 y(FITS)28 b(blo)s(c)m(ks)f(=)h(8640)i(b)m(ytes.)41 +b(This)27 b(is)g(the)h(most)h(e\016cien)m(t)g(w)m(a)m(y)g(to)g(read)g +(or)f(write)g(large)g(c)m(h)m(unks)g(of)g(data)i(and)0 +3766 y(can)37 b(ac)m(hiev)m(e)h(IO)e(transfer)g(rates)h(of)g(5)g({)g +(10MB/s)i(or)d(greater.)61 b(Note)38 b(that)f(this)f(fast)h(direct)f +(IO)g(pro)s(cess)g(is)0 3878 y(not)29 b(applicable)d(when)h(accessing)i +(columns)f(of)g(data)h(in)e(a)i(FITS)f(table)g(b)s(ecause)h(the)f(b)m +(ytes)h(are)g(generally)f(not)0 3991 y(con)m(tiguous)h(since)f(they)h +(are)h(in)m(terlea)m(v)m(ed)f(b)m(y)g(the)g(other)g(columns)f(of)h +(data)g(in)f(the)h(table.)40 b(This)27 b(explains)g(wh)m(y)0 +4104 y(the)k(sp)s(eed)e(for)h(accessing)h(FITS)f(tables)g(is)f +(generally)h(slo)m(w)m(er)g(than)h(accessing)f(FITS)g(images.)0 +4264 y(Giv)m(en)h(this)g(bac)m(kground)g(information,)f(the)i(general)f +(strategy)i(for)e(e\016cien)m(tly)g(accessing)h(FITS)f(\014les)f +(should)0 4377 y(no)m(w)36 b(b)s(e)g(apparen)m(t:)52 +b(when)35 b(dealing)g(with)g(FITS)h(images,)i(read)e(or)g(write)f +(large)i(c)m(h)m(unks)f(of)g(data)h(at)g(a)f(time)0 4490 +y(so)30 b(that)h(the)f(direct)g(IO)f(mec)m(hanism)g(will)f(b)s(e)h(in)m +(v)m(ok)m(ed;)i(when)e(accessing)i(FITS)e(headers)h(or)g(FITS)f +(tables,)h(on)0 4603 y(the)35 b(other)g(hand,)g(once)g(a)g(particular)f +(FITS)g(blo)s(c)m(k)g(has)g(b)s(een)g(loading)g(in)m(to)h(one)g(of)g +(the)f(IO)h(bu\013ers,)g(try)f(to)0 4716 y(access)39 +b(all)d(the)h(needed)g(information)f(in)g(that)i(blo)s(c)m(k)f(b)s +(efore)g(it)g(gets)h(\015ushed)d(out)j(of)g(the)f(IO)g(bu\013er.)60 +b(It)38 b(is)0 4829 y(imp)s(ortan)m(t)30 b(to)i(a)m(v)m(oid)f(the)g +(situation)f(where)h(the)g(same)g(FITS)f(blo)s(c)m(k)h(is)f(b)s(eing)f +(read)i(then)g(\015ushed)e(from)h(a)h(IO)0 4942 y(bu\013er)e(m)m +(ultiple)f(times.)0 5102 y(The)i(follo)m(wing)f(section)h(giv)m(es)h +(more)f(sp)s(eci\014c)g(suggestions)g(for)g(optimizing)f(the)h(use)g +(of)h(CFITSIO.)0 5262 y(1.)54 b(When)34 b(dealing)f(with)h(a)h(FITS)e +(primary)g(arra)m(y)i(or)g(IMA)m(GE)g(extension,)h(it)e(is)f(more)i +(e\016cien)m(t)g(to)g(read)g(or)0 5375 y(write)30 b(large)g(c)m(h)m +(unks)g(of)g(the)h(image)f(at)i(a)e(time)g(\(at)i(least)e(3)h(FITS)f +(blo)s(c)m(ks)f(=)h(8640)i(b)m(ytes\))f(so)g(that)g(the)f(direct)0 +5488 y(IO)j(mec)m(hanism)g(will)d(b)s(e)j(used)g(as)g(describ)s(ed)f +(in)g(the)h(previous)f(section.)50 b(Smaller)32 b(c)m(h)m(unks)h(of)g +(data)h(are)g(read)0 5601 y(or)d(written)f(via)h(the)g(IO)f(bu\013ers,) +g(whic)m(h)g(is)g(somewhat)h(less)f(e\016cien)m(t)i(b)s(ecause)f(of)g +(the)g(extra)h(cop)m(y)f(op)s(eration)0 5714 y(and)26 +b(additional)e(b)s(o)s(okk)m(eeping)i(steps)h(that)g(are)g(required.)38 +b(In)26 b(principle)d(it)j(is)g(more)g(e\016cien)m(t)h(to)h(read)e(or)h +(write)p eop +%%Page: 58 64 +58 63 bop 0 299 a Fi(58)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fi(as)e(big)f(an)h(arra)m(y)h(of)f(image)g(pixels)e(at)j(one)f(time)f +(as)i(p)s(ossible,)d(ho)m(w)m(ev)m(er,)j(if)e(the)i(arra)m(y)f(b)s +(ecomes)g(so)g(large)g(that)0 668 y(the)j(op)s(erating)f(system)g +(cannot)h(store)g(it)f(all)g(in)f(RAM,)i(then)f(the)h(p)s(erformance)f +(ma)m(y)h(b)s(e)f(degraded)g(b)s(ecause)0 781 y(of)g(the)f(increased)g +(sw)m(apping)f(of)h(virtual)f(memory)h(to)h(disk.)0 941 +y(2.)51 b(When)33 b(dealing)g(with)f(FITS)h(tables,)i(the)f(most)g(imp) +s(ortan)m(t)f(e\016ciency)g(factor)i(in)d(the)i(soft)m(w)m(are)h +(design)e(is)0 1054 y(to)k(read)f(or)g(write)f(the)h(data)h(in)e(the)h +(FITS)g(\014le)f(in)g(a)h(single)f(pass)h(through)f(the)h(\014le.)57 +b(An)36 b(example)g(of)g(p)s(o)s(or)0 1167 y(program)g(design)g(w)m +(ould)f(b)s(e)h(to)h(read)g(a)f(large,)j(3-column)d(table)g(b)m(y)h +(sequen)m(tially)e(reading)h(the)g(en)m(tire)h(\014rst)0 +1280 y(column,)24 b(then)g(going)g(bac)m(k)g(to)h(read)e(the)h(2nd)g +(column,)g(and)f(\014nally)f(the)i(3rd)f(column;)i(this)e(ob)m(viously) +f(requires)0 1393 y(3)j(passes)f(through)f(the)i(\014le)e(whic)m(h)g +(could)h(triple)e(the)j(execution)f(time)g(of)h(an)f(I/O)g(limited)e +(program.)38 b(F)-8 b(or)25 b(small)0 1506 y(tables)30 +b(this)f(is)h(not)g(imp)s(ortan)m(t,)g(but)g(when)f(reading)g(m)m +(ulti-megab)m(yte)i(sized)f(tables)g(these)h(ine\016ciencies)e(can)0 +1619 y(b)s(ecome)g(signi\014can)m(t.)39 b(The)28 b(more)h(e\016cien)m +(t)g(pro)s(cedure)e(in)h(this)f(case)j(is)d(to)j(read)e(or)h(write)f +(only)f(as)i(man)m(y)g(ro)m(ws)0 1732 y(of)g(the)g(table)g(as)g(will)e +(\014t)h(in)m(to)h(the)h(a)m(v)-5 b(ailable)28 b(in)m(ternal)g(I/O)h +(bu\013ers,)f(then)h(access)h(all)e(the)h(necessary)g(columns)0 +1844 y(of)i(data)h(within)c(that)k(range)f(of)g(ro)m(ws.)43 +b(Then)29 b(after)j(the)f(program)g(is)f(completely)g(\014nished)f +(with)g(the)j(data)f(in)0 1957 y(those)i(ro)m(ws)e(it)h(can)g(mo)m(v)m +(e)i(on)e(to)g(the)h(next)f(range)g(of)g(ro)m(ws)g(that)h(will)c(\014t) +j(in)f(the)h(bu\013ers,)f(con)m(tin)m(uing)g(in)g(this)0 +2070 y(w)m(a)m(y)d(un)m(til)d(the)h(en)m(tire)h(\014le)f(has)g(b)s(een) +g(pro)s(cessed.)39 b(By)27 b(using)e(this)h(pro)s(cedure)f(of)i +(accessing)g(all)f(the)g(columns)g(of)0 2183 y(a)k(table)f(in)f +(parallel)f(rather)i(than)g(sequen)m(tially)-8 b(,)29 +b(eac)m(h)h(blo)s(c)m(k)f(of)h(the)f(FITS)g(\014le)f(will)e(only)j(b)s +(e)f(read)i(or)f(written)0 2296 y(once.)0 2456 y(The)g(optimal)f(n)m +(um)m(b)s(er)g(of)i(ro)m(ws)f(to)i(read)e(or)g(write)g(at)h(one)g(time) +f(in)f(a)i(giv)m(en)f(table)h(dep)s(ends)d(on)j(the)f(width)f(of)0 +2569 y(the)k(table)g(ro)m(w,)h(on)f(the)g(n)m(um)m(b)s(er)f(of)h(I/O)g +(bu\013ers)f(that)i(ha)m(v)m(e)g(b)s(een)e(allo)s(cated)h(in)f(FITSIO,) +g(and)h(also)g(on)g(the)0 2682 y(n)m(um)m(b)s(er)27 b(of)i(other)f +(FITS)g(\014les)f(that)i(are)g(op)s(en)f(at)h(the)g(same)g(time)f +(\(since)g(one)h(I/O)f(bu\013er)f(is)h(alw)m(a)m(ys)h(reserv)m(ed)0 +2795 y(for)34 b(eac)m(h)h(op)s(en)f(FITS)f(\014le\).)52 +b(F)-8 b(ortunately)g(,)36 b(a)f(FITSIO)e(routine)g(is)h(a)m(v)-5 +b(ailable)33 b(that)i(will)c(return)j(the)g(optimal)0 +2908 y(n)m(um)m(b)s(er)e(of)i(ro)m(ws)g(for)g(a)g(giv)m(en)f(table:)48 +b(call)33 b(ftgrsz\(unit,)h(nro)m(ws,)g(status\).)52 +b(It)34 b(is)f(not)h(critical)e(to)j(use)e(exactly)0 +3021 y(the)f(v)-5 b(alue)31 b(of)g(nro)m(ws)g(returned)g(b)m(y)g(this)f +(routine,)h(as)h(long)f(as)h(one)g(do)s(es)f(not)h(exceed)g(it.)44 +b(Using)31 b(a)h(v)m(ery)f(small)0 3134 y(v)-5 b(alue)31 +b(ho)m(w)m(ev)m(er)j(can)e(also)g(lead)f(to)i(p)s(o)s(or)e(p)s +(erformance)g(b)s(ecause)h(of)g(the)g(o)m(v)m(erhead)h(from)f(the)g +(larger)f(n)m(um)m(b)s(er)0 3247 y(of)g(subroutine)d(calls.)0 +3407 y(The)36 b(optimal)f(n)m(um)m(b)s(er)h(of)g(ro)m(ws)h(returned)e +(b)m(y)h(ftgrsz)h(is)f(v)-5 b(alid)35 b(only)g(as)i(long)f(as)h(the)f +(application)f(program)0 3520 y(is)e(only)h(reading)g(or)g(writing)e +(data)j(in)f(the)g(sp)s(eci\014ed)f(table.)53 b(An)m(y)34 +b(other)h(calls)e(to)i(access)h(data)f(in)e(the)i(table)0 +3633 y(header)e(or)h(in)e(an)m(y)i(other)g(FITS)f(\014le)g(w)m(ould)f +(cause)i(additional)e(blo)s(c)m(ks)h(of)h(data)g(to)g(b)s(e)f(loaded)h +(in)m(to)f(the)h(I/O)0 3745 y(bu\013ers)i(displacing)f(data)j(from)f +(the)g(original)f(table,)j(and)e(should)e(b)s(e)i(a)m(v)m(oided)g +(during)e(the)j(critical)e(p)s(erio)s(d)0 3858 y(while)28 +b(the)j(table)f(is)g(b)s(eing)f(read)h(or)g(written.)0 +4019 y(Occasionally)f(it)g(is)f(necessary)i(to)h(sim)m(ultaneously)c +(access)k(more)f(than)f(one)h(FITS)f(table,)h(for)g(example)f(when)0 +4131 y(transferring)41 b(v)-5 b(alues)42 b(from)g(an)h(input)d(table)j +(to)g(an)g(output)f(table.)78 b(In)42 b(cases)h(lik)m(e)f(this,)j(one)e +(should)e(call)0 4244 y(ftgrsz)28 b(to)h(get)g(the)f(optimal)f(n)m(um)m +(b)s(er)g(of)h(ro)m(ws)g(for)f(eac)m(h)j(table)d(separately)-8 +b(,)30 b(than)d(reduce)h(the)g(n)m(um)m(b)s(er)f(of)h(ro)m(ws)0 +4357 y(prop)s(ortionally)-8 b(.)42 b(F)-8 b(or)33 b(example,)f(if)f +(the)h(optimal)f(n)m(um)m(b)s(er)f(of)i(ro)m(ws)g(in)e(the)i(input)e +(table)i(is)f(3600)i(and)e(is)g(1400)0 4470 y(in)h(the)h(output)f +(table,)i(then)f(these)g(v)-5 b(alues)33 b(should)e(b)s(e)h(cut)h(in)f +(half)g(to)i(1800)g(and)f(700,)i(resp)s(ectiv)m(ely)-8 +b(,)34 b(if)e(b)s(oth)0 4583 y(tables)e(are)h(going)f(to)h(b)s(e)f +(accessed)i(at)f(the)f(same)h(time.)0 4743 y(3.)39 b(Use)24 +b(binary)e(table)h(extensions)g(rather)g(than)h(ASCI)s(I)e(table)h +(extensions)g(for)g(b)s(etter)h(e\016ciency)g(when)e(dealing)0 +4856 y(with)36 b(tabular)h(data.)62 b(The)37 b(I/O)g(to)h(ASCI)s(I)e +(tables)h(is)g(slo)m(w)m(er)g(b)s(ecause)h(of)f(the)h(o)m(v)m(erhead)h +(in)d(formatting)h(or)0 4969 y(parsing)29 b(the)i(ASCI)s(I)f(data)h +(\014elds,)f(and)g(b)s(ecause)h(ASCI)s(I)e(tables)h(are)h(ab)s(out)g(t) +m(wice)g(as)g(large)g(as)g(binary)e(tables)0 5082 y(with)g(the)i(same)f +(information)f(con)m(ten)m(t.)0 5242 y(4.)64 b(Design)38 +b(soft)m(w)m(are)h(so)g(that)f(it)g(reads)g(the)g(FITS)f(header)h(k)m +(eyw)m(ords)g(in)f(the)h(same)h(order)e(in)g(whic)m(h)g(they)0 +5355 y(o)s(ccur)c(in)f(the)h(\014le.)48 b(When)32 b(reading)h(k)m(eyw)m +(ords,)h(FITSIO)e(searc)m(hes)i(forw)m(ard)e(starting)h(from)f(the)i(p) +s(osition)d(of)0 5468 y(the)e(last)h(k)m(eyw)m(ord)f(that)h(w)m(as)g +(read.)40 b(If)29 b(it)f(reac)m(hes)j(the)e(end)g(of)g(the)h(header)f +(without)f(\014nding)f(the)i(k)m(eyw)m(ord,)h(it)0 5581 +y(then)j(go)s(es)h(bac)m(k)g(to)h(the)e(start)h(of)g(the)g(header)f +(and)g(con)m(tin)m(ues)g(the)h(searc)m(h)g(do)m(wn)f(to)h(the)g(p)s +(osition)d(where)i(it)0 5694 y(started.)41 b(In)30 b(practice,)h(as)f +(long)g(as)h(the)f(en)m(tire)h(FITS)e(header)h(can)h(\014t)f(at)h(one)g +(time)f(in)f(the)h(a)m(v)-5 b(ailable)30 b(in)m(ternal)p +eop +%%Page: 59 65 +59 64 bop 0 299 a Fg(6.13.)73 b(OPTIMIZING)29 b(CODE)h(F)m(OR)h +(MAXIMUM)g(PR)m(OCESSING)f(SPEED)971 b Fi(59)0 555 y(I/O)33 +b(bu\013ers,)h(then)f(the)h(header)f(k)m(eyw)m(ord)h(access)h(will)30 +b(b)s(e)j(v)m(ery)h(fast)g(and)f(it)g(mak)m(es)h(little)e(di\013erence) +h(whic)m(h)0 668 y(order)d(they)g(are)h(accessed.)0 828 +y(5.)40 b(Av)m(oid)28 b(the)f(use)h(of)f(scaling)g(\(b)m(y)h(using)e +(the)i(BSCALE)e(and)h(BZER)m(O)h(or)f(TSCAL)g(and)g(TZER)m(O)f(k)m(eyw) +m(ords\))0 941 y(in)34 b(FITS)g(\014les)f(since)i(the)g(scaling)f(op)s +(erations)g(add)g(to)i(the)f(pro)s(cessing)e(time)i(needed)f(to)i(read) +f(or)g(write)f(the)0 1054 y(data.)60 b(In)36 b(some)i(cases)f(it)f(ma)m +(y)i(b)s(e)e(more)h(e\016cien)m(t)g(to)g(temp)s(orarily)e(turn)h(o\013) +h(the)g(scaling)f(\(using)f(ftpscl)h(or)0 1167 y(fttscl\))31 +b(and)e(then)h(read)h(or)f(write)g(the)g(ra)m(w)h(unscaled)e(v)-5 +b(alues)30 b(in)f(the)h(FITS)g(\014le.)0 1327 y(6.)40 +b(Av)m(oid)26 b(using)g(the)h('implicit)d(datat)m(yp)s(e)j(con)m(v)m +(ersion')g(capabilit)m(y)f(in)f(FITSIO.)h(F)-8 b(or)28 +b(instance,)f(when)f(reading)0 1440 y(a)f(FITS)e(image)i(with)e(BITPIX) +h(=)g(-32)i(\(32-bit)f(\015oating)f(p)s(oin)m(t)f(pixels\),)i(read)f +(the)h(data)g(in)m(to)f(a)h(single)e(precision)0 1553 +y(\015oating)f(p)s(oin)m(t)e(data)j(arra)m(y)f(in)f(the)h(program.)37 +b(F)-8 b(orcing)22 b(FITSIO)f(to)h(con)m(v)m(ert)i(the)e(data)g(to)h(a) +f(di\013eren)m(t)f(datat)m(yp)s(e)0 1666 y(can)31 b(signi\014can)m(tly) +d(slo)m(w)i(the)h(program.)0 1826 y(7.)57 b(Where)36 +b(feasible,)g(design)f(FITS)g(binary)f(tables)h(using)f(v)m(ector)k +(column)c(elemen)m(ts)i(so)g(that)g(the)g(data)h(are)0 +1939 y(written)29 b(as)h(a)g(con)m(tiguous)g(set)g(of)g(b)m(ytes,)g +(rather)g(than)f(as)h(single)e(elemen)m(ts)i(in)f(m)m(ultiple)e(ro)m +(ws.)41 b(F)-8 b(or)30 b(example,)0 2052 y(it)35 b(is)g(faster)h(to)g +(access)h(the)f(data)h(in)d(a)i(table)g(that)g(con)m(tains)g(a)g +(single)e(ro)m(w)i(and)f(2)h(columns)e(with)h(TF)m(ORM)0 +2165 y(k)m(eyw)m(ords)e(equal)g(to)h('10000E')h(and)e('10000J',)j(than) +d(it)f(is)g(to)i(access)g(the)g(same)f(amoun)m(t)h(of)f(data)h(in)e(a)h +(table)0 2278 y(with)39 b(10000)k(ro)m(ws)d(whic)m(h)g(has)g(columns)f +(with)g(the)i(TF)m(ORM)g(k)m(eyw)m(ords)g(equal)f(to)h('1E')h(and)e +('1J'.)h(In)f(the)0 2391 y(former)27 b(case)i(the)f(10000)i(\015oating) +e(p)s(oin)m(t)f(v)-5 b(alues)27 b(in)g(the)h(\014rst)f(column)g(are)h +(all)f(written)g(in)f(a)i(con)m(tiguous)g(blo)s(c)m(k)0 +2503 y(of)e(the)f(\014le)g(whic)m(h)f(can)i(b)s(e)f(read)g(or)g +(written)g(quic)m(kly)-8 b(,)26 b(whereas)f(in)f(the)i(second)f(case)i +(eac)m(h)g(\015oating)e(p)s(oin)m(t)f(v)-5 b(alue)0 2616 +y(in)33 b(the)h(\014rst)f(column)f(is)h(in)m(terlea)m(v)m(ed)i(with)d +(the)i(in)m(teger)h(v)-5 b(alue)33 b(in)g(the)h(second)g(column)e(of)i +(the)g(same)h(ro)m(w)f(so)0 2729 y(CFITSIO)29 b(has)h(to)h(explicitly)d +(mo)m(v)m(e)k(to)f(the)g(p)s(osition)d(of)j(eac)m(h)g(elemen)m(t)g(to)g +(b)s(e)f(read)g(or)g(written.)0 2889 y(8.)52 b(Av)m(oid)34 +b(the)h(use)e(of)i(v)-5 b(ariable)32 b(length)i(v)m(ector)i(columns)c +(in)h(binary)g(tables,)i(since)e(an)m(y)i(reading)e(or)h(writing)0 +3002 y(of)f(these)g(data)g(requires)e(that)i(CFITSIO)f(\014rst)f(lo)s +(ok)i(up)e(or)i(compute)g(the)f(starting)h(address)f(of)g(eac)m(h)i(ro) +m(w)f(of)0 3115 y(data)e(in)e(the)i(heap.)0 3275 y(9.)40 +b(When)26 b(cop)m(ying)g(data)i(from)e(one)g(FITS)g(table)g(to)h +(another,)h(it)e(is)g(faster)g(to)i(transfer)e(the)g(ra)m(w)h(b)m(ytes) +g(instead)0 3388 y(of)f(reading)f(then)h(writing)e(eac)m(h)j(column)d +(of)j(the)f(table.)39 b(The)25 b(FITSIO)g(subroutines)f(FTGTBS)h(and)h +(FTPTBS)0 3501 y(\(for)i(ASCI)s(I)f(tables\),)i(and)e(FTGTBB)i(and)e +(FTPTBB)i(\(for)f(binary)e(tables\))i(will)e(p)s(erform)g(lo)m(w-lev)m +(el)i(reads)g(or)0 3614 y(writes)33 b(of)i(an)m(y)f(con)m(tiguous)h +(range)g(of)f(b)m(ytes)h(in)e(a)i(table)f(extension.)52 +b(These)34 b(routines)f(can)i(b)s(e)e(used)h(to)h(read)0 +3727 y(or)29 b(write)f(a)h(whole)f(ro)m(w)g(\(or)i(m)m(ultiple)c(ro)m +(ws\))j(of)g(a)g(table)g(with)e(a)i(single)e(subroutine)g(call.)39 +b(These)29 b(routines)f(are)0 3840 y(fast)38 b(b)s(ecause)f(they)h(b)m +(ypass)f(all)f(the)i(usual)e(data)i(scaling,)h(error)e(c)m(hec)m(king)h +(and)f(mac)m(hine)g(dep)s(enden)m(t)f(data)0 3953 y(con)m(v)m(ersion)k +(that)h(is)d(normally)h(done)g(b)m(y)h(FITSIO,)f(and)g(they)h(allo)m(w) +f(the)h(program)g(to)h(write)e(the)h(data)g(to)0 4066 +y(the)34 b(output)g(\014le)f(in)g(exactly)i(the)f(same)h(b)m(yte)g +(order.)51 b(F)-8 b(or)35 b(these)g(same)f(reasons,)i(use)e(of)g(these) +h(routines)e(can)0 4179 y(b)s(e)g(somewhat)h(risky)e(b)s(ecause)h(no)g +(v)-5 b(alidation)32 b(or)i(mac)m(hine)f(dep)s(enden)m(t)f(con)m(v)m +(ersion)i(is)e(p)s(erformed)g(b)m(y)h(these)0 4292 y(routines.)39 +b(In)27 b(general)g(these)i(routines)d(are)i(only)f(recommended)g(for)h +(optimizing)e(critical)g(pieces)i(of)g(co)s(de)g(and)0 +4405 y(should)d(only)i(b)s(e)g(used)f(b)m(y)i(programmers)e(who)h +(thoroughly)g(understand)e(the)j(in)m(ternal)e(b)m(yte)i(structure)f +(of)h(the)0 4517 y(FITS)i(tables)g(they)g(are)h(reading)f(or)g +(writing.)0 4678 y(10.)41 b(Another)30 b(strategy)g(for)g(impro)m(ving) +d(the)j(sp)s(eed)e(of)i(writing)e(a)h(FITS)g(table,)h(similar)d(to)j +(the)f(previous)f(one,)0 4791 y(is)j(to)h(directly)f(construct)h(the)f +(en)m(tire)h(b)m(yte)g(stream)g(for)g(a)g(whole)f(table)g(ro)m(w)h +(\(or)g(m)m(ultiple)e(ro)m(ws\))i(within)d(the)0 4903 +y(application)j(program)i(and)g(then)f(write)h(it)f(to)i(the)f(FITS)f +(\014le)h(with)e(ftptbb.)51 b(This)32 b(a)m(v)m(oids)j(all)e(the)h(o)m +(v)m(erhead)0 5016 y(normally)e(presen)m(t)i(in)e(the)i(column-orien)m +(ted)f(CFITSIO)f(write)h(routines.)50 b(This)32 b(tec)m(hnique)h +(should)f(only)h(b)s(e)0 5129 y(used)26 b(for)h(critical)f +(applications,)g(b)s(ecause)g(it)h(mak)m(es)h(the)f(co)s(de)g(more)g +(di\016cult)e(to)i(understand)e(and)i(main)m(tain,)0 +5242 y(and)d(it)g(mak)m(es)i(the)f(co)s(de)g(more)f(system)h(dep)s +(enden)m(t)f(\(e.g.,)k(do)c(the)h(b)m(ytes)g(need)g(to)g(b)s(e)f(sw)m +(app)s(ed)g(b)s(efore)g(writing)0 5355 y(to)31 b(the)g(FITS)e +(\014le?\).)0 5515 y(11.)53 b(Finally)-8 b(,)34 b(external)g(factors)i +(suc)m(h)e(as)g(the)h(t)m(yp)s(e)f(of)h(magnetic)f(disk)f(con)m +(troller)h(\(SCSI)f(or)i(IDE\),)g(the)f(size)0 5628 y(of)h(the)g(disk)f +(cac)m(he,)k(the)d(a)m(v)m(erage)i(seek)f(sp)s(eed)e(of)h(the)g(disk,)g +(the)g(amoun)m(t)h(of)f(disk)e(fragmen)m(tation,)k(and)e(the)p +eop +%%Page: 60 66 +60 65 bop 0 299 a Fi(60)1277 b Fg(CHAPTER)29 b(6.)72 +b(FITSIO)29 b(CONVENTIONS)g(AND)i(GUIDELINES)0 555 y +Fi(amoun)m(t)e(of)g(RAM)f(a)m(v)-5 b(ailable)28 b(on)h(the)f(system)h +(can)g(all)e(ha)m(v)m(e)j(a)f(signi\014can)m(t)e(impact)i(on)f(o)m(v)m +(erall)h(I/O)f(e\016ciency)-8 b(.)0 668 y(F)g(or)36 b(critical)e +(applications,)g(a)i(system)f(administrator)e(should)g(review)h(the)i +(prop)s(osed)d(system)j(hardw)m(are)e(to)0 781 y(iden)m(tify)29 +b(an)m(y)i(p)s(oten)m(tial)e(I/O)i(b)s(ottlenec)m(ks.)p +eop +%%Page: 61 67 +61 66 bop 0 1225 a Ff(Chapter)65 b(7)0 1687 y Fl(The)77 +b(CFITSIO)f(Iterator)i(F)-19 b(unction)0 2180 y Fi(The)41 +b(\014ts)p 325 2180 28 4 v 33 w(iterate)p 615 2180 V +33 w(data)i(function)d(in)h(CFITSIO)f(pro)m(vides)h(a)h(unique)d(metho) +s(d)j(of)g(executing)g(an)f(arbitrary)0 2293 y(user-supplied)33 +b(`w)m(ork')k(function)e(that)i(op)s(erates)g(on)g(ro)m(ws)f(of)h(data) +g(in)e(FITS)h(tables)g(or)g(on)h(pixels)d(in)i(FITS)0 +2406 y(images.)i(Rather)24 b(than)e(explicitly)f(reading)h(and)h +(writing)e(the)i(FITS)g(images)g(or)g(columns)f(of)h(data,)i(one)f +(instead)0 2518 y(calls)34 b(the)i(CFITSIO)d(iterator)j(routine,)g +(passing)e(to)i(it)f(the)g(name)g(of)h(the)f(user's)g(w)m(ork)g +(function)f(that)i(is)e(to)0 2631 y(b)s(e)c(executed)h(along)f(with)f +(a)i(list)e(of)h(all)f(the)i(table)f(columns)f(or)h(image)g(arra)m(ys)h +(that)g(are)f(to)h(b)s(e)f(passed)g(to)h(the)0 2744 y(w)m(ork)37 +b(function.)60 b(The)37 b(CFITSIO)e(iterator)j(function)e(then)h(do)s +(es)g(all)f(the)h(w)m(ork)g(of)h(allo)s(cating)e(memory)h(for)0 +2857 y(the)28 b(arra)m(ys,)h(reading)e(the)h(input)d(data)k(from)e(the) +h(FITS)f(\014le,)g(passing)g(them)h(to)g(the)g(w)m(ork)g(function,)f +(and)g(then)0 2970 y(writing)34 b(an)m(y)j(output)f(data)h(bac)m(k)h +(to)f(the)f(FITS)g(\014le)f(after)i(the)g(w)m(ork)g(function)e(exits.) +58 b(Because)38 b(it)e(is)g(often)0 3083 y(more)h(e\016cien)m(t)h(to)g +(pro)s(cess)f(only)f(a)i(subset)f(of)g(the)g(total)h(table)g(ro)m(ws)f +(at)h(one)f(time,)i(the)f(iterator)f(function)0 3196 +y(can)f(determine)f(the)i(optim)m(um)e(amoun)m(t)h(of)g(data)h(to)g +(pass)e(in)g(eac)m(h)i(iteration)f(and)f(rep)s(eatly)g(call)h(the)g(w)m +(ork)0 3309 y(function)29 b(un)m(til)g(the)h(en)m(tire)h(table)f(b)s +(een)f(pro)s(cessed.)0 3469 y(F)-8 b(or)37 b(man)m(y)f(applications)e +(this)g(single)h(CFITSIO)f(iterator)j(function)d(can)i(e\013ectiv)m +(ely)h(replace)f(all)f(the)h(other)0 3582 y(CFITSIO)g(routines)h(for)g +(reading)g(or)g(writing)f(data)i(in)e(FITS)h(images)h(or)f(tables.)63 +b(Using)36 b(the)i(iterator)g(has)0 3695 y(sev)m(eral)31 +b(imp)s(ortan)m(t)e(adv)-5 b(an)m(tages)32 b(o)m(v)m(er)g(the)f +(traditional)d(metho)s(d)i(of)h(reading)e(and)h(writing)e(FITS)i(data)h +(\014les:)136 3961 y Fc(\017)46 b Fi(It)33 b(cleanly)f(separates)i(the) +f(data)h(I/O)f(from)f(the)h(routine)f(that)i(op)s(erates)f(on)g(the)g +(data.)49 b(This)31 b(leads)h(to)227 4074 y(a)f(more)g(mo)s(dular)d +(and)i(`ob)5 b(ject)31 b(orien)m(ted')g(programming)e(st)m(yle.)136 +4268 y Fc(\017)46 b Fi(It)27 b(simpli\014es)c(the)k(application)e +(program)i(b)m(y)f(eliminating)e(the)j(need)g(to)g(allo)s(cate)g +(memory)g(for)f(the)h(data)227 4381 y(arra)m(ys)e(and)f(eliminates)f +(most)h(of)h(the)f(calls)g(to)h(the)g(CFITSIO)d(routines)i(that)h +(explicitly)d(read)i(and)g(write)227 4494 y(the)31 b(data.)136 +4689 y Fc(\017)46 b Fi(It)32 b(ensures)e(that)i(the)g(data)g(are)g(pro) +s(cessed)f(as)h(e\016cien)m(tly)f(as)g(p)s(ossible.)42 +b(This)30 b(is)g(esp)s(ecially)g(imp)s(ortan)m(t)227 +4801 y(when)44 b(pro)s(cessing)f(tabular)h(data)i(since)e(the)h +(iterator)g(function)e(will)f(calculate)j(the)g(most)g(e\016cien)m(t) +227 4914 y(n)m(um)m(b)s(er)36 b(of)i(ro)m(ws)g(in)e(the)i(table)f(to)h +(b)s(e)f(passed)g(at)i(one)e(time)h(to)g(the)g(user's)e(w)m(ork)i +(function)e(on)i(eac)m(h)227 5027 y(iteration.)136 5222 +y Fc(\017)46 b Fi(Mak)m(es)39 b(it)d(p)s(ossible)f(for)i(larger)g(pro)5 +b(jects)37 b(to)h(dev)m(elop)f(a)h(library)c(of)k(w)m(ork)f(functions)f +(that)h(all)f(ha)m(v)m(e)j(a)227 5335 y(uniform)28 b(calling)h +(sequence)i(and)f(are)h(all)e(indep)s(enden)m(t)f(of)j(the)f(details)g +(of)g(the)h(FITS)e(\014le)h(format.)0 5601 y(There)g(are)h(basically)e +(2)j(steps)e(in)g(using)f(the)i(CFITSIO)e(iterator)i(function.)41 +b(The)30 b(\014rst)g(step)h(is)f(to)h(design)f(the)0 +5714 y(w)m(ork)c(function)e(itself)g(whic)m(h)g(m)m(ust)i(ha)m(v)m(e)g +(a)g(prescrib)s(ed)d(set)j(of)g(input)e(parameters.)39 +b(One)25 b(of)h(these)g(parameters)1905 5942 y(61)p eop +%%Page: 62 68 +62 67 bop 0 299 a Fi(62)1455 b Fg(CHAPTER)30 b(7.)112 +b(THE)30 b(CFITSIO)e(ITERA)-8 b(TOR)30 b(FUNCTION)0 555 +y Fi(is)e(a)h(structure)g(con)m(taining)g(p)s(oin)m(ters)e(to)j(the)f +(arra)m(ys)h(of)f(data;)h(the)f(w)m(ork)h(function)d(can)j(p)s(erform)d +(an)m(y)i(desired)0 668 y(op)s(erations)j(on)i(these)f(arra)m(ys)h(and) +e(do)s(es)h(not)g(need)g(to)h(w)m(orry)f(ab)s(out)g(ho)m(w)g(the)h +(input)d(data)j(w)m(ere)f(read)g(from)0 781 y(the)e(\014le)e(or)h(ho)m +(w)h(the)f(output)g(data)h(get)h(written)d(bac)m(k)i(to)h(the)e +(\014le.)0 941 y(The)24 b(second)h(step)g(is)e(to)j(design)d(the)i +(driv)m(er)f(routine)f(that)j(op)s(ens)e(all)f(the)i(necessary)g(FITS)f +(\014les)g(and)g(initializes)0 1054 y(the)41 b(input)f(parameters)h(to) +h(the)g(iterator)f(function.)72 b(The)41 b(driv)m(er)f(program)h(calls) +f(the)i(CFITSIO)e(iterator)0 1167 y(function)29 b(whic)m(h)g(then)h +(reads)g(the)h(data)g(and)f(passes)g(it)g(to)h(the)g(user's)e(w)m(ork)i +(function.)0 1327 y(F)-8 b(urther)41 b(details)g(on)h(using)e(the)i +(iterator)g(function)f(can)h(b)s(e)f(found)f(in)h(the)h(companion)f +(CFITSIO)f(User's)0 1440 y(Guide,)30 b(and)f(in)g(the)i(iter)p +875 1440 28 4 v 32 w(a.f,)g(iter)p 1198 1440 V 33 w(b.f)f(and)f(iter)p +1678 1440 V 33 w(c.f)h(example)g(programs.)p eop +%%Page: 63 69 +63 68 bop 0 1225 a Ff(Chapter)65 b(8)0 1687 y Fl(Basic)77 +b(In)-6 b(terface)77 b(Routines)0 2180 y Fi(This)26 b(section)h +(de\014nes)g(a)h(basic)f(set)h(of)g(subroutines)d(that)j(can)g(b)s(e)f +(used)g(to)h(p)s(erform)e(the)i(most)g(common)g(t)m(yp)s(es)0 +2293 y(of)d(read)g(and)f(write)g(op)s(erations)g(on)h(FITS)f(\014les.) +38 b(New)25 b(users)f(should)f(start)i(with)f(these)h(subroutines)e +(and)h(then,)0 2406 y(as)33 b(needed,)h(explore)e(the)i(more)f(adv)-5 +b(ance)33 b(routines)f(describ)s(ed)f(in)h(the)h(follo)m(wing)f(c)m +(hapter)h(to)h(p)s(erform)e(more)0 2518 y(complex)e(or)g(sp)s +(ecialized)f(op)s(erations.)0 2679 y(A)h(righ)m(t)f(arro)m(w)h(sym)m(b) +s(ol)e(\()p Fa(>)p Fi(\))i(is)f(used)g(to)h(separate)h(the)e(input)f +(parameters)i(from)f(the)h(output)f(parameters)h(in)0 +2791 y(the)i(de\014nition)d(of)i(eac)m(h)i(routine.)43 +b(This)29 b(sym)m(b)s(ol)i(is)f(not)i(actually)f(part)g(of)h(the)f +(calling)f(sequence.)45 b(Note)32 b(that)0 2904 y(the)f(status)h +(parameter)g(is)e(b)s(oth)h(an)g(input)e(and)i(an)g(output)g(parameter) +h(and)e(m)m(ust)h(b)s(e)g(initialized)d(=)j(0)h(prior)0 +3017 y(to)f(calling)e(the)i(FITSIO)e(subroutines.)0 3177 +y(Refer)h(to)i(Chapter)d(9)i(for)f(the)h(de\014nition)d(of)i(all)g(the) +g(parameters)h(used)e(b)m(y)i(these)g(in)m(terface)f(routines.)0 +3525 y Fd(8.1)135 b(FITSIO)44 b(Error)h(Status)h(Routines)0 +3773 y Fh(1)81 b Fi(Return)24 b(the)i(curren)m(t)f(v)m(ersion)g(n)m(um) +m(b)s(er)f(of)i(the)f(\014tsio)g(library)-8 b(.)37 b(The)25 +b(v)m(ersion)g(n)m(um)m(b)s(er)f(will)f(b)s(e)h(incremen)m(ted)227 +3886 y(with)29 b(eac)m(h)j(new)e(release)g(of)h(CFITSIO.)382 +4157 y Fe(FTVERS\()46 b(>)h(version\))0 4429 y Fh(2)81 +b Fi(Return)45 b(the)i(descriptiv)m(e)e(text)i(string)f(corresp)s +(onding)e(to)j(a)g(FITSIO)e(error)h(status)h(co)s(de.)89 +b(The)46 b(30-)227 4541 y(c)m(haracter)32 b(length)e(string)f(con)m +(tains)i(a)g(brief)e(description)f(of)i(the)h(cause)g(of)f(the)h +(error.)382 4813 y Fe(FTGERR\(status,)44 b(>)j(errtext\))0 +5084 y Fh(3)81 b Fi(Return)40 b(the)h(top)g(\(oldest\))g(80-c)m +(haracter)j(error)c(message)i(from)f(the)g(in)m(ternal)e(FITSIO)h(stac) +m(k)i(of)f(error)227 5197 y(messages)29 b(and)f(shift)f(an)m(y)h +(remaining)e(messages)j(on)f(the)g(stac)m(k)i(up)d(one)h(lev)m(el.)40 +b(An)m(y)28 b(FITSIO)f(error)h(will)227 5310 y(generate)h(one)e(or)g +(more)h(messages)g(on)f(the)g(stac)m(k.)41 b(Call)26 +b(this)g(routine)g(rep)s(eatedly)g(to)i(get)h(eac)m(h)f(message)227 +5422 y(in)h(sequence.)41 b(The)30 b(error)g(stac)m(k)i(is)e(empt)m(y)g +(when)g(a)g(blank)f(string)h(is)f(returned.)382 5694 +y Fe(FTGMSG\()46 b(>)h(errmsg\))1905 5942 y Fi(63)p eop +%%Page: 64 70 +64 69 bop 0 299 a Fi(64)1747 b Fg(CHAPTER)30 b(8.)111 +b(BASIC)30 b(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 555 +y Fh(4)81 b Fi(The)33 b(FTPMRK)h(routine)f(puts)h(an)g(in)m(visible)d +(mark)m(er)j(on)g(the)h(CFITSIO)d(error)i(stac)m(k.)54 +b(The)33 b(FTCMRK)227 668 y(routine)40 b(can)h(then)g(b)s(e)f(used)g +(to)h(delete)g(an)m(y)g(more)g(recen)m(t)h(error)e(messages)i(on)f(the) +g(stac)m(k,)k(bac)m(k)c(to)227 781 y(the)32 b(p)s(osition)d(of)i(the)g +(mark)m(er.)43 b(This)30 b(preserv)m(es)h(an)m(y)g(older)g(error)f +(messages)i(on)f(the)h(stac)m(k.)44 b(FTCMSG)227 894 +y(simply)21 b(clears)h(the)h(en)m(tire)g(error)f(message)i(stac)m(k.)40 +b(These)23 b(routines)e(are)i(called)f(without)g(an)m(y)h(argumen)m +(ts.)382 1152 y Fe(FTPMRK)382 1265 y(FTCMRK)382 1378 +y(FTCMSG)0 1637 y Fh(5)81 b Fi(Prin)m(t)29 b(out)i(the)g(error)f +(message)i(corresp)s(onding)d(to)i(the)g(input)e(status)i(v)-5 +b(alue)30 b(and)g(all)g(the)h(error)f(messages)227 1750 +y(on)g(the)h(FITSIO)e(stac)m(k)i(to)g(the)g(sp)s(eci\014ed)d(\014le)i +(stream)g(\(stream)h(can)g(b)s(e)e(either)h(the)g(string)f('STDOUT')227 +1863 y(or)i('STDERR'\).)f(If)g(the)h(input)d(status)j(v)-5 +b(alue)30 b(=)g(0)h(then)f(this)f(routine)g(do)s(es)h(nothing.)334 +2121 y Fe(FTRPRT)46 b(\(stream,)g(>)h(status\))0 2380 +y Fh(6)81 b Fi(W)-8 b(rite)38 b(an)g(80-c)m(haracter)j(message)e(to)g +(the)f(FITSIO)f(error)h(stac)m(k.)65 b(Application)36 +b(programs)i(should)e(not)227 2493 y(normally)29 b(write)g(to)j(the)e +(stac)m(k,)i(but)e(there)g(ma)m(y)h(b)s(e)f(some)h(situations)e(where)h +(this)f(is)h(desirable.)382 2751 y Fe(FTPMSG\(errmsg\))0 +3085 y Fd(8.2)135 b(File)46 b(I/O)f(Routines)0 3325 y +Fh(1)81 b Fi(Op)s(en)34 b(an)h(existing)g(FITS)f(\014le)h(with)f +(readonly)h(or)g(readwrite)g(access.)58 b(This)33 b(routine)i(alw)m(a)m +(ys)h(op)s(ens)f(the)227 3438 y(primary)29 b(arra)m(y)j(\(the)f +(\014rst)f(HDU\))i(of)f(the)h(\014le,)e(and)g(do)s(es)h(not)g(mo)m(v)m +(e)h(to)g(a)f(follo)m(wing)f(extension,)h(if)f(one)227 +3551 y(w)m(as)d(sp)s(eci\014ed)e(as)h(part)h(of)f(the)h(\014lename.)38 +b(Use)27 b(the)g(FTNOPN)f(routine)f(to)i(automatically)g(mo)m(v)m(e)h +(to)f(the)227 3664 y(extension.)43 b(This)30 b(routine)g(will)f(also)i +(op)s(en)g(IRAF)g(images)h(\(.imh)e(format)i(\014les\))f(and)f(ra)m(w)i +(binary)d(data)227 3776 y(arra)m(ys)f(with)e(READONL)-8 +b(Y)28 b(access)h(b)m(y)e(\014rst)g(con)m(v)m(erting)h(them)f(on)g(the) +h(\015y)f(in)m(to)g(virtual)f(FITS)h(images.)227 3889 +y(See)36 b(the)g(`Extended)f(File)g(Name)i(Syn)m(tax')f(c)m(hapter)g +(for)f(more)h(details.)56 b(The)35 b(second)h(routine)e(simply)227 +4002 y(op)s(ens)e(the)g(sp)s(eci\014ed)f(\014le)h(without)f(trying)h +(to)h(in)m(terpret)f(the)g(\014lename)g(using)f(the)h(extended)h +(\014lename)227 4115 y(syn)m(tax.)382 4374 y Fe +(FTOPEN\(unit,filename,rwm)o(ode)o(,)42 b(>)47 b(blocksize,status\))382 +4487 y(FTDKOPEN\(unit,filename,r)o(wmo)o(de,)41 b(>)48 +b(blocksize,status\))0 4745 y Fh(2)81 b Fi(Op)s(en)24 +b(an)i(existing)f(FITS)g(\014le)g(with)f(readonly)h(or)h(readwrite)f +(access)i(and)f(mo)m(v)m(e)h(to)f(a)h(follo)m(wing)d(extension,)227 +4858 y(if)37 b(one)h(w)m(as)g(sp)s(eci\014ed)f(as)h(part)f(of)h(the)h +(\014lename.)62 b(\(e.g.,)42 b('\014lename.\014ts+2')37 +b(or)h('\014lename.\014ts[2]')h(will)227 4971 y(mo)m(v)m(e)f(to)g(the)e +(3rd)g(HDU)i(in)d(the)i(\014le\).)59 b(Note)37 b(that)h(this)d(routine) +h(di\013ers)f(from)h(FTOPEN)g(in)f(that)i(it)227 5084 +y(do)s(es)30 b(not)h(ha)m(v)m(e)h(the)e(redundan)m(t)f(blo)s(c)m(ksize) +h(argumen)m(t.)382 5342 y Fe(FTNOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))0 5601 y Fh(3)81 b Fi(Op)s(en)31 b(an)h(existing)f +(FITS)h(\014le)f(with)g(readonly)h(or)g(readwrite)g(access)h(and)f +(then)g(mo)m(v)m(e)i(to)f(the)g(\014rst)e(HDU)227 5714 +y(con)m(taining)25 b(signi\014can)m(t)g(data,)i(if)d(a\))j(an)e(HDU)h +(name)g(or)f(n)m(um)m(b)s(er)f(to)i(op)s(en)f(w)m(as)h(not)g +(explicitly)d(sp)s(eci\014ed)p eop +%%Page: 65 71 +65 70 bop 0 299 a Fg(8.2.)72 b(FILE)30 b(I/O)h(R)m(OUTINES)2693 +b Fi(65)227 555 y(as)31 b(part)g(of)g(the)g(\014lename,)g(and)f(b\))h +(if)f(the)h(FITS)f(\014le)g(con)m(tains)h(a)h(n)m(ull)c(primary)h(arra) +m(y)j(\(i.e.,)g(NAXIS)e(=)227 668 y(0\).)41 b(In)26 b(this)h(case,)i +(it)e(will)e(lo)s(ok)i(for)g(the)h(\014rst)e(IMA)m(GE)j(HDU)f(with)e +(NAXIS)h(>)h(0,)g(or)g(the)f(\014rst)g(table)g(that)227 +781 y(do)s(es)h(not)g(con)m(tain)f(the)h(strings)f(`GTI')h(\(Go)s(o)s +(d)f(Time)g(In)m(terv)-5 b(al\))28 b(or)g(`OBST)-8 b(ABLE')28 +b(in)e(the)i(EXTNAME)227 894 y(k)m(eyw)m(ord)37 b(v)-5 +b(alue.)60 b(FTTOPN)36 b(is)f(similar,)h(except)i(it)e(will)e(mo)m(v)m +(e)39 b(to)e(the)g(\014rst)f(signi\014can)m(t)g(table)g(HDU)227 +1007 y(\(skipping)24 b(o)m(v)m(er)i(an)m(y)g(image)g(HDUs\))h(in)d(the) +i(\014le)f(if)f(a)i(sp)s(eci\014c)f(HDU)h(name)g(or)g(n)m(um)m(b)s(er)e +(is)h(not)g(sp)s(eci\014ed.)227 1120 y(FTIOPN)30 b(will)e(mo)m(v)m(e)k +(to)f(the)f(\014rst)g(non-n)m(ull)e(image)j(HDU,)g(skipping)d(o)m(v)m +(er)j(an)m(y)g(tables.)382 1372 y Fe(FTDOPN\(unit,filename,rwm)o(ode)o +(,)42 b(>)47 b(status\))382 1485 y(FTTOPN\(unit,filename,rwm)o(ode)o(,) +42 b(>)47 b(status\))382 1598 y(FTIOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))0 1851 y Fh(4)81 b Fi(Op)s(en)30 b(and)h(initialize)e +(a)j(new)f(empt)m(y)h(FITS)e(\014le.)44 b(A)31 b(template)h(\014le)f +(ma)m(y)h(also)g(b)s(e)f(sp)s(eci\014ed)f(to)i(de\014ne)f(the)227 +1964 y(structure)h(of)h(the)g(new)f(\014le)f(\(see)j(section)e +(4.2.4\).)50 b(The)32 b(second)g(routine)g(simply)e(creates)k(the)f(sp) +s(eci\014ed)227 2077 y(\014le)d(without)f(trying)h(to)h(in)m(terpret)e +(the)i(\014lename)f(using)e(the)j(extended)f(\014lename)g(syn)m(tax.) +382 2330 y Fe(FTINIT\(unit,filename,blo)o(cks)o(ize,)41 +b(>)48 b(status\))382 2442 y(FTDKINIT\(unit,filename,b)o(loc)o(ksiz)o +(e,)42 b(>)47 b(status\))0 2695 y Fh(5)81 b Fi(Close)30 +b(a)g(FITS)g(\014le)f(previously)f(op)s(ened)i(with)f(ftop)s(en)h(or)g +(ftinit)382 2948 y Fe(FTCLOS\(unit,)44 b(>)k(status\))0 +3201 y Fh(6)81 b Fi(Mo)m(v)m(e)32 b(to)f(a)g(sp)s(eci\014ed)e +(\(absolute\))h(HDU)h(in)f(the)g(FITS)g(\014le)f(\(nhdu)g(=)h(1)h(for)f +(the)g(FITS)g(primary)e(arra)m(y\))382 3453 y Fe(FTMAHD\(unit,nhdu,)43 +b(>)k(hdutype,status\))0 3706 y Fh(7)81 b Fi(Create)30 +b(a)f(primary)e(arra)m(y)j(\(if)f(none)g(already)f(exists\),)i(or)f +(insert)f(a)i(new)f(IMA)m(GE)h(extension)f(immediately)227 +3819 y(follo)m(wing)22 b(the)h(CHDU,)g(or)g(insert)f(a)h(new)g(Primary) +e(Arra)m(y)i(at)h(the)f(b)s(eginning)d(of)j(the)g(\014le.)37 +b(An)m(y)23 b(follo)m(wing)227 3932 y(extensions)28 b(in)g(the)h +(\014le)e(will)f(b)s(e)i(shifted)g(do)m(wn)g(to)h(mak)m(e)h(ro)s(om)e +(for)h(the)g(new)f(extension.)39 b(If)29 b(the)g(CHDU)227 +4045 y(is)g(the)h(last)f(HDU)h(in)f(the)g(\014le)g(then)g(the)h(new)f +(image)h(extension)f(will)e(simply)g(b)s(e)i(app)s(ended)f(to)i(the)g +(end)227 4158 y(of)k(the)h(\014le.)51 b(One)33 b(can)h(force)h(a)g(new) +e(primary)f(arra)m(y)j(to)g(b)s(e)e(inserted)g(at)i(the)f(b)s(eginning) +d(of)j(the)h(FITS)227 4271 y(\014le)29 b(b)m(y)g(setting)g(status)h(=)f +(-9)h(prior)e(to)i(calling)d(the)j(routine.)39 b(In)29 +b(this)f(case)i(the)g(old)e(primary)g(arra)m(y)i(will)227 +4384 y(b)s(e)c(con)m(v)m(erted)j(to)e(an)g(IMA)m(GE)g(extension.)39 +b(The)27 b(new)f(extension)g(\(or)h(primary)e(arra)m(y\))j(will)c(b)s +(ecome)j(the)227 4496 y(CHDU.)382 4749 y Fe(FTIIMG\(unit,bitpix,naxis)o +(,na)o(xes,)41 b(>)48 b(status\))0 5002 y Fh(8)81 b Fi(Insert)30 +b(a)i(new)f(ASCI)s(I)f(T)-8 b(ABLE)31 b(extension)g(immediately)f +(follo)m(wing)f(the)j(CHDU.)g(An)m(y)f(follo)m(wing)f(exten-)227 +5115 y(sions)25 b(will)e(b)s(e)i(shifted)f(do)m(wn)h(to)h(mak)m(e)h(ro) +s(om)e(for)h(the)f(new)g(extension.)39 b(If)25 b(there)h(are)g(no)g +(other)f(follo)m(wing)227 5228 y(extensions)31 b(then)g(the)h(new)f +(table)g(extension)g(will)e(simply)g(b)s(e)i(app)s(ended)f(to)i(the)f +(end)g(of)h(the)f(\014le.)43 b(The)227 5341 y(new)30 +b(extension)g(will)e(b)s(ecome)j(the)f(CHDU.)382 5593 +y Fe(FTITAB\(unit,rowlen,nrows)o(,tf)o(ield)o(s,tt)o(ype)o(,tbc)o(ol,t) +o(for)o(m,tu)o(nit,)o(ext)o(name)o(,)42 b(>)716 5706 +y(status\))p eop +%%Page: 66 72 +66 71 bop 0 299 a Fi(66)1747 b Fg(CHAPTER)30 b(8.)111 +b(BASIC)30 b(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)0 555 +y Fh(9)81 b Fi(Insert)26 b(a)h(new)g(binary)e(table)h(extension)h +(immediately)e(follo)m(wing)h(the)h(CHDU.)g(An)m(y)g(follo)m(wing)e +(extensions)227 668 y(will)36 b(b)s(e)i(shifted)f(do)m(wn)h(to)h(mak)m +(e)g(ro)s(om)g(for)f(the)g(new)g(extension.)65 b(If)38 +b(there)h(are)f(no)h(other)f(follo)m(wing)227 781 y(extensions)e(then)h +(the)f(new)g(bin)m(table)f(extension)i(will)d(simply)g(b)s(e)i(app)s +(ended)e(to)k(the)e(end)g(of)h(the)g(\014le.)227 894 +y(The)30 b(new)g(extension)g(will)e(b)s(ecome)j(the)f(CHDU.)382 +1137 y Fe(FTIBIN\(unit,nrows,tfield)o(s,t)o(type)o(,tfo)o(rm,)o(tuni)o +(t,ex)o(tna)o(me,v)o(arid)o(at)41 b(>)48 b(status\))0 +1468 y Fd(8.3)135 b(Keyw)l(ord)46 b(I/O)f(Routines)0 +1705 y Fh(1)81 b Fi(Put)30 b(\(app)s(end\))f(an)h(80-c)m(haracter)j +(record)e(in)m(to)f(the)h(CHU.)382 1948 y Fe(FTPREC\(unit,card,)43 +b(>)k(status\))0 2191 y Fh(2)81 b Fi(Put)28 b(\(app)s(end\))g(a)h(new)g +(k)m(eyw)m(ord)g(of)g(the)g(appropriate)f(datat)m(yp)s(e)i(in)m(to)f +(the)g(CHU.)g(The)f(E)h(and)f(D)i(v)m(ersions)227 2304 +y(of)24 b(this)e(routine)g(ha)m(v)m(e)i(the)g(added)e(feature)i(that)g +(if)e(the)h('decimals')g(parameter)h(is)e(negativ)m(e,)k(then)d(the)g +('G')227 2417 y(displa)m(y)28 b(format)i(rather)f(then)g(the)h('E')f +(format)h(will)d(b)s(e)i(used)f(when)h(constructing)g(the)g(k)m(eyw)m +(ord)h(v)-5 b(alue,)227 2530 y(taking)26 b(the)h(absolute)f(v)-5 +b(alue)25 b(of)i('decimals')e(for)h(the)h(precision.)37 +b(This)25 b(will)e(suppress)h(trailing)h(zeros,)j(and)227 +2643 y(will)34 b(use)j(a)g(\014xed)f(format)h(rather)g(than)f(an)h(exp) +s(onen)m(tial)e(format,)k(dep)s(ending)34 b(on)j(the)g(magnitude)f(of) +227 2755 y(the)31 b(v)-5 b(alue.)382 2998 y Fe +(FTPKY[JLS]\(unit,keyword,)o(key)o(val,)o(comm)o(ent)o(,)42 +b(>)47 b(status\))382 3111 y(FTPKY[EDFG]\(unit,keyword)o(,ke)o(yval)o +(,dec)o(ima)o(ls,c)o(omme)o(nt,)41 b(>)48 b(status\))0 +3354 y Fh(3)81 b Fi(Get)37 b(the)f(n)m(th)f(80-c)m(haracter)k(header)d +(record)g(from)f(the)h(CHU.)h(The)e(\014rst)g(k)m(eyw)m(ord)i(in)d(the) +i(header)g(is)f(at)227 3467 y(k)m(ey)p 365 3467 28 4 +v 34 w(no)42 b(=)f(1;)49 b(if)41 b(k)m(ey)p 996 3467 +V 34 w(no)h(=)f(0)i(then)e(this)g(subroutine)f(simple)g(mo)m(v)m(es)k +(the)e(in)m(ternal)f(p)s(oin)m(ter)g(to)i(the)227 3580 +y(b)s(eginning)33 b(of)j(the)g(header)f(so)h(that)g(subsequen)m(t)f(k)m +(eyw)m(ord)h(op)s(erations)f(will)e(start)j(at)g(the)g(top)g(of)g(the) +227 3693 y(header;)31 b(it)f(also)g(returns)f(a)i(blank)e(card)h(v)-5 +b(alue)30 b(in)f(this)g(case.)382 3936 y Fe(FTGREC\(unit,key_no,)42 +b(>)48 b(card,status\))0 4178 y Fh(4)81 b Fi(Get)31 b(a)g(k)m(eyw)m +(ord)g(v)-5 b(alue)29 b(\(with)h(the)g(appropriate)g(datat)m(yp)s(e\))h +(and)f(commen)m(t)i(from)e(the)g(CHU)382 4421 y Fe +(FTGKY[EDJLS]\(unit,keywor)o(d,)41 b(>)48 b(keyval,comment,status\))0 +4664 y Fh(5)81 b Fi(Delete)31 b(an)f(existing)g(k)m(eyw)m(ord)h +(record.)382 4907 y Fe(FTDKEY\(unit,keyword,)42 b(>)48 +b(status\))0 5238 y Fd(8.4)135 b(Data)46 b(I/O)g(Routines)0 +5488 y Fi(The)32 b(follo)m(wing)f(routines)g(read)i(or)f(write)g(data)h +(v)-5 b(alues)32 b(in)f(the)i(curren)m(t)f(HDU)i(of)e(the)h(FITS)f +(\014le.)46 b(Automatic)0 5601 y(datat)m(yp)s(e)28 b(con)m(v)m(ersion)g +(will)c(b)s(e)j(attempted)h(for)g(n)m(umerical)d(datat)m(yp)s(es)k(if)d +(the)h(sp)s(eci\014ed)f(datat)m(yp)s(e)i(is)e(di\013eren)m(t)0 +5714 y(from)k(the)g(actual)h(datat)m(yp)s(e)h(of)e(the)h(FITS)e(arra)m +(y)i(or)f(table)h(column.)p eop +%%Page: 67 73 +67 72 bop 0 299 a Fg(8.4.)72 b(D)m(A)-8 b(T)g(A)32 b(I/O)f(R)m(OUTINES) +2650 b Fi(67)0 555 y Fh(1)81 b Fi(W)-8 b(rite)30 b(elemen)m(ts)h(in)m +(to)f(the)h(primary)d(data)k(arra)m(y)e(or)h(image)f(extension.)382 +771 y Fe(FTPPR[BIJED]\(unit,group,)o(fpi)o(xel,)o(nele)o(men)o(ts,v)o +(alue)o(s,)41 b(>)48 b(status\))0 987 y Fh(2)81 b Fi(Read)30 +b(elemen)m(ts)i(from)e(the)h(primary)d(data)k(arra)m(y)f(or)g(image)g +(extension.)41 b(Unde\014ned)29 b(arra)m(y)j(elemen)m(ts)f(will)227 +1100 y(b)s(e)g(returned)f(with)g(a)i(v)-5 b(alue)30 b(=)h(n)m(ullv)-5 +b(al,)30 b(unless)f(n)m(ullv)-5 b(al)29 b(=)i(0)h(in)e(whic)m(h)g(case) +i(no)f(c)m(hec)m(ks)i(for)e(unde\014ned)227 1213 y(pixels)f(will)e(b)s +(e)i(p)s(erformed.)42 b(The)30 b(an)m(yf)i(parameter)f(is)f(set)i(to)g +(true)f(\(=)g(.true.\))43 b(if)30 b(an)m(y)i(of)f(the)g(returned)227 +1326 y(elemen)m(ts)g(w)m(ere)g(unde\014ned.)382 1542 +y Fe(FTGPV[BIJED]\(unit,group,)o(fpi)o(xel,)o(nele)o(men)o(ts,n)o(ullv) +o(al,)41 b(>)48 b(values,anyf,status\))0 1758 y Fh(3)81 +b Fi(W)-8 b(rite)35 b(elemen)m(ts)h(in)m(to)f(an)g(ASCI)s(I)e(or)i +(binary)f(table)h(column.)53 b(The)35 b(`felem')g(parameter)h(applies)d +(only)h(to)227 1871 y(v)m(ector)e(columns)d(in)g(binary)g(tables)h(and) +g(is)f(ignored)h(when)f(writing)g(to)i(ASCI)s(I)d(tables.)382 +2087 y Fe(FTPCL[SLBIJEDCM]\(unit,co)o(lnu)o(m,fr)o(ow,f)o(ele)o(m,ne)o +(leme)o(nts)o(,val)o(ues,)41 b(>)47 b(status\))0 2303 +y Fh(4)81 b Fi(Read)22 b(elemen)m(ts)g(from)f(an)g(ASCI)s(I)g(or)g +(binary)f(table)i(column.)37 b(Unde\014ned)20 b(arra)m(y)i(elemen)m(ts) +g(will)d(b)s(e)i(returned)227 2416 y(with)31 b(a)i(v)-5 +b(alue)32 b(=)g(n)m(ullv)-5 b(al,)31 b(unless)g(n)m(ullv)-5 +b(al)29 b(=)k(0)f(\(or)h(=)f(')h(')f(for)g(ftgcvs\))i(in)d(whic)m(h)g +(case)j(no)e(c)m(hec)m(king)h(for)227 2529 y(unde\014ned)23 +b(v)-5 b(alues)24 b(will)e(b)s(e)j(p)s(erformed.)37 b(The)24 +b(ANYF)i(parameter)f(is)f(set)i(to)f(true)g(if)f(an)m(y)h(of)g(the)g +(returned)227 2642 y(elemen)m(ts)31 b(are)g(unde\014ned.)227 +2785 y(An)m(y)d(column,)g(regardless)f(of)h(it's)g(in)m(trinsic)d +(datat)m(yp)s(e,)30 b(ma)m(y)e(b)s(e)f(read)h(as)g(a)h(string.)39 +b(It)28 b(should)d(b)s(e)j(noted)227 2898 y(ho)m(w)m(ev)m(er)k(that)f +(reading)e(a)i(n)m(umeric)e(column)g(as)i(a)g(string)e(is)g(10)j(-)e +(100)i(times)e(slo)m(w)m(er)g(than)g(reading)g(the)227 +3011 y(same)36 b(column)e(as)i(a)g(n)m(um)m(b)s(er)e(due)g(to)j(the)e +(large)h(o)m(v)m(erhead)g(in)e(constructing)h(the)h(formatted)g +(strings.)227 3124 y(The)i(displa)m(y)e(format)i(of)g(the)g(returned)f +(strings)f(will)f(b)s(e)j(determined)e(b)m(y)i(the)g(TDISPn)f(k)m(eyw)m +(ord,)j(if)227 3237 y(it)c(exists,)h(otherwise)f(b)m(y)g(the)g(datat)m +(yp)s(e)h(of)f(the)h(column.)56 b(The)36 b(length)f(of)i(the)f +(returned)f(strings)g(can)227 3350 y(b)s(e)29 b(determined)e(with)h +(the)h(ftgcdw)g(routine.)39 b(The)28 b(follo)m(wing)g(TDISPn)f(displa)m +(y)h(formats)h(are)g(curren)m(tly)227 3463 y(supp)s(orted:)418 +3661 y Fe(Iw.m)142 b(Integer)418 3774 y(Ow.m)g(Octal)47 +b(integer)418 3887 y(Zw.m)142 b(Hexadecimal)45 b(integer)418 +4000 y(Fw.d)142 b(Fixed)47 b(floating)e(point)418 4113 +y(Ew.d)142 b(Exponential)45 b(floating)h(point)418 4226 +y(Dw.d)142 b(Exponential)45 b(floating)h(point)418 4339 +y(Gw.d)142 b(General;)46 b(uses)g(Fw.d)h(if)g(significance)e(not)i +(lost,)f(else)h(Ew.d)227 4538 y Fi(where)24 b(w)h(is)e(the)i(width)e +(in)g(c)m(haracters)j(of)f(the)g(displa)m(y)m(ed)e(v)-5 +b(alues,)26 b(m)e(is)g(the)g(minim)m(um)e(n)m(um)m(b)s(er)i(of)g +(digits)227 4651 y(displa)m(y)m(ed,)29 b(and)g(d)h(is)e(the)j(n)m(um)m +(b)s(er)d(of)i(digits)e(to)j(the)f(righ)m(t)g(of)g(the)g(decimal.)39 +b(The)29 b(.m)h(\014eld)f(is)g(optional.)382 4867 y Fe +(FTGCV[SBIJEDCM]\(unit,col)o(num)o(,fro)o(w,fe)o(lem)o(,nel)o(emen)o +(ts,)o(null)o(val,)41 b(>)1098 4980 y(values,anyf,status\))0 +5196 y Fh(5)81 b Fi(Get)42 b(the)g(table)g(column)e(n)m(um)m(b)s(er)h +(and)g(full)e(name)j(of)g(the)f(column)g(whose)g(name)h(matc)m(hes)h +(the)f(input)227 5309 y(template)34 b(string.)47 b(See)33 +b(the)h(`Adv)-5 b(anced)33 b(In)m(terface)h(Routines')e(c)m(hapter)i +(for)f(a)g(full)e(description)g(of)i(this)227 5422 y(routine.)382 +5638 y Fe(FTGCNN\(unit,casesen,colt)o(emp)o(late)o(,)42 +b(>)47 b(colname,colnum,status\))p eop +%%Page: 68 74 +68 73 bop 0 299 a Fi(68)1747 b Fg(CHAPTER)30 b(8.)111 +b(BASIC)30 b(INTERF)-10 b(A)m(CE)30 b(R)m(OUTINES)p eop +%%Page: 69 75 +69 74 bop 0 1225 a Ff(Chapter)65 b(9)0 1687 y Fl(Adv)-13 +b(anced)78 b(In)-6 b(terface)77 b(Subroutines)0 2180 +y Fi(This)30 b(c)m(hapter)i(de\014nes)f(all)f(the)i(a)m(v)-5 +b(ailable)31 b(subroutines)f(in)g(the)i(FITSIO)e(user)h(in)m(terface.) +45 b(F)-8 b(or)33 b(completeness,)0 2293 y(the)43 b(basic)f +(subroutines)e(describ)s(ed)g(in)i(the)g(previous)g(c)m(hapter)h(are)g +(also)f(rep)s(eated)h(here.)77 b(A)43 b(righ)m(t)f(arro)m(w)0 +2406 y(sym)m(b)s(ol)28 b(is)f(used)h(here)h(to)g(separate)h(the)f +(input)e(parameters)i(from)f(the)h(output)g(parameters)g(in)e(the)i +(de\014nition)0 2518 y(of)k(eac)m(h)h(subroutine.)46 +b(This)31 b(sym)m(b)s(ol)h(is)g(not)h(actually)g(part)f(of)h(the)h +(calling)d(sequence.)49 b(An)32 b(alphab)s(etical)f(list)0 +2631 y(and)f(de\014nition)e(of)i(all)g(the)g(parameters)h(is)e(giv)m +(en)i(at)g(the)f(end)g(of)h(this)e(section.)0 2961 y +Fd(9.1)135 b(FITS)44 b(File)i(Op)t(en)e(and)h(Close)h(Subroutines:)0 +3197 y Fh(1)81 b Fi(Op)s(en)39 b(an)h(existing)f(FITS)h(\014le)f(with)g +(readonly)h(or)g(readwrite)g(access.)72 b(FTDOPN)41 b(also)f(mo)m(v)m +(es)i(to)f(the)227 3310 y(\014rst)30 b(HDU)h(con)m(taining)f +(signi\014can)m(t)f(data,)j(if)d(no)h(sp)s(eci\014c)f(HDU)i(is)f(sp)s +(eci\014ed)f(as)h(part)g(of)h(the)f(\014lename.)227 3423 +y(FTTOPN)39 b(and)h(FTIOPN)f(are)h(similar)d(except)k(that)g(they)f +(will)d(mo)m(v)m(e)k(to)g(the)f(\014rst)f(table)g(HDU)i(or)227 +3536 y(image)31 b(HDU,)g(resp)s(ectiv)m(ely)-8 b(,)31 +b(if)e(a)i(HDU)g(name)f(or)h(n)m(um)m(b)s(er)e(is)g(not)i(sp)s +(eci\014ed)d(as)j(part)f(of)h(the)f(\014lename.)382 3770 +y Fe(FTOPEN\(unit,filename,rwm)o(ode)o(,)42 b(>)47 b +(blocksize,status\))382 3883 y(FTDOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))382 3996 y(FTTOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))382 4108 y(FTIOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))0 4343 y Fh(2)81 b Fi(Op)s(en)24 b(an)i(existing)f +(FITS)g(\014le)g(with)f(readonly)h(or)h(readwrite)f(access)i(and)f(mo)m +(v)m(e)h(to)f(a)h(follo)m(wing)d(extension,)227 4455 +y(if)37 b(one)h(w)m(as)g(sp)s(eci\014ed)f(as)h(part)f(of)h(the)h +(\014lename.)62 b(\(e.g.,)42 b('\014lename.\014ts+2')37 +b(or)h('\014lename.\014ts[2]')h(will)227 4568 y(mo)m(v)m(e)f(to)g(the)e +(3rd)g(HDU)i(in)d(the)i(\014le\).)59 b(Note)37 b(that)h(this)d(routine) +h(di\013ers)f(from)h(FTOPEN)g(in)f(that)i(it)227 4681 +y(do)s(es)30 b(not)h(ha)m(v)m(e)h(the)e(redundan)m(t)f(blo)s(c)m(ksize) +h(argumen)m(t.)382 4915 y Fe(FTNOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))0 5149 y Fh(3)81 b Fi(Reop)s(en)38 +b(a)i(FITS)e(\014le)h(that)g(w)m(as)h(previously)d(op)s(ened)h(with)g +(FTOPEN,)h(FTNOPN,)g(or)h(FTINIT.)e(The)227 5262 y(newunit)e(n)m(um)m +(b)s(er)g(ma)m(y)j(then)e(b)s(e)g(treated)i(as)f(a)g(separate)g +(\014le,)h(and)e(one)h(ma)m(y)h(sim)m(ultaneously)c(read)227 +5375 y(or)h(write)f(to)h(2)g(\(or)g(more\))g(di\013eren)m(t)f +(extensions)g(in)f(the)i(same)g(\014le.)55 b(The)35 b(FTOPEN)g(and)g +(FTNOPN)227 5488 y(routines)e(\(ab)s(o)m(v)m(e\))i(automatically)e +(detects)i(cases)g(where)e(a)g(previously)f(op)s(ened)g(\014le)h(is)g +(b)s(eing)f(op)s(ened)227 5601 y(again,)c(and)f(then)g(in)m(ternally)e +(call)h(FTREOPEN,)h(so)h(programs)e(should)g(rarely)g(need)h(to)h +(explicitly)d(call)227 5714 y(this)30 b(routine.)1905 +5942 y(69)p eop +%%Page: 70 76 +70 75 bop 0 299 a Fi(70)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)334 +555 y Fe(FTREOPEN\(unit,)44 b(>)j(newunit,)f(status\))0 +804 y Fh(4)81 b Fi(Op)s(en)29 b(and)g(initialize)f(a)j(new)f(empt)m(y)g +(FITS)g(\014le)334 1054 y Fe(FTINIT\(unit,filename,bloc)o(ksi)o(ze,)41 +b(>)48 b(status\))0 1303 y Fh(5)81 b Fi(Create)24 b(a)g(new)f(FITS)g +(\014le,)h(using)e(a)i(template)g(\014le)e(to)j(de\014ne)d(its)h +(initial)e(size)j(and)f(structure.)37 b(The)24 b(template)227 +1416 y(ma)m(y)39 b(b)s(e)f(another)h(FITS)e(HDU)i(or)g(an)f(ASCI)s(I)f +(template)i(\014le.)63 b(If)38 b(the)h(input)d(template)j(\014le)e +(name)i(is)227 1529 y(blank,)27 b(then)g(this)f(routine)g(b)s(eha)m(v)m +(es)i(the)f(same)h(as)f(FTINIT.)g(The)f(curren)m(tly)h(supp)s(orted)e +(format)i(of)h(the)227 1641 y(ASCI)s(I)c(template)i(\014le)f(is)f +(describ)s(ed)g(under)g(the)i(\014ts)p 2037 1641 28 4 +v 32 w(parse)p 2277 1641 V 33 w(template)f(routine)g(\(in)g(the)g +(general)h(Utilities)227 1754 y(section\),)31 b(but)f(this)f(ma)m(y)i +(c)m(hange)h(sligh)m(tly)d(later)h(releases)g(of)h(CFITSIO.)334 +2004 y Fe(FTTPLT\(unit,)45 b(filename,)g(tplfilename,)f(>)k(status\))0 +2253 y Fh(6)81 b Fi(Flush)32 b(in)m(ternal)g(bu\013ers)h(of)h(data)g +(to)g(the)g(output)g(FITS)f(\014le)g(previously)e(op)s(ened)i(with)f +(ftop)s(en)i(or)f(ftinit.)227 2366 y(The)j(routine)g(usually)e(nev)m +(er)j(needs)f(to)i(b)s(e)e(called,)h(but)f(doing)g(so)h(will)d(ensure)i +(that)h(if)e(the)i(program)227 2479 y(subsequen)m(tly)29 +b(ab)s(orts,)h(then)h(the)f(FITS)g(\014le)f(will)f(ha)m(v)m(e)k(at)f +(least)f(b)s(een)g(closed)g(prop)s(erly)-8 b(.)382 2728 +y Fe(FTFLUS\(unit,)44 b(>)k(status\))0 2977 y Fh(7)81 +b Fi(Close)30 b(a)g(FITS)g(\014le)f(previously)f(op)s(ened)i(with)f +(ftop)s(en)h(or)g(ftinit)382 3226 y Fe(FTCLOS\(unit,)44 +b(>)k(status\))0 3475 y Fh(8)81 b Fi(Close)33 b(and)g(DELETE)g(a)h +(FITS)f(\014le)g(previously)e(op)s(ened)i(with)f(ftop)s(en)h(or)h +(ftinit.)49 b(This)32 b(routine)g(ma)m(y)j(b)s(e)227 +3588 y(useful)28 b(in)h(cases)h(where)g(a)g(FITS)f(\014le)f(is)h +(created,)i(but)e(an)h(error)f(o)s(ccurs)h(whic)m(h)e(prev)m(en)m(ts)j +(the)e(complete)227 3701 y(\014le)h(from)g(b)s(eing)f(written.)382 +3950 y Fe(FTDELT\(unit,)44 b(>)k(status\))0 4199 y Fh(9)81 +b Fi(Get)31 b(the)g(v)-5 b(alue)30 b(of)g(an)g(un)m(used)g(I/O)g(unit)f +(n)m(um)m(b)s(er)g(whic)m(h)g(ma)m(y)i(then)f(b)s(e)g(used)g(as)g +(input)f(to)i(FTOPEN)f(or)227 4312 y(FTINIT.)36 b(This)e(routine)h +(searc)m(hes)i(for)f(the)g(\014rst)f(un)m(used)g(unit)f(n)m(um)m(b)s +(er)h(in)f(the)j(range)f(from)f(with)g(99)227 4425 y(do)m(wn)e(to)h +(50.)50 b(This)31 b(routine)h(just)h(k)m(eeps)h(an)f(in)m(ternal)f +(list)f(of)j(the)f(allo)s(cated)g(unit)f(n)m(um)m(b)s(ers)g(and)g(do)s +(es)227 4538 y(not)26 b(ph)m(ysically)d(c)m(hec)m(k)j(that)g(the)g(F)-8 +b(ortran)25 b(unit)f(is)g(a)m(v)-5 b(ailable)25 b(\(to)h(b)s(e)f +(compatible)f(with)g(the)h(SPP)f(v)m(ersion)227 4651 +y(of)35 b(FITSIO\).)g(Th)m(us)f(users)g(m)m(ust)h(not)g(indep)s(enden)m +(tly)d(allo)s(cate)j(an)m(y)h(unit)d(n)m(um)m(b)s(ers)h(in)g(the)h +(range)g(50)227 4764 y(-)42 b(99)g(if)e(this)g(routine)g(is)g(also)h +(to)h(b)s(e)f(used)f(in)g(the)h(same)h(program.)73 b(This)39 +b(routine)h(is)g(pro)m(vided)g(for)227 4877 y(con)m(v)m(enience)33 +b(only)-8 b(,)31 b(and)f(it)h(is)f(not)i(required)d(that)j(the)f(unit)f +(n)m(um)m(b)s(ers)g(used)g(b)m(y)h(FITSIO)f(b)s(e)h(allo)s(cated)227 +4990 y(b)m(y)g(this)e(routine.)382 5239 y Fe(FTGIOU\()46 +b(>)h(iounit,)f(status\))0 5488 y Fh(10)g Fi(F)-8 b(ree)34 +b(\(deallo)s(cate\))g(an)f(I/O)g(unit)e(n)m(um)m(b)s(er)h(whic)m(h)f(w) +m(as)i(previously)e(allo)s(cated)i(with)f(FTGIOU.)h(All)e(pre-)227 +5601 y(viously)26 b(allo)s(cated)i(unit)e(n)m(um)m(b)s(ers)g(ma)m(y)i +(b)s(e)f(deallo)s(cated)h(at)g(once)h(b)m(y)e(calling)f(FTFIOU)i(with)e +(iounit)g(=)227 5714 y(-1.)p eop +%%Page: 71 77 +71 76 bop 0 299 a Fg(9.1.)72 b(FITS)30 b(FILE)g(OPEN)g(AND)h(CLOSE)e +(SUBR)m(OUTINES:)1561 b Fi(71)382 555 y Fe(FTFIOU\(iounit,)44 +b(>)j(status\))0 788 y Fh(11)f Fi(Return)30 b(the)h(F)-8 +b(ortran)31 b(unit)f(n)m(um)m(b)s(er)f(that)i(corresp)s(onds)f(to)h +(the)g(C)g(\014ts\014le)e(p)s(oin)m(ter)h(v)-5 b(alue,)31 +b(or)f(vice)h(v)m(ersa.)227 901 y(These)37 b(2)h(C)f(routines)f(ma)m(y) +h(b)s(e)g(useful)e(in)h(mixed)g(language)i(programs)f(where)f(b)s(oth)h +(C)g(and)f(F)-8 b(ortran)227 1014 y(subroutines)24 b(need)h(to)i +(access)g(the)f(same)g(\014le.)39 b(F)-8 b(or)26 b(example,)h(if)e(a)h +(FITS)f(\014le)g(is)g(op)s(ened)g(with)f(unit)g(12)j(b)m(y)227 +1127 y(a)k(F)-8 b(ortran)31 b(subroutine,)e(then)h(a)h(C)f(routine)g +(within)e(the)i(same)h(program)g(could)e(get)j(the)e(\014t\014le)g(p)s +(oin)m(ter)227 1240 y(v)-5 b(alue)38 b(to)g(access)h(the)f(same)h +(\014le)e(b)m(y)g(calling)g('fptr)g(=)h(CUnit2FITS\(12\)'.)63 +b(These)38 b(routines)f(return)g(a)227 1353 y(v)-5 b(alue)30 +b(of)h(zero)g(if)e(an)h(error)g(o)s(ccurs.)286 1586 y +Fe(int)334 b(CFITS2Unit\(fitsfile)42 b(*ptr\);)286 1698 +y(fitsfile*)k(CUnit2FITS\(int)e(unit\);)0 1931 y Fh(11)i +Fi(P)m(arse)32 b(the)g(input)d(\014lename)i(and)g(return)f(the)i(HDU)g +(n)m(um)m(b)s(er)e(that)i(w)m(ould)e(b)s(e)h(mo)m(v)m(ed)i(to)f(if)e +(the)i(\014le)e(w)m(ere)227 2044 y(op)s(ened)j(with)f(FTNOPN.)h(The)f +(returned)g(HDU)i(n)m(um)m(b)s(er)e(b)s(egins)g(with)g(1)h(for)g(the)g +(primary)f(arra)m(y)-8 b(,)35 b(so)227 2157 y(for)d(example,)f(if)g +(the)h(input)e(\014lename)g(=)i(`m)m(y\014le.\014ts[2]')g(then)f(hdun)m +(um)e(=)j(3)g(will)d(b)s(e)i(returned.)43 b(FIT-)227 +2270 y(SIO)35 b(do)s(es)h(not)g(op)s(en)g(the)g(\014le)f(to)i(c)m(hec)m +(k)h(if)d(the)h(extension)g(actually)g(exists)f(if)h(an)f(extension)h +(n)m(um)m(b)s(er)227 2383 y(is)42 b(sp)s(eci\014ed.)74 +b(If)42 b(an)g(extension)g(*name*)h(is)e(included)f(in)h(the)h(\014le)f +(name)i(sp)s(eci\014cation)e(\(e.g.)77 b(`m)m(y-)227 +2496 y(\014le.\014ts[EVENTS]')29 b(then)g(this)g(routine)g(will)e(ha)m +(v)m(e)k(to)f(op)s(en)f(the)h(FITS)f(\014le)g(and)g(lo)s(ok)g(for)h +(the)g(p)s(osition)227 2609 y(of)38 b(the)h(named)e(extension,)j(then)e +(close)g(\014le)f(again.)63 b(This)37 b(is)g(not)h(p)s(ossible)d(if)i +(the)h(\014le)f(is)g(b)s(eing)g(read)227 2722 y(from)f(the)g(stdin)e +(stream,)k(and)d(an)h(error)f(will)e(b)s(e)j(returned)e(in)h(this)g +(case.)58 b(If)35 b(the)h(\014lename)f(do)s(es)h(not)227 +2835 y(sp)s(ecify)28 b(an)h(explicit)e(extension)i(\(e.g.)42 +b('m)m(y\014le.\014ts'\))29 b(then)g(hdun)m(um)e(=)h(-99)j(will)26 +b(b)s(e)j(returned,)f(whic)m(h)g(is)227 2948 y(functionally)j(equiv)-5 +b(alen)m(t)33 b(to)i(hdun)m(um)c(=)i(1.)50 b(This)32 +b(routine)g(is)h(mainly)f(used)g(for)i(bac)m(kw)m(ard)g(compati-)227 +3060 y(bilit)m(y)d(in)g(the)h(fto)s(ols)g(soft)m(w)m(are)i(pac)m(k)-5 +b(age)34 b(and)e(is)f(not)h(recommended)g(for)g(general)h(use.)46 +b(It)32 b(is)g(generally)227 3173 y(b)s(etter)j(and)g(more)g(e\016cien) +m(t)g(to)h(\014rst)e(op)s(en)g(the)h(FITS)f(\014le)g(with)g(FTNOPN,)h +(then)g(use)f(FTGHDN)i(to)227 3286 y(determine)29 b(whic)m(h)g(HDU)h +(in)e(the)i(\014le)f(has)h(b)s(een)f(op)s(ened,)g(rather)g(than)h +(calling)e(FTEXTN)i(follo)m(w)m(ed)f(b)m(y)227 3399 y(a)i(call)f(to)h +(FTNOPN.)382 3632 y Fe(FTEXTN\(filename,)43 b(>)48 b(nhdu,)e(status\))0 +3865 y Fh(12)g Fi(Return)30 b(the)g(name)h(of)f(the)h(op)s(ened)e(FITS) +h(\014le.)382 4098 y Fe(FTFLNM\(unit,)44 b(>)k(filename,)d(status\))0 +4331 y Fh(13)h Fi(Return)30 b(the)g(I/O)g(mo)s(de)g(of)h(the)g(op)s(en) +e(FITS)h(\014le)f(\(READONL)-8 b(Y)32 b(=)e(0,)h(READ)m(WRITE)g(=)f +(1\).)382 4564 y Fe(FTFLMD\(unit,)44 b(>)k(iomode,)e(status\))0 +4796 y Fh(14)g Fi(Return)30 b(the)g(\014le)g(t)m(yp)s(e)g(of)h(the)f +(op)s(ened)g(FITS)g(\014le)f(\(e.g.)42 b('\014le://',)31 +b('ftp://',)h(etc.\).)382 5029 y Fe(FTURLT\(unit,)44 +b(>)k(urltype,)d(status\))0 5262 y Fh(15)h Fi(P)m(arse)27 +b(the)f(input)e(\014lename)i(or)g(URL)g(in)m(to)g(its)g(comp)s(onen)m +(t)g(parts:)39 b(the)26 b(\014le)f(t)m(yp)s(e)i(\(\014le://,)g(ftp://,) +h(h)m(ttp://,)227 5375 y(etc\),)34 b(the)e(base)g(input)d(\014le)i +(name,)h(the)g(name)g(of)g(the)g(output)f(\014le)g(that)h(the)g(input)e +(\014le)g(is)h(to)h(b)s(e)f(copied)227 5488 y(to)38 b(prior)d(to)i(op)s +(ening,)g(the)g(HDU)g(or)f(extension)h(sp)s(eci\014cation,)g(the)g +(\014ltering)d(sp)s(eci\014er,)j(the)g(binning)227 5601 +y(sp)s(eci\014er,)d(and)f(the)i(column)e(sp)s(eci\014er.)50 +b(Blank)33 b(strings)g(will)f(b)s(e)h(returned)g(for)h(an)m(y)g(comp)s +(onen)m(ts)g(that)227 5714 y(are)d(not)g(presen)m(t)f(in)f(the)i(input) +d(\014le)i(name.)p eop +%%Page: 72 78 +72 77 bop 0 299 a Fi(72)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)334 +555 y Fe(FTIURL\(filename,)43 b(>)48 b(filetype,)d(infile,)h(outfile,)g +(extspec,)f(filter,)716 668 y(binspec,)g(colspec,)h(status\))0 +913 y Fh(16)g Fi(P)m(arse)e(the)g(input)e(\014le)h(name)g(and)g(return) +g(the)h(ro)s(ot)g(\014le)e(name.)81 b(The)43 b(ro)s(ot)h(name)g +(includes)d(the)j(\014le)227 1025 y(t)m(yp)s(e)35 b(if)f(sp)s +(eci\014ed,)h(\(e.g.)56 b('ftp://')37 b(or)e('h)m(ttp://'\))i(and)d +(the)h(full)e(path)i(name,)h(to)g(the)f(exten)m(t)i(that)e(it)g(is)227 +1138 y(sp)s(eci\014ed)25 b(in)f(the)j(input)d(\014lename.)38 +b(It)26 b(do)s(es)g(not)g(include)e(the)i(HDU)h(name)f(or)g(n)m(um)m(b) +s(er,)g(or)g(an)m(y)h(\014ltering)227 1251 y(sp)s(eci\014cations.)334 +1496 y Fe(FTRTNM\(filename,)43 b(>)48 b(rootname,)d(status\))0 +1740 y Fh(16)h Fi(T)-8 b(est)36 b(if)f(the)h(input)e(\014le)h(or)g(a)i +(compressed)e(v)m(ersion)g(of)h(the)g(\014le)f(\(with)g(a)h(.gz,)i(.Z,) +e(.z,)i(or)e(.zip)f(extension\))227 1853 y(exists)j(on)g(disk.)62 +b(The)37 b(returned)g(v)-5 b(alue)37 b(of)h(the)h('exists')f(parameter) +g(will)d(ha)m(v)m(e)40 b(1)e(of)g(the)g(4)g(follo)m(wing)227 +1966 y(v)-5 b(alues:)370 2198 y Fe(2:)95 b(the)47 b(file)g(does)g(not)f +(exist,)h(but)f(a)i(compressed)d(version)h(does)g(exist)370 +2311 y(1:)95 b(the)47 b(disk)g(file)g(does)f(exist)370 +2424 y(0:)95 b(neither)46 b(the)h(file)g(nor)g(a)g(compressed)e +(version)h(of)h(the)g(file)g(exist)323 2537 y(-1:)94 +b(the)47 b(input)g(file)f(name)h(is)g(not)g(a)g(disk)g(file)g(\(could)f +(be)h(a)g(ftp,)g(http,)561 2650 y(smem,)g(or)g(mem)g(file,)f(or)h(a)h +(file)e(piped)h(in)g(on)g(the)g(STDIN)f(stream\))286 +2894 y(FTEXIST\(filename,)d(>)48 b(exists,)e(status\);)0 +3225 y Fd(9.2)135 b(HDU-Lev)l(el)47 b(Op)t(erations)0 +3475 y Fi(When)30 b(a)h(FITS)f(\014le)f(is)h(\014rst)f(op)s(ened)h(or)g +(created,)i(the)f(in)m(ternal)e(bu\013ers)g(in)g(FITSIO)g +(automatically)i(p)s(oin)m(t)e(to)0 3588 y(the)h(\014rst)g(HDU)h(in)e +(the)h(\014le.)40 b(The)29 b(follo)m(wing)g(routines)g(ma)m(y)i(b)s(e)e +(used)h(to)h(mo)m(v)m(e)g(to)g(another)f(HDU)h(in)e(the)i(\014le.)0 +3701 y(Note)j(that)f(the)g(HDU)g(n)m(um)m(b)s(ering)e(con)m(v)m(en)m +(tion)i(used)f(in)f(FITSIO)h(denotes)h(the)f(primary)f(arra)m(y)i(as)g +(the)g(\014rst)0 3814 y(HDU,)e(the)g(\014rst)f(extension)g(in)f(a)h +(FITS)g(\014le)f(is)h(the)g(second)h(HDU,)g(and)f(so)h(on.)0 +4059 y Fh(1)81 b Fi(Mo)m(v)m(e)32 b(to)f(a)g(sp)s(eci\014ed)e +(\(absolute\))h(HDU)h(in)f(the)g(FITS)g(\014le)f(\(nhdu)g(=)h(1)h(for)f +(the)g(FITS)g(primary)e(arra)m(y\))382 4303 y Fe(FTMAHD\(unit,nhdu,)43 +b(>)k(hdutype,status\))0 4548 y Fh(2)81 b Fi(Mo)m(v)m(e)32 +b(to)f(a)g(new)f(\(existing\))g(HDU)h(forw)m(ard)f(or)g(bac)m(kw)m +(ards)h(relativ)m(e)f(to)h(the)g(CHDU)382 4792 y Fe +(FTMRHD\(unit,nmove,)43 b(>)k(hdutype,status\))0 5036 +y Fh(3)81 b Fi(Mo)m(v)m(e)22 b(to)f(the)f(\(\014rst\))h(HDU)g(whic)m(h) +e(has)h(the)g(sp)s(eci\014ed)f(extension)h(t)m(yp)s(e)g(and)g(EXTNAME)g +(\(or)h(HDUNAME\))227 5149 y(and)32 b(EXTVER)g(k)m(eyw)m(ord)h(v)-5 +b(alues.)47 b(The)32 b(hdut)m(yp)s(e)f(parameter)i(ma)m(y)h(ha)m(v)m(e) +f(a)g(v)-5 b(alue)32 b(of)h(IMA)m(GE)p 3640 5149 28 4 +v 34 w(HDU,)227 5262 y(ASCI)s(I)p 486 5262 V 32 w(TBL,)f(BINAR)-8 +b(Y)p 1122 5262 V 34 w(TBL,)32 b(or)h(ANY)p 1718 5262 +V 33 w(HDU)g(where)f(ANY)p 2458 5262 V 33 w(HDU)i(means)e(that)h(only)f +(the)g(extname)227 5375 y(and)k(extv)m(er)h(v)-5 b(alues)35 +b(will)e(b)s(e)i(used)g(to)i(lo)s(cate)g(the)f(correct)h(extension.)57 +b(If)35 b(the)h(input)e(v)-5 b(alue)36 b(of)g(extv)m(er)227 +5488 y(is)c(0)h(then)f(the)g(EXTVER)h(k)m(eyw)m(ord)g(is)e(ignored)h +(and)g(the)g(\014rst)g(HDU)h(with)e(a)i(matc)m(hing)g(EXTNAME)227 +5601 y(\(or)j(HDUNAME\))h(k)m(eyw)m(ord)f(will)c(b)s(e)j(found.)55 +b(If)34 b(no)i(matc)m(hing)f(HDU)h(is)f(found)f(in)g(the)h(\014le)g +(then)g(the)227 5714 y(curren)m(t)27 b(HDU)g(will)d(remain)h(unc)m +(hanged)i(and)f(a)h(status)g(=)f(BAD)p 2501 5714 V 34 +w(HDU)p 2740 5714 V 33 w(NUM)h(\(301\))i(will)24 b(b)s(e)i(returned.)p +eop +%%Page: 73 79 +73 78 bop 0 299 a Fg(9.2.)72 b(HDU-LEVEL)31 b(OPERA)-8 +b(TIONS)2414 b Fi(73)382 555 y Fe(FTMNHD\(unit,)44 b(hdutype,)i +(extname,)f(extver,)h(>)i(status\))0 804 y Fh(4)81 b +Fi(Get)31 b(the)g(n)m(um)m(b)s(er)e(of)h(the)h(curren)m(t)f(HDU)h(in)e +(the)i(FITS)e(\014le)h(\(primary)f(arra)m(y)h(=)g(1\))382 +1054 y Fe(FTGHDN\(unit,)44 b(>)k(nhdu\))0 1303 y Fh(5)81 +b Fi(Return)39 b(the)i(t)m(yp)s(e)g(of)g(the)g(curren)m(t)f(HDU)i(in)d +(the)i(FITS)f(\014le.)70 b(The)41 b(p)s(ossible)d(v)-5 +b(alues)40 b(for)g(hdut)m(yp)s(e)g(are)227 1416 y(IMA)m(GE)p +546 1416 28 4 v 34 w(HDU)31 b(\(0\),)h(ASCI)s(I)p 1242 +1416 V 31 w(TBL)e(\(1\),)i(or)e(BINAR)-8 b(Y)p 2133 1416 +V 34 w(TBL)30 b(\(2\).)382 1665 y Fe(FTGHDT\(unit,)44 +b(>)k(hdutype,)d(status\))0 1914 y Fh(6)81 b Fi(Return)29 +b(the)i(total)g(n)m(um)m(b)s(er)e(of)i(HDUs)f(in)g(the)g(FITS)g +(\014le.)40 b(The)29 b(CHDU)i(remains)e(unc)m(hanged.)382 +2163 y Fe(FTTHDU\(unit,)44 b(>)k(hdunum,)e(status\))0 +2412 y Fh(7)81 b Fi(Create)36 b(\(app)s(end\))e(a)h(new)g(empt)m(y)g +(HDU)h(follo)m(wing)e(the)h(last)g(extension)g(that)h(has)f(b)s(een)f +(previously)f(ac-)227 2525 y(cessed)41 b(b)m(y)f(the)g(program.)70 +b(This)39 b(will)e(o)m(v)m(erwrite)k(an)m(y)g(extensions)f(in)e(an)j +(existing)e(FITS)g(\014le)h(if)f(the)227 2638 y(program)31 +b(has)g(not)g(already)g(mo)m(v)m(ed)h(to)f(that)h(\(or)f(a)h(later\))f +(extension)g(using)e(the)i(FTMAHD)h(or)f(FTM-)227 2751 +y(RHD)24 b(routines.)37 b(F)-8 b(or)25 b(example,)f(if)f(an)g(existing) +f(FITS)h(\014le)f(con)m(tains)i(a)g(primary)d(arra)m(y)j(and)f(5)g +(extensions)227 2864 y(and)31 b(a)h(program)f(\(1\))h(op)s(ens)f(the)g +(FITS)g(\014le,)g(\(2\))h(mo)m(v)m(es)h(to)f(extension)f(4,)h(\(3\))g +(mo)m(v)m(es)h(bac)m(k)f(to)g(the)f(pri-)227 2977 y(mary)36 +b(arra)m(y)-8 b(,)38 b(and)e(\(4\))h(then)e(calls)g(FTCRHD,)h(then)g +(the)g(new)g(extension)f(will)e(b)s(e)j(written)e(follo)m(wing)227 +3090 y(the)d(4th)f(extension,)h(o)m(v)m(erwriting)f(the)g(existing)f +(5th)i(extension.)382 3339 y Fe(FTCRHD\(unit,)44 b(>)k(status\))0 +3588 y Fh(8)81 b Fi(Insert)41 b(a)h(new)f(IMA)m(GE)i(extension)f +(immediately)e(follo)m(wing)g(the)i(CHDU.)g(An)m(y)g(follo)m(wing)e +(extensions)227 3701 y(will)c(b)s(e)i(shifted)f(do)m(wn)h(to)h(mak)m(e) +g(ro)s(om)g(for)f(the)g(new)g(extension.)65 b(If)38 b(there)h(are)f(no) +h(other)f(follo)m(wing)227 3814 y(extensions)29 b(then)g(the)h(new)e +(image)i(extension)f(will)e(simply)f(b)s(e)j(app)s(ended)f(to)i(the)f +(end)g(of)g(the)h(\014le.)39 b(The)227 3927 y(new)30 +b(extension)g(will)e(b)s(ecome)j(the)f(CHDU.)382 4176 +y Fe(FTIIMG\(unit,bitpix,naxis)o(,na)o(xes,)41 b(>)48 +b(status\))0 4425 y Fh(9)81 b Fi(Insert)30 b(a)i(new)f(ASCI)s(I)f(T)-8 +b(ABLE)31 b(extension)g(immediately)f(follo)m(wing)f(the)j(CHDU.)g(An)m +(y)f(follo)m(wing)f(exten-)227 4538 y(sions)25 b(will)e(b)s(e)i +(shifted)f(do)m(wn)h(to)h(mak)m(e)h(ro)s(om)e(for)h(the)f(new)g +(extension.)39 b(If)25 b(there)h(are)g(no)g(other)f(follo)m(wing)227 +4651 y(extensions)31 b(then)g(the)h(new)f(table)g(extension)g(will)e +(simply)g(b)s(e)i(app)s(ended)f(to)i(the)f(end)g(of)h(the)f(\014le.)43 +b(The)227 4764 y(new)30 b(extension)g(will)e(b)s(ecome)j(the)f(CHDU.) +382 5013 y Fe(FTITAB\(unit,rowlen,nrows)o(,tf)o(ield)o(s,tt)o(ype)o +(,tbc)o(ol,t)o(for)o(m,tu)o(nit,)o(ext)o(name)o(,)42 +b(>)716 5126 y(status\))0 5375 y Fh(10)k Fi(Insert)25 +b(a)h(new)f(binary)e(table)j(extension)f(immediately)e(follo)m(wing)h +(the)i(CHDU.)g(An)m(y)g(follo)m(wing)d(extensions)227 +5488 y(will)36 b(b)s(e)i(shifted)f(do)m(wn)h(to)h(mak)m(e)g(ro)s(om)g +(for)f(the)g(new)g(extension.)65 b(If)38 b(there)h(are)f(no)h(other)f +(follo)m(wing)227 5601 y(extensions)e(then)h(the)f(new)g(bin)m(table)f +(extension)i(will)d(simply)g(b)s(e)i(app)s(ended)e(to)k(the)e(end)g(of) +h(the)g(\014le.)227 5714 y(The)30 b(new)g(extension)g(will)e(b)s(ecome) +j(the)f(CHDU.)p eop +%%Page: 74 80 +74 79 bop 0 299 a Fi(74)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)382 +555 y Fe(FTIBIN\(unit,nrows,tfield)o(s,t)o(type)o(,tfo)o(rm,)o(tuni)o +(t,ex)o(tna)o(me,v)o(arid)o(at)41 b(>)48 b(status\))0 +777 y Fh(11)e Fi(Resize)25 b(an)f(image)h(b)m(y)f(mo)s(di\014ng)e(the)j +(size,)h(dimensions,)d(and/or)h(datat)m(yp)s(e)h(of)g(the)g(curren)m(t) +f(primary)e(arra)m(y)227 890 y(or)29 b(image)h(extension.)39 +b(If)29 b(the)g(new)g(image,)h(as)f(sp)s(eci\014ed)e(b)m(y)i(the)g +(input)e(argumen)m(ts,)j(is)e(larger)h(than)g(the)227 +1003 y(curren)m(t)34 b(existing)f(image)h(in)f(the)h(FITS)f(\014le)g +(then)g(zero)i(\014ll)d(data)j(will)c(b)s(e)i(inserted)g(at)h(the)g +(end)g(of)g(the)227 1116 y(curren)m(t)25 b(image)g(and)f(an)m(y)i +(follo)m(wing)d(extensions)i(will)d(b)s(e)i(mo)m(v)m(ed)i(further)e +(bac)m(k)h(in)f(the)h(\014le.)38 b(Similarly)-8 b(,)23 +b(if)227 1229 y(the)28 b(new)e(image)i(is)e(smaller)g(than)h(the)g +(curren)m(t)g(image)g(then)g(an)m(y)h(follo)m(wing)e(extensions)g(will) +f(b)s(e)h(shifted)227 1342 y(up)32 b(to)m(w)m(ards)i(the)g(b)s +(eginning)c(of)j(the)h(FITS)e(\014le)g(and)h(the)g(image)g(data)h(will) +d(b)s(e)h(truncated)h(to)h(the)f(new)227 1455 y(size.)40 +b(This)24 b(routine)h(rewrites)h(the)g(BITPIX,)h(NAXIS,)f(and)g(NAXISn) +g(k)m(eyw)m(ords)g(with)f(the)i(appropriate)227 1567 +y(v)-5 b(alues)30 b(for)g(new)g(image.)382 1789 y Fe +(FTRSIM\(unit,bitpix,naxis)o(,na)o(xes,)o(stat)o(us\))0 +2011 y Fh(12)46 b Fi(Delete)33 b(the)g(CHDU)g(in)e(the)h(FITS)f +(\014le.)46 b(An)m(y)32 b(follo)m(wing)f(HDUs)i(will)d(b)s(e)h(shifted) +g(forw)m(ard)h(in)f(the)h(\014le,)g(to)227 2124 y(\014ll)k(in)g(the)h +(gap)h(created)g(b)m(y)g(the)f(deleted)g(HDU.)i(In)d(the)i(case)g(of)g +(deleting)e(the)i(primary)d(arra)m(y)j(\(the)227 2237 +y(\014rst)30 b(HDU)h(in)e(the)i(\014le\))f(then)g(the)h(curren)m(t)f +(primary)e(arra)m(y)j(will)d(b)s(e)i(replace)g(b)m(y)h(a)g(n)m(ull)d +(primary)g(arra)m(y)227 2350 y(con)m(taining)j(the)h(minim)m(um)c(set)k +(of)g(required)d(k)m(eyw)m(ords)j(and)e(no)i(data.)44 +b(If)31 b(there)g(are)h(more)f(extensions)227 2463 y(in)e(the)h(\014le) +f(follo)m(wing)g(the)h(one)g(that)h(is)e(deleted,)h(then)g(the)g(the)g +(CHDU)h(will)c(b)s(e)j(rede\014ned)e(to)j(p)s(oin)m(t)e(to)227 +2576 y(the)e(follo)m(wing)e(extension.)40 b(If)26 b(there)h(are)g(no)g +(follo)m(wing)e(extensions)h(then)h(the)g(CHDU)g(will)d(b)s(e)i +(rede\014ned)227 2689 y(to)35 b(p)s(oin)m(t)e(to)i(the)f(previous)e +(HDU.)j(The)e(output)h(HDUTYPE)g(parameter)h(indicates)d(the)j(t)m(yp)s +(e)f(of)g(the)227 2802 y(new)c(CHDU)h(after)g(the)f(previous)f(CHDU)i +(has)f(b)s(een)g(deleted.)382 3024 y Fe(FTDHDU\(unit,)44 +b(>)k(hdutype,status\))0 3245 y Fh(13)e Fi(Cop)m(y)36 +b(all)f(or)h(part)g(of)g(the)g(input)e(FITS)h(\014le)g(and)h(app)s(end) +e(it)h(to)i(the)f(end)g(of)g(the)g(output)g(FITS)f(\014le.)56 +b(If)227 3358 y('previous')27 b(is)g(true)h(\(not)g(0\),)i(then)d(an)m +(y)h(HDUs)h(preceding)e(the)h(curren)m(t)f(HDU)i(in)d(the)i(input)e +(\014le)h(will)f(b)s(e)227 3471 y(copied)33 b(to)h(the)g(output)f +(\014le.)50 b(Similarly)-8 b(,)31 b('curren)m(t')j(and)e('follo)m +(wing')h(determine)g(whether)f(the)i(curren)m(t)227 3584 +y(HDU,)g(and/or)e(an)m(y)h(follo)m(wing)e(HDUs)i(in)e(the)h(input)f +(\014le)g(will)f(b)s(e)i(copied)g(to)h(the)f(output)g(\014le.)46 +b(If)32 b(all)g(3)227 3697 y(parameters)j(are)h(true,)g(then)e(the)h +(en)m(tire)g(input)e(\014le)h(will)e(b)s(e)i(copied.)54 +b(On)33 b(return,)j(the)f(curren)m(t)f(HDU)227 3810 y(in)29 +b(the)g(input)f(\014le)h(will)e(b)s(e)i(unc)m(hanged,)h(and)f(the)h +(last)f(copied)g(HDU)i(will)c(b)s(e)i(the)h(curren)m(t)f(HDU)h(in)f +(the)227 3923 y(output)h(\014le.)382 4145 y Fe(FTCPFL\(iunit,)44 +b(ounit,)i(previous,)f(current,)h(following,)f(>)i(status\))0 +4367 y Fh(14)f Fi(Cop)m(y)35 b(the)f(en)m(tire)h(CHDU)g(from)f(the)g +(FITS)g(\014le)g(asso)s(ciated)h(with)e(IUNIT)h(to)i(the)e(CHDU)h(of)g +(the)g(FITS)227 4480 y(\014le)f(asso)s(ciated)h(with)e(OUNIT.)h(The)g +(output)g(HDU)h(m)m(ust)f(b)s(e)g(empt)m(y)h(and)e(not)i(already)f(con) +m(tain)h(an)m(y)227 4593 y(k)m(eyw)m(ords.)41 b(Space)29 +b(will)d(b)s(e)j(reserv)m(ed)g(for)g(MOREKEYS)f(additional)e(k)m(eyw)m +(ords)k(in)d(the)j(output)e(header)227 4706 y(if)i(there)g(is)g(not)g +(already)g(enough)g(space.)382 4927 y Fe(FTCOPY\(iunit,ounit,morek)o +(eys)o(,)42 b(>)47 b(status\))0 5149 y Fh(15)f Fi(Cop)m(y)27 +b(the)h(header)f(\(and)g(not)g(the)g(data\))i(from)d(the)i(CHDU)g(asso) +s(ciated)f(with)f(in)m(unit)f(to)j(the)f(CHDU)h(asso-)227 +5262 y(ciated)e(with)e(outunit.)38 b(If)25 b(the)g(curren)m(t)h(output) +f(HDU)h(is)e(not)i(completely)f(empt)m(y)-8 b(,)27 b(then)e(the)h(CHDU) +g(will)227 5375 y(b)s(e)e(closed)h(and)f(a)i(new)e(HDU)h(will)e(b)s(e)h +(app)s(ended)f(to)j(the)f(output)f(\014le.)38 b(This)23 +b(routine)h(will)e(automatically)227 5488 y(transform)31 +b(the)g(necessary)h(k)m(eyw)m(ords)f(when)g(cop)m(ying)g(a)g(primary)f +(arra)m(y)i(to)f(and)g(image)h(extension,)f(or)227 5601 +y(an)c(image)g(extension)f(to)h(a)h(primary)c(arra)m(y)-8 +b(.)41 b(An)26 b(empt)m(y)h(output)f(data)i(unit)d(will)f(b)s(e)i +(created)i(\(all)e(v)-5 b(alues)227 5714 y(=)30 b(0\).)p +eop +%%Page: 75 81 +75 80 bop 0 299 a Fg(9.3.)72 b(DEFINE)31 b(OR)f(REDEFINE)h(THE)f(STR)m +(UCTURE)f(OF)h(THE)g(CHDU)1042 b Fi(75)382 555 y Fe(FTCPHD\(inunit,)44 +b(outunit,)h(>)j(status\))0 819 y Fh(16)e Fi(Cop)m(y)d(just)g(the)g +(data)h(from)f(the)g(CHDU)h(asso)s(ciated)f(with)f(IUNIT)h(to)h(the)f +(CHDU)h(asso)s(ciated)f(with)227 932 y(OUNIT.)26 b(This)e(will)f(o)m(v) +m(erwrite)j(an)m(y)g(data)g(previously)e(in)g(the)i(OUNIT)f(CHDU.)h +(This)e(lo)m(w)i(lev)m(el)f(routine)227 1045 y(is)h(used)f(b)m(y)i +(FTCOPY,)f(but)g(it)f(ma)m(y)j(also)e(b)s(e)g(useful)e(in)i(certain)g +(application)f(programs)h(whic)m(h)f(w)m(an)m(t)i(to)227 +1158 y(cop)m(y)j(the)f(data)h(from)f(one)g(FITS)f(\014le)g(to)i +(another)f(but)g(also)g(w)m(an)m(t)h(to)g(mo)s(dify)d(the)i(header)g(k) +m(eyw)m(ords)g(in)227 1271 y(the)j(pro)s(cess.)44 b(all)31 +b(the)h(required)e(header)h(k)m(eyw)m(ords)h(m)m(ust)g(b)s(e)f(written) +g(to)h(the)g(OUNIT)f(CHDU)h(b)s(efore)227 1383 y(calling)d(this)g +(routine)382 1647 y Fe(FTCPDT\(iunit,ounit,)42 b(>)48 +b(status\))0 1985 y Fd(9.3)135 b(De\014ne)45 b(or)g(Rede\014ne)h(the)f +(structure)g(of)g(the)g(CHDU)0 2237 y Fi(It)32 b(should)e(rarely)h(b)s +(e)h(necessary)g(to)h(call)e(the)h(subroutines)e(in)g(this)h(section.) +46 b(FITSIO)30 b(in)m(ternally)g(calls)h(these)0 2350 +y(routines)i(whenev)m(er)h(necessary)-8 b(,)36 b(so)e(an)m(y)g(calls)f +(to)i(these)f(routines)f(b)m(y)h(application)e(programs)i(will)d(lik)m +(ely)i(b)s(e)0 2462 y(redundan)m(t.)0 2726 y Fh(1)81 +b Fi(This)35 b(routine)h(forces)i(FITSIO)e(to)i(scan)f(the)g(curren)m +(t)g(header)g(k)m(eyw)m(ords)h(that)f(de\014ne)g(the)g(structure)g(of) +227 2839 y(the)31 b(HDU)f(\(suc)m(h)g(as)h(the)f(NAXISn,)g(PCOUNT)f +(and)g(GCOUNT)h(k)m(eyw)m(ords\))h(so)f(that)h(it)e(can)i(initialize) +227 2952 y(the)36 b(in)m(ternal)e(bu\013ers)g(that)i(describ)s(e)e(the) +i(HDU)g(structure.)55 b(This)34 b(routine)h(ma)m(y)h(b)s(e)e(used)h +(instead)g(of)227 3065 y(the)k(more)g(complicated)g(calls)f(to)h(ftp)s +(def,)h(ftadef)f(or)g(ftb)s(def.)65 b(This)37 b(routine)h(is)g(also)h +(v)m(ery)g(useful)e(for)227 3178 y(reinitializing)30 +b(the)k(structure)g(of)g(an)f(HDU,)i(if)e(the)h(n)m(um)m(b)s(er)e(of)i +(ro)m(ws)g(in)f(a)h(table,)h(as)f(sp)s(eci\014ed)e(b)m(y)i(the)227 +3291 y(NAXIS2)d(k)m(eyw)m(ord,)g(has)f(b)s(een)g(mo)s(di\014ed)e(from)i +(its)g(initial)d(v)-5 b(alue.)382 3554 y Fe(FTRDEF\(unit,)44 +b(>)k(status\))141 b(\(DEPRECATED\))0 3818 y Fh(2)81 +b Fi(De\014ne)27 b(the)g(structure)g(of)g(the)g(primary)e(arra)m(y)j +(or)f(IMA)m(GE)h(extension.)39 b(When)27 b(writing)e(GR)m(OUP)m(ed)j +(FITS)227 3931 y(\014les)42 b(that)i(b)m(y)e(con)m(v)m(en)m(tion)j(set) +e(the)g(NAXIS1)g(k)m(eyw)m(ord)h(equal)e(to)i(0,)i(ftp)s(def)c(m)m(ust) +h(b)s(e)f(called)g(with)227 4044 y(naxes\(1\))27 b(=)e(1,)i(NOT)e(0,)i +(otherwise)e(FITSIO)f(will)f(rep)s(ort)i(an)g(error)g(status=308)i +(when)d(trying)h(to)h(write)227 4157 y(data)31 b(to)g(a)g(group.)40 +b(Note:)i(it)30 b(is)g(usually)e(simpler)g(to)j(call)f(FTRDEF)g(rather) +h(than)f(this)f(routine.)382 4421 y Fe(FTPDEF\(unit,bitpix,naxis)o(,na) +o(xes,)o(pcou)o(nt,)o(gcou)o(nt,)41 b(>)48 b(status\))93 +b(\(DEPRECATED\))0 4684 y Fh(3)81 b Fi(De\014ne)32 b(the)h(structure)f +(of)g(an)h(ASCI)s(I)e(table)h(\(T)-8 b(ABLE\))33 b(extension.)47 +b(Note:)f(it)32 b(is)f(usually)f(simpler)g(to)k(call)227 +4797 y(FTRDEF)d(rather)f(than)h(this)e(routine.)382 5061 +y Fe(FTADEF\(unit,rowlen,tfiel)o(ds,)o(tbco)o(l,tf)o(orm)o(,nro)o(ws)42 +b(>)47 b(status\))f(\(DEPRECATED\))0 5325 y Fh(4)81 b +Fi(De\014ne)35 b(the)h(structure)f(of)g(a)h(binary)e(table)h(\(BINT)-8 +b(ABLE\))37 b(extension.)55 b(Note:)e(it)35 b(is)f(usually)f(simpler)g +(to)227 5438 y(call)d(FTRDEF)h(rather)f(than)g(this)f(routine.)382 +5701 y Fe(FTBDEF\(unit,tfields,tfor)o(m,v)o(arid)o(at,n)o(row)o(s)42 +b(>)47 b(status\))f(\(DEPRECATED\))p eop +%%Page: 76 82 +76 81 bop 0 299 a Fi(76)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fh(5)81 b Fi(De\014ne)34 b(the)g(size)g(of)g(the)g(Curren)m(t)f +(Data)i(Unit,)g(o)m(v)m(erriding)d(the)i(length)g(of)g(the)g(data)h +(unit)d(as)i(previously)227 668 y(de\014ned)e(b)m(y)h(ftp)s(def,)g +(ftadef,)i(or)e(ftb)s(def.)48 b(This)32 b(is)g(useful)f(if)i(one)g(do)s +(es)g(not)h(kno)m(w)f(the)g(total)h(size)f(of)h(the)227 +781 y(data)f(unit)e(un)m(til)g(after)h(the)h(data)g(ha)m(v)m(e)g(b)s +(een)f(written.)45 b(The)32 b(size)g(\(in)f(b)m(ytes\))i(of)g(an)f +(ASCI)s(I)f(or)h(Binary)227 894 y(table)26 b(is)f(giv)m(en)g(b)m(y)h +(NAXIS1)g(*)g(NAXIS2.)40 b(\(Note)27 b(that)f(to)h(determine)e(the)g(v) +-5 b(alue)26 b(of)g(NAXIS1)f(it)h(is)f(often)227 1007 +y(more)32 b(con)m(v)m(enien)m(t)g(to)g(read)f(the)g(v)-5 +b(alue)31 b(of)g(the)h(NAXIS1)f(k)m(eyw)m(ord)h(from)e(the)i(output)e +(\014le,)h(rather)g(than)227 1120 y(computing)e(the)h(ro)m(w)g(length)g +(directly)e(from)h(all)g(the)h(TF)m(ORM)h(k)m(eyw)m(ord)f(v)-5 +b(alues\).)40 b(Note:)i(it)29 b(is)g(usually)227 1233 +y(simpler)f(to)j(call)f(FTRDEF)h(rather)f(than)g(this)f(routine.)382 +1454 y Fe(FTDDEF\(unit,bytlen,)42 b(>)48 b(status\))e(\(DEPRECATED\))0 +1676 y Fh(6)81 b Fi(De\014ne)22 b(the)g(zero)i(indexed)c(b)m(yte)j +(o\013set)g(of)g(the)f('heap')h(measured)e(from)h(the)h(start)g(of)f +(the)g(binary)f(table)h(data.)227 1789 y(By)30 b(default)f(the)g(heap)h +(is)e(assumed)h(to)h(start)g(immediately)e(follo)m(wing)g(the)i +(regular)e(table)i(data,)g(i.e.,)g(at)227 1902 y(lo)s(cation)36 +b(NAXIS1)h(x)g(NAXIS2.)59 b(This)35 b(routine)g(is)h(only)f(relev)-5 +b(an)m(t)37 b(for)f(binary)f(tables)h(whic)m(h)g(con)m(tain)227 +2015 y(v)-5 b(ariable)34 b(length)h(arra)m(y)g(columns)f(\(with)h(TF)m +(ORMn)g(=)f('Pt'\).)57 b(This)33 b(subroutine)g(also)i(automatically) +227 2128 y(writes)22 b(the)h(v)-5 b(alue)22 b(of)h(theap)g(to)h(a)f(k)m +(eyw)m(ord)g(in)f(the)h(extension)f(header.)38 b(This)21 +b(subroutine)g(m)m(ust)i(b)s(e)f(called)227 2241 y(after)27 +b(the)f(required)e(k)m(eyw)m(ords)j(ha)m(v)m(e)g(b)s(een)e(written)g +(\(with)g(ftph)m(bn\))g(and)h(after)g(the)h(table)f(structure)f(has)227 +2354 y(b)s(een)30 b(de\014ned)f(\(with)g(ftb)s(def)7 +b(\))30 b(but)g(b)s(efore)g(an)m(y)g(data)h(is)f(written)f(to)i(the)g +(table.)382 2575 y Fe(FTPTHP\(unit,theap,)43 b(>)k(status\))0 +2903 y Fd(9.4)135 b(FITS)44 b(Header)i(I/O)f(Subroutines)0 +3156 y Fb(9.4.1)112 b(Header)38 b(Space)h(and)f(P)m(osition)d(Routines) +0 3359 y Fh(1)81 b Fi(Reserv)m(e)37 b(space)g(in)e(the)i(CHU)f(for)h +(MOREKEYS)e(more)i(header)f(k)m(eyw)m(ords.)59 b(This)35 +b(subroutine)f(ma)m(y)k(b)s(e)227 3472 y(called)c(to)i(reserv)m(e)g +(space)f(for)g(k)m(eyw)m(ords)g(whic)m(h)f(are)h(to)h(b)s(e)e(written)g +(at)h(a)h(later)f(time,)h(after)f(the)g(data)227 3585 +y(unit)g(or)h(subsequen)m(t)f(extensions)g(ha)m(v)m(e)i(b)s(een)e +(written)g(to)i(the)f(FITS)f(\014le.)57 b(If)35 b(this)g(subroutine)f +(is)h(not)227 3698 y(explicitly)25 b(called,)i(then)g(the)g(initial)e +(size)h(of)i(the)f(FITS)f(header)h(will)e(b)s(e)h(limited)f(to)j(the)f +(space)h(a)m(v)-5 b(ailable)227 3811 y(at)24 b(the)g(time)f(that)h(the) +g(\014rst)f(data)h(is)f(written)f(to)i(the)g(asso)s(ciated)g(data)g +(unit.)37 b(FITSIO)22 b(has)i(the)f(abilit)m(y)f(to)227 +3924 y(dynamically)g(add)h(more)h(space)h(to)g(the)f(header)g(if)f +(needed,)i(ho)m(w)m(ev)m(er)g(it)f(is)f(more)h(e\016cien)m(t)g(to)h +(preallo)s(cate)227 4037 y(the)31 b(required)d(space)j(if)f(the)g(size) +g(is)g(kno)m(wn)g(in)f(adv)-5 b(ance.)382 4258 y Fe +(FTHDEF\(unit,morekeys,)42 b(>)47 b(status\))0 4480 y +Fh(2)81 b Fi(Return)23 b(the)i(n)m(um)m(b)s(er)e(of)h(existing)g(k)m +(eyw)m(ords)g(in)g(the)g(CHU)g(\(NOT)h(including)c(the)j(END)h(k)m(eyw) +m(ord)g(whic)m(h)e(is)227 4593 y(not)h(considered)e(a)h(real)g(k)m(eyw) +m(ord\))h(and)f(the)g(remaining)f(space)h(a)m(v)-5 b(ailable)23 +b(to)h(write)e(additional)g(k)m(eyw)m(ords)227 4706 y(in)38 +b(the)i(CHU.)f(\(returns)f(KEYSADD)i(=)f(-1)h(if)e(the)h(header)g(has)g +(not)h(y)m(et)g(b)s(een)e(closed\).)68 b(Note)40 b(that)227 +4819 y(FITSIO)23 b(will)f(attempt)j(to)g(dynamically)d(add)h(space)i +(for)f(more)g(k)m(eyw)m(ords)h(if)e(required)f(when)h(app)s(ending)227 +4932 y(new)30 b(k)m(eyw)m(ords)h(to)g(a)g(header.)382 +5153 y Fe(FTGHSP\(iunit,)44 b(>)j(keysexist,keysadd,status\))0 +5375 y Fh(3)81 b Fi(Return)38 b(the)i(n)m(um)m(b)s(er)e(of)h(k)m(eyw)m +(ords)h(in)e(the)h(header)g(and)g(the)g(curren)m(t)h(p)s(osition)d(in)h +(the)h(header.)68 b(This)227 5488 y(returns)37 b(the)g(n)m(um)m(b)s(er) +f(of)i(the)g(k)m(eyw)m(ord)g(record)f(that)h(will)d(b)s(e)i(read)g +(next)h(\(or)g(one)g(greater)g(than)g(the)227 5601 y(p)s(osition)27 +b(of)h(the)h(last)f(k)m(eyw)m(ord)h(that)g(w)m(as)f(read)g(or)h +(written\).)39 b(A)29 b(v)-5 b(alue)27 b(of)i(1)g(is)e(returned)g(if)g +(the)i(p)s(oin)m(ter)227 5714 y(is)h(p)s(ositioned)e(at)j(the)g(b)s +(eginning)c(of)k(the)g(header.)p eop +%%Page: 77 83 +77 82 bop 0 299 a Fg(9.4.)72 b(FITS)30 b(HEADER)h(I/O)f(SUBR)m(OUTINES) +2086 b Fi(77)382 555 y Fe(FTGHPS\(iunit,)44 b(>)j +(keysexist,key_no,status\))0 845 y Fb(9.4.2)112 b(Read)38 +b(or)f(W)-9 b(rite)36 b(Standard)j(Header)e(Routines)0 +1064 y Fi(These)31 b(subroutines)d(pro)m(vide)i(a)h(simple)e(metho)s(d) +h(of)h(reading)f(or)h(writing)e(most)i(of)g(the)g(k)m(eyw)m(ord)g(v)-5 +b(alues)30 b(that)0 1177 y(are)e(normally)e(required)g(in)h(a)h(FITS)f +(\014les.)39 b(These)27 b(subroutines)f(are)i(pro)m(vided)e(for)i(con)m +(v)m(enience)g(only)f(and)h(are)0 1290 y(not)36 b(required)d(to)j(b)s +(e)f(used.)55 b(If)35 b(preferred,)h(users)e(ma)m(y)i(call)f(the)h(lo)m +(w)m(er-lev)m(el)f(subroutines)e(describ)s(ed)h(in)g(the)0 +1402 y(previous)29 b(section)i(to)h(individually)26 b(read)k(or)h +(write)f(the)h(required)e(k)m(eyw)m(ords.)43 b(Note)32 +b(that)g(in)d(most)j(cases,)g(the)0 1515 y(required)25 +b(k)m(eyw)m(ords)i(suc)m(h)g(as)g(NAXIS,)f(TFIELD,)h(TTYPEn,)g(etc,)i +(whic)m(h)c(de\014ne)h(the)h(structure)f(of)h(the)g(HDU)0 +1628 y(m)m(ust)j(b)s(e)g(written)f(to)j(the)e(header)g(b)s(efore)g(an)m +(y)h(data)g(can)g(b)s(e)e(written)h(to)h(the)g(image)f(or)h(table.)0 +1881 y Fh(1)81 b Fi(Put)37 b(the)i(primary)d(header)i(or)g(IMA)m(GE)h +(extension)e(k)m(eyw)m(ords)i(in)m(to)f(the)g(CHU.)g(There)g(are)g(2)h +(a)m(v)-5 b(ailable)227 1994 y(routines:)38 b(The)27 +b(simpler)d(FTPHPS)j(routine)f(is)g(equiv)-5 b(alen)m(t)27 +b(to)g(calling)f(ftphpr)f(with)h(the)h(default)g(v)-5 +b(alues)227 2107 y(of)35 b(SIMPLE)f(=)g(true,)i(p)s(coun)m(t)e(=)g(0,)i +(gcoun)m(t)g(=)e(1,)i(and)e(EXTEND)h(=)f(true.)53 b(PCOUNT,)34 +b(GCOUNT)227 2220 y(and)23 b(EXTEND)h(k)m(eyw)m(ords)g(are)h(not)f +(required)e(in)g(the)i(primary)e(header)h(and)h(are)g(only)f(written)g +(if)f(p)s(coun)m(t)227 2333 y(is)30 b(not)h(equal)g(to)h(zero,)g(gcoun) +m(t)g(is)e(not)h(equal)f(to)i(zero)g(or)f(one,)g(and)g(if)f(extend)h +(is)f(TR)m(UE,)h(resp)s(ectiv)m(ely)-8 b(.)227 2446 y(When)30 +b(writing)f(to)i(an)f(IMA)m(GE)i(extension,)e(the)g(SIMPLE)g(and)g +(EXTEND)g(parameters)h(are)g(ignored.)382 2699 y Fe +(FTPHPS\(unit,bitpix,naxis)o(,na)o(xes,)41 b(>)48 b(status\))382 +2925 y(FTPHPR\(unit,simple,bitpi)o(x,n)o(axis)o(,nax)o(es,)o(pcou)o +(nt,g)o(cou)o(nt,e)o(xten)o(d,)41 b(>)48 b(status\))0 +3178 y Fh(2)81 b Fi(Get)44 b(primary)d(header)i(or)h(IMA)m(GE)g +(extension)f(k)m(eyw)m(ords)h(from)f(the)g(CHU.)h(When)f(reading)f +(from)h(an)227 3291 y(IMA)m(GE)32 b(extension)e(the)g(SIMPLE)g(and)f +(EXTEND)i(parameters)g(are)f(ignored.)382 3544 y Fe +(FTGHPR\(unit,maxdim,)42 b(>)48 b(simple,bitpix,naxis,naxe)o(s,p)o +(coun)o(t,gc)o(oun)o(t,ex)o(tend)o(,)716 3657 y(status\))0 +3911 y Fh(3)81 b Fi(Put)34 b(the)h(ASCI)s(I)f(table)h(header)g(k)m(eyw) +m(ords)g(in)m(to)g(the)g(CHU.)h(The)e(optional)g(TUNITn)g(and)h +(EXTNAME)227 4024 y(k)m(eyw)m(ords)c(are)g(written)e(only)h(if)f(the)i +(input)d(string)h(v)-5 b(alues)30 b(are)h(not)f(blank.)382 +4277 y Fe(FTPHTB\(unit,rowlen,nrows)o(,tf)o(ield)o(s,tt)o(ype)o(,tbc)o +(ol,t)o(for)o(m,tu)o(nit,)o(ext)o(name)o(,)42 b(>)716 +4390 y(status\))0 4643 y Fh(4)81 b Fi(Get)31 b(the)g(ASCI)s(I)d(table)j +(header)f(k)m(eyw)m(ords)h(from)e(the)i(CHU)382 4896 +y Fe(FTGHTB\(unit,maxdim,)42 b(>)48 b(rowlen,nrows,tfields,tty)o(pe,)o +(tbco)o(l,tf)o(orm)o(,tun)o(it,)716 5009 y(extname,status\))0 +5262 y Fh(5)81 b Fi(Put)34 b(the)h(binary)e(table)i(header)f(k)m(eyw)m +(ords)i(in)m(to)e(the)h(CHU.)g(The)g(optional)f(TUNITn)g(and)g(EXTNAME) +227 5375 y(k)m(eyw)m(ords)i(are)g(written)e(only)g(if)h(the)g(input)e +(string)i(v)-5 b(alues)34 b(are)i(not)f(blank.)54 b(The)35 +b(p)s(coun)m(t)g(parameter,)227 5488 y(whic)m(h)e(sp)s(eci\014es)g(the) +i(size)f(of)h(the)f(v)-5 b(ariable)33 b(length)h(arra)m(y)h(heap,)g +(should)e(initially)d(=)k(0;)j(FITSIO)d(will)227 5601 +y(automatically)24 b(up)s(date)f(the)h(PCOUNT)f(k)m(eyw)m(ord)h(v)-5 +b(alue)23 b(if)g(an)m(y)h(v)-5 b(ariable)23 b(length)g(arra)m(y)i(data) +f(is)f(written)227 5714 y(to)31 b(the)e(heap.)41 b(The)29 +b(TF)m(ORM)g(k)m(eyw)m(ord)h(v)-5 b(alue)29 b(for)h(v)-5 +b(ariable)28 b(length)h(v)m(ector)i(columns)d(should)g(ha)m(v)m(e)j +(the)p eop +%%Page: 78 84 +78 83 bop 0 299 a Fi(78)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)227 +555 y Fi(form)d('Pt\(len\)')i(or)e('1Pt\(len\)')i(where)e(`t')h(is)f +(the)h(data)g(t)m(yp)s(e)g(co)s(de)f(letter)h(\(A,I,J,E,D,)h(etc.\))42 +b(and)27 b(`len')g(is)227 668 y(an)h(in)m(teger)h(sp)s(ecifying)d(the)i +(maxim)m(um)f(length)g(of)i(the)f(v)m(ectors)h(in)e(that)i(column)e +(\(len)g(m)m(ust)h(b)s(e)g(greater)227 781 y(than)j(or)h(equal)e(to)j +(the)e(longest)h(v)m(ector)g(in)e(the)i(column\).)43 +b(If)30 b(`len')h(is)g(not)g(sp)s(eci\014ed)f(when)g(the)i(table)f(is) +227 894 y(created)c(\(e.g.,)i(the)d(input)e(TF)m(ORMn)i(v)-5 +b(alue)25 b(is)g(just)g('1Pt'\))j(then)d(FITSIO)g(will)e(scan)j(the)g +(column)f(when)227 1007 y(the)30 b(table)f(is)f(\014rst)h(closed)g(and) +g(will)d(app)s(end)i(the)h(maxim)m(um)g(length)f(to)i(the)g(TF)m(ORM)f +(k)m(eyw)m(ord)h(v)-5 b(alue.)227 1120 y(Note)28 b(that)e(if)f(the)h +(table)g(is)f(subsequen)m(tly)g(mo)s(di\014ed)f(to)j(increase)e(the)i +(maxim)m(um)e(length)g(of)h(the)g(v)m(ectors)227 1233 +y(then)k(the)h(mo)s(difying)d(program)i(is)f(resp)s(onsible)f(for)i +(also)g(up)s(dating)e(the)j(TF)m(ORM)g(k)m(eyw)m(ord)g(v)-5 +b(alue.)382 1462 y Fe(FTPHBN\(unit,nrows,tfield)o(s,t)o(type)o(,tfo)o +(rm,)o(tuni)o(t,ex)o(tna)o(me,v)o(arid)o(at,)41 b(>)48 +b(status\))0 1691 y Fh(6)81 b Fi(Get)31 b(the)g(binary)d(table)i +(header)h(k)m(eyw)m(ords)f(from)g(the)h(CHU)382 1921 +y Fe(FTGHBN\(unit,maxdim,)42 b(>)48 b(nrows,tfields,ttype,tfor)o(m,t)o +(unit)o(,ext)o(nam)o(e,va)o(rida)o(t,)716 2034 y(status\))0 +2320 y Fb(9.4.3)112 b(W)-9 b(rite)36 b(Keyw)m(ord)h(Subroutines)0 +2524 y Fh(1)81 b Fi(Put)30 b(\(app)s(end\))f(an)h(80-c)m(haracter)j +(record)e(in)m(to)f(the)h(CHU.)382 2753 y Fe(FTPREC\(unit,card,)43 +b(>)k(status\))0 2982 y Fh(2)81 b Fi(Put)36 b(\(app)s(end\))g(a)i +(COMMENT)f(k)m(eyw)m(ord)g(in)m(to)g(the)h(CHU.)f(Multiple)e(COMMENT)i +(k)m(eyw)m(ords)g(will)e(b)s(e)227 3095 y(written)30 +b(if)f(the)i(input)d(commen)m(t)j(string)f(is)f(longer)h(than)g(72)i(c) +m(haracters.)382 3325 y Fe(FTPCOM\(unit,comment,)42 b(>)48 +b(status\))0 3554 y Fh(3)81 b Fi(Put)24 b(\(app)s(end\))g(a)h(HISTOR)-8 +b(Y)25 b(k)m(eyw)m(ord)g(in)m(to)g(the)g(CHU.)g(Multiple)e(HISTOR)-8 +b(Y)24 b(k)m(eyw)m(ords)h(will)e(b)s(e)h(written)227 +3667 y(if)30 b(the)g(input)f(history)g(string)g(is)h(longer)g(than)g +(72)h(c)m(haracters.)382 3897 y Fe(FTPHIS\(unit,history,)42 +b(>)48 b(status\))0 4126 y Fh(4)81 b Fi(Put)36 b(\(app)s(end\))f(the)h +(D)m(A)-8 b(TE)38 b(k)m(eyw)m(ord)f(in)m(to)f(the)g(CHU.)h(The)f(k)m +(eyw)m(ord)g(v)-5 b(alue)36 b(will)e(con)m(tain)j(the)f(curren)m(t)227 +4239 y(system)c(date)g(as)g(a)f(c)m(haracter)i(string)e(in)f +('dd/mm/yy')h(format.)44 b(If)31 b(a)h(D)m(A)-8 b(TE)32 +b(k)m(eyw)m(ord)g(already)f(exists)227 4352 y(in)j(the)h(header,)i +(then)d(this)g(subroutine)f(will)g(simply)f(up)s(date)j(the)g(k)m(eyw)m +(ord)g(v)-5 b(alue)35 b(in-place)f(with)g(the)227 4465 +y(curren)m(t)c(date.)382 4694 y Fe(FTPDAT\(unit,)44 b(>)k(status\))0 +4924 y Fh(5)81 b Fi(Put)22 b(\(app)s(end\))f(a)i(new)f(k)m(eyw)m(ord)h +(of)g(the)f(appropriate)g(datat)m(yp)s(e)h(in)m(to)g(the)f(CHU.)h(Note) +h(that)f(FTPKYS)f(will)227 5036 y(only)32 b(write)g(string)f(v)-5 +b(alues)32 b(up)f(to)j(68)f(c)m(haracters)h(in)d(length;)i(longer)f +(strings)g(will)d(b)s(e)j(truncated.)47 b(The)227 5149 +y(FTPKLS)27 b(routine)g(can)i(b)s(e)f(used)f(to)i(write)e(longer)h +(strings,)g(using)e(a)j(non-standard)e(FITS)h(con)m(v)m(en)m(tion.)227 +5262 y(The)23 b(E)h(and)f(D)h(v)m(ersions)f(of)h(this)e(routine)h(ha)m +(v)m(e)i(the)f(added)f(feature)h(that)g(if)f(the)h('decimals')f +(parameter)h(is)227 5375 y(negativ)m(e,)h(then)20 b(the)i('G')g(displa) +m(y)d(format)i(rather)g(then)g(the)g('E')h(format)f(will)e(b)s(e)h +(used)g(when)g(constructing)227 5488 y(the)25 b(k)m(eyw)m(ord)f(v)-5 +b(alue,)25 b(taking)f(the)h(absolute)f(v)-5 b(alue)23 +b(of)i('decimals')e(for)h(the)g(precision.)37 b(This)22 +b(will)g(suppress)227 5601 y(trailing)32 b(zeros,)k(and)d(will)f(use)h +(a)i(\014xed)e(format)h(rather)g(than)f(an)h(exp)s(onen)m(tial)f +(format,)j(dep)s(ending)31 b(on)227 5714 y(the)g(magnitude)e(of)i(the)f +(v)-5 b(alue.)p eop +%%Page: 79 85 +79 84 bop 0 299 a Fg(9.4.)72 b(FITS)30 b(HEADER)h(I/O)f(SUBR)m(OUTINES) +2086 b Fi(79)382 555 y Fe(FTPKY[JLS]\(unit,keyword,)o(key)o(val,)o +(comm)o(ent)o(,)42 b(>)47 b(status\))382 668 y +(FTPKY[EDFG]\(unit,keyword)o(,ke)o(yval)o(,dec)o(ima)o(ls,c)o(omme)o +(nt,)41 b(>)48 b(status\))0 915 y Fh(6)81 b Fi(Put)33 +b(\(app)s(end\))h(a)g(string)f(v)-5 b(alued)33 b(k)m(eyw)m(ord)i(in)m +(to)f(the)h(CHU)f(whic)m(h)f(ma)m(y)h(b)s(e)g(longer)g(than)f(68)i(c)m +(haracters)227 1028 y(in)i(length.)63 b(This)36 b(uses)i(the)g(Long)g +(String)f(Keyw)m(ord)h(con)m(v)m(en)m(tion)h(that)f(is)f(describ)s(ed)f +(in)h(the)h("Usage)227 1141 y(Guidelines)30 b(and)h(Suggestions")i +(section)f(of)h(this)e(do)s(cumen)m(t.)46 b(Since)32 +b(this)f(uses)h(a)g(non-standard)g(FITS)227 1254 y(con)m(v)m(en)m(tion) +37 b(to)e(enco)s(de)h(the)f(long)g(k)m(eyw)m(ord)g(string,)h(programs)e +(whic)m(h)g(use)h(this)f(routine)g(should)f(also)227 +1367 y(call)d(the)g(FTPLSW)g(routine)g(to)h(add)e(some)i(COMMENT)f(k)m +(eyw)m(ords)h(to)g(w)m(arn)f(users)f(of)i(the)f(FITS)g(\014le)227 +1480 y(that)36 b(this)e(con)m(v)m(en)m(tion)j(is)d(b)s(eing)g(used.)55 +b(FTPLSW)35 b(also)g(writes)g(a)g(k)m(eyw)m(ord)h(called)f(LONGSTRN)f +(to)227 1593 y(record)c(the)h(v)m(ersion)e(of)i(the)f(longstring)f(con) +m(v)m(en)m(tion)i(that)g(has)f(b)s(een)g(used,)f(in)g(case)i(a)g(new)f +(con)m(v)m(en)m(tion)227 1705 y(is)e(adopted)h(at)g(some)g(p)s(oin)m(t) +e(in)h(the)g(future.)40 b(If)28 b(the)g(LONGSTRN)g(k)m(eyw)m(ord)h(is)f +(already)g(presen)m(t)g(in)g(the)227 1818 y(header,)j(then)f(FTPLSW)g +(will)d(simply)h(return)i(and)f(will)f(not)j(write)e(duplicate)g(k)m +(eyw)m(ords.)382 2065 y Fe(FTPKLS\(unit,keyword,keyv)o(al,)o(comm)o +(ent,)41 b(>)47 b(status\))382 2178 y(FTPLSW\(unit,)d(>)k(status\))0 +2425 y Fh(7)81 b Fi(Put)30 b(\(app)s(end\))g(a)h(new)f(k)m(eyw)m(ord)h +(with)e(an)i(unde\014ned,)e(or)h(n)m(ull,)f(v)-5 b(alue)30 +b(in)m(to)h(the)g(CHU.)g(The)f(v)-5 b(alue)30 b(string)227 +2538 y(of)h(the)f(k)m(eyw)m(ord)h(is)f(left)g(blank)f(in)g(this)g +(case.)382 2785 y Fe(FTPKYU\(unit,keyword,comm)o(ent)o(,)42 +b(>)47 b(status\))0 3032 y Fh(8)81 b Fi(Put)41 b(\(app)s(end\))g(a)i(n) +m(um)m(b)s(ered)d(sequence)j(of)f(k)m(eyw)m(ords)g(in)m(to)g(the)h +(CHU.)f(One)f(ma)m(y)i(app)s(end)d(the)j(same)227 3145 +y(commen)m(t)37 b(to)g(ev)m(ery)g(k)m(eyw)m(ord)g(\(and)f(eliminate)e +(the)j(need)f(to)h(ha)m(v)m(e)g(an)f(arra)m(y)h(of)f(iden)m(tical)f +(commen)m(t)227 3258 y(strings,)i(one)f(for)g(eac)m(h)h(k)m(eyw)m +(ord\))g(b)m(y)f(including)d(the)j(amp)s(ersand)e(c)m(haracter)k(as)e +(the)h(last)f(non-blank)227 3371 y(c)m(haracter)h(in)d(the)i +(\(\014rst\))f(COMMENTS)f(string)g(parameter.)56 b(This)34 +b(same)h(string)g(will)d(then)j(b)s(e)g(used)227 3484 +y(for)30 b(the)g(commen)m(t)h(\014eld)e(in)f(all)h(the)h(k)m(eyw)m +(ords.)41 b(\(Note)32 b(that)e(the)g(SPP)f(v)m(ersion)h(of)g(these)g +(routines)f(only)227 3597 y(supp)s(orts)g(a)i(single)e(commen)m(t)i +(string\).)382 3844 y Fe(FTPKN[JLS]\(unit,keyroot,)o(sta)o(rtno)o(,no_) +o(key)o(s,ke)o(yval)o(s,c)o(omme)o(nts,)41 b(>)47 b(status\))382 +3957 y(FTPKN[EDFG]\(unit,keyroot)o(,st)o(artn)o(o,no)o(_ke)o(ys,k)o +(eyva)o(ls,)o(deci)o(mals)o(,co)o(mmen)o(ts,)41 b(>)907 +4070 y(status\))0 4317 y Fh(9)81 b Fi(Cop)m(y)21 b(an)h(indexed)e(k)m +(eyw)m(ord)j(from)e(one)h(HDU)h(to)f(another,)i(mo)s(difying)c(the)i +(index)e(n)m(um)m(b)s(er)g(of)i(the)g(k)m(eyw)m(ord)227 +4430 y(name)37 b(in)e(the)h(pro)s(cess.)58 b(F)-8 b(or)37 +b(example,)h(this)d(routine)h(could)f(read)h(the)h(TLMIN3)f(k)m(eyw)m +(ord)h(from)f(the)227 4542 y(input)27 b(HDU)i(\(b)m(y)f(giving)f(k)m +(eyro)s(ot)j(=)d("TLMIN")i(and)f(inn)m(um)e(=)i(3\))h(and)f(write)f(it) +h(to)h(the)f(output)g(HDU)227 4655 y(with)35 b(the)h(k)m(eyw)m(ord)h +(name)f(TLMIN4)g(\(b)m(y)g(setting)h(outn)m(um)e(=)h(4\).)58 +b(If)36 b(the)g(input)e(k)m(eyw)m(ord)j(do)s(es)f(not)227 +4768 y(exist,)31 b(then)f(this)f(routine)g(simply)f(returns)h(without)h +(indicating)e(an)i(error.)382 5015 y Fe(FTCPKYinunit,)44 +b(outunit,)i(innum,)g(outnum,)f(keyroot,)h(>)h(status\))0 +5262 y Fh(10)f Fi(Put)33 b(\(app)s(end\))f(a)h('triple)f(precision')g +(k)m(eyw)m(ord)h(in)m(to)g(the)h(CHU)f(in)f(F28.16)j(format.)49 +b(The)33 b(\015oating)g(p)s(oin)m(t)227 5375 y(k)m(eyw)m(ord)d(v)-5 +b(alue)29 b(is)f(constructed)i(b)m(y)f(concatenating)i(the)e(input)f +(in)m(teger)i(v)-5 b(alue)28 b(with)g(the)i(input)d(double)227 +5488 y(precision)20 b(fraction)i(v)-5 b(alue)22 b(\(whic)m(h)f(m)m(ust) +h(ha)m(v)m(e)h(a)f(v)-5 b(alue)22 b(b)s(et)m(w)m(een)h(0.0)g(and)e +(1.0\).)40 b(The)21 b(FTGKYT)h(routine)227 5601 y(should)34 +b(b)s(e)i(used)f(to)i(read)f(this)e(k)m(eyw)m(ord)j(v)-5 +b(alue,)37 b(b)s(ecause)f(the)g(other)h(k)m(eyw)m(ord)f(reading)f +(subroutines)227 5714 y(will)28 b(not)j(preserv)m(e)f(the)h(full)d +(precision)g(of)j(the)f(v)-5 b(alue.)p eop +%%Page: 80 86 +80 85 bop 0 299 a Fi(80)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)382 +555 y Fe(FTPKYT\(unit,keyword,intv)o(al,)o(dblv)o(al,c)o(omm)o(ent,)41 +b(>)48 b(status\))0 850 y Fh(11)e Fi(W)-8 b(rite)35 b(k)m(eyw)m(ords)h +(to)f(the)h(CHDU)f(that)h(are)f(de\014ned)f(in)f(an)i(ASCI)s(I)f +(template)h(\014le.)54 b(The)34 b(format)i(of)f(the)227 +963 y(template)c(\014le)f(is)f(describ)s(ed)f(under)h(the)i(ftgthd)f +(routine)f(b)s(elo)m(w.)382 1258 y Fe(FTPKTP\(unit,)44 +b(filename,)i(>)h(status\))0 1552 y Fh(12)f Fi(App)s(end)28 +b(the)i(ph)m(ysical)e(units)h(string)g(to)h(an)g(existing)f(k)m(eyw)m +(ord.)41 b(This)28 b(routine)h(uses)g(a)h(lo)s(cal)g(con)m(v)m(en)m +(tion,)227 1665 y(sho)m(wn)i(in)f(the)i(follo)m(wing)e(example,)i(in)e +(whic)m(h)g(the)i(k)m(eyw)m(ord)g(units)e(are)i(enclosed)f(in)f(square) +h(brac)m(k)m(ets)227 1778 y(in)d(the)i(b)s(eginning)d(of)i(the)h(k)m +(eyw)m(ord)g(commen)m(t)g(\014eld.)239 2073 y Fe(VELOCITY=)809 +b(12.3)46 b(/)i([km/s])e(orbital)g(speed)382 2299 y +(FTPUNT\(unit,keyword,unit)o(s,)41 b(>)48 b(status\))0 +2630 y Fb(9.4.4)112 b(Insert)38 b(Keyw)m(ord)f(Subroutines)0 +2865 y Fh(1)81 b Fi(Insert)26 b(a)h(new)f(k)m(eyw)m(ord)h(record)g(in)m +(to)f(the)h(CHU)g(at)g(the)g(sp)s(eci\014ed)e(p)s(osition)g(\(i.e.,)j +(immediately)d(preceding)227 2978 y(the)34 b(\(k)m(eyno\)th)g(k)m(eyw)m +(ord)g(in)e(the)i(header.\))49 b(This)32 b('insert)g(record')i +(subroutine)d(is)h(somewhat)i(less)f(e\016-)227 3091 +y(cien)m(t)27 b(then)g(the)g('app)s(end)e(record')i(subroutine)e +(\(FTPREC\))h(describ)s(ed)f(ab)s(o)m(v)m(e)j(b)s(ecause)f(the)g +(remaining)227 3204 y(k)m(eyw)m(ords)k(in)e(the)i(header)f(ha)m(v)m(e)h +(to)g(b)s(e)f(shifted)f(do)m(wn)h(one)h(slot.)382 3499 +y Fe(FTIREC\(unit,key_no,card,)41 b(>)47 b(status\))0 +3793 y Fh(2)81 b Fi(Insert)36 b(a)h(new)f(k)m(eyw)m(ord)i(in)m(to)f +(the)g(CHU.)g(The)f(new)g(k)m(eyw)m(ord)i(is)e(inserted)f(immediately)g +(follo)m(wing)h(the)227 3906 y(last)26 b(k)m(eyw)m(ord)h(that)f(has)g +(b)s(een)g(read)g(from)f(the)h(header.)40 b(The)25 b(FTIKLS)g +(subroutine)f(w)m(orks)i(the)g(same)h(as)227 4019 y(the)h(FTIKYS)e +(subroutine,)g(except)j(it)e(also)g(supp)s(orts)f(long)h(string)f(v)-5 +b(alues)27 b(greater)h(than)f(68)h(c)m(haracters)227 +4132 y(in)35 b(length.)58 b(These)36 b('insert)f(k)m(eyw)m(ord')i +(subroutines)d(are)j(somewhat)g(less)e(e\016cien)m(t)i(then)f(the)g +('app)s(end)227 4245 y(k)m(eyw)m(ord')30 b(subroutines)d(describ)s(ed)g +(ab)s(o)m(v)m(e)j(b)s(ecause)f(the)g(remaining)f(k)m(eyw)m(ords)h(in)f +(the)h(header)g(ha)m(v)m(e)h(to)227 4358 y(b)s(e)g(shifted)f(do)m(wn)h +(one)h(slot.)382 4653 y Fe(FTIKEY\(unit,)44 b(card,)j(>)g(status\))382 +4766 y(FTIKY[JLS]\(unit,keyword,)o(key)o(val,)o(comm)o(ent)o(,)42 +b(>)47 b(status\))382 4878 y(FTIKLS\(unit,keyword,keyv)o(al,)o(comm)o +(ent,)41 b(>)47 b(status\))382 4991 y(FTIKY[EDFG]\(unit,keyword)o(,ke)o +(yval)o(,dec)o(ima)o(ls,c)o(omme)o(nt,)41 b(>)48 b(status\))0 +5286 y Fh(3)81 b Fi(Insert)32 b(a)i(new)f(k)m(eyw)m(ord)h(with)e(an)h +(unde\014ned,)g(or)g(n)m(ull,)f(v)-5 b(alue)33 b(in)m(to)h(the)f(CHU.)h +(The)f(v)-5 b(alue)33 b(string)f(of)i(the)227 5399 y(k)m(eyw)m(ord)d +(is)f(left)g(blank)f(in)g(this)g(case.)382 5694 y Fe +(FTIKYU\(unit,keyword,comm)o(ent)o(,)42 b(>)47 b(status\))p +eop +%%Page: 81 87 +81 86 bop 0 299 a Fg(9.4.)72 b(FITS)30 b(HEADER)h(I/O)f(SUBR)m(OUTINES) +2086 b Fi(81)0 555 y Fb(9.4.5)112 b(Read)38 b(Keyw)m(ord)g(Subroutines) +0 774 y Fi(These)29 b(routines)e(return)h(the)h(v)-5 +b(alue)28 b(of)h(the)g(sp)s(eci\014ed)e(k)m(eyw)m(ord\(s\).)41 +b(Wild)28 b(card)g(c)m(haracters)i(\(*,)h(?,)e(or)g(#\))f(ma)m(y)0 +887 y(b)s(e)f(used)h(when)f(sp)s(ecifying)f(the)i(name)g(of)g(the)g(k)m +(eyw)m(ord)h(to)g(b)s(e)e(read:)39 b(a)29 b(')10 b(?')40 +b(will)25 b(matc)m(h)k(an)m(y)g(single)d(c)m(haracter)0 +1000 y(at)38 b(that)g(p)s(osition)d(in)h(the)i(k)m(eyw)m(ord)g(name)f +(and)g(a)g('*')i(will)34 b(matc)m(h)k(an)m(y)g(length)f(\(including)d +(zero\))k(string)f(of)0 1113 y(c)m(haracters.)65 b(The)37 +b('#')h(c)m(haracter)h(will)c(matc)m(h)k(an)m(y)f(consecutiv)m(e)h +(string)e(of)h(decimal)f(digits)f(\(0)j(-)f(9\).)64 b(Note)0 +1226 y(that)30 b(when)f(a)g(wild)e(card)j(is)e(used)h(in)f(the)i(input) +d(k)m(eyw)m(ord)j(name,)g(the)g(routine)e(will)f(only)i(searc)m(h)h +(for)f(a)h(matc)m(h)0 1339 y(from)h(the)h(curren)m(t)g(header)g(p)s +(osition)e(to)i(the)h(end)e(of)h(the)g(header.)45 b(It)32 +b(will)d(not)j(resume)g(the)g(searc)m(h)g(from)g(the)0 +1452 y(top)i(of)h(the)f(header)g(bac)m(k)h(to)g(the)f(original)e +(header)i(p)s(osition)e(as)j(is)e(done)h(when)f(no)h(wildcards)d(are)k +(included)0 1564 y(in)e(the)h(k)m(eyw)m(ord)h(name.)52 +b(If)33 b(the)h(desired)f(k)m(eyw)m(ord)i(string)e(is)g(8-c)m +(haracters)j(long)e(\(the)g(maxim)m(um)f(length)h(of)0 +1677 y(a)i(k)m(eyw)m(ord)g(name\))g(then)g(a)g('*')g(ma)m(y)h(b)s(e)e +(app)s(ended)f(as)h(the)h(nin)m(th)f(c)m(haracter)i(of)f(the)f(input)f +(name)i(to)g(force)0 1790 y(the)31 b(k)m(eyw)m(ord)g(searc)m(h)h(to)f +(stop)g(at)g(the)g(end)f(of)h(the)g(header)g(\(e.g.,)i('COMMENT)d(*')i +(will)c(searc)m(h)j(for)g(the)g(next)0 1903 y(COMMENT)37 +b(k)m(eyw)m(ord\).)64 b(The)37 b(\013grec)i(routine)e(ma)m(y)h(b)s(e)f +(used)g(to)i(set)f(the)g(starting)f(p)s(osition)f(when)h(doing)0 +2016 y(wild)28 b(card)i(searc)m(hes.)0 2264 y Fh(1)81 +b Fi(Get)37 b(the)f(n)m(th)f(80-c)m(haracter)k(header)d(record)g(from)f +(the)h(CHU.)h(The)e(\014rst)g(k)m(eyw)m(ord)i(in)d(the)i(header)g(is)f +(at)227 2377 y(k)m(ey)p 365 2377 28 4 v 34 w(no)42 b(=)f(1;)49 +b(if)41 b(k)m(ey)p 996 2377 V 34 w(no)h(=)f(0)i(then)e(this)g +(subroutine)f(simple)g(mo)m(v)m(es)k(the)e(in)m(ternal)f(p)s(oin)m(ter) +g(to)i(the)227 2490 y(b)s(eginning)33 b(of)j(the)g(header)f(so)h(that)g +(subsequen)m(t)f(k)m(eyw)m(ord)h(op)s(erations)f(will)e(start)j(at)g +(the)g(top)g(of)g(the)227 2603 y(header;)31 b(it)f(also)g(returns)f(a)i +(blank)e(card)h(v)-5 b(alue)30 b(in)f(this)g(case.)382 +2850 y Fe(FTGREC\(unit,key_no,)42 b(>)48 b(card,status\))0 +3098 y Fh(2)81 b Fi(Get)31 b(the)g(name,)f(v)-5 b(alue)30 +b(\(as)h(a)g(string\),)f(and)g(commen)m(t)i(of)e(the)h(n)m(th)f(k)m +(eyw)m(ord)h(in)e(CHU.)i(This)e(routine)g(also)227 3211 +y(c)m(hec)m(ks)i(that)f(the)g(returned)e(k)m(eyw)m(ord)i(name)f(\(KEYW) +m(ORD\))i(con)m(tains)f(only)e(legal)h(ASCI)s(I)f(c)m(haracters.)227 +3324 y(Call)h(FTGREC)h(and)g(FTPSV)m(C)g(to)h(b)m(ypass)f(this)f(error) +h(c)m(hec)m(k.)382 3572 y Fe(FTGKYN\(unit,key_no,)42 +b(>)48 b(keyword,value,comment,st)o(atu)o(s\))0 3819 +y Fh(3)81 b Fi(Get)31 b(the)g(80-c)m(haracter)i(header)d(record)g(for)g +(the)h(named)f(k)m(eyw)m(ord)382 4067 y Fe(FTGCRD\(unit,keyword,)42 +b(>)48 b(card,status\))0 4315 y Fh(4)81 b Fi(Get)26 b(the)f(next)h(k)m +(eyw)m(ord)f(whose)g(name)h(matc)m(hes)g(one)f(of)h(the)f(strings)f(in) +g('inclist')g(but)g(do)s(es)h(not)g(matc)m(h)i(an)m(y)227 +4428 y(of)32 b(the)f(strings)f(in)g('exclist'.)43 b(The)30 +b(strings)g(in)g(inclist)f(and)i(exclist)f(ma)m(y)i(con)m(tain)g(wild)c +(card)j(c)m(haracters)227 4541 y(\(*,)38 b(?,)e(and)e(#\))i(as)f +(describ)s(ed)e(at)j(the)f(b)s(eginning)d(of)k(this)e(section.)55 +b(This)33 b(routine)h(searc)m(hes)i(from)f(the)227 4654 +y(curren)m(t)28 b(header)f(p)s(osition)f(to)i(the)g(end)f(of)h(the)g +(header,)g(only)-8 b(,)28 b(and)f(do)s(es)g(not)h(con)m(tin)m(ue)g(the) +g(searc)m(h)g(from)227 4767 y(the)41 b(top)g(of)g(the)g(header)g(bac)m +(k)h(to)f(the)g(original)e(p)s(osition.)71 b(The)40 b(curren)m(t)h +(header)f(p)s(osition)f(ma)m(y)j(b)s(e)227 4880 y(reset)33 +b(with)d(the)i(ftgrec)h(routine.)43 b(Note)33 b(that)g(nexc)f(ma)m(y)g +(b)s(e)f(set)h(=)g(0)g(if)e(there)i(are)g(no)g(k)m(eyw)m(ords)g(to)h(b) +s(e)227 4993 y(excluded.)40 b(This)28 b(routine)i(returns)f(status)i(=) +f(202)h(if)f(a)g(matc)m(hing)h(k)m(eyw)m(ord)g(is)e(not)i(found.)382 +5240 y Fe(FTGNXK\(unit,inclist,ninc)o(,ex)o(clis)o(t,ne)o(xc,)41 +b(>)48 b(card,status\))0 5488 y Fh(5)81 b Fi(Get)30 b(the)g(literal)f +(k)m(eyw)m(ord)h(v)-5 b(alue)29 b(as)h(a)g(c)m(haracter)i(string.)39 +b(Regardless)30 b(of)g(the)g(datat)m(yp)s(e)g(of)g(the)g(k)m(eyw)m +(ord,)227 5601 y(this)36 b(routine)g(simply)f(returns)h(the)h(string)f +(of)h(c)m(haracters)i(in)c(the)j(v)-5 b(alue)36 b(\014eld)g(of)h(the)g +(k)m(eyw)m(ord)h(along)227 5714 y(with)29 b(the)i(commen)m(t)g +(\014eld.)p eop +%%Page: 82 88 +82 87 bop 0 299 a Fi(82)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)382 +555 y Fe(FTGKEY\(unit,keyword,)42 b(>)48 b(value,comment,status\))0 +817 y Fh(6)81 b Fi(Get)31 b(a)g(k)m(eyw)m(ord)g(v)-5 +b(alue)29 b(\(with)h(the)g(appropriate)g(datat)m(yp)s(e\))h(and)f +(commen)m(t)i(from)e(the)g(CHU)382 1079 y Fe(FTGKY[EDJLS]\(unit,keywor) +o(d,)41 b(>)48 b(keyval,comment,status\))0 1341 y Fh(7)81 +b Fi(Get)24 b(a)g(sequence)g(of)g(n)m(um)m(b)s(ered)e(k)m(eyw)m(ord)i +(v)-5 b(alues.)37 b(These)24 b(routines)e(do)h(not)h(supp)s(ort)e(wild) +f(card)i(c)m(haracters)227 1454 y(in)29 b(the)i(ro)s(ot)g(name.)382 +1716 y Fe(FTGKN[EDJLS]\(unit,keyroo)o(t,s)o(tart)o(no,m)o(ax_)o(keys)o +(,)42 b(>)47 b(keyvals,nfound,status\))0 1977 y Fh(8)81 +b Fi(Get)27 b(the)f(v)-5 b(alue)25 b(of)i(a)f(\015oating)g(p)s(oin)m(t) +f(k)m(eyw)m(ord,)j(returning)c(the)i(in)m(teger)g(and)g(fractional)f +(parts)h(of)g(the)g(v)-5 b(alue)227 2090 y(in)31 b(separate)h +(subroutine)e(argumen)m(ts.)45 b(This)30 b(subroutine)f(ma)m(y)k(b)s(e) +e(used)g(to)h(read)g(an)m(y)g(k)m(eyw)m(ord)g(but)f(is)227 +2203 y(esp)s(ecially)e(useful)f(for)j(reading)e(the)i('triple)e +(precision')f(k)m(eyw)m(ords)j(written)f(b)m(y)g(FTPKYT.)382 +2465 y Fe(FTGKYT\(unit,keyword,)42 b(>)48 b(intval,dblval,comment,s)o +(tat)o(us\))0 2727 y Fh(9)81 b Fi(Get)24 b(the)g(ph)m(ysical)f(units)f +(string)g(in)h(an)g(existing)g(k)m(eyw)m(ord.)39 b(This)22 +b(routine)h(uses)g(a)h(lo)s(cal)f(con)m(v)m(en)m(tion,)k(sho)m(wn)227 +2840 y(in)32 b(the)i(follo)m(wing)d(example,)j(in)e(whic)m(h)g(the)h(k) +m(eyw)m(ord)h(units)e(are)h(enclosed)g(in)f(square)h(brac)m(k)m(ets)i +(in)d(the)227 2953 y(b)s(eginning)g(of)j(the)g(k)m(eyw)m(ord)g(commen)m +(t)h(\014eld.)52 b(A)35 b(blank)f(string)f(is)h(returned)g(if)f(no)i +(units)e(are)i(de\014ned)227 3066 y(for)30 b(the)h(k)m(eyw)m(ord.)191 +3328 y Fe(VELOCITY=)809 b(12.3)46 b(/)i([km/s])e(orbital)g(speed)382 +3553 y(FTGUNT\(unit,keyword,)c(>)48 b(units,status\))0 +3846 y Fb(9.4.6)112 b(Mo)s(dify)38 b(Keyw)m(ord)f(Subroutines)0 +4066 y Fi(Wild)30 b(card)h(c)m(haracters,)j(as)e(describ)s(ed)d(in)h +(the)i(Read)g(Keyw)m(ord)f(section,)h(ab)s(o)m(v)m(e,)h(ma)m(y)g(b)s(e) +d(used)h(when)g(sp)s(eci-)0 4179 y(fying)e(the)i(name)f(of)h(the)f(k)m +(eyw)m(ord)h(to)g(b)s(e)f(mo)s(di\014ed.)0 4441 y Fh(1)81 +b Fi(Mo)s(dify)29 b(\(o)m(v)m(erwrite\))i(the)g(n)m(th)f(80-c)m +(haracter)j(header)d(record)h(in)e(the)h(CHU)382 4702 +y Fe(FTMREC\(unit,key_no,card,)41 b(>)47 b(status\))0 +4964 y Fh(2)81 b Fi(Mo)s(dify)36 b(\(o)m(v)m(erwrite\))j(the)f(80-c)m +(haracter)j(header)c(record)h(for)f(the)h(named)f(k)m(eyw)m(ord)h(in)f +(the)h(CHU.)g(This)227 5077 y(can)31 b(b)s(e)f(used)f(to)i(o)m(v)m +(erwrite)g(the)g(name)f(of)h(the)f(k)m(eyw)m(ord)h(as)g(w)m(ell)e(as)i +(its)f(v)-5 b(alue)29 b(and)h(commen)m(t)i(\014elds.)382 +5339 y Fe(FTMCRD\(unit,keyword,card)o(,)42 b(>)47 b(status\))0 +5601 y Fh(3)81 b Fi(Mo)s(dify)32 b(\(o)m(v)m(erwrite\))k(the)e(name)g +(of)h(an)f(existing)f(k)m(eyw)m(ord)h(in)f(the)i(CHU)f(preserving)e +(the)j(curren)m(t)e(v)-5 b(alue)227 5714 y(and)30 b(commen)m(t)h +(\014elds.)p eop +%%Page: 83 89 +83 88 bop 0 299 a Fg(9.4.)72 b(FITS)30 b(HEADER)h(I/O)f(SUBR)m(OUTINES) +2086 b Fi(83)382 555 y Fe(FTMNAM\(unit,oldkey,keywo)o(rd,)41 +b(>)48 b(status\))0 823 y Fh(4)81 b Fi(Mo)s(dify)29 b(\(o)m(v)m +(erwrite\))i(the)g(commen)m(t)g(\014eld)e(of)i(an)f(existing)f(k)m(eyw) +m(ord)i(in)e(the)i(CHU)382 1091 y Fe(FTMCOM\(unit,keyword,comm)o(ent)o +(,)42 b(>)47 b(status\))0 1358 y Fh(5)81 b Fi(Mo)s(dify)23 +b(the)i(v)-5 b(alue)24 b(and)g(commen)m(t)i(\014elds)d(of)i(an)f +(existing)g(k)m(eyw)m(ord)h(in)e(the)i(CHU.)g(The)f(FTMKLS)g(subrou-) +227 1471 y(tine)34 b(w)m(orks)f(the)h(same)h(as)f(the)g(FTMKYS)f +(subroutine,)g(except)i(it)f(also)f(supp)s(orts)f(long)i(string)f(v)-5 +b(alues)227 1584 y(greater)38 b(than)f(68)h(c)m(haracters)g(in)e +(length.)59 b(Optionally)-8 b(,)37 b(one)g(ma)m(y)h(mo)s(dify)d(only)h +(the)h(v)-5 b(alue)36 b(\014eld)g(and)227 1697 y(lea)m(v)m(e)31 +b(the)e(commen)m(t)i(\014eld)d(unc)m(hanged)h(b)m(y)g(setting)g(the)h +(input)d(COMMENT)i(parameter)h(equal)f(to)h(the)227 1810 +y(amp)s(ersand)f(c)m(haracter)k(\(&\).)42 b(The)30 b(E)g(and)g(D)h(v)m +(ersions)f(of)h(this)f(routine)f(ha)m(v)m(e)j(the)f(added)f(feature)h +(that)227 1923 y(if)25 b(the)i('decimals')e(parameter)i(is)e(negativ)m +(e,)k(then)d(the)g('G')h(displa)m(y)d(format)j(rather)f(then)g(the)g +('E')h(format)227 2036 y(will)f(b)s(e)i(used)f(when)h(constructing)g +(the)g(k)m(eyw)m(ord)h(v)-5 b(alue,)29 b(taking)f(the)h(absolute)f(v)-5 +b(alue)28 b(of)g('decimals')g(for)227 2149 y(the)37 b(precision.)58 +b(This)34 b(will)g(suppress)h(trailing)f(zeros,)39 b(and)d(will)e(use)j +(a)g(\014xed)e(format)i(rather)g(than)f(an)227 2262 y(exp)s(onen)m +(tial)30 b(format,)h(dep)s(ending)c(on)k(the)f(magnitude)g(of)g(the)h +(v)-5 b(alue.)382 2530 y Fe(FTMKY[JLS]\(unit,keyword,)o(key)o(val,)o +(comm)o(ent)o(,)42 b(>)47 b(status\))382 2642 y +(FTMKLS\(unit,keyword,keyv)o(al,)o(comm)o(ent,)41 b(>)47 +b(status\))382 2755 y(FTMKY[EDFG]\(unit,keyword)o(,ke)o(yval)o(,dec)o +(ima)o(ls,c)o(omme)o(nt,)41 b(>)48 b(status\))0 3023 +y Fh(6)81 b Fi(Mo)s(dify)21 b(the)h(v)-5 b(alue)22 b(of)g(an)g +(existing)g(k)m(eyw)m(ord)g(to)h(b)s(e)f(unde\014ned,)g(or)g(n)m(ull.) +36 b(The)22 b(v)-5 b(alue)21 b(string)h(of)g(the)g(k)m(eyw)m(ord)227 +3136 y(is)29 b(set)i(to)g(blank.)39 b(Optionally)-8 b(,)28 +b(one)i(ma)m(y)h(lea)m(v)m(e)g(the)g(commen)m(t)g(\014eld)d(unc)m +(hanged)i(b)m(y)g(setting)g(the)g(input)227 3249 y(COMMENT)g(parameter) +h(equal)f(to)h(the)g(amp)s(ersand)e(c)m(haracter)j(\(&\).)382 +3517 y Fe(FTMKYU\(unit,keyword,comm)o(ent)o(,)42 b(>)47 +b(status\))0 3817 y Fb(9.4.7)112 b(Up)s(date)39 b(Keyw)m(ord)e +(Subroutines)0 4032 y Fh(1)81 b Fi(Up)s(date)36 b(an)g(80-c)m(haracter) +j(record)d(in)f(the)i(CHU.)f(If)g(the)g(sp)s(eci\014ed)f(k)m(eyw)m(ord) +i(already)e(exists)h(then)g(that)227 4144 y(header)j(record)f(will)e(b) +s(e)i(replaced)h(with)e(the)i(input)e(CARD)h(string.)65 +b(If)38 b(it)h(do)s(es)f(not)h(exist)f(then)h(the)227 +4257 y(new)f(record)g(will)d(b)s(e)i(added)h(to)g(the)g(header.)64 +b(The)37 b(FTUKLS)g(subroutine)f(w)m(orks)i(the)g(same)h(as)f(the)227 +4370 y(FTUKYS)28 b(subroutine,)f(except)j(it)e(also)h(supp)s(orts)d +(long)i(string)g(v)-5 b(alues)28 b(greater)i(than)e(68)h(c)m(haracters) +h(in)227 4483 y(length.)382 4751 y Fe(FTUCRD\(unit,keyword,card)o(,)42 +b(>)47 b(status\))0 5019 y Fh(2)81 b Fi(Up)s(date)44 +b(the)i(v)-5 b(alue)44 b(and)h(commen)m(t)h(\014elds)d(of)i(a)h(k)m +(eyw)m(ord)f(in)f(the)h(CHU.)h(The)e(sp)s(eci\014ed)f(k)m(eyw)m(ord)j +(is)227 5132 y(mo)s(di\014ed)37 b(if)g(it)h(already)g(exists)g(\(b)m(y) +h(calling)e(FTMKYx\))i(otherwise)e(a)i(new)f(k)m(eyw)m(ord)h(is)f +(created)h(b)m(y)227 5245 y(calling)c(FTPKYx.)58 b(The)36 +b(E)g(and)f(D)i(v)m(ersions)e(of)i(this)e(routine)g(ha)m(v)m(e)i(the)g +(added)e(feature)i(that)g(if)e(the)227 5357 y('decimals')30 +b(parameter)i(is)e(negativ)m(e,)i(then)e(the)h('G')h(displa)m(y)d +(format)i(rather)g(then)f(the)h('E')g(format)h(will)227 +5470 y(b)s(e)41 b(used)f(when)h(constructing)g(the)g(k)m(eyw)m(ord)h(v) +-5 b(alue,)44 b(taking)d(the)g(absolute)g(v)-5 b(alue)41 +b(of)h('decimals')e(for)227 5583 y(the)d(precision.)58 +b(This)34 b(will)g(suppress)h(trailing)f(zeros,)39 b(and)d(will)e(use)j +(a)g(\014xed)e(format)i(rather)g(than)f(an)227 5696 y(exp)s(onen)m +(tial)30 b(format,)h(dep)s(ending)c(on)k(the)f(magnitude)g(of)g(the)h +(v)-5 b(alue.)p eop +%%Page: 84 90 +84 89 bop 0 299 a Fi(84)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)382 +555 y Fe(FTUKY[JLS]\(unit,keyword,)o(key)o(val,)o(comm)o(ent)o(,)42 +b(>)47 b(status\))382 668 y(FTUKLS\(unit,keyword,keyv)o(al,)o(comm)o +(ent,)41 b(>)47 b(status\))382 781 y(FTUKY[EDFG]\(unit,keyword)o(,ke)o +(yval)o(,dec)o(ima)o(ls,c)o(omme)o(nt,)41 b(>)48 b(status\))0 +1044 y Fh(3)81 b Fi(Up)s(date)23 b(the)g(v)-5 b(alue)23 +b(of)h(an)f(existing)g(k)m(eyw)m(ord)h(to)g(b)s(e)f(unde\014ned,)f(or)i +(n)m(ull,)f(or)g(insert)g(a)g(new)g(unde\014ned-v)-5 +b(alue)227 1157 y(k)m(eyw)m(ord)30 b(if)e(it)h(do)s(esn't)g(already)g +(exist.)40 b(The)29 b(v)-5 b(alue)29 b(string)f(of)h(the)h(k)m(eyw)m +(ord)f(is)g(left)g(blank)f(in)f(this)i(case.)382 1420 +y Fe(FTUKYU\(unit,keyword,comm)o(ent)o(,)42 b(>)47 b(status\))0 +1715 y Fb(9.4.8)112 b(Delete)37 b(Keyw)m(ord)g(Subroutines)0 +1927 y Fh(1)81 b Fi(Delete)31 b(an)f(existing)f(k)m(eyw)m(ord)i +(record.)40 b(The)30 b(space)h(previously)d(o)s(ccupied)h(b)m(y)h(the)g +(k)m(eyw)m(ord)h(is)e(reclaimed)227 2040 y(b)m(y)d(mo)m(ving)g(all)f +(the)h(follo)m(wing)f(header)h(records)g(up)f(one)h(ro)m(w)h(in)d(the)j +(header.)39 b(The)25 b(\014rst)h(routine)f(deletes)227 +2153 y(a)34 b(k)m(eyw)m(ord)f(at)h(a)g(sp)s(eci\014ed)d(p)s(osition)g +(in)h(the)h(header)g(\(the)h(\014rst)e(k)m(eyw)m(ord)i(is)e(at)i(p)s +(osition)d(1\),)k(whereas)227 2266 y(the)d(second)g(routine)f(deletes)h +(a)g(sp)s(eci\014cally)d(named)i(k)m(eyw)m(ord.)46 b(Wild)30 +b(card)h(c)m(haracters,)j(as)e(describ)s(ed)227 2378 +y(in)e(the)h(Read)g(Keyw)m(ord)f(section,)h(ab)s(o)m(v)m(e,)h(ma)m(y)g +(b)s(e)e(used)g(when)f(sp)s(ecifying)g(the)i(name)g(of)g(the)f(k)m(eyw) +m(ord)227 2491 y(to)h(b)s(e)f(deleted)g(\(b)s(e)g(careful!\).)382 +2755 y Fe(FTDREC\(unit,key_no,)42 b(>)48 b(status\))382 +2867 y(FTDKEY\(unit,keyword,)42 b(>)48 b(status\))0 3205 +y Fd(9.5)135 b(Data)46 b(Scaling)g(and)e(Unde\014ned)h(Pixel)h(P)l +(arameters)0 3456 y Fi(These)24 b(subroutines)e(de\014ne)i(or)h(mo)s +(dify)d(the)j(in)m(ternal)e(parameters)i(used)f(b)m(y)g(FITSIO)g(to)h +(either)f(scale)h(the)f(data)0 3569 y(or)33 b(to)i(represen)m(t)e +(unde\014ned)e(pixels.)48 b(Generally)33 b(FITSIO)f(will)f(scale)i(the) +h(data)g(according)f(to)h(the)g(v)-5 b(alues)33 b(of)0 +3682 y(the)f(BSCALE)g(and)f(BZER)m(O)h(\(or)h(TSCALn)d(and)i(TZER)m +(On\))f(k)m(eyw)m(ords,)i(ho)m(w)m(ev)m(er)h(these)e(subroutines)e(ma)m +(y)0 3795 y(b)s(e)i(used)h(to)h(o)m(v)m(erride)f(the)g(k)m(eyw)m(ord)h +(v)-5 b(alues.)48 b(This)31 b(ma)m(y)j(b)s(e)f(useful)e(when)h(one)i(w) +m(an)m(ts)f(to)h(read)f(or)g(write)g(the)0 3908 y(ra)m(w)d(unscaled)e +(v)-5 b(alues)28 b(in)h(the)g(FITS)g(\014le.)39 b(Similarly)-8 +b(,)27 b(FITSIO)h(generally)h(uses)g(the)g(v)-5 b(alue)29 +b(of)h(the)f(BLANK)h(or)0 4021 y(TNULLn)35 b(k)m(eyw)m(ord)h(to)g +(signify)d(an)j(unde\014ned)d(pixel,)i(but)g(these)h(routines)f(ma)m(y) +h(b)s(e)e(used)h(to)h(o)m(v)m(erride)g(this)0 4134 y(v)-5 +b(alue.)40 b(These)30 b(subroutines)e(do)j(not)f(create)i(or)f(mo)s +(dify)d(the)j(corresp)s(onding)d(header)i(k)m(eyw)m(ord)h(v)-5 +b(alues.)0 4397 y Fh(1)81 b Fi(Reset)26 b(the)g(scaling)e(factors)i(in) +e(the)i(primary)e(arra)m(y)i(or)f(image)h(extension;)h(do)s(es)e(not)g +(c)m(hange)i(the)f(BSCALE)227 4510 y(and)i(BZER)m(O)g(k)m(eyw)m(ord)h +(v)-5 b(alues)27 b(and)h(only)f(a\013ects)j(the)e(automatic)i(scaling)d +(p)s(erformed)g(when)g(the)h(data)227 4623 y(elemen)m(ts)e(are)g +(written/read)f(to/from)h(the)g(FITS)f(\014le.)38 b(When)25 +b(reading)g(from)g(a)h(FITS)f(\014le)f(the)i(returned)227 +4736 y(data)i(v)-5 b(alue)27 b(=)g(\(the)h(v)-5 b(alue)27 +b(giv)m(en)h(in)e(the)h(FITS)g(arra)m(y\))h(*)g(BSCALE)f(+)g(BZER)m(O.) +g(The)g(in)m(v)m(erse)h(form)m(ula)227 4849 y(is)33 b(used)g(when)g +(writing)f(data)j(v)-5 b(alues)33 b(to)h(the)g(FITS)g(\014le.)50 +b(\(NOTE:)34 b(BSCALE)f(and)g(BZER)m(O)h(m)m(ust)g(b)s(e)227 +4962 y(declared)c(as)h(Double)f(Precision)f(v)-5 b(ariables\).)382 +5225 y Fe(FTPSCL\(unit,bscale,bzero)o(,)42 b(>)47 b(status\))0 +5488 y Fh(2)81 b Fi(Reset)39 b(the)f(scaling)g(parameters)g(for)h(a)f +(table)g(column;)k(do)s(es)c(not)g(c)m(hange)i(the)e(TSCALn)f(or)h +(TZER)m(On)227 5601 y(k)m(eyw)m(ord)29 b(v)-5 b(alues)28 +b(and)f(only)h(a\013ects)h(the)g(automatic)g(scaling)e(p)s(erformed)g +(when)g(the)i(data)g(elemen)m(ts)g(are)227 5714 y(written/read)i +(to/from)h(the)g(FITS)f(\014le.)43 b(When)31 b(reading)f(from)h(a)h +(FITS)f(\014le)f(the)i(returned)e(data)i(v)-5 b(alue)p +eop +%%Page: 85 91 +85 90 bop 0 299 a Fg(9.6.)72 b(FITS)30 b(PRIMAR)-8 b(Y)31 +b(ARRA)-8 b(Y)31 b(OR)f(IMA)m(GE)h(EXTENSION)e(I/O)i(SUBR)m(OUTINES)589 +b Fi(85)227 555 y(=)40 b(\(the)h(v)-5 b(alue)39 b(giv)m(en)h(in)f(the)h +(FITS)g(arra)m(y\))g(*)h(TSCAL)e(+)g(TZER)m(O.)h(The)f(in)m(v)m(erse)h +(form)m(ula)g(is)f(used)227 668 y(when)33 b(writing)f(data)j(v)-5 +b(alues)34 b(to)g(the)h(FITS)e(\014le.)51 b(\(NOTE:)34 +b(TSCAL)f(and)g(TZER)m(O)g(m)m(ust)h(b)s(e)f(declared)227 +781 y(as)e(Double)f(Precision)f(v)-5 b(ariables\).)382 +1041 y Fe(FTTSCL\(unit,colnum,tscal)o(,tz)o(ero,)41 b(>)48 +b(status\))0 1300 y Fh(3)81 b Fi(De\014ne)36 b(the)g(in)m(teger)h(v)-5 +b(alue)35 b(to)i(b)s(e)e(used)h(to)h(signify)d(unde\014ned)g(pixels)g +(in)h(the)h(primary)e(arra)m(y)j(or)f(image)227 1413 +y(extension.)53 b(This)33 b(is)g(only)h(used)g(if)f(BITPIX)h(=)h(8,)h +(16,)g(or)f(32.)54 b(This)33 b(do)s(es)h(not)h(create)h(or)e(c)m(hange) +i(the)227 1526 y(v)-5 b(alue)30 b(of)h(the)f(BLANK)h(k)m(eyw)m(ord)g +(in)e(the)h(header.)382 1786 y Fe(FTPNUL\(unit,blank,)43 +b(>)k(status\))0 2046 y Fh(4)81 b Fi(De\014ne)36 b(the)g(string)f(to)h +(b)s(e)f(used)g(to)i(signify)d(unde\014ned)g(pixels)g(in)g(a)i(column)f +(in)g(an)g(ASCI)s(I)g(table.)57 b(This)227 2158 y(do)s(es)30 +b(not)h(create)h(or)e(c)m(hange)i(the)e(v)-5 b(alue)30 +b(of)h(the)f(TNULLn)g(k)m(eyw)m(ord.)382 2418 y Fe +(FTSNUL\(unit,colnum,snull)41 b(>)47 b(status\))0 2678 +y Fh(5)81 b Fi(De\014ne)34 b(the)h(v)-5 b(alue)33 b(to)i(b)s(e)f(used)g +(to)h(signify)d(unde\014ned)g(pixels)h(in)g(an)h(in)m(teger)h(column)e +(in)g(a)h(binary)f(table)227 2791 y(\(where)c(TF)m(ORMn)f(=)g('B',)i +('I',)f(or)f('J'\).)i(This)c(do)s(es)j(not)f(create)j(or)d(c)m(hange)i +(the)e(v)-5 b(alue)28 b(of)h(the)g(TNULLn)227 2904 y(k)m(eyw)m(ord.)382 +3163 y Fe(FTTNUL\(unit,colnum,tnull)41 b(>)47 b(status\))0 +3497 y Fd(9.6)135 b(FITS)44 b(Primary)h(Arra)l(y)g(or)g(IMA)l(GE)g +(Extension)h(I/O)f(Subroutines)0 3747 y Fi(These)26 b(subroutines)e +(put)i(or)h(get)g(data)h(v)-5 b(alues)25 b(in)h(the)g(primary)f(data)i +(arra)m(y)g(\(i.e.,)h(the)f(\014rst)f(HDU)h(in)e(the)i(FITS)0 +3860 y(\014le\))34 b(or)h(an)f(IMA)m(GE)i(extension.)53 +b(The)34 b(data)i(arra)m(y)f(is)e(represen)m(ted)i(as)g(a)g(single)e +(one-dimensional)g(arra)m(y)i(of)0 3973 y(pixels)f(regardless)i(of)g +(the)g(actual)g(dimensionalit)m(y)d(of)k(the)f(arra)m(y)-8 +b(,)38 b(and)e(the)g(FPIXEL)g(parameter)g(giv)m(es)h(the)0 +4086 y(p)s(osition)26 b(within)e(this)j(1-D)h(arra)m(y)g(of)g(the)g +(\014rst)e(pixel)g(to)i(read)g(or)f(write.)39 b(Automatic)28 +b(data)g(t)m(yp)s(e)g(con)m(v)m(ersion)g(is)0 4199 y(p)s(erformed)h +(for)i(n)m(umeric)f(data)h(\(except)i(for)d(complex)h(data)g(t)m(yp)s +(es\))h(if)e(the)h(data)g(t)m(yp)s(e)g(of)g(the)g(primary)e(arra)m(y)0 +4312 y(\(de\014ned)f(b)m(y)g(the)h(BITPIX)f(k)m(eyw)m(ord\))h +(di\013ers)f(from)g(the)g(data)i(t)m(yp)s(e)e(of)h(the)g(arra)m(y)g(in) +e(the)i(calling)e(subroutine.)0 4425 y(The)41 b(data)i(v)-5 +b(alues)41 b(are)h(also)g(scaled)f(b)m(y)h(the)g(BSCALE)f(and)g(BZER)m +(O)h(header)f(v)-5 b(alues)41 b(as)h(they)g(are)g(b)s(eing)0 +4538 y(written)31 b(or)h(read)g(from)g(the)g(FITS)g(arra)m(y)-8 +b(.)47 b(The)31 b(ftpscl)h(subroutine)e(MUST)h(b)s(e)h(called)f(to)i +(de\014ne)e(the)i(scaling)0 4650 y(parameters)h(when)e(writing)g(data)i +(to)g(the)g(FITS)f(arra)m(y)h(or)f(to)h(o)m(v)m(erride)g(the)g(default) +e(scaling)h(v)-5 b(alue)33 b(giv)m(en)g(in)0 4763 y(the)e(header)f +(when)f(reading)h(the)g(FITS)g(arra)m(y)-8 b(.)0 4924 +y(Tw)m(o)41 b(sets)f(of)h(subroutines)d(are)j(pro)m(vided)e(to)i(read)g +(the)f(data)i(arra)m(y)f(whic)m(h)e(di\013er)g(in)g(the)i(w)m(a)m(y)g +(unde\014ned)0 5036 y(pixels)33 b(are)j(handled.)54 b(The)35 +b(\014rst)f(set)i(of)g(routines)e(\(FTGPVx\))i(simply)d(return)h(an)h +(arra)m(y)h(of)g(data)g(elemen)m(ts)0 5149 y(in)31 b(whic)m(h)g +(unde\014ned)f(pixels)g(are)j(set)f(equal)g(to)h(a)g(v)-5 +b(alue)31 b(sp)s(eci\014ed)g(b)m(y)h(the)g(user)g(in)f(the)h('n)m(ullv) +-5 b(al')30 b(parameter.)0 5262 y(An)k(additional)f(feature)i(of)f +(these)h(subroutines)e(is)g(that)j(if)d(the)i(user)f(sets)h(n)m(ullv)-5 +b(al)32 b(=)i(0,)i(then)f(no)f(c)m(hec)m(ks)i(for)0 5375 +y(unde\014ned)d(pixels)h(will)f(b)s(e)h(p)s(erformed,)i(th)m(us)f +(increasing)f(the)i(sp)s(eed)e(of)i(the)g(program.)55 +b(The)35 b(second)h(set)g(of)0 5488 y(routines)30 b(\(FTGPFx\))j +(returns)d(the)i(data)g(elemen)m(t)g(arra)m(y)g(and,)f(in)g(addition,)f +(a)i(logical)f(arra)m(y)h(whic)m(h)e(de\014nes)0 5601 +y(whether)40 b(the)g(corresp)s(onding)e(data)j(pixel)e(is)g +(unde\014ned.)69 b(The)39 b(latter)i(set)g(of)f(subroutines)e(ma)m(y)j +(b)s(e)f(more)0 5714 y(con)m(v)m(enien)m(t)32 b(to)h(use)e(in)f(some)h +(circumstances,)h(ho)m(w)m(ev)m(er,)h(it)e(requires)f(an)h(additional)e +(arra)m(y)j(of)g(logical)f(v)-5 b(alues)p eop +%%Page: 86 92 +86 91 bop 0 299 a Fi(86)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fi(whic)m(h)35 b(can)h(b)s(e)g(un)m(wieldy)d(when)j(w)m(orking)f +(with)g(large)h(data)h(arra)m(ys.)58 b(Also)36 b(for)g(programmer)g +(con)m(v)m(enience,)0 668 y(sets)j(of)g(subroutines)e(to)i(directly)f +(read)g(or)h(write)f(2)h(and)g(3)g(dimensional)d(arra)m(ys)j(ha)m(v)m +(e)h(b)s(een)e(pro)m(vided,)i(as)0 781 y(w)m(ell)29 b(as)h(a)g(set)g +(of)g(subroutines)d(to)j(read)g(or)g(write)e(an)m(y)i(con)m(tiguous)g +(rectangular)g(subset)f(of)h(pixels)e(within)f(the)0 +894 y(n-dimensional)g(arra)m(y)-8 b(.)0 1150 y Fh(1)81 +b Fi(Get)30 b(the)g(data)g(t)m(yp)s(e)f(of)h(the)g(image)f(\(=)h +(BITPIX)f(v)-5 b(alue\).)40 b(P)m(ossible)28 b(returned)g(v)-5 +b(alues)29 b(are:)41 b(8,)30 b(16,)h(32,)g(-32,)227 1263 +y(or)f(-64)h(corresp)s(onding)d(to)j(unsigned)d(b)m(yte,)j(signed)e +(2-b)m(yte)i(in)m(teger,)g(signed)e(4-b)m(yte)i(in)m(teger,)g(real,)f +(and)227 1376 y(double.)227 1525 y(The)c(second)f(subroutine)f(is)h +(similar)e(to)j(FTGIDT,)h(except)f(that)h(if)e(the)g(image)i(pixel)d(v) +-5 b(alues)25 b(are)h(scaled,)227 1638 y(with)g(non-default)g(v)-5 +b(alues)26 b(for)h(the)h(BZER)m(O)f(and)f(BSCALE)g(k)m(eyw)m(ords,)j +(then)e(this)f(routine)g(will)e(return)227 1751 y(the)32 +b('equiv)-5 b(alen)m(t')31 b(data)g(t)m(yp)s(e)h(that)f(is)f(needed)h +(to)h(store)g(the)f(scaled)g(v)-5 b(alues.)42 b(F)-8 +b(or)32 b(example,)f(if)f(BITPIX)227 1864 y(=)39 b(16)g(and)g(BSCALE)f +(=)g(0.1)i(then)f(the)g(equiv)-5 b(alen)m(t)38 b(data)h(t)m(yp)s(e)g +(is)f(\015oating)h(p)s(oin)m(t,)h(and)e(-32)i(will)d(b)s(e)227 +1977 y(returned.)65 b(There)39 b(are)g(2)g(sp)s(ecial)f(cases:)58 +b(if)38 b(the)h(image)g(con)m(tains)g(unsigned)e(2-b)m(yte)j(in)m +(teger)f(v)-5 b(alues,)227 2090 y(with)39 b(BITPIX)h(=)f(16,)44 +b(BSCALE)39 b(=)h(1,)j(and)c(BZER)m(O)h(=)g(32768,)45 +b(then)39 b(this)g(routine)g(will)f(return)h(a)227 2203 +y(non-standard)26 b(v)-5 b(alue)26 b(of)h(20)h(for)f(the)g(bitpix)e(v) +-5 b(alue.)39 b(Similarly)23 b(if)i(the)j(image)f(con)m(tains)g +(unsigned)e(4-b)m(yte)227 2316 y(in)m(tegers,)31 b(then)f(bitpix)e +(will)g(b)s(e)i(returned)f(with)g(a)i(v)-5 b(alue)30 +b(of)g(40.)382 2571 y Fe(FTGIDT\(unit,)44 b(>)k(bitpix,status\))382 +2684 y(FTGIET\(unit,)c(>)k(bitpix,status\))0 2940 y Fh(2)81 +b Fi(Get)31 b(the)g(dimension)c(\(n)m(um)m(b)s(er)j(of)g(axes)h(=)f +(NAXIS\))h(of)f(the)h(image)382 3196 y Fe(FTGIDM\(unit,)44 +b(>)k(naxis,status\))0 3452 y Fh(3)81 b Fi(Get)31 b(the)g(size)f(of)g +(all)g(the)g(dimensions)e(of)i(the)h(image)382 3707 y +Fe(FTGISZ\(unit,)44 b(maxdim,)i(>)i(naxes,status\))0 +3963 y Fh(4)81 b Fi(Get)35 b(the)f(parameters)g(that)h(de\014ne)e(the)h +(t)m(yp)s(e)g(and)g(size)f(of)i(the)f(image.)52 b(This)32 +b(routine)h(simply)e(com)m(bines)227 4076 y(calls)f(to)h(the)f(ab)s(o)m +(v)m(e)i(3)f(routines.)382 4332 y Fe(FTGIPR\(unit,)44 +b(maxdim,)i(>)i(bitpix,)d(naxis,)h(naxes,)h(int)f(*status\))0 +4588 y Fh(5)81 b Fi(Put)30 b(elemen)m(ts)g(in)m(to)h(the)f(data)h(arra) +m(y)382 4843 y Fe(FTPPR[BIJED]\(unit,group,)o(fpi)o(xel,)o(nele)o(men)o +(ts,v)o(alue)o(s,)41 b(>)48 b(status\))0 5099 y Fh(6)81 +b Fi(Put)30 b(elemen)m(ts)h(in)m(to)f(the)h(data)g(arra)m(y)-8 +b(,)32 b(substituting)c(the)i(appropriate)g(FITS)g(n)m(ull)e(v)-5 +b(alue)30 b(for)g(all)g(elemen)m(ts)227 5212 y(whic)m(h)d(are)g(equal)h +(to)g(the)f(v)-5 b(alue)27 b(of)h(NULL)-10 b(V)g(AL.)28 +b(F)-8 b(or)28 b(in)m(teger)g(FITS)f(arra)m(ys,)i(the)e(n)m(ull)f(v)-5 +b(alue)27 b(de\014ned)f(b)m(y)227 5325 y(the)k(previous)e(call)h(to)i +(FTPNUL)e(will)e(b)s(e)i(substituted;)g(for)g(\015oating)h(p)s(oin)m(t) +f(FITS)g(arra)m(ys)h(\(BITPIX)f(=)227 5438 y(-32)j(or)e(-64\))i(then)e +(the)h(sp)s(ecial)e(IEEE)g(NaN)i(\(Not-a-Num)m(b)s(er\))h(v)-5 +b(alue)30 b(will)e(b)s(e)i(substituted.)382 5694 y Fe +(FTPPN[BIJED]\(unit,group,)o(fpi)o(xel,)o(nele)o(men)o(ts,v)o(alue)o +(s,n)o(ullv)o(al)42 b(>)47 b(status\))p eop +%%Page: 87 93 +87 92 bop 0 299 a Fg(9.6.)72 b(FITS)30 b(PRIMAR)-8 b(Y)31 +b(ARRA)-8 b(Y)31 b(OR)f(IMA)m(GE)h(EXTENSION)e(I/O)i(SUBR)m(OUTINES)589 +b Fi(87)0 555 y Fh(7)81 b Fi(Set)30 b(data)h(arra)m(y)g(elemen)m(ts)g +(as)f(unde\014ned)382 808 y Fe(FTPPRU\(unit,group,fpixel)o(,ne)o(leme)o +(nts,)41 b(>)47 b(status\))0 1060 y Fh(8)81 b Fi(Get)36 +b(elemen)m(ts)f(from)g(the)g(data)h(arra)m(y)-8 b(.)55 +b(Unde\014ned)34 b(arra)m(y)h(elemen)m(ts)h(will)c(b)s(e)j(returned)f +(with)f(a)j(v)-5 b(alue)34 b(=)227 1173 y(n)m(ullv)-5 +b(al,)28 b(unless)h(n)m(ullv)-5 b(al)28 b(=)i(0)h(in)e(whic)m(h)g(case) +i(no)g(c)m(hec)m(ks)g(for)g(unde\014ned)d(pixels)g(will)g(b)s(e)i(p)s +(erformed.)382 1425 y Fe(FTGPV[BIJED]\(unit,group,)o(fpi)o(xel,)o(nele) +o(men)o(ts,n)o(ullv)o(al,)41 b(>)48 b(values,anyf,status\))0 +1678 y Fh(9)81 b Fi(Get)32 b(elemen)m(ts)f(and)g(n)m(ull\015ags)e(from) +i(data)h(arra)m(y)-8 b(.)44 b(An)m(y)32 b(unde\014ned)d(arra)m(y)i +(elemen)m(ts)h(will)c(ha)m(v)m(e)33 b(the)e(corre-)227 +1791 y(sp)s(onding)d(\015agv)-5 b(als)30 b(elemen)m(t)h(set)g(equal)f +(to)h(.TR)m(UE.)382 2043 y Fe(FTGPF[BIJED]\(unit,group,)o(fpi)o(xel,)o +(nele)o(men)o(ts,)41 b(>)48 b(values,flagvals,anyf,sta)o(tus)o(\))0 +2295 y Fh(10)e Fi(Put)30 b(v)-5 b(alues)30 b(in)m(to)g(group)g +(parameters)382 2548 y Fe(FTPGP[BIJED]\(unit,group,)o(fpa)o(rm,n)o +(parm)o(,va)o(lues)o(,)42 b(>)47 b(status\))0 2800 y +Fh(11)f Fi(Get)31 b(v)-5 b(alues)30 b(from)g(group)g(parameters)382 +3053 y Fe(FTGGP[BIJED]\(unit,group,)o(fpa)o(rm,n)o(parm)o(,)42 +b(>)47 b(values,status\))0 3305 y Fi(The)32 b(follo)m(wing)e(4)j +(subroutines)d(transfer)h(FITS)h(images)g(with)f(2)h(or)g(3)h +(dimensions)c(to)k(or)f(from)g(a)h(data)f(arra)m(y)0 +3418 y(whic)m(h)g(has)h(b)s(een)g(declared)f(in)g(the)i(calling)e +(program.)49 b(The)33 b(dimensionalit)m(y)d(of)k(the)f(FITS)g(image)g +(is)f(passed)0 3531 y(b)m(y)26 b(the)g(naxis1,)g(naxis2,)h(and)e +(naxis3)h(parameters)g(and)f(the)h(declared)g(dimensions)d(of)j(the)g +(program)g(arra)m(y)h(are)0 3644 y(passed)k(in)e(the)j(dim1)d(and)i +(dim2)f(parameters.)43 b(Note)32 b(that)g(the)f(program)g(arra)m(y)g +(do)s(es)g(not)g(ha)m(v)m(e)i(to)e(ha)m(v)m(e)i(the)0 +3757 y(same)28 b(dimensions)d(as)j(the)g(FITS)e(arra)m(y)-8 +b(,)30 b(but)d(m)m(ust)g(b)s(e)g(at)i(least)e(as)h(big.)39 +b(F)-8 b(or)29 b(example)e(if)f(a)i(FITS)f(image)h(with)0 +3870 y(NAXIS1)j(=)f(NAXIS2)h(=)f(400)i(is)d(read)i(in)m(to)f(a)h +(program)f(arra)m(y)h(whic)m(h)e(is)h(dimensioned)e(as)i(512)i(x)f(512) +g(pixels,)0 3983 y(then)d(the)g(image)h(will)c(just)j(\014ll)e(the)j +(lo)m(w)m(er)f(left)g(corner)g(of)h(the)f(arra)m(y)h(with)e(pixels)f +(in)h(the)i(range)f(1)h(-)f(400)i(in)d(the)0 4095 y(X)32 +b(an)g(Y)h(directions.)45 b(This)30 b(has)i(the)h(e\013ect)g(of)g +(taking)f(a)h(con)m(tiguous)f(set)h(of)f(pixel)f(v)-5 +b(alue)32 b(in)e(the)j(FITS)e(arra)m(y)0 4208 y(and)k(writing)e(them)i +(to)h(a)g(non-con)m(tiguous)f(arra)m(y)g(in)f(program)h(memory)g +(\(i.e.,)i(there)f(are)f(no)m(w)h(some)f(blank)0 4321 +y(pixels)29 b(around)g(the)h(edge)i(of)e(the)h(image)f(in)f(the)i +(program)f(arra)m(y\).)0 4574 y Fh(11)46 b Fi(Put)30 +b(2-D)i(image)e(in)m(to)h(the)f(data)h(arra)m(y)382 4826 +y Fe(FTP2D[BIJED]\(unit,group,)o(dim)o(1,na)o(xis1)o(,na)o(xis2)o(,ima) +o(ge,)41 b(>)48 b(status\))0 5078 y Fh(12)e Fi(Put)30 +b(3-D)i(cub)s(e)d(in)m(to)i(the)f(data)h(arra)m(y)382 +5331 y Fe(FTP3D[BIJED]\(unit,group,)o(dim)o(1,di)o(m2,n)o(axi)o(s1,n)o +(axis)o(2,n)o(axis)o(3,cu)o(be,)41 b(>)48 b(status\))0 +5583 y Fh(13)e Fi(Get)29 b(2-D)f(image)g(from)g(the)f(data)i(arra)m(y) +-8 b(.)41 b(Unde\014ned)26 b(pixels)f(in)i(the)h(arra)m(y)g(will)d(b)s +(e)i(set)h(equal)f(to)i(the)e(v)-5 b(alue)227 5696 y(of)31 +b('n)m(ullv)-5 b(al',)28 b(unless)h(n)m(ullv)-5 b(al=0)28 +b(in)h(whic)m(h)g(case)j(no)e(testing)h(for)f(unde\014ned)e(pixels)g +(will)g(b)s(e)i(p)s(erformed.)p eop +%%Page: 88 94 +88 93 bop 0 299 a Fi(88)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)382 +555 y Fe(FTG2D[BIJED]\(unit,group,)o(nul)o(lval)o(,dim)o(1,n)o(axis)o +(1,na)o(xis)o(2,)42 b(>)47 b(image,anyf,status\))0 766 +y Fh(14)f Fi(Get)31 b(3-D)h(cub)s(e)e(from)g(the)g(data)h(arra)m(y)-8 +b(.)42 b(Unde\014ned)29 b(pixels)g(in)g(the)h(arra)m(y)h(will)d(b)s(e)i +(set)h(equal)f(to)h(the)f(v)-5 b(alue)227 879 y(of)31 +b('n)m(ullv)-5 b(al',)28 b(unless)h(n)m(ullv)-5 b(al=0)28 +b(in)h(whic)m(h)g(case)j(no)e(testing)h(for)f(unde\014ned)e(pixels)g +(will)g(b)s(e)i(p)s(erformed.)382 1089 y Fe(FTG3D[BIJED]\(unit,group,)o +(nul)o(lval)o(,dim)o(1,d)o(im2,)o(naxi)o(s1,)o(naxi)o(s2,n)o(axi)o(s3,) +41 b(>)1002 1202 y(cube,anyf,status\))0 1413 y Fi(The)i(follo)m(wing)e +(subroutines)g(transfer)i(a)h(rectangular)f(subset)f(of)i(the)f(pixels) +e(in)h(a)i(FITS)e(N-dimensional)0 1525 y(image)30 b(to)h(or)f(from)f +(an)h(arra)m(y)g(whic)m(h)f(has)h(b)s(een)f(declared)g(in)g(the)h +(calling)f(program.)40 b(The)29 b(fpixels)f(and)h(lpixels)0 +1638 y(parameters)e(are)h(in)m(teger)f(arra)m(ys)h(whic)m(h)e(sp)s +(ecify)f(the)j(starting)f(and)f(ending)g(pixels)f(in)h(eac)m(h)i +(dimension)c(of)k(the)0 1751 y(FITS)36 b(image)h(that)g(are)g(to)h(b)s +(e)e(read)g(or)h(written.)59 b(\(Note)38 b(that)g(these)f(are)g(the)g +(starting)f(and)g(ending)g(pixels)0 1864 y(in)d(the)i(FITS)f(image,)j +(not)e(in)e(the)i(declared)f(arra)m(y\).)55 b(The)34 +b(arra)m(y)i(parameter)f(is)f(treated)h(simply)e(as)i(a)g(large)0 +1977 y(one-dimensional)28 b(arra)m(y)i(of)h(the)f(appropriate)f(datat)m +(yp)s(e)i(con)m(taining)f(the)g(pixel)e(v)-5 b(alues;)30 +b(The)f(pixel)g(v)-5 b(alues)29 b(in)0 2090 y(the)d(FITS)f(arra)m(y)i +(are)f(read/written)f(from/to)i(this)e(program)g(arra)m(y)i(in)d +(strict)i(sequence)g(without)f(an)m(y)i(gaps;)g(it)0 +2203 y(is)h(up)f(to)j(the)f(calling)e(routine)h(to)h(correctly)g(in)m +(terpret)f(the)h(dimensionalit)m(y)d(of)j(this)f(arra)m(y)-8 +b(.)41 b(The)28 b(t)m(w)m(o)i(families)0 2316 y(of)d(FITS)g(reading)f +(routines)g(\(FTGSVx)h(and)g(FTGSFx)g(subroutines\))e(also)j(ha)m(v)m +(e)g(an)f('incs')g(parameter)g(whic)m(h)0 2429 y(de\014nes)j(the)h +(data)h(sampling)c(in)m(terv)-5 b(al)30 b(in)g(eac)m(h)i(dimension)c +(of)j(the)g(FITS)f(arra)m(y)-8 b(.)43 b(F)-8 b(or)32 +b(example,)f(if)f(incs\(1\)=2)0 2542 y(and)j(incs\(2\)=3)g(when)g +(reading)f(a)i(2-dimensional)d(FITS)i(image,)h(then)f(only)g(ev)m(ery)h +(other)f(pixel)f(in)g(the)i(\014rst)0 2655 y(dimension)c(and)j(ev)m +(ery)h(3rd)e(pixel)g(in)g(the)h(second)g(dimension)d(will)h(b)s(e)h +(returned)g(in)g(the)h('arra)m(y')h(parameter.)0 2767 +y([Note:)39 b(the)25 b(FTGSSx)f(family)g(of)g(routines)g(whic)m(h)g(w)m +(ere)h(presen)m(t)g(in)e(previous)g(v)m(ersions)h(of)h(FITSIO)f(ha)m(v) +m(e)i(b)s(een)0 2880 y(sup)s(erseded)i(b)m(y)j(the)f(more)h(general)f +(FTGSVx)g(family)f(of)i(routines.])0 3091 y Fh(15)46 +b Fi(Put)30 b(an)g(arbitrary)f(data)i(subsection)f(in)m(to)g(the)h +(data)g(arra)m(y)-8 b(.)382 3301 y Fe(FTPSS[BIJED]\(unit,group,)o(nax)o +(is,n)o(axes)o(,fp)o(ixel)o(s,lp)o(ixe)o(ls,a)o(rray)o(,)42 +b(>)47 b(status\))0 3512 y Fh(16)f Fi(Get)30 b(an)e(arbitrary)f(data)j +(subsection)d(from)h(the)h(data)g(arra)m(y)-8 b(.)42 +b(Unde\014ned)27 b(pixels)f(in)i(the)g(arra)m(y)i(will)25 +b(b)s(e)j(set)227 3625 y(equal)j(to)i(the)e(v)-5 b(alue)32 +b(of)f('n)m(ullv)-5 b(al',)30 b(unless)g(n)m(ullv)-5 +b(al=0)30 b(in)g(whic)m(h)g(case)j(no)e(testing)h(for)f(unde\014ned)f +(pixels)227 3738 y(will)e(b)s(e)i(p)s(erformed.)382 3948 +y Fe(FTGSV[BIJED]\(unit,group,)o(nax)o(is,n)o(axes)o(,fp)o(ixel)o(s,lp) +o(ixe)o(ls,i)o(ncs,)o(nul)o(lval)o(,)42 b(>)1002 4061 +y(array,anyf,status\))0 4272 y Fh(17)k Fi(Get)34 b(an)f(arbitrary)f +(data)h(subsection)f(from)h(the)g(data)g(arra)m(y)-8 +b(.)50 b(An)m(y)33 b(Unde\014ned)e(pixels)g(in)h(the)h(arra)m(y)h(will) +227 4384 y(ha)m(v)m(e)e(the)e(corresp)s(onding)f('\015agv)-5 +b(als')30 b(elemen)m(t)h(set)g(equal)f(to)h(.TR)m(UE.)382 +4595 y Fe(FTGSF[BIJED]\(unit,group,)o(nax)o(is,n)o(axes)o(,fp)o(ixel)o +(s,lp)o(ixe)o(ls,i)o(ncs,)41 b(>)1002 4708 y(array,flagvals,anyf,statu) +o(s\))0 5034 y Fd(9.7)135 b(FITS)44 b(ASCI)t(I)g(and)h(Binary)g(T)-11 +b(able)45 b(Data)h(I/O)f(Subroutines)0 5287 y Fb(9.7.1)112 +b(Column)37 b(Information)f(Subroutines)0 5488 y Fh(1)81 +b Fi(Get)30 b(the)g(n)m(um)m(b)s(er)e(of)i(ro)m(ws)g(or)f(columns)f(in) +h(the)h(curren)m(t)f(FITS)g(table.)40 b(The)29 b(n)m(um)m(b)s(er)f(of)i +(ro)m(ws)g(is)e(giv)m(en)i(b)m(y)227 5601 y(the)k(NAXIS2)f(k)m(eyw)m +(ord)h(and)e(the)i(n)m(um)m(b)s(er)e(of)h(columns)f(is)g(giv)m(en)h(b)m +(y)g(the)h(TFIELDS)e(k)m(eyw)m(ord)i(in)e(the)227 5714 +y(header)e(of)h(the)g(table.)p eop +%%Page: 89 95 +89 94 bop 0 299 a Fg(9.7.)72 b(FITS)30 b(ASCI)s(I)f(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(D)m(A)-8 b(T)g(A)32 b(I/O)e(SUBR)m(OUTINES) +979 b Fi(89)382 555 y Fe(FTGNRW\(unit,)44 b(>)k(nrows,)e(status\))382 +668 y(FTGNCL\(unit,)e(>)k(ncols,)e(status\))0 921 y Fh(2)81 +b Fi(Get)25 b(the)f(table)h(column)e(n)m(um)m(b)s(er)g(\(and)h(name\))h +(of)f(the)h(column)e(whose)h(name)g(matc)m(hes)i(an)e(input)f(template) +227 1034 y(name.)38 b(The)21 b(table)h(column)e(names)i(are)g +(de\014ned)e(b)m(y)i(the)g(TTYPEn)e(k)m(eyw)m(ords)i(in)e(the)i(FITS)f +(header.)37 b(If)22 b(a)227 1147 y(column)h(do)s(es)h(not)g(ha)m(v)m(e) +h(a)f(TTYPEn)f(k)m(eyw)m(ord,)j(then)d(these)h(routines)f(assume)h +(that)g(the)h(name)e(consists)227 1260 y(of)i(all)f(blank)g(c)m +(haracters.)40 b(These)25 b(2)g(subroutines)d(p)s(erform)i(the)h(same)g +(function)f(except)i(that)f(FTGCNO)227 1373 y(only)i(returns)f(the)h(n) +m(um)m(b)s(er)f(of)h(the)g(matc)m(hing)h(column)e(whereas)h(FTGCNN)g +(also)g(returns)f(the)i(name)f(of)227 1486 y(the)k(column.)39 +b(If)30 b(CASESEN)f(=)h(.true.)41 b(then)30 b(the)h(column)e(name)h +(matc)m(h)i(will)27 b(b)s(e)j(case-sensitiv)m(e.)227 +1635 y(The)41 b(input)d(column)i(name)h(template)g(\(COL)-8 +b(TEMPLA)g(TE\))41 b(is)f(\(1\))h(either)g(the)g(exact)h(name)f(of)g +(the)227 1748 y(column)35 b(to)j(b)s(e)d(searc)m(hed)i(for,)h(or)e +(\(2\))i(it)e(ma)m(y)h(con)m(tain)f(wild)e(cards)i(c)m(haracters)i +(\(*,)h(?,)f(or)e(#\),)i(or)f(\(3\))227 1861 y(it)c(ma)m(y)h(con)m +(tain)f(the)g(n)m(um)m(b)s(er)f(of)h(the)g(desired)f(column)g(\(where)h +(the)g(n)m(um)m(b)s(er)f(is)g(expressed)g(as)h(ASCI)s(I)227 +1974 y(digits\).)39 b(The)28 b(\014rst)g(2)h(wild)d(cards)i(b)s(eha)m +(v)m(e)h(similarly)c(to)k(UNIX)g(\014lename)f(matc)m(hing:)39 +b(the)29 b('*')g(c)m(haracter)227 2087 y(matc)m(hes)e(an)m(y)g +(sequence)f(of)h(c)m(haracters)g(\(including)c(zero)k(c)m(haracters\))h +(and)d(the)i(')10 b(?')39 b(c)m(haracter)28 b(matc)m(hes)227 +2199 y(an)m(y)40 b(single)f(c)m(haracter.)71 b(The)39 +b(#)h(wildcard)d(will)g(matc)m(h)k(an)m(y)f(consecutiv)m(e)h(string)e +(of)h(decimal)e(digits)227 2312 y(\(0-9\).)45 b(As)31 +b(an)g(example,)g(the)g(template)g(strings)f('AB?DE',)i('AB*E',)h(and)d +('AB*CDE')j(will)28 b(all)i(matc)m(h)227 2425 y(the)c(string)f +('ABCDE'.)j(If)d(more)h(than)g(one)g(column)f(name)h(in)f(the)h(table)g +(matc)m(hes)h(the)f(template)h(string,)227 2538 y(then)33 +b(the)h(\014rst)f(matc)m(h)h(is)e(returned)h(and)f(the)i(status)g(v)-5 +b(alue)33 b(will)d(b)s(e)j(set)h(to)g(237)h(as)f(a)f(w)m(arning)g(that) +h(a)227 2651 y(unique)f(matc)m(h)j(w)m(as)f(not)g(found.)53 +b(T)-8 b(o)35 b(\014nd)f(the)h(other)g(cases)g(that)h(matc)m(h)g(the)f +(template,)h(simply)d(call)227 2764 y(the)27 b(subroutine)e(again)i +(lea)m(ving)g(the)g(input)e(status)i(v)-5 b(alue)27 b(equal)f(to)i(237) +g(and)f(the)g(next)g(matc)m(hing)g(name)227 2877 y(will)i(then)j(b)s(e) +f(returned.)43 b(Rep)s(eat)32 b(this)f(pro)s(cess)g(un)m(til)f(a)i +(status)g(=)g(219)h(\(column)d(name)i(not)g(found\))f(is)227 +2990 y(returned.)40 b(If)30 b(these)h(subroutines)d(fail)h(to)i(matc)m +(h)g(the)g(template)g(to)g(an)m(y)g(of)f(the)h(columns)e(in)g(the)i +(table,)227 3103 y(they)i(lastly)e(c)m(hec)m(k)j(if)e(the)g(template)h +(can)g(b)s(e)e(in)m(terpreted)h(as)h(a)g(simple)d(p)s(ositiv)m(e)h(in)m +(teger)i(\(e.g.,)i('7',)f(or)227 3216 y('512'\))i(and)d(if)f(so,)j +(they)f(return)e(that)j(column)d(n)m(um)m(b)s(er.)49 +b(If)33 b(no)g(matc)m(hes)i(are)f(found)e(then)h(a)h(status)g(=)227 +3329 y(219)e(error)e(is)f(returned.)227 3478 y(Note)i(that)e(the)h +(FITS)e(Standard)g(recommends)g(that)i(only)e(letters,)i(digits,)e(and) +h(the)g(underscore)f(c)m(har-)227 3591 y(acter)44 b(b)s(e)e(used)g(in)g +(column)f(names)i(\(with)f(no)g(em)m(b)s(edded)g(spaces)h(in)f(the)h +(name\).)78 b(T)-8 b(railing)40 b(blank)227 3704 y(c)m(haracters)32 +b(are)f(not)g(signi\014can)m(t.)40 b(It)31 b(is)e(recommended)i(that)g +(the)g(column)e(names)h(in)g(a)h(giv)m(en)f(table)h(b)s(e)227 +3816 y(unique)e(within)f(the)i(\014rst)g(8)h(c)m(haracters.)382 +4070 y Fe(FTGCNO\(unit,casesen,colt)o(emp)o(late)o(,)42 +b(>)47 b(colnum,status\))382 4182 y(FTGCNN\(unit,casesen,colt)o(emp)o +(late)o(,)42 b(>)47 b(colname,colnum,status\))0 4436 +y Fh(3)81 b Fi(Get)39 b(the)g(datat)m(yp)s(e)h(of)e(a)h(column)f(in)f +(an)h(ASCI)s(I)g(or)g(binary)f(table.)65 b(This)37 b(routine)h(returns) +f(an)i(in)m(teger)227 4549 y(co)s(de)34 b(v)-5 b(alue)32 +b(corresp)s(onding)f(to)j(the)g(datat)m(yp)s(e)g(of)f(the)g(column.)48 +b(\(See)34 b(the)f(FTBNFM)i(and)d(FT)-8 b(ASFM)227 4661 +y(subroutines)26 b(in)h(the)h(Utilities)f(section)h(of)g(this)f(do)s +(cumen)m(t)h(for)g(a)h(list)e(of)h(the)h(co)s(de)f(v)-5 +b(alues\).)40 b(The)27 b(v)m(ector)227 4774 y(rep)s(eat)38 +b(coun)m(t)g(\(whic)m(h)f(is)g(alw)m(a)m(y)h(1)g(for)g(ASCI)s(I)e +(table)h(columns\))g(is)g(also)g(returned.)62 b(If)37 +b(the)h(sp)s(eci\014ed)227 4887 y(column)31 b(has)g(an)g(ASCI)s(I)f(c)m +(haracter)j(datat)m(yp)s(e)g(\(co)s(de)f(=)f(16\))i(then)e(the)h(width) +d(of)j(a)g(unit)e(string)h(in)f(the)227 5000 y(column)i(is)g(also)h +(returned.)48 b(Note)34 b(that)g(this)d(routine)h(supp)s(orts)g(the)h +(lo)s(cal)f(con)m(v)m(en)m(tion)i(for)f(sp)s(ecifying)227 +5113 y(arra)m(ys)f(of)f(strings)f(within)e(a)k(binary)d(table)i(c)m +(haracter)h(column,)f(using)e(the)i(syn)m(tax)h(TF)m(ORM)f(=)g('rAw') +227 5226 y(where)f('r')g(is)g(the)g(total)h(n)m(um)m(b)s(er)e(of)i(c)m +(haracters)g(\(=)g(the)f(width)f(of)h(the)g(column\))g(and)g('w')g(is)f +(the)i(width)227 5339 y(of)39 b(a)f(unit)f(string)g(within)f(the)i +(column.)63 b(Th)m(us)37 b(if)g(the)h(column)f(has)h(TF)m(ORM)h(=)f +('60A12')i(then)e(this)227 5452 y(routine)30 b(will)d(return)j(dataco)s +(de)h(=)f(16,)h(rep)s(eat)g(=)f(60,)i(and)d(width)g(=)h(12.)227 +5601 y(The)h(second)h(routine,)f(FTEQTY)g(is)f(similar)f(except)k(that) +f(in)e(the)i(case)g(of)g(scaled)f(in)m(teger)h(columns)e(it)227 +5714 y(returns)23 b(the)h('equiv)-5 b(alen)m(t')23 b(data)h(t)m(yp)s(e) +g(that)h(is)d(needed)i(to)g(store)g(the)g(scaled)f(v)-5 +b(alues,)25 b(and)e(not)h(necessarily)p eop +%%Page: 90 96 +90 95 bop 0 299 a Fi(90)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)227 +555 y Fi(the)38 b(ph)m(ysical)f(data)h(t)m(yp)s(e)g(of)g(the)g +(unscaled)f(v)-5 b(alues)37 b(as)h(stored)g(in)f(the)h(FITS)f(table.)63 +b(F)-8 b(or)38 b(example)g(if)227 668 y(a)d('1I')g(column)e(in)g(a)h +(binary)f(table)h(has)g(TSCALn)f(=)g(1)i(and)f(TZER)m(On)f(=)g(32768,) +38 b(then)c(this)f(column)227 781 y(e\013ectiv)m(ely)25 +b(con)m(tains)f(unsigned)e(short)h(in)m(teger)i(v)-5 +b(alues,)24 b(and)g(th)m(us)f(the)h(returned)f(v)-5 b(alue)23 +b(of)h(t)m(yp)s(eco)s(de)h(will)227 894 y(b)s(e)32 b(the)h(co)s(de)g +(for)g(an)f(unsigned)f(short)h(in)m(teger,)i(not)f(a)g(signed)f(short)g +(in)m(teger.)48 b(Similarly)-8 b(,)30 b(if)i(a)h(column)227 +1007 y(has)d(TTYPEn)g(=)g('1I')h(and)f(TSCALn)e(=)i(0.12,)j(then)d(the) +g(returned)g(t)m(yp)s(eco)s(de)g(will)e(b)s(e)i(the)h(co)s(de)f(for)h +(a)227 1120 y('real')g(column.)382 1382 y Fe(FTGTCL\(unit,colnum,)42 +b(>)48 b(datacode,repeat,width,st)o(atu)o(s\))382 1495 +y(FTEQTY\(unit,colnum,)42 b(>)48 b(datacode,repeat,width,st)o(atu)o +(s\))0 1758 y Fh(4)81 b Fi(Return)22 b(the)i(displa)m(y)e(width)g(of)h +(a)h(column.)38 b(This)21 b(is)i(the)h(length)f(of)g(the)h(string)f +(that)h(will)d(b)s(e)i(returned)f(when)227 1871 y(reading)32 +b(the)h(column)f(as)h(a)g(formatted)g(string.)47 b(The)32 +b(displa)m(y)f(width)g(is)h(determined)g(b)m(y)g(the)h(TDISPn)227 +1984 y(k)m(eyw)m(ord,)e(if)f(presen)m(t,)g(otherwise)g(b)m(y)g(the)h +(data)g(t)m(yp)s(e)g(of)f(the)h(column.)382 2246 y Fe(FTGCDW\(unit,)44 +b(colnum,)i(>)i(dispwidth,)d(status\))0 2509 y Fh(5)81 +b Fi(Get)29 b(information)d(ab)s(out)i(an)g(existing)f(ASCI)s(I)g +(table)h(column.)39 b(\(NOTE:)28 b(TSCAL)f(and)g(TZER)m(O)h(m)m(ust)g +(b)s(e)227 2622 y(declared)i(as)h(Double)f(Precision)f(v)-5 +b(ariables\).)39 b(All)29 b(the)i(returned)e(parameters)i(are)f(scalar) +h(quan)m(tities.)382 2884 y Fe(FTGACL\(unit,colnum,)42 +b(>)716 2997 y(ttype,tbcol,tunit,tform,)o(tsca)o(l,t)o(zero)o(,snu)o +(ll,)o(tdis)o(p,st)o(atu)o(s\))0 3259 y Fh(6)81 b Fi(Get)29 +b(information)d(ab)s(out)h(an)h(existing)f(binary)f(table)i(column.)39 +b(\(NOTE:)28 b(TSCAL)e(and)i(TZER)m(O)f(m)m(ust)h(b)s(e)227 +3372 y(declared)i(as)g(Double)f(Precision)g(v)-5 b(ariables\).)39 +b(D)m(A)-8 b(T)g(A)g(TYPE)32 b(is)d(a)h(c)m(haracter)i(string)c(whic)m +(h)h(returns)g(the)227 3485 y(datat)m(yp)s(e)35 b(of)g(the)f(column)f +(as)h(de\014ned)f(b)m(y)h(the)g(TF)m(ORMn)g(k)m(eyw)m(ord)h(\(e.g.,)i +('I',)e('J','E',)g('D',)g(etc.\).)54 b(In)227 3598 y(the)27 +b(case)g(of)g(an)f(ASCI)s(I)f(c)m(haracter)j(column,)e(D)m(A)-8 +b(T)g(A)g(TYPE)29 b(will)23 b(ha)m(v)m(e)28 b(a)f(v)-5 +b(alue)26 b(of)g(the)h(form)f('An')g(where)227 3711 y('n')34 +b(is)f(an)h(in)m(teger)h(expressing)e(the)h(width)e(of)i(the)h(\014eld) +d(in)h(c)m(haracters.)53 b(F)-8 b(or)35 b(example,)g(if)e(TF)m(ORM)h(=) +227 3824 y('160A8')39 b(then)e(FTGBCL)f(will)e(return)i(D)m(A)-8 +b(T)g(A)g(TYPE='A8')39 b(and)d(REPEA)-8 b(T=20.)60 b(All)35 +b(the)i(returned)227 3937 y(parameters)31 b(are)g(scalar)f(quan)m +(tities.)382 4199 y Fe(FTGBCL\(unit,colnum,)42 b(>)716 +4312 y(ttype,tunit,datatype,rep)o(eat,)o(tsc)o(al,t)o(zero)o(,tn)o +(ull,)o(tdis)o(p,s)o(tatu)o(s\))0 4575 y Fh(7)81 b Fi(Put)31 +b(\(app)s(end\))g(a)i(TDIMn)f(k)m(eyw)m(ord)g(whose)g(v)-5 +b(alue)32 b(has)g(the)g(form)g('\(l,m,n...\)')46 b(where)32 +b(l,)g(m,)g(n...)46 b(are)33 b(the)227 4688 y(dimensions)28 +b(of)i(a)h(m)m(ultidimension)c(arra)m(y)j(column)g(in)f(a)h(binary)f +(table.)382 4950 y Fe(FTPTDM\(unit,colnum,naxis)o(,na)o(xes,)41 +b(>)48 b(status\))0 5213 y Fh(8)81 b Fi(Return)29 b(the)h(n)m(um)m(b)s +(er)e(of)i(and)g(size)f(of)h(the)g(dimensions)e(of)i(a)g(table)g +(column.)39 b(Normally)29 b(this)g(information)227 5326 +y(is)h(giv)m(en)h(b)m(y)g(the)g(TDIMn)f(k)m(eyw)m(ord,)i(but)e(if)g +(this)g(k)m(eyw)m(ord)h(is)f(not)h(presen)m(t)g(then)g(this)e(routine)h +(returns)227 5439 y(NAXIS)g(=)g(1)h(and)f(NAXES\(1\))h(equal)f(to)h +(the)g(rep)s(eat)g(coun)m(t)g(in)e(the)h(TF)m(ORM)h(k)m(eyw)m(ord.)382 +5701 y Fe(FTGTDM\(unit,colnum,maxdi)o(m,)41 b(>)48 b +(naxis,naxes,status\))p eop +%%Page: 91 97 +91 96 bop 0 299 a Fg(9.7.)72 b(FITS)30 b(ASCI)s(I)f(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(D)m(A)-8 b(T)g(A)32 b(I/O)e(SUBR)m(OUTINES) +979 b Fi(91)0 555 y Fh(9)81 b Fi(Deco)s(de)33 b(the)g(input)e(TDIMn)i +(k)m(eyw)m(ord)g(string)e(\(e.g.)50 b('\(100,200\)'\))37 +b(and)32 b(return)g(the)h(n)m(um)m(b)s(er)e(of)i(and)f(size)227 +668 y(of)c(the)g(dimensions)d(of)j(a)g(binary)e(table)h(column.)39 +b(If)27 b(the)h(input)e(tdimstr)g(c)m(haracter)j(string)e(is)g(n)m +(ull,)f(then)227 781 y(this)e(routine)f(returns)g(naxis)g(=)i(1)f(and)g +(naxes[0])i(equal)d(to)j(the)e(rep)s(eat)h(coun)m(t)g(in)e(the)h(TF)m +(ORM)h(k)m(eyw)m(ord.)227 894 y(This)k(routine)g(is)h(called)f(b)m(y)h +(FTGTDM.)382 1147 y Fe(FTDTDM\(unit,tdimstr,coln)o(um,)o(maxd)o(im,)41 +b(>)48 b(naxis,naxes,)c(status\))0 1400 y Fh(10)i Fi(Return)32 +b(the)h(optimal)f(n)m(um)m(b)s(er)g(of)h(ro)m(ws)g(to)h(read)f(or)g +(write)f(at)i(one)f(time)g(for)f(maxim)m(um)g(I/O)h(e\016ciency)-8 +b(.)227 1513 y(Refer)31 b(to)g(the)g(\\Optimizing)d(Co)s(de")i(section) +h(in)e(Chapter)h(5)g(for)h(more)f(discussion)e(on)i(ho)m(w)h(to)g(use)f +(this)227 1626 y(routine.)382 1879 y Fe(FFGRSZ\(unit,)44 +b(>)k(nrows,status\))0 2169 y Fb(9.7.2)112 b(Lo)m(w-Lev)m(el)38 +b(T)-9 b(able)37 b(Access)g(Subroutines)0 2388 y Fi(The)d(follo)m(wing) +e(subroutines)g(pro)m(vide)i(lo)m(w-lev)m(el)g(access)h(to)g(the)g +(data)g(in)e(ASCI)s(I)f(or)i(binary)f(tables)h(and)g(are)0 +2501 y(mainly)27 b(useful)g(as)j(an)f(e\016cien)m(t)g(w)m(a)m(y)h(to)g +(cop)m(y)g(all)e(or)h(part)g(of)g(a)g(table)g(from)g(one)g(lo)s(cation) +g(to)h(another.)40 b(These)0 2614 y(routines)23 b(simply)f(read)i(or)h +(write)e(the)i(sp)s(eci\014ed)d(n)m(um)m(b)s(er)h(of)i(consecutiv)m(e)g +(b)m(ytes)g(in)e(an)h(ASCI)s(I)f(or)h(binary)f(table,)0 +2727 y(without)36 b(regard)h(for)f(column)g(b)s(oundaries)e(or)j(the)g +(ro)m(w)g(length)g(in)e(the)i(table.)60 b(The)37 b(\014rst)f(t)m(w)m(o) +i(subroutines)0 2840 y(read)29 b(or)h(write)f(consecutiv)m(e)h(b)m +(ytes)g(in)e(a)i(table)f(to)i(or)e(from)g(a)h(c)m(haracter)h(string)d +(v)-5 b(ariable,)29 b(while)f(the)h(last)h(t)m(w)m(o)0 +2953 y(subroutines)f(read)j(or)g(write)f(consecutiv)m(e)h(b)m(ytes)h +(to)f(or)g(from)f(a)h(v)-5 b(ariable)31 b(declared)g(as)h(a)g(n)m +(umeric)e(data)j(t)m(yp)s(e)0 3065 y(\(e.g.,)40 b(INTEGER,)d +(INTEGER*2,)i(REAL,)d(DOUBLE)h(PRECISION\).)f(These)g(routines)g(do)g +(not)h(p)s(erform)0 3178 y(an)m(y)c(mac)m(hine)f(dep)s(enden)m(t)g +(data)i(con)m(v)m(ersion)f(or)f(b)m(yte)i(sw)m(apping,)e(except)i(that) +f(con)m(v)m(ersion)g(to/from)g(ASCI)s(I)0 3291 y(format)d(is)f(p)s +(erformed)f(b)m(y)h(the)h(FTGTBS)f(and)g(FTPTBS)g(routines)g(on)g(mac)m +(hines)g(whic)m(h)g(do)g(not)h(use)f(ASCI)s(I)0 3404 +y(c)m(haracter)j(co)s(des)e(in)f(the)i(in)m(ternal)e(data)i(represen)m +(tations)g(\(e.g.,)h(on)e(IBM)h(mainframe)e(computers\).)0 +3657 y Fh(1)81 b Fi(Read)26 b(a)h(consecutiv)m(e)g(string)f(of)g(c)m +(haracters)i(from)e(an)g(ASCI)s(I)f(table)h(in)m(to)h(a)f(c)m(haracter) +i(v)-5 b(ariable)26 b(\(spanning)227 3770 y(columns)31 +b(and)h(m)m(ultiple)e(ro)m(ws)i(if)f(necessary\))i(This)e(routine)g +(should)f(not)j(b)s(e)e(used)h(with)f(binary)f(tables)227 +3883 y(b)s(ecause)h(of)f(complications)f(related)i(to)g(passing)e +(string)g(v)-5 b(ariables)29 b(b)s(et)m(w)m(een)i(C)f(and)g(F)-8 +b(ortran.)382 4136 y Fe(FTGTBS\(unit,frow,startch)o(ar,)o(ncha)o(rs,)41 +b(>)48 b(string,status\))0 4390 y Fh(2)81 b Fi(W)-8 b(rite)30 +b(a)h(consecutiv)m(e)g(string)e(of)i(c)m(haracters)g(to)g(an)f(ASCI)s +(I)f(table)h(from)g(a)h(c)m(haracter)h(v)-5 b(ariable)29 +b(\(spanning)227 4503 y(columns)i(and)h(m)m(ultiple)e(ro)m(ws)i(if)f +(necessary\))i(This)e(routine)g(should)f(not)j(b)s(e)e(used)h(with)f +(binary)f(tables)227 4615 y(b)s(ecause)h(of)f(complications)f(related)i +(to)g(passing)e(string)g(v)-5 b(ariables)29 b(b)s(et)m(w)m(een)i(C)f +(and)g(F)-8 b(ortran.)382 4869 y Fe(FTPTBS\(unit,frow,startch)o(ar,)o +(ncha)o(rs,s)o(tri)o(ng,)41 b(>)48 b(status\))0 5122 +y Fh(3)81 b Fi(Read)27 b(a)h(consecutiv)m(e)h(arra)m(y)f(of)g(b)m(ytes) +g(from)f(an)g(ASCI)s(I)f(or)i(binary)d(table)j(in)m(to)f(a)h(n)m +(umeric)f(v)-5 b(ariable)26 b(\(span-)227 5235 y(ning)31 +b(columns)f(and)i(m)m(ultiple)d(ro)m(ws)j(if)f(necessary\).)46 +b(The)32 b(arra)m(y)g(parameter)g(ma)m(y)h(b)s(e)e(declared)g(as)i(an)m +(y)227 5348 y(n)m(umerical)g(datat)m(yp)s(e)i(as)g(long)f(as)h(the)f +(arra)m(y)h(is)e(at)i(least)g('nc)m(hars')g(b)m(ytes)f(long,)i(e.g.,)g +(if)e(nc)m(hars)g(=)g(17,)227 5461 y(then)c(declare)h(the)f(arra)m(y)h +(as)g(INTEGER*4)g(ARRA)-8 b(Y\(5\).)382 5714 y Fe +(FTGTBB\(unit,frow,startch)o(ar,)o(ncha)o(rs,)41 b(>)48 +b(array,status\))p eop +%%Page: 92 98 +92 97 bop 0 299 a Fi(92)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fh(4)81 b Fi(W)-8 b(rite)31 b(a)g(consecutiv)m(e)h(arra)m(y)g(of) +f(b)m(ytes)g(to)h(an)e(ASCI)s(I)g(or)h(binary)e(table)i(from)f(a)i(n)m +(umeric)d(v)-5 b(ariable)30 b(\(span-)227 668 y(ning)k(columns)f(and)h +(m)m(ultiple)e(ro)m(ws)j(if)e(necessary\))j(The)e(arra)m(y)h(parameter) +g(ma)m(y)h(b)s(e)e(declared)g(as)h(an)m(y)227 781 y(n)m(umerical)e +(datat)m(yp)s(e)i(as)g(long)f(as)h(the)f(arra)m(y)h(is)e(at)i(least)g +('nc)m(hars')g(b)m(ytes)f(long,)i(e.g.,)g(if)e(nc)m(hars)g(=)g(17,)227 +894 y(then)c(declare)h(the)f(arra)m(y)h(as)g(INTEGER*4)g(ARRA)-8 +b(Y\(5\).)382 1161 y Fe(FTPTBB\(unit,frow,startch)o(ar,)o(ncha)o(rs,a)o +(rra)o(y,)42 b(>)47 b(status\))0 1461 y Fb(9.7.3)112 +b(Edit)36 b(Ro)m(ws)h(or)h(Columns)0 1676 y Fh(1)81 b +Fi(Insert)26 b(blank)g(ro)m(ws)i(in)m(to)f(an)g(existing)f(ASCI)s(I)g +(or)h(binary)f(table)h(\(in)g(the)g(CDU\).)h(All)e(the)i(ro)m(ws)f(F)m +(OLLO)m(W-)227 1789 y(ING)32 b(ro)m(w)f(FR)m(O)m(W)i(are)e(shifted)f +(do)m(wn)h(b)m(y)g(NR)m(O)m(WS)h(ro)m(ws.)43 b(If)31 +b(FR)m(O)m(W)i(=)d(0)i(then)f(the)g(blank)f(ro)m(ws)i(are)227 +1902 y(inserted)e(at)i(the)f(b)s(eginning)e(of)i(the)g(table.)43 +b(This)29 b(routine)h(mo)s(di\014es)f(the)j(NAXIS2)f(k)m(eyw)m(ord)h +(to)f(re\015ect)227 2015 y(the)g(new)f(n)m(um)m(b)s(er)f(of)h(ro)m(ws)h +(in)e(the)h(table.)382 2282 y Fe(FTIROW\(unit,frow,nrows,)41 +b(>)48 b(status\))0 2550 y Fh(2)81 b Fi(Delete)26 b(ro)m(ws)g(from)f +(an)g(existing)g(ASCI)s(I)f(or)h(binary)f(table)h(\(in)g(the)h(CDU\).)g +(The)f(NR)m(O)m(WS)h(n)m(um)m(b)s(er)e(of)i(ro)m(ws)227 +2663 y(are)k(deleted,)g(starting)f(with)g(ro)m(w)g(FR)m(O)m(W,)j(and)d +(an)m(y)h(remaining)d(ro)m(ws)j(in)e(the)i(table)f(are)h(shifted)f(up)f +(to)227 2775 y(\014ll)35 b(in)h(the)h(space.)61 b(This)35 +b(routine)h(mo)s(di\014es)f(the)j(NAXIS2)f(k)m(eyw)m(ord)g(to)h +(re\015ect)f(the)h(new)e(n)m(um)m(b)s(er)g(of)227 2888 +y(ro)m(ws)31 b(in)e(the)h(table.)382 3156 y Fe +(FTDROW\(unit,frow,nrows,)41 b(>)48 b(status\))0 3423 +y Fh(3)81 b Fi(Delete)25 b(a)g(list)e(of)i(ro)m(ws)f(from)g(an)h(ASCI)s +(I)e(or)h(binary)f(table)h(\(in)g(the)g(CDU\).)i(In)e(the)g(\014rst)g +(routine,)h('ro)m(wrange')227 3536 y(is)i(a)h(c)m(haracter)h(string)e +(listing)f(the)i(ro)m(ws)f(or)h(ro)m(w)g(ranges)g(to)g(delete)g +(\(e.g.,)j('2-4,)e(5,)g(8-9'\).)42 b(In)27 b(the)h(second)227 +3649 y(routine,)36 b('ro)m(wlist')e(is)g(an)g(in)m(teger)i(arra)m(y)f +(of)g(ro)m(w)g(n)m(um)m(b)s(ers)e(to)j(b)s(e)e(deleted)h(from)f(the)h +(table.)55 b(nro)m(ws)34 b(is)227 3762 y(the)e(n)m(um)m(b)s(er)e(of)h +(ro)m(w)h(n)m(um)m(b)s(ers)e(in)g(the)h(list.)43 b(The)31 +b(\014rst)f(ro)m(w)i(in)e(the)h(table)h(is)e(1)i(not)f(0.)44 +b(The)31 b(list)f(of)i(ro)m(w)227 3875 y(n)m(um)m(b)s(ers)d(m)m(ust)h +(b)s(e)g(sorted)h(in)e(ascending)g(order.)382 4142 y +Fe(FTDRRG\(unit,rowrange,)42 b(>)47 b(status\))382 4255 +y(FTDRWS\(unit,rowlist,nrow)o(s,)41 b(>)48 b(status\))0 +4523 y Fh(4)81 b Fi(Insert)43 b(a)i(blank)e(column)h(\(or)g(columns\))g +(in)m(to)g(an)g(existing)g(ASCI)s(I)f(or)h(binary)f(table)h(\(in)g(the) +g(CDU\).)227 4636 y(COLNUM)c(sp)s(eci\014es)f(the)i(column)e(n)m(um)m +(b)s(er)g(that)i(the)f(\(\014rst\))g(new)g(column)f(should)f(o)s(ccup)m +(y)j(in)e(the)227 4749 y(table.)57 b(NCOLS)34 b(sp)s(eci\014es)g(ho)m +(w)i(man)m(y)g(columns)e(are)i(to)g(b)s(e)f(inserted.)56 +b(An)m(y)35 b(existing)g(columns)f(from)227 4862 y(this)k(p)s(osition)e +(and)i(higher)f(are)i(mo)m(v)m(ed)g(o)m(v)m(er)h(to)f(allo)m(w)f(ro)s +(om)g(for)h(the)f(new)g(column\(s\).)64 b(The)38 b(index)227 +4975 y(n)m(um)m(b)s(er)j(on)h(all)f(the)h(follo)m(wing)e(k)m(eyw)m +(ords)j(will)c(b)s(e)i(incremen)m(ted)h(if)f(necessary)h(to)h +(re\015ect)f(the)g(new)227 5087 y(p)s(osition)30 b(of)h(the)g +(column\(s\))g(in)f(the)h(table:)42 b(TBCOLn,)30 b(TF)m(ORMn,)i +(TTYPEn,)e(TUNITn,)h(TNULLn,)227 5200 y(TSCALn,)22 b(TZER)m(On,)g +(TDISPn,)g(TDIMn,)h(TLMINn,)g(TLMAXn,)f(TDMINn,)i(TDMAXn,)f(TCTYPn,)227 +5313 y(TCRPXn,)30 b(TCR)-10 b(VLn,)29 b(TCDL)-8 b(Tn,)30 +b(TCR)m(OTn,)f(and)g(TCUNIn.)382 5581 y Fe(FTICOL\(unit,colnum,ttype)o +(,tf)o(orm,)41 b(>)48 b(status\))382 5694 y(FTICLS\(unit,colnum,ncols)o +(,tt)o(ype,)o(tfor)o(m,)41 b(>)48 b(status\))p eop +%%Page: 93 99 +93 98 bop 0 299 a Fg(9.7.)72 b(FITS)30 b(ASCI)s(I)f(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(D)m(A)-8 b(T)g(A)32 b(I/O)e(SUBR)m(OUTINES) +979 b Fi(93)0 555 y Fh(5)81 b Fi(Mo)s(dify)36 b(the)h(v)m(ector)i +(length)e(of)g(a)h(binary)d(table)i(column)f(\(e.g.,)41 +b(c)m(hange)e(a)e(column)f(from)h(TF)m(ORMn)g(=)227 668 +y('1E')31 b(to)h('20E'\).)g(The)e(v)m(ector)i(length)d(ma)m(y)i(b)s(e)f +(increased)g(or)g(decreased)h(from)f(the)g(curren)m(t)h(v)-5 +b(alue.)382 924 y Fe(FTMVEC\(unit,colnum,newve)o(cle)o(n,)42 +b(>)47 b(status\))0 1180 y Fh(6)81 b Fi(Delete)28 b(a)g(column)f(from)g +(an)g(existing)g(ASCI)s(I)f(or)i(binary)d(table)j(\(in)f(the)g(CDU\).)i +(The)e(index)f(n)m(um)m(b)s(er)g(of)i(all)227 1293 y(the)k(k)m(eyw)m +(ords)h(listed)d(ab)s(o)m(v)m(e)k(\(for)e(FTICOL\))f(will)e(b)s(e)j +(decremen)m(ted)g(if)f(necessary)i(to)g(re\015ect)f(the)g(new)227 +1406 y(p)s(osition)24 b(of)i(the)g(column\(s\))f(in)f(the)i(table.)39 +b(Those)26 b(index)e(k)m(eyw)m(ords)i(that)g(refer)f(to)i(the)f +(deleted)f(column)227 1519 y(will)30 b(also)i(b)s(e)g(deleted.)46 +b(Note)33 b(that)g(the)g(ph)m(ysical)e(size)h(of)g(the)h(FITS)e(\014le) +h(will)d(not)k(b)s(e)e(reduced)h(b)m(y)g(this)227 1632 +y(op)s(eration,)d(and)f(the)h(empt)m(y)g(FITS)f(blo)s(c)m(ks)g(if)g(an) +m(y)h(at)g(the)g(end)f(of)h(the)g(\014le)f(will)e(b)s(e)i(padded)g +(with)f(zeros.)382 1888 y Fe(FTDCOL\(unit,colnum,)42 +b(>)48 b(status\))0 2144 y Fh(7)81 b Fi(Cop)m(y)30 b(a)g(column)f(from) +h(one)g(HDU)h(to)g(another)f(\(or)h(to)g(the)f(same)h(HDU\).)g(If)f +(createcol)i(=)d(TR)m(UE,)i(then)f(a)227 2257 y(new)20 +b(column)f(will)f(b)s(e)i(inserted)f(in)g(the)i(output)f(table,)j(at)e +(p)s(osition)d(`outcolumn',)k(otherwise)e(the)h(existing)227 +2370 y(output)29 b(column)e(will)f(b)s(e)i(o)m(v)m(erwritten)h(\(in)f +(whic)m(h)f(case)j(it)e(m)m(ust)g(ha)m(v)m(e)i(a)f(compatible)f(datat)m +(yp)s(e\).)42 b(Note)227 2483 y(that)31 b(the)g(\014rst)e(column)h(in)f +(a)h(table)h(is)e(at)i(coln)m(um)f(=)g(1.)382 2739 y +Fe(FTCPCL\(inunit,outunit,in)o(col)o(num,)o(outc)o(oln)o(um,c)o(reat)o +(eco)o(l,)42 b(>)47 b(status\);)0 3029 y Fb(9.7.4)112 +b(Read)38 b(and)h(W)-9 b(rite)35 b(Column)i(Data)g(Routines)0 +3248 y Fi(These)22 b(subroutines)e(put)i(or)g(get)i(data)f(v)-5 +b(alues)21 b(in)g(the)i(curren)m(t)f(ASCI)s(I)f(or)h(Binary)f(table)i +(extension.)37 b(Automatic)0 3361 y(data)21 b(t)m(yp)s(e)g(con)m(v)m +(ersion)f(is)f(p)s(erformed)g(for)h(n)m(umerical)f(data)i(t)m(yp)s(es)g +(\(B,I,J,E,D\))h(if)d(the)i(data)g(t)m(yp)s(e)f(of)h(the)f(column)0 +3474 y(\(de\014ned)32 b(b)m(y)i(the)f(TF)m(ORM)h(k)m(eyw)m(ord\))g +(di\013ers)e(from)g(the)i(data)g(t)m(yp)s(e)f(of)h(the)f(calling)f +(subroutine.)47 b(The)33 b(data)0 3587 y(v)-5 b(alues)29 +b(are)i(also)f(scaled)f(b)m(y)h(the)g(TSCALn)f(and)g(TZER)m(On)g +(header)h(v)-5 b(alues)29 b(as)h(they)g(are)h(b)s(eing)d(written)h(to)i +(or)0 3700 y(read)j(from)f(the)h(FITS)f(arra)m(y)-8 b(.)51 +b(The)33 b(fttscl)h(subroutine)d(MUST)j(b)s(e)f(used)g(to)h(de\014ne)f +(the)h(scaling)f(parameters)0 3813 y(when)f(writing)f(data)j(to)g(the)f +(table)g(or)g(to)h(o)m(v)m(erride)f(the)h(default)e(scaling)g(v)-5 +b(alues)33 b(giv)m(en)g(in)f(the)h(header)g(when)0 3926 +y(reading)c(from)h(the)h(table.)0 4086 y(In)h(the)i(case)g(of)f(binary) +f(tables)h(with)f(v)m(ector)i(elemen)m(ts,)h(the)e('felem')g(parameter) +h(de\014nes)e(the)i(starting)f(pixel)0 4199 y(within)j(the)i(elemen)m +(t)h(v)m(ector.)65 b(This)37 b(parameter)h(is)f(ignored)h(with)e(ASCI)s +(I)h(tables.)64 b(Similarly)-8 b(,)37 b(in)g(the)h(case)0 +4312 y(of)45 b(binary)d(tables)i(the)h('nelemen)m(ts')g(parameter)g(sp) +s(eci\014es)e(the)h(total)h(n)m(um)m(b)s(er)e(of)i(v)m(ector)h(v)-5 +b(alues)44 b(read)g(or)0 4425 y(written)35 b(\(con)m(tin)m(uing)g(on)h +(subsequen)m(t)f(ro)m(ws)g(if)g(required\))f(and)i(not)g(the)g(n)m(um)m +(b)s(er)e(of)i(table)g(elemen)m(ts.)57 b(Tw)m(o)0 4538 +y(sets)36 b(of)f(subroutines)f(are)h(pro)m(vided)f(to)j(get)f(the)g +(column)e(data)i(whic)m(h)e(di\013er)g(in)h(the)g(w)m(a)m(y)i +(unde\014ned)c(pixels)0 4650 y(are)f(handled.)41 b(The)31 +b(\014rst)g(set)h(of)f(routines)g(\(FTGCV\))h(simply)d(return)h(an)h +(arra)m(y)h(of)f(data)h(elemen)m(ts)g(in)e(whic)m(h)0 +4763 y(unde\014ned)41 b(pixels)h(are)i(set)g(equal)f(to)i(a)f(v)-5 +b(alue)43 b(sp)s(eci\014ed)f(b)m(y)h(the)h(user)f(in)f(the)i('n)m(ullv) +-5 b(al')41 b(parameter.)81 b(An)0 4876 y(additional)41 +b(feature)j(of)g(these)g(subroutines)d(is)i(that)h(if)e(the)i(user)e +(sets)i(n)m(ullv)-5 b(al)41 b(=)i(0,)48 b(then)43 b(no)g(c)m(hec)m(ks)i +(for)0 4989 y(unde\014ned)33 b(pixels)h(will)f(b)s(e)h(p)s(erformed,)i +(th)m(us)f(increasing)f(the)i(sp)s(eed)e(of)i(the)g(program.)55 +b(The)35 b(second)h(set)g(of)0 5102 y(routines)g(\(FTGCF\))i(returns)d +(the)i(data)h(elemen)m(t)f(arra)m(y)h(and)e(in)g(addition)f(a)i +(logical)g(arra)m(y)g(of)g(\015ags)g(whic)m(h)0 5215 +y(de\014nes)29 b(whether)h(the)h(corresp)s(onding)d(data)j(pixel)e(is)g +(unde\014ned.)0 5375 y(An)m(y)41 b(column,)h(regardless)e(of)h(it's)f +(in)m(trinsic)e(datat)m(yp)s(e,)45 b(ma)m(y)c(b)s(e)f(read)h(as)g(a)g +(string.)70 b(It)41 b(should)e(b)s(e)h(noted)0 5488 y(ho)m(w)m(ev)m(er) +32 b(that)f(reading)e(a)i(n)m(umeric)e(column)g(as)i(a)f(string)g(is)f +(10)i(-)g(100)g(times)f(slo)m(w)m(er)h(than)f(reading)f(the)i(same)0 +5601 y(column)f(as)i(a)g(n)m(um)m(b)s(er)e(due)h(to)h(the)g(large)g(o)m +(v)m(erhead)g(in)f(constructing)g(the)h(formatted)g(strings.)43 +b(The)31 b(displa)m(y)0 5714 y(format)26 b(of)g(the)h(returned)d +(strings)h(will)e(b)s(e)j(determined)e(b)m(y)i(the)g(TDISPn)f(k)m(eyw)m +(ord,)j(if)c(it)i(exists,)h(otherwise)e(b)m(y)p eop +%%Page: 94 100 +94 99 bop 0 299 a Fi(94)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fi(the)e(datat)m(yp)s(e)h(of)g(the)f(column.)39 +b(The)28 b(length)f(of)i(the)f(returned)f(strings)g(can)h(b)s(e)g +(determined)f(with)f(the)j(ftgcdw)0 668 y(routine.)40 +b(The)30 b(follo)m(wing)e(TDISPn)i(displa)m(y)e(formats)j(are)f(curren) +m(tly)g(supp)s(orted:)191 923 y Fe(Iw.m)142 b(Integer)191 +1036 y(Ow.m)g(Octal)46 b(integer)191 1149 y(Zw.m)142 +b(Hexadecimal)45 b(integer)191 1262 y(Fw.d)142 b(Fixed)46 +b(floating)g(point)191 1375 y(Ew.d)142 b(Exponential)45 +b(floating)g(point)191 1488 y(Dw.d)142 b(Exponential)45 +b(floating)g(point)191 1600 y(Gw.d)142 b(General;)46 +b(uses)g(Fw.d)h(if)g(significance)d(not)j(lost,)g(else)f(Ew.d)0 +1855 y Fi(where)37 b(w)h(is)f(the)h(width)e(in)h(c)m(haracters)i(of)f +(the)h(displa)m(y)m(ed)d(v)-5 b(alues,)40 b(m)d(is)g(the)h(minim)m(um)e +(n)m(um)m(b)s(er)g(of)i(digits)0 1968 y(displa)m(y)m(ed,)29 +b(and)h(d)g(is)f(the)i(n)m(um)m(b)s(er)e(of)h(digits)f(to)i(the)g(righ) +m(t)f(of)h(the)f(decimal.)40 b(The)30 b(.m)g(\014eld)f(is)g(optional.)0 +2223 y Fh(1)81 b Fi(Put)30 b(elemen)m(ts)h(in)m(to)g(an)f(ASCI)s(I)f +(or)i(binary)e(table)i(column)e(\(in)h(the)h(CDU\).)g(\(The)g(SPP)f +(FSPCLS)f(routine)227 2336 y(has)38 b(an)f(additional)f(in)m(teger)i +(argumen)m(t)g(after)h(the)f(V)-10 b(ALUES)37 b(c)m(haracter)i(string)e +(whic)m(h)f(sp)s(eci\014es)h(the)227 2449 y(size)30 b(of)h(the)g(1st)g +(dimension)c(of)k(this)e(2-D)j(CHAR)e(arra)m(y\).)382 +2704 y Fe(FTPCL[SLBIJEDCM]\(unit,co)o(lnu)o(m,fr)o(ow,f)o(ele)o(m,ne)o +(leme)o(nts)o(,val)o(ues,)41 b(>)47 b(status\))0 2959 +y Fh(2)81 b Fi(Put)29 b(elemen)m(ts)h(in)m(to)g(an)g(ASCI)s(I)e(or)i +(binary)e(table)i(column)e(\(in)h(the)h(CDU\))g(substituting)e(the)i +(appropriate)227 3072 y(FITS)i(n)m(ull)e(v)-5 b(alue)31 +b(for)h(an)m(y)h(elemen)m(ts)f(that)h(are)f(equal)g(to)h(NULL)-10 +b(V)g(AL.)32 b(This)e(family)h(of)h(routines)f(m)m(ust)227 +3185 y(NOT)h(b)s(e)g(used)f(to)i(write)f(to)h(v)-5 b(ariable)31 +b(length)g(arra)m(y)i(columns.)45 b(F)-8 b(or)33 b(ASCI)s(I)e(T)-8 +b(ABLE)32 b(extensions,)h(the)227 3298 y(n)m(ull)39 b(v)-5 +b(alue)41 b(de\014ned)f(b)m(y)h(the)g(previous)f(call)g(to)i(FTSNUL)e +(will)f(b)s(e)h(substituted;)45 b(F)-8 b(or)42 b(in)m(teger)g(FITS)227 +3410 y(columns,)c(in)e(a)i(binary)e(table)h(the)g(n)m(ull)f(v)-5 +b(alue)36 b(de\014ned)h(b)m(y)g(the)g(previous)f(call)h(to)h(FTTNUL)f +(will)e(b)s(e)227 3523 y(substituted;)27 b(F)-8 b(or)28 +b(\015oating)g(p)s(oin)m(t)e(FITS)g(columns)g(a)i(sp)s(ecial)e(IEEE)h +(NaN)h(\(Not-a-Num)m(b)s(er\))h(v)-5 b(alue)27 b(will)227 +3636 y(b)s(e)j(substituted.)382 3891 y Fe(FTPCN[BIJED]\(unit,colnum)o +(,fr)o(ow,f)o(elem)o(,ne)o(leme)o(nts,)o(val)o(ues,)o(null)o(val)41 +b(>)48 b(status\))0 4146 y Fh(3)81 b Fi(Put)37 b(bit)g(v)-5 +b(alues)37 b(in)m(to)h(a)g(binary)e(b)m(yte)i(\('B'\))i(or)d(bit)g +(\('X'\))i(table)f(column)f(\(in)f(the)i(CDU\).)h(LRA)-8 +b(Y)38 b(is)f(an)227 4259 y(arra)m(y)d(of)g(logical)e(v)-5 +b(alues)33 b(corresp)s(onding)e(to)j(the)g(sequence)f(of)h(bits)e(to)i +(b)s(e)f(written.)48 b(If)33 b(LRA)-8 b(Y)34 b(is)e(true)227 +4372 y(then)g(the)g(corresp)s(onding)e(bit)h(is)g(set)h(to)h(1,)g +(otherwise)e(the)h(bit)f(is)g(set)i(to)g(0.)45 b(Note)34 +b(that)e(in)f(the)h(case)h(of)227 4485 y('X')g(columns,)f(FITSIO)f +(will)f(write)h(to)i(all)e(8)i(bits)e(of)h(eac)m(h)i(b)m(yte)f(whether) +e(they)i(are)g(formally)d(v)-5 b(alid)31 b(or)227 4598 +y(not.)46 b(Th)m(us)31 b(if)g(the)h(column)f(is)f(de\014ned)h(as)h +('4X',)i(and)d(one)h(calls)f(FTPCLX)h(with)e(fbit=1)h(and)g(n)m(bit=8,) +227 4711 y(then)j(all)f(8)h(bits)f(will)e(b)s(e)i(written)g(in)m(to)h +(the)g(\014rst)g(b)m(yte)g(\(as)h(opp)s(osed)e(to)i(writing)c(the)k +(\014rst)e(4)h(bits)f(in)m(to)227 4824 y(the)e(\014rst)f(ro)m(w)g(and)g +(then)g(the)h(next)f(4)h(bits)e(in)m(to)i(the)f(next)h(ro)m(w\),)g(ev)m +(en)g(though)f(the)h(last)f(4)h(bits)e(of)i(eac)m(h)227 +4937 y(b)m(yte)g(are)g(formally)e(not)i(de\014ned.)382 +5191 y Fe(FTPCLX\(unit,colnum,frow,)o(fbi)o(t,nb)o(it,l)o(ray)o(,)42 +b(>)47 b(status\))0 5446 y Fh(4)81 b Fi(Set)30 b(table)g(elemen)m(ts)h +(in)e(a)i(column)e(as)i(unde\014ned)382 5701 y Fe +(FTPCLU\(unit,colnum,frow,)o(fel)o(em,n)o(elem)o(ent)o(s,)42 +b(>)47 b(status\))p eop +%%Page: 95 101 +95 100 bop 0 299 a Fg(9.7.)72 b(FITS)30 b(ASCI)s(I)f(AND)i(BINAR)-8 +b(Y)31 b(T)-8 b(ABLE)31 b(D)m(A)-8 b(T)g(A)32 b(I/O)e(SUBR)m(OUTINES) +979 b Fi(95)0 555 y Fh(5)81 b Fi(Get)34 b(elemen)m(ts)f(from)g(an)g +(ASCI)s(I)f(or)h(binary)f(table)h(column)f(\(in)g(the)h(CDU\).)i(These) +e(routines)f(return)g(the)227 668 y(v)-5 b(alues)29 b(of)h(the)g(table) +g(column)f(arra)m(y)h(elemen)m(ts.)41 b(Unde\014ned)28 +b(arra)m(y)j(elemen)m(ts)f(will)d(b)s(e)i(returned)g(with)g(a)227 +781 y(v)-5 b(alue)25 b(=)h(n)m(ullv)-5 b(al,)24 b(unless)g(n)m(ullv)-5 +b(al)23 b(=)i(0)h(\(or)g(=)f(')h(')g(for)f(ftgcvs\))i(in)d(whic)m(h)g +(case)j(no)e(c)m(hec)m(king)i(for)e(unde\014ned)227 894 +y(v)-5 b(alues)27 b(will)e(b)s(e)i(p)s(erformed.)39 b(The)27 +b(ANYF)h(parameter)g(is)f(set)h(to)g(true)g(if)f(an)m(y)g(of)h(the)g +(returned)f(elemen)m(ts)227 1007 y(are)f(unde\014ned.)37 +b(\(Note:)i(the)26 b(ftgcl)f(routine)f(simple)f(gets)j(an)g(arra)m(y)f +(of)g(logical)g(data)h(v)-5 b(alues)24 b(without)h(an)m(y)227 +1120 y(c)m(hec)m(ks)39 b(for)e(unde\014ned)e(v)-5 b(alues;)40 +b(use)d(the)g(ftgc\015)h(routine)e(to)i(c)m(hec)m(k)g(for)f +(unde\014ned)e(logical)i(elemen)m(ts\).)227 1233 y(\(The)29 +b(SPP)f(FSGCVS)g(routine)f(has)i(an)f(additional)f(in)m(teger)i +(argumen)m(t)g(after)g(the)g(V)-10 b(ALUES)28 b(c)m(haracter)227 +1346 y(string)i(whic)m(h)f(sp)s(eci\014es)g(the)h(size)h(of)f(the)h +(1st)g(dimension)c(of)k(this)e(2-D)j(CHAR)e(arra)m(y\).)382 +1595 y Fe(FTGCL\(unit,colnum,frow,f)o(ele)o(m,ne)o(leme)o(nts)o(,)42 +b(>)47 b(values,status\))382 1708 y(FTGCV[SBIJEDCM]\(unit,col)o(num)o +(,fro)o(w,fe)o(lem)o(,nel)o(emen)o(ts,)o(null)o(val,)41 +b(>)1098 1821 y(values,anyf,status\))0 2071 y Fh(6)81 +b Fi(Get)44 b(elemen)m(ts)g(and)e(n)m(ull)g(\015ags)h(from)g(an)h(ASCI) +s(I)d(or)j(binary)d(table)j(column)e(\(in)g(the)i(CHDU\).)g(These)227 +2184 y(routines)28 b(return)f(the)i(v)-5 b(alues)28 b(of)h(the)g(table) +g(column)e(arra)m(y)j(elemen)m(ts.)40 b(An)m(y)29 b(unde\014ned)d(arra) +m(y)k(elemen)m(ts)227 2297 y(will)k(ha)m(v)m(e)k(the)f(corresp)s +(onding)e(\015agv)-5 b(als)36 b(elemen)m(t)i(set)f(equal)f(to)i(.TR)m +(UE.)f(The)f(ANYF)i(parameter)f(is)227 2409 y(set)30 +b(to)g(true)g(if)e(an)m(y)i(of)f(the)h(returned)e(elemen)m(ts)i(are)g +(unde\014ned.)38 b(\(The)29 b(SPP)f(FSGCFS)h(routine)g(has)g(an)227 +2522 y(additional)24 b(in)m(teger)j(argumen)m(t)f(after)h(the)f(V)-10 +b(ALUES)26 b(c)m(haracter)i(string)d(whic)m(h)f(sp)s(eci\014es)h(the)i +(size)e(of)i(the)227 2635 y(1st)k(dimension)d(of)j(this)e(2-D)i(CHAR)g +(arra)m(y\).)382 2885 y Fe(FTGCF[SLBIJEDCM]\(unit,co)o(lnu)o(m,fr)o +(ow,f)o(ele)o(m,ne)o(leme)o(nts)o(,)42 b(>)1193 2998 +y(values,flagvals,anyf,stat)o(us\))0 3247 y Fh(7)81 b +Fi(Get)29 b(an)f(arbitrary)f(data)i(subsection)e(from)h(an)g +(N-dimensional)e(arra)m(y)j(in)e(a)h(binary)f(table)h(v)m(ector)i +(column.)227 3360 y(Unde\014ned)k(pixels)f(in)h(the)i(arra)m(y)g(will)c +(b)s(e)j(set)h(equal)e(to)i(the)g(v)-5 b(alue)35 b(of)g('n)m(ullv)-5 +b(al',)35 b(unless)e(n)m(ullv)-5 b(al=0)33 b(in)227 3473 +y(whic)m(h)f(case)j(no)e(testing)h(for)f(unde\014ned)e(pixels)h(will)e +(b)s(e)j(p)s(erformed.)49 b(The)32 b(\014rst)h(and)g(last)g(ro)m(ws)h +(in)e(the)227 3586 y(table)27 b(to)g(b)s(e)f(read)g(are)h(sp)s +(eci\014ed)d(b)m(y)j(fpixels\(naxis+1\))d(and)i(lpixels\(naxis+1\),)f +(and)h(hence)g(are)h(treated)227 3699 y(as)f(the)f(next)h(higher)e +(dimension)f(of)i(the)h(FITS)e(N-dimensional)f(arra)m(y)-8 +b(.)40 b(The)25 b(INCS)f(parameter)i(sp)s(eci\014es)227 +3812 y(the)31 b(sampling)d(in)m(terv)-5 b(al)30 b(in)f(eac)m(h)i +(dimension)d(b)s(et)m(w)m(een)j(the)g(data)g(elemen)m(ts)f(that)h(will) +d(b)s(e)i(returned.)382 4062 y Fe(FTGSV[BIJED]\(unit,colnum)o(,na)o +(xis,)o(naxe)o(s,f)o(pixe)o(ls,l)o(pix)o(els,)o(incs)o(,nu)o(llva)o(l,) +42 b(>)1002 4175 y(array,anyf,status\))0 4424 y Fh(8)81 +b Fi(Get)29 b(an)f(arbitrary)f(data)i(subsection)e(from)h(an)g +(N-dimensional)e(arra)m(y)j(in)e(a)h(binary)f(table)h(v)m(ector)i +(column.)227 4537 y(An)m(y)39 b(Unde\014ned)e(pixels)g(in)h(the)h(arra) +m(y)g(will)d(ha)m(v)m(e)k(the)f(corresp)s(onding)e('\015agv)-5 +b(als')39 b(elemen)m(t)g(set)g(equal)227 4650 y(to)d(.TR)m(UE.)f(The)f +(\014rst)g(and)g(last)h(ro)m(ws)g(in)e(the)i(table)g(to)g(b)s(e)g(read) +f(are)h(sp)s(eci\014ed)e(b)m(y)i(fpixels\(naxis+1\))227 +4763 y(and)k(lpixels\(naxis+1\),)g(and)f(hence)i(are)f(treated)i(as)e +(the)g(next)h(higher)e(dimension)e(of)k(the)f(FITS)g(N-)227 +4876 y(dimensional)d(arra)m(y)-8 b(.)66 b(The)38 b(INCS)g(parameter)h +(sp)s(eci\014es)e(the)h(sampling)f(in)m(terv)-5 b(al)38 +b(in)f(eac)m(h)j(dimension)227 4989 y(b)s(et)m(w)m(een)31 +b(the)g(data)g(elemen)m(ts)g(that)g(will)c(b)s(e)j(returned.)382 +5238 y Fe(FTGSF[BIJED]\(unit,colnum)o(,na)o(xis,)o(naxe)o(s,f)o(pixe)o +(ls,l)o(pix)o(els,)o(incs)o(,)42 b(>)1002 5351 y +(array,flagvals,anyf,statu)o(s\))0 5601 y Fh(9)81 b Fi(Get)33 +b(bit)f(v)-5 b(alues)33 b(from)f(a)h(b)m(yte)h(\('B'\))g(or)f(bit)f +(\(`X`\))i(table)f(column)f(\(in)g(the)h(CDU\).)g(LRA)-8 +b(Y)34 b(is)e(an)g(arra)m(y)i(of)227 5714 y(logical)k(v)-5 +b(alues)38 b(corresp)s(onding)f(to)i(the)g(sequence)f(of)h(bits)f(to)h +(b)s(e)f(read.)65 b(If)38 b(LRA)-8 b(Y)39 b(is)e(true)i(then)f(the)p +eop +%%Page: 96 102 +96 101 bop 0 299 a Fi(96)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)227 +555 y Fi(corresp)s(onding)j(bit)g(w)m(as)h(set)h(to)g(1,)h(otherwise)e +(the)g(bit)g(w)m(as)g(set)h(to)g(0.)53 b(Note)35 b(that)g(in)e(the)i +(case)g(of)f('X')227 668 y(columns,)40 b(FITSIO)e(will)e(read)i(all)g +(8)h(bits)f(of)h(eac)m(h)h(b)m(yte)f(whether)f(they)h(are)g(formally)f +(v)-5 b(alid)37 b(or)h(not.)227 781 y(Th)m(us)c(if)f(the)i(column)e(is) +g(de\014ned)g(as)i('4X',)h(and)d(one)i(calls)f(FTGCX)g(with)f(fbit=1)h +(and)f(n)m(bit=8,)i(then)227 894 y(all)28 b(8)i(bits)e(will)e(b)s(e)j +(read)g(from)g(the)g(\014rst)f(b)m(yte)i(\(as)g(opp)s(osed)e(to)i +(reading)e(the)i(\014rst)e(4)i(bits)e(from)g(the)i(\014rst)227 +1007 y(ro)m(w)g(and)e(then)h(the)h(\014rst)e(4)i(bits)e(from)h(the)g +(next)g(ro)m(w\),)i(ev)m(en)f(though)f(the)g(last)g(4)h(bits)e(of)h +(eac)m(h)i(b)m(yte)f(are)227 1120 y(formally)f(not)i(de\014ned.)382 +1385 y Fe(FTGCX\(unit,colnum,frow,f)o(bit)o(,nbi)o(t,)42 +b(>)47 b(lray,status\))0 1650 y Fh(10)f Fi(Read)31 b(an)m(y)g +(consecutiv)m(e)g(set)g(of)g(bits)f(from)g(an)g('X')i(or)e('B')i +(column)d(and)h(in)m(terpret)g(them)h(as)g(an)f(unsigned)227 +1763 y(n-bit)j(in)m(teger.)53 b(NBIT)35 b(m)m(ust)f(b)s(e)f(less)h +(than)g(or)g(equal)g(to)h(16)g(when)f(calling)e(FTGCXI,)j(and)f(less)f +(than)227 1876 y(or)f(equal)f(to)h(32)g(when)e(calling)g(FTGCXJ;)i +(there)f(is)g(no)g(limit)e(on)j(the)f(v)-5 b(alue)31 +b(of)h(NBIT)f(for)g(FTGCXD,)227 1989 y(but)38 b(the)h(returned)e +(double)h(precision)e(v)-5 b(alue)38 b(only)g(has)g(48)i(bits)d(of)i +(precision)e(on)h(most)h(32-bit)g(w)m(ord)227 2102 y(mac)m(hines.)63 +b(The)37 b(NBITS)g(bits)g(are)h(in)m(terpreted)f(as)h(an)g(unsigned)d +(in)m(teger)k(unless)d(NBITS)h(=)g(16)i(\(in)227 2215 +y(FTGCXI\))e(or)g(32)g(\(in)f(FTGCXJ\))g(in)f(whic)m(h)h(case)h(the)g +(string)f(of)g(bits)g(are)h(in)m(terpreted)e(as)i(16-bit)g(or)227 +2328 y(32-bit)j(2's)g(complemen)m(t)g(signed)e(in)m(tegers.)68 +b(If)39 b(NR)m(O)m(WS)i(is)d(greater)j(than)e(1)h(then)f(the)h(same)g +(set)g(of)227 2441 y(bits)33 b(will)e(b)s(e)i(read)h(from)f(sequen)m +(tial)g(ro)m(ws)h(in)e(the)i(table)f(starting)h(with)e(ro)m(w)i(FR)m(O) +m(W.)h(Note)g(that)g(the)227 2554 y(n)m(um)m(b)s(ering)26 +b(con)m(v)m(en)m(tion)j(used)e(here)g(for)h(the)g(FBIT)f(parameter)i +(adopts)e(1)h(for)g(the)g(\014rst)f(elemen)m(t)h(of)g(the)227 +2667 y(v)m(ector)k(of)f(bits;)e(this)h(is)f(the)i(Most)g(Signi\014can)m +(t)e(Bit)h(of)h(the)f(in)m(teger)h(v)-5 b(alue.)382 2932 +y Fe(FTGCX[IJD]\(unit,colnum,f)o(row)o(,nro)o(ws,f)o(bit)o(,nbi)o(t,)42 +b(>)47 b(array,status\))0 3197 y Fh(11)f Fi(Get)37 b(the)e(descriptor)g +(for)g(a)h(v)-5 b(ariable)35 b(length)g(column)f(in)g(a)i(binary)e +(table.)56 b(The)35 b(descriptor)g(consists)g(of)227 +3310 y(2)d(in)m(teger)f(parameters:)42 b(the)31 b(n)m(um)m(b)s(er)f(of) +h(elemen)m(ts)h(in)d(the)i(arra)m(y)h(and)e(the)h(starting)g(o\013set)h +(relativ)m(e)f(to)227 3423 y(the)d(start)f(of)g(the)h(heap.)39 +b(The)27 b(\014rst)f(routine)g(returns)g(a)h(single)f(descriptor)g +(whereas)h(the)g(second)g(routine)227 3536 y(returns)i(the)i +(descriptors)e(for)h(a)h(range)g(of)f(ro)m(ws)h(in)e(the)h(table.)382 +3801 y Fe(FTGDES\(unit,colnum,rownu)o(m,)41 b(>)48 b +(nelements,offset,status\))382 3914 y(FFGDESSunit,colnum,first)o(row)o +(,nro)o(ws)42 b(>)47 b(nelements,offset,)c(status\))0 +4179 y Fh(12)j Fi(Put)29 b(the)g(descriptor)f(for)h(a)h(v)-5 +b(ariable)28 b(length)h(column)f(in)g(a)h(binary)f(table.)40 +b(This)27 b(subroutine)h(can)h(b)s(e)g(used)227 4292 +y(in)23 b(conjunction)h(with)f(FTGDES)h(to)h(enable)f(2)h(or)f(more)g +(arra)m(ys)h(to)g(p)s(oin)m(t)e(to)i(the)g(same)g(storage)g(lo)s +(cation)227 4405 y(to)31 b(sa)m(v)m(e)h(storage)g(space)f(if)e(the)i +(arra)m(ys)g(are)g(iden)m(tical.)382 4671 y Fe +(FTPDES\(unit,colnum,rownu)o(m,n)o(elem)o(ents)o(,of)o(fset)o(,)42 +b(>)47 b(status\))0 5011 y Fd(9.8)135 b(Ro)l(w)46 b(Selection)g(and)f +(Calculator)h(Routines)0 5262 y Fi(These)21 b(routines)e(all)h(parse)h +(and)f(ev)-5 b(aluate)22 b(an)e(input)f(string)h(con)m(taining)h(a)g +(user)f(de\014ned)g(arithmetic)g(expression.)0 5375 y(The)29 +b(\014rst)f(3)i(routines)e(select)i(ro)m(ws)f(in)f(a)i(FITS)e(table,)i +(based)f(on)g(whether)g(the)g(expression)f(ev)-5 b(aluates)30 +b(to)g(true)0 5488 y(\(not)e(equal)e(to)i(zero\))g(or)f(false)g +(\(zero\).)41 b(The)27 b(other)g(routines)f(ev)-5 b(aluate)28 +b(the)f(expression)f(and)g(calculate)i(a)f(v)-5 b(alue)0 +5601 y(for)35 b(eac)m(h)h(ro)m(w)g(of)f(the)h(table.)55 +b(The)35 b(allo)m(w)m(ed)g(expression)f(syn)m(tax)h(is)g(describ)s(ed)e +(in)h(the)h(ro)m(w)h(\014lter)e(section)h(in)0 5714 y(the)i(earlier)f +(`Extended)g(File)g(Name)h(Syn)m(tax')g(c)m(hapter)h(of)f(this)e(do)s +(cumen)m(t.)60 b(The)36 b(expression)g(ma)m(y)h(also)g(b)s(e)p +eop +%%Page: 97 103 +97 102 bop 0 299 a Fg(9.8.)72 b(R)m(O)m(W)31 b(SELECTION)e(AND)i +(CALCULA)-8 b(TOR)29 b(R)m(OUTINES)1382 b Fi(97)0 555 +y(written)27 b(to)j(a)e(text)i(\014le,)e(and)g(the)h(name)f(of)h(the)f +(\014le,)g(prep)s(ended)f(with)g(a)i('@')f(c)m(haracter)i(ma)m(y)f(b)s +(e)f(supplied)d(for)0 668 y(the)34 b('expr')g(parameter)g(\(e.g.)53 +b('@\014lename.txt'\).)e(The)34 b(expression)e(in)h(the)h(\014le)f(can) +h(b)s(e)f(arbitrarily)e(complex)0 781 y(and)k(extend)h(o)m(v)m(er)h(m)m +(ultiple)c(lines)h(of)i(the)f(\014le.)56 b(Lines)35 b(that)h(b)s(egin)e +(with)g(2)i(slash)f(c)m(haracters)i(\('//'\))h(will)33 +b(b)s(e)0 894 y(ignored)c(and)h(ma)m(y)h(b)s(e)f(used)g(to)h(add)e +(commen)m(ts)j(to)f(the)f(\014le.)0 1171 y Fh(1)81 b +Fi(Ev)-5 b(aluate)37 b(a)g(b)s(o)s(olean)f(expression)g(o)m(v)m(er)i +(the)g(indicated)d(ro)m(ws,)k(returning)c(an)i(arra)m(y)h(of)f(\015ags) +g(indicating)227 1284 y(whic)m(h)29 b(ro)m(ws)i(ev)-5 +b(aluated)30 b(to)h(TR)m(UE/F)-10 b(ALSE)430 1560 y Fe +(FTFROW\(unit,expr,firstr)o(ow,)41 b(nrows,)46 b(>)i(n_good_rows,)c +(row_status,)h(status\))0 1837 y Fh(2)81 b Fi(Find)28 +b(the)j(\014rst)f(ro)m(w)g(whic)m(h)f(satis\014es)h(the)h(input)d(b)s +(o)s(olean)h(expression)430 2114 y Fe(FTFFRW\(unit,)44 +b(expr,)i(>)i(rownum,)e(status\))0 2391 y Fh(3)81 b Fi(Ev)-5 +b(aluate)34 b(an)g(expression)g(on)g(all)f(ro)m(ws)i(of)f(a)h(table.)53 +b(If)34 b(the)g(input)f(and)h(output)g(\014les)f(are)i(not)g(the)f +(same,)227 2503 y(cop)m(y)39 b(the)f(TR)m(UE)g(ro)m(ws)h(to)f(the)h +(output)e(\014le.)63 b(If)38 b(the)g(\014les)f(are)i(the)f(same,)j +(delete)d(the)g(F)-10 b(ALSE)38 b(ro)m(ws)227 2616 y(\(preserv)m(e)31 +b(the)g(TR)m(UE)f(ro)m(ws\).)430 2893 y Fe(FTSROW\(inunit,)43 +b(outunit,)j(expr,)g(>)i(status\))0 3170 y Fh(4)81 b +Fi(Calculate)26 b(an)h(expression)e(for)i(the)f(indicated)g(ro)m(ws)g +(of)h(a)g(table,)h(returning)d(the)i(results,)f(cast)i(as)f(datat)m(yp) +s(e)227 3283 y(\(TSHOR)-8 b(T,)32 b(TDOUBLE,)h(etc\),)h(in)d(arra)m(y) +-8 b(.)48 b(If)31 b(n)m(ulv)-5 b(al==NULL,)31 b(UNDEFs)i(will)c(b)s(e)j +(zero)s(ed)g(out.)47 b(F)-8 b(or)227 3396 y(v)m(ector)37 +b(results,)e(the)g(n)m(um)m(b)s(er)e(of)i(elemen)m(ts)h(returned)d(ma)m +(y)j(b)s(e)e(less)g(than)h(nelemen)m(ts)f(if)g(nelemen)m(ts)h(is)227 +3509 y(not)30 b(an)g(ev)m(en)h(m)m(ultiple)c(of)j(the)g(result)f +(dimension.)38 b(Call)28 b(FTTEXP)i(to)g(obtain)g(the)g(dimensions)d +(of)j(the)227 3621 y(results.)430 3898 y Fe(FTCROW\(unit,datatype,ex)o +(pr,)o(firs)o(trow)o(,ne)o(leme)o(nts,)o(nul)o(val,)41 +b(>)620 4011 y(array,anynul,status\))0 4288 y Fh(5)81 +b Fi(Ev)-5 b(aluate)32 b(an)h(expression)e(and)i(write)e(the)i(result)f +(either)g(to)i(a)f(column)e(\(if)h(the)h(expression)e(is)h(a)h +(function)227 4401 y(of)d(other)g(columns)f(in)f(the)i(table\))g(or)g +(to)g(a)h(k)m(eyw)m(ord)f(\(if)f(the)h(expression)e(ev)-5 +b(aluates)31 b(to)f(a)g(constan)m(t)i(and)227 4514 y(is)e(not)g(a)h +(function)e(of)i(other)f(columns)g(in)f(the)h(table\).)41 +b(In)30 b(the)h(former)e(case,)j(the)f(parName)f(parameter)227 +4627 y(is)39 b(the)h(name)f(of)h(the)g(column)e(\(whic)m(h)h(ma)m(y)h +(or)f(ma)m(y)h(not)g(already)f(exist\))h(in)m(to)f(whic)m(h)g(to)h +(write)f(the)227 4739 y(results,)e(and)g(parInfo)e(con)m(tains)i(an)g +(optional)e(TF)m(ORM)i(k)m(eyw)m(ord)g(v)-5 b(alue)37 +b(if)e(a)i(new)f(column)g(is)f(b)s(eing)227 4852 y(created.)42 +b(If)28 b(a)h(TF)m(ORM)h(v)-5 b(alue)28 b(is)g(not)h(sp)s(eci\014ed)f +(then)g(a)i(default)e(format)h(will)e(b)s(e)h(used,)h(dep)s(ending)d +(on)227 4965 y(the)35 b(expression.)53 b(If)34 b(the)h(expression)e(ev) +-5 b(aluates)36 b(to)f(a)g(constan)m(t,)i(then)e(the)g(result)e(will)f +(b)s(e)i(written)g(to)227 5078 y(the)28 b(k)m(eyw)m(ord)g(name)f(giv)m +(en)g(b)m(y)h(the)f(parName)h(parameter,)h(and)d(the)i(parInfo)e +(parameter)i(ma)m(y)g(b)s(e)f(used)227 5191 y(to)k(supply)d(an)i +(optional)g(commen)m(t)h(for)f(the)g(k)m(eyw)m(ord.)42 +b(If)29 b(the)i(k)m(eyw)m(ord)g(do)s(es)f(not)g(already)g(exist,)g +(then)227 5304 y(the)g(name)f(of)h(the)g(k)m(eyw)m(ord)g(m)m(ust)f(b)s +(e)g(preceded)g(with)f(a)i('#')f(c)m(haracter,)j(otherwise)d(the)g +(result)g(will)e(b)s(e)227 5417 y(written)j(to)h(a)g(column)e(with)g +(that)i(name.)430 5694 y Fe(FTCALC\(inunit,)43 b(expr,)k(outunit,)e +(parName,)h(parInfo,)f(>)j(status\))p eop +%%Page: 98 104 +98 103 bop 0 299 a Fi(98)1319 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fh(6)81 b Fi(This)37 b(calculator)j(routine)f(is)f(similar)f(to)j +(the)g(previous)e(routine,)j(except)g(that)f(the)g(expression)e(is)h +(only)227 668 y(ev)-5 b(aluated)41 b(o)m(v)m(er)g(the)f(sp)s(eci\014ed) +f(ro)m(w)h(ranges.)70 b(nranges)39 b(sp)s(eci\014es)g(the)h(n)m(um)m(b) +s(er)f(of)h(ro)m(w)h(ranges,)i(and)227 781 y(\014rstro)m(w)30 +b(and)g(lastro)m(w)g(giv)m(e)h(the)g(starting)f(and)g(ending)f(ro)m(w)h +(n)m(um)m(b)s(er)f(of)i(eac)m(h)g(range.)430 1031 y Fe +(FTCALC_RNG\(inunit,)42 b(expr,)47 b(outunit,)e(parName,)h(parInfo,)573 +1144 y(nranges,)f(firstrow,)h(lastrow,)f(>)j(status\))0 +1394 y Fh(7)81 b Fi(Ev)-5 b(aluate)30 b(the)h(giv)m(en)f(expression)f +(and)h(return)f(information)g(on)h(the)h(result.)430 +1643 y Fe(FTTEXP\(unit,)44 b(expr,)i(>)i(datatype,)d(nelem,)h(naxis,)g +(naxes,)g(status\))0 1976 y Fd(9.9)135 b(Celestial)48 +b(Co)t(ordinate)e(System)f(Subroutines)0 2226 y Fi(The)36 +b(FITS)g(comm)m(unit)m(y)g(has)g(adopted)h(a)g(set)g(of)g(k)m(eyw)m +(ord)g(con)m(v)m(en)m(tions)g(that)g(de\014ne)f(the)h(transformations)0 +2339 y(needed)30 b(to)i(con)m(v)m(ert)g(b)s(et)m(w)m(een)f(pixel)e(lo)s +(cations)h(in)f(an)i(image)g(and)f(the)g(corresp)s(onding)f(celestial)h +(co)s(ordinates)0 2452 y(on)25 b(the)h(sky)-8 b(,)27 +b(or)e(more)g(generally)-8 b(,)27 b(that)f(de\014ne)e(w)m(orld)g(co)s +(ordinates)i(that)f(are)h(to)g(b)s(e)f(asso)s(ciated)h(with)e(an)m(y)i +(pixel)0 2564 y(lo)s(cation)34 b(in)f(an)i(n-dimensional)c(FITS)j(arra) +m(y)-8 b(.)54 b(CFITSIO)33 b(is)g(distributed)f(with)h(a)i(couple)e(of) +i(self-con)m(tained)0 2677 y(W)-8 b(orld)27 b(Co)s(ordinate)f(System)g +(\(W)m(CS\))i(routines,)f(ho)m(w)m(ev)m(er,)i(these)f(routines)e(DO)h +(NOT)f(supp)s(ort)f(all)h(the)h(latest)0 2790 y(W)m(CS)38 +b(con)m(v)m(en)m(tions,)j(so)e(it)f(is)f(STR)m(ONGL)-8 +b(Y)38 b(RECOMMENDED)h(that)f(soft)m(w)m(are)i(dev)m(elop)s(ers)d(use)h +(a)h(more)0 2903 y(robust)30 b(external)g(W)m(CS)g(library)-8 +b(.)39 b(Sev)m(eral)30 b(recommended)g(libraries)e(are:)95 +3153 y Fe(WCSLIB)47 b(-)95 b(supported)45 b(by)i(Mark)g(Calabretta)95 +3266 y(WCSTools)f(-)h(supported)f(by)h(Doug)g(Mink)95 +3379 y(AST)g(library)f(-)i(developed)d(by)i(the)g(U.K.)g(Starlink)e +(project)0 3629 y Fi(More)30 b(information)d(ab)s(out)i(the)g(W)m(CS)g +(k)m(eyw)m(ord)h(con)m(v)m(en)m(tions)g(and)e(links)f(to)j(all)e(of)h +(these)g(W)m(CS)g(libraries)e(can)0 3742 y(b)s(e)j(found)f(on)h(the)h +(FITS)e(Supp)s(ort)g(O\016ce)h(w)m(eb)g(site)h(at)g(h)m +(ttp://\014ts.gsfc.nasa.go)m(v)j(under)29 b(the)h(W)m(CS)h(link.)0 +3902 y(The)i(functions)g(pro)m(vided)g(in)f(these)j(external)e(W)m(CS)h +(libraries)e(will)f(need)j(access)h(to)g(the)f(W)m(CS)g(information)0 +4015 y(con)m(tained)g(in)e(the)i(FITS)f(\014le)g(headers.)51 +b(One)33 b(con)m(v)m(enien)m(t)i(w)m(a)m(y)g(to)f(pass)g(this)e +(information)g(to)j(the)f(extermal)0 4128 y(library)j(is)i(to)i(use)e +(FITSIO)g(to)h(cop)m(y)h(the)f(header)f(k)m(eyw)m(ords)h(in)m(to)g(one) +g(long)f(c)m(haracter)j(string,)f(and)e(then)0 4240 y(pass)29 +b(this)g(string)g(to)h(an)g(in)m(terface)g(routine)f(in)g(the)h +(external)f(library)f(that)i(will)d(extract)32 b(the)e(necessary)g(W)m +(CS)0 4353 y(information)f(\(e.g.,)j(see)f(the)f(astFitsChan)g(and)g +(astPutCards)g(routines)f(in)g(the)i(Starlink)d(AST)i(library\).)0 +4514 y(The)24 b(follo)m(wing)g(FITSIO)f(routines)h(DO)h(NOT)f(supp)s +(ort)f(the)i(more)g(recen)m(t)h(W)m(CS)f(con)m(v)m(en)m(tions)h(that)g +(ha)m(v)m(e)g(b)s(een)0 4626 y(appro)m(v)m(ed)37 b(as)h(part)f(of)g +(the)h(FITS)e(standard.)61 b(Consequen)m(tly)-8 b(,)38 +b(the)g(follo)m(wing)d(routines)i(ARE)g(NO)m(W)h(DEP-)0 +4739 y(RECA)-8 b(TED.)29 b(It)f(is)g(STR)m(ONGL)-8 b(Y)28 +b(RECOMMENDED)h(that)g(soft)m(w)m(are)h(dev)m(elop)s(ers)e(not)h(use)f +(these)h(routines,)0 4852 y(and)h(instead)f(use)h(an)h(external)f(W)m +(CS)g(library)-8 b(,)29 b(as)i(describ)s(ed)d(ab)s(o)m(v)m(e.)0 +5012 y(These)21 b(routines)f(are)h(included)d(mainly)h(for)i(bac)m(kw)m +(ard)g(compatibilit)m(y)f(with)f(existing)h(soft)m(w)m(are.)39 +b(They)21 b(supp)s(ort)0 5125 y(the)30 b(follo)m(wing)f(standard)g(map) +g(pro)5 b(jections:)40 b(-SIN,)30 b(-T)-8 b(AN,)31 b(-AR)m(C,)g(-NCP)-8 +b(,)30 b(-GLS,)g(-MER,)h(and)e(-AIT)h(\(these)0 5238 +y(are)f(the)g(legal)f(v)-5 b(alues)28 b(for)g(the)h(co)s(ordt)m(yp)s(e) +f(parameter\).)41 b(These)28 b(routines)g(are)h(based)f(on)g(similar)e +(functions)h(in)0 5351 y(Classic)i(AIPS.)h(All)f(the)i(angular)e(quan)m +(tities)h(are)h(giv)m(en)f(in)f(units)g(of)h(degrees.)0 +5601 y Fh(1)81 b Fi(Get)22 b(the)g(v)-5 b(alues)20 b(of)i(all)e(the)i +(standard)f(FITS)f(celestial)h(co)s(ordinate)h(system)f(k)m(eyw)m(ords) +h(from)f(the)h(header)f(of)h(a)227 5714 y(FITS)j(image)h(\(i.e.,)h(the) +e(primary)f(arra)m(y)i(or)f(an)h(image)f(extension\).)39 +b(These)26 b(v)-5 b(alues)24 b(ma)m(y)i(then)g(b)s(e)e(passed)p +eop +%%Page: 99 105 +99 104 bop 0 299 a Fg(9.10.)73 b(FILE)30 b(CHECKSUM)f(SUBR)m(OUTINES) +2080 b Fi(99)227 555 y(to)39 b(the)e(subroutines)f(that)i(p)s(erform)e +(the)i(co)s(ordinate)f(transformations.)62 b(If)37 b(an)m(y)h(or)g(all) +e(of)i(the)g(W)m(CS)227 668 y(k)m(eyw)m(ords)32 b(are)f(not)g(presen)m +(t,)h(then)f(default)f(v)-5 b(alues)30 b(will)f(b)s(e)h(returned.)41 +b(If)31 b(the)g(\014rst)g(co)s(ordinate)f(axis)h(is)227 +781 y(the)e(declination-lik)m(e)e(co)s(ordinate,)i(then)f(this)f +(routine)h(will)e(sw)m(ap)i(them)h(so)g(that)g(the)g(longitudinal-lik)m +(e)227 894 y(co)s(ordinate)h(is)g(returned)f(as)i(the)f(\014rst)g +(axis.)227 1045 y(If)35 b(the)h(\014le)e(uses)h(the)g(new)m(er)h('CDj)p +1454 1045 28 4 v 32 w(i')f(W)m(CS)g(transformation)g(matrix)g(k)m(eyw)m +(ords)g(instead)g(of)g(old)g(st)m(yle)227 1158 y('CDEL)-8 +b(Tn')37 b(and)f('CR)m(OT)-8 b(A2')38 b(k)m(eyw)m(ords,)h(then)e(this)e +(routine)h(will)e(calculate)k(and)e(return)g(the)h(v)-5 +b(alues)227 1271 y(of)33 b(the)g(equiv)-5 b(alen)m(t)33 +b(old-st)m(yle)f(k)m(eyw)m(ords.)49 b(Note)34 b(that)g(the)f(con)m(v)m +(ersion)g(from)f(the)i(new-st)m(yle)f(k)m(eyw)m(ords)227 +1383 y(to)f(the)f(old-st)m(yle)f(v)-5 b(alues)30 b(is)g(sometimes)g +(only)g(an)h(appro)m(ximation,)f(so)g(if)g(the)h(appro)m(ximation)f(is) +f(larger)227 1496 y(than)37 b(an)h(in)m(ternally)d(de\014ned)h +(threshold)g(lev)m(el,)j(then)e(CFITSIO)f(will)f(still)g(return)h(the)i +(appro)m(ximate)227 1609 y(W)m(CS)f(k)m(eyw)m(ord)g(v)-5 +b(alues,)38 b(but)e(will)e(also)j(return)e(with)h(status)h(=)f(506,)k +(to)e(w)m(arn)e(the)h(calling)e(program)227 1722 y(that)30 +b(appro)m(ximations)d(ha)m(v)m(e)j(b)s(een)e(made.)40 +b(It)29 b(is)f(then)g(up)g(to)h(the)g(calling)f(program)g(to)h(decide)g +(whether)227 1835 y(the)34 b(appro)m(ximations)e(are)i(su\016cien)m +(tly)e(accurate)k(for)d(the)h(particular)d(application,)i(or)h(whether) +f(more)227 1948 y(precise)d(W)m(CS)g(transformations)g(m)m(ust)g(b)s(e) +g(p)s(erformed)f(using)g(new-st)m(yle)h(W)m(CS)h(k)m(eyw)m(ords)f +(directly)-8 b(.)382 2209 y Fe(FTGICS\(unit,)44 b(>)k +(xrval,yrval,xrpix,yrpix)o(,xin)o(c,yi)o(nc,)o(rot,)o(coor)o(dty)o +(pe,s)o(tatu)o(s\))0 2470 y Fh(2)81 b Fi(Get)34 b(the)f(v)-5 +b(alues)32 b(of)h(all)f(the)h(standard)f(FITS)h(celestial)f(co)s +(ordinate)h(system)g(k)m(eyw)m(ords)g(from)g(the)g(header)227 +2583 y(of)j(a)h(FITS)e(table)g(where)h(the)g(X)g(and)f(Y)h(\(or)g(RA)g +(and)g(DEC)f(co)s(ordinates)h(are)g(stored)g(in)f(2)h(separate)227 +2695 y(columns)31 b(of)h(the)g(table.)45 b(These)31 b(v)-5 +b(alues)31 b(ma)m(y)i(then)e(b)s(e)h(passed)f(to)h(the)g(subroutines)e +(that)i(p)s(erform)f(the)227 2808 y(co)s(ordinate)f(transformations.) +382 3069 y Fe(FTGTCS\(unit,xcol,ycol,)42 b(>)716 3182 +y(xrval,yrval,xrpix,yrpix,)o(xinc)o(,yi)o(nc,r)o(ot,c)o(oor)o(dtyp)o +(e,st)o(atu)o(s\))0 3443 y Fh(3)81 b Fi(Calculate)40 +b(the)i(celestial)e(co)s(ordinate)h(corresp)s(onding)e(to)j(the)f +(input)e(X)i(and)g(Y)g(pixel)e(lo)s(cation)i(in)f(the)227 +3556 y(image.)382 3817 y Fe(FTWLDP\(xpix,ypix,xrval,y)o(rva)o(l,xr)o +(pix,)o(yrp)o(ix,x)o(inc,)o(yin)o(c,ro)o(t,)1241 3929 +y(coordtype,)45 b(>)i(xpos,ypos,status\))0 4190 y Fh(4)81 +b Fi(Calculate)40 b(the)i(X)f(and)f(Y)h(pixel)f(lo)s(cation)g(corresp)s +(onding)f(to)j(the)f(input)e(celestial)i(co)s(ordinate)g(in)f(the)227 +4303 y(image.)382 4564 y Fe(FTXYPX\(xpos,ypos,xrval,y)o(rva)o(l,xr)o +(pix,)o(yrp)o(ix,x)o(inc,)o(yin)o(c,ro)o(t,)1241 4677 +y(coordtype,)45 b(>)i(xpix,ypix,status\))0 5012 y Fd(9.10)136 +b(File)45 b(Chec)l(ksum)g(Subroutines)0 5262 y Fi(The)33 +b(follo)m(wing)e(routines)h(either)h(compute)g(or)h(v)-5 +b(alidate)32 b(the)i(c)m(hec)m(ksums)f(for)g(the)h(CHDU.)g(The)e(D)m(A) +-8 b(T)g(ASUM)0 5375 y(k)m(eyw)m(ord)33 b(is)e(used)g(to)i(store)f(the) +h(n)m(umerical)d(v)-5 b(alue)32 b(of)g(the)g(32-bit,)h(1's)g(complemen) +m(t)f(c)m(hec)m(ksum)h(for)f(the)g(data)0 5488 y(unit)25 +b(alone.)39 b(If)25 b(there)h(is)g(no)f(data)i(unit)e(then)g(the)h(v)-5 +b(alue)26 b(is)f(set)h(to)h(zero.)40 b(The)26 b(n)m(umerical)e(v)-5 +b(alue)26 b(is)f(stored)h(as)g(an)0 5601 y(ASCI)s(I)20 +b(string)h(of)i(digits,)f(enclosed)g(in)e(quotes,)25 +b(b)s(ecause)d(the)g(v)-5 b(alue)22 b(ma)m(y)g(b)s(e)f(to)s(o)i(large)f +(to)h(represen)m(t)f(as)g(a)h(32-bit)0 5714 y(signed)k(in)m(teger.)40 +b(The)27 b(CHECKSUM)g(k)m(eyw)m(ord)i(is)e(used)g(to)h(store)h(the)f +(ASCI)s(I)e(enco)s(ded)i(COMPLEMENT)f(of)p eop +%%Page: 100 106 +100 105 bop 0 299 a Fi(100)1274 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fi(the)c(c)m(hec)m(ksum)h(for)f(the)h(en)m(tire)f(HDU.)h(Storing) +e(the)i(complemen)m(t,)g(rather)f(than)g(the)h(actual)f(c)m(hec)m +(ksum,)i(forces)0 668 y(the)k(c)m(hec)m(ksum)h(for)f(the)h(whole)e(HDU) +i(to)g(equal)f(zero.)47 b(If)31 b(the)i(\014le)e(has)h(b)s(een)f(mo)s +(di\014ed)f(since)i(the)g(c)m(hec)m(ksums)0 781 y(w)m(ere)39 +b(computed,)i(then)e(the)g(HDU)g(c)m(hec)m(ksum)h(will)c(usually)g(not) +j(equal)g(zero.)66 b(These)39 b(c)m(hec)m(ksum)g(k)m(eyw)m(ord)0 +894 y(con)m(v)m(en)m(tions)33 b(are)g(based)f(on)g(a)g(pap)s(er)f(b)m +(y)h(Rob)g(Seaman)g(published)d(in)i(the)h(pro)s(ceedings)f(of)h(the)h +(AD)m(ASS)f(IV)0 1007 y(conference)f(in)e(Baltimore)h(in)g(No)m(v)m(em) +m(b)s(er)h(1994)h(and)e(a)h(later)f(revision)f(in)g(June)g(1995.)0 +1237 y Fh(1)81 b Fi(Compute)33 b(and)g(write)g(the)h(D)m(A)-8 +b(T)g(ASUM)35 b(and)e(CHECKSUM)g(k)m(eyw)m(ord)h(v)-5 +b(alues)33 b(for)g(the)h(CHDU)g(in)m(to)g(the)227 1350 +y(curren)m(t)25 b(header.)38 b(The)24 b(D)m(A)-8 b(T)g(ASUM)27 +b(v)-5 b(alue)24 b(is)f(the)i(32-bit)g(c)m(hec)m(ksum)g(for)f(the)h +(data)g(unit,)g(expressed)f(as)h(a)227 1463 y(decimal)30 +b(in)m(teger)g(enclosed)g(in)f(single)g(quotes.)41 b(The)30 +b(CHECKSUM)g(k)m(eyw)m(ord)g(v)-5 b(alue)30 b(is)f(a)i(16-c)m(haracter) +227 1576 y(string)i(whic)m(h)f(is)h(the)g(ASCI)s(I-enco)s(ded)f(v)-5 +b(alue)33 b(for)h(the)f(complemen)m(t)h(of)g(the)f(c)m(hec)m(ksum)i +(for)e(the)h(whole)227 1689 y(HDU.)h(If)e(these)g(k)m(eyw)m(ords)h +(already)f(exist,)h(their)e(v)-5 b(alues)33 b(will)e(b)s(e)i(up)s +(dated)f(only)g(if)g(necessary)i(\(i.e.,)h(if)227 1802 +y(the)c(\014le)e(has)h(b)s(een)g(mo)s(di\014ed)e(since)i(the)h +(original)d(k)m(eyw)m(ord)j(v)-5 b(alues)30 b(w)m(ere)h(computed\).)382 +2033 y Fe(FTPCKS\(unit,)44 b(>)k(status\))0 2263 y Fh(2)81 +b Fi(Up)s(date)28 b(the)h(CHECKSUM)e(k)m(eyw)m(ord)i(v)-5 +b(alue)28 b(in)f(the)i(CHDU,)g(assuming)e(that)i(the)f(D)m(A)-8 +b(T)g(ASUM)30 b(k)m(eyw)m(ord)227 2376 y(exists)35 b(and)g(already)g +(has)g(the)h(correct)g(v)-5 b(alue.)55 b(This)34 b(routine)g +(calculates)i(the)g(new)f(c)m(hec)m(ksum)h(for)f(the)227 +2489 y(curren)m(t)40 b(header)g(unit,)i(adds)d(it)h(to)h(the)f(data)h +(unit)e(c)m(hec)m(ksum,)44 b(enco)s(des)c(the)g(v)-5 +b(alue)40 b(in)m(to)g(an)g(ASCI)s(I)227 2602 y(string,)30 +b(and)g(writes)f(the)i(string)e(to)i(the)g(CHECKSUM)e(k)m(eyw)m(ord.) +382 2833 y Fe(FTUCKS\(unit,)44 b(>)k(status\))0 3063 +y Fh(3)81 b Fi(V)-8 b(erify)34 b(the)g(CHDU)h(b)m(y)g(computing)e(the)i +(c)m(hec)m(ksums)g(and)f(comparing)g(them)g(with)f(the)i(k)m(eyw)m +(ords.)53 b(The)227 3176 y(data)34 b(unit)e(is)g(v)m(eri\014ed)g +(correctly)h(if)f(the)i(computed)f(c)m(hec)m(ksum)g(equals)g(the)g(v)-5 +b(alue)33 b(of)g(the)g(D)m(A)-8 b(T)g(ASUM)227 3289 y(k)m(eyw)m(ord.)64 +b(The)37 b(c)m(hec)m(ksum)i(for)f(the)g(en)m(tire)f(HDU)i(\(header)f +(plus)e(data)j(unit\))d(is)h(correct)i(if)e(it)h(equals)227 +3402 y(zero.)55 b(The)34 b(output)g(D)m(A)-8 b(T)g(A)m(OK)37 +b(and)d(HDUOK)h(parameters)g(in)e(this)h(subroutine)e(are)j(in)m +(tegers)g(whic)m(h)227 3515 y(will)24 b(ha)m(v)m(e)j(a)f(v)-5 +b(alue)26 b(=)g(1)g(if)f(the)i(data)f(or)g(HDU)h(is)e(v)m(eri\014ed)h +(correctly)-8 b(,)28 b(a)e(v)-5 b(alue)26 b(=)f(0)i(if)e(the)h(D)m(A)-8 +b(T)g(ASUM)28 b(or)227 3628 y(CHECKSUM)h(k)m(eyw)m(ord)g(is)g(not)g +(presen)m(t,)h(or)f(v)-5 b(alue)29 b(=)g(-1)h(if)e(the)i(computed)f(c)m +(hec)m(ksum)h(is)e(not)i(correct.)382 3858 y Fe(FTVCKS\(unit,)44 +b(>)k(dataok,hduok,status\))0 4089 y Fh(4)81 b Fi(Compute)25 +b(and)h(return)f(the)i(c)m(hec)m(ksum)g(v)-5 b(alues)25 +b(for)h(the)h(CHDU)f(\(as)h(double)e(precision)g(v)-5 +b(ariables\))25 b(without)227 4202 y(creating)45 b(or)f(mo)s(difying)e +(the)j(CHECKSUM)e(and)h(D)m(A)-8 b(T)g(ASUM)46 b(k)m(eyw)m(ords.)83 +b(This)43 b(routine)g(is)h(used)227 4315 y(in)m(ternally)29 +b(b)m(y)h(FTV)m(CKS,)g(but)g(ma)m(y)h(b)s(e)e(useful)g(in)g(other)i +(situations)e(as)h(w)m(ell.)382 4545 y Fe(FTGCKS\(unit,)44 +b(>)k(datasum,hdusum,status\))0 4776 y Fh(5)81 b Fi(Enco)s(de)33 +b(a)h(c)m(hec)m(ksum)h(v)-5 b(alue)33 b(\(stored)h(in)f(a)h(double)f +(precision)f(v)-5 b(ariable\))33 b(in)m(to)g(a)i(16-c)m(haracter)h +(string.)50 b(If)227 4889 y(COMPLEMENT)30 b(=)g(.true.)41 +b(then)30 b(the)g(32-bit)h(sum)e(v)-5 b(alue)30 b(will)e(b)s(e)i +(complemen)m(ted)g(b)s(efore)g(enco)s(ding.)382 5120 +y Fe(FTESUM\(sum,complement,)42 b(>)47 b(checksum\))0 +5350 y Fh(6)81 b Fi(Deco)s(de)39 b(a)f(16)h(c)m(haracter)h(c)m(hec)m +(ksum)e(string)f(in)m(to)h(a)h(double)d(precision)g(v)-5 +b(alue.)64 b(If)37 b(COMPLEMENT)g(=)227 5463 y(.true.)k(then)30 +b(the)h(32-bit)f(sum)g(v)-5 b(alue)30 b(will)d(b)s(e)j(complemen)m(ted) +h(after)f(deco)s(ding.)382 5694 y Fe(FTDSUM\(checksum,compleme)o(nt,)41 +b(>)48 b(sum\))p eop +%%Page: 101 107 +101 106 bop 0 299 a Fg(9.11.)113 b(D)m(A)-8 b(TE)31 b(AND)g(TIME)f +(UTILITY)g(R)m(OUTINES)1767 b Fi(101)0 555 y Fd(9.11)180 +b(Date)46 b(and)f(Time)g(Utilit)l(y)i(Routines)0 805 +y Fi(The)29 b(follo)m(wing)f(routines)h(help)f(to)j(construct)f(or)f +(parse)h(the)g(FITS)f(date/time)h(strings.)40 b(Starting)29 +b(in)f(the)i(y)m(ear)0 918 y(2000,)k(the)d(FITS)g(D)m(A)-8 +b(TE)32 b(k)m(eyw)m(ord)g(v)-5 b(alues)30 b(\(and)i(the)f(v)-5 +b(alues)31 b(of)g(other)h(`D)m(A)-8 b(TE-')33 b(k)m(eyw)m(ords\))f(m)m +(ust)f(ha)m(v)m(e)i(the)0 1031 y(form)j('YYYY-MM-DD')k(\(date)e(only\)) +e(or)h('YYYY-MM-DDThh:mm:ss.ddd...')61 b(\(date)38 b(and)e(time\))g +(where)0 1144 y(the)30 b(n)m(um)m(b)s(er)f(of)i(decimal)e(places)h(in)f +(the)h(seconds)g(v)-5 b(alue)30 b(is)f(optional.)40 b(These)30 +b(times)g(are)g(in)f(UTC.)h(The)g(older)0 1257 y('dd/mm/yy')g(date)h +(format)g(ma)m(y)g(not)g(b)s(e)e(used)h(for)g(dates)h(after)g(01)g(Jan) +m(uary)f(2000.)0 1486 y Fh(1)81 b Fi(Get)31 b(the)g(curren)m(t)f +(system)g(date.)42 b(The)29 b(returned)h(y)m(ear)h(has)f(4)h(digits)e +(\(1999,)j(2000,)h(etc.\))382 1714 y Fe(FTGSDT\()46 b(>)h(day,)g +(month,)f(year,)g(status)g(\))0 1943 y Fh(2)81 b Fi(Get)34 +b(the)g(curren)m(t)g(system)f(date)i(and)e(time)g(string)g +(\('YYYY-MM-DDThh:mm:ss'\).)53 b(The)33 b(time)h(will)d(b)s(e)227 +2056 y(in)25 b(UTC/GMT)h(if)f(a)m(v)-5 b(ailable,)26 +b(as)h(indicated)d(b)m(y)i(a)g(returned)f(timeref)g(v)-5 +b(alue)26 b(=)f(0.)40 b(If)26 b(the)g(returned)e(v)-5 +b(alue)227 2169 y(of)31 b(timeref)f(=)h(1)g(then)f(this)g(indicates)f +(that)j(it)e(w)m(as)h(not)g(p)s(ossible)d(to)j(con)m(v)m(ert)i(the)d +(lo)s(cal)g(time)h(to)g(UTC,)227 2281 y(and)f(th)m(us)g(the)h(lo)s(cal) +e(time)h(w)m(as)h(returned.)382 2510 y Fe(FTGSTM\(>)45 +b(datestr,)h(timeref,)f(status\))0 2739 y Fh(3)81 b Fi(Construct)26 +b(a)i(date)g(string)e(from)h(the)g(input)e(date)j(v)-5 +b(alues.)39 b(If)27 b(the)g(y)m(ear)h(is)f(b)s(et)m(w)m(een)g(1900)i +(and)e(1998,)j(inclu-)227 2852 y(siv)m(e,)37 b(then)d(the)i(returned)d +(date)j(string)e(will)e(ha)m(v)m(e)37 b(the)e(old)f(FITS)g(format)i +(\('dd/mm/yy'\),)h(otherwise)227 2964 y(the)32 b(date)g(string)e(will)e +(ha)m(v)m(e)33 b(the)e(new)g(FITS)g(format)g(\('YYYY-MM-DD'\).)36 +b(Use)c(FTTM2S)f(instead)f(to)227 3077 y(alw)m(a)m(ys)h(return)e(a)i +(date)g(string)f(using)e(the)j(new)f(FITS)g(format.)382 +3306 y Fe(FTDT2S\()46 b(year,)g(month,)g(day,)h(>)g(datestr,)f +(status\))0 3535 y Fh(4)81 b Fi(Construct)34 b(a)i(new-format)f(date)h +(+)f(time)g(string)f(\('YYYY-MM-DDThh:mm:ss.ddd...'\).)57 +b(If)34 b(the)i(y)m(ear,)227 3647 y(mon)m(th,)d(and)e(da)m(y)h(v)-5 +b(alues)31 b(all)g(=)g(0)h(then)g(only)f(the)h(time)f(is)g(enco)s(ded)g +(with)g(format)h('hh:mm:ss.ddd...'.)227 3760 y(The)j(decimals)f +(parameter)i(sp)s(eci\014es)d(ho)m(w)j(man)m(y)f(decimal)f(places)h(of) +g(fractional)g(seconds)g(to)h(include)227 3873 y(in)29 +b(the)i(string.)40 b(If)29 b(`decimals')h(is)g(negativ)m(e,)h(then)g +(only)e(the)i(date)g(will)c(b)s(e)j(return)f(\('YYYY-MM-DD'\).)382 +4102 y Fe(FTTM2S\()46 b(year,)g(month,)g(day,)h(hour,)f(minute,)g +(second,)g(decimals,)764 4215 y(>)h(datestr,)f(status\))0 +4443 y Fh(5)81 b Fi(Return)44 b(the)g(date)i(as)f(read)f(from)h(the)g +(input)d(string,)48 b(where)c(the)h(string)f(ma)m(y)h(b)s(e)f(in)g +(either)g(the)h(old)227 4556 y(\('dd/mm/yy'\))31 b(or)g(new)e +(\('YYYY-MM-DDThh:mm:ss')k(or)d('YYYY-MM-DD'\))k(FITS)c(format.)382 +4785 y Fe(FTS2DT\(datestr,)43 b(>)48 b(year,)e(month,)g(day,)h +(status\))0 5013 y Fh(6)81 b Fi(Return)30 b(the)h(date)h(and)f(time)g +(as)g(read)g(from)g(the)h(input)d(string,)h(where)h(the)h(string)e(ma)m +(y)i(b)s(e)e(in)g(either)h(the)227 5126 y(old)d(or)g(new)g(FITS)g +(format.)40 b(The)28 b(returned)f(hours,)h(min)m(utes,)g(and)g(seconds) +g(v)-5 b(alues)28 b(will)d(b)s(e)j(set)h(to)g(zero)227 +5239 y(if)j(the)i(input)d(string)h(do)s(es)h(not)h(include)d(the)i +(time)g(\('dd/mm/yy')g(or)h('YYYY-MM-DD'\))j(.)c(Similarly)-8 +b(,)227 5352 y(the)36 b(returned)e(y)m(ear,)j(mon)m(th,)g(and)d(date)i +(v)-5 b(alues)35 b(will)d(b)s(e)j(set)h(to)g(zero)g(if)e(the)h(date)h +(is)e(not)i(included)c(in)227 5465 y(the)f(input)d(string)i +(\('hh:mm:ss.ddd...'\).)382 5694 y Fe(FTS2TM\(datestr,)43 +b(>)48 b(year,)e(month,)g(day,)h(hour,)f(minute,)g(second,)g(status\))p +eop +%%Page: 102 108 +102 107 bop 0 299 a Fi(102)1274 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fd(9.12)136 b(General)45 b(Utilit)l(y)i(Subroutines)0 +805 y Fi(The)30 b(follo)m(wing)f(utilit)m(y)f(subroutines)h(ma)m(y)i(b) +s(e)e(useful)g(for)h(certain)g(applications:)0 1060 y +Fh(1)81 b Fi(Return)29 b(the)i(starting)f(b)m(yte)h(address)e(of)i(the) +f(CHDU)h(and)f(the)h(next)f(HDU.)382 1315 y Fe(FTGHAD\(iunit,)44 +b(>)j(curaddr,nextaddr\))0 1569 y Fh(2)81 b Fi(Con)m(v)m(ert)31 +b(a)g(c)m(haracter)h(string)d(to)i(upp)s(ercase)e(\(op)s(erates)j(in)d +(place\).)382 1824 y Fe(FTUPCH\(string\))0 2078 y Fh(3)81 +b Fi(Compare)43 b(the)i(input)d(template)i(string)f(against)h(the)h +(reference)f(string)f(to)i(see)g(if)e(they)h(matc)m(h.)82 +b(The)227 2191 y(template)35 b(string)f(ma)m(y)h(con)m(tain)f(wildcard) +e(c)m(haracters:)51 b('*')35 b(will)d(matc)m(h)j(an)m(y)g(sequence)g +(of)f(c)m(haracters)227 2304 y(\(including)f(zero)j(c)m(haracters\))h +(and)e('reference)h(string.)55 b(If)35 b(CASESN)f(=)h(.true.)56 +b(then)35 b(the)g(matc)m(h)i(will)227 2417 y(b)s(e)29 +b(case)h(sensitiv)m(e.)40 b(The)29 b(returned)f(MA)-8 +b(TCH)30 b(parameter)g(will)d(b)s(e)h(.true.)41 b(if)28 +b(the)i(2)g(strings)e(matc)m(h,)j(and)227 2530 y(EXA)m(CT)i(will)e(b)s +(e)h(.true.)49 b(if)32 b(the)i(matc)m(h)g(is)e(exact)i(\(i.e.,)h(if)d +(no)h(wildcard)e(c)m(haracters)j(w)m(ere)g(used)e(in)g(the)227 +2643 y(matc)m(h\).)42 b(Both)31 b(strings)e(m)m(ust)i(b)s(e)e(68)j(c)m +(haracters)f(or)g(less)f(in)f(length.)382 2898 y Fe +(FTCMPS\(str_template,stri)o(ng,)o(case)o(sen,)41 b(>)47 +b(match,exact\))0 3152 y Fh(4)81 b Fi(T)-8 b(est)31 b(that)g(the)f(k)m +(eyw)m(ord)h(name)f(con)m(tains)h(only)e(legal)i(c)m(haracters:)42 +b(A-Z,0-9,)32 b(h)m(yphen,)d(and)h(underscore.)382 3407 +y Fe(FTTKEY\(keyword,)43 b(>)48 b(status\))0 3662 y Fh(5)81 +b Fi(T)-8 b(est)31 b(that)g(the)f(k)m(eyw)m(ord)h(record)f(con)m(tains) +h(only)e(legal)h(prin)m(table)f(ASCI)s(I)g(c)m(haracters)382 +3916 y Fe(FTTREC\(card,)44 b(>)k(status\))0 4171 y Fh(6)81 +b Fi(T)-8 b(est)25 b(whether)f(the)h(curren)m(t)f(header)h(con)m(tains) +f(an)m(y)h(NULL)g(\(ASCI)s(I)e(0\))j(c)m(haracters.)40 +b(These)24 b(c)m(haracters)j(are)227 4284 y(illegal)33 +b(in)g(the)i(header,)g(but)f(they)g(will)e(go)j(undetected)g(b)m(y)f +(most)h(of)g(the)f(CFITSIO)f(k)m(eyw)m(ord)i(header)227 +4397 y(routines,)28 b(b)s(ecause)g(the)h(n)m(ull)d(is)h(in)m(terpreted) +g(as)i(the)f(normal)f(end-of-string)h(terminator.)40 +b(This)26 b(routine)227 4509 y(returns)i(the)g(p)s(osition)f(of)i(the)g +(\014rst)f(n)m(ull)e(c)m(haracter)k(in)e(the)g(header,)h(or)g(zero)g +(if)f(there)h(are)g(no)f(n)m(ulls.)38 b(F)-8 b(or)227 +4622 y(example)36 b(a)g(returned)f(v)-5 b(alue)36 b(of)g(110)h(w)m +(ould)e(indicate)g(that)i(the)f(\014rst)f(NULL)h(is)f(lo)s(cated)h(in)f +(the)h(30th)227 4735 y(c)m(haracter)28 b(of)f(the)g(second)f(k)m(eyw)m +(ord)h(in)e(the)i(header)f(\(recall)g(that)h(eac)m(h)h(header)e(record) +h(is)e(80)i(c)m(haracters)227 4848 y(long\).)55 b(Note)36 +b(that)g(this)e(is)g(one)h(of)g(the)g(few)g(FITSIO)f(routines)g(in)f +(whic)m(h)h(the)h(returned)f(v)-5 b(alue)35 b(is)f(not)227 +4961 y(necessarily)c(equal)f(to)j(the)e(status)h(v)-5 +b(alue\).)382 5216 y Fe(FTNCHK\(unit,)44 b(>)k(status\))0 +5470 y Fh(7)81 b Fi(P)m(arse)27 b(a)f(header)h(k)m(eyw)m(ord)g(record)f +(and)g(return)f(the)i(name)f(of)h(the)f(k)m(eyw)m(ord)h(and)f(the)h +(length)e(of)i(the)g(name.)227 5583 y(The)34 b(k)m(eyw)m(ord)h(name)f +(normally)f(o)s(ccupies)g(the)i(\014rst)e(8)i(c)m(haracters)g(of)g(the) +f(record,)i(except)f(under)e(the)227 5696 y(HIERAR)m(CH)e(con)m(v)m(en) +m(tion)g(where)f(the)h(name)f(can)h(b)s(e)f(up)f(to)i(70)g(c)m +(haracters)h(in)d(length.)p eop +%%Page: 103 109 +103 108 bop 0 299 a Fg(9.12.)73 b(GENERAL)30 b(UTILITY)g(SUBR)m +(OUTINES)1934 b Fi(103)382 555 y Fe(FTGKNM\(card,)44 +b(>)k(keyname,)d(keylength,)g(status\))0 811 y Fh(8)81 +b Fi(P)m(arse)34 b(a)h(header)f(k)m(eyw)m(ord)h(record.)52 +b(This)32 b(subroutine)g(parses)i(the)g(input)f(header)h(record)g(to)h +(return)e(the)227 924 y(v)-5 b(alue)26 b(\(as)h(a)g(c)m(haracter)g +(string\))f(and)g(commen)m(t)h(strings.)38 b(If)26 b(the)g(k)m(eyw)m +(ord)h(has)f(no)g(v)-5 b(alue)26 b(\(columns)f(9-10)227 +1037 y(not)i(equal)e(to)i('=)f('\),)i(then)e(the)g(v)-5 +b(alue)26 b(string)f(is)g(returned)g(blank)g(and)g(the)h(commen)m(t)i +(string)d(is)g(set)h(equal)227 1150 y(to)31 b(column)f(9)g(-)h(80)g(of) +g(the)f(input)f(string.)382 1406 y Fe(FTPSVC\(card,)44 +b(>)k(value,comment,status\))0 1662 y Fh(9)81 b Fi(Construct)35 +b(a)i(sequence)f(k)m(eyw)m(ord)h(name)f(\(R)m(OOT)g(+)g(nnn\).)57 +b(This)34 b(subroutine)g(app)s(ends)g(the)j(sequence)227 +1775 y(n)m(um)m(b)s(er)29 b(to)i(the)g(ro)s(ot)g(string)e(to)i(create)h +(a)f(k)m(eyw)m(ord)g(name)f(\(e.g.,)i('NAXIS')f(+)f(2)h(=)f('NAXIS2'\)) +382 2032 y Fe(FTKEYN\(keyroot,seq_no,)42 b(>)47 b(keyword,status\))0 +2288 y Fh(10)f Fi(Construct)30 b(a)g(sequence)g(k)m(eyw)m(ord)h(name)f +(\(n)f(+)h(R)m(OOT\).)g(This)e(subroutine)g(concatenates)k(the)f +(sequence)227 2401 y(n)m(um)m(b)s(er)20 b(to)j(the)e(fron)m(t)h(of)g +(the)f(ro)s(ot)h(string)f(to)h(create)h(a)f(k)m(eyw)m(ord)g(name)g +(\(e.g.,)j(1)d(+)f('CTYP')g(=)g('1CTYP'\))382 2657 y +Fe(FTNKEY\(seq_no,keyroot,)42 b(>)47 b(keyword,status\))0 +2913 y Fh(11)f Fi(Determine)34 b(the)g(datat)m(yp)s(e)g(of)g(a)g(k)m +(eyw)m(ord)h(v)-5 b(alue)33 b(string.)49 b(This)32 b(subroutine)g +(parses)h(the)h(k)m(eyw)m(ord)g(v)-5 b(alue)227 3026 +y(string)30 b(\(usually)e(columns)h(11-30)k(of)d(the)h(header)f +(record\))g(to)i(determine)d(its)h(datat)m(yp)s(e.)382 +3282 y Fe(FTDTYP\(value,)44 b(>)j(dtype,status\))0 3538 +y Fh(11)f Fi(Return)c(the)i(class)f(of)g(input)e(header)i(record.)79 +b(The)43 b(record)g(is)f(classi\014ed)f(in)m(to)i(one)h(of)f(the)g +(follo)m(wing)227 3651 y(categories)35 b(\(the)f(class)e(v)-5 +b(alues)33 b(are)g(de\014ned)f(in)g(\014tsio.h\).)48 +b(Note)35 b(that)e(this)f(is)g(one)i(of)f(the)g(few)g(FITSIO)227 +3764 y(routines)d(that)g(do)s(es)h(not)f(return)f(a)i(status)g(v)-5 +b(alue.)334 4020 y Fe(Class)94 b(Value)619 b(Keywords)95 +4133 y(TYP_STRUC_KEY)92 b(10)j(SIMPLE,)46 b(BITPIX,)g(NAXIS,)g(NAXISn,) +g(EXTEND,)g(BLOCKED,)1002 4246 y(GROUPS,)g(PCOUNT,)g(GCOUNT,)g(END)1002 +4359 y(XTENSION,)g(TFIELDS,)f(TTYPEn,)h(TBCOLn,)g(TFORMn,)g(THEAP,)1002 +4472 y(and)h(the)g(first)f(4)i(COMMENT)e(keywords)f(in)i(the)g(primary) +f(array)1002 4585 y(that)h(define)f(the)h(FITS)g(format.)95 +4698 y(TYP_CMPRS_KEY)92 b(20)j(The)47 b(experimental)e(keywords)g(used) +i(in)g(the)g(compressed)1002 4811 y(image)g(format)f(ZIMAGE,)g +(ZCMPTYPE,)f(ZNAMEn,)h(ZVALn,)1002 4924 y(ZTILEn,)g(ZBITPIX,)g +(ZNAXISn,)f(ZSCALE,)h(ZZERO,)g(ZBLANK)95 5036 y(TYP_SCAL_KEY)140 +b(30)95 b(BSCALE,)46 b(BZERO,)g(TSCALn,)g(TZEROn)95 5149 +y(TYP_NULL_KEY)140 b(40)95 b(BLANK,)46 b(TNULLn)95 5262 +y(TYP_DIM_KEY)188 b(50)95 b(TDIMn)95 5375 y(TYP_RANG_KEY)140 +b(60)95 b(TLMINn,)46 b(TLMAXn,)g(TDMINn,)g(TDMAXn,)g(DATAMIN,)f +(DATAMAX)95 5488 y(TYP_UNIT_KEY)140 b(70)95 b(BUNIT,)46 +b(TUNITn)95 5601 y(TYP_DISP_KEY)140 b(80)95 b(TDISPn)95 +5714 y(TYP_HDUID_KEY)d(90)j(EXTNAME,)46 b(EXTVER,)g(EXTLEVEL,)f +(HDUNAME,)g(HDUVER,)h(HDULEVEL)p eop +%%Page: 104 110 +104 109 bop 0 299 a Fi(104)1274 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)95 +555 y Fe(TYP_CKSUM_KEY)45 b(100)94 b(CHECKSUM,)46 b(DATASUM)95 +668 y(TYP_WCS_KEY)141 b(110)94 b(CTYPEn,)46 b(CUNITn,)g(CRVALn,)g +(CRPIXn,)g(CROTAn,)f(CDELTn)1002 781 y(CDj_is,)h(PVj_ms,)g(LONPOLEs,)f +(LATPOLEs)1002 894 y(TCTYPn,)h(TCTYns,)g(TCUNIn,)g(TCUNns,)g(TCRVLn,)f +(TCRVns,)h(TCRPXn,)1002 1007 y(TCRPks,)g(TCDn_k,)g(TCn_ks,)g(TPVn_m,)g +(TPn_ms,)f(TCDLTn,)h(TCROTn)1002 1120 y(jCTYPn,)g(jCTYns,)g(jCUNIn,)g +(jCUNns,)g(jCRVLn,)f(jCRVns,)h(iCRPXn,)1002 1233 y(iCRPns,)g(jiCDn,)94 +b(jiCDns,)46 b(jPVn_m,)g(jPn_ms,)f(jCDLTn,)h(jCROTn)1002 +1346 y(\(i,j,m,n)g(are)h(integers,)e(s)i(is)h(any)f(letter\))95 +1458 y(TYP_REFSYS_KEY)d(120)j(EQUINOXs,)f(EPOCH,)g(MJD-OBSs,)f +(RADECSYS,)g(RADESYSs)95 1571 y(TYP_COMM_KEY)140 b(130)47 +b(COMMENT,)f(HISTORY,)f(\(blank)h(keyword\))95 1684 y(TYP_CONT_KEY)140 +b(140)47 b(CONTINUE)95 1797 y(TYP_USER_KEY)140 b(150)47 +b(all)g(other)g(keywords)430 2023 y(class)f(=)h(FTGKCL)f(\(char)h +(*card\))0 2275 y Fh(12)f Fi(P)m(arse)f(the)g('TF)m(ORM')h(binary)d +(table)i(column)e(format)i(string.)83 b(This)43 b(subroutine)g(parses)h +(the)h(input)227 2388 y(TF)m(ORM)27 b(c)m(haracter)g(string)e(and)h +(returns)f(the)h(in)m(teger)g(datat)m(yp)s(e)h(co)s(de,)h(the)e(rep)s +(eat)g(coun)m(t)h(of)f(the)g(\014eld,)227 2501 y(and,)f(in)d(the)i +(case)g(of)g(c)m(haracter)h(string)d(\014elds,)i(the)f(length)g(of)h +(the)g(unit)e(string.)37 b(The)23 b(follo)m(wing)f(datat)m(yp)s(e)227 +2613 y(co)s(des)h(are)h(returned)e(\(the)h(negativ)m(e)h(of)g(the)f(v) +-5 b(alue)22 b(is)g(returned)g(if)g(the)h(column)f(con)m(tains)h(v)-5 +b(ariable-length)227 2726 y(arra)m(ys\):)764 2978 y Fe(Datatype)761 +b(DATACODE)46 b(value)764 3091 y(bit,)g(X)907 b(1)764 +3204 y(byte,)46 b(B)811 b(11)764 3317 y(logical,)45 b(L)668 +b(14)764 3430 y(ASCII)46 b(character,)f(A)286 b(16)764 +3543 y(short)46 b(integer,)g(I)381 b(21)764 3656 y(integer,)45 +b(J)668 b(41)764 3768 y(real,)46 b(E)811 b(42)764 3881 +y(double)46 b(precision,)f(D)238 b(82)764 3994 y(complex)809 +b(83)764 4107 y(double)46 b(complex)475 b(163)382 4333 +y(FTBNFM\(tform,)44 b(>)j(datacode,repeat,width,stat)o(us\))0 +4585 y Fh(13)f Fi(P)m(arse)38 b(the)f('TF)m(ORM')h(k)m(eyw)m(ord)g(v)-5 +b(alue)36 b(that)i(de\014nes)e(the)h(column)f(format)i(in)d(an)i(ASCI)s +(I)f(table.)61 b(This)227 4698 y(routine)30 b(parses)h(the)g(input)f +(TF)m(ORM)h(c)m(haracter)i(string)d(and)g(returns)g(the)i(datat)m(yp)s +(e)g(co)s(de,)f(the)h(width)227 4811 y(of)40 b(the)h(column,)g(and)f +(\(if)f(it)g(is)h(a)g(\015oating)g(p)s(oin)m(t)f(column\))g(the)h(n)m +(um)m(b)s(er)f(of)h(decimal)f(places)h(to)h(the)227 4924 +y(righ)m(t)27 b(of)h(the)f(decimal)f(p)s(oin)m(t.)39 +b(The)27 b(returned)f(datat)m(yp)s(e)i(co)s(des)f(are)h(the)g(same)f +(as)h(for)f(the)g(binary)f(table,)227 5036 y(listed)39 +b(ab)s(o)m(v)m(e,)44 b(with)39 b(the)h(follo)m(wing)f(additional)f +(rules:)59 b(in)m(teger)41 b(columns)e(that)h(are)h(b)s(et)m(w)m(een)g +(1)g(and)227 5149 y(4)36 b(c)m(haracters)i(wide)c(are)j(de\014ned)d(to) +j(b)s(e)e(short)h(in)m(tegers)g(\(co)s(de)g(=)g(21\).)58 +b(Wider)35 b(in)m(teger)h(columns)f(are)227 5262 y(de\014ned)k(to)i(b)s +(e)e(regular)g(in)m(tegers)i(\(co)s(de)f(=)g(41\).)71 +b(Similarly)-8 b(,)39 b(Fixed)g(decimal)g(p)s(oin)m(t)g(columns)g +(\(with)227 5375 y(TF)m(ORM)30 b(=)g('Fw.d'\))g(are)g(de\014ned)f(to)h +(b)s(e)g(single)e(precision)g(reals)h(\(co)s(de)i(=)e(42\))i(if)e(w)g +(is)g(b)s(et)m(w)m(een)h(1)h(and)227 5488 y(7)i(c)m(haracters)h(wide,)e +(inclusiv)m(e.)44 b(Wider)31 b('F')i(columns)e(will)f(return)h(a)i +(double)e(precision)f(data)j(co)s(de)g(\(=)227 5601 y(82\).)54 +b('Ew.d')34 b(format)g(columns)f(will)f(ha)m(v)m(e)j(dataco)s(de)g(=)f +(42,)j(and)c('Dw.d')i(format)f(columns)f(will)f(ha)m(v)m(e)227 +5714 y(dataco)s(de)g(=)e(82.)p eop +%%Page: 105 111 +105 110 bop 0 299 a Fg(9.12.)73 b(GENERAL)30 b(UTILITY)g(SUBR)m +(OUTINES)1934 b Fi(105)382 555 y Fe(FTASFM\(tform,)44 +b(>)j(datacode,width,decimals,st)o(atus)o(\))0 825 y +Fh(14)f Fi(Calculate)30 b(the)h(starting)f(column)g(p)s(ositions)e(and) +i(total)h(ASCI)s(I)e(table)i(width)d(based)j(on)f(the)h(input)d(arra)m +(y)227 938 y(of)f(ASCI)s(I)e(table)h(TF)m(ORM)h(v)-5 +b(alues.)39 b(The)26 b(SP)-8 b(A)m(CE)27 b(input)d(parameter)j +(de\014nes)f(ho)m(w)h(man)m(y)f(blank)g(spaces)227 1051 +y(to)40 b(lea)m(v)m(e)h(b)s(et)m(w)m(een)f(eac)m(h)g(column)f(\(it)g +(is)f(recommended)h(to)h(ha)m(v)m(e)h(one)e(space)h(b)s(et)m(w)m(een)g +(columns)e(for)227 1164 y(b)s(etter)31 b(h)m(uman)e(readabilit)m(y\).) +382 1434 y Fe(FTGABC\(tfields,tform,spa)o(ce,)41 b(>)48 +b(rowlen,tbcol,status\))0 1704 y Fh(15)e Fi(P)m(arse)36 +b(a)f(template)g(string)f(and)h(return)f(a)h(formatted)h(80-c)m +(haracter)h(string)d(suitable)g(for)h(app)s(ending)d(to)227 +1817 y(\(or)40 b(deleting)f(from\))g(a)h(FITS)f(header)h(\014le.)67 +b(This)38 b(subroutine)f(is)i(useful)f(for)h(parsing)f(lines)g(from)h +(an)227 1930 y(ASCI)s(I)34 b(template)i(\014le)f(and)f(reformatting)i +(them)f(in)m(to)h(legal)f(FITS)f(header)i(records.)55 +b(The)35 b(formatted)227 2043 y(string)30 b(ma)m(y)h(then)f(b)s(e)g +(passed)g(to)i(the)e(FTPREC,)h(FTMCRD,)g(or)f(FTDKEY)h(subroutines)d +(to)k(app)s(end)227 2156 y(or)f(mo)s(dify)d(a)j(FITS)f(header)g +(record.)382 2426 y Fe(FTGTHD\(template,)43 b(>)48 b +(card,hdtype,status\))0 2696 y Fi(The)23 b(input)g(TEMPLA)-8 +b(TE)23 b(c)m(haracter)j(string)d(generally)g(should)f(con)m(tain)i(3)h +(tok)m(ens:)38 b(\(1\))25 b(the)f(KEYNAME,)h(\(2\))0 +2809 y(the)h(V)-10 b(ALUE,)26 b(and)f(\(3\))i(the)f(COMMENT)g(string.) +38 b(The)25 b(TEMPLA)-8 b(TE)26 b(string)f(m)m(ust)g(adhere)h(to)g(the) +g(follo)m(wing)0 2922 y(format:)0 3192 y Fh(-)80 b Fi(The)24 +b(KEYNAME)g(tok)m(en)h(m)m(ust)e(b)s(egin)g(in)f(columns)h(1-8)i(and)e +(b)s(e)h(a)g(maxim)m(um)f(of)h(8)g(c)m(haracters)h(long.)38 +b(If)24 b(the)227 3305 y(\014rst)32 b(8)h(c)m(haracters)h(of)e(the)h +(template)g(line)d(are)j(blank)e(then)h(the)h(remainder)e(of)h(the)h +(line)e(is)g(considered)227 3418 y(to)42 b(b)s(e)e(a)h(FITS)f(commen)m +(t)h(\(with)f(a)h(blank)e(k)m(eyw)m(ord)i(name\).)72 +b(A)41 b(legal)g(FITS)f(k)m(eyw)m(ord)h(name)f(ma)m(y)227 +3531 y(only)34 b(con)m(tain)i(the)f(c)m(haracters)h(A-Z,)f(0-9,)j(and)c +('-')i(\(min)m(us)e(sign\))g(and)g(underscore.)54 b(This)33 +b(subroutine)227 3644 y(will)39 b(automatically)i(con)m(v)m(ert)i(an)m +(y)f(lo)m(w)m(ercase)h(c)m(haracters)f(to)h(upp)s(ercase)d(in)g(the)i +(output)f(string.)72 b(If)227 3757 y(KEYNAME)33 b(=)f('COMMENT')h(or)g +('HISTOR)-8 b(Y')32 b(then)h(the)f(remainder)f(of)i(the)g(line)e(is)h +(considered)f(to)227 3870 y(b)s(e)f(a)h(FITS)e(COMMENT)h(or)h(HISTOR)-8 +b(Y)30 b(record,)g(resp)s(ectiv)m(ely)-8 b(.)0 4140 y +Fh(-)80 b Fi(The)26 b(V)-10 b(ALUE)26 b(tok)m(en)h(m)m(ust)e(b)s(e)h +(separated)g(from)f(the)i(KEYNAME)f(tok)m(en)h(b)m(y)f(one)g(or)g(more) +g(spaces)g(and/or)227 4253 y(an)i('=')g(c)m(haracter.)41 +b(The)27 b(datat)m(yp)s(e)i(of)f(the)g(V)-10 b(ALUE)27 +b(tok)m(en)i(\(n)m(umeric,)f(logical,)g(or)g(c)m(haracter)h(string\))e +(is)227 4366 y(automatically)32 b(determined)e(and)i(the)g(output)f +(CARD)h(string)f(is)g(formatted)h(accordingly)-8 b(.)45 +b(The)31 b(v)-5 b(alue)227 4478 y(tok)m(en)34 b(ma)m(y)f(b)s(e)f +(forced)g(to)i(b)s(e)e(in)m(terpreted)f(as)i(a)g(string)f(\(e.g.)48 +b(if)32 b(it)g(is)f(a)i(string)f(of)g(n)m(umeric)g(digits\))f(b)m(y)227 +4591 y(enclosing)f(it)g(in)f(single)g(quotes.)0 4862 +y Fh(-)80 b Fi(The)37 b(COMMENT)f(tok)m(en)i(is)e(optional,)i(but)f(if) +f(presen)m(t)h(m)m(ust)f(b)s(e)h(separated)g(from)g(the)g(V)-10 +b(ALUE)37 b(tok)m(en)227 4974 y(b)m(y)j(at)h(least)g(one)f(blank)f +(space.)70 b(A)40 b(leading)f('/')i(c)m(haracter)h(ma)m(y)f(b)s(e)e +(used)h(to)g(mark)g(the)h(b)s(eginning)227 5087 y(of)33 +b(the)f(commen)m(t)h(\014eld,)f(otherwise)f(the)i(commen)m(t)g(\014eld) +e(b)s(egins)f(with)h(the)h(\014rst)g(non-blank)e(c)m(haracter)227 +5200 y(follo)m(wing)f(the)i(v)-5 b(alue)30 b(tok)m(en.)0 +5470 y Fh(-)80 b Fi(One)32 b(exception)h(to)g(the)g(ab)s(o)m(v)m(e)h +(rules)d(is)g(that)i(if)f(the)g(\014rst)g(non-blank)f(c)m(haracter)j +(in)d(the)i(template)g(string)227 5583 y(is)h(a)h(min)m(us)e(sign)h +(\('-'\))i(follo)m(w)m(ed)e(b)m(y)h(a)g(single)e(tok)m(en,)k(or)e(a)g +(single)e(tok)m(en)j(follo)m(w)m(ed)e(b)m(y)h(an)f(equal)h(sign,)227 +5696 y(then)29 b(it)f(is)g(in)m(terpreted)f(as)i(the)g(name)g(of)g(a)g +(k)m(eyw)m(ord)g(whic)m(h)e(is)h(to)h(b)s(e)f(deleted)h(from)f(the)h +(FITS)f(header.)p eop +%%Page: 106 112 +106 111 bop 0 299 a Fi(106)1274 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)0 +555 y Fh(-)80 b Fi(The)40 b(second)g(exception)g(is)f(that)i(if)e(the)h +(template)g(string)f(starts)h(with)f(a)i(min)m(us)d(sign)h(and)g(is)g +(follo)m(w)m(ed)227 668 y(b)m(y)33 b(2)g(tok)m(ens)g(then)g(the)f +(second)h(tok)m(en)h(is)d(in)m(terpreted)h(as)h(the)g(new)f(name)g(for) +h(the)g(k)m(eyw)m(ord)g(sp)s(eci\014ed)227 781 y(b)m(y)h(\014rst)e(tok) +m(en.)52 b(In)33 b(this)f(case)j(the)e(old)g(k)m(eyw)m(ord)h(name)g +(\(\014rst)f(tok)m(en\))i(is)d(returned)h(in)f(c)m(haracters)j(1-8)227 +894 y(of)e(the)g(returned)e(CARD)i(string,)f(and)g(the)h(new)f(k)m(eyw) +m(ord)h(name)g(\(the)g(second)f(tok)m(en\))i(is)e(returned)f(in)227 +1007 y(c)m(haracters)c(41-48)h(of)e(the)f(returned)g(CARD)g(string.)39 +b(These)25 b(old)g(and)g(new)g(names)g(ma)m(y)h(then)f(b)s(e)g(passed) +227 1120 y(to)31 b(the)g(FTMNAM)g(subroutine)e(whic)m(h)g(will)e(c)m +(hange)32 b(the)e(k)m(eyw)m(ord)h(name.)0 1361 y(The)f(HDTYPE)g(output) +g(parameter)h(indicates)e(ho)m(w)i(the)f(returned)g(CARD)g(string)f +(should)g(b)s(e)h(in)m(terpreted:)382 1602 y Fe(hdtype)857 +b(interpretation)382 1715 y(------)523 b(-------------------------)o +(----)o(---)o(----)o(----)o(---)o(----)o(--)525 1828 +y(-2)572 b(Modify)46 b(the)h(name)g(of)g(the)g(keyword)f(given)g(in)h +(CARD\(1:8\))1193 1941 y(to)g(the)g(new)g(name)g(given)f(in)h +(CARD\(41:48\))525 2167 y(-1)572 b(CARD\(1:8\))45 b(contains)h(the)h +(name)g(of)g(a)g(keyword)f(to)h(be)g(deleted)1193 2280 +y(from)g(the)g(FITS)f(header.)573 2506 y(0)572 b(append)46 +b(the)h(CARD)g(string)f(to)h(the)g(FITS)g(header)f(if)h(the)1193 +2619 y(keyword)f(does)h(not)g(already)e(exist,)h(otherwise)g(update) +1193 2732 y(the)h(value/comment)d(if)j(the)g(keyword)f(is)h(already)f +(present)1193 2844 y(in)h(the)g(header.)573 3070 y(1)572 +b(simply)46 b(append)g(this)h(keyword)f(to)h(the)g(FITS)g(header)f +(\(CARD)1193 3183 y(is)h(either)f(a)i(HISTORY)e(or)h(COMMENT)f +(keyword\).)573 3409 y(2)572 b(This)47 b(is)g(a)g(FITS)g(END)g(record;) +f(it)h(should)f(not)h(be)g(written)1193 3522 y(to)g(the)g(FITS)g +(header)f(because)g(FITSIO)g(automatically)1193 3635 +y(appends)g(the)h(END)g(record)f(when)h(the)f(header)h(is)g(closed.)0 +3876 y Fi(EXAMPLES:)30 b(The)g(follo)m(wing)f(lines)f(illustrate)h(v)-5 +b(alid)29 b(input)f(template)j(strings:)286 4118 y Fe(INTVAL)46 +b(7)i(This)f(is)g(an)g(integer)f(keyword)286 4231 y(RVAL)524 +b(34.6)142 b(/)239 b(This)46 b(is)i(a)f(floating)f(point)g(keyword)286 +4343 y(EVAL=-12.45E-03)92 b(This)46 b(is)i(a)f(floating)f(point)g +(keyword)g(in)h(exponential)e(notation)286 4456 y(lval)i(F)g(This)g(is) +g(a)h(boolean)e(keyword)859 4569 y(This)h(is)g(a)g(comment)f(keyword)g +(with)h(a)g(blank)f(keyword)g(name)286 4682 y(SVAL1)h(=)g('Hello)f +(world')142 b(/)95 b(this)47 b(is)g(a)g(string)f(keyword)286 +4795 y(SVAL2)94 b('123.5')g(this)47 b(is)g(also)f(a)i(string)e(keyword) +286 4908 y(sval3)94 b(123+)h(/)g(this)47 b(is)g(also)f(a)i(string)e +(keyword)g(with)g(the)h(value)g('123+)189 b(')286 5021 +y(#)48 b(the)f(following)e(template)h(line)g(deletes)g(the)h(DATE)g +(keyword)286 5134 y(-)h(DATE)286 5247 y(#)g(the)f(following)e(template) +h(line)g(modifies)g(the)h(NAME)f(keyword)g(to)h(OBJECT)286 +5360 y(-)h(NAME)e(OBJECT)0 5601 y Fh(16)g Fi(P)m(arse)35 +b(the)g(input)e(string)h(con)m(taining)g(a)h(list)f(of)h(ro)m(ws)f(or)h +(ro)m(w)g(ranges,)h(and)e(return)g(in)m(teger)h(arra)m(ys)g(con-)227 +5714 y(taining)25 b(the)h(\014rst)f(and)g(last)h(ro)m(w)g(in)e(eac)m(h) +j(range.)40 b(F)-8 b(or)26 b(example,)h(if)d(ro)m(wlist)h(=)g("3-5,)k +(6,)e(8-9")h(then)d(it)h(will)p eop +%%Page: 107 113 +107 112 bop 0 299 a Fg(9.12.)73 b(GENERAL)30 b(UTILITY)g(SUBR)m +(OUTINES)1934 b Fi(107)227 555 y(return)34 b(n)m(umranges)h(=)g(3,)h +(rangemin)e(=)h(3,)i(6,)g(8)e(and)g(rangemax)g(=)g(5,)i(6,)g(9.)55 +b(A)m(t)36 b(most,)h('maxranges')227 668 y(n)m(um)m(b)s(er)31 +b(of)h(ranges)f(will)e(b)s(e)j(returned.)43 b('maxro)m(ws')32 +b(is)f(the)h(maxim)m(um)f(n)m(um)m(b)s(er)f(of)i(ro)m(ws)g(in)e(the)i +(table;)227 781 y(an)m(y)e(ro)m(ws)f(or)g(ranges)g(larger)g(than)g +(this)f(will)e(b)s(e)j(ignored.)39 b(The)29 b(ro)m(ws)g(m)m(ust)g(b)s +(e)f(sp)s(eci\014ed)g(in)f(increasing)227 894 y(order,)33 +b(and)f(the)g(ranges)h(m)m(ust)f(not)g(o)m(v)m(erlap.)47 +b(A)33 b(min)m(us)d(sign)i(ma)m(y)h(b)s(e)e(use)h(to)h(sp)s(ecify)e +(all)g(the)i(ro)m(ws)f(to)227 1007 y(the)h(upp)s(er)d(or)j(lo)m(w)m(er) +g(b)s(ound,)e(so)i("50-")h(means)e(all)g(the)h(ro)m(ws)f(from)g(50)h +(to)h(the)e(end)g(of)h(the)f(table,)i(and)227 1120 y("-")e(means)e(all) +f(the)i(ro)m(ws)f(in)f(the)i(table,)f(from)g(1)h(-)g(maxro)m(ws.)191 +1380 y Fe(FTRWRG\(rowlist,)44 b(maxrows,)h(maxranges,)g(>)525 +1492 y(numranges,)g(rangemin,)g(rangemax,)h(status\))p +eop +%%Page: 108 114 +108 113 bop 0 299 a Fi(108)1274 b Fg(CHAPTER)29 b(9.)112 +b(AD)m(V)-10 b(ANCED)32 b(INTERF)-10 b(A)m(CE)30 b(SUBR)m(OUTINES)p +eop +%%Page: 109 115 +109 114 bop 0 1225 a Ff(Chapter)65 b(10)0 1687 y Fl(Summary)76 +b(of)i(all)f(FITSIO)0 1937 y(User-In)-6 b(terface)77 +b(Subroutines)0 2429 y Fi(Error)29 b(Status)i(Routines)e(page)i(63)382 +2696 y Fe(FTVERS\()46 b(>)h(version\))382 2809 y(FTGERR\(status,)d(>)j +(errtext\))382 2922 y(FTGMSG\()f(>)h(errmsg\))382 3035 +y(FTRPRT)f(\(stream,)f(>)j(status\))382 3147 y(FTPMSG\(errmsg\))382 +3260 y(FTPMRK)382 3373 y(FTCMSG)382 3486 y(FTCMRK)0 3753 +y Fi(FITS)30 b(File)f(Op)s(en)g(and)h(Close)g(Subroutines:)38 +b(page)31 b(69)382 4020 y Fe(FTOPEN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(blocksize,status\))382 4133 y(FTDKOPEN\(unit,filename,r)o(wmo) +o(de,)41 b(>)48 b(blocksize,status\))382 4246 y +(FTNOPN\(unit,filename,rwm)o(ode)o(,)42 b(>)47 b(status\))382 +4359 y(FTDOPN\(unit,filename,rwm)o(ode)o(,)42 b(>)47 +b(status\))382 4472 y(FTTOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))382 4585 y(FTIOPN\(unit,filename,rwm)o(ode)o(,)42 +b(>)47 b(status\))382 4698 y(FTREOPEN\(unit,)d(>)j(newunit,)f(status\)) +382 4811 y(FTINIT\(unit,filename,blo)o(cks)o(ize,)41 +b(>)48 b(status\))382 4924 y(FTDKINIT\(unit,filename,b)o(loc)o(ksiz)o +(e,)42 b(>)47 b(status\))382 5036 y(FTTPLT\(unit,)d(filename,)i +(tplfilename,)e(>)j(status\))382 5149 y(FTFLUS\(unit,)d(>)k(status\)) +382 5262 y(FTCLOS\(unit,)c(>)k(status\))382 5375 y(FTDELT\(unit,)c(>)k +(status\))382 5488 y(FTGIOU\()e(>)h(iounit,)f(status\))382 +5601 y(FTFIOU\(iounit,)e(>)j(status\))0 5714 y(CFITS2Unit\(fitsfile)c +(*ptr\))141 b(\(C)48 b(routine\))1882 5942 y Fi(109)p +eop +%%Page: 110 116 +110 115 bop 0 299 a Fi(110)281 b Fg(CHAPTER)30 b(10.)112 +b(SUMMAR)-8 b(Y)32 b(OF)e(ALL)g(FITSIO)f(USER-INTERF)-10 +b(A)m(CE)30 b(SUBR)m(OUTINES)382 555 y Fe(CUnit2FITS\(int)44 +b(unit\))380 b(\(C)47 b(routine\))382 668 y(FTEXTN\(filename,)c(>)48 +b(nhdu,)e(status\))382 781 y(FTFLNM\(unit,)e(>)k(filename,)d(status\)) +382 894 y(FTFLMD\(unit,)f(>)k(iomode,)e(status\))382 +1007 y(FFURLT\(unit,)e(>)k(urltype,)d(status\))382 1120 +y(FTIURL\(filename,)e(>)48 b(filetype,)d(infile,)h(outfile,)f(extspec,) +h(filter,)716 1233 y(binspec,)f(colspec,)h(status\))382 +1346 y(FTRTNM\(filename,)d(>)48 b(rootname,)d(status\))382 +1458 y(FTEXIST\(filename,)e(>)k(exist,)f(status\))0 1695 +y Fi(HDU-Lev)m(el)32 b(Op)s(erations:)39 b(page)31 b(72)382 +1932 y Fe(FTMAHD\(unit,nhdu,)43 b(>)k(hdutype,status\))382 +2045 y(FTMRHD\(unit,nmove,)c(>)k(hdutype,status\))382 +2158 y(FTGHDN\(unit,)d(>)k(nhdu\))382 2271 y(FTMNHD\(unit,)c(hdutype,)i +(extname,)f(extver,)h(>)i(status\))382 2384 y(FTGHDT\(unit,)c(>)k +(hdutype,)d(status\))382 2497 y(FTTHDU\(unit,)f(>)k(hdunum,)e(status\)) +382 2610 y(FTCRHD\(unit,)e(>)k(status\))382 2723 y +(FTIIMG\(unit,bitpix,naxis)o(,na)o(xes,)41 b(>)48 b(status\))382 +2836 y(FTITAB\(unit,rowlen,nrows)o(,tf)o(ield)o(s,tt)o(ype)o(,tbc)o +(ol,t)o(for)o(m,tu)o(nit,)o(ext)o(name)o(,)42 b(>)716 +2949 y(status\))382 3061 y(FTIBIN\(unit,nrows,tfield)o(s,t)o(type)o +(,tfo)o(rm,)o(tuni)o(t,ex)o(tna)o(me,v)o(arid)o(at)f(>)48 +b(status\))382 3174 y(FTRSIM\(unit,bitpix,naxis)o(,na)o(xes,)o(stat)o +(us\))382 3287 y(FTDHDU\(unit,)c(>)k(hdutype,status\))382 +3400 y(FTCPFL\(iunit,ounit,previ)o(ous)o(,)42 b(current,)j(following,)g +(>)j(status\))382 3513 y(FTCOPY\(iunit,ounit,morek)o(eys)o(,)42 +b(>)47 b(status\))382 3626 y(FTCPHD\(inunit,)d(outunit,)h(>)j(status\)) +382 3739 y(FTCPDT\(iunit,ounit,)42 b(>)48 b(status\))0 +3976 y Fi(Subroutines)28 b(to)j(sp)s(ecify)e(or)h(mo)s(dify)f(the)h +(structure)g(of)h(the)f(CHDU:)h(page)h(75)382 4213 y +Fe(FTRDEF\(unit,)44 b(>)k(status\))93 b(\(DEPRECATED\))382 +4326 y(FTPDEF\(unit,bitpix,naxis)o(,na)o(xes,)o(pcou)o(nt,)o(gcou)o +(nt,)41 b(>)48 b(status\))93 b(\(DEPRECATED\))382 4439 +y(FTADEF\(unit,rowlen,tfiel)o(ds,)o(tbco)o(l,tf)o(orm)o(,nro)o(ws)42 +b(>)47 b(status\))94 b(\(DEPRECATED\))382 4551 y +(FTBDEF\(unit,tfields,tfor)o(m,v)o(arid)o(at,n)o(row)o(s)42 +b(>)47 b(status\))94 b(\(DEPRECATED\))382 4664 y(FTDDEF\(unit,bytlen,) +42 b(>)48 b(status\))93 b(\(DEPRECATED\))382 4777 y +(FTPTHP\(unit,theap,)43 b(>)k(status\))0 5014 y Fi(Header)31 +b(Space)f(and)g(P)m(osition)g(Subroutines:)38 b(page)31 +b(76)382 5251 y Fe(FTHDEF\(unit,morekeys,)42 b(>)47 b(status\))382 +5364 y(FTGHSP\(iunit,)d(>)j(keysexist,keysadd,status\))382 +5477 y(FTGHPS\(iunit,)d(>)j(keysexist,key_no,status\))0 +5714 y Fi(Read)31 b(or)f(W)-8 b(rite)31 b(Standard)e(Header)i +(Subroutines:)38 b(page)31 b(77)p eop +%%Page: 111 117 +111 116 bop 3764 299 a Fi(111)382 555 y Fe(FTPHPS\(unit,bitpix,naxis)o +(,na)o(xes,)41 b(>)48 b(status\))382 668 y(FTPHPR\(unit,simple,bitpi)o +(x,n)o(axis)o(,nax)o(es,)o(pcou)o(nt,g)o(cou)o(nt,e)o(xten)o(d,)41 +b(>)48 b(status\))382 781 y(FTGHPR\(unit,maxdim,)42 b(>)48 +b(simple,bitpix,naxis,naxe)o(s,p)o(coun)o(t,gc)o(oun)o(t,ex)o(tend)o(,) +716 894 y(status\))382 1007 y(FTPHTB\(unit,rowlen,nrows)o(,tf)o(ield)o +(s,tt)o(ype)o(,tbc)o(ol,t)o(for)o(m,tu)o(nit,)o(ext)o(name)o(,)42 +b(>)716 1120 y(status\))382 1233 y(FTGHTB\(unit,maxdim,)g(>)48 +b(rowlen,nrows,tfields,tty)o(pe,)o(tbco)o(l,tf)o(orm)o(,tun)o(it,)716 +1346 y(extname,status\))382 1458 y(FTPHBN\(unit,nrows,tfield)o(s,t)o +(type)o(,tfo)o(rm,)o(tuni)o(t,ex)o(tna)o(me,v)o(arid)o(at)41 +b(>)48 b(status\))382 1571 y(FTGHBN\(unit,maxdim,)42 +b(>)48 b(nrows,tfields,ttype,tfor)o(m,t)o(unit)o(,ext)o(nam)o(e,va)o +(rida)o(t,)716 1684 y(status\))0 1942 y Fi(W)-8 b(rite)31 +b(Keyw)m(ord)f(Subroutines:)38 b(page)31 b(78)382 2199 +y Fe(FTPREC\(unit,card,)43 b(>)k(status\))382 2312 y +(FTPCOM\(unit,comment,)42 b(>)48 b(status\))382 2425 +y(FTPHIS\(unit,history,)42 b(>)48 b(status\))382 2538 +y(FTPDAT\(unit,)c(>)k(status\))382 2651 y(FTPKY[JLS]\(unit,keyword,)o +(key)o(val,)o(comm)o(ent)o(,)42 b(>)47 b(status\))382 +2764 y(FTPKY[EDFG]\(unit,keyword)o(,ke)o(yval)o(,dec)o(ima)o(ls,c)o +(omme)o(nt,)41 b(>)48 b(status\))382 2877 y(FTPKLS\(unit,keyword,keyv)o +(al,)o(comm)o(ent,)41 b(>)47 b(status\))382 2990 y(FTPLSW\(unit,)d(>)k +(status\))382 3103 y(FTPKYU\(unit,keyword,comm)o(ent)o(,)42 +b(>)47 b(status\))382 3216 y(FTPKN[JLS]\(unit,keyroot,)o(sta)o(rtno)o +(,no_)o(key)o(s,ke)o(yval)o(s,c)o(omme)o(nts,)41 b(>)47 +b(status\))382 3329 y(FTPKN[EDFG]\(unit,keyroot)o(,st)o(artn)o(o,no)o +(_ke)o(ys,k)o(eyva)o(ls,)o(deci)o(mals)o(,co)o(mmen)o(ts,)41 +b(>)907 3441 y(status\))382 3554 y(FTCPKYinunit,)j(outunit,)i(innum,)g +(outnum,)f(keyroot,)h(>)h(status\))382 3667 y +(FTPKYT\(unit,keyword,intv)o(al,)o(dblv)o(al,c)o(omm)o(ent,)41 +b(>)48 b(status\))382 3780 y(FTPKTP\(unit,)c(filename,)i(>)h(status\)) +382 3893 y(FTPUNT\(unit,keyword,unit)o(s,)41 b(>)48 b(status\))0 +4151 y Fi(Insert)30 b(Keyw)m(ord)g(Subroutines:)38 b(page)31 +b(80)382 4408 y Fe(FTIREC\(unit,key_no,card,)41 b(>)47 +b(status\))382 4521 y(FTIKY[JLS]\(unit,keyword,)o(key)o(val,)o(comm)o +(ent)o(,)42 b(>)47 b(status\))382 4634 y(FTIKLS\(unit,keyword,keyv)o +(al,)o(comm)o(ent,)41 b(>)47 b(status\))382 4747 y +(FTIKY[EDFG]\(unit,keyword)o(,ke)o(yval)o(,dec)o(ima)o(ls,c)o(omme)o +(nt,)41 b(>)48 b(status\))382 4860 y(FTIKYU\(unit,keyword,comm)o(ent)o +(,)42 b(>)47 b(status\))0 5118 y Fi(Read)31 b(Keyw)m(ord)f +(Subroutines:)38 b(page)31 b(81)382 5375 y Fe(FTGREC\(unit,key_no,)42 +b(>)48 b(card,status\))382 5488 y(FTGKYN\(unit,key_no,)42 +b(>)48 b(keyword,value,comment,st)o(atu)o(s\))382 5601 +y(FTGCRD\(unit,keyword,)42 b(>)48 b(card,status\))382 +5714 y(FTGNXK\(unit,inclist,ninc)o(,ex)o(clis)o(t,ne)o(xc,)41 +b(>)48 b(card,status\))p eop +%%Page: 112 118 +112 117 bop 0 299 a Fi(112)281 b Fg(CHAPTER)30 b(10.)112 +b(SUMMAR)-8 b(Y)32 b(OF)e(ALL)g(FITSIO)f(USER-INTERF)-10 +b(A)m(CE)30 b(SUBR)m(OUTINES)382 555 y Fe(FTGKEY\(unit,keyword,)42 +b(>)48 b(value,comment,status\))382 668 y(FTGKY[EDJLS]\(unit,keywor)o +(d,)41 b(>)48 b(keyval,comment,status\))382 781 y +(FTGKN[EDJLS]\(unit,keyroo)o(t,s)o(tart)o(no,m)o(ax_)o(keys)o(,)42 +b(>)47 b(keyvals,nfound,status\))382 894 y(FTGKYT\(unit,keyword,)42 +b(>)48 b(intval,dblval,comment,s)o(tat)o(us\))382 1007 +y(FTGUNT\(unit,keyword,)42 b(>)48 b(units,status\))0 +1263 y Fi(Mo)s(dify)29 b(Keyw)m(ord)h(Subroutines:)38 +b(page)31 b(82)382 1519 y Fe(FTMREC\(unit,key_no,card,)41 +b(>)47 b(status\))382 1632 y(FTMCRD\(unit,keyword,card)o(,)42 +b(>)47 b(status\))382 1745 y(FTMNAM\(unit,oldkey,keywo)o(rd,)41 +b(>)48 b(status\))382 1858 y(FTMCOM\(unit,keyword,comm)o(ent)o(,)42 +b(>)47 b(status\))382 1971 y(FTMKY[JLS]\(unit,keyword,)o(key)o(val,)o +(comm)o(ent)o(,)42 b(>)47 b(status\))382 2084 y +(FTMKLS\(unit,keyword,keyv)o(al,)o(comm)o(ent,)41 b(>)47 +b(status\))382 2197 y(FTMKY[EDFG]\(unit,keyword)o(,ke)o(yval)o(,dec)o +(ima)o(ls,c)o(omme)o(nt,)41 b(>)48 b(status\))382 2310 +y(FTMKYU\(unit,keyword,comm)o(ent)o(,)42 b(>)47 b(status\))0 +2566 y Fi(Up)s(date)30 b(Keyw)m(ord)g(Subroutines:)38 +b(page)32 b(83)382 2822 y Fe(FTUCRD\(unit,keyword,card)o(,)42 +b(>)47 b(status\))382 2935 y(FTUKY[JLS]\(unit,keyword,)o(key)o(val,)o +(comm)o(ent)o(,)42 b(>)47 b(status\))382 3048 y +(FTUKLS\(unit,keyword,keyv)o(al,)o(comm)o(ent,)41 b(>)47 +b(status\))382 3161 y(FTUKY[EDFG]\(unit,keyword)o(,ke)o(yval)o(,dec)o +(ima)o(ls,c)o(omme)o(nt,)41 b(>)48 b(status\))382 3274 +y(FTUKYU\(unit,keyword,comm)o(ent)o(,)42 b(>)47 b(status\))0 +3530 y Fi(Delete)32 b(Keyw)m(ord)e(Subroutines:)38 b(page)31 +b(84)382 3786 y Fe(FTDREC\(unit,key_no,)42 b(>)48 b(status\))382 +3899 y(FTDKEY\(unit,keyword,)42 b(>)48 b(status\))0 4155 +y Fi(De\014ne)31 b(Data)h(Scaling)d(P)m(arameters)i(and)f(Unde\014ned)f +(Pixel)g(Flags:)41 b(page)31 b(84)382 4411 y Fe +(FTPSCL\(unit,bscale,bzero)o(,)42 b(>)47 b(status\))382 +4524 y(FTTSCL\(unit,colnum,tscal)o(,tz)o(ero,)41 b(>)48 +b(status\))382 4637 y(FTPNUL\(unit,blank,)43 b(>)k(status\))382 +4750 y(FTSNUL\(unit,colnum,snull)41 b(>)47 b(status\))382 +4863 y(FTTNUL\(unit,colnum,tnull)41 b(>)47 b(status\))0 +5119 y Fi(FITS)30 b(Primary)e(Arra)m(y)j(or)f(IMA)m(GE)i(Extension)d +(I/O)i(Subroutines:)38 b(page)31 b(85)382 5375 y Fe(FTGIDT\(unit,)44 +b(>)k(bitpix,status\))382 5488 y(FTGIET\(unit,)c(>)k(bitpix,status\)) +382 5601 y(FTGIDM\(unit,)c(>)k(naxis,status\))382 5714 +y(FTGISZ\(unit,)c(maxdim,)i(>)i(naxes,status\))p eop +%%Page: 113 119 +113 118 bop 3764 299 a Fi(113)382 555 y Fe(FTGIPR\(unit,)44 +b(maxdim,)i(>)i(bitpix,naxis,naxes,stat)o(us\))382 668 +y(FTPPR[BIJED]\(unit,group,)o(fpi)o(xel,)o(nele)o(men)o(ts,v)o(alue)o +(s,)41 b(>)48 b(status\))382 781 y(FTPPN[BIJED]\(unit,group,)o(fpi)o +(xel,)o(nele)o(men)o(ts,v)o(alue)o(s,n)o(ullv)o(al)42 +b(>)47 b(status\))382 894 y(FTPPRU\(unit,group,fpixel)o(,ne)o(leme)o +(nts,)41 b(>)47 b(status\))382 1007 y(FTGPV[BIJED]\(unit,group,)o(fpi)o +(xel,)o(nele)o(men)o(ts,n)o(ullv)o(al,)41 b(>)48 b +(values,anyf,status\))382 1120 y(FTGPF[BIJED]\(unit,group,)o(fpi)o +(xel,)o(nele)o(men)o(ts,)41 b(>)48 b(values,flagvals,anyf,sta)o(tus)o +(\))382 1233 y(FTPGP[BIJED]\(unit,group,)o(fpa)o(rm,n)o(parm)o(,va)o +(lues)o(,)42 b(>)47 b(status\))382 1346 y(FTGGP[BIJED]\(unit,group,)o +(fpa)o(rm,n)o(parm)o(,)42 b(>)47 b(values,status\))382 +1458 y(FTP2D[BIJED]\(unit,group,)o(dim)o(1,na)o(xis1)o(,na)o(xis2)o +(,ima)o(ge,)41 b(>)48 b(status\))382 1571 y(FTP3D[BIJED]\(unit,group,)o +(dim)o(1,di)o(m2,n)o(axi)o(s1,n)o(axis)o(2,n)o(axis)o(3,cu)o(be,)41 +b(>)48 b(status\))382 1684 y(FTG2D[BIJED]\(unit,group,)o(nul)o(lval)o +(,dim)o(1,n)o(axis)o(1,na)o(xis)o(2,)42 b(>)47 b(image,anyf,status\)) +382 1797 y(FTG3D[BIJED]\(unit,group,)o(nul)o(lval)o(,dim)o(1,d)o(im2,)o +(naxi)o(s1,)o(naxi)o(s2,n)o(axi)o(s3,)41 b(>)1002 1910 +y(cube,anyf,status\))382 2023 y(FTPSS[BIJED]\(unit,group,)o(nax)o(is,n) +o(axes)o(,fp)o(ixel)o(s,lp)o(ixe)o(ls,a)o(rray)o(,)h(>)47 +b(status\))382 2136 y(FTGSV[BIJED]\(unit,group,)o(nax)o(is,n)o(axes)o +(,fp)o(ixel)o(s,lp)o(ixe)o(ls,i)o(ncs,)o(nul)o(lval)o(,)42 +b(>)1002 2249 y(array,anyf,status\))382 2362 y +(FTGSF[BIJED]\(unit,group,)o(nax)o(is,n)o(axes)o(,fp)o(ixel)o(s,lp)o +(ixe)o(ls,i)o(ncs,)f(>)1002 2475 y(array,flagvals,anyf,statu)o(s\))0 +2739 y Fi(T)-8 b(able)30 b(Column)e(Information)i(Subroutines:)38 +b(page)31 b(88)382 3003 y Fe(FTGNRW\(unit,)44 b(>)k(nrows,)e(status\)) +382 3115 y(FTGNCL\(unit,)e(>)k(ncols,)e(status\))382 +3228 y(FTGCNO\(unit,casesen,colt)o(emp)o(late)o(,)c(>)47 +b(colnum,status\))382 3341 y(FTGCNN\(unit,casesen,colt)o(emp)o(late)o +(,)42 b(>)47 b(colnam,colnum,status\))382 3454 y(FTGTCL\(unit,colnum,) +42 b(>)48 b(datacode,repeat,width,st)o(atu)o(s\))382 +3567 y(FTEQTY\(unit,colnum,)42 b(>)48 b(datacode,repeat,width,st)o(atu) +o(s\))382 3680 y(FTGCDW\(unit,colnum,)42 b(>)48 b(dispwidth,status\)) +382 3793 y(FTGACL\(unit,colnum,)42 b(>)716 3906 y +(ttype,tbcol,tunit,tform,)o(tsca)o(l,t)o(zero)o(,snu)o(ll,)o(tdis)o +(p,st)o(atu)o(s\))382 4019 y(FTGBCL\(unit,colnum,)g(>)716 +4132 y(ttype,tunit,datatype,rep)o(eat,)o(tsc)o(al,t)o(zero)o(,tn)o +(ull,)o(tdis)o(p,s)o(tatu)o(s\))382 4245 y(FTPTDM\(unit,colnum,naxis)o +(,na)o(xes,)f(>)48 b(status\))382 4357 y(FTGTDM\(unit,colnum,maxdi)o +(m,)41 b(>)48 b(naxis,naxes,status\))382 4470 y +(FTDTDM\(unit,tdimstr,coln)o(um,)o(maxd)o(im,)41 b(>)48 +b(naxis,naxes,)c(status\))382 4583 y(FFGRSZ\(unit,)g(>)k +(nrows,status\))0 4847 y Fi(Lo)m(w-Lev)m(el)31 b(T)-8 +b(able)30 b(Access)i(Subroutines:)38 b(page)31 b(91)382 +5111 y Fe(FTGTBS\(unit,frow,startch)o(ar,)o(ncha)o(rs,)41 +b(>)48 b(string,status\))382 5224 y(FTPTBS\(unit,frow,startch)o(ar,)o +(ncha)o(rs,s)o(tri)o(ng,)41 b(>)48 b(status\))382 5337 +y(FTGTBB\(unit,frow,startch)o(ar,)o(ncha)o(rs,)41 b(>)48 +b(array,status\))382 5450 y(FTPTBB\(unit,frow,startch)o(ar,)o(ncha)o +(rs,a)o(rra)o(y,)42 b(>)47 b(status\))0 5714 y Fi(Edit)29 +b(Ro)m(ws)i(or)f(Columns)f(page)i(92)p eop +%%Page: 114 120 +114 119 bop 0 299 a Fi(114)281 b Fg(CHAPTER)30 b(10.)112 +b(SUMMAR)-8 b(Y)32 b(OF)e(ALL)g(FITSIO)f(USER-INTERF)-10 +b(A)m(CE)30 b(SUBR)m(OUTINES)382 555 y Fe(FTIROW\(unit,frow,nrows,)41 +b(>)48 b(status\))382 668 y(FTDROW\(unit,frow,nrows,)41 +b(>)48 b(status\))382 781 y(FTDRRG\(unit,rowrange,)42 +b(>)47 b(status\))382 894 y(FTDRWS\(unit,rowlist,nrow)o(s,)41 +b(>)48 b(status\))382 1007 y(FTICOL\(unit,colnum,ttype)o(,tf)o(orm,)41 +b(>)48 b(status\))382 1120 y(FTICLS\(unit,colnum,ncols)o(,tt)o(ype,)o +(tfor)o(m,)41 b(>)48 b(status\))382 1233 y(FTMVEC\(unit,colnum,newve)o +(cle)o(n,)42 b(>)47 b(status\))382 1346 y(FTDCOL\(unit,colnum,)42 +b(>)48 b(status\))382 1458 y(FTCPCL\(inunit,outunit,in)o(col)o(num,)o +(outc)o(oln)o(um,c)o(reat)o(eco)o(l,)42 b(>)47 b(status\);)0 +1716 y Fi(Read)31 b(and)e(W)-8 b(rite)31 b(Column)e(Data)j(Routines)d +(page)i(93)382 1974 y Fe(FTPCL[SLBIJEDCM]\(unit,co)o(lnu)o(m,fr)o(ow,f) +o(ele)o(m,ne)o(leme)o(nts)o(,val)o(ues,)41 b(>)47 b(status\))382 +2087 y(FTPCN[BIJED]\(unit,colnum)o(,fr)o(ow,f)o(elem)o(,ne)o(leme)o +(nts,)o(val)o(ues,)o(null)o(val)41 b(>)48 b(status\))382 +2199 y(FTPCLX\(unit,colnum,frow,)o(fbi)o(t,nb)o(it,l)o(ray)o(,)42 +b(>)47 b(status\))382 2312 y(FTPCLU\(unit,colnum,frow,)o(fel)o(em,n)o +(elem)o(ent)o(s,)42 b(>)47 b(status\))382 2425 y +(FTGCL\(unit,colnum,frow,f)o(ele)o(m,ne)o(leme)o(nts)o(,)42 +b(>)47 b(values,status\))382 2538 y(FTGCV[SBIJEDCM]\(unit,col)o(num)o +(,fro)o(w,fe)o(lem)o(,nel)o(emen)o(ts,)o(null)o(val,)41 +b(>)1098 2651 y(values,anyf,status\))382 2764 y +(FTGCF[SLBIJEDCM]\(unit,co)o(lnu)o(m,fr)o(ow,f)o(ele)o(m,ne)o(leme)o +(nts)o(,)h(>)1193 2877 y(values,flagvals,anyf,stat)o(us\))382 +2990 y(FTGSV[BIJED]\(unit,colnum)o(,na)o(xis,)o(naxe)o(s,f)o(pixe)o +(ls,l)o(pix)o(els,)o(incs)o(,nu)o(llva)o(l,)g(>)1002 +3103 y(array,anyf,status\))382 3216 y(FTGSF[BIJED]\(unit,colnum)o(,na)o +(xis,)o(naxe)o(s,f)o(pixe)o(ls,l)o(pix)o(els,)o(incs)o(,)g(>)1002 +3329 y(array,flagvals,anyf,statu)o(s\))382 3441 y +(FTGCX\(unit,colnum,frow,f)o(bit)o(,nbi)o(t,)g(>)47 b(lray,status\))382 +3554 y(FTGCX[IJD]\(unit,colnum,f)o(row)o(,nro)o(ws,f)o(bit)o(,nbi)o(t,) +42 b(>)47 b(array,status\))382 3667 y(FTGDES\(unit,colnum,rownu)o(m,)41 +b(>)48 b(nelements,offset,status\))382 3780 y +(FTPDES\(unit,colnum,rownu)o(m,n)o(elem)o(ents)o(,of)o(fset)o(,)42 +b(>)47 b(status\))0 4038 y Fi(Ro)m(w)31 b(Selection)f(and)f(Calculator) +h(Routines:)40 b(page)31 b(96)382 4295 y Fe(FTFROW\(unit,expr,firstro)o +(w,)41 b(nrows,)47 b(>)g(n_good_rows,)d(row_status,)h(status\))382 +4408 y(FTFFRW\(unit,)f(expr,)j(>)g(rownum,)f(status\))382 +4521 y(FTSROW\(inunit,)e(outunit,)h(expr,)i(>)g(status)f(\))382 +4634 y(FTCROW\(unit,datatype,exp)o(r,f)o(irst)o(row,)o(nel)o(emen)o +(ts,n)o(ulv)o(al,)41 b(>)620 4747 y(array,anynul,status\))382 +4860 y(FTCALC\(inunit,)j(expr,)i(outunit,)g(parName,)f(parInfo,)h(>)h +(status\))382 4973 y(FTCALC_RNG\(inunit,)c(expr,)j(outunit,)g(parName,) +f(parInfo,)573 5086 y(nranges,)g(firstrow,)h(lastrow,)f(>)j(status\)) +382 5199 y(FTTEXP\(unit,)c(expr,)j(>)g(datatype,)e(nelem,)h(naxis,)h +(naxes,)f(status\))0 5456 y Fi(Celestial)29 b(Co)s(ordinate)h(System)g +(Subroutines:)38 b(page)31 b(98)382 5714 y Fe(FTGICS\(unit,)44 +b(>)k(xrval,yrval,xrpix,yrpix)o(,xin)o(c,yi)o(nc,)o(rot,)o(coor)o(dty)o +(pe,s)o(tatu)o(s\))p eop +%%Page: 115 121 +115 120 bop 3764 299 a Fi(115)382 555 y Fe(FTGTCS\(unit,xcol,ycol,)42 +b(>)716 668 y(xrval,yrval,xrpix,yrpix,)o(xinc)o(,yi)o(nc,r)o(ot,c)o +(oor)o(dtyp)o(e,st)o(atu)o(s\))382 781 y(FTWLDP\(xpix,ypix,xrval,y)o +(rva)o(l,xr)o(pix,)o(yrp)o(ix,x)o(inc,)o(yin)o(c,ro)o(t,)1241 +894 y(coordtype,)j(>)i(xpos,ypos,status\))382 1007 y +(FTXYPX\(xpos,ypos,xrval,y)o(rva)o(l,xr)o(pix,)o(yrp)o(ix,x)o(inc,)o +(yin)o(c,ro)o(t,)1241 1120 y(coordtype,)e(>)i(xpix,ypix,status\))0 +1340 y Fi(File)30 b(Chec)m(ksum)f(Subroutines:)39 b(page)31 +b(99)382 1560 y Fe(FTPCKS\(unit,)44 b(>)k(status\))382 +1673 y(FTUCKS\(unit,)c(>)k(status\))382 1785 y(FTVCKS\(unit,)c(>)k +(dataok,hduok,status\))382 1898 y(FTGCKS\(unit,)c(>)k +(datasum,hdusum,status\))382 2011 y(FTESUM\(sum,complement,)42 +b(>)47 b(checksum\))382 2124 y(FTDSUM\(checksum,compleme)o(nt,)41 +b(>)48 b(sum\))0 2457 y Fi(Time)29 b(and)h(Date)i(Utilit)m(y)e +(Subroutines:)38 b(page)31 b(101)382 2677 y Fe(FTGSDT\()46 +b(>)h(day,)g(month,)f(year,)g(status)g(\))382 2790 y(FTGSTM\(>)f +(datestr,)h(timeref,)f(status\))382 2903 y(FTDT2S\()h(year,)g(month,)g +(day,)h(>)g(datestr,)f(status\))382 3016 y(FTTM2S\()g(year,)g(month,)g +(day,)h(hour,)f(minute,)g(second,)g(decimals,)764 3129 +y(>)h(datestr,)f(status\))382 3242 y(FTS2DT\(datestr,)d(>)48 +b(year,)e(month,)g(day,)h(status\))382 3354 y(FTS2TM\(datestr,)c(>)48 +b(year,)e(month,)g(day,)h(hour,)f(minute,)g(second,)g(status\))0 +3574 y Fi(General)30 b(Utilit)m(y)g(Subroutines:)38 b(page)31 +b(102)382 3794 y Fe(FTGHAD\(unit,)44 b(>)k(curaddr,nextaddr\))382 +3907 y(FTUPCH\(string\))382 4020 y(FTCMPS\(str_template,stri)o(ng,)o +(case)o(sen,)41 b(>)47 b(match,exact\))382 4133 y(FTTKEY\(keyword,)c(>) +48 b(status\))382 4246 y(FTTREC\(card,)c(>)k(status\))382 +4359 y(FTNCHK\(unit,)c(>)k(status\))382 4472 y(FTGKNM\(unit,)c(>)k +(keyword,)d(keylength,)g(status\))382 4585 y(FTPSVC\(card,)f(>)k +(value,comment,status\))382 4698 y(FTKEYN\(keyroot,seq_no,)42 +b(>)47 b(keyword,status\))382 4811 y(FTNKEY\(seq_no,keyroot,)42 +b(>)47 b(keyword,status\))382 4924 y(FTDTYP\(value,)d(>)j +(dtype,status\))382 5036 y(class)f(=)i(FTGKCL\(card\))382 +5149 y(FTASFM\(tform,)c(>)j(datacode,width,decimals,st)o(atus)o(\))382 +5262 y(FTBNFM\(tform,)d(>)j(datacode,repeat,width,stat)o(us\))382 +5375 y(FTGABC\(tfields,tform,spa)o(ce,)41 b(>)48 b +(rowlen,tbcol,status\))382 5488 y(FTGTHD\(template,)43 +b(>)48 b(card,hdtype,status\))382 5601 y(FTRWRG\(rowlist,)43 +b(maxrows,)j(maxranges,)f(>)i(numranges,)e(rangemin,)716 +5714 y(rangemax,)g(status\))p eop +%%Page: 116 122 +116 121 bop 0 299 a Fi(116)281 b Fg(CHAPTER)30 b(10.)112 +b(SUMMAR)-8 b(Y)32 b(OF)e(ALL)g(FITSIO)f(USER-INTERF)-10 +b(A)m(CE)30 b(SUBR)m(OUTINES)p eop +%%Page: 117 123 +117 122 bop 0 1225 a Ff(Chapter)65 b(11)0 1687 y Fl(P)-6 +b(arameter)77 b(De\014nitions)0 2180 y Fe(anyf)47 b(-)g(\(logical\))e +(set)i(to)g(TRUE)g(if)g(any)g(of)g(the)g(returned)f(data)g(values)h +(are)f(undefined)0 2293 y(array)g(-)i(\(any)e(datatype)g(except)g +(character\))f(array)h(of)i(bytes)e(to)h(be)g(read)g(or)g(written.)0 +2406 y(bitpix)f(-)i(\(integer\))d(bits)h(per)h(pixel:)f(8,)i(16,)f(32,) +f(-32,)h(or)g(-64)0 2518 y(blank)f(-)i(\(integer\))d(value)h(used)h +(for)g(undefined)e(pixels)h(in)i(integer)d(primary)h(array)0 +2631 y(blocksize)f(-)j(\(integer\))d(2880-byte)g(logical)h(record)g +(blocking)g(factor)477 2744 y(\(if)h(0)h(<)f(blocksize)e(<)j(11\))f(or) +g(the)g(actual)f(block)g(size)h(in)g(bytes)477 2857 y(\(if)g(10)g(<)h +(blocksize)d(<)j(28800\).)93 b(As)47 b(of)g(version)f(3.3)h(of)g +(FITSIO,)477 2970 y(blocksizes)e(greater)h(than)h(2880)f(are)h(no)g +(longer)g(supported.)0 3083 y(bscale)f(-)i(\(double)d(precision\))g +(scaling)h(factor)g(for)h(the)g(primary)f(array)0 3196 +y(bytlen)g(-)i(\(integer\))d(length)h(of)h(the)g(data)g(unit,)f(in)h +(bytes)0 3309 y(bzero)f(-)i(\(double)e(precision\))f(zero)h(point)h +(for)g(primary)e(array)i(scaling)0 3422 y(card)g(-)g(\(character*80\))d +(header)i(record)g(to)h(be)h(read)e(or)h(written)0 3535 +y(casesen)f(-)h(\(logical\))f(will)g(string)g(matching)g(be)h(case)g +(sensitive?)0 3648 y(checksum)f(-)h(\(character*16\))d(encoded)i +(checksum)f(string)0 3760 y(colname)h(-)h(\(character\))e(ASCII)h(name) +h(of)g(the)g(column)0 3873 y(colnum)f(-)i(\(integer\))d(number)h(of)h +(the)g(column)f(\(first)g(column)g(=)i(1\))0 3986 y(coltemplate)d(-)i +(\(character\))e(template)g(string)i(to)g(be)g(matched)f(to)h(column)f +(names)0 4099 y(comment)g(-)h(\(character\))e(the)i(keyword)f(comment)g +(field)0 4212 y(comments)g(-)h(\(character)e(array\))h(keyword)g +(comment)g(fields)0 4325 y(compid)g(-)i(\(integer\))d(the)i(type)f(of)i +(computer)d(that)i(the)g(program)e(is)j(running)d(on)0 +4438 y(complement)g(-)i(\(logical\))f(should)g(the)h(checksum)e(be)i +(complemented?)0 4551 y(coordtype)e(-)j(\(character\))c(type)j(of)g +(coordinate)e(projection)g(\(-SIN,)h(-TAN,)h(-ARC,)477 +4664 y(-NCP,)g(-GLS,)f(-MER,)g(or)i(-AIT\))0 4777 y(cube)f(-)g(3D)g +(data)g(cube)g(of)g(the)g(appropriate)d(datatype)0 4890 +y(curaddr)i(-)h(\(integer\))f(starting)f(address)h(\(in)h(bytes\))f(of) +h(the)g(CHDU)0 5002 y(datacode)f(-)h(\(integer\))e(symbolic)h(code)g +(of)i(the)f(binary)f(table)g(column)g(datatype)0 5115 +y(dataok)g(-)i(\(integer\))d(was)i(the)g(data)f(unit)h(verification)d +(successful)h(\(=1\))i(or)430 5228 y(not)f(\(=)i(-1\).)94 +b(Equals)46 b(zero)h(if)g(the)g(DATASUM)f(keyword)f(is)j(not)f +(present.)0 5341 y(datasum)f(-)h(\(double)f(precision\))f(32-bit)h(1's) +h(complement)e(checksum)h(for)h(the)f(data)h(unit)0 5454 +y(datatype)f(-)h(\(character\))e(datatype)g(\(format\))h(of)h(the)g +(binary)f(table)g(column)0 5567 y(datestr)94 b(-)47 b(\(string\))f +(FITS)g(date/time)f(string:)h('YYYY-MM-DDThh:mm:ss.ddd')o(,)525 +5680 y('YYYY-MM-dd',)e(or)j('dd/mm/yy')1882 5942 y Fi(117)p +eop +%%Page: 118 124 +118 123 bop 0 299 a Fi(118)1779 b Fg(CHAPTER)30 b(11.)112 +b(P)-8 b(ARAMETER)30 b(DEFINITIONS)0 555 y Fe(day)47 +b(-)g(\(integer\))f(current)f(day)i(of)h(the)e(month)0 +668 y(dblval)g(-)i(\(double)d(precision\))g(fractional)g(part)i(of)g +(the)g(keyword)f(value)0 781 y(decimals)g(-)h(\(integer\))e(number)h +(of)i(decimal)d(places)h(to)i(be)f(displayed)0 894 y(dim1)g(-)g +(\(integer\))e(actual)h(size)h(of)g(the)g(first)g(dimension)e(of)i(the) +g(image)f(or)h(cube)g(array)0 1007 y(dim2)g(-)g(\(integer\))e(actual)h +(size)h(of)g(the)g(second)f(dimension)g(of)h(the)g(cube)f(array)0 +1120 y(dispwidth)f(-)j(\(integer\))d(-)i(the)g(display)f(width)h +(\(length)e(of)j(string\))d(for)i(a)h(column)0 1233 y(dtype)e(-)i +(\(character\))d(datatype)g(of)i(the)g(keyword)f(\('C',)g('L',)h('I',) +94 b(or)48 b('F'\))764 1346 y(C)f(=)h(character)d(string)764 +1458 y(L)i(=)h(logical)764 1571 y(I)f(=)h(integer)764 +1684 y(F)f(=)h(floating)d(point)h(number)0 1797 y(errmsg)g(-)i +(\(character*80\))43 b(oldest)k(error)f(message)g(on)h(the)g(internal)e +(stack)0 1910 y(errtext)h(-)h(\(character*30\))d(descriptive)h(error)h +(message)g(corresponding)e(to)j(error)g(number)0 2023 +y(casesen)f(-)h(\(logical\))f(true)g(if)h(column)f(name)h(matching)f +(is)h(case)f(sensitive)0 2136 y(exact)g(-)i(\(logical\))d(do)i(the)g +(strings)f(match)g(exactly,)g(or)h(were)g(wildcards)e(used?)0 +2249 y(exclist)94 b(\(character)45 b(array\))h(list)g(of)h(names)g(to)g +(be)g(excluded)f(from)g(search)0 2362 y(exists)142 b(-)47 +b(flag)g(indicating)e(whether)g(the)i(file)g(or)g(compressed)e(file)i +(exists)f(on)h(disk)0 2475 y(extend)f(-)i(\(logical\))d(true)h(if)i +(there)e(may)h(be)g(extensions)e(following)g(the)i(primary)f(data)0 +2588 y(extname)g(-)h(\(character\))e(value)h(of)i(the)e(EXTNAME)g +(keyword)g(\(if)h(not)g(blank\))0 2700 y(fbit)g(-)g(\(integer\))e +(first)i(bit)g(in)g(the)g(field)f(to)h(be)g(read)g(or)g(written)0 +2813 y(felem)f(-)i(\(integer\))d(first)h(pixel)h(of)g(the)g(element)f +(vector)g(\(ignored)f(for)i(ASCII)g(tables\))0 2926 y(filename)f(-)h +(\(character\))e(name)h(of)i(the)e(FITS)h(file)0 3039 +y(flagvals)f(-)h(\(logical)f(array\))g(True)g(if)h(corresponding)e +(data)h(element)g(is)h(undefined)0 3152 y(fparm)f(-)i(\(integer\))d +(sequence)h(number)g(of)h(the)g(first)f(group)h(parameter)e(to)i(read)g +(or)g(write)0 3265 y(fpixel)f(-)i(\(integer\))d(the)i(first)f(pixel)g +(position)0 3378 y(fpixels)g(-)h(\(integer)f(array\))g(the)h(first)f +(included)g(pixel)g(in)h(each)g(dimension)0 3491 y(frow)g(-)g +(\(integer\))e(beginning)h(row)h(number)f(\(first)g(row)h(of)g(table)f +(=)i(1\))0 3604 y(gcount)e(-)i(\(integer\))d(value)h(of)h(the)g(GCOUNT) +f(keyword)g(\(usually)g(=)h(1\))0 3717 y(group)f(-)i(\(integer\))d +(sequence)h(number)g(of)h(the)g(data)f(group)h(\(=0)g(for)g +(non-grouped)d(data\))0 3830 y(hdtype)i(-)i(\(integer\))d(header)h +(record)g(type:)g(-1=delete;)93 b(0=append)46 b(or)h(replace;)907 +3942 y(1=append;)e(2=this)h(is)h(the)g(END)g(keyword)0 +4055 y(hduok)f(-)i(\(integer\))d(was)i(the)g(HDU)g(verification)d +(successful)h(\(=1\))i(or)430 4168 y(not)f(\(=)i(-1\).)94 +b(Equals)46 b(zero)h(if)g(the)g(CHECKSUM)e(keyword)h(is)h(not)g +(present.)0 4281 y(hdusum)f(-)i(\(double)d(precision\))g(32)j(bit)e +(1's)h(complement)e(checksum)h(for)h(the)g(entire)f(CHDU)0 +4394 y(hdutype)g(-)h(\(integer\))f(type)g(of)h(HDU:)g(0)g(=)h(primary)e +(array)g(or)h(IMAGE,)f(1)i(=)f(ASCII)g(table,)907 4507 +y(2)g(=)h(binary)e(table,)g(-1)h(=)h(unknown)0 4620 y(history)e(-)h +(\(character\))e(the)i(HISTORY)f(keyword)g(comment)f(string)0 +4733 y(hour)i(-)g(\(integer\))e(hour)i(from)g(0)g(-)h(23)0 +4846 y(image)e(-)i(2D)f(image)f(of)i(the)e(appropriate)f(datatype)0 +4959 y(inclist)94 b(\(character)45 b(array\))h(list)g(of)h(names)g(to)g +(be)g(included)f(in)h(search)0 5072 y(incs)g(-)g(\(integer)f(array\))g +(sampling)f(interval)h(for)h(pixels)f(in)h(each)g(FITS)f(dimension)0 +5185 y(intval)g(-)i(\(integer\))d(integer)h(part)g(of)h(the)g(keyword)f +(value)0 5297 y(iounit)g(-)i(\(integer\))d(value)h(of)h(an)h(unused)e +(I/O)h(unit)f(number)0 5410 y(iunit)g(-)i(\(integer\))d(logical)h(unit) +h(number)f(associated)f(with)h(the)h(input)g(FITS)f(file,)h(1-199)0 +5523 y(key_no)f(-)i(\(integer\))d(sequence)g(number)h(\(starting)g +(with)g(1\))i(of)f(the)g(keyword)e(record)0 5636 y(keylength)g(-)j +(\(integer\))d(length)h(of)h(the)g(keyword)f(name)p eop +%%Page: 119 125 +119 124 bop 3764 299 a Fi(119)0 555 y Fe(keyroot)46 b(-)h +(\(character\))e(root)i(string)f(for)h(the)g(keyword)e(name)0 +668 y(keysadd)h(-\(integer\))f(number)h(of)h(new)g(keyword)f(records)g +(which)g(can)h(fit)g(in)g(the)g(CHU)0 781 y(keysexist)e(-)j +(\(integer\))d(number)h(of)h(existing)f(keyword)g(records)f(in)j(the)f +(CHU)0 894 y(keyval)f(-)i(value)e(of)h(the)g(keyword)f(in)h(the)g +(appropriate)e(datatype)0 1007 y(keyvals)h(-)h(\(array\))f(value)g(of)i +(the)f(keywords)e(in)i(the)g(appropriate)e(datatype)0 +1120 y(keyword)h(-)h(\(character*8\))d(name)j(of)g(a)h(keyword)0 +1233 y(lray)f(-)g(\(logical)f(array\))g(array)g(of)h(logical)f(values)g +(corresponding)e(to)k(the)e(bit)h(array)0 1346 y(lpixels)f(-)h +(\(integer)f(array\))g(the)h(last)f(included)g(pixel)g(in)i(each)e +(dimension)0 1458 y(match)g(-)i(\(logical\))d(do)i(the)g(2)h(strings)d +(match?)0 1571 y(maxdim)h(-)i(\(integer\))d(dimensioned)g(size)h(of)h +(the)g(NAXES,)f(TTYPE,)g(TFORM)h(or)g(TUNIT)f(arrays)0 +1684 y(max_keys)g(-)h(\(integer\))e(maximum)h(number)g(of)h(keywords)f +(to)h(search)f(for)0 1797 y(minute)g(-)i(\(integer\))d(minute)h(of)h +(an)g(hour)g(\(0)g(-)h(59\))0 1910 y(month)e(-)i(\(integer\))d(current) +h(month)g(of)h(the)g(year)g(\(1)g(-)h(12\))0 2023 y(morekeys)e(-)h +(\(integer\))e(will)i(leave)f(space)h(in)g(the)g(header)f(for)h(this)f +(many)h(more)g(keywords)0 2136 y(naxes)f(-)i(\(integer)d(array\))h +(size)h(of)g(each)g(dimension)e(in)i(the)g(FITS)g(array)0 +2249 y(naxis)f(-)i(\(integer\))d(number)h(of)h(dimensions)e(in)j(the)e +(FITS)h(array)0 2362 y(naxis1)f(-)i(\(integer\))d(length)h(of)h(the)g +(X/first)f(axis)g(of)i(the)f(FITS)f(array)0 2475 y(naxis2)g(-)i +(\(integer\))d(length)h(of)h(the)g(Y/second)f(axis)g(of)h(the)g(FITS)g +(array)0 2588 y(naxis3)f(-)i(\(integer\))d(length)h(of)h(the)g(Z/third) +f(axis)g(of)i(the)f(FITS)f(array)0 2700 y(nbit)h(-)g(\(integer\))e +(number)h(of)i(bits)e(in)h(the)g(field)g(to)g(read)g(or)g(write)0 +2813 y(nchars)f(-)i(\(integer\))d(number)h(of)h(characters)e(to)i(read) +g(and)g(return)0 2926 y(ncols)f(-)i(\(integer\))d(number)h(of)h +(columns)0 3039 y(nelements)e(-)j(\(integer\))d(number)h(of)h(data)g +(elements)e(to)j(read)e(or)h(write)0 3152 y(nexc)142 +b(\(integer\))93 b(number)46 b(of)h(names)g(in)g(the)g(exclusion)e +(list)i(\(may)f(=)i(0\))0 3265 y(nhdu)f(-)g(\(integer\))e(absolute)h +(number)g(of)h(the)g(HDU)g(\(1st)g(HDU)g(=)g(1\))0 3378 +y(ninc)142 b(\(integer\))93 b(number)46 b(of)h(names)g(in)g(the)g +(inclusion)e(list)0 3491 y(nmove)h(-)i(\(integer\))d(number)h(of)h +(HDUs)g(to)g(move)g(\(+)g(or)g(-\),)g(relative)f(to)h(current)f +(position)0 3604 y(nfound)g(-)i(\(integer\))d(number)h(of)h(keywords)f +(found)g(\(highest)g(keyword)f(number\))0 3717 y(no_keys)h(-)h +(\(integer\))f(number)g(of)h(keywords)e(to)j(write)e(in)h(the)g +(sequence)0 3830 y(nparm)f(-)i(\(integer\))d(number)h(of)h(group)g +(parameters)e(to)i(read)g(or)g(write)0 3942 y(nrows)f(-)i(\(integer\))d +(number)h(of)h(rows)g(in)g(the)g(table)0 4055 y(nullval)f(-)h(value)g +(to)g(represent)e(undefined)g(pixels,)h(of)h(the)g(appropriate)e +(datatype)0 4168 y(nextaddr)h(-)h(\(integer\))e(starting)h(address)g +(\(in)h(bytes\))f(of)h(the)g(HDU)g(following)e(the)i(CHDU)0 +4281 y(offset)f(-)i(\(integer\))d(byte)h(offset)h(in)g(the)g(heap)f(to) +h(the)g(first)g(element)f(of)h(the)g(array)0 4394 y(oldkey)f(-)i +(\(character\))c(old)j(name)g(of)g(keyword)f(to)h(be)g(modified)0 +4507 y(ounit)f(-)i(\(integer\))d(logical)h(unit)h(number)f(associated)f +(with)h(the)h(output)f(FITS)h(file)g(1-199)0 4620 y(pcount)f(-)i +(\(integer\))d(value)h(of)h(the)g(PCOUNT)f(keyword)g(\(usually)g(=)h +(0\))0 4733 y(repeat)f(-)i(\(integer\))d(length)h(of)h(element)f +(vector)g(\(e.g.)g(12J\);)h(ignored)f(for)g(ASCII)h(table)0 +4846 y(rot)g(-)g(\(double)f(precision\))f(celestial)g(coordinate)g +(rotation)h(angle)g(\(degrees\))0 4959 y(rowlen)g(-)i(\(integer\))d +(length)h(of)h(a)h(table)e(row,)h(in)g(characters)e(or)i(bytes)0 +5072 y(rowlist)f(-)h(\(integer)f(array\))g(list)h(of)g(row)g(numbers)e +(to)j(be)f(deleted)f(in)h(increasing)e(order)0 5185 y(rownum)h(-)i +(\(integer\))d(number)h(of)h(the)g(row)g(\(first)f(row)h(=)g(1\))0 +5297 y(rowrange-)e(\(string\))h(list)g(of)i(rows)e(or)h(row)g(ranges)f +(to)i(be)f(deleted)0 5410 y(rwmode)f(-)i(\(integer\))d(file)h(access)h +(mode:)f(0)h(=)h(readonly,)d(1)j(=)f(readwrite)0 5523 +y(second)142 b(\(double\)-)45 b(second)h(within)g(minute)g(\(0)h(-)h +(60.9999999999\))c(\(leap)i(second!\))0 5636 y(seq_no)g(-)i +(\(integer\))d(the)i(sequence)e(number)h(to)i(append)e(to)h(the)g +(keyword)f(root)g(name)p eop +%%Page: 120 126 +120 125 bop 0 299 a Fi(120)1779 b Fg(CHAPTER)30 b(11.)112 +b(P)-8 b(ARAMETER)30 b(DEFINITIONS)0 555 y Fe(simple)46 +b(-)i(\(logical\))d(does)h(the)h(FITS)g(file)g(conform)e(to)j(all)f +(the)f(FITS)h(standards)0 668 y(snull)f(-)i(\(character\))d(value)h +(used)h(to)g(represent)e(undefined)g(values)h(in)i(ASCII)e(table)0 +781 y(space)g(-)i(\(integer\))d(number)h(of)h(blank)g(spaces)f(to)h +(leave)f(between)g(ASCII)h(table)f(columns)0 894 y(startchar)f(-)j +(\(integer\))d(first)h(character)g(in)h(the)g(row)g(to)g(be)g(read)0 +1007 y(startno)f(-)h(\(integer\))f(value)g(of)h(the)g(first)f(keyword)g +(sequence)g(number)g(\(usually)f(1\))0 1120 y(status)h(-)i(\(integer\)) +d(returned)g(error)i(status)f(code)g(\(0)i(=)f(OK\))0 +1233 y(str_template)d(\(character\))h(template)h(string)g(to)h(be)g +(matched)f(to)h(reference)e(string)0 1346 y(stream)h(-)i(\(character\)) +c(output)i(stream)g(for)h(the)g(report:)f(either)g('STDOUT')g(or)h +('STDERR')0 1458 y(string)f(-)i(\(character\))c(character)i(string)0 +1571 y(sum)h(-)g(\(double)f(precision\))f(32)i(bit)g(unsigned)f +(checksum)f(value)0 1684 y(tbcol)h(-)i(\(integer)d(array\))h(column)h +(number)f(of)h(the)g(first)f(character)f(in)j(the)e(field\(s\))0 +1797 y(tdisp)g(-)i(\(character\))d(Fortran)g(type)i(display)f(format)g +(for)h(the)g(table)f(column)0 1910 y(template-\(character\))c(template) +k(string)g(for)h(a)g(FITS)g(header)f(record)0 2023 y(tfields)g(-)h +(\(integer\))f(number)g(of)h(fields)f(\(columns\))f(in)i(the)g(table)0 +2136 y(tform)f(-)i(\(character)d(array\))h(format)g(of)h(the)g +(column\(s\);)e(allowed)h(values)g(are:)430 2249 y(For)g(ASCII)h +(tables:)93 b(Iw,)47 b(Aw,)g(Fww.dd,)f(Eww.dd,)g(or)h(Dww.dd)430 +2362 y(For)f(binary)h(tables:)e(rL,)i(rX,)g(rB,)g(rI,)g(rJ,)g(rA,)g +(rAw,)f(rE,)h(rD,)g(rC,)g(rM)430 2475 y(where)f('w'=width)f(of)i(the)g +(field,)f('d'=no.)g(of)h(decimals,)f('r'=repeat)f(count)430 +2588 y(Note)h(that)h(the)g('rAw')f(form)h(is)g(non-standard)d +(extension)i(to)h(the)430 2700 y(TFORM)f(keyword)g(syntax)g(that)g(is)i +(not)f(specifically)d(defined)i(in)h(the)430 2813 y(Binary)f(Tables)g +(definition)f(document.)0 2926 y(theap)h(-)i(\(integer\))d(zero)i +(indexed)f(byte)g(offset)g(of)h(starting)f(address)g(of)h(the)g(heap) +430 3039 y(relative)e(to)i(the)g(beginning)e(of)j(the)f(binary)f(table) +g(data)0 3152 y(tnull)g(-)i(\(integer\))d(value)h(used)h(to)g +(represent)f(undefined)f(values)h(in)h(binary)f(table)0 +3265 y(ttype)g(-)i(\(character)d(array\))h(label)g(for)h(table)g +(column\(s\))0 3378 y(tscal)f(-)i(\(double)e(precision\))f(scaling)g +(factor)i(for)f(table)h(column)0 3491 y(tunit)f(-)i(\(character)d +(array\))h(physical)f(unit)i(for)g(table)f(column\(s\))0 +3604 y(tzero)g(-)i(\(double)e(precision\))f(scaling)g(zero)i(point)f +(for)h(table)g(column)0 3717 y(unit)94 b(-)48 b(\(integer\))d(logical)h +(unit)h(number)f(associated)f(with)h(the)h(FITS)g(file)f(\(1-199\))0 +3830 y(units)g(-)i(\(character\))d(the)h(keyword)g(units)h(string)f +(\(e.g.,)g('km/s'\))0 3942 y(value)g(-)i(\(character\))d(the)h(keyword) +g(value)h(string)0 4055 y(values)f(-)i(array)e(of)h(data)g(values)f(of) +h(the)g(appropriate)e(datatype)0 4168 y(varidat)h(-)h(\(integer\))f +(size)g(in)h(bytes)g(of)g(the)g('variable)e(length)h(data)h(area')525 +4281 y(following)e(the)i(binary)f(table)h(data)f(\(usually)g(=)h(0\))0 +4394 y(version)f(-)h(\(real\))f(current)g(revision)g(number)g(of)h(the) +g(library)0 4507 y(width)f(-)i(\(integer\))d(width)h(of)i(the)f +(character)e(string)h(field)0 4620 y(xcol)h(-)g(\(integer\))e(number)h +(of)i(the)f(column)f(containing)f(the)i(X)g(coordinate)e(values)0 +4733 y(xinc)i(-)g(\(double)f(precision\))f(X)i(axis)g(coordinate)e +(increment)g(at)i(reference)f(pixel)g(\(deg\))0 4846 +y(xpix)h(-)g(\(double)f(precision\))f(X)i(axis)g(pixel)f(location)0 +4959 y(xpos)h(-)g(\(double)f(precision\))f(X)i(axis)g(celestial)e +(coordinate)g(\(usually)h(RA\))h(\(deg\))0 5072 y(xrpix)f(-)i(\(double) +e(precision\))f(X)i(axis)g(reference)e(pixel)h(array)h(location)0 +5185 y(xrval)f(-)i(\(double)e(precision\))f(X)i(axis)g(coordinate)e +(value)h(at)h(the)g(reference)e(pixel)i(\(deg\))0 5297 +y(ycol)g(-)g(\(integer\))e(number)h(of)i(the)f(column)f(containing)f +(the)i(X)g(coordinate)e(values)0 5410 y(year)i(-)g(\(integer\))e(last)i +(2)g(digits)g(of)g(the)g(year)f(\(00)h(-)h(99\))0 5523 +y(yinc)f(-)g(\(double)f(precision\))f(Y)i(axis)g(coordinate)e +(increment)g(at)i(reference)f(pixel)g(\(deg\))0 5636 +y(ypix)h(-)g(\(double)f(precision\))f(y)i(axis)g(pixel)f(location)p +eop +%%Page: 121 127 +121 126 bop 3764 299 a Fi(121)0 555 y Fe(ypos)47 b(-)g(\(double)f +(precision\))f(y)i(axis)g(celestial)e(coordinate)g(\(usually)h(DEC\))g +(\(deg\))0 668 y(yrpix)g(-)i(\(double)e(precision\))f(Y)i(axis)g +(reference)e(pixel)h(array)h(location)0 781 y(yrval)f(-)i(\(double)e +(precision\))f(Y)i(axis)g(coordinate)e(value)h(at)h(the)g(reference)e +(pixel)i(\(deg\))p eop +%%Page: 122 128 +122 127 bop 0 299 a Fi(122)1779 b Fg(CHAPTER)30 b(11.)112 +b(P)-8 b(ARAMETER)30 b(DEFINITIONS)p eop +%%Page: 123 129 +123 128 bop 0 1225 a Ff(Chapter)65 b(12)0 1687 y Fl(FITSIO)76 +b(Error)h(Status)h(Co)6 b(des)0 2180 y Fe(Status)46 b(codes)g(in)i(the) +f(range)f(-99)h(to)g(-999)94 b(and)47 b(1)h(to)f(999)g(are)g(reserved)e +(for)i(future)0 2293 y(FITSIO)f(use.)95 2518 y(0)96 b(OK,)47 +b(no)g(error)0 2631 y(101)95 b(input)46 b(and)h(output)f(files)g(are)h +(the)g(same)0 2744 y(103)95 b(too)47 b(many)f(FITS)h(files)f(open)h(at) +g(once;)f(all)h(internal)f(buffers)g(full)0 2857 y(104)95 +b(error)46 b(opening)g(existing)f(file)0 2970 y(105)95 +b(error)46 b(creating)g(new)g(FITS)h(file;)f(\(does)h(a)g(file)g(with)g +(this)f(name)h(already)f(exist?\))0 3083 y(106)95 b(error)46 +b(writing)g(record)g(to)h(FITS)g(file)0 3196 y(107)95 +b(end-of-file)44 b(encountered)h(while)h(reading)g(record)g(from)h +(FITS)g(file)0 3309 y(108)95 b(error)46 b(reading)g(record)g(from)h +(file)0 3422 y(110)95 b(error)46 b(closing)g(FITS)g(file)0 +3535 y(111)95 b(internal)45 b(array)i(dimensions)e(exceeded)0 +3648 y(112)95 b(Cannot)46 b(modify)g(file)g(with)h(readonly)f(access)0 +3760 y(113)95 b(Could)46 b(not)h(allocate)e(memory)0 +3873 y(114)95 b(illegal)45 b(logical)h(unit)h(number;)f(must)g(be)i +(between)d(1)j(-)f(199,)g(inclusive)0 3986 y(115)95 b(NULL)46 +b(input)h(pointer)e(to)j(routine)0 4099 y(116)95 b(error)46 +b(seeking)g(position)f(in)j(file)0 4325 y(121)95 b(invalid)45 +b(URL)i(prefix)f(on)i(file)e(name)0 4438 y(122)95 b(tried)46 +b(to)h(register)f(too)h(many)f(IO)h(drivers)0 4551 y(123)95 +b(driver)46 b(initialization)e(failed)0 4664 y(124)95 +b(matching)45 b(driver)h(is)h(not)g(registered)0 4777 +y(125)95 b(failed)46 b(to)h(parse)f(input)h(file)f(URL)0 +4890 y(126)95 b(parse)46 b(error)g(in)i(range)e(list)0 +5115 y(151)95 b(bad)47 b(argument)e(in)i(shared)f(memory)g(driver)0 +5228 y(152)95 b(null)46 b(pointer)g(passed)g(as)h(an)h(argument)0 +5341 y(153)95 b(no)47 b(more)f(free)h(shared)f(memory)g(handles)0 +5454 y(154)95 b(shared)46 b(memory)g(driver)g(is)h(not)g(initialized)0 +5567 y(155)95 b(IPC)47 b(error)f(returned)f(by)j(a)f(system)f(call)0 +5680 y(156)95 b(no)47 b(memory)f(in)h(shared)f(memory)g(driver)1882 +5942 y Fi(123)p eop +%%Page: 124 130 +124 129 bop 0 299 a Fi(124)1613 b Fg(CHAPTER)30 b(12.)112 +b(FITSIO)30 b(ERR)m(OR)g(ST)-8 b(A)g(TUS)30 b(CODES)0 +555 y Fe(157)95 b(resource)45 b(deadlock)h(would)g(occur)0 +668 y(158)95 b(attempt)45 b(to)j(open/create)c(lock)j(file)g(failed)0 +781 y(159)95 b(shared)46 b(memory)g(block)g(cannot)g(be)h(resized)f(at) +h(the)g(moment)0 1120 y(201)95 b(header)46 b(not)h(empty;)f(can't)g +(write)g(required)g(keywords)0 1233 y(202)95 b(specified)45 +b(keyword)h(name)g(was)h(not)g(found)g(in)g(the)g(header)0 +1346 y(203)95 b(specified)45 b(header)h(record)g(number)g(is)h(out)g +(of)g(bounds)0 1458 y(204)95 b(keyword)45 b(value)i(field)f(is)h(blank) +0 1571 y(205)95 b(keyword)45 b(value)i(string)f(is)h(missing)f(the)h +(closing)f(quote)g(character)0 1684 y(207)95 b(illegal)45 +b(character)h(in)h(keyword)f(name)g(or)i(header)e(record)0 +1797 y(208)95 b(keyword)45 b(does)i(not)g(have)g(expected)e(name.)i +(Keyword)e(out)i(of)g(sequence?)0 1910 y(209)95 b(keyword)45 +b(does)i(not)g(have)g(expected)e(integer)h(value)0 2023 +y(210)95 b(could)46 b(not)h(find)g(the)f(required)g(END)h(header)f +(keyword)0 2136 y(211)95 b(illegal)45 b(BITPIX)i(keyword)e(value)0 +2249 y(212)95 b(illegal)45 b(NAXIS)i(keyword)f(value)0 +2362 y(213)95 b(illegal)45 b(NAXISn)i(keyword)e(value:)h(must)h(be)g(0) +h(or)f(positive)e(integer)0 2475 y(214)95 b(illegal)45 +b(PCOUNT)i(keyword)e(value)0 2588 y(215)95 b(illegal)45 +b(GCOUNT)i(keyword)e(value)0 2700 y(216)95 b(illegal)45 +b(TFIELDS)h(keyword)g(value)0 2813 y(217)95 b(negative)45 +b(ASCII)i(or)g(binary)f(table)g(width)h(value)f(\(NAXIS1\))0 +2926 y(218)95 b(negative)45 b(number)h(of)h(rows)g(in)g(ASCII)g(or)g +(binary)f(table)g(\(NAXIS2\))0 3039 y(219)95 b(column)46 +b(name)g(\(TTYPE)g(keyword\))g(not)h(found)0 3152 y(220)95 +b(illegal)45 b(SIMPLE)i(keyword)e(value)0 3265 y(221)95 +b(could)46 b(not)h(find)g(the)f(required)g(SIMPLE)g(header)g(keyword)0 +3378 y(222)95 b(could)46 b(not)h(find)g(the)f(required)g(BITPIX)g +(header)g(keyword)0 3491 y(223)95 b(could)46 b(not)h(find)g(the)f +(required)g(NAXIS)g(header)g(keyword)0 3604 y(224)95 +b(could)46 b(not)h(find)g(all)f(the)h(required)f(NAXISn)g(keywords)g +(in)h(the)g(header)0 3717 y(225)95 b(could)46 b(not)h(find)g(the)f +(required)g(XTENSION)g(header)g(keyword)0 3830 y(226)95 +b(the)47 b(CHDU)f(is)h(not)g(an)g(ASCII)g(table)f(extension)0 +3942 y(227)95 b(the)47 b(CHDU)f(is)h(not)g(a)h(binary)e(table)g +(extension)0 4055 y(228)95 b(could)46 b(not)h(find)g(the)f(required)g +(PCOUNT)g(header)g(keyword)0 4168 y(229)95 b(could)46 +b(not)h(find)g(the)f(required)g(GCOUNT)g(header)g(keyword)0 +4281 y(230)95 b(could)46 b(not)h(find)g(the)f(required)g(TFIELDS)g +(header)g(keyword)0 4394 y(231)95 b(could)46 b(not)h(find)g(all)f(the)h +(required)f(TBCOLn)g(keywords)g(in)h(the)g(header)0 4507 +y(232)95 b(could)46 b(not)h(find)g(all)f(the)h(required)f(TFORMn)g +(keywords)g(in)h(the)g(header)0 4620 y(233)95 b(the)47 +b(CHDU)f(is)h(not)g(an)g(IMAGE)g(extension)0 4733 y(234)95 +b(illegal)45 b(TBCOL)i(keyword)f(value;)g(out)h(of)g(range)0 +4846 y(235)95 b(this)46 b(operation)g(only)g(allowed)g(for)h(ASCII)f +(or)h(BINARY)g(table)f(extension)0 4959 y(236)95 b(column)46 +b(is)h(too)g(wide)f(to)i(fit)f(within)f(the)h(specified)e(width)h(of)h +(the)g(ASCII)g(table)0 5072 y(237)95 b(the)47 b(specified)e(column)h +(name)h(template)e(matched)h(more)h(than)f(one)h(column)f(name)0 +5185 y(241)95 b(binary)46 b(table)g(row)h(width)f(is)i(not)e(equal)h +(to)g(the)g(sum)g(of)g(the)g(field)f(widths)0 5297 y(251)95 +b(unrecognizable)44 b(type)i(of)h(FITS)g(extension)0 +5410 y(252)95 b(unrecognizable)44 b(FITS)i(record)0 5523 +y(253)95 b(END)47 b(keyword)e(contains)h(non-blank)f(characters)g(in)i +(columns)f(9-80)0 5636 y(254)95 b(Header)46 b(fill)g(area)h(contains)f +(non-blank)f(characters)p eop +%%Page: 125 131 +125 130 bop 3764 299 a Fi(125)0 555 y Fe(255)95 b(Data)46 +b(fill)h(area)g(contains)e(non-blank)g(on)j(non-zero)d(values)0 +668 y(261)95 b(unable)46 b(to)h(parse)f(the)h(TFORM)g(keyword)e(value)i +(string)0 781 y(262)95 b(unrecognizable)44 b(TFORM)i(datatype)f(code)0 +894 y(263)95 b(illegal)45 b(TDIMn)i(keyword)f(value)0 +1120 y(301)95 b(illegal)45 b(HDU)i(number;)f(less)h(than)f(1)i(or)f +(greater)f(than)h(internal)e(buffer)h(size)0 1233 y(302)95 +b(column)46 b(number)g(out)h(of)g(range)f(\(1)h(-)h(999\))0 +1346 y(304)95 b(attempt)45 b(to)j(move)e(to)h(negative)f(file)h(record) +f(number)0 1458 y(306)95 b(attempted)45 b(to)i(read)g(or)g(write)f(a)i +(negative)d(number)h(of)i(bytes)e(in)h(the)g(FITS)g(file)0 +1571 y(307)95 b(illegal)45 b(starting)h(row)h(number)f(for)h(table)f +(read)h(or)g(write)f(operation)0 1684 y(308)95 b(illegal)45 +b(starting)h(element)g(number)g(for)h(table)f(read)h(or)g(write)f +(operation)0 1797 y(309)95 b(attempted)45 b(to)i(read)g(or)g(write)f +(character)g(string)g(in)h(non-character)d(table)i(column)0 +1910 y(310)95 b(attempted)45 b(to)i(read)g(or)g(write)f(logical)g +(value)g(in)i(non-logical)c(table)j(column)0 2023 y(311)95 +b(illegal)45 b(ASCII)i(table)f(TFORM)h(format)f(code)g(for)h(attempted) +e(operation)0 2136 y(312)95 b(illegal)45 b(binary)i(table)f(TFORM)g +(format)g(code)h(for)g(attempted)e(operation)0 2249 y(314)95 +b(value)46 b(for)h(undefined)e(pixels)h(has)h(not)g(been)g(defined)0 +2362 y(317)95 b(attempted)45 b(to)i(read)g(or)g(write)f(descriptor)f +(in)i(a)h(non-descriptor)c(field)0 2475 y(320)95 b(number)46 +b(of)h(array)f(dimensions)f(out)i(of)g(range)0 2588 y(321)95 +b(first)46 b(pixel)g(number)g(is)i(greater)d(than)i(the)g(last)g(pixel) +f(number)0 2700 y(322)95 b(attempt)45 b(to)j(set)f(BSCALE)f(or)h +(TSCALn)f(scaling)g(parameter)f(=)i(0)0 2813 y(323)95 +b(illegal)45 b(axis)i(length)f(less)h(than)f(1)0 3039 +y(340)h(NOT_GROUP_TABLE)d(340)142 b(Grouping)45 b(function)h(error)0 +3152 y(341)95 b(HDU_ALREADY_MEMBER)0 3265 y(342)47 b(MEMBER_NOT_FOUND)0 +3378 y(343)g(GROUP_NOT_FOUND)0 3491 y(344)g(BAD_GROUP_ID)0 +3604 y(345)g(TOO_MANY_HDUS_TRACKED)0 3717 y(346)g(HDU_ALREADY_TRACKED)0 +3830 y(347)g(BAD_OPTION)0 3942 y(348)g(IDENTICAL_POINTERS)0 +4055 y(349)g(BAD_GROUP_ATTACH)0 4168 y(350)g(BAD_GROUP_DETACH)0 +4394 y(360)g(NGP_NO_MEMORY)665 b(malloc)46 b(failed)0 +4507 y(361)h(NGP_READ_ERR)713 b(read)46 b(error)h(from)f(file)0 +4620 y(362)h(NGP_NUL_PTR)761 b(null)46 b(pointer)g(passed)g(as)h(an)g +(argument.)1575 4733 y(Passing)f(null)g(pointer)g(as)h(a)h(name)f(of) +1575 4846 y(template)f(file)g(raises)g(this)h(error)0 +4959 y(363)g(NGP_EMPTY_CURLINE)473 b(line)46 b(read)h(seems)f(to)h(be)h +(empty)e(\(used)1575 5072 y(internally\))0 5185 y(364)h +(NGP_UNREAD_QUEUE_FULL)281 b(cannot)46 b(unread)g(more)g(then)h(1)g +(line)g(\(or)g(single)1575 5297 y(line)g(twice\))0 5410 +y(365)g(NGP_INC_NESTING)569 b(too)46 b(deep)h(include)f(file)h(nesting) +e(\(infinite)1575 5523 y(loop,)h(template)g(includes)f(itself)i(?\))0 +5636 y(366)g(NGP_ERR_FOPEN)665 b(fopen\(\))45 b(failed,)h(cannot)g +(open)h(template)e(file)p eop +%%Page: 126 132 +126 131 bop 0 299 a Fi(126)1613 b Fg(CHAPTER)30 b(12.)112 +b(FITSIO)30 b(ERR)m(OR)g(ST)-8 b(A)g(TUS)30 b(CODES)0 +555 y Fe(367)47 b(NGP_EOF)953 b(end)46 b(of)i(file)e(encountered)f(and) +i(not)g(expected)0 668 y(368)g(NGP_BAD_ARG)761 b(bad)46 +b(arguments)g(passed.)g(Usually)f(means)1575 781 y(internal)h(parser)g +(error.)g(Should)g(not)h(happen)0 894 y(369)g(NGP_TOKEN_NOT_EXPECT)329 +b(token)46 b(not)h(expected)e(here)0 1120 y(401)95 b(error)46 +b(attempting)f(to)i(convert)f(an)h(integer)f(to)h(a)h(formatted)d +(character)g(string)0 1233 y(402)95 b(error)46 b(attempting)f(to)i +(convert)f(a)h(real)g(value)f(to)i(a)f(formatted)e(character)h(string)0 +1346 y(403)95 b(cannot)46 b(convert)g(a)h(quoted)f(string)g(keyword)g +(to)h(an)g(integer)0 1458 y(404)95 b(attempted)45 b(to)i(read)g(a)g +(non-logical)e(keyword)h(value)g(as)h(a)h(logical)e(value)0 +1571 y(405)95 b(cannot)46 b(convert)g(a)h(quoted)f(string)g(keyword)g +(to)h(a)h(real)e(value)0 1684 y(406)95 b(cannot)46 b(convert)g(a)h +(quoted)f(string)g(keyword)g(to)h(a)h(double)e(precision)f(value)0 +1797 y(407)95 b(error)46 b(attempting)f(to)i(read)g(character)e(string) +h(as)h(an)h(integer)0 1910 y(408)95 b(error)46 b(attempting)f(to)i +(read)g(character)e(string)h(as)h(a)h(real)e(value)0 +2023 y(409)95 b(error)46 b(attempting)f(to)i(read)g(character)e(string) +h(as)h(a)h(double)e(precision)f(value)0 2136 y(410)95 +b(bad)47 b(keyword)e(datatype)h(code)0 2249 y(411)95 +b(illegal)45 b(number)i(of)g(decimal)f(places)g(while)g(formatting)f +(floating)h(point)g(value)0 2362 y(412)95 b(numerical)45 +b(overflow)g(during)i(implicit)e(datatype)h(conversion)0 +2475 y(413)95 b(error)46 b(compressing)f(image)0 2588 +y(414)95 b(error)46 b(uncompressing)e(image)0 2700 y(420)95 +b(error)46 b(in)h(date)g(or)g(time)g(conversion)0 2926 +y(431)95 b(syntax)46 b(error)g(in)h(parser)f(expression)0 +3039 y(432)95 b(expression)45 b(did)i(not)f(evaluate)g(to)h(desired)f +(type)0 3152 y(433)95 b(vector)46 b(result)g(too)h(large)f(to)h(return) +f(in)i(array)0 3265 y(434)95 b(data)46 b(parser)g(failed)g(not)h(sent)g +(an)g(out)g(column)0 3378 y(435)95 b(bad)47 b(data)f(encounter)f(while) +i(parsing)f(column)0 3491 y(436)95 b(parse)46 b(error:)g(output)g(file) +h(not)g(of)g(proper)f(type)0 3717 y(501)95 b(celestial)45 +b(angle)h(too)h(large)g(for)f(projection)0 3830 y(502)95 +b(bad)47 b(celestial)e(coordinate)g(or)i(pixel)f(value)0 +3942 y(503)95 b(error)46 b(in)h(celestial)e(coordinate)g(calculation)0 +4055 y(504)95 b(unsupported)44 b(type)j(of)g(celestial)e(projection)0 +4168 y(505)95 b(required)45 b(celestial)g(coordinate)g(keywords)h(not)h +(found)0 4281 y(506)95 b(approximate)44 b(wcs)j(keyword)f(values)g +(were)h(returned)p eop +%%Trailer +end +userdict /end-hook known{end-hook}if +%%EOF diff --git a/pkg/tbtables/cfitsio/fitsio.tex b/pkg/tbtables/cfitsio/fitsio.tex new file mode 100644 index 00000000..64068047 --- /dev/null +++ b/pkg/tbtables/cfitsio/fitsio.tex @@ -0,0 +1,7203 @@ +\documentclass[11pt]{book} +\input{html.sty} +\htmladdtonavigation + {\begin{rawhtml} + FITSIO Home + \end{rawhtml}} +%\oddsidemargin=0.25in +\oddsidemargin=0.00in +\evensidemargin=0.00in +\textwidth=6.5in +%\topmargin=0.0in +\textheight=8.75in +\parindent=0cm +\parskip=0.2cm +\begin{document} +\pagenumbering{roman} + +\begin{titlepage} +\normalsize +\vspace*{4.6cm} +\begin{center} +{\Huge \bf FITSIO User's Guide}\\ +\end{center} +\medskip +\medskip +\begin{center} +{\LARGE \bf A Subroutine Interface to FITS Format Files}\\ +\end{center} +\begin{center} +{\LARGE \bf for Fortran Programmers}\\ +\end{center} +\medskip +\medskip +\begin{center} +{\Large Version 2.5\\} +\end{center} +\bigskip +\vskip 2.5cm +\begin{center} +{HEASARC\\ +Code 662\\ +Goddard Space Flight Center\\ +Greenbelt, MD 20771\\ +USA} +\end{center} + +\vfill +\bigskip +\begin{center} +{\Large July 2004\\} +\end{center} +\vfill +\end{titlepage} + +\clearpage + +\tableofcontents + +\chapter{Introduction } +\pagenumbering{arabic} + +This document describes the Fortran-callable subroutine interface that +is provided as part of the CFITSIO library (which is written in ANSI +C). This is a companion document to the CFITSIO User's Guide which +should be consulted for further information about the underlying +CFITSIO library. In the remainder of this document, the terms FITSIO +and CFITSIO are interchangeable and refer to the same library. + +FITSIO/CFITSIO is a machine-independent library of routines for reading +and writing data files in the FITS (Flexible Image Transport System) +data format. It can also read IRAF format image files and raw binary +data arrays by converting them on the fly into a virtual FITS format +file. This library was written to provide a powerful yet simple +interface for accessing FITS files which will run on most commonly used +computers and workstations. FITSIO supports all the features described +in the official NOST definition of the FITS format and can read and +write all the currently defined types of extensions, including ASCII +tables (TABLE), Binary tables (BINTABLE) and IMAGE extensions. The +FITSIO subroutines insulate the programmer from having to deal with the +complicated formatting details in the FITS file, however, it is assumed +that users have a general knowledge about the structure and usage of +FITS files. + +The CFITSIO package was initially developed by the HEASARC (High Energy +Astrophysics Science Archive Research Center) at the NASA Goddard Space +Flight Center to convert various existing and newly acquired +astronomical data sets into FITS format and to further analyze data +already in FITS format. New features continue to be added to CFITSIO +in large part due to contributions of ideas or actual code from users +of the package. The Integral Science Data Center in Switzerland, and +the XMM/ESTEC project in The Netherlands made especially significant +contributions that resulted in many of the new features that appeared +in v2.0 of CFITSIO. + +The latest version of the CFITSIO source code, documentation, and +example programs are available on the World-Wide Web or via anonymous +ftp from: + +\begin{verbatim} + http://heasarc.gsfc.nasa.gov/fitsio + ftp://legacy.gsfc.nasa.gov/software/fitsio/c +\end{verbatim} +\newpage +Any questions, bug reports, or suggested enhancements related to the CFITSIO +package should be sent to the primary author: + +\begin{verbatim} + Dr. William Pence Telephone: (301) 286-4599 + HEASARC, Code 662 E-mail: pence@tetra.gsfc.nasa.gov + NASA/Goddard Space Flight Center + Greenbelt, MD 20771, USA +\end{verbatim} +This User's Guide assumes that readers already have a general +understanding of the definition and structure of FITS format files. +Further information about FITS formats is available from the FITS Support +Office at {\tt http://fits.gsfc.nasa.gov}. In particular, the +'NOST FITS Standard' gives the authoritative definition of the FITS data +format, and the `FITS User's Guide' provides additional historical background +and practical advice on using FITS files. + +CFITSIO users may also be interested in the FTOOLS package of programs +that can be used to manipulate and analyze FITS format files. +Information about FTOOLS can be obtained on the Web or via anonymous +ftp at: + +\begin{verbatim} + http://heasarc.gsfc.nasa.gov/ftools + ftp://legacy.gsfc.nasa.gov/software/ftools/release +\end{verbatim} + +\chapter{ Creating FITSIO/CFITSIO } + + +\section{Building the Library} + +To use the FITSIO subroutines one must first build the CFITSIO library, +which requires a C compiler. gcc is ideal, or most other ANSI-C +compilers will also work. The CFITSIO code is contained in about 40 C +source files (*.c) and header files (*.h). On VAX/VMS systems 2 +assembly-code files (vmsieeed.mar and vmsieeer.mar) are also needed. + +The Fortran interface subroutines to the C CFITSIO routines are located +in the f77\_wrap1.c, through f77\_wrap4.c files. These are relatively simple +'wrappers' that translate the arguments in the Fortran subroutine into +the appropriate format for the corresponding C routine. This +translation is performed transparently to the user by a set of C macros +located in the cfortran.h file. Unfortunately cfortran.h does not +support every combination of C and Fortran compilers so the Fortran +interface is not supported on all platforms. (see further notes below). + +A standard combination of C and Fortran compilers will be assumed by +default, but one may also specify a particular Fortran compiler by +doing: + +\begin{verbatim} + > setenv CFLAGS -DcompilerName=1 +\end{verbatim} +(where 'compilerName' is the name of the compiler) before running +the configure command. The currently recognized compiler +names are: + +\begin{verbatim} + g77Fortran + IBMR2Fortran + CLIPPERFortran + pgiFortran + NAGf90Fortran + f2cFortran + hpuxFortran + apolloFortran + sunFortran + CRAYFortran + mipsFortran + DECFortran + vmsFortran + CONVEXFortran + PowerStationFortran + AbsoftUNIXFortran + AbsoftProFortran + SXFortran +\end{verbatim} +Alternatively, one may edit the CFLAGS line in the Makefile to add the +'-DcompilerName' flag after running the './configure' command. + +The CFITSIO library is built on Unix systems by typing: + +\begin{verbatim} + > ./configure [--prefix=/target/installation/path] + > make (or 'make shared') + > make install (this step is optional) +\end{verbatim} +at the operating system prompt. The configure command customizes the +Makefile for the particular system, then the `make' command compiles the +source files and builds the library. Type `./configure' and not simply +`configure' to ensure that the configure script in the current directory +is run and not some other system-wide configure script. The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, + +\begin{verbatim} + > ./configure --prefix=/usr1/local +\end{verbatim} +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include file to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +By default this also builds the set of Fortran-callable +wrapper routines whose calling sequences are described later in this +document. + +The 'make shared' option builds a shared or dynamic version of the +CFITSIO library. When using the shared library the executable code is +not copied into your program at link time and instead the program +locates the necessary library code at run time, normally through +LD\_LIBRARY\_PATH or some other method. The advantages of using a shared +library are: + +\begin{verbatim} + 1. Less disk space if you build more than 1 program + 2. Less memory if more than one copy of a program using the shared + library is running at the same time since the system is smart + enough to share copies of the shared library at run time. + 3. Possibly easier maintenance since a new version of the shared + library can be installed without relinking all the software + that uses it (as long as the subroutine names and calling + sequences remain unchanged). + 4. No run-time penalty. +\end{verbatim} +The disadvantages are: + +\begin{verbatim} + 1. More hassle at runtime. You have to either build the programs + specially or have LD_LIBRARY_PATH set right. + 2. There may be a slight start up penalty, depending on where you are + reading the shared library and the program from and if your CPU is + either really slow or really heavily loaded. +\end{verbatim} + +On HP/UX systems, the environment variable CFLAGS should be set +to -Ae before running configure to enable "extended ANSI" features. + +It may not be possible to staticly link programs that use CFITSIO on +some platforms (namely, on Solaris 2.6) due to the network drivers +(which provide FTP and HTTP access to FITS files). It is possible to +make both a dynamic and a static version of the CFITSIO library, but +network file access will not be possible using the static version. + +On VAX/VMS and ALPHA/VMS systems the make\_gfloat.com command file may +be executed to build the cfitsio.olb object library using the default +G-floating point option for double variables. The make\_dfloat.com and +make\_ieee.com files may be used instead to build the library with the +other floating point options. Note that the getcwd function that is +used in the group.c module may require that programs using CFITSIO be +linked with the ALPHA\$LIBRARY:VAXCRTL.OLB library. See the example +link line in the next section of this document. + +On Windows IBM-PC type platforms the situation is more complicated +because of the wide variety of Fortran compilers that are available and +because of the inherent complexities of calling the CFITSIO C routines +from Fortran. Two different versions of the CFITSIO dll library are +available, compiled with the Borland C++ compiler and the Microsoft +Visual C++ compiler, respectively, in the files +cfitsiodll\_2xxx\_borland.zip and cfitsiodll\_2xxx\_vcc.zip, where +'2xxx' represents the current release number. Both these dll libraries +contain a set of Fortran wrapper routines which may be compatible with +some, but probably not all, available Fortran compilers. To test if +they are compatible, compile the program testf77.f and try linking to +these dll libraries. If these libraries do not work with a particular +Fortran compiler, then there are 2 possible solutions. The first +solution would be to modify the file cfortran.h for that particular +combination of C and Fortran compilers, and then rebuild the CFITSIO +dll library. This will require, however, a some expertise in +mixed language programming. +The other solution is to use the older v5.03 Fortran-77 implementation +of FITSIO that is still available from the FITSIO web-site. This +version is no longer supported, but it does provide the basic functions +for reading and writing FITS files and should be compatible with most +Fortran compilers. + +CFITSIO has currently been tested on the following platforms: + +\begin{verbatim} + OPERATING SYSTEM COMPILER + Sun OS gcc and cc (3.0.1) + Sun Solaris gcc and cc + Silicon Graphics IRIX gcc and cc + Silicon Graphics IRIX64 MIPS + Dec Alpha OSF/1 gcc and cc + DECstation Ultrix gcc + Dec Alpha OpenVMS cc + DEC VAX/VMS gcc and cc + HP-UX gcc + IBM AIX gcc + Linux gcc + MkLinux DR3 + Windows 95/98/NT Borland C++ V4.5 + Windows 95/98/NT/ME/XP Microsoft/Compaq Visual C++ v5.0, v6.0 + Windows 95/98/NT Cygwin gcc + OS/2 gcc + EMX + MacOS 7.1 or greater Metrowerks 10.+ +\end{verbatim} +CFITSIO will probably run on most other Unix platforms. Cray +supercomputers are currently not supported. + + +\section{Testing the Library} + +The CFITSIO library should be tested by building and running +the testprog.c program that is included with the release. +On Unix systems type: + +\begin{verbatim} + % make testprog + % testprog > testprog.lis + % diff testprog.lis testprog.out + % cmp testprog.fit testprog.std +\end{verbatim} + On VMS systems, +(assuming cc is the name of the C compiler command), type: + +\begin{verbatim} + $ cc testprog.c + $ link testprog, cfitsio/lib, alpha$library:vaxcrtl/lib + $ run testprog +\end{verbatim} +The testprog program should produce a FITS file called `testprog.fit' +that is identical to the `testprog.std' FITS file included with this +release. The diagnostic messages (which were piped to the file +testprog.lis in the Unix example) should be identical to the listing +contained in the file testprog.out. The 'diff' and 'cmp' commands +shown above should not report any differences in the files. (There +may be some minor formatting differences, such as the presence or +absence of leading zeros, or 3 digit exponents in numbers, +which can be ignored). + +The Fortran wrappers in CFITSIO may be tested with the testf77 +program. On Unix systems the fortran compilation and link command +may be called 'f77' or 'g77', depending on the system. + +\begin{verbatim} + % f77 -o testf77 testf77.f -L. -lcfitsio -lnsl -lsocket + or + % f77 -f -o testf77 testf77.f -L. -lcfitsio (under SUN O/S) + or + % f77 -o testf77 testf77.f -Wl,-L. -lcfitsio -lm -lnsl -lsocket (HP/UX) + or + % g77 -o testf77 -s testf77.f -lcfitsio -lcc_dynamic -lncurses (Mac OS-X) + + % testf77 > testf77.lis + % diff testf77.lis testf77.out + % cmp testf77.fit testf77.std +\end{verbatim} +On machines running SUN O/S, Fortran programs must be compiled with the +'-f' option to force double precision variables to be aligned on 8-byte +boundarys to make the fortran-declared variables compatible with C. A +similar compiler option may be required on other platforms. Failing to +use this option may cause the program to crash on FITSIO routines that +read or write double precision variables. + +Also note that on some systems, the output listing of the testf77 +program may differ slightly from the testf77.std template, if leading +zeros are not printed by default before the decimal point when using F +format. + +A few other utility programs are included with CFITSIO: + +\begin{verbatim} + speed - measures the maximum throughput (in MB per second) + for writing and reading FITS files with CFITSIO + + listhead - lists all the header keywords in any FITS file + + fitscopy - copies any FITS file (especially useful in conjunction + with the CFITSIO's extended input filename syntax) + + cookbook - a sample program that peforms common read and + write operations on a FITS file. + + iter_a, iter_b, iter_c - examples of the CFITSIO iterator routine +\end{verbatim} + +The first 4 of these utility programs can be compiled and linked by typing + +\begin{verbatim} + % make program_name +\end{verbatim} + + +\section{Linking Programs with FITSIO} + +When linking applications software with the FITSIO library, several system libraries usually need to be specified on the link comman +Unix systems, the most reliable way to determine what libraries are required +is to type 'make testprog' and see what libraries the configure script has +added. The typical libraries that may need to be added are -lm (the math +library) and -lnsl and -lsocket (needed only for FTP and HTTP file access). +These latter 2 libraries are not needed on VMS and Windows platforms, +because FTP file access is not currently supported on those platforms. + +Note that when upgrading to a newer version of CFITSIO it is usually +necessay to recompile, as well as relink, the programs that use CFITSIO, +because the definitions in fitsio.h often change. + + +\section{Getting Started with FITSIO} + +In order to effectively use the FITSIO library as quickly as possible, +it is recommended that new users follow these steps: + +1. Read the following `FITS Primer' chapter for a brief +overview of the structure of FITS files. This is especially important +for users who have not previously dealt with the FITS table and image +extensions. + +2. Write a simple program to read or write a FITS file using the Basic +Interface routines. + +3. Refer to the cookbook.f program that is included with this release +for examples of routines that perform various common FITS file +operations. + +4. Read Chapters 4 and 5 to become familiar with the conventions and +advanced features of the FITSIO interface. + +5. Scan through the more extensive set of routines that are provided +in the `Advanced Interface'. These routines perform more specialized +functions than are provided by the Basic Interface routines. + + +\section{Example Program} + +The following listing shows an example of how to use the FITSIO +routines in a Fortran program. Refer to the cookbook.f program that +is included with the FITSIO distribution for examples of other +FITS programs. + +\begin{verbatim} + program writeimage + +C Create a FITS primary array containing a 2-D image + + integer status,unit,blocksize,bitpix,naxis,naxes(2) + integer i,j,group,fpixel,nelements,array(300,200) + character filename*80 + logical simple,extend + + status=0 +C Name of the FITS file to be created: + filename='ATESTFILE.FITS' + +C Get an unused Logical Unit Number to use to create the FITS file + call ftgiou(unit,status) + +C create the new empty FITS file + blocksize=1 + call ftinit(unit,filename,blocksize,status) + +C initialize parameters about the FITS image (300 x 200 16-bit integers) + simple=.true. + bitpix=16 + naxis=2 + naxes(1)=300 + naxes(2)=200 + extend=.true. + +C write the required header keywords + call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status) + +C initialize the values in the image with a linear ramp function + do j=1,naxes(2) + do i=1,naxes(1) + array(i,j)=i+j + end do + end do + +C write the array to the FITS file + group=1 + fpixel=1 + nelements=naxes(1)*naxes(2) + call ftpprj(unit,group,fpixel,nelements,array,status) + +C write another optional keyword to the header + call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status) + +C close the file and free the unit number + call ftclos(unit, status) + call ftfiou(unit, status) + end +\end{verbatim} + + +\section{Legal Stuff} + +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. +(However, see the restriction on the use of the gzip compression code, +below). + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER." + +The file compress.c contains (slightly modified) source code that +originally came from gzip-1.2.4, copyright (C) 1992-1993 by Jean-loup +Gailly. This gzip code is distributed under the GNU General Public +License and thus requires that any software that uses the CFITSIO +library (which in turn uses the gzip code) must conform to the +provisions in the GNU General Public License. A copy of the GNU +license is included at the beginning of compress.c file. + +An alternate version of the compress.c file (called +compress\_alternate.c) is provided for users who want to use the CFITSIO +library but are unwilling or unable to publicly release their software +under the terms of the GNU General Public License. This alternate +version contains non-functional stubs for the file compression and +uncompression routines used by CFITSIO. Replace the file `compress.c' +with `compress\_alternate.c' before compiling the CFITSIO library. This +will produce a version of CFITSIO which does not support reading or +writing compressed FITS files but is otherwise identical to the +standard version. + + +\section{Acknowledgements} + +The development of many of the powerful features in CFITSIO was made +possible through collaborations with many people or organizations from +around the world. The following, in particular, have made especially +significant contributions: + +Programmers from the Integral Science Data Center, Switzerland (namely, +Jurek Borkowski, Bruce O'Neel, and Don Jennings), designed the concept +for the plug-in I/O drivers that was introduced with CFITSIO 2.0. The +use of `drivers' greatly simplified the low-level I/O, which in turn +made other new features in CFITSIO (e.g., support for compressed FITS +files and support for IRAF format image files) much easier to +implement. Jurek Borkowski wrote the Shared Memory driver, and Bruce +O'Neel wrote the drivers for accessing FITS files over the network +using the FTP, HTTP, and ROOT protocols. + +The ISDC also provided the template parsing routines (written by Jurek +Borkowski) and the hierarchical grouping routines (written by Don +Jennings). The ISDC DAL (Data Access Layer) routines are layered on +top of CFITSIO and make extensive use of these features. + +Uwe Lammers (XMM/ESA/ESTEC, The Netherlands) designed the +high-performance lexical parsing algorithm that is used to do +on-the-fly filtering of FITS tables. This algorithm essentially +pre-compiles the user-supplied selection expression into a form that +can be rapidly evaluated for each row. Peter Wilson (RSTX, NASA/GSFC) +then wrote the parsing routines used by CFITSIO based on Lammers' +design, combined with other techniques such as the CFITSIO iterator +routine to further enhance the data processing throughput. This effort +also benefited from a much earlier lexical parsing routine that was +developed by Kent Blackburn (NASA/GSFC). More recently, Craig Markwardt +(NASA/GSFC) implemented additional functions (median, average, stddev) +and other enhancements to the lexical parser. + +The CFITSIO iterator function is loosely based on similar ideas +developed for the XMM Data Access Layer. + +Peter Wilson (RSTX, NASA/GSFC) wrote the complete set of +Fortran-callable wrappers for all the CFITSIO routines, which in turn +rely on the CFORTRAN macro developed by Burkhard Burow. + +The syntax used by CFITSIO for filtering or binning input FITS files is +based on ideas developed for the AXAF Science Center Data Model by +Jonathan McDowell, Antonella Fruscione, Aneta Siemiginowska and Bill +Joye. See http://heasarc.gsfc.nasa.gov/docs/journal/axaf7.html for +further description of the AXAF Data Model. + +The file decompression code were taken directly from the gzip (GNU zip) +program developed by Jean-loup Gailly and others. + +Doug Mink, SAO, provided the routines for converting IRAF format +images into FITS format. + +In addition, many other people have made valuable contributions to the +development of CFITSIO. These include (with apologies to others that may +have inadvertently been omitted): + +Steve Allen, Carl Akerlof, Keith Arnaud, Morten Krabbe Barfoed, Kent +Blackburn, G Bodammer, Romke Bontekoe, Lucio Chiappetti, Keith Costorf, +Robin Corbet, John Davis, Richard Fink, Ning Gan, Emily Greene, Joe +Harrington, Cheng Ho, Phil Hodge, Jim Ingham, Yoshitaka Ishisaki, Diab +Jerius, Mark Levine, Todd Karakaskian, Edward King, Scott Koch, Claire +Larkin, Rob Managan, Eric Mandel, John Mattox, Carsten Meyer, Emi +Miyata, Stefan Mochnacki, Mike Noble, Oliver Oberdorf, Clive Page, +Arvind Parmar, Jeff Pedelty, Tim Pearson, Maren Purves, Scott Randall, +Chris Rogers, Arnold Rots, Barry Schlesinger, Robin Stebbins, Andrew +Szymkowiak, Allyn Tennant, Peter Teuben, James Theiler, Doug Tody, +Shiro Ueno, Steve Walton, Archie Warnock, Alan Watson, Dan Whipple, Wim +Wimmers, Peter Young, Jianjun Xu, and Nelson Zarate. + + +\chapter{ A FITS Primer } + +This section gives a brief overview of the structure of FITS files. +Users should refer to the documentation available from the NOST, as +described in the introduction, for more detailed information on FITS +formats. + +FITS was first developed in the late 1970's as a standard data +interchange format between various astronomical observatories. Since +then FITS has become the defacto standard data format supported by most +astronomical data analysis software packages. + +A FITS file consists of one or more Header + Data Units (HDUs), where +the first HDU is called the `Primary HDU', or `Primary Array'. The +primary array contains an N-dimensional array of pixels, such as a 1-D +spectrum, a 2-D image, or a 3-D data cube. Five different primary +datatypes are supported: Unsigned 8-bit bytes, 16 and 32-bit signed +integers, and 32 and 64-bit floating point reals. FITS also has a +convention for storing 16 and 32-bit unsigned integers (see the later +section entitled `Unsigned Integers' for more details). The primary HDU +may also consist of only a header with a null array containing no +data pixels. + +Any number of additional HDUs may follow the primary array; these +additional HDUs are called FITS `extensions'. There are currently 3 +types of extensions defined by the FITS standard: + +\begin{itemize} +\item + Image Extension - a N-dimensional array of pixels, like in a primary array +\item + ASCII Table Extension - rows and columns of data in ASCII character format +\item + Binary Table Extension - rows and columns of data in binary representation +\end{itemize} + +In each case the HDU consists of an ASCII Header Unit followed by an optional +Data Unit. For historical reasons, each Header or Data unit must be an +exact multiple of 2880 8-bit bytes long. Any unused space is padded +with fill characters (ASCII blanks or zeros). + +Each Header Unit consists of any number of 80-character keyword records +or `card images' which have the general form: + +\begin{verbatim} + KEYNAME = value / comment string + NULLKEY = / comment: This keyword has no value +\end{verbatim} +The keyword names may be up to 8 characters long and can only contain +uppercase letters, the digits 0-9, the hyphen, and the underscore +character. The keyword name is (usually) followed by an equals sign and +a space character (= ) in columns 9 - 10 of the record, followed by the +value of the keyword which may be either an integer, a floating point +number, a character string (enclosed in single quotes), or a boolean +value (the letter T or F). A keyword may also have a null or undefined +value if there is no specified value string, as in the second example. + +The last keyword in the header is always the `END' keyword which has no +value or comment fields. There are many rules governing the exact +format of a keyword record (see the NOST FITS Standard) so it is better +to rely on standard interface software like FITSIO to correctly +construct or to parse the keyword records rather than try to deal +directly with the raw FITS formats. + +Each Header Unit begins with a series of required keywords which depend +on the type of HDU. These required keywords specify the size and +format of the following Data Unit. The header may contain other +optional keywords to describe other aspects of the data, such as the +units or scaling values. Other COMMENT or HISTORY keywords are also +frequently added to further document the data file. + +The optional Data Unit immediately follows the last 2880-byte block in +the Header Unit. Some HDUs do not have a Data Unit and only consist of +the Header Unit. + +If there is more than one HDU in the FITS file, then the Header Unit of +the next HDU immediately follows the last 2880-byte block of the +previous Data Unit (or Header Unit if there is no Data Unit). + +The main required keywords in FITS primary arrays or image extensions are: +\begin{itemize} +\item +BITPIX -- defines the datatype of the array: 8, 16, 32, -32, -64 for +unsigned 8--bit byte, 16--bit signed integer, 32--bit signed integer, +32--bit IEEE floating point, and 64--bit IEEE double precision floating +point, respectively. +\item +NAXIS -- the number of dimensions in the array, usually 0, 1, 2, 3, or 4. +\item +NAXISn -- (n ranges from 1 to NAXIS) defines the size of each dimension. +\end{itemize} + +FITS tables start with the keyword XTENSION = `TABLE' (for ASCII +tables) or XTENSION = `BINTABLE' (for binary tables) and have the +following main keywords: +\begin{itemize} +\item +TFIELDS -- number of fields or columns in the table +\item +NAXIS2 -- number of rows in the table +\item +TTYPEn -- for each column (n ranges from 1 to TFIELDS) gives the +name of the column +\item +TFORMn -- the datatype of the column +\item +TUNITn -- the physical units of the column (optional) +\end{itemize} + +Users should refer to the FITS Support Office at {\tt http://fits.gsfc.nasa.gov} +for futher information about the FITS format and related software +packages. + + +\chapter{ Extended File Name Syntax } + + +\section{Overview} + +CFITSIO supports an extended syntax when specifying the name of the +data file to be opened or created that includes the following +features: + +\begin{itemize} +\item +CFITSIO can read IRAF format images which have header file names that +end with the '.imh' extension, as well as reading and writing FITS +files, This feature is implemented in CFITSIO by first converting the +IRAF image into a temporary FITS format file in memory, then opening +the FITS file. Any of the usual CFITSIO routines then may be used to +read the image header or data. Similarly, raw binary data arrays can +be read by converting them on the fly into virtual FITS images. + +\item +FITS files on the internet can be read (and sometimes written) using the FTP, +HTTP, or ROOT protocols. + +\item +FITS files can be piped between tasks on the stdin and stdout streams. + +\item +FITS files can be read and written in shared memory. This can potentially +achieve much better data I/O performance compared to reading and +writing the same FITS files on magnetic disk. + +\item +Compressed FITS files in gzip or Unix COMPRESS format can be directly read. + +\item +Output FITS files can be written directly in compressed gzip format, +thus saving disk space. + +\item +FITS table columns can be created, modified, or deleted 'on-the-fly' as +the table is opened by CFITSIO. This creates a virtual FITS file containing +the modifications that is then opened by the application program. + +\item +Table rows may be selected, or filtered out, on the fly when the table +is opened by CFITSIO, based on an arbitrary user-specified expression. +Only rows for which the expression evaluates to 'TRUE' are retained +in the copy of the table that is opened by the application program. + +\item +Histogram images may be created on the fly by binning the values in +table columns, resulting in a virtual N-dimensional FITS image. The +application program then only sees the FITS image (in the primary +array) instead of the original FITS table. +\end{itemize} + +The latter 3 features in particular add very powerful data processing +capabilities directly into CFITSIO, and hence into every task that uses +CFITSIO to read or write FITS files. For example, these features +transform a very simple program that just copies an input FITS file to +a new output file (like the `fitscopy' program that is distributed with +CFITSIO) into a multipurpose FITS file processing tool. By appending +fairly simple qualifiers onto the name of the input FITS file, the user +can perform quite complex table editing operations (e.g., create new +columns, or filter out rows in a table) or create FITS images by +binning or histogramming the values in table columns. In addition, +these functions have been coded using new state-of-the art algorithms +that are, in some cases, 10 - 100 times faster than previous widely +used implementations. + +Before describing the complete syntax for the extended FITS file names +in the next section, here are a few examples of FITS file names that +give a quick overview of the allowed syntax: + +\begin{itemize} +\item +{\tt 'myfile.fits'}: the simplest case of a FITS file on disk in the current +directory. + +\item +{\tt 'myfile.imh'}: opens an IRAF format image file and converts it on the +fly into a temporary FITS format image in memory which can then be read with +any other CFITSIO routine. + +\item +{\tt rawfile.dat[i512,512]}: opens a raw binary data array (a 512 x 512 +short integer array in this case) and converts it on the fly into a +temporary FITS format image in memory which can then be read with any +other CFITSIO routine. + +\item +{\tt myfile.fits.gz}: if this is the name of a new output file, the '.gz' +suffix will cause it to be compressed in gzip format when it is written to +disk. + +\item +{\tt 'myfile.fits.gz[events, 2]'}: opens and uncompresses the gzipped file +myfile.fits then moves to the extension which has the keywords EXTNAME += 'EVENTS' and EXTVER = 2. + +\item +{\tt '-'}: a dash (minus sign) signifies that the input file is to be read +from the stdin file stream, or that the output file is to be written to +the stdout stream. + +\item +{\tt 'ftp://legacy.gsfc.nasa.gov/test/vela.fits'}: FITS files in any ftp +archive site on the internet may be directly opened with read-only +access. + +\item +{\tt 'http://legacy.gsfc.nasa.gov/software/test.fits'}: any valid URL to a +FITS file on the Web may be opened with read-only access. + +\item +{\tt 'root://legacy.gsfc.nasa.gov/test/vela.fits'}: similar to ftp access +except that it provides write as well as read access to the files +across the network. This uses the root protocol developed at CERN. + +\item +{\tt 'shmem://h2[events]'}: opens the FITS file in a shared memory segment and +moves to the EVENTS extension. + +\item +{\tt 'mem://'}: creates a scratch output file in core computer memory. The +resulting 'file' will disappear when the program exits, so this +is mainly useful for testing purposes when one does not want a +permanent copy of the output file. + +\item +{\tt 'myfile.fits[3; Images(10)]'}: opens a copy of the image contained in the +10th row of the 'Images' column in the binary table in the 3th extension +of the FITS file. The application just sees this single image as the +primary array. + +\item +{\tt 'myfile.fits[1:512:2, 1:512:2]'}: opens a section of the input image +ranging from the 1st to the 512th pixel in X and Y, and selects every +second pixel in both dimensions, resulting in a 256 x 256 pixel image +in this case. + +\item +{\tt 'myfile.fits[EVENTS][col Rad = sqrt(X**2 + Y**2)]'}: creates and opens +a temporary file on the fly (in memory or on disk) that is identical to +myfile.fits except that it will contain a new column in the EVENTS +extension called 'Rad' whose value is computed using the indicated +expresson which is a function of the values in the X and Y columns. + +\item +{\tt 'myfile.fits[EVENTS][PHA > 5]'}: creates and opens a temporary FITS +files that is identical to 'myfile.fits' except that the EVENTS table +will only contain the rows that have values of the PHA column greater +than 5. In general, any arbitrary boolean expression using a C or +Fortran-like syntax, which may combine AND and OR operators, +may be used to select rows from a table. + +\item +{\tt 'myfile.fits[EVENTS][bin (X,Y)=1,2048,4]'}: creates a temporary FITS +primary array image which is computed on the fly by binning (i.e, +computing the 2-dimensional histogram) of the values in the X and Y +columns of the EVENTS extension. In this case the X and Y coordinates +range from 1 to 2048 and the image pixel size is 4 units in both +dimensions, so the resulting image is 512 x 512 pixels in size. + +\item +The final example combines many of these feature into one complex +expression (it is broken into several lines for clarity): + +\begin{verbatim} + 'ftp://legacy.gsfc.nasa.gov/data/sample.fits.gz[EVENTS] + [col phacorr = pha * 1.1 - 0.3][phacorr >= 5.0 && phacorr <= 14.0] + [bin (X,Y)=32]' +\end{verbatim} +In this case, CFITSIO (1) copies and uncompresses the FITS file from +the ftp site on the legacy machine, (2) moves to the 'EVENTS' +extension, (3) calculates a new column called 'phacorr', (4) selects +the rows in the table that have phacorr in the range 5 to 14, and +finally (5) bins the remaining rows on the X and Y column coordinates, +using a pixel size = 32 to create a 2D image. All this processing is +completely transparent to the application program, which simply sees +the final 2-D image in the primary array of the opened file. +\end{itemize} + +The full extended CFITSIO FITS file name can contain several different +components depending on the context. These components are described in +the following sections: + +\begin{verbatim} +When creating a new file: + filetype://BaseFilename(templateName) + +When opening an existing primary array or image HDU: + filetype://BaseFilename(outName)[HDUlocation][ImageSection] + +When opening an existing table HDU: + filetype://BaseFilename(outName)[HDUlocation][colFilter][rowFilter][binSpec] +\end{verbatim} +The filetype, BaseFilename, outName, HDUlocation, and ImageSection +components, if present, must be given in that order, but the colFilter, +rowFilter, and binSpec specifiers may follow in any order. Regardless +of the order, however, the colFilter specifier, if present, will be +processed first by CFITSIO, followed by the rowFilter specifier, and +finally by the binSpec specifier. + + +\section{Filetype} + +The type of file determines the medium on which the file is located +(e.g., disk or network) and, hence, which internal device driver is used by +CFITSIO to read and/or write the file. Currently supported types are + +\begin{verbatim} + file:// - file on local magnetic disk (default) + ftp:// - a readonly file accessed with the anonymous FTP protocol. + It also supports ftp://username:password@hostname/... + for accessing password-protected ftp sites. + http:// - a readonly file accessed with the HTTP protocol. It + does not support username:password like the ftp driver. + Proxy HTTP servers are supported using the http_proxy + environment variable. + root:// - uses the CERN root protocol for writing as well as + reading files over the network. + shmem:// - opens or creates a file which persists in the computer's + shared memory. + mem:// - opens a temporary file in core memory. The file + disappears when the program exits so this is mainly + useful for test purposes when a permanent output file + is not desired. +\end{verbatim} +If the filetype is not specified, then type file:// is assumed. +The double slashes '//' are optional and may be omitted in most cases. + + +\subsection{Notes about HTTP proxy servers} + +A proxy HTTP server may be used by defining the address (URL) and port +number of the proxy server with the http\_proxy environment variable. +For example + +\begin{verbatim} + setenv http_proxy http://heasarc.gsfc.nasa.gov:3128 +\end{verbatim} +will cause CFITSIO to use port 3128 on the heasarc proxy server whenever +reading a FITS file with HTTP. + + +\subsection{Notes about the root filetype} + +The original rootd server can be obtained from: +\verb-ftp://root.cern.ch/root/rootd.tar.gz- +but, for it to work correctly with CFITSIO one has to use a modified +version which supports a command to return the length of the file. +This modified version is available in rootd subdirectory +in the CFITSIO ftp area at + +\begin{verbatim} + ftp://legacy.gsfc.nasa.gov/software/fitsio/c/root/rootd.tar.gz. +\end{verbatim} + +This small server is started either by inetd when a client requests a +connection to a rootd server or by hand (i.e. from the command line). +The rootd server works with the ROOT TNetFile class. It allows remote +access to ROOT database files in either read or write mode. By default +TNetFile assumes port 432 (which requires rootd to be started as root). +To run rootd via inetd add the following line to /etc/services: + +\begin{verbatim} + rootd 432/tcp +\end{verbatim} +and to /etc/inetd.conf, add the following line: + +\begin{verbatim} + rootd stream tcp nowait root /user/rdm/root/bin/rootd rootd -i +\end{verbatim} +Force inetd to reread its conf file with "kill -HUP ". +You can also start rootd by hand running directly under your private +account (no root system privileges needed). For example to start +rootd listening on port 5151 just type: \verb+rootd -p 5151+ +Notice: no \& is needed. Rootd will go into background by itself. + +\begin{verbatim} + Rootd arguments: + -i says we were started by inetd + -p port# specifies a different port to listen on + -d level level of debug info written to syslog + 0 = no debug (default) + 1 = minimum + 2 = medium + 3 = maximum +\end{verbatim} +Rootd can also be configured for anonymous usage (like anonymous ftp). +To setup rootd to accept anonymous logins do the following (while being +logged in as root): + +\begin{verbatim} + - Add the following line to /etc/passwd: + + rootd:*:71:72:Anonymous rootd:/var/spool/rootd:/bin/false + + where you may modify the uid, gid (71, 72) and the home directory + to suite your system. + + - Add the following line to /etc/group: + + rootd:*:72:rootd + + where the gid must match the gid in /etc/passwd. + + - Create the directories: + + mkdir /var/spool/rootd + mkdir /var/spool/rootd/tmp + chmod 777 /var/spool/rootd/tmp + + Where /var/spool/rootd must match the rootd home directory as + specified in the rootd /etc/passwd entry. + + - To make writeable directories for anonymous do, for example: + + mkdir /var/spool/rootd/pub + chown rootd:rootd /var/spool/rootd/pub +\end{verbatim} +That's all. Several additional remarks: you can login to an anonymous +server either with the names "anonymous" or "rootd". The password should +be of type user@host.do.main. Only the @ is enforced for the time +being. In anonymous mode the top of the file tree is set to the rootd +home directory, therefore only files below the home directory can be +accessed. Anonymous mode only works when the server is started via +inetd. + + +\subsection{Notes about the shmem filetype:} + +Shared memory files are currently supported on most Unix platforms, +where the shared memory segments are managed by the operating system +kernel and `live' independently of processes. They are not deleted (by +default) when the process which created them terminates, although they +will disappear if the system is rebooted. Applications can create +shared memory files in CFITSIO by calling: + +\begin{verbatim} + fit_create_file(&fitsfileptr, "shmem://h2", &status); +\end{verbatim} +where the root `file' names are currently restricted to be 'h0', 'h1', +'h2', 'h3', etc., up to a maximumn number defined by the the value of +SHARED\_MAXSEG (equal to 16 by default). This is a prototype +implementation of the shared memory interface and a more robust +interface, which will have fewer restrictions on the number of files +and on their names, may be developed in the future. + +When opening an already existing FITS file in shared memory one calls +the usual CFITSIO routine: + +\begin{verbatim} + fits_open_file(&fitsfileptr, "shmem://h7", mode, &status) +\end{verbatim} +The file mode can be READWRITE or READONLY just as with disk files. +More than one process can operate on READONLY mode files at the same +time. CFITSIO supports proper file locking (both in READONLY and +READWRITE modes), so calls to fits\_open\_file may be locked out until +another other process closes the file. + +When an application is finished accessing a FITS file in a shared +memory segment, it may close it (and the file will remain in the +system) with fits\_close\_file, or delete it with fits\_delete\_file. +Physical deletion is postponed until the last process calls +ffclos/ffdelt. fits\_delete\_file tries to obtain a READWRITE lock on +the file to be deleted, thus it can be blocked if the object was not +opened in READWRITE mode. + +A shared memory management utility program called `smem', is included +with the CFITSIO distribution. It can be built by typing `make smem'; +then type `smem -h' to get a list of valid options. Executing smem +without any options causes it to list all the shared memory segments +currently residing in the system and managed by the shared memory +driver. To get a list of all the shared memory objects, run the system +utility program `ipcs [-a]'. + + +\section{Base Filename} + +The base filename is the name of the file optionally including the +director/subdirectory path, and in the case of `ftp', `http', and `root' +filetypes, the machine identifier. Examples: + +\begin{verbatim} + myfile.fits + !data.fits + /data/myfile.fits + fits.gsfc.nasa.gov/ftp/sampledata/myfile.fits.gz +\end{verbatim} + +When creating a new output file on magnetic disk (of type file://) if +the base filename begins with an exclamation point (!) then any +existing file with that same basename will be deleted prior to creating +the new FITS file. Otherwise if the file to be created already exists, +then CFITSIO will return an error and will not overwrite the existing +file. Note that the exclamation point, '!', is a special UNIX character, +so if it is used on the command line rather than entered at a task +prompt, it must be preceded by a backslash to force the UNIX +shell to pass it verbatim to the application program. + +If the output disk file name ends with the suffix '.gz', then CFITSIO +will compress the file using the gzip compression algorithm before +writing it to disk. This can reduce the amount of disk space used by +the file. Note that this feature requires that the uncompressed file +be constructed in memory before it is compressed and written to disk, +so it can fail if there is insufficient available memory. + +An input FITS file may be compressed with the gzip or Unix compress +algorithms, in which case CFITSIO will uncompress the file on the fly +into a temporary file (in memory or on disk). Compressed files may +only be opened with read-only permission. When specifying the name of +a compressed FITS file it is not necessary to append the file suffix +(e.g., `.gz' or `.Z'). If CFITSIO cannot find the input file name +without the suffix, then it will automatically search for a compressed +file with the same root name. In the case of reading ftp and http type +files, CFITSIO generally looks for a compressed version of the file +first, before trying to open the uncompressed file. By default, +CFITSIO copies (and uncompressed if necessary) the ftp or http FITS +file into memory on the local machine before opening it. This will +fail if the local machine does not have enough memory to hold the whole +FITS file, so in this case, the output filename specifier (see the next +section) can be used to further control how CFITSIO reads ftp and http +files. + +If the input file is an IRAF image file (*.imh file) then CFITSIO will +automatically convert it on the fly into a virtual FITS image before it +is opened by the application program. IRAF images can only be opened +with READONLY file access. + +Similarly, if the input file is a raw binary data array, then CFITSIO +will convert it on the fly into a virtual FITS image with the basic set +of required header keywords before it is opened by the application +program (with READONLY access). In this case the data type and +dimensions of the image must be specified in square brackets following +the filename (e.g. rawfile.dat[ib512,512]). The first character (case +insensitive) defines the datatype of the array: + +\begin{verbatim} + b 8-bit unsigned byte + i 16-bit signed integer + u 16-bit unsigned integer + j 32-bit signed integer + r or f 32-bit floating point + d 64-bit floating point +\end{verbatim} +An optional second character specifies the byte order of the array +values: b or B indicates big endian (as in FITS files and the native +format of SUN UNIX workstations and Mac PCs) and l or L indicates +little endian (native format of DEC OSF workstations and IBM PCs). If +this character is omitted then the array is assumed to have the native +byte order of the local machine. These datatype characters are then +followed by a series of one or more integer values separated by commas +which define the size of each dimension of the raw array. Arrays with +up to 5 dimensions are currently supported. Finally, a byte offset to +the position of the first pixel in the data file may be specified by +separating it with a ':' from the last dimension value. If omitted, it +is assumed that the offset = 0. This parameter may be used to skip +over any header information in the file that precedes the binary data. +Further examples: + +\begin{verbatim} + raw.dat[b10000] 1-dimensional 10000 pixel byte array + raw.dat[rb400,400,12] 3-dimensional floating point big-endian array + img.fits[ib512,512:2880] reads the 512 x 512 short integer array in + a FITS file, skipping over the 2880 byte header +\end{verbatim} + +One special case of input file is where the filename = `-' (a dash or +minus sign) or 'stdin' or 'stdout', which signifies that the input file +is to be read from the stdin stream, or written to the stdout stream if +a new output file is being created. In the case of reading from stdin, +CFITSIO first copies the whole stream into a temporary FITS file (in +memory or on disk), and subsequent reading of the FITS file occurs in +this copy. When writing to stdout, CFITSIO first constructs the whole +file in memory (since random access is required), then flushes it out +to the stdout stream when the file is closed. In addition, if the +output filename = '-.gz' or 'stdout.gz' then it will be gzip compressed +before being written to stdout. + +This ability to read and write on the stdin and stdout steams allows +FITS files to be piped between tasks in memory rather than having to +create temporary intermediate FITS files on disk. For example if task1 +creates an output FITS file, and task2 reads an input FITS file, the +FITS file may be piped between the 2 tasks by specifying + +\begin{verbatim} + task1 - | task2 - +\end{verbatim} +where the vertical bar is the Unix piping symbol. This assumes that the 2 +tasks read the name of the FITS file off of the command line. + + +\section{Output File Name when Opening an Existing File} + +An optional output filename may be specified in parentheses immediately +following the base file name to be opened. This is mainly useful in +those cases where CFITSIO creates a temporary copy of the input FITS +file before it is opened and passed to the application program. This +happens by default when opening a network FTP or HTTP-type file, when +reading a compressed FITS file on a local disk, when reading from the +stdin stream, or when a column filter, row filter, or binning specifier +is included as part of the input file specification. By default this +temporary file is created in memory. If there is not enough memory to +create the file copy, then CFITSIO will exit with an error. In these +cases one can force a permanent file to be created on disk, instead of +a temporary file in memory, by supplying the name in parentheses +immediately following the base file name. The output filename can +include the '!' clobber flag. + +Thus, if the input filename to CFITSIO is: +\verb+file1.fits.gz(file2.fits)+ +then CFITSIO will uncompress `file1.fits.gz' into the local disk file +`file2.fits' before opening it. CFITSIO does not automatically delete +the output file, so it will still exist after the application program +exits. + +In some cases, several different temporary FITS files will be created +in sequence, for instance, if one opens a remote file using FTP, then +filters rows in a binary table extension, then create an image by +binning a pair of columns. In this case, the remote file will be +copied to a temporary local file, then a second temporary file will be +created containing the filtered rows of the table, and finally a third +temporary file containing the binned image will be created. In cases +like this where multiple files are created, the outfile specifier will +be interpreted the name of the final file as described below, in descending +priority: + +\begin{itemize} +\item +as the name of the final image file if an image within a single binary +table cell is opened or if an image is created by binning a table column. +\item +as the name of the file containing the filtered table if a column filter +and/or a row filter are specified. +\item +as the name of the local copy of the remote FTP or HTTP file. +\item +as the name of the uncompressed version of the FITS file, if a +compressed FITS file on local disk has been opened. +\item +otherwise, the output filename is ignored. +\end{itemize} + + +The output file specifier is useful when reading FTP or HTTP-type +FITS files since it can be used to create a local disk copy of the file +that can be reused in the future. If the output file name = `*' then a +local file with the same name as the network file will be created. +Note that CFITSIO will behave differently depending on whether the +remote file is compressed or not as shown by the following examples: +\begin{itemize} +\item +`ftp://remote.machine/tmp/myfile.fits.gz(*)' - the remote compressed +file is copied to the local compressed file `myfile.fits.gz', which +is then uncompressed in local memory before being opened and passed +to the application program. + +\item +`ftp://remote.machine/tmp/myfile.fits.gz(myfile.fits)' - the remote +compressed file is copied and uncompressed into the local file +`myfile.fits'. This example requires less local memory than the +previous example since the file is uncompressed on disk instead of +in memory. + +\item +`ftp://remote.machine/tmp/myfile.fits(myfile.fits.gz)' - this will +usually produce an error since CFITSIO itself cannot compress files. +\end{itemize} + +The exact behavior of CFITSIO in the latter case depends on the type of +ftp server running on the remote machine and how it is configured. In +some cases, if the file `myfile.fits.gz' exists on the remote machine, +then the server will copy it to the local machine. In other cases the +ftp server will automatically create and transmit a compressed version +of the file if only the uncompressed version exists. This can get +rather confusing, so users should use a certain amount of caution when +using the output file specifier with FTP or HTTP file types, to make +sure they get the behavior that they expect. + + +\section{Template File Name when Creating a New File} + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described below. + + +\section{HDU Location Specification} + +The optional HDU location specifier defines which HDU (Header-Data +Unit, also known as an `extension') within the FITS file to initially +open. It must immediately follow the base file name (or the output +file name if present). If it is not specified then the first HDU (the +primary array) is opened. The HDU location specifier is required if +the colFilter, rowFilter, or binSpec specifiers are present, because +the primary array is not a valid HDU for these operations. The HDU may +be specified either by absolute position number, starting with 0 for +the primary array, or by reference to the HDU name, and optionally, the +version number and the HDU type of the desired extension. The location +of an image within a single cell of a binary table may also be +specified, as described below. + +The absolute position of the extension is specified either by enclosed +the number in square brackets (e.g., `[1]' = the first extension +following the primary array) or by preceded the number with a plus sign +(`+1'). To specify the HDU by name, give the name of the desired HDU +(the value of the EXTNAME or HDUNAME keyword) and optionally the +extension version number (value of the EXTVER keyword) and the +extension type (value of the XTENSION keyword: IMAGE, ASCII or TABLE, +or BINTABLE), separated by commas and all enclosed in square brackets. +If the value of EXTVER and XTENSION are not specified, then the first +extension with the correct value of EXTNAME is opened. The extension +name and type are not case sensitive, and the extension type may be +abbreviated to a single letter (e.g., I = IMAGE extension or primary +array, A or T = ASCII table extension, and B = binary table BINTABLE +extension). If the HDU location specifier is equal to `[PRIMARY]' or +`[P]', then the primary array (the first HDU) will be opened. + +FITS images are most commonly stored in the primary array or an image +extension, but images can also be stored as a vector in a single cell +of a binary table (i.e. each row of the vector column contains a +different image). Such an image can be opened with CFITSIO by +specifying the desired column name and the row number after the binary +table HDU specifier as shown in the following examples. The column name +is separated from the HDU specifier by a semicolon and the row number +is enclosed in parentheses. In this case CFITSIO copies the image from +the table cell into a temporary primary array before it is opened. The +application program then just sees the image in the primary array, +without any extensions. The particular row to be opened may be +specified either by giving an absolute integer row number (starting +with 1 for the first row), or by specifying a boolean expression that +evaluates to TRUE for the desired row. The first row that satisfies +the expression will be used. The row selection expression has the same +syntax as described in the Row Filter Specifier section, below. + + Examples: + +\begin{verbatim} + myfile.fits[3] - open the 3rd HDU following the primary array + myfile.fits+3 - same as above, but using the FTOOLS-style notation + myfile.fits[EVENTS] - open the extension that has EXTNAME = 'EVENTS' + myfile.fits[EVENTS, 2] - same as above, but also requires EXTVER = 2 + myfile.fits[events,2,b] - same, but also requires XTENSION = 'BINTABLE' + myfile.fits[3; images(17)] - opens the image in row 17 of the 'images' + column in the 3rd extension of the file. + myfile.fits[3; images(exposure > 100)] - as above, but opens the image + in the first row that has an 'exposure' column value + greater than 100. +\end{verbatim} + + +\section{Image Section} + +A virtual file containing a rectangular subsection of an image can be +extracted and opened by specifying the range of pixels (start:end) +along each axis to be extracted from the original image. One can also +specify an optional pixel increment (start:end:step) for each axis of +the input image. A pixel step = 1 will be assumed if it is not +specified. If the start pixel is larger then the end pixel, then the +image will be flipped (producing a mirror image) along that dimension. +An asterisk, '*', may be used to specify the entire range of an axis, +and '-*' will flip the entire axis. The input image can be in the +primary array, in an image extension, or contained in a vector cell of +a binary table. In the later 2 cases the extension name or number must +be specified before the image section specifier. + + Examples: + +\begin{verbatim} + myfile.fits[1:512:2, 2:512:2] - open a 256x256 pixel image + consisting of the odd numbered columns (1st axis) and + the even numbered rows (2nd axis) of the image in the + primary array of the file. + + myfile.fits[*, 512:256] - open an image consisting of all the columns + in the input image, but only rows 256 through 512. + The image will be flipped along the 2nd axis since + the starting pixel is greater than the ending pixel. + + myfile.fits[*:2, 512:256:2] - same as above but keeping only + every other row and column in the input image. + + myfile.fits[-*, *] - copy the entire image, flipping it along + the first axis. + + myfile.fits[3][1:256,1:256] - opens a subsection of the image that + is in the 3rd extension of the file. + + myfile.fits[4; images(12)][1:10,1:10] - open an image consisting + of the first 10 pixels in both dimensions. The original + image resides in the 12th row of the 'images' vector + column in the table in the 4th extension of the file. +\end{verbatim} + +When CFITSIO opens an image section it first creates a temporary file +containing the image section plus a copy of any other HDUs in the +file. This temporary file is then opened by the application program, +so it is not possible to write to or modify the input file when +specifying an image section. Note that CFITSIO automatically updates +the world coordinate system keywords in the header of the image +section, if they exist, so that the coordinate associated with each +pixel in the image section will be computed correctly. + + +\section{Column and Keyword Filtering Specification} + +The optional column/keyword filtering specifier is used to modify the +column structure and/or the header keywords in the HDU that was +selected with the previous HDU location specifier. This filtering +specifier must be enclosed in square brackets and can be distinguished +from a general row filter specifier (described below) by the fact that +it begins with the string 'col ' and is not immediately followed by an +equals sign. The original file is not changed by this filtering +operation, and instead the modifications are made on a copy of the +input FITS file (usually in memory), which also contains a copy of all +the other HDUs in the file. This temporary file is passed to the +application program and will persist only until the file is closed or +until the program exits, unless the outfile specifier (see above) is +also supplied. + +The column/keyword filter can be used to perform the following +operations. More than one operation may be specified by separating +them with semi-colons. + +\begin{itemize} + +\item +Copy only a specified list of columns columns to the filtered input file. +The list of column name should be separated by semi-colons. Wild card +characters may be used in the column names to match multiple columns. +If the expression contains both a list of columns to be included and +columns to be deleted, then all the columns in the original table +except the explicitly deleted columns will appear in the filtered +table (i.e., there is no need to explicitly list the columns to +be included if any columns are being deleted). + +\item +Delete a column or keyword by listing the name preceded by a minus +sign or an exclamation mark (!), e.g., '-TIME' will delete the TIME +column if it exists, otherwise the TIME keyword. An error is returned +if neither a column nor keyword with this name exists. Note that the +exclamation point, '!', is a special UNIX character, so if it is used +on the command line rather than entered at a task prompt, it must be +preceded by a backslash to force the UNIX shell to ignore it. + +\item +Rename an existing column or keyword with the syntax 'NewName == +OldName'. An error is returned if neither a column nor keyword with +this name exists. + +\item +Append a new column or keyword to the table. To create a column, +give the new name, optionally followed by the datatype in parentheses, +followed by a single equals sign and an expression to be used to +compute the value (e.g., 'newcol(1J) = 0' will create a new 32-bit +integer column called 'newcol' filled with zeros). The datatype is +specified using the same syntax that is allowed for the value of the +FITS TFORMn keyword (e.g., 'I', 'J', 'E', 'D', etc. for binary tables, +and 'I8', F12.3', 'E20.12', etc. for ASCII tables). If the datatype is +not specified then an appropriate datatype will be chosen depending on +the form of the expression (may be a character string, logical, bit, long +integer, or double column). An appropriate vector count (in the case +of binary tables) will also be added if not explicitly specified. + +When creating a new keyword, the keyword name must be preceded by a +pound sign '\#', and the expression must evaluate to a scalar +(i.e., cannot have a column name in the expression). The comment +string for the keyword may be specified in parentheses immediately +following the keyword name (instead of supplying a datatype as in +the case of creating a new column). + +\item +Recompute (overwrite) the values in an existing column or keyword by +giving the name followed by an equals sign and an arithmetic +expression. +\end{itemize} + +The expression that is used when appending or recomputing columns or +keywords can be arbitrarily complex and may be a function of other +header keyword values and other columns (in the same row). The full +syntax and available functions for the expression are described below +in the row filter specification section. + +If the expression contains both a list of columns to be included and +columns to be deleted, then all the columns in the original table +except the explicitly deleted columns will appear in the filtered +table. + +For complex or commonly used operations, one can also place the +operations into an external text file and import it into the column +filter using the syntax '[col @filename.txt]'. The operations can +extend over multiple lines of the file, but multiple operations must +still be separated by semicolons. Any lines in the external text file +that begin with 2 slash characters ('//') will be ignored and may be +used to add comments into the file. + +Examples: + +\begin{verbatim} + [col Time;rate] - only the Time and rate columns will + appear in the filtered input file. + + [col Time;*raw] - include the Time column and any other + columns whose name ends with 'raw'. + + [col -TIME; Good == STATUS] - deletes the TIME column and + renames the status column to 'Good' + + [col PI=PHA * 1.1 + 0.2] - creates new PI column from PHA values + + [col rate = rate/exposure] - recomputes the rate column by dividing + it by the EXPOSURE keyword value. +\end{verbatim} + + +\section{Row Filtering Specification} + + When entering the name of a FITS table that is to be opened by a + program, an optional row filter may be specified to select a subset + of the rows in the table. A temporary new FITS file is created on + the fly which contains only those rows for which the row filter + expression evaluates to true. (The primary array and any other + extensions in the input file are also copied to the temporary + file). The original FITS file is closed and the new virtual file + is opened by the application program. The row filter expression is + enclosed in square brackets following the file name and extension + name (e.g., 'file.fits[events][GRADE==50]' selects only those rows + where the GRADE column value equals 50). When dealing with tables + where each row has an associated time and/or 2D spatial position, + the row filter expression can also be used to select rows based on + the times in a Good Time Intervals (GTI) extension, or on spatial + position as given in a SAO-style region file. + + +\subsection{General Syntax} + + The row filtering expression can be an arbitrarily complex series + of operations performed on constants, keyword values, and column + data taken from the specified FITS TABLE extension. The expression + must evaluate to a boolean value for each row of the table, where + a value of FALSE means that the row will be excluded. + + For complex or commonly used filters, one can place the expression + into a text file and import it into the row filter using the syntax + '[@filename.txt]'. The expression can be arbitrarily complex and + extend over multiple lines of the file. Any lines in the external + text file that begin with 2 slash characters ('//') will be ignored + and may be used to add comments into the file. + + Keyword and column data are referenced by name. Any string of + characters not surrounded by quotes (ie, a constant string) or + followed by an open parentheses (ie, a function name) will be + initially interpreted as a column name and its contents for the + current row inserted into the expression. If no such column exists, + a keyword of that name will be searched for and its value used, if + found. To force the name to be interpreted as a keyword (in case + there is both a column and keyword with the same name), precede the + keyword name with a single pound sign, '\#', as in '\#NAXIS2'. Due to + the generalities of FITS column and keyword names, if the column or + keyword name contains a space or a character which might appear as + an arithmetic term then inclose the name in '\$' characters as in + \$MAX PHA\$ or \#\$MAX-PHA\$. Names are case insensitive. + + To access a table entry in a row other than the current one, follow + the column's name with a row offset within curly braces. For + example, 'PHA\{-3\}' will evaluate to the value of column PHA, 3 rows + above the row currently being processed. One cannot specify an + absolute row number, only a relative offset. Rows that fall outside + the table will be treated as undefined, or NULLs. + + Boolean operators can be used in the expression in either their + Fortran or C forms. The following boolean operators are available: + +\begin{verbatim} + "equal" .eq. .EQ. == "not equal" .ne. .NE. != + "less than" .lt. .LT. < "less than/equal" .le. .LE. <= =< + "greater than" .gt. .GT. > "greater than/equal" .ge. .GE. >= => + "or" .or. .OR. || "and" .and. .AND. && + "negation" .not. .NOT. ! "approx. equal(1e-7)" ~ +\end{verbatim} + +Note that the exclamation +point, '!', is a special UNIX character, so if it is used on the +command line rather than entered at a task prompt, it must be preceded +by a backslash to force the UNIX shell to ignore it. + + The expression may also include arithmetic operators and functions. + Trigonometric functions use radians, not degrees. The following + arithmetic operators and functions can be used in the expression + (function names are case insensitive). A null value will be returned + in case of illegal operations such as divide by zero, sqrt(negative) + log(negative), log10(negative), arccos(.gt. 1), arcsin(.gt. 1). + + +\begin{verbatim} + "addition" + "subtraction" - + "multiplication" * "division" / + "negation" - "exponentiation" ** ^ + "absolute value" abs(x) "cosine" cos(x) + "sine" sin(x) "tangent" tan(x) + "arc cosine" arccos(x) "arc sine" arcsin(x) + "arc tangent" arctan(x) "arc tangent" arctan2(x,y) + "hyperbolic cos" cosh(x) "hyperbolic sin" sinh(x) + "hyperbolic tan" tanh(x) "round to nearest int" round(x) + "round down to int" floor(x) "round up to int" ceil(x) + "exponential" exp(x) "square root" sqrt(x) + "natural log" log(x) "common log" log10(x) + "modulus" i % j "random # [0.0,1.0)" random() + "minimum" min(x,y) "maximum" max(x,y) + "cumulative sum" accum(x) "sequential difference" seqdiff(x) + "if-then-else" b?x:y +\end{verbatim} + + An alternate syntax for the min and max functions has only a single + argument which should be a vector value (see below). The result + will be the minimum/maximum element contained within the vector. + + The accum(x) function forms the cumulative sum of x, element by element. + Vector columns are supported simply by performing the summation process + through all the values. Null values are treated as 0. The seqdiff(x) + function forms the sequential difference of x, element by element. + The first value of seqdiff is the first value of x. A single null + value in x causes a pair of nulls in the output. The seqdiff and + accum functions are functional inverses, i.e., seqdiff(accum(x)) == x + as long as no null values are present. + + The following type casting operators are available, where the + inclosing parentheses are required and taken from the C language + usage. Also, the integer to real casts values to double precision: + +\begin{verbatim} + "real to integer" (int) x (INT) x + "integer to real" (float) i (FLOAT) i +\end{verbatim} + + In addition, several constants are built in for use in numerical + expressions: + + +\begin{verbatim} + #pi 3.1415... #e 2.7182... + #deg #pi/180 #row current row number + #null undefined value #snull undefined string +\end{verbatim} + + A string constant must be enclosed in quotes as in 'Crab'. The + "null" constants are useful for conditionally setting table values + to a NULL, or undefined, value (eg., "col1==-99 ? \#NULL : col1"). + + There is also a function for testing if two values are close to + each other, i.e., if they are "near" each other to within a user + specified tolerance. The arguments, value\_1 and value\_2 can be + integer or real and represent the two values who's proximity is + being tested to be within the specified tolerance, also an integer + or real: + +\begin{verbatim} + near(value_1, value_2, tolerance) +\end{verbatim} + When a NULL, or undefined, value is encountered in the FITS table, + the expression will evaluate to NULL unless the undefined value is + not actually required for evaluation, e.g. "TRUE .or. NULL" + evaluates to TRUE. The following two functions allow some NULL + detection and handling: + +\begin{verbatim} + "a null value?" ISNULL(x) + "define a value for null" DEFNULL(x,y) +\end{verbatim} + The former + returns a boolean value of TRUE if the argument x is NULL. The + later "defines" a value to be substituted for NULL values; it + returns the value of x if x is not NULL, otherwise it returns the + value of y. + + +\subsection{Bit Masks} + + Bit masks can be used to select out rows from bit columns (TFORMn = + \#X) in FITS files. To represent the mask, binary, octal, and hex + formats are allowed: + + +\begin{verbatim} + binary: b0110xx1010000101xxxx0001 + octal: o720x1 -> (b111010000xxx001) + hex: h0FxD -> (b00001111xxxx1101) +\end{verbatim} + + In all the representations, an x or X is allowed in the mask as a + wild card. Note that the x represents a different number of wild + card bits in each representation. All representations are case + insensitive. + + To construct the boolean expression using the mask as the boolean + equal operator described above on a bit table column. For example, + if you had a 7 bit column named flags in a FITS table and wanted + all rows having the bit pattern 0010011, the selection expression + would be: + + +\begin{verbatim} + flags == b0010011 + or + flags .eq. b10011 +\end{verbatim} + + It is also possible to test if a range of bits is less than, less + than equal, greater than and greater than equal to a particular + boolean value: + + +\begin{verbatim} + flags <= bxxx010xx + flags .gt. bxxx100xx + flags .le. b1xxxxxxx +\end{verbatim} + + Notice the use of the x bit value to limit the range of bits being + compared. + + It is not necessary to specify the leading (most significant) zero + (0) bits in the mask, as shown in the second expression above. + + Bit wise AND, OR and NOT operations are also possible on two or + more bit fields using the '\&'(AND), '$|$'(OR), and the '!'(NOT) + operators. All of these operators result in a bit field which can + then be used with the equal operator. For example: + + +\begin{verbatim} + (!flags) == b1101100 + (flags & b1000001) == bx000001 +\end{verbatim} + + Bit fields can be appended as well using the '+' operator. Strings + can be concatenated this way, too. + + +\subsection{Vector Columns} + + Vector columns can also be used in building the expression. No + special syntax is required if one wants to operate on all elements + of the vector. Simply use the column name as for a scalar column. + Vector columns can be freely intermixed with scalar columns or + constants in virtually all expressions. The result will be of the + same dimension as the vector. Two vectors in an expression, though, + need to have the same number of elements and have the same + dimensions. The only places a vector column cannot be used (for + now, anyway) are the SAO region functions and the NEAR boolean + function. + + Arithmetic and logical operations are all performed on an element by + element basis. Comparing two vector columns, eg "COL1 == COL2", + thus results in another vector of boolean values indicating which + elements of the two vectors are equal. + + Eight functions are available that operate on a vector and return a + scalar result: + +\begin{verbatim} + "minimum" MIN(V) "maximum" MAX(V) + "average" AVERAGE(V) "median" MEDIAN(V) + "sumation" SUM(V) "standard deviation" STDDEV(V) + "# of values" NELEM(V) "# of non-null values" NVALID(V) +\end{verbatim} + where V represents the name of a vector column or a manually + constructed vector using curly brackets as described below. The + first 6 of these functions ignore any null values in the vector when + computing the result. + + The SUM function literally sums all the elements in x, returning a + scalar value. If x is a boolean vector, SUM returns the number + of TRUE elements. The NELEM function returns the number of elements + in vector x whereas NVALID return the number of non-null elements in + the vector. (NELEM also operates on bit and string columns, + returning their column widths.) As an example, to test whether all + elements of two vectors satisfy a given logical comparison, one can + use the expression + +\begin{verbatim} + SUM( COL1 > COL2 ) == NELEM( COL1 ) +\end{verbatim} + + which will return TRUE if all elements of COL1 are greater than + their corresponding elements in COL2. + + To specify a single element of a vector, give the column name + followed by a comma-separated list of coordinates enclosed in + square brackets. For example, if a vector column named PHAS exists + in the table as a one dimensional, 256 component list of numbers + from which you wanted to select the 57th component for use in the + expression, then PHAS[57] would do the trick. Higher dimensional + arrays of data may appear in a column. But in order to interpret + them, the TDIMn keyword must appear in the header. Assuming that a + (4,4,4,4) array is packed into each row of a column named ARRAY4D, + the (1,2,3,4) component element of each row is accessed by + ARRAY4D[1,2,3,4]. Arrays up to dimension 5 are currently + supported. Each vector index can itself be an expression, although + it must evaluate to an integer value within the bounds of the + vector. Vector columns which contain spaces or arithmetic operators + must have their names enclosed in "\$" characters as with + \$ARRAY-4D\$[1,2,3,4]. + + A more C-like syntax for specifying vector indices is also + available. The element used in the preceding example alternatively + could be specified with the syntax ARRAY4D[4][3][2][1]. Note the + reverse order of indices (as in C), as well as the fact that the + values are still ones-based (as in Fortran -- adopted to avoid + ambiguity for 1D vectors). With this syntax, one does not need to + specify all of the indices. To extract a 3D slice of this 4D + array, use ARRAY4D[4]. + + Variable-length vector columns are not supported. + + Vectors can be manually constructed within the expression using a + comma-separated list of elements surrounded by curly braces ('\{\}'). + For example, '\{1,3,6,1\}' is a 4-element vector containing the values + 1, 3, 6, and 1. The vector can contain only boolean, integer, and + real values (or expressions). The elements will be promoted to the + highest datatype present. Any elements which are themselves + vectors, will be expanded out with each of its elements becoming an + element in the constructed vector. + + +\subsection{Good Time Interval Filtering} + + A common filtering method involves selecting rows which have a time + value which lies within what is called a Good Time Interval or GTI. + The time intervals are defined in a separate FITS table extension + which contains 2 columns giving the start and stop time of each + good interval. The filtering operation accepts only those rows of + the input table which have an associated time which falls within + one of the time intervals defined in the GTI extension. A high + level function, gtifilter(a,b,c,d), is available which evaluates + each row of the input table and returns TRUE or FALSE depending + whether the row is inside or outside the good time interval. The + syntax is + +\begin{verbatim} + gtifilter( [ "gtifile" [, expr [, "STARTCOL", "STOPCOL" ] ] ] ) +\end{verbatim} + where each "[]" demarks optional parameters. Note that the quotes + around the gtifile and START/STOP column are required. Either single + or double quotes may be used. In cases where this expression is + entered on the Unix command line, enclose the entire expression in + double quotes, and then use single quotes within the expression to + enclose the 'gtifile' and other terms. It is also usually possible + to do the reverse, and enclose the whole expression in single quotes + and then use double quotes within the expression. The gtifile, + if specified, can be blank ("") which will mean to use the first + extension with the name "*GTI*" in the current file, a plain + extension specifier (eg, "+2", "[2]", or "[STDGTI]") which will be + used to select an extension in the current file, or a regular + filename with or without an extension specifier which in the latter + case will mean to use the first extension with an extension name + "*GTI*". Expr can be any arithmetic expression, including simply + the time column name. A vector time expression will produce a + vector boolean result. STARTCOL and STOPCOL are the names of the + START/STOP columns in the GTI extension. If one of them is + specified, they both must be. + + In its simplest form, no parameters need to be provided -- default + values will be used. The expression "gtifilter()" is equivalent to + +\begin{verbatim} + gtifilter( "", TIME, "*START*", "*STOP*" ) +\end{verbatim} + This will search the current file for a GTI extension, filter the + TIME column in the current table, using START/STOP times taken from + columns in the GTI extension with names containing the strings + "START" and "STOP". The wildcards ('*') allow slight variations in + naming conventions such as "TSTART" or "STARTTIME". The same + default values apply for unspecified parameters when the first one + or two parameters are specified. The function automatically + searches for TIMEZERO/I/F keywords in the current and GTI + extensions, applying a relative time offset, if necessary. + + +\subsection{Spatial Region Filtering} + + Another common filtering method selects rows based on whether the + spatial position associated with each row is located within a given + 2-dimensional region. The syntax for this high-level filter is + +\begin{verbatim} + regfilter( "regfilename" [ , Xexpr, Yexpr [ , "wcs cols" ] ] ) +\end{verbatim} + where each "[]" demarks optional parameters. The region file name + is required and must be enclosed in quotes. The remaining + parameters are optional. The region file is an ASCII text file + which contains a list of one or more geometric shapes (circle, + ellipse, box, etc.) which defines a region on the celestial sphere + or an area within a particular 2D image. The region file is + typically generated using an image display program such as fv/POW + (distribute by the HEASARC), or ds9 (distributed by the Smithsonian + Astrophysical Observatory). Users should refer to the documentation + provided with these programs for more details on the syntax used in + the region files. + + In its simpliest form, (e.g., regfilter("region.reg") ) the + coordinates in the default 'X' and 'Y' columns will be used to + determine if each row is inside or outside the area specified in + the region file. Alternate position column names, or expressions, + may be entered if needed, as in + +\begin{verbatim} + regfilter("region.reg", XPOS, YPOS) +\end{verbatim} + Region filtering can be applied most unambiguously if the positions + in the region file and in the table to be filtered are both give in + terms of absolute celestial coordinate units. In this case the + locations and sizes of the geometric shapes in the region file are + specified in angular units on the sky (e.g., positions given in + R.A. and Dec. and sizes in arcseconds or arcminutes). Similarly, + each row of the filtered table will have a celestial coordinate + associated with it. This association is usually implemented using + a set of so-called 'World Coordinate System' (or WCS) FITS keywords + that define the coordinate transformation that must be applied to + the values in the 'X' and 'Y' columns to calculate the coordinate. + + Alternatively, one can perform spatial filtering using unitless + 'pixel' coordinates for the regions and row positions. In this + case the user must be careful to ensure that the positions in the 2 + files are self-consistent. A typical problem is that the region + file may be generated using a binned image, but the unbinned + coordinates are given in the event table. The ROSAT events files, + for example, have X and Y pixel coordinates that range from 1 - + 15360. These coordinates are typically binned by a factor of 32 to + produce a 480x480 pixel image. If one then uses a region file + generated from this image (in image pixel units) to filter the + ROSAT events file, then the X and Y column values must be converted + to corresponding pixel units as in: + +\begin{verbatim} + regfilter("rosat.reg", X/32.+.5, Y/32.+.5) +\end{verbatim} + Note that this binning conversion is not necessary if the region + file is specified using celestial coordinate units instead of pixel + units because CFITSIO is then able to directly compare the + celestial coordinate of each row in the table with the celestial + coordinates in the region file without having to know anything + about how the image may have been binned. + + The last "wcs cols" parameter should rarely be needed. If supplied, + this string contains the names of the 2 columns (space or comma + separated) which have the associated WCS keywords. If not supplied, + the filter will scan the X and Y expressions for column names. + If only one is found in each expression, those columns will be + used, otherwise an error will be returned. + + These region shapes are supported (names are case insensitive): + +\begin{verbatim} + Point ( X1, Y1 ) <- One pixel square region + Line ( X1, Y1, X2, Y2 ) <- One pixel wide region + Polygon ( X1, Y1, X2, Y2, ... ) <- Rest are interiors with + Rectangle ( X1, Y1, X2, Y2, A ) | boundaries considered + Box ( Xc, Yc, Wdth, Hght, A ) V within the region + Diamond ( Xc, Yc, Wdth, Hght, A ) + Circle ( Xc, Yc, R ) + Annulus ( Xc, Yc, Rin, Rout ) + Ellipse ( Xc, Yc, Rx, Ry, A ) + Elliptannulus ( Xc, Yc, Rinx, Riny, Routx, Routy, Ain, Aout ) + Sector ( Xc, Yc, Amin, Amax ) +\end{verbatim} + where (Xc,Yc) is the coordinate of the shape's center; (X\#,Y\#) are + the coordinates of the shape's edges; Rxxx are the shapes' various + Radii or semimajor/minor axes; and Axxx are the angles of rotation + (or bounding angles for Sector) in degrees. For rotated shapes, the + rotation angle can be left off, indicating no rotation. Common + alternate names for the regions can also be used: rotbox = box; + rotrectangle = rectangle; (rot)rhombus = (rot)diamond; and pie + = sector. When a shape's name is preceded by a minus sign, '-', + the defined region is instead the area *outside* its boundary (ie, + the region is inverted). All the shapes within a single region + file are OR'd together to create the region, and the order is + significant. The overall way of looking at region files is that if + the first region is an excluded region then a dummy included region + of the whole detector is inserted in the front. Then each region + specification as it is processed overrides any selections inside of + that region specified by previous regions. Another way of thinking + about this is that if a previous excluded region is completely + inside of a subsequent included region the excluded region is + ignored. + + The positional coordinates may be given either in pixel units, + decimal degrees or hh:mm:ss.s, dd:mm:ss.s units. The shape sizes + may be given in pixels, degrees, arcminutes, or arcseconds. Look + at examples of region file produced by fv/POW or ds9 for further + details of the region file format. + + There are three functions that are primarily for use with SAO region + files and the FSAOI task, but they can be used directly. They + return a boolean true or false depending on whether a two + dimensional point is in the region or not: + +\begin{verbatim} + "point in a circular region" + circle(xcntr,ycntr,radius,Xcolumn,Ycolumn) + + "point in an elliptical region" + ellipse(xcntr,ycntr,xhlf_wdth,yhlf_wdth,rotation,Xcolumn,Ycolumn) + + "point in a rectangular region" + box(xcntr,ycntr,xfll_wdth,yfll_wdth,rotation,Xcolumn,Ycolumn) + + where + (xcntr,ycntr) are the (x,y) position of the center of the region + (xhlf_wdth,yhlf_wdth) are the (x,y) half widths of the region + (xfll_wdth,yfll_wdth) are the (x,y) full widths of the region + (radius) is half the diameter of the circle + (rotation) is the angle(degrees) that the region is rotated with + respect to (xcntr,ycntr) + (Xcoord,Ycoord) are the (x,y) coordinates to test, usually column + names + NOTE: each parameter can itself be an expression, not merely a + column name or constant. +\end{verbatim} + + +\subsection{Example Row Filters} + +\begin{verbatim} + [ binary && mag <= 5.0] - Extract all binary stars brighter + than fifth magnitude (note that + the initial space is necessary to + prevent it from being treated as a + binning specification) + + [#row >= 125 && #row <= 175] - Extract row numbers 125 through 175 + + [IMAGE[4,5] .gt. 100] - Extract all rows that have the + (4,5) component of the IMAGE column + greater than 100 + + [abs(sin(theta * #deg)) < 0.5] - Extract all rows having the + absolute value of the sine of theta + less than a half where the angles + are tabulated in degrees + + [SUM( SPEC > 3*BACKGRND )>=1] - Extract all rows containing a + spectrum, held in vector column + SPEC, with at least one value 3 + times greater than the background + level held in a keyword, BACKGRND + + [VCOL=={1,4,2}] - Extract all rows whose vector column + VCOL contains the 3-elements 1, 4, and + 2. + + [@rowFilter.txt] - Extract rows using the expression + contained within the text file + rowFilter.txt + + [gtifilter()] - Search the current file for a GTI + extension, filter the TIME + column in the current table, using + START/STOP times taken from + columns in the GTI extension + + [regfilter("pow.reg")] - Extract rows which have a coordinate + (as given in the X and Y columns) + within the spatial region specified + in the pow.reg region file. + + [regfilter("pow.reg", Xs, Ys)] - Same as above, except that the + Xs and Ys columns will be used to + determine the coordinate of each + row in the table. +\end{verbatim} + + +\section{ Binning or Histogramming Specification} + +The optional binning specifier is enclosed in square brackets and can +be distinguished from a general row filter specification by the fact +that it begins with the keyword 'bin' not immediately followed by an +equals sign. When binning is specified, a temporary N-dimensional FITS +primary array is created by computing the histogram of the values in +the specified columns of a FITS table extension. After the histogram +is computed the input FITS file containing the table is then closed and +the temporary FITS primary array is opened and passed to the +application program. Thus, the application program never sees the +original FITS table and only sees the image in the new temporary file +(which has no additional extensions). Obviously, the application +program must be expecting to open a FITS image and not a FITS table in +this case. + +The data type of the FITS histogram image may be specified by appending +'b' (for 8-bit byte), 'i' (for 16-bit integers), 'j' (for 32-bit +integer), 'r' (for 32-bit floating points), or 'd' (for 64-bit double +precision floating point) to the 'bin' keyword (e.g. '[binr X]' +creates a real floating point image). If the datatype is not +explicitly specified then a 32-bit integer image will be created by +default, unless the weighting option is also specified in which case +the image will have a 32-bit floating point data type by default. + +The histogram image may have from 1 to 4 dimensions (axes), depending +on the number of columns that are specified. The general form of the +binning specification is: + +\begin{verbatim} + [bin{bijrd} Xcol=min:max:binsize, Ycol= ..., Zcol=..., Tcol=...; weight] +\end{verbatim} +in which up to 4 columns, each corresponding to an axis of the image, +are listed. The column names are case insensitive, and the column +number may be given instead of the name, preceded by a pound sign +(e.g., [bin \#4=1:512]). If the column name is not specified, then +CFITSIO will first try to use the 'preferred column' as specified by +the CPREF keyword if it exists (e.g., 'CPREF = 'DETX,DETY'), otherwise +column names 'X', 'Y', 'Z', and 'T' will be assumed for each of the 4 +axes, respectively. In cases where the column name could be confused +with an arithmetic expression, enclose the column name in parentheses to +force the name to be interpreted literally. + +Each column name may be followed by an equals sign and then the lower +and upper range of the histogram, and the size of the histogram bins, +separated by colons. Spaces are allowed before and after the equals +sign but not within the 'min:max:binsize' string. The min, max and +binsize values may be integer or floating point numbers, or they may be +the names of keywords in the header of the table. If the latter, then +the value of that keyword is substituted into the expression. + +Default values for the min, max and binsize quantities will be +used if not explicitly given in the binning expression as shown +in these examples: + +\begin{verbatim} + [bin x = :512:2] - use default minimum value + [bin x = 1::2] - use default maximum value + [bin x = 1:512] - use default bin size + [bin x = 1:] - use default maximum value and bin size + [bin x = :512] - use default minimum value and bin size + [bin x = 2] - use default minimum and maximum values + [bin x] - use default minimum, maximum and bin size + [bin 4] - default 2-D image, bin size = 4 in both axes + [bin] - default 2-D image +\end{verbatim} +CFITSIO will use the value of the TLMINn, TLMAXn, and TDBINn keywords, +if they exist, for the default min, max, and binsize, respectively. If +they do not exist then CFITSIO will use the actual minimum and maximum +values in the column for the histogram min and max values. The default +binsize will be set to 1, or (max - min) / 10., whichever is smaller, +so that the histogram will have at least 10 bins along each axis. + +A shortcut notation is allowed if all the columns/axes have the same +binning specification. In this case all the column names may be listed +within parentheses, followed by the (single) binning specification, as +in: + +\begin{verbatim} + [bin (X,Y)=1:512:2] + [bin (X,Y) = 5] +\end{verbatim} + +The optional weighting factor is the last item in the binning specifier +and, if present, is separated from the list of columns by a +semi-colon. As the histogram is accumulated, this weight is used to +incremented the value of the appropriated bin in the histogram. If the +weighting factor is not specified, then the default weight = 1 is +assumed. The weighting factor may be a constant integer or floating +point number, or the name of a keyword containing the weighting value. +Or the weighting factor may be the name of a table column in which case +the value in that column, on a row by row basis, will be used. + +In some cases, the column or keyword may give the reciprocal of the +actual weight value that is needed. In this case, precede the weight +keyword or column name by a slash '/' to tell CFITSIO to use the +reciprocal of the value when constructing the histogram. + +For complex or commonly used histograms, one can also place its +description into a text file and import it into the binning +specification using the syntax '[bin @filename.txt]'. The file's +contents can extend over multiple lines, although it must still +conform to the no-spaces rule for the min:max:binsize syntax and each +axis specification must still be comma-separated. Any lines in the +external text file that begin with 2 slash characters ('//') will be +ignored and may be used to add comments into the file. + + Examples: + + +\begin{verbatim} + [bini detx, dety] - 2-D, 16-bit integer histogram + of DETX and DETY columns, using + default values for the histogram + range and binsize + + [bin (detx, dety)=16; /exposure] - 2-D, 32-bit real histogram of DETX + and DETY columns with a bin size = 16 + in both axes. The histogram values + are divided by the EXPOSURE keyword + value. + + [bin time=TSTART:TSTOP:0.1] - 1-D lightcurve, range determined by + the TSTART and TSTOP keywords, + with 0.1 unit size bins. + + [bin pha, time=8000.:8100.:0.1] - 2-D image using default binning + of the PHA column for the X axis, + and 1000 bins in the range + 8000. to 8100. for the Y axis. + + [bin @binFilter.txt] - Use the contents of the text file + binFilter.txt for the binning + specifications. + +\end{verbatim} + + +\chapter{Template Files } + +When a new FITS file is created with a call to fits\_create\_file, the +name of a template file may be supplied in parentheses immediately +following the name of the new file to be created. This template is +used to define the structure of one or more HDUs in the new file. The +template file may be another FITS file, in which case the newly created +file will have exactly the same keywords in each HDU as in the template +FITS file, but all the data units will be filled with zeros. The +template file may also be an ASCII text file, where each line (in +general) describes one FITS keyword record. The format of the ASCII +template file is described in the following sections. + + +\section{Detailed Template Line Format} + +The format of each ASCII template line closely follows the format of a +FITS keyword record: + +\begin{verbatim} + KEYWORD = KEYVALUE / COMMENT +\end{verbatim} +except that free format may be used (e.g., the equals sign may appear +at any position in the line) and TAB characters are allowed and are +treated the same as space characters. The KEYVALUE and COMMENT fields +are optional. The equals sign character is also optional, but it is +recommended that it be included for clarity. Any template line that +begins with the pound '\#' character is ignored by the template parser +and may be use to insert comments into the template file itself. + +The KEYWORD name field is limited to 8 characters in length and only +the letters A-Z, digits 0-9, and the hyphen and underscore characters +may be used, without any embedded spaces. Lowercase letters in the +template keyword name will be converted to uppercase. Leading spaces +in the template line preceding the keyword name are generally ignored, +except if the first 8 characters of a template line are all blank, then +the entire line is treated as a FITS comment keyword (with a blank +keyword name) and is copied verbatim into the FITS header. + +The KEYVALUE field may have any allowed FITS data type: character +string, logical, integer, real, complex integer, or complex real. The +character string values need not be enclosed in single quote characters +unless they are necessary to distinguish the string from a different +data type (e.g. 2.0 is a real but '2.0' is a string). The keyword has +an undefined (null) value if the template record only contains blanks +following the "=" or between the "=" and the "/" comment field +delimiter. + +String keyword values longer than 68 characters (the maximum length +that will fit in a single FITS keyword record) are permitted using the +CFITSIO long string convention. They can either be specified as a +single long line in the template, or by using multiple lines where the +continuing lines contain the 'CONTINUE' keyword, as in this example: + +\begin{verbatim} + LONGKEY = 'This is a long string value that is contin&' + CONTINUE 'ued over 2 records' / comment field goes here +\end{verbatim} +The format of template lines with CONTINUE keyword is very strict: 3 +spaces must follow CONTINUE and the rest of the line is copied verbatim +to the FITS file. + +The start of the optional COMMENT field must be preceded by "/", which +is used to separate it from the keyword value field. Exceptions are if +the KEYWORD name field contains COMMENT, HISTORY, CONTINUE, or if the +first 8 characters of the template line are blanks. + +More than one Header-Data Unit (HDU) may be defined in the template +file. The start of an HDU definition is denoted with a SIMPLE or +XTENSION template line: + +1) SIMPLE begins a Primary HDU definition. SIMPLE may only appear as +the first keyword in the template file. If the template file begins +with XTENSION instead of SIMPLE, then a default empty Primary HDU is +created, and the template is then assumed to define the keywords +starting with the first extension following the Primary HDU. + +2) XTENSION marks the beginning of a new extension HDU definition. The +previous HDU will be closed at this point and processing of the next +extension begins. + + +\section{Auto-indexing of Keywords} + +If a template keyword name ends with a "\#" character, it is said to be +'auto-indexed'. Each "\#" character will be replaced by the current +integer index value, which gets reset = 1 at the start of each new HDU +in the file (or 7 in the special case of a GROUP definition). The +FIRST indexed keyword in each template HDU definition is used as the +'incrementor'; each subsequent occurrence of this SAME keyword will +cause the index value to be incremented. This behavior can be rather +subtle, as illustrated in the following examples in which the TTYPE +keyword is the incrementor in both cases: + +\begin{verbatim} + TTYPE# = TIME + TFORM# = 1D + TTYPE# = RATE + TFORM# = 1E +\end{verbatim} +will create TTYPE1, TFORM1, TTYPE2, and TFORM2 keywords. But if the +template looks like, + +\begin{verbatim} + TTYPE# = TIME + TTYPE# = RATE + TFORM# = 1D + TFORM# = 1E +\end{verbatim} +this results in a FITS files with TTYPE1, TTYPE2, TFORM2, and TFORM2, +which is probably not what was intended! + + +\section{Template Parser Directives} + +In addition to the template lines which define individual keywords, the +template parser recognizes 3 special directives which are each preceded +by the backslash character: \verb+ \include, \group+, and \verb+ \end+. + +The 'include' directive must be followed by a filename. It forces the +parser to temporarily stop reading the current template file and begin +reading the include file. Once the parser reaches the end of the +include file it continues parsing the current template file. Include +files can be nested, and HDU definitions can span multiple template +files. + +The start of a GROUP definition is denoted with the 'group' directive, +and the end of a GROUP definition is denoted with the 'end' directive. +Each GROUP contains 0 or more member blocks (HDUs or GROUPs). Member +blocks of type GROUP can contain their own member blocks. The GROUP +definition itself occupies one FITS file HDU of special type (GROUP +HDU), so if a template specifies 1 group with 1 member HDU like: + +\begin{verbatim} +\group +grpdescr = 'demo' +xtension bintable +# this bintable has 0 cols, 0 rows +\end +\end{verbatim} +then the parser creates a FITS file with 3 HDUs : + +\begin{verbatim} +1) dummy PHDU +2) GROUP HDU (has 1 member, which is bintable in HDU number 3) +3) bintable (member of GROUP in HDU number 2) +\end{verbatim} +Technically speaking, the GROUP HDU is a BINTABLE with 6 columns. Applications +can define additional columns in a GROUP HDU using TFORMn and TTYPEn +(where n is 7, 8, ....) keywords or their auto-indexing equivalents. + +For a more complicated example of a template file using the group directives, +look at the sample.tpl file that is included in the CFITSIO distribution. + + +\section{Formal Template Syntax} + +The template syntax can formally be defined as follows: + +\begin{verbatim} + TEMPLATE = BLOCK [ BLOCK ... ] + + BLOCK = { HDU | GROUP } + + GROUP = \GROUP [ BLOCK ... ] \END + + HDU = XTENSION [ LINE ... ] { XTENSION | \GROUP | \END | EOF } + + LINE = [ KEYWORD [ = ] ] [ VALUE ] [ / COMMENT ] + + X ... - X can be present 1 or more times + { X | Y } - X or Y + [ X ] - X is optional +\end{verbatim} + +At the topmost level, the template defines 1 or more template blocks. Blocks +can be either HDU (Header Data Unit) or a GROUP. For each block the parser +creates 1 (or more for GROUPs) FITS file HDUs. + + + +\section{Errors} + +In general the fits\_execute\_template() function tries to be as atomic +as possible, so either everything is done or nothing is done. If an +error occurs during parsing of the template, fits\_execute\_template() +will (try to) delete the top level BLOCK (with all its children if any) +in which the error occurred, then it will stop reading the template file +and it will return with an error. + + +\section{Examples} + +1. This template file will create a 200 x 300 pixel image, with 4-byte +integer pixel values, in the primary HDU: + +\begin{verbatim} + SIMPLE = T + BITPIX = 32 + NAXIS = 2 / number of dimensions + NAXIS1 = 100 / length of first axis + NAXIS2 = 200 / length of second axis + OBJECT = NGC 253 / name of observed object +\end{verbatim} +The allowed values of BITPIX are 8, 16, 32, -32, or -64, +representing, respectively, 8-bit integer, 16-bit integer, 32-bit +integer, 32-bit floating point, or 64 bit floating point pixels. + +2. To create a FITS table, the template first needs to include +XTENSION = TABLE or BINTABLE to define whether it is an ASCII or binary +table, and NAXIS2 to define the number of rows in the table. Two +template lines are then needed to define the name (TTYPEn) and FITS data +format (TFORMn) of the columns, as in this example: + +\begin{verbatim} + xtension = bintable + naxis2 = 40 + ttype# = Name + tform# = 10a + ttype# = Npoints + tform# = j + ttype# = Rate + tunit# = counts/s + tform# = e +\end{verbatim} +The above example defines a null primary array followed by a 40-row +binary table extension with 3 columns called 'Name', 'Npoints', and +'Rate', with data formats of '10A' (ASCII character string), '1J' +(integer) and '1E' (floating point), respectively. Note that the other +required FITS keywords (BITPIX, NAXIS, NAXIS1, PCOUNT, GCOUNT, TFIELDS, +and END) do not need to be explicitly defined in the template because +their values can be inferred from the other keywords in the template. +This example also illustrates that the templates are generally +case-insensitive (the keyword names and TFORMn values are converted to +upper-case in the FITS file) and that string keyword values generally +do not need to be enclosed in quotes. + +\chapter{FITSIO Conventions and Guidelines } + + +\section{CFITSIO Size Limitations} + +CFITSIO places few restrictions on the size of FITS files that it +reads or writes. There are a few limits, however, which may affect +some extreme cases: + +1. The maximum number of FITS files that may be simultaneously opened +by CFITSIO is set by NMAXFILES as defined in fitsio2.h. It is currently +set = 300 by default. CFITSIO will allocate about 80 * NMAXFILES bytes +of memory for internal use. Note that the underlying C compiler or +operating system, may have a smaller limit on the number of opened files. +The C symbolic constant FOPEN\_MAX is intended to define the maximum +number of files that may open at once (including any other text or +binary files that may be open, not just FITS files). On some systems it +has been found that gcc supports a maximum of 255 opened files. + +Note that opening and operating on many FITS files simultaneously in +parallel may be less efficient than operating on smaller groups of files +in series. CFITSIO only has NIOBUF number of internal buffers (set = 40 +by default) that are used for temporary storage of the most recent data +records that have been read or written in the FITS files. If the number +of opened files is greater than NIOBUF, then CFITSIO may waste more time +flushing and re-reading or re-writing the same records in the FITS files. + +2. By default, CFITSIO can handle FITS files up to 2.1 GB in size (2**31 +bytes). This file size limit is often imposed by 32-bit operating +systems. More recently, as 64-bit operating systems become more common, an +industry-wide standard (at least on Unix systems) has been developed to +support larger sized files (see http://ftp.sas.com/standards/large.file/). +Starting with version 2.1 of CFITSIO, larger FITS files up to 6 terabytes +in size may be read and written on supported platforms. In order +to support these larger files, CFITSIO must be compiled with the +'-D\_LARGEFILE\_SOURCE' and `-D\_FILE\_OFFSET\_BITS=64' compiler flags. +Some platforms may also require the `-D\_LARGE\_FILES' compiler flag. + This causes the compiler to allocate 8-bytes instead of +4-bytes for the `off\_t' datatype which is used to store file offset +positions. It appears that in most cases it is not necessary to +also include these compiler flags when compiling programs that link to +the CFITSIO library. + +If CFITSIO is compiled with the -D\_LARGEFILE\_SOURCE +and -D\_FILE\_OFFSET\_BITS=64 flags on a +platform that supports large files, then it can read and write FITS +files that contain up to 2**31 2880-byte FITS records, or approximately +6 terabytes in size. It is still required that the value of the NAXISn +and PCOUNT keywords in each extension be within the range of a signed +4-byte integer (max value = 2,147,483,648). Thus, each dimension of an +image (given by the NAXISn keywords), the total width of a table +(NAXIS1 keyword), the number of rows in a table (NAXIS2 keyword), and +the total size of the variable-length array heap in binary tables +(PCOUNT keyword) must be less than this limit. + +Currently, support for large files within CFITSIO has been tested +on the Linux, Solaris, and IBM AIX operating systems. + + +\section{Multiple Access to the Same FITS File} + +CFITSIO supports simultaneous read and write access to multiple HDUs in +the same FITS file. Thus, one can open the same FITS file twice within +a single program and move to 2 different HDUs in the file, and then +read and write data or keywords to the 2 extensions just as if one were +accessing 2 completely separate FITS files. Since in general it is +not possible to physically open the same file twice and then expect to +be able to simultaneously (or in alternating succession) write to 2 +different locations in the file, CFITSIO recognizes when the file to be +opened (in the call to fits\_open\_file) has already been opened and +instead of actually opening the file again, just logically links the +new file to the old file. (This only applies if the file is opened +more than once within the same program, and does not prevent the same +file from being simultaneously opened by more than one program). Then +before CFITSIO reads or writes to either (logical) file, it makes sure +that any modifications made to the other file have been completely +flushed from the internal buffers to the file. Thus, in principle, one +could open a file twice, in one case pointing to the first extension +and in the other pointing to the 2nd extension and then write data to +both extensions, in any order, without danger of corrupting the file, +There may be some efficiency penalties in doing this however, since +CFITSIO has to flush all the internal buffers related to one file +before switching to the other, so it would still be prudent to +minimize the number of times one switches back and forth between doing +I/O to different HDUs in the same file. + + +\section{Current Header Data Unit (CHDU)} + +In general, a FITS file can contain multiple Header Data Units, also +called extensions. CFITSIO only operates within one HDU at any given +time, and the currently selected HDU is called the Current Header Data +Unit (CHDU). When a FITS file is first created or opened the CHDU is +automatically defined to be the first HDU (i.e., the primary array). +CFITSIO routines are provided to move to and open any other existing +HDU within the FITS file or to append or insert a new HDU in the FITS +file which then becomes the CHDU. + + +\section{Subroutine Names} + +All FITSIO subroutine names begin with the letters 'ft' to distinguish +them from other subroutines and are 5 or 6 characters long. Users should +not name their own subroutines beginning with 'ft' to avoid conflicts. +(The SPP interface routines all begin with 'fs'). Subroutines which read +or get information from the FITS file have names beginning with +'ftg...'. Subroutines which write or put information into the FITS file +have names beginning with 'ftp...'. + + +\section{Subroutine Families and Datatypes} + +Many of the subroutines come in families which differ only in the +datatype of the associated parameter(s) . The datatype of these +subroutines is indicated by the last letter of the subroutine name +(e.g., 'j' in 'ftpkyj') as follows: + +\begin{verbatim} + x - bit + b - character*1 (unsigned byte) + i - short integer (I*2) + j - integer (I*4) + e - real exponential floating point (R*4) + f - real fixed-format floating point (R*4) + d - double precision real floating-point (R*8) + g - double precision fixed-format floating point (R*8) + c - complex reals (pairs of R*4 values) + m - double precision complex (pairs of R*8 values) + l - logical (L*4) + s - character string +\end{verbatim} + +When dealing with the FITS byte datatype, it is important to remember +that the raw values (before any scaling by the BSCALE and BZERO, or +TSCALn and TZEROn keyword values) in byte arrays (BITPIX = 8) or byte +columns (TFORMn = 'B') are interpreted as unsigned bytes with values +ranging from 0 to 255. Some Fortran compilers support a non-standard +byte datatype such as INTEGER*1, LOGICAL*1, or BYTE, which can sometimes +be used instead of CHARACTER*1 variables. Many machines permit passing a +numeric datatype (such as INTEGER*1) to the FITSIO subroutines which are +expecting a CHARACTER*1 datatype, but this technically violates the +Fortran-77 standard and is not supported on all machines (e.g., on a VAX/VMS +machine one must use the VAX-specific \%DESCR function). + +One feature of the CFITSIO routines is that they can operate on a `X' +(bit) column in a binary table as though it were a `B' (byte) column. +For example a `11X' datatype column can be interpreted the same as a +`2B' column (i.e., 2 unsigned 8-bit bytes). In some instances, it can +be more efficient to read and write whole bytes at a time, rather than +reading or writing each individual bit. + +The double precision complex datatype is not a standard Fortran-77 +datatype. If a particular Fortran compiler does not directly support +this datatype, then one may instead pass an array of pairs of double +precision values to these subroutines. The first value in each pair +is the real part, and the second is the imaginary part. + + +\section{Implicit Data Type Conversion} + +The FITSIO routines that read and write numerical data can perform +implicit data type conversion. This means that the data type of the +variable or array in the program does not need to be the same as the +data type of the value in the FITS file. Data type conversion is +supported for numerical and string data types (if the string contains a +valid number enclosed in quotes) when reading a FITS header keyword +value and for numeric values when reading or writing values in the +primary array or a table column. CFITSIO returns status = +NUM\_OVERFLOW if the converted data value exceeds the range of the +output data type. Implicit data type conversion is not supported +within binary tables for string, logical, complex, or double complex +data types. + +In addition, any table column may be read as if it contained string values. +In the case of numeric columns the returned string will be formatted +using the TDISPn display format if it exists. + + +\section{Data Scaling} + +When reading numerical data values in the primary array or a +table column, the values will be scaled automatically by the BSCALE and +BZERO (or TSCALn and TZEROn) header keyword values if they are +present in the header. The scaled data that is returned to the reading +program will have + +\begin{verbatim} + output value = (FITS value) * BSCALE + BZERO +\end{verbatim} +(a corresponding formula using TSCALn and TZEROn is used when reading +from table columns). In the case of integer output values the floating +point scaled value is truncated to an integer (not rounded to the +nearest integer). The ftpscl and fttscl subroutines may be used to +override the scaling parameters defined in the header (e.g., to turn +off the scaling so that the program can read the raw unscaled values +from the FITS file). + +When writing numerical data to the primary array or to a table +column the data values will generally be automatically inversely scaled +by the value of the BSCALE and BZERO (or TSCALn and TZEROn) header +keyword values if they they exist in the header. These keywords must +have been written to the header before any data is written for them to +have any effect. Otherwise, one may use the ftpscl and fttscl +subroutines to define or override the scaling keywords in the header +(e.g., to turn off the scaling so that the program can write the raw +unscaled values into the FITS file). If scaling is performed, the +inverse scaled output value that is written into the FITS file will +have + +\begin{verbatim} + FITS value = ((input value) - BZERO) / BSCALE +\end{verbatim} +(a corresponding formula using TSCALn and TZEROn is used when +writing to table columns). Rounding to the nearest integer, rather +than truncation, is performed when writing integer datatypes to the +FITS file. + + +\section{Error Status Values and the Error Message Stack} + +The last parameter in nearly every FITSIO subroutine is the error +status value which is both an input and an output parameter. A +returned positive value for this parameter indicates an error was +detected. A listing of all the FITSIO status code values is given at +the end of this document. + +The FITSIO library uses an `inherited status' convention for the status +parameter which means that if a subroutine is called with a positive +input value of the status parameter, then the subroutine will exit +immediately without changing the value of the status parameter. Thus, +if one passes the status value returned from each FITSIO routine as +input to the next FITSIO subroutine, then whenever an error is detected +all further FITSIO processing will cease. This convention can simplify +the error checking in application programs because it is not necessary +to check the value of the status parameter after every single FITSIO +subroutine call. If a program contains a sequence of several FITSIO +calls, one can just check the status value after the last call. Since +the returned status values are generally distinctive, it should be +possible to determine which subroutine originally returned the error +status. + +FITSIO also maintains an internal stack of error messages (80-character +maximum length) which in many cases provide a more detailed explanation +of the cause of the error than is provided by the error status number +alone. It is recommended that the error message stack be printed out +whenever a program detects a FITSIO error. To do this, call the FTGMSG +routine repeatedly to get the successive messages on the stack. When the +stack is empty FTGMSG will return a blank string. Note that this is a +`First In -- First Out' stack, so the oldest error message is returned +first by ftgmsg. + + +\section{Variable-Length Array Facility in Binary Tables} + +FITSIO provides easy-to-use support for reading and writing data in +variable length fields of a binary table. The variable length columns +have TFORMn keyword values of the form `1Pt(len)' where `t' is the +datatype code (e.g., I, J, E, D, etc.) and `len' is an integer +specifying the maximum length of the vector in the table. If the value +of `len' is not specified when the table is created (e.g., if the TFORM +keyword value is simply specified as '1PE' instead of '1PE(400) ), then +FITSIO will automatically scan the table when it is closed to +determine the maximum length of the vector and will append this value +to the TFORMn value. + +The same routines which read and write data in an ordinary fixed length +binary table extension are also used for variable length fields, +however, the subroutine parameters take on a slightly different +interpretation as described below. + +All the data in a variable length field is written into an area called +the `heap' which follows the main fixed-length FITS binary table. The +size of the heap, in bytes, is specified with the PCOUNT keyword in the +FITS header. When creating a new binary table, the initial value of +PCOUNT should usually be set to zero. FITSIO will recompute the size +of the heap as the data is written and will automatically update the +PCOUNT keyword value when the table is closed. When writing variable +length data to a table, CFITSIO will automatically extend the size +of the heap area if necessary, so that any following HDUs do not +get overwritten. + +By default the heap data area starts immediately after the last row of +the fixed-length table. This default starting location may be +overridden by the THEAP keyword, but this is not recommended. +If additional rows of data are added to the table, CFITSIO will +automatically shift the the heap down to make room for the new +rows, but it is obviously be more efficient to initially +create the table with the necessary number of blank rows, so that +the heap does not needed to be constantly moved. + +When writing to a variable length field, the entire array of values for +a given row of the table must be written with a single call to FTPCLx. +The total length of the array is calculated from (NELEM+FELEM-1). One +cannot append more elements to an existing field at a later time; any +attempt to do so will simply overwrite all the data which was previously +written. Note also that the new data will be written to a new area of +the heap and the heap space used by the previous write cannot be +reclaimed. For this reason it is advised that each row of a variable +length field only be written once. An exception to this general rule +occurs when setting elements of an array as undefined. One must first +write a dummy value into the array with FTPCLx, and then call FTPCLU to +flag the desired elements as undefined. (Do not use the FTPCNx family +of routines with variable length fields). Note that the rows of a table, +whether fixed or variable length, do not have to be written +consecutively and may be written in any order. + +When writing to a variable length ASCII character field (e.g., TFORM = +'1PA') only a single character string written. FTPCLS writes the whole +length of the input string (minus any trailing blank characters), thus +the NELEM and FELEM parameters are ignored. If the input string is +completely blank then FITSIO will write one blank character to the FITS +file. Similarly, FTGCVS and FTGCFS read the entire string (truncated +to the width of the character string argument in the subroutine call) +and also ignore the NELEM and FELEM parameters. + +The FTPDES subroutine is useful in situations where multiple rows of a +variable length column have the identical array of values. One can +simply write the array once for the first row, and then use FTPDES to +write the same descriptor values into the other rows (use the FTGDES +routine to read the first descriptor value); all the rows will then +point to the same storage location thus saving disk space. + +When reading from a variable length array field one can only read as +many elements as actually exist in that row of the table; reading does +not automatically continue with the next row of the table as occurs +when reading an ordinary fixed length table field. Attempts to read +more than this will cause an error status to be returned. One can +determine the number of elements in each row of a variable column with +the FTGDES subroutine. + + +\section{Support for IEEE Special Values} + +The ANSI/IEEE-754 floating-point number standard defines certain +special values that are used to represent such quantities as +Not-a-Number (NaN), denormalized, underflow, overflow, and infinity. +(See the Appendix in the NOST FITS standard or the NOST FITS User's +Guide for a list of these values). The FITSIO subroutines that read +floating point data in FITS files recognize these IEEE special values +and by default interpret the overflow and infinity values as being +equivalent to a NaN, and convert the underflow and denormalized values +into zeros. In some cases programmers may want access to the raw IEEE +values, without any modification by FITSIO. This can be done by +calling the FTGPVx or FTGCVx routines while specifying 0.0 as the value +of the NULLVAL parameter. This will force FITSIO to simply pass the +IEEE values through to the application program, without any +modification. This does not work for double precision values on +VAX/VMS machines, however, where there is no easy way to bypass the +default interpretation of the IEEE special values. + + +\section{When the Final Size of the FITS HDU is Unknown} + +It is not required to know the total size of a FITS data array or table +before beginning to write the data to the FITS file. In the case of +the primary array or an image extension, one should initially create +the array with the size of the highest dimension (largest NAXISn +keyword) set to a dummy value, such as 1. Then after all the data have +been written and the true dimensions are known, then the NAXISn value +should be updated using the fits\_ update\_key routine before moving to +another extension or closing the FITS file. + +When writing to FITS tables, CFITSIO automatically keeps track of the +highest row number that is written to, and will increase the size of +the table if necessary. CFITSIO will also automatically insert space +in the FITS file if necessary, to ensure that the data 'heap', if it +exists, and/or any additional HDUs that follow the table do not get +overwritten as new rows are written to the table. + +As a general rule it is best to specify the initial number of rows = 0 +when the table is created, then let CFITSIO keep track of the number of +rows that are actually written. The application program should not +manually update the number of rows in the table (as given by the NAXIS2 +keyword) since CFITSIO does this automatically. If a table is +initially created with more than zero rows, then this will usually be +considered as the minimum size of the table, even if fewer rows are +actually written to the table. Thus, if a table is initially created +with NAXIS2 = 20, and CFITSIO only writes 10 rows of data before +closing the table, then NAXIS2 will remain equal to 20. If however, 30 +rows of data are written to this table, then NAXIS2 will be increased +from 20 to 30. The one exception to this automatic updating of the +NAXIS2 keyword is if the application program directly modifies the +value of NAXIS2 (up or down) itself just before closing the table. In this +case, CFITSIO does not update NAXIS2 again, since it assumes that the +application program must have had a good reason for changing the value +directly. This is not recommended, however, and is only provided for +backward compatibility with software that initially creates a table +with a large number of rows, than decreases the NAXIS2 value to the +actual smaller value just before closing the table. + + +\section{Local FITS Conventions supported by FITSIO} + +CFITSIO supports several local FITS conventions which are not +defined in the official NOST FITS standard and which are not +necessarily recognized or supported by other FITS software packages. +Programmers should be cautious about using these features, especially +if the FITS files that are produced are expected to be processed by +other software systems which do not use the CFITSIO interface. + + +\subsection{Support for Long String Keyword Values.} + +The length of a standard FITS string keyword is limited to 68 +characters because it must fit entirely within a single FITS header +keyword record. In some instances it is necessary to encode strings +longer than this limit, so FITSIO supports a local convention in which +the string value is continued over multiple keywords. This +continuation convention uses an ampersand character at the end of each +substring to indicate that it is continued on the next keyword, and the +continuation keywords all have the name CONTINUE without an equal sign +in column 9. The string value may be continued in this way over as many +additional CONTINUE keywords as is required. The following lines +illustrate this continuation convention which is used in the value of +the STRKEY keyword: + +\begin{verbatim} +LONGSTRN= 'OGIP 1.0' / The OGIP Long String Convention may be used. +STRKEY = 'This is a very long string keyword&' / Optional Comment +CONTINUE ' value that is continued over 3 keywords in the & ' +CONTINUE 'FITS header.' / This is another optional comment. +\end{verbatim} +It is recommended that the LONGSTRN keyword, as shown +here, always be included in any HDU that uses this longstring +convention. A subroutine called FTPLSW +has been provided in CFITSIO to write this keyword if it does not +already exist. + +This long string convention is supported by the following FITSIO +subroutines that deal with string-valued keywords: + +\begin{verbatim} + ftgkys - read a string keyword + ftpkls - write (append) a string keyword + ftikls - insert a string keyword + ftmkls - modify the value of an existing string keyword + ftukls - update an existing keyword, or write a new keyword + ftdkey - delete a keyword +\end{verbatim} +These routines will transparently read, write, or delete a long string +value in the FITS file, so programmers in general do not have to be +concerned about the details of the convention that is used to encode +the long string in the FITS header. When reading a long string, one +must ensure that the character string parameter used in these +subroutine calls has been declared long enough to hold the entire +string, otherwise the returned string value will be truncated. + +Note that the more commonly used FITSIO subroutine to write string +valued keywords (FTPKYS) does NOT support this long string convention +and only supports strings up to 68 characters in length. This has been +done deliberately to prevent programs from inadvertently writing +keywords using this non-standard convention without the explicit intent +of the programmer or user. The FTPKLS subroutine must be called +instead to write long strings. This routine can also be used to write +ordinary string values less than 68 characters in length. + + +\subsection{Arrays of Fixed-Length Strings in Binary Tables} + +The definition of the FITS binary table extension format does not +provide a simple way to specify that a character column contains an +array of fixed-length strings. To support this feature, FITSIO uses a +local convention for the format of the TFORMn keyword value of the form +'rAw' where 'r' is an integer specifying the total width in characters +of the column, and 'w' is an integer specifying the (fixed) length of +an individual unit string within the vector. For example, TFORM1 = +'120A10' would indicate that the binary table column is 120 characters +wide and consists of 12 10-character length strings. This convention +is recognized by the FITSIO subroutines that read or write strings in +binary tables. The Binary Table definition document specifies that +other optional characters may follow the datatype code in the TFORM +keyword, so this local convention is in compliance with the +FITS standard, although other FITS readers are not required to +recognize this convention. + +The Binary Table definition document that was approved by the IAU in +1994 contains an appendix describing an alternate convention for +specifying arrays of fixed or variable length strings in a binary table +character column (with the form 'rA:SSTRw/nnn)'. This appendix was not +officially voted on by the IAU and hence is still provisional. FITSIO +does not currently support this proposal. + + +\subsection{Keyword Units Strings} + +One deficiency of the current FITS Standard is that it does not define +a specific convention for recording the physical units of a keyword +value. The TUNITn keyword can be used to specify the physical units of +the values in a table column, but there is no analogous convention for +keyword values. The comment field of the keyword is often used for +this purpose, but the units are usually not specified in a well defined +format that FITS readers can easily recognize and extract. + +To solve this deficiency, FITSIO uses a local convention in which the +keyword units are enclosed in square brackets as the first token in the +keyword comment field; more specifically, the opening square bracket +immediately follows the slash '/' comment field delimiter and a single +space character. The following examples illustrate keywords that use +this convention: + + +\begin{verbatim} +EXPOSURE= 1800.0 / [s] elapsed exposure time +V_HELIO = 16.23 / [km s**(-1)] heliocentric velocity +LAMBDA = 5400. / [angstrom] central wavelength +FLUX = 4.9033487787637465E-30 / [J/cm**2/s] average flux +\end{verbatim} + +In general, the units named in the IAU(1988) Style Guide are +recommended, with the main exception that the preferred unit for angle +is 'deg' for degrees. + +The FTPUNT and FTGUNT subroutines in FITSIO write and read, +respectively, the keyword unit strings in an existing keyword. + + +\subsection{HIERARCH Convention for Extended Keyword Names} + +CFITSIO supports the HIERARCH keyword convention which allows keyword +names that are longer then 8 characters and may contain the full range +of printable ASCII text characters. This convention +was developed at the European Southern Observatory (ESO) to support +hierarchical FITS keyword such as: + +\begin{verbatim} +HIERARCH ESO INS FOCU POS = -0.00002500 / Focus position +\end{verbatim} +Basically, this convention uses the FITS keyword 'HIERARCH' to indicate +that this convention is being used, then the actual keyword name +({\tt'ESO INS FOCU POS'} in this example) begins in column 10 and can +contain any printable ASCII text characters, including spaces. The +equals sign marks the end of the keyword name and is followed by the +usual value and comment fields just as in standard FITS keywords. +Further details of this convention are described at +http://arcdev.hq.eso.org/dicb/dicd/dic-1-1.4.html (search for +HIERARCH). + +This convention allows a much broader range of keyword names +than is allowed by the FITS Standard. Here are more examples +of such keywords: + +\begin{verbatim} +HIERARCH LongKeyword = 47.5 / Keyword has > 8 characters, and mixed case +HIERARCH XTE$TEMP = 98.6 / Keyword contains the '$' character +HIERARCH Earth is a star = F / Keyword contains embedded spaces +\end{verbatim} +CFITSIO will transparently read and write these keywords, so application +programs do not in general need to know anything about the specific +implementation details of the HIERARCH convention. In particular, +application programs do not need to specify the `HIERARCH' part of the +keyword name when reading or writing keywords (although it +may be included if desired). When writing a keyword, CFITSIO first +checks to see if the keyword name is legal as a standard FITS keyword +(no more than 8 characters long and containing only letters, digits, or +a minus sign or underscore). If so it writes it as a standard FITS +keyword, otherwise it uses the hierarch convention to write the +keyword. The maximum keyword name length is 67 characters, which +leaves only 1 space for the value field. A more practical limit is +about 40 characters, which leaves enough room for most keyword values. +CFITSIO returns an error if there is not enough room for both the +keyword name and the keyword value on the 80-character card, except for +string-valued keywords which are simply truncated so that the closing +quote character falls in column 80. In the current implementation, +CFITSIO preserves the case of the letters when writing the keyword +name, but it is case-insensitive when reading or searching for a +keyword. The current implementation allows any ASCII text character +(ASCII 32 to ASCII 126) in the keyword name except for the '=' +character. A space is also required on either side of the equal sign. + + +\section{Optimizing Code for Maximum Processing Speed} + +CFITSIO has been carefully designed to obtain the highest possible +speed when reading and writing FITS files. In order to achieve the +best performance, however, application programmers must be careful to +call the CFITSIO routines appropriately and in an efficient sequence; +inappropriate usage of CFITSIO routines can greatly slow down the +execution speed of a program. + +The maximum possible I/O speed of CFITSIO depends of course on the type +of computer system that it is running on. As a rough guide, the +current generation of workstations can achieve speeds of 2 -- 10 MB/s +when reading or writing FITS images and similar, or slightly slower +speeds with FITS binary tables. Reading of FITS files can occur at +even higher rates (30MB/s or more) if the FITS file is still cached in +system memory following a previous read or write operation on the same +file. To more accurately predict the best performance that is possible +on any particular system, a diagnostic program called ``speed.c'' is +included with the CFITSIO distribution which can be run to +approximately measure the maximum possible speed of writing and reading +a test FITS file. + +The following 2 sections provide some background on how CFITSIO +internally manages the data I/O and describes some strategies that may +be used to optimize the processing speed of software that uses +CFITSIO. + + +\subsection{Background Information: How CFITSIO Manages Data I/O} + +Many CFITSIO operations involve transferring only a small number of +bytes to or from the FITS file (e.g, reading a keyword, or writing a +row in a table); it would be very inefficient to physically read or +write such small blocks of data directly in the FITS file on disk, +therefore CFITSIO maintains a set of internal Input--Output (IO) +buffers in RAM memory that each contain one FITS block (2880 bytes) of +data. Whenever CFITSIO needs to access data in the FITS file, it first +transfers the FITS block containing those bytes into one of the IO +buffers in memory. The next time CFITSIO needs to access bytes in the +same block it can then go to the fast IO buffer rather than using a +much slower system disk access routine. The number of available IO +buffers is determined by the NIOBUF parameter (in fitsio2.h) and is +currently set to 40. + +Whenever CFITSIO reads or writes data it first checks to see if that +block of the FITS file is already loaded into one of the IO buffers. +If not, and if there is an empty IO buffer available, then it will load +that block into the IO buffer (when reading a FITS file) or will +initialize a new block (when writing to a FITS file). If all the IO +buffers are already full, it must decide which one to reuse (generally +the one that has been accessed least recently), and flush the contents +back to disk if it has been modified before loading the new block. + +The one major exception to the above process occurs whenever a large +contiguous set of bytes are accessed, as might occur when reading or +writing a FITS image. In this case CFITSIO bypasses the internal IO +buffers and simply reads or writes the desired bytes directly in the +disk file with a single call to a low-level file read or write +routine. The minimum threshold for the number of bytes to read or +write this way is set by the MINDIRECT parameter and is currently set +to 3 FITS blocks = 8640 bytes. This is the most efficient way to read +or write large chunks of data and can achieve IO transfer rates of +5 -- 10MB/s or greater. Note that this fast direct IO process is not +applicable when accessing columns of data in a FITS table because the +bytes are generally not contiguous since they are interleaved by the +other columns of data in the table. This explains why the speed for +accessing FITS tables is generally slower than accessing +FITS images. + +Given this background information, the general strategy for efficiently +accessing FITS files should now be apparent: when dealing with FITS +images, read or write large chunks of data at a time so that the direct +IO mechanism will be invoked; when accessing FITS headers or FITS +tables, on the other hand, once a particular FITS block has been +loading into one of the IO buffers, try to access all the needed +information in that block before it gets flushed out of the IO buffer. +It is important to avoid the situation where the same FITS block is +being read then flushed from a IO buffer multiple times. + +The following section gives more specific suggestions for optimizing +the use of CFITSIO. + +1. When dealing with a FITS primary array or IMAGE extension, it is +more efficient to read or write large chunks of the image at a time +(at least 3 FITS blocks = 8640 bytes) so that the direct IO mechanism +will be used as described in the previous section. Smaller chunks of +data are read or written via the IO buffers, which is somewhat less +efficient because of the extra copy operation and additional +bookkeeping steps that are required. In principle it is more efficient +to read or write as big an array of image pixels at one time as +possible, however, if the array becomes so large that the operating +system cannot store it all in RAM, then the performance may be degraded +because of the increased swapping of virtual memory to disk. + +2. When dealing with FITS tables, the most important efficiency factor +in the software design is to read or write the data in the FITS file in +a single pass through the file. An example of poor program design +would be to read a large, 3-column table by sequentially reading the +entire first column, then going back to read the 2nd column, and +finally the 3rd column; this obviously requires 3 passes through the +file which could triple the execution time of an I/O limited program. +For small tables this is not important, but when reading multi-megabyte +sized tables these inefficiencies can become significant. The more +efficient procedure in this case is to read or write only as many rows +of the table as will fit into the available internal I/O buffers, then +access all the necessary columns of data within that range of rows. +Then after the program is completely finished with the data in those +rows it can move on to the next range of rows that will fit in the +buffers, continuing in this way until the entire file has been +processed. By using this procedure of accessing all the columns of a +table in parallel rather than sequentially, each block of the FITS file +will only be read or written once. + +The optimal number of rows to read or write at one time in a given +table depends on the width of the table row, on the number of I/O +buffers that have been allocated in FITSIO, and also on the number of +other FITS files that are open at the same time (since one I/O buffer +is always reserved for each open FITS file). Fortunately, a FITSIO +routine is available that will return the optimal number of rows for a +given table: call ftgrsz(unit, nrows, status). It is not critical to +use exactly the value of nrows returned by this routine, as long as one +does not exceed it. Using a very small value however can also lead to +poor performance because of the overhead from the larger number of +subroutine calls. + +The optimal number of rows returned by ftgrsz is valid only as long as +the application program is only reading or writing data in the +specified table. Any other calls to access data in the table header or +in any other FITS file would cause additional blocks of data to be +loaded into the I/O buffers displacing data from the original table, +and should be avoided during the critical period while the table is +being read or written. + +Occasionally it is necessary to simultaneously access more than one +FITS table, for example when transferring values from an input table to +an output table. In cases like this, one should call ftgrsz to get the +optimal number of rows for each table separately, than reduce the +number of rows proportionally. For example, if the optimal number of +rows in the input table is 3600 and is 1400 in the output table, then +these values should be cut in half to 1800 and 700, respectively, if +both tables are going to be accessed at the same time. + +3. Use binary table extensions rather than ASCII table +extensions for better efficiency when dealing with tabular data. The +I/O to ASCII tables is slower because of the overhead in formatting or +parsing the ASCII data fields, and because ASCII tables are about twice +as large as binary tables with the same information content. + +4. Design software so that it reads the FITS header keywords in the +same order in which they occur in the file. When reading keywords, +FITSIO searches forward starting from the position of the last keyword +that was read. If it reaches the end of the header without finding the +keyword, it then goes back to the start of the header and continues the +search down to the position where it started. In practice, as long as +the entire FITS header can fit at one time in the available internal I/O +buffers, then the header keyword access will be very fast and it makes +little difference which order they are accessed. + +5. Avoid the use of scaling (by using the BSCALE and BZERO or TSCAL and +TZERO keywords) in FITS files since the scaling operations add to the +processing time needed to read or write the data. In some cases it may +be more efficient to temporarily turn off the scaling (using ftpscl or +fttscl) and then read or write the raw unscaled values in the FITS +file. + +6. Avoid using the 'implicit datatype conversion' capability in +FITSIO. For instance, when reading a FITS image with BITPIX = -32 +(32-bit floating point pixels), read the data into a single precision +floating point data array in the program. Forcing FITSIO to convert +the data to a different datatype can significantly slow the program. + +7. Where feasible, design FITS binary tables using vector column +elements so that the data are written as a contiguous set of bytes, +rather than as single elements in multiple rows. For example, it is +faster to access the data in a table that contains a single row +and 2 columns with TFORM keywords equal to '10000E' and '10000J', than +it is to access the same amount of data in a table with 10000 rows +which has columns with the TFORM keywords equal to '1E' and '1J'. In +the former case the 10000 floating point values in the first column are +all written in a contiguous block of the file which can be read or +written quickly, whereas in the second case each floating point value +in the first column is interleaved with the integer value in the second +column of the same row so CFITSIO has to explicitly move to the +position of each element to be read or written. + +8. Avoid the use of variable length vector columns in binary tables, +since any reading or writing of these data requires that CFITSIO first +look up or compute the starting address of each row of data in the +heap. + +9. When copying data from one FITS table to another, it is faster to +transfer the raw bytes instead of reading then writing each column of +the table. The FITSIO subroutines FTGTBS and FTPTBS (for ASCII +tables), and FTGTBB and FTPTBB (for binary tables) will perform +low-level reads or writes of any contiguous range of bytes in a table +extension. These routines can be used to read or write a whole row (or +multiple rows) of a table with a single subroutine call. These +routines are fast because they bypass all the usual data scaling, error +checking and machine dependent data conversion that is normally done by +FITSIO, and they allow the program to write the data to the output file +in exactly the same byte order. For these same reasons, use of these +routines can be somewhat risky because no validation or machine +dependent conversion is performed by these routines. In general these +routines are only recommended for optimizing critical pieces of code +and should only be used by programmers who thoroughly understand the +internal byte structure of the FITS tables they are reading or +writing. + +10. Another strategy for improving the speed of writing a FITS table, +similar to the previous one, is to directly construct the entire byte +stream for a whole table row (or multiple rows) within the application +program and then write it to the FITS file with +ftptbb. This avoids all the overhead normally present +in the column-oriented CFITSIO write routines. This technique should +only be used for critical applications, because it makes the code more +difficult to understand and maintain, and it makes the code more system +dependent (e.g., do the bytes need to be swapped before writing to the +FITS file?). + +11. Finally, external factors such as the type of magnetic disk +controller (SCSI or IDE), the size of the disk cache, the average seek +speed of the disk, the amount of disk fragmentation, and the amount of +RAM available on the system can all have a significant impact on +overall I/O efficiency. For critical applications, a system +administrator should review the proposed system hardware to identify any +potential I/O bottlenecks. + + +\chapter{ The CFITSIO Iterator Function } + +The fits\_iterate\_data function in CFITSIO provides a unique method of +executing an arbitrary user-supplied `work' function that operates on +rows of data in FITS tables or on pixels in FITS images. Rather than +explicitly reading and writing the FITS images or columns of data, one +instead calls the CFITSIO iterator routine, passing to it the name of +the user's work function that is to be executed along with a list of +all the table columns or image arrays that are to be passed to the work +function. The CFITSIO iterator function then does all the work of +allocating memory for the arrays, reading the input data from the FITS +file, passing them to the work function, and then writing any output +data back to the FITS file after the work function exits. Because +it is often more efficient to process only a subset of the total table +rows at one time, the iterator function can determine the optimum +amount of data to pass in each iteration and repeatly call the work +function until the entire table been processed. + +For many applications this single CFITSIO iterator function can +effectively replace all the other CFITSIO routines for reading or +writing data in FITS images or tables. Using the iterator has several +important advantages over the traditional method of reading and writing +FITS data files: + +\begin{itemize} +\item +It cleanly separates the data I/O from the routine that operates on +the data. This leads to a more modular and `object oriented' +programming style. + +\item +It simplifies the application program by eliminating the need to allocate +memory for the data arrays and eliminates most of the calls to the CFITSIO +routines that explicitly read and write the data. + +\item +It ensures that the data are processed as efficiently as possible. +This is especially important when processing tabular data since +the iterator function will calculate the most efficient number +of rows in the table to be passed at one time to the user's work +function on each iteration. + +\item +Makes it possible for larger projects to develop a library of work +functions that all have a uniform calling sequence and are all +independent of the details of the FITS file format. + +\end{itemize} + +There are basically 2 steps in using the CFITSIO iterator function. +The first step is to design the work function itself which must have a +prescribed set of input parameters. One of these parameters is a +structure containing pointers to the arrays of data; the work function +can perform any desired operations on these arrays and does not need to +worry about how the input data were read from the file or how the +output data get written back to the file. + +The second step is to design the driver routine that opens all the +necessary FITS files and initializes the input parameters to the +iterator function. The driver program calls the CFITSIO iterator +function which then reads the data and passes it to the user's work +function. + +Further details on using the iterator function can be found in the +companion CFITSIO User's Guide, and in the iter\_a.f, iter\_b.f and +iter\_c.f example programs. + + + +\chapter{ Basic Interface Routines } + +This section defines a basic set of subroutines that can be +used to perform the most common types of read and write operations +on FITS files. New users should start with these subroutines and +then, as needed, explore the more advance routines described in +the following chapter to perform more complex or specialized operations. + +A right arrow symbol ($>$) is used to separate the input parameters from +the output parameters in the definition of each routine. This symbol +is not actually part of the calling sequence. Note that +the status parameter is both an input and an output parameter +and must be initialized = 0 prior to calling the FITSIO subroutines. + +Refer to Chapter 9 for the definition of all the parameters +used by these interface routines. + + +\section{FITSIO Error Status Routines \label{FTVERS}} + + +\begin{description} +\item[1 ] Return the current version number of the fitsio library. + The version number will be incremented with each new + release of CFITSIO. +\end{description} + +\begin{verbatim} + FTVERS( > version) +\end{verbatim} + +\begin{description} +\item[2 ] Return the descriptive text string corresponding to a FITSIO error + status code. The 30-character length string contains a brief + description of the cause of the error. +\end{description} + +\begin{verbatim} + FTGERR(status, > errtext) +\end{verbatim} + +\begin{description} +\item[3 ] Return the top (oldest) 80-character error message from the + internal FITSIO stack of error messages and shift any remaining + messages on the stack up one level. Any FITSIO error will + generate one or more messages on the stack. Call this routine + repeatedly to get each message in sequence. The error stack is empty + when a blank string is returned. +\end{description} + +\begin{verbatim} + FTGMSG( > errmsg) +\end{verbatim} + +\begin{description} +\item[4 ]The FTPMRK routine puts an invisible marker on the + CFITSIO error stack. The FTCMRK routine can then be + used to delete any more recent error messages on the stack, back to + the position of the marker. This preserves any older error messages + on the stack. FTCMSG simply clears the entire error message stack. + These routines are called without any arguments. +\end{description} + +\begin{verbatim} + FTPMRK + FTCMRK + FTCMSG +\end{verbatim} + + +\begin{description} +\item[5 ] Print out the error message corresponding to the input status + value and all the error messages on the FITSIO stack to the specified + file stream (stream can be either the string 'STDOUT' or 'STDERR'). + If the input status value = 0 then this routine does nothing. +\end{description} + +\begin{verbatim} + FTRPRT (stream, > status) +\end{verbatim} + +\begin{description} +\item[6 ] Write an 80-character message to the FITSIO error stack. Application + programs should not normally write to the stack, but there may be + some situations where this is desirable. +\end{description} + +\begin{verbatim} + FTPMSG(errmsg) +\end{verbatim} + + +\section{File I/O Routines} + + +\begin{description} +\item[1 ]Open an existing FITS file with readonly or readwrite access. + This routine always opens the primary array (the first HDU) of + the file, and does not move to a following extension, if one was + specified as part of the filename. Use the FTNOPN routine to + automatically move to the extension. This routine will also + open IRAF images (.imh format files) and raw binary data arrays + with READONLY access by first converting them on the fly into + virtual FITS images. See the `Extended File Name Syntax' chapter + for more details. The second routine simply opens the specified + file without trying to interpret the filename using the extended + filename syntax. +\end{description} + +\begin{verbatim} + FTOPEN(unit,filename,rwmode, > blocksize,status) + FTDKOPEN(unit,filename,rwmode, > blocksize,status) +\end{verbatim} + +\begin{description} +\item[2 ]Open an existing FITS file with readonly or readwrite access + and move to a following extension, if one was specified as + part of the filename. (e.g., 'filename.fits+2' or + 'filename.fits[2]' will move to the 3rd HDU in the file). + Note that this routine differs from FTOPEN in that it does not + have the redundant blocksize argument. +\end{description} + +\begin{verbatim} + FTNOPN(unit,filename,rwmode, > status) +\end{verbatim} + +\begin{description} +\item[3 ]Open an existing FITS file with readonly or readwrite access + and then move to the first HDU containing significant data, if a) an HDU + name or number to open was not explicitly specified as part of the + filename, and b) if the FITS file contains a null primary array (i.e., + NAXIS = 0). In this case, it will look for the first IMAGE HDU with + NAXIS > 0, or the first table that does not contain the strings `GTI' + (Good Time Interval) or `OBSTABLE' in the EXTNAME keyword value. FTTOPN + is similar, except it will move to the first significant table HDU + (skipping over any image HDUs) in the file if a specific HDU name + or number is not specified. FTIOPN will move to the first non-null + image HDU, skipping over any tables. +\end{description} + +\begin{verbatim} + FTDOPN(unit,filename,rwmode, > status) + FTTOPN(unit,filename,rwmode, > status) + FTIOPN(unit,filename,rwmode, > status) +\end{verbatim} + +\begin{description} +\item[4 ]Open and initialize a new empty FITS file. A template file may also be + specified to define the structure of the new file (see section 4.2.4). + The second routine simply creates the specified + file without trying to interpret the filename using the extended + filename syntax. +\end{description} + +\begin{verbatim} + FTINIT(unit,filename,blocksize, > status) + FTDKINIT(unit,filename,blocksize, > status) +\end{verbatim} + +\begin{description} +\item[5 ]Close a FITS file previously opened with ftopen or ftinit +\end{description} + +\begin{verbatim} + FTCLOS(unit, > status) +\end{verbatim} + +\begin{description} +\item[6 ] Move to a specified (absolute) HDU in the FITS file (nhdu = 1 for the + FITS primary array) +\end{description} + +\begin{verbatim} + FTMAHD(unit,nhdu, > hdutype,status) +\end{verbatim} + +\begin{description} +\item[7 ] Create a primary array (if none already exists), or insert a + new IMAGE extension immediately following the CHDU, or + insert a new Primary Array at the beginning of the file. Any + following extensions in the file will be shifted down to make room + for the new extension. If the CHDU is the last HDU in the file + then the new image extension will simply be appended to the end of + the file. One can force a new primary array to be inserted at the + beginning of the FITS file by setting status = -9 prior + to calling the routine. In this case the old primary array will be + converted to an IMAGE extension. The new extension (or primary + array) will become the CHDU. +\end{description} + +\begin{verbatim} + FTIIMG(unit,bitpix,naxis,naxes, > status) +\end{verbatim} + +\begin{description} +\item[8 ] Insert a new ASCII TABLE extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new table extension will simply be appended to the + end of the file. The new extension will become the CHDU. +\end{description} + +\begin{verbatim} + FTITAB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) +\end{verbatim} + +\begin{description} +\item[9 ] Insert a new binary table extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new bintable extension will simply be appended to the + end of the file. The new extension will become the CHDU. +\end{description} + +\begin{verbatim} + FTIBIN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) +\end{verbatim} + +\section{Keyword I/O Routines} + + +\begin{description} +\item[1 ]Put (append) an 80-character record into the CHU. +\end{description} + +\begin{verbatim} + FTPREC(unit,card, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Put (append) a new keyword of the appropriate datatype into the CHU. + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, + depending on the magnitude of the value. +\end{description} + +\begin{verbatim} + FTPKY[JLS](unit,keyword,keyval,comment, > status) + FTPKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +\end{verbatim} + +\begin{description} +\item[3 ]Get the nth 80-character header record from the CHU. The first keyword + in the header is at key\_no = 1; if key\_no = 0 then this subroutine + simple moves the internal pointer to the beginning of the header + so that subsequent keyword operations will start at the top of + the header; it also returns a blank card value in this case. +\end{description} + +\begin{verbatim} + FTGREC(unit,key_no, > card,status) +\end{verbatim} + +\begin{description} +\item[4 ] Get a keyword value (with the appropriate datatype) and comment from + the CHU +\end{description} + +\begin{verbatim} + FTGKY[EDJLS](unit,keyword, > keyval,comment,status) +\end{verbatim} + +\begin{description} +\item[5 ] Delete an existing keyword record. +\end{description} + +\begin{verbatim} + FTDKEY(unit,keyword, > status) +\end{verbatim} + + +\section{Data I/O Routines} + +The following routines read or write data values in the current HDU of +the FITS file. Automatic datatype conversion +will be attempted for numerical datatypes if the specified datatype is +different from the actual datatype of the FITS array or table column. + + +\begin{description} +\item[1 ]Write elements into the primary data array or image extension. +\end{description} + +\begin{verbatim} + FTPPR[BIJED](unit,group,fpixel,nelements,values, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Read elements from the primary data array or image extension. + Undefined array elements will be + returned with a value = nullval, unless nullval = 0 in which case no + checks for undefined pixels will be performed. The anyf parameter is + set to true (= .true.) if any of the returned + elements were undefined. +\end{description} + +\begin{verbatim} + FTGPV[BIJED](unit,group,fpixel,nelements,nullval, > values,anyf,status) +\end{verbatim} + +\begin{description} +\item[3 ] Write elements into an ASCII or binary table column. The `felem' + parameter applies only to vector columns in binary tables and is + ignored when writing to ASCII tables. +\end{description} + +\begin{verbatim} + FTPCL[SLBIJEDCM](unit,colnum,frow,felem,nelements,values, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Read elements from an ASCII or binary table column. Undefined + array elements will be returned with a value = nullval, unless nullval = 0 + (or = ' ' for ftgcvs) in which case no checking for undefined values will + be performed. The ANYF parameter is set to true if any of the returned + elements are undefined. + + Any column, regardless of it's intrinsic datatype, may be read as a + string. It should be noted however that reading a numeric column + as a string is 10 - 100 times slower than reading the same column + as a number due to the large overhead in constructing the formatted + strings. The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + datatype of the column. The length of the returned strings can be + determined with the ftgcdw routine. The following TDISPn display + formats are currently supported: + +\begin{verbatim} + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +\end{verbatim} + where w is the width in characters of the displayed values, m is the minimum + number of digits displayed, and d is the number of digits to the right of the + decimal. The .m field is optional. +\end{description} + + +\begin{verbatim} + FTGCV[SBIJEDCM](unit,colnum,frow,felem,nelements,nullval, > + values,anyf,status) +\end{verbatim} + +\begin{description} +\item[5 ] Get the table column number and full name of the column whose name + matches the input template string. See the `Advanced Interface Routines' + chapter for a full description of this routine. +\end{description} + +\begin{verbatim} + FTGCNN(unit,casesen,coltemplate, > colname,colnum,status) +\end{verbatim} + + +\chapter{ Advanced Interface Subroutines } + +This chapter defines all the available subroutines in the FITSIO user +interface. For completeness, the basic subroutines described in the +previous chapter are also repeated here. A right arrow symbol is used +here to separate the input parameters from the output parameters in the +definition of each subroutine. This symbol is not actually part of the +calling sequence. An alphabetical list and definition of all the +parameters is given at the end of this section. + + +\section{FITS File Open and Close Subroutines: \label{FTOPEN}} + + +\begin{description} +\item[1 ]Open an existing FITS file with readonly or readwrite access. FTDOPN +also moves to the first HDU containing significant data, if no specific +HDU is specified as part of the filename. FTTOPN and FTIOPN are similar +except that they will move to the first table HDU or image HDU, respectively, +if a HDU name or number is not specified as part of the filename. +\end{description} + +\begin{verbatim} + FTOPEN(unit,filename,rwmode, > blocksize,status) + FTDOPN(unit,filename,rwmode, > status) + FTTOPN(unit,filename,rwmode, > status) + FTIOPN(unit,filename,rwmode, > status) +\end{verbatim} + + +\begin{description} +\item[2 ]Open an existing FITS file with readonly or readwrite access + and move to a following extension, if one was specified as + part of the filename. (e.g., 'filename.fits+2' or + 'filename.fits[2]' will move to the 3rd HDU in the file). + Note that this routine differs from FTOPEN in that it does not + have the redundant blocksize argument. +\end{description} + +\begin{verbatim} + FTNOPN(unit,filename,rwmode, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Reopen a FITS file that was previously opened with + FTOPEN, FTNOPN, or FTINIT. The newunit number + may then be treated as a separate file, and one may + simultaneously read or write to 2 (or more) different extensions in + the same file. The FTOPEN and FTNOPN routines (above) automatically + detects cases where a previously opened file is being opened again, + and then internally call FTREOPEN, so programs should rarely + need to explicitly call this routine. +\end{description} + +\begin{verbatim} + FTREOPEN(unit, > newunit, status) +\end{verbatim} + +\begin{description} +\item[4 ]Open and initialize a new empty FITS file +\end{description} + +\begin{verbatim} + FTINIT(unit,filename,blocksize, > status) +\end{verbatim} + +\begin{description} +\item[5 ] Create a new FITS file, using a template file to define its + initial size and structure. The template may be another FITS HDU + or an ASCII template file. If the input template file name + is blank, then this routine behaves the same as FTINIT. + The currently supported format of the ASCII template file is described + under the fits\_parse\_template routine (in the general Utilities + section), but this may change slightly later releases of + CFITSIO. +\end{description} + +\begin{verbatim} + FTTPLT(unit, filename, tplfilename, > status) +\end{verbatim} + +\begin{description} +\item[6 ]Flush internal buffers of data to the output FITS file + previously opened with ftopen or ftinit. The routine usually + never needs to be called, but doing so will ensure that + if the program subsequently aborts, then the FITS file will + have at least been closed properly. +\end{description} + +\begin{verbatim} + FTFLUS(unit, > status) +\end{verbatim} + +\begin{description} +\item[7 ]Close a FITS file previously opened with ftopen or ftinit +\end{description} + +\begin{verbatim} + FTCLOS(unit, > status) +\end{verbatim} + +\begin{description} +\item[8 ] Close and DELETE a FITS file previously opened with ftopen or ftinit. + This routine may be useful in cases where a FITS file is created, but + an error occurs which prevents the complete file from being written. +\end{description} + +\begin{verbatim} + FTDELT(unit, > status) +\end{verbatim} + +\begin{description} +\item[9 ] Get the value of an unused I/O unit number which may then be used + as input to FTOPEN or FTINIT. This routine searches for the first + unused unit number in the range from with 99 down to 50. This + routine just keeps an internal list of the allocated unit numbers + and does not physically check that the Fortran unit is available (to be + compatible with the SPP version of FITSIO). Thus users must not + independently allocate any unit numbers in the range 50 - 99 + if this routine is also to be used in the same program. This + routine is provided for convenience only, and it is not required + that the unit numbers used by FITSIO be allocated by this routine. +\end{description} + +\begin{verbatim} + FTGIOU( > iounit, status) +\end{verbatim} + +\begin{description} +\item[10] Free (deallocate) an I/O unit number which was previously allocated + with FTGIOU. All previously allocated unit numbers may be + deallocated at once by calling FTFIOU with iounit = -1. +\end{description} + +\begin{verbatim} + FTFIOU(iounit, > status) +\end{verbatim} + +\begin{description} +\item[11] Return the Fortran unit number that corresponds to the C fitsfile +pointer value, or vice versa. These 2 C routines may be useful in +mixed language programs where both C and Fortran subroutines need +to access the same file. For example, if a FITS file is opened +with unit 12 by a Fortran subroutine, then a C routine within the +same program could get the fitfile pointer value to access the same file +by calling 'fptr = CUnit2FITS(12)'. These routines return a value +of zero if an error occurs. +\end{description} + +\begin{verbatim} + int CFITS2Unit(fitsfile *ptr); + fitsfile* CUnit2FITS(int unit); +\end{verbatim} + + +\begin{description} +\item[11] Parse the input filename and return the HDU number that would be +moved to if the file were opened with FTNOPN. The returned HDU +number begins with 1 for the primary array, so for example, if the +input filename = `myfile.fits[2]' then hdunum = 3 will be returned. +FITSIO does not open the file to check if the extension actually exists +if an extension number is specified. If an extension *name* is included +in the file name specification (e.g. `myfile.fits[EVENTS]' then this +routine will have to open the FITS file and look for the position of +the named extension, then close file again. This is not possible if +the file is being read from the stdin stream, and an error will be +returned in this case. If the filename does not specify an explicit +extension (e.g. 'myfile.fits') then hdunum = -99 will be returned, +which is functionally equivalent to hdunum = 1. This routine is mainly +used for backward compatibility in the ftools software package and is +not recommended for general use. It is generally better and more +efficient to first open the FITS file with FTNOPN, then use FTGHDN to +determine which HDU in the file has been opened, rather than calling + FTEXTN followed by a call to FTNOPN. +\end{description} + +\begin{verbatim} + FTEXTN(filename, > nhdu, status) +\end{verbatim} + +\begin{description} +\item[12] Return the name of the opened FITS file. +\end{description} + +\begin{verbatim} + FTFLNM(unit, > filename, status) +\end{verbatim} + +\begin{description} +\item[13] Return the I/O mode of the open FITS file (READONLY = 0, READWRITE = 1). +\end{description} + +\begin{verbatim} + FTFLMD(unit, > iomode, status) +\end{verbatim} + +\begin{description} +\item[14] Return the file type of the opened FITS file (e.g. 'file://', 'ftp://', + etc.). +\end{description} + +\begin{verbatim} + FTURLT(unit, > urltype, status) +\end{verbatim} + +\begin{description} +\item[15] Parse the input filename or URL into its component parts: the file +type (file://, ftp://, http://, etc), the base input file name, the +name of the output file that the input file is to be copied to prior +to opening, the HDU or extension specification, the filtering +specifier, the binning specifier, and the column specifier. Blank +strings will be returned for any components that are not present +in the input file name. +\end{description} + +\begin{verbatim} + FTIURL(filename, > filetype, infile, outfile, extspec, filter, + binspec, colspec, status) +\end{verbatim} + +\begin{description} +\item[16] Parse the input file name and return the root file name. The root +name includes the file type if specified, (e.g. 'ftp://' or 'http://') +and the full path name, to the extent that it is specified in the input +filename. It does not include the HDU name or number, or any filtering +specifications. +\end{description} + +\begin{verbatim} + FTRTNM(filename, > rootname, status) +\end{verbatim} + + +\begin{description} +\item[16] Test if the input file or a compressed version of the file (with +a .gz, .Z, .z, or .zip extension) exists on disk. The returned value of +the 'exists' parameter will have 1 of the 4 following values: + +\begin{verbatim} + 2: the file does not exist, but a compressed version does exist + 1: the disk file does exist + 0: neither the file nor a compressed version of the file exist + -1: the input file name is not a disk file (could be a ftp, http, + smem, or mem file, or a file piped in on the STDIN stream) +\end{verbatim} + +\end{description} + +\begin{verbatim} + FTEXIST(filename, > exists, status); +\end{verbatim} + +\section{HDU-Level Operations \label{FTMAHD}} + +When a FITS file is first opened or created, the internal buffers in +FITSIO automatically point to the first HDU in the file. The following +routines may be used to move to another HDU in the file. Note that +the HDU numbering convention used in FITSIO denotes the primary array +as the first HDU, the first extension in a FITS file is the second HDU, +and so on. + + +\begin{description} +\item[1 ] Move to a specified (absolute) HDU in the FITS file (nhdu = 1 for the + FITS primary array) +\end{description} + +\begin{verbatim} + FTMAHD(unit,nhdu, > hdutype,status) +\end{verbatim} + +\begin{description} +\item[2 ]Move to a new (existing) HDU forward or backwards relative to the CHDU +\end{description} + +\begin{verbatim} + FTMRHD(unit,nmove, > hdutype,status) +\end{verbatim} + +\begin{description} +\item[3 ] Move to the (first) HDU which has the specified extension type and + EXTNAME (or HDUNAME) and EXTVER keyword values. The hdutype parameter + may have + a value of IMAGE\_HDU, ASCII\_TBL, BINARY\_TBL, or ANY\_HDU where + ANY\_HDU means that only the extname and extver values will be + used to locate the correct extension. If the input value of + extver is 0 then the EXTVER keyword is ignored and the first HDU + with a matching EXTNAME (or HDUNAME) keyword will be found. If no + matching HDU is found in the file then the current HDU will remain + unchanged + and a status = BAD\_HDU\_NUM (301) will be returned. +\end{description} + +\begin{verbatim} + FTMNHD(unit, hdutype, extname, extver, > status) +\end{verbatim} + +\begin{description} +\item[4 ]Get the number of the current HDU in the FITS file (primary array = 1) +\end{description} + +\begin{verbatim} + FTGHDN(unit, > nhdu) +\end{verbatim} + +\begin{description} +\item[5 ] Return the type of the current HDU in the FITS file. The possible + values for hdutype are IMAGE\_HDU (0), ASCII\_TBL (1), or BINARY\_TBL (2). +\end{description} + +\begin{verbatim} + FTGHDT(unit, > hdutype, status) +\end{verbatim} + +\begin{description} +\item[6 ] Return the total number of HDUs in the FITS file. + The CHDU remains unchanged. +\end{description} + +\begin{verbatim} + FTTHDU(unit, > hdunum, status) +\end{verbatim} + +\begin{description} +\item[7 ]Create (append) a new empty HDU following the last extension that + has been previously accessed by the program. This will overwrite + any extensions in an existing FITS file if the program has not already + moved to that (or a later) extension using the FTMAHD or FTMRHD routines. + For example, if an existing FITS file contains a primary array and 5 + extensions and a program (1) opens the FITS file, (2) moves to + extension 4, (3) moves back to the primary array, and (4) then calls + FTCRHD, then the new extension will be written following the 4th + extension, overwriting the existing 5th extension. +\end{description} + +\begin{verbatim} + FTCRHD(unit, > status) +\end{verbatim} + +\begin{description} +\item[8 ] Insert a new IMAGE extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new image extension will simply be appended to the + end of the file. The new extension will become the CHDU. +\end{description} + +\begin{verbatim} + FTIIMG(unit,bitpix,naxis,naxes, > status) +\end{verbatim} + +\begin{description} +\item[9 ] Insert a new ASCII TABLE extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new table extension will simply be appended to the + end of the file. The new extension will become the CHDU. +\end{description} + +\begin{verbatim} + FTITAB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) +\end{verbatim} + +\begin{description} +\item[10] Insert a new binary table extension immediately following the CHDU. + Any following extensions will be shifted down to make room for + the new extension. If there are no other following extensions + then the new bintable extension will simply be appended to the + end of the file. The new extension will become the CHDU. +\end{description} + +\begin{verbatim} + FTIBIN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) +\end{verbatim} + +\begin{description} +\item[11] Resize an image by modifing the size, dimensions, and/or datatype of the + current primary array or image extension. If the new image, as specified + by the input arguments, is larger than the current existing image + in the FITS file then zero fill data will be inserted at the end + of the current image and any following extensions will be moved + further back in the file. Similarly, if the new image is + smaller than the current image then any following extensions + will be shifted up towards the beginning of the FITS file + and the image data will be truncated to the new size. + This routine rewrites the BITPIX, NAXIS, and NAXISn keywords + with the appropriate values for new image. +\end{description} + +\begin{verbatim} + FTRSIM(unit,bitpix,naxis,naxes,status) +\end{verbatim} + +\begin{description} +\item[12] Delete the CHDU in the FITS file. Any following HDUs will be shifted + forward in the file, to fill in the gap created by the deleted + HDU. In the case of deleting the primary array (the first HDU in + the file) then the current primary array will be replace by a null + primary array containing the minimum set of required keywords and + no data. If there are more extensions in the file following the + one that is deleted, then the the CHDU will be redefined to point + to the following extension. If there are no following extensions + then the CHDU will be redefined to point to the previous HDU. The + output HDUTYPE parameter indicates the type of the new CHDU after + the previous CHDU has been deleted. +\end{description} + +\begin{verbatim} + FTDHDU(unit, > hdutype,status) +\end{verbatim} + +\begin{description} +\item[13] Copy all or part of the input FITS file and append it + to the end of the output FITS file. If 'previous' is + true (not 0), then any HDUs preceding the current HDU in the input file + will be copied to the output file. Similarly, 'current' and 'following' + determine whether the current HDU, and/or any following HDUs in the + input file will be copied to the output file. If all 3 parameters are + true, then the entire input file will be copied. On return, the current + HDU in the input file will be unchanged, and the last copied HDU will be the + current HDU in the output file. +\end{description} + +\begin{verbatim} + FTCPFL(iunit, ounit, previous, current, following, > status) +\end{verbatim} + +\begin{description} +\item[14] Copy the entire CHDU from the FITS file associated with IUNIT to the CHDU + of the FITS file associated with OUNIT. The output HDU must be empty and + not already contain any keywords. Space will be reserved for MOREKEYS + additional keywords in the output header if there is not already enough + space. +\end{description} + +\begin{verbatim} + FTCOPY(iunit,ounit,morekeys, > status) +\end{verbatim} + +\begin{description} +\item[15] Copy the header (and not the data) from the CHDU associated with inunit + to the CHDU associated with outunit. If the current output HDU + is not completely empty, then the CHDU will be closed and a new + HDU will be appended to the output file. This routine will automatically + transform the necessary keywords when copying a primary array to + and image extension, or an image extension to a primary array. + An empty output data unit will be created (all values = 0). +\end{description} + +\begin{verbatim} + FTCPHD(inunit, outunit, > status) +\end{verbatim} + +\begin{description} +\item[16] Copy just the data from the CHDU associated with IUNIT + to the CHDU associated with OUNIT. This will overwrite + any data previously in the OUNIT CHDU. This low level routine is used + by FTCOPY, but it may also be useful in certain application programs + which want to copy the data from one FITS file to another but also + want to modify the header keywords in the process. all the required + header keywords must be written to the OUNIT CHDU before calling + this routine +\end{description} + +\begin{verbatim} + FTCPDT(iunit,ounit, > status) +\end{verbatim} + + +\section{Define or Redefine the structure of the CHDU \label{FTRDEF}} + +It should rarely be necessary to call the subroutines in this section. +FITSIO internally calls these routines whenever necessary, so any calls +to these routines by application programs will likely be redundant. + + +\begin{description} +\item[1 ] This routine forces FITSIO to scan the current header keywords that + define the structure of the HDU (such as the NAXISn, PCOUNT and GCOUNT + keywords) so that it can initialize the internal buffers that describe + the HDU structure. This routine may be used instead of the more + complicated calls to ftpdef, ftadef or ftbdef. This routine is + also very useful for reinitializing the structure of an HDU, + if the number of rows in a table, as specified by the NAXIS2 keyword, + has been modified from its initial value. +\end{description} + +\begin{verbatim} + FTRDEF(unit, > status) (DEPRECATED) +\end{verbatim} + +\begin{description} +\item[2 ]Define the structure of the primary array or IMAGE extension. When + writing GROUPed FITS files that by convention set the NAXIS1 keyword + equal to 0, ftpdef must be called with naxes(1) = 1, NOT 0, otherwise + FITSIO will report an error status=308 when trying to write data + to a group. Note: it is usually simpler to call FTRDEF rather + than this routine. +\end{description} + +\begin{verbatim} + FTPDEF(unit,bitpix,naxis,naxes,pcount,gcount, > status) (DEPRECATED) +\end{verbatim} + +\begin{description} +\item[3 ] Define the structure of an ASCII table (TABLE) extension. Note: it + is usually simpler to call FTRDEF rather than this routine. +\end{description} + +\begin{verbatim} + FTADEF(unit,rowlen,tfields,tbcol,tform,nrows > status) (DEPRECATED) +\end{verbatim} + +\begin{description} +\item[4 ] Define the structure of a binary table (BINTABLE) extension. Note: it + is usually simpler to call FTRDEF rather than this routine. +\end{description} + +\begin{verbatim} + FTBDEF(unit,tfields,tform,varidat,nrows > status) (DEPRECATED) +\end{verbatim} + +\begin{description} +\item[5 ] Define the size of the Current Data Unit, overriding the length + of the data unit as previously defined by ftpdef, ftadef, or ftbdef. + This is useful if one does not know the total size of the data unit until + after the data have been written. The size (in bytes) of an ASCII or + Binary table is given by NAXIS1 * NAXIS2. (Note that to determine the + value of NAXIS1 it is often more convenient to read the value of the + NAXIS1 keyword from the output file, rather than computing the row + length directly from all the TFORM keyword values). Note: it + is usually simpler to call FTRDEF rather than this routine. +\end{description} + +\begin{verbatim} + FTDDEF(unit,bytlen, > status) (DEPRECATED) +\end{verbatim} + +\begin{description} +\item[6 ] Define the zero indexed byte offset of the 'heap' measured from + the start of the binary table data. By default the heap is assumed + to start immediately following the regular table data, i.e., at + location NAXIS1 x NAXIS2. This routine is only relevant for + binary tables which contain variable length array columns (with + TFORMn = 'Pt'). This subroutine also automatically writes + the value of theap to a keyword in the extension header. This + subroutine must be called after the required keywords have been + written (with ftphbn) and after the table structure has been defined + (with ftbdef) but before any data is written to the table. +\end{description} + +\begin{verbatim} + FTPTHP(unit,theap, > status) +\end{verbatim} + + +\section{FITS Header I/O Subroutines} + + +\subsection{Header Space and Position Routines \label{FTHDEF}} + + +\begin{description} +\item[1 ] Reserve space in the CHU for MOREKEYS more header keywords. + This subroutine may be called to reserve space for keywords which are + to be written at a later time, after the data unit or subsequent + extensions have been written to the FITS file. If this subroutine is + not explicitly called, then the initial size of the FITS header will be + limited to the space available at the time that the first data is written + to the associated data unit. FITSIO has the ability to dynamically + add more space to the header if needed, however it is more efficient + to preallocate the required space if the size is known in advance. +\end{description} + +\begin{verbatim} + FTHDEF(unit,morekeys, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Return the number of existing keywords in the CHU (NOT including the + END keyword which is not considered a real keyword) and the remaining + space available to write additional keywords in the CHU. (returns + KEYSADD = -1 if the header has not yet been closed). + Note that FITSIO will attempt to dynamically add space for more + keywords if required when appending new keywords to a header. +\end{description} + +\begin{verbatim} + FTGHSP(iunit, > keysexist,keysadd,status) +\end{verbatim} + +\begin{description} +\item[3 ] Return the number of keywords in the header and the current position + in the header. This returns the number of the keyword record that + will be read next (or one greater than the position of the last keyword + that was read or written). A value of 1 is returned if the pointer is + positioned at the beginning of the header. +\end{description} + +\begin{verbatim} + FTGHPS(iunit, > keysexist,key_no,status) +\end{verbatim} + +\subsection{Read or Write Standard Header Routines \label{FTPHPR}} + +These subroutines provide a simple method of reading or writing most of +the keyword values that are normally required in a FITS files. These +subroutines are provided for convenience only and are not required to +be used. If preferred, users may call the lower-level subroutines +described in the previous section to individually read or write the +required keywords. Note that in most cases, the required keywords such +as NAXIS, TFIELD, TTYPEn, etc, which define the structure of the HDU +must be written to the header before any data can be written to the +image or table. + + +\begin{description} +\item[1 ] Put the primary header or IMAGE extension keywords into the CHU. +There are 2 available routines: The simpler FTPHPS routine is +equivalent to calling ftphpr with the default values of SIMPLE = true, +pcount = 0, gcount = 1, and EXTEND = true. PCOUNT, GCOUNT and EXTEND +keywords are not required in the primary header and are only written if +pcount is not equal to zero, gcount is not equal to zero or one, and if +extend is TRUE, respectively. When writing to an IMAGE extension, the +SIMPLE and EXTEND parameters are ignored. +\end{description} + +\begin{verbatim} + FTPHPS(unit,bitpix,naxis,naxes, > status) + + FTPHPR(unit,simple,bitpix,naxis,naxes,pcount,gcount,extend, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Get primary header or IMAGE extension keywords from the CHU. When + reading from an IMAGE extension the SIMPLE and EXTEND parameters are + ignored. +\end{description} + +\begin{verbatim} + FTGHPR(unit,maxdim, > simple,bitpix,naxis,naxes,pcount,gcount,extend, + status) +\end{verbatim} + +\begin{description} +\item[3 ] Put the ASCII table header keywords into the CHU. The optional +TUNITn and EXTNAME keywords are written only if the input string +values are not blank. +\end{description} + +\begin{verbatim} + FTPHTB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) +\end{verbatim} + +\begin{description} +\item[4 ] Get the ASCII table header keywords from the CHU +\end{description} + +\begin{verbatim} + FTGHTB(unit,maxdim, > rowlen,nrows,tfields,ttype,tbcol,tform,tunit, + extname,status) +\end{verbatim} + +\begin{description} +\item[5 ]Put the binary table header keywords into the CHU. The optional + TUNITn and EXTNAME keywords are written only if the input string + values are not blank. The pcount parameter, which specifies the + size of the variable length array heap, should initially = 0; + FITSIO will automatically update the PCOUNT keyword value if any + variable length array data is written to the heap. The TFORM keyword + value for variable length vector columns should have the form 'Pt(len)' + or '1Pt(len)' where `t' is the data type code letter (A,I,J,E,D, etc.) + and `len' is an integer specifying the maximum length of the vectors + in that column (len must be greater than or equal to the longest + vector in the column). If `len' is not specified when the table is + created (e.g., the input TFORMn value is just '1Pt') then FITSIO will + scan the column when the table is first closed and will append the + maximum length to the TFORM keyword value. Note that if the table + is subsequently modified to increase the maximum length of the vectors + then the modifying program is responsible for also updating the TFORM + keyword value. +\end{description} + + +\begin{verbatim} + FTPHBN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat, > status) +\end{verbatim} + +\begin{description} +\item[6 ]Get the binary table header keywords from the CHU +\end{description} + +\begin{verbatim} + FTGHBN(unit,maxdim, > nrows,tfields,ttype,tform,tunit,extname,varidat, + status) +\end{verbatim} + +\subsection{Write Keyword Subroutines \label{FTPREC}} + + +\begin{description} +\item[1 ]Put (append) an 80-character record into the CHU. +\end{description} + +\begin{verbatim} + FTPREC(unit,card, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Put (append) a COMMENT keyword into the CHU. Multiple COMMENT keywords + will be written if the input comment string is longer than 72 characters. +\end{description} + +\begin{verbatim} + FTPCOM(unit,comment, > status) +\end{verbatim} + +\begin{description} +\item[3 ]Put (append) a HISTORY keyword into the CHU. Multiple HISTORY keywords + will be written if the input history string is longer than 72 characters. +\end{description} + +\begin{verbatim} + FTPHIS(unit,history, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Put (append) the DATE keyword into the CHU. The keyword value will contain + the current system date as a character string in 'dd/mm/yy' format. If + a DATE keyword already exists in the header, then this subroutine will + simply update the keyword value in-place with the current date. +\end{description} + +\begin{verbatim} + FTPDAT(unit, > status) +\end{verbatim} + +\begin{description} +\item[5 ] Put (append) a new keyword of the appropriate datatype into the CHU. + Note that FTPKYS will only write string values up to 68 characters in + length; longer strings will be truncated. The FTPKLS routine can be + used to write longer strings, using a non-standard FITS convention. + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, + depending on the magnitude of the value. +\end{description} + +\begin{verbatim} + FTPKY[JLS](unit,keyword,keyval,comment, > status) + FTPKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +\end{verbatim} + +\begin{description} +\item[6 ] Put (append) a string valued keyword into the CHU which may be longer + than 68 characters in length. This uses the Long String Keyword + convention that is described in the "Usage Guidelines and Suggestions" + section of this document. Since this uses a non-standard FITS + convention to encode the long keyword string, programs which use + this routine should also call the FTPLSW routine to add some COMMENT + keywords to warn users of the FITS file that this convention is + being used. FTPLSW also writes a keyword called LONGSTRN to record + the version of the longstring convention that has been used, in case + a new convention is adopted at some point in the future. If the + LONGSTRN keyword is already present in the header, then FTPLSW will + simply return and will not write duplicate keywords. +\end{description} + +\begin{verbatim} + FTPKLS(unit,keyword,keyval,comment, > status) + FTPLSW(unit, > status) +\end{verbatim} + +\begin{description} +\item[7 ] Put (append) a new keyword with an undefined, or null, value into the CHU. + The value string of the keyword is left blank in this case. +\end{description} + +\begin{verbatim} + FTPKYU(unit,keyword,comment, > status) +\end{verbatim} + +\begin{description} +\item[8 ] Put (append) a numbered sequence of keywords into the CHU. One may + append the same comment to every keyword (and eliminate the need + to have an array of identical comment strings, one for each keyword) by + including the ampersand character as the last non-blank character in the + (first) COMMENTS string parameter. This same string + will then be used for the comment field in all the keywords. (Note + that the SPP version of these routines only supports a single comment + string). +\end{description} + +\begin{verbatim} + FTPKN[JLS](unit,keyroot,startno,no_keys,keyvals,comments, > status) + FTPKN[EDFG](unit,keyroot,startno,no_keys,keyvals,decimals,comments, > + status) +\end{verbatim} + +\begin{description} +\item[9 ]Copy an indexed keyword from one HDU to another, modifying + the index number of the keyword name in the process. For example, + this routine could read the TLMIN3 keyword from the input HDU + (by giving keyroot = "TLMIN" and innum = 3) and write it to the + output HDU with the keyword name TLMIN4 (by setting outnum = 4). + If the input keyword does not exist, then this routine simply + returns without indicating an error. +\end{description} + +\begin{verbatim} + FTCPKYinunit, outunit, innum, outnum, keyroot, > status) +\end{verbatim} + +\begin{description} +\item[10] Put (append) a 'triple precision' keyword into the CHU in F28.16 format. + The floating point keyword value is constructed by concatenating the + input integer value with the input double precision fraction value + (which must have a value between 0.0 and 1.0). The FTGKYT routine should + be used to read this keyword value, because the other keyword reading + subroutines will not preserve the full precision of the value. +\end{description} + +\begin{verbatim} + FTPKYT(unit,keyword,intval,dblval,comment, > status) +\end{verbatim} + +\begin{description} +\item[11] Write keywords to the CHDU that are defined in an ASCII template file. + The format of the template file is described under the ftgthd + routine below. +\end{description} + +\begin{verbatim} + FTPKTP(unit, filename, > status) +\end{verbatim} + +\begin{description} +\item[12] Append the physical units string to an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are enclosed in square brackets in the + beginning of the keyword comment field. +\end{description} + + +\begin{verbatim} + VELOCITY= 12.3 / [km/s] orbital speed + + FTPUNT(unit,keyword,units, > status) +\end{verbatim} + +\subsection{Insert Keyword Subroutines \label{FTIREC}} + + +\begin{description} +\item[1 ] Insert a new keyword record into the CHU at the specified position + (i.e., immediately preceding the (keyno)th keyword in the header.) + This 'insert record' subroutine is somewhat less efficient + then the 'append record' subroutine (FTPREC) described above because + the remaining keywords in the header have to be shifted down one slot. +\end{description} + +\begin{verbatim} + FTIREC(unit,key_no,card, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Insert a new keyword into the CHU. The new keyword is inserted + immediately following the last keyword that has been read from the header. + The FTIKLS subroutine works the same as the FTIKYS subroutine, except + it also supports long string values greater than 68 characters in length. + These 'insert keyword' subroutines are somewhat less efficient then + the 'append keyword' subroutines described above because the remaining + keywords in the header have to be shifted down one slot. +\end{description} + +\begin{verbatim} + FTIKEY(unit, card, > status) + FTIKY[JLS](unit,keyword,keyval,comment, > status) + FTIKLS(unit,keyword,keyval,comment, > status) + FTIKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Insert a new keyword with an undefined, or null, value into the CHU. + The value string of the keyword is left blank in this case. +\end{description} + +\begin{verbatim} + FTIKYU(unit,keyword,comment, > status) +\end{verbatim} + +\subsection{Read Keyword Subroutines \label{FTGREC}} + +These routines return the value of the specified keyword(s). Wild card +characters (*, ?, or \#) may be used when specifying the name of the keyword +to be read: a '?' will match any single character at that position in the +keyword name and a '*' will match any length (including zero) string of +characters. The '\#' character will match any consecutive string of +decimal digits (0 - 9). Note that when a wild card is used in the input +keyword name, the routine will only search for a match from the current +header position to the end of the header. It will not resume the search +from the top of the header back to the original header position as is done +when no wildcards are included in the keyword name. If the desired +keyword string is 8-characters long (the maximum length of a keyword +name) then a '*' may be appended as the ninth character of the input +name to force the keyword search to stop at the end of the header +(e.g., 'COMMENT *' will search for the next COMMENT keyword). The +ffgrec routine may be used to set the starting position when doing +wild card searches. + + +\begin{description} +\item[1 ]Get the nth 80-character header record from the CHU. The first keyword + in the header is at key\_no = 1; if key\_no = 0 then this subroutine + simple moves the internal pointer to the beginning of the header + so that subsequent keyword operations will start at the top of + the header; it also returns a blank card value in this case. +\end{description} + +\begin{verbatim} + FTGREC(unit,key_no, > card,status) +\end{verbatim} + +\begin{description} +\item[2 ] Get the name, value (as a string), and comment of the nth keyword in CHU. + This routine also checks that the returned keyword name (KEYWORD) contains + only legal ASCII characters. Call FTGREC and FTPSVC to bypass this error + check. +\end{description} + +\begin{verbatim} + FTGKYN(unit,key_no, > keyword,value,comment,status) +\end{verbatim} + +\begin{description} +\item[3 ] Get the 80-character header record for the named keyword +\end{description} + +\begin{verbatim} + FTGCRD(unit,keyword, > card,status) +\end{verbatim} + +\begin{description} +\item[4 ] Get the next keyword whose name matches one of the strings in + 'inclist' but does not match any of the strings in 'exclist'. + The strings in inclist and exclist may contain wild card characters + (*, ?, and \#) as described at the beginning of this section. + This routine searches from the current header position to the + end of the header, only, and does not continue the search from + the top of the header back to the original position. The current + header position may be reset with the ftgrec routine. Note + that nexc may be set = 0 if there are no keywords to be excluded. + This routine returns status = 202 if a matching + keyword is not found. +\end{description} + +\begin{verbatim} + FTGNXK(unit,inclist,ninc,exclist,nexc, > card,status) +\end{verbatim} + +\begin{description} +\item[5 ] Get the literal keyword value as a character string. Regardless + of the datatype of the keyword, this routine simply returns the + string of characters in the value field of the keyword along with + the comment field. +\end{description} + +\begin{verbatim} + FTGKEY(unit,keyword, > value,comment,status) +\end{verbatim} + +\begin{description} +\item[6 ] Get a keyword value (with the appropriate datatype) and comment from + the CHU +\end{description} + +\begin{verbatim} + FTGKY[EDJLS](unit,keyword, > keyval,comment,status) +\end{verbatim} + +\begin{description} +\item[7 ] Get a sequence of numbered keyword values. These + routines do not support wild card characters in the root name. +\end{description} + +\begin{verbatim} + FTGKN[EDJLS](unit,keyroot,startno,max_keys, > keyvals,nfound,status) +\end{verbatim} + +\begin{description} +\item[8 ] Get the value of a floating point keyword, returning the integer and + fractional parts of the value in separate subroutine arguments. + This subroutine may be used to read any keyword but is especially + useful for reading the 'triple precision' keywords written by FTPKYT. +\end{description} + +\begin{verbatim} + FTGKYT(unit,keyword, > intval,dblval,comment,status) +\end{verbatim} + +\begin{description} +\item[9 ] Get the physical units string in an existing keyword. This + routine uses a local convention, shown in the following example, + in which the keyword units are + enclosed in square brackets in the beginning of the keyword comment + field. A blank string is returned if no units are defined + for the keyword. +\end{description} + +\begin{verbatim} + VELOCITY= 12.3 / [km/s] orbital speed + + FTGUNT(unit,keyword, > units,status) +\end{verbatim} + +\subsection{Modify Keyword Subroutines \label{FTMREC}} + +Wild card characters, as described in the Read Keyword section, above, +may be used when specifying the name of the keyword to be modified. + + +\begin{description} +\item[1 ] Modify (overwrite) the nth 80-character header record in the CHU +\end{description} + +\begin{verbatim} + FTMREC(unit,key_no,card, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Modify (overwrite) the 80-character header record for the named keyword + in the CHU. This can be used to overwrite the name of the keyword as + well as its value and comment fields. +\end{description} + +\begin{verbatim} + FTMCRD(unit,keyword,card, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Modify (overwrite) the name of an existing keyword in the CHU + preserving the current value and comment fields. +\end{description} + +\begin{verbatim} + FTMNAM(unit,oldkey,keyword, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Modify (overwrite) the comment field of an existing keyword in the CHU +\end{description} + +\begin{verbatim} + FTMCOM(unit,keyword,comment, > status) +\end{verbatim} + +\begin{description} +\item[5 ] Modify the value and comment fields of an existing keyword in the CHU. + The FTMKLS subroutine works the same as the FTMKYS subroutine, except + it also supports long string values greater than 68 characters in length. + Optionally, one may modify only the value field and leave the comment + field unchanged by setting the input COMMENT parameter equal to + the ampersand character (\&). + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, + depending on the magnitude of the value. +\end{description} + +\begin{verbatim} + FTMKY[JLS](unit,keyword,keyval,comment, > status) + FTMKLS(unit,keyword,keyval,comment, > status) + FTMKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +\end{verbatim} + +\begin{description} +\item[6 ] Modify the value of an existing keyword to be undefined, or null. + The value string of the keyword is set to blank. + Optionally, one may leave the comment field unchanged by setting the + input COMMENT parameter equal to the ampersand character (\&). +\end{description} + +\begin{verbatim} + FTMKYU(unit,keyword,comment, > status) +\end{verbatim} + +\subsection{Update Keyword Subroutines \label{FTUCRD}} + + +\begin{description} +\item[1 ] Update an 80-character record in the CHU. If the specified keyword + already exists then that header record will be replaced with + the input CARD string. If it does not exist then the new record will + be added to the header. + The FTUKLS subroutine works the same as the FTUKYS subroutine, except + it also supports long string values greater than 68 characters in length. +\end{description} + +\begin{verbatim} + FTUCRD(unit,keyword,card, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Update the value and comment fields of a keyword in the CHU. + The specified keyword is modified if it already exists (by calling + FTMKYx) otherwise a new keyword is created by calling FTPKYx. + The E and D versions of this routine have the added feature that + if the 'decimals' parameter is negative, then the 'G' display + format rather then the 'E' format will be used when constructing + the keyword value, taking the absolute value of 'decimals' for the + precision. This will suppress trailing zeros, and will use a + fixed format rather than an exponential format, + depending on the magnitude of the value. +\end{description} + +\begin{verbatim} + FTUKY[JLS](unit,keyword,keyval,comment, > status) + FTUKLS(unit,keyword,keyval,comment, > status) + FTUKY[EDFG](unit,keyword,keyval,decimals,comment, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Update the value of an existing keyword to be undefined, or null, + or insert a new undefined-value keyword if it doesn't already exist. + The value string of the keyword is left blank in this case. +\end{description} + +\begin{verbatim} + FTUKYU(unit,keyword,comment, > status) +\end{verbatim} + +\subsection{Delete Keyword Subroutines \label{FTDREC}} + + +\begin{description} +\item[1 ] Delete an existing keyword record. The space previously occupied by + the keyword is reclaimed by moving all the following header records up + one row in the header. The first routine deletes a keyword at a + specified position in the header (the first keyword is at position 1), + whereas the second routine deletes a specifically named keyword. + Wild card characters, as described in the Read Keyword section, above, + may be used when specifying the name of the keyword to be deleted + (be careful!). +\end{description} + +\begin{verbatim} + FTDREC(unit,key_no, > status) + FTDKEY(unit,keyword, > status) +\end{verbatim} + + +\section{Data Scaling and Undefined Pixel Parameters \label{FTPSCL}} + +These subroutines define or modify the internal parameters used by +FITSIO to either scale the data or to represent undefined pixels. +Generally FITSIO will scale the data according to the values of the BSCALE +and BZERO (or TSCALn and TZEROn) keywords, however these subroutines +may be used to override the keyword values. This may be useful when +one wants to read or write the raw unscaled values in the FITS file. +Similarly, FITSIO generally uses the value of the BLANK or TNULLn +keyword to signify an undefined pixel, but these routines may be used +to override this value. These subroutines do not create or modify the +corresponding header keyword values. + + +\begin{description} +\item[1 ] Reset the scaling factors in the primary array or image extension; does + not change the BSCALE and BZERO keyword values and only affects the + automatic scaling performed when the data elements are written/read + to/from the FITS file. When reading from a FITS file the returned + data value = (the value given in the FITS array) * BSCALE + BZERO. + The inverse formula is used when writing data values to the FITS + file. (NOTE: BSCALE and BZERO must be declared as Double Precision + variables). +\end{description} + +\begin{verbatim} + FTPSCL(unit,bscale,bzero, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Reset the scaling parameters for a table column; does not change + the TSCALn or TZEROn keyword values and only affects the automatic + scaling performed when the data elements are written/read to/from + the FITS file. When reading from a FITS file the returned data + value = (the value given in the FITS array) * TSCAL + TZERO. The + inverse formula is used when writing data values to the FITS file. + (NOTE: TSCAL and TZERO must be declared as Double Precision + variables). +\end{description} + +\begin{verbatim} + FTTSCL(unit,colnum,tscal,tzero, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Define the integer value to be used to signify undefined pixels in the + primary array or image extension. This is only used if BITPIX = 8, 16, + or 32. This does not create or change the value of the BLANK keyword in + the header. +\end{description} + +\begin{verbatim} + FTPNUL(unit,blank, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Define the string to be used to signify undefined pixels in + a column in an ASCII table. This does not create or change the value + of the TNULLn keyword. +\end{description} + +\begin{verbatim} + FTSNUL(unit,colnum,snull > status) +\end{verbatim} + +\begin{description} +\item[5 ] Define the value to be used to signify undefined pixels in + an integer column in a binary table (where TFORMn = 'B', 'I', or 'J'). + This does not create or change the value of the TNULLn keyword. +\end{description} + +\begin{verbatim} + FTTNUL(unit,colnum,tnull > status) +\end{verbatim} + + +\section{FITS Primary Array or IMAGE Extension I/O Subroutines \label{FTPPR}} + + These subroutines put or get data values in the primary data array +(i.e., the first HDU in the FITS file) or an IMAGE extension. The +data array is represented as a single one-dimensional array of +pixels regardless of the actual dimensionality of the array, and the +FPIXEL parameter gives the position within this 1-D array of the first +pixel to read or write. Automatic data type conversion is performed +for numeric data (except for complex data types) if the data type of +the primary array (defined by the BITPIX keyword) differs from the data +type of the array in the calling subroutine. The data values are also +scaled by the BSCALE and BZERO header values as they are being written +or read from the FITS array. The ftpscl subroutine MUST be +called to define the scaling parameters when writing data to the FITS +array or to override the default scaling value given in the header when +reading the FITS array. + + Two sets of subroutines are provided to read the data array which +differ in the way undefined pixels are handled. The first set of +routines (FTGPVx) simply return an array of data elements in which +undefined pixels are set equal to a value specified by the user in the +'nullval' parameter. An additional feature of these subroutines is +that if the user sets nullval = 0, then no checks for undefined pixels +will be performed, thus increasing the speed of the program. The +second set of routines (FTGPFx) returns the data element array and, in +addition, a logical array which defines whether the corresponding data +pixel is undefined. The latter set of subroutines may be more +convenient to use in some circumstances, however, it requires an +additional array of logical values which can be unwieldy when working +with large data arrays. Also for programmer convenience, sets of +subroutines to directly read or write 2 and 3 dimensional arrays have +been provided, as well as a set of subroutines to read or write any +contiguous rectangular subset of pixels within the n-dimensional array. + + +\begin{description} +\item[1 ] Get the data type of the image (= BITPIX value). Possible returned + values are: 8, 16, 32, -32, or -64 corresponding to unsigned byte, + signed 2-byte integer, signed 4-byte integer, real, and double. + + The second subroutine is similar to FTGIDT, except that if the image + pixel values are scaled, with non-default values for the BZERO and + BSCALE keywords, then this routine will return the 'equivalent' + data type that is needed to store the scaled values. For example, + if BITPIX = 16 and BSCALE = 0.1 then the equivalent data type is + floating point, and -32 will be returned. There are 2 special cases: + if the image contains unsigned 2-byte integer values, with BITPIX = + 16, BSCALE = 1, and BZERO = 32768, then this routine will return + a non-standard value of 20 for the bitpix value. Similarly if the + image contains unsigned 4-byte integers, then bitpix will + be returned with a value of 40. +\end{description} + + +\begin{verbatim} + FTGIDT(unit, > bitpix,status) + FTGIET(unit, > bitpix,status) +\end{verbatim} + +\begin{description} +\item[2 ] Get the dimension (number of axes = NAXIS) of the image +\end{description} + +\begin{verbatim} + FTGIDM(unit, > naxis,status) +\end{verbatim} + +\begin{description} +\item[3 ] Get the size of all the dimensions of the image +\end{description} + +\begin{verbatim} + FTGISZ(unit, maxdim, > naxes,status) +\end{verbatim} + +\begin{description} +\item[4 ] Get the parameters that define the type and size of the image. This + routine simply combines calls to the above 3 routines. +\end{description} + +\begin{verbatim} + FTGIPR(unit, maxdim, > bitpix, naxis, naxes, int *status) +\end{verbatim} + +\begin{description} +\item[5 ]Put elements into the data array +\end{description} + +\begin{verbatim} + FTPPR[BIJED](unit,group,fpixel,nelements,values, > status) +\end{verbatim} + +\begin{description} +\item[6 ]Put elements into the data array, substituting the appropriate FITS null + value for all elements which are equal to the value of NULLVAL. For + integer FITS arrays, the null value defined by the previous call to FTPNUL + will be substituted; for floating point FITS arrays (BITPIX = -32 + or -64) then the special IEEE NaN (Not-a-Number) value will be + substituted. +\end{description} + +\begin{verbatim} + FTPPN[BIJED](unit,group,fpixel,nelements,values,nullval > status) +\end{verbatim} + +\begin{description} +\item[7 ]Set data array elements as undefined +\end{description} + +\begin{verbatim} + FTPPRU(unit,group,fpixel,nelements, > status) +\end{verbatim} + +\begin{description} +\item[8 ] Get elements from the data array. Undefined array elements will be + returned with a value = nullval, unless nullval = 0 in which case no + checks for undefined pixels will be performed. +\end{description} + +\begin{verbatim} + FTGPV[BIJED](unit,group,fpixel,nelements,nullval, > values,anyf,status) +\end{verbatim} + +\begin{description} +\item[9 ] Get elements and nullflags from data array. + Any undefined array elements will have the corresponding flagvals element + set equal to .TRUE. +\end{description} + +\begin{verbatim} + FTGPF[BIJED](unit,group,fpixel,nelements, > values,flagvals,anyf,status) +\end{verbatim} + +\begin{description} +\item[10] Put values into group parameters +\end{description} + +\begin{verbatim} + FTPGP[BIJED](unit,group,fparm,nparm,values, > status) +\end{verbatim} + +\begin{description} +\item[11] Get values from group parameters +\end{description} + +\begin{verbatim} + FTGGP[BIJED](unit,group,fparm,nparm, > values,status) +\end{verbatim} +The following 4 subroutines transfer FITS images with 2 or 3 dimensions +to or from a data array which has been declared in the calling program. +The dimensionality of the FITS image is passed by the naxis1, naxis2, +and naxis3 parameters and the declared dimensions of the program array +are passed in the dim1 and dim2 parameters. Note that the program array +does not have to have the same dimensions as the FITS array, but must +be at least as big. For example if a FITS image with NAXIS1 = NAXIS2 = 400 +is read into a program array which is dimensioned as 512 x 512 pixels, +then the image will just fill the lower left corner of the array +with pixels in the range 1 - 400 in the X an Y directions. This has +the effect of taking a contiguous set of pixel value in the FITS array +and writing them to a non-contiguous array in program memory +(i.e., there are now some blank pixels around the edge of the image +in the program array). + + +\begin{description} +\item[11] Put 2-D image into the data array +\end{description} + +\begin{verbatim} + FTP2D[BIJED](unit,group,dim1,naxis1,naxis2,image, > status) +\end{verbatim} + +\begin{description} +\item[12] Put 3-D cube into the data array +\end{description} + +\begin{verbatim} + FTP3D[BIJED](unit,group,dim1,dim2,naxis1,naxis2,naxis3,cube, > status) +\end{verbatim} + +\begin{description} +\item[13] Get 2-D image from the data array. Undefined + pixels in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will + be performed. +\end{description} + +\begin{verbatim} + FTG2D[BIJED](unit,group,nullval,dim1,naxis1,naxis2, > image,anyf,status) +\end{verbatim} + +\begin{description} +\item[14] Get 3-D cube from the data array. Undefined + pixels in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will + be performed. +\end{description} + +\begin{verbatim} + FTG3D[BIJED](unit,group,nullval,dim1,dim2,naxis1,naxis2,naxis3, > + cube,anyf,status) +\end{verbatim} + +The following subroutines transfer a rectangular subset of the pixels +in a FITS N-dimensional image to or from an array which has been +declared in the calling program. The fpixels and lpixels parameters +are integer arrays which specify the starting and ending pixels in each +dimension of the FITS image that are to be read or written. (Note that +these are the starting and ending pixels in the FITS image, not in the +declared array). The array parameter is treated simply as a large +one-dimensional array of the appropriate datatype containing the pixel +values; The pixel values in the FITS array are read/written from/to +this program array in strict sequence without any gaps; it is up to +the calling routine to correctly interpret the dimensionality of this +array. The two families of FITS reading routines (FTGSVx and FTGSFx +subroutines) also have an 'incs' parameter which defines the +data sampling interval in each dimension of the FITS array. For +example, if incs(1)=2 and incs(2)=3 when reading a 2-dimensional +FITS image, then only every other pixel in the first dimension +and every 3rd pixel in the second dimension will be returned in +the 'array' parameter. [Note: the FTGSSx family of routines which +were present in previous versions of FITSIO have been superseded +by the more general FTGSVx family of routines.] + + +\begin{description} +\item[15] Put an arbitrary data subsection into the data array. +\end{description} + +\begin{verbatim} + FTPSS[BIJED](unit,group,naxis,naxes,fpixels,lpixels,array, > status) +\end{verbatim} + +\begin{description} +\item[16] Get an arbitrary data subsection from the data array. Undefined + pixels in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will + be performed. +\end{description} + +\begin{verbatim} + FTGSV[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) +\end{verbatim} + +\begin{description} +\item[17] Get an arbitrary data subsection from the data array. Any Undefined + pixels in the array will have the corresponding 'flagvals' + element set equal to .TRUE. +\end{description} + +\begin{verbatim} + FTGSF[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) +\end{verbatim} + + +\section{FITS ASCII and Binary Table Data I/O Subroutines} + + +\subsection{Column Information Subroutines \label{FTGCNO}} + + +\begin{description} +\item[1 ] Get the number of rows or columns in the current FITS table. + The number of rows is given by the NAXIS2 keyword and the + number of columns is given by the TFIELDS keyword in the header + of the table. +\end{description} + +\begin{verbatim} + FTGNRW(unit, > nrows, status) + FTGNCL(unit, > ncols, status) +\end{verbatim} + +\begin{description} +\item[2 ] Get the table column number (and name) of the column whose name +matches an input template name. The table column names are defined by +the TTYPEn keywords in the FITS header. If a column does not have a +TTYPEn keyword, then these routines assume that the name consists of +all blank characters. These 2 subroutines perform the same function +except that FTGCNO only returns the number of the matching column whereas +FTGCNN also returns the name of the column. If CASESEN = .true. then +the column name match will be case-sensitive. + +The input column name template (COLTEMPLATE) is (1) either the exact +name of the column to be searched for, or (2) it may contain wild cards +characters (*, ?, or \#), or (3) it may contain the number of the desired +column (where the number is expressed as ASCII digits). The first 2 wild +cards behave similarly to UNIX filename matching: the '*' character matches +any sequence of characters (including zero characters) and the '?' +character matches any single character. The \# wildcard will match +any consecutive string of decimal digits (0-9). As an example, the template +strings 'AB?DE', 'AB*E', and 'AB*CDE' will all match the string +'ABCDE'. If more than one column name in the table matches the +template string, then the first match is returned and the status value +will be set to 237 as a warning that a unique match was not found. To +find the other cases that match the template, simply call the +subroutine again leaving the input status value equal to 237 and the +next matching name will then be returned. Repeat this process until a +status = 219 (column name not found) is returned. If these subroutines +fail to match the template to any of the columns in the table, they +lastly check if the template can be interpreted as a simple positive +integer (e.g., '7', or '512') and if so, they return that column +number. If no matches are found then a status = 219 error is +returned. + +Note that the FITS Standard recommends that only letters, digits, and +the underscore character be used in column names (with no embedded +spaces in the name). Trailing blank characters are not significant. +It is recommended that the column names in a given table be unique +within the first 8 characters. +\end{description} + +\begin{verbatim} + FTGCNO(unit,casesen,coltemplate, > colnum,status) + FTGCNN(unit,casesen,coltemplate, > colname,colnum,status) +\end{verbatim} + +\begin{description} +\item[3 ] Get the datatype of a column in an ASCII or binary table. This + routine returns an integer code value corresponding to the datatype + of the column. (See the FTBNFM and FTASFM subroutines in the Utilities + section of this document for a list of the code values). The vector + repeat count (which is alway 1 for ASCII table columns) is also returned. + If the specified column has an ASCII character datatype (code = 16) then + the width of a unit string in the column is also returned. Note that + this routine supports the local convention for specifying arrays of + strings within a binary table character column, using the syntax + TFORM = 'rAw' where 'r' is the total number of characters (= the width + of the column) and 'w' is the width of a unit string within the column. + Thus if the column has TFORM = '60A12' then this routine will return + datacode = 16, repeat = 60, and width = 12. + + The second routine, FTEQTY is similar except that in + the case of scaled integer columns it returns the 'equivalent' data + type that is needed to store the scaled values, and not necessarily + the physical data type of the unscaled values as stored in the FITS + table. For example if a '1I' column in a binary table has TSCALn = + 1 and TZEROn = 32768, then this column effectively contains unsigned + short integer values, and thus the returned value of typecode will + be the code for an unsigned short integer, not a signed short integer. + Similarly, if a column has TTYPEn = '1I' + and TSCALn = 0.12, then the returned typecode + will be the code for a 'real' column. +\end{description} + +\begin{verbatim} + FTGTCL(unit,colnum, > datacode,repeat,width,status) + FTEQTY(unit,colnum, > datacode,repeat,width,status) +\end{verbatim} + +\begin{description} +\item[4 ] Return the display width of a column. This is the length + of the string that will be returned + when reading the column as a formatted string. The display width is + determined by the TDISPn keyword, if present, otherwise by the data + type of the column. +\end{description} + +\begin{verbatim} + FTGCDW(unit, colnum, > dispwidth, status) +\end{verbatim} + +\begin{description} +\item[5 ] Get information about an existing ASCII table column. (NOTE: TSCAL and + TZERO must be declared as Double Precision variables). All the + returned parameters are scalar quantities. +\end{description} + +\begin{verbatim} + FTGACL(unit,colnum, > + ttype,tbcol,tunit,tform,tscal,tzero,snull,tdisp,status) +\end{verbatim} + +\begin{description} +\item[6 ] Get information about an existing binary table column. (NOTE: TSCAL and + TZERO must be declared as Double Precision variables). DATATYPE is a + character string which returns the datatype of the column as defined + by the TFORMn keyword (e.g., 'I', 'J','E', 'D', etc.). In the case + of an ASCII character column, DATATYPE will have a value of the + form 'An' where 'n' is an integer expressing the width of the field + in characters. For example, if TFORM = '160A8' then FTGBCL will return + DATATYPE='A8' and REPEAT=20. All the returned parameters are scalar + quantities. +\end{description} + +\begin{verbatim} + FTGBCL(unit,colnum, > + ttype,tunit,datatype,repeat,tscal,tzero,tnull,tdisp,status) +\end{verbatim} + +\begin{description} +\item[7 ] Put (append) a TDIMn keyword whose value has the form '(l,m,n...)' + where l, m, n... are the dimensions of a multidimension array + column in a binary table. +\end{description} + +\begin{verbatim} + FTPTDM(unit,colnum,naxis,naxes, > status) +\end{verbatim} + +\begin{description} +\item[8 ] Return the number of and size of the dimensions of a table column. + Normally this information is given by the TDIMn keyword, but if + this keyword is not present then this routine returns NAXIS = 1 + and NAXES(1) equal to the repeat count in the TFORM keyword. +\end{description} + +\begin{verbatim} + FTGTDM(unit,colnum,maxdim, > naxis,naxes,status) +\end{verbatim} + +\begin{description} +\item[9 ] Decode the input TDIMn keyword string (e.g. '(100,200)') and return the + number of and size of the dimensions of a binary table column. If the input + tdimstr character string is null, then this routine returns naxis = 1 + and naxes[0] equal to the repeat count in the TFORM keyword. This routine + is called by FTGTDM. +\end{description} + +\begin{verbatim} + FTDTDM(unit,tdimstr,colnum,maxdim, > naxis,naxes, status) +\end{verbatim} + +\begin{description} +\item[10] Return the optimal number of rows to read or write at one time for + maximum I/O efficiency. Refer to the ``Optimizing Code'' section + in Chapter 5 for more discussion on how to use this routine. +\end{description} + + +\begin{verbatim} + FFGRSZ(unit, > nrows,status) +\end{verbatim} + + +\subsection{Low-Level Table Access Subroutines \label{FTGTBS}} + +The following subroutines provide low-level access to the data in ASCII +or binary tables and are mainly useful as an efficient way to copy all +or part of a table from one location to another. These routines simply +read or write the specified number of consecutive bytes in an ASCII or +binary table, without regard for column boundaries or the row length in +the table. The first two subroutines read or write consecutive bytes +in a table to or from a character string variable, while the last two +subroutines read or write consecutive bytes to or from a variable +declared as a numeric data type (e.g., INTEGER, INTEGER*2, REAL, DOUBLE +PRECISION). These routines do not perform any machine dependent data +conversion or byte swapping, except that conversion to/from ASCII +format is performed by the FTGTBS and FTPTBS routines on machines which +do not use ASCII character codes in the internal data representations +(e.g., on IBM mainframe computers). + + +\begin{description} +\item[1 ] Read a consecutive string of characters from an ASCII table + into a character variable (spanning columns and multiple rows if necessary) + This routine should not be used with binary tables because of + complications related to passing string variables between C and Fortran. +\end{description} + +\begin{verbatim} + FTGTBS(unit,frow,startchar,nchars, > string,status) +\end{verbatim} + +\begin{description} +\item[2 ] Write a consecutive string of characters to an ASCII table + from a character variable (spanning columns and multiple rows if necessary) + This routine should not be used with binary tables because of + complications related to passing string variables between C and Fortran. +\end{description} + +\begin{verbatim} + FTPTBS(unit,frow,startchar,nchars,string, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Read a consecutive array of bytes from an ASCII or binary table + into a numeric variable (spanning columns and multiple rows if necessary). + The array parameter may be declared as any numerical datatype as long + as the array is at least 'nchars' bytes long, e.g., if nchars = 17, + then declare the array as INTEGER*4 ARRAY(5). +\end{description} + +\begin{verbatim} + FTGTBB(unit,frow,startchar,nchars, > array,status) +\end{verbatim} + +\begin{description} +\item[4 ] Write a consecutive array of bytes to an ASCII or binary table + from a numeric variable (spanning columns and multiple rows if necessary) + The array parameter may be declared as any numerical datatype as long + as the array is at least 'nchars' bytes long, e.g., if nchars = 17, + then declare the array as INTEGER*4 ARRAY(5). +\end{description} + +\begin{verbatim} + FTPTBB(unit,frow,startchar,nchars,array, > status) +\end{verbatim} + + +\subsection{Edit Rows or Columns \label{FTIROW}} + + +\begin{description} +\item[1 ] Insert blank rows into an existing ASCII or binary table (in the CDU). + All the rows FOLLOWING row FROW are shifted down by NROWS rows. If + FROW = 0 then the blank rows are inserted at the beginning of the + table. This routine modifies the NAXIS2 keyword to reflect the new + number of rows in the table. +\end{description} + +\begin{verbatim} + FTIROW(unit,frow,nrows, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Delete rows from an existing ASCII or binary table (in the CDU). + The NROWS number of rows are deleted, starting with row FROW, and + any remaining rows in the table are shifted up to fill in the space. + This routine modifies the NAXIS2 keyword to reflect the new number + of rows in the table. +\end{description} + +\begin{verbatim} + FTDROW(unit,frow,nrows, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Delete a list of rows from an ASCII or binary table (in the CDU). + In the first routine, 'rowrange' is a character string listing the + rows or row ranges to delete (e.g., '2-4, 5, 8-9'). In the second + routine, 'rowlist' is an integer array of row numbers to be deleted + from the table. nrows is the number of row numbers in the list. + The first row in the table is 1 not 0. The list of row numbers + must be sorted in ascending order. +\end{description} + +\begin{verbatim} + FTDRRG(unit,rowrange, > status) + FTDRWS(unit,rowlist,nrows, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Insert a blank column (or columns) into an existing ASCII or binary + table (in the CDU). COLNUM specifies the column number that the (first) + new column should occupy in the table. NCOLS specifies how many + columns are to be inserted. Any existing columns from this position and + higher are moved over to allow room for the new column(s). + The index number on all the following keywords will be incremented + if necessary to reflect the new position of the column(s) in the table: + TBCOLn, TFORMn, TTYPEn, TUNITn, TNULLn, TSCALn, TZEROn, TDISPn, TDIMn, + TLMINn, TLMAXn, TDMINn, TDMAXn, TCTYPn, TCRPXn, TCRVLn, TCDLTn, TCROTn, + and TCUNIn. +\end{description} + +\begin{verbatim} + FTICOL(unit,colnum,ttype,tform, > status) + FTICLS(unit,colnum,ncols,ttype,tform, > status) +\end{verbatim} + +\begin{description} +\item[5 ] Modify the vector length of a binary table column (e.g., + change a column from TFORMn = '1E' to '20E'). The vector + length may be increased or decreased from the current value. +\end{description} + +\begin{verbatim} + FTMVEC(unit,colnum,newveclen, > status) +\end{verbatim} + +\begin{description} +\item[6 ] Delete a column from an existing ASCII or binary table (in the CDU). + The index number of all the keywords listed above (for FTICOL) will be + decremented if necessary to reflect the new position of the column(s) in + the table. Those index keywords that refer to the deleted column will + also be deleted. Note that the physical size of the FITS file will + not be reduced by this operation, and the empty FITS blocks if any + at the end of the file will be padded with zeros. +\end{description} + +\begin{verbatim} + FTDCOL(unit,colnum, > status) +\end{verbatim} + +\begin{description} +\item[7 ] Copy a column from one HDU to another (or to the same HDU). If + createcol = TRUE, then a new column will be inserted in the output + table, at position `outcolumn', otherwise the existing output column will + be overwritten (in which case it must have a compatible datatype). + Note that the first column in a table is at colnum = 1. +\end{description} + +\begin{verbatim} + FTCPCL(inunit,outunit,incolnum,outcolnum,createcol, > status); +\end{verbatim} + +\subsection{Read and Write Column Data Routines \label{FTPCLS}} + +These subroutines put or get data values in the current ASCII or Binary table +extension. Automatic data type conversion is performed for numerical data +types (B,I,J,E,D) if the data type of the column (defined by the TFORM keyword) +differs from the data type of the calling subroutine. The data values are also +scaled by the TSCALn and TZEROn header values as they are being written to +or read from the FITS array. The fttscl subroutine MUST be used to define the +scaling parameters when writing data to the table or to override the default +scaling values given in the header +when reading from the table. + + In the case of binary tables with vector elements, the 'felem' +parameter defines the starting pixel within the element vector. This +parameter is ignored with ASCII tables. Similarly, in the case of +binary tables the 'nelements' parameter specifies the total number of +vector values read or written (continuing on subsequent rows if +required) and not the number of table elements. Two sets of +subroutines are provided to get the column data which differ in the way +undefined pixels are handled. The first set of routines (FTGCV) +simply return an array of data elements in which undefined pixels are +set equal to a value specified by the user in the 'nullval' parameter. +An additional feature of these subroutines is that if the user sets +nullval = 0, then no checks for undefined pixels will be performed, +thus increasing the speed of the program. The second set of routines +(FTGCF) returns the data element array and in addition a logical array +of flags which defines whether the corresponding data pixel is undefined. + + Any column, regardless of it's intrinsic datatype, may be read as a + string. It should be noted however that reading a numeric column + as a string is 10 - 100 times slower than reading the same column as + a number due to the large overhead in constructing the formatted + strings. The display format of the returned strings will be + determined by the TDISPn keyword, if it exists, otherwise by the + datatype of the column. The length of the returned strings can be + determined with the ftgcdw routine. The following TDISPn display + formats are currently supported: + +\begin{verbatim} + Iw.m Integer + Ow.m Octal integer + Zw.m Hexadecimal integer + Fw.d Fixed floating point + Ew.d Exponential floating point + Dw.d Exponential floating point + Gw.d General; uses Fw.d if significance not lost, else Ew.d +\end{verbatim} + where w is the width in characters of the displayed values, m is the minimum + number of digits displayed, and d is the number of digits to the right of the + decimal. The .m field is optional. + + +\begin{description} +\item[1 ] Put elements into an ASCII or binary table column (in the CDU). + (The SPP FSPCLS routine has an additional integer argument after + the VALUES character string which specifies the size of the 1st + dimension of this 2-D CHAR array). +\end{description} + +\begin{verbatim} + FTPCL[SLBIJEDCM](unit,colnum,frow,felem,nelements,values, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Put elements into an ASCII or binary table column (in the CDU) + substituting the appropriate FITS null value for any elements that + are equal to NULLVAL. This family of routines must NOT be used to + write to variable length array columns. For ASCII TABLE extensions, the + null value defined by the previous call to FTSNUL will be substituted; + For integer FITS columns, in a binary table the null value + defined by the previous call to FTTNUL will be substituted; + For floating point FITS columns a special IEEE NaN (Not-a-Number) + value will be substituted. +\end{description} + +\begin{verbatim} + FTPCN[BIJED](unit,colnum,frow,felem,nelements,values,nullval > status) +\end{verbatim} + +\begin{description} +\item[3 ] Put bit values into a binary byte ('B') or bit ('X') table column (in the + CDU). LRAY is an array of logical values corresponding to the sequence of + bits to be written. If LRAY is true then the corresponding bit is + set to 1, otherwise the bit is set to 0. Note that in the case of + 'X' columns, FITSIO will write to all 8 bits of each byte whether + they are formally valid or not. Thus if the column is defined as + '4X', and one calls FTPCLX with fbit=1 and nbit=8, then all 8 bits + will be written into the first byte (as opposed to writing the + first 4 bits into the first row and then the next 4 bits into the + next row), even though the last 4 bits of each byte are formally + not defined. +\end{description} + +\begin{verbatim} + FTPCLX(unit,colnum,frow,fbit,nbit,lray, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Set table elements in a column as undefined +\end{description} + +\begin{verbatim} + FTPCLU(unit,colnum,frow,felem,nelements, > status) +\end{verbatim} + +\begin{description} +\item[5 ] Get elements from an ASCII or binary table column (in the CDU). These + routines return the values of the table column array elements. Undefined + array elements will be returned with a value = nullval, unless nullval = 0 + (or = ' ' for ftgcvs) in which case no checking for undefined values will + be performed. The ANYF parameter is set to true if any of the returned + elements are undefined. (Note: the ftgcl routine simple gets an array + of logical data values without any checks for undefined values; use + the ftgcfl routine to check for undefined logical elements). + (The SPP FSGCVS routine has an additional integer argument after + the VALUES character string which specifies the size of the 1st + dimension of this 2-D CHAR array). +\end{description} + +\begin{verbatim} + FTGCL(unit,colnum,frow,felem,nelements, > values,status) + FTGCV[SBIJEDCM](unit,colnum,frow,felem,nelements,nullval, > + values,anyf,status) +\end{verbatim} + +\begin{description} +\item[6 ] Get elements and null flags from an ASCII or binary table column (in the + CHDU). These routines return the values of the table column array elements. + Any undefined array elements will have the corresponding flagvals element + set equal to .TRUE. The ANYF parameter is set to true if any of the + returned elements are undefined. + (The SPP FSGCFS routine has an additional integer argument after + the VALUES character string which specifies the size of the 1st + dimension of this 2-D CHAR array). +\end{description} + +\begin{verbatim} + FTGCF[SLBIJEDCM](unit,colnum,frow,felem,nelements, > + values,flagvals,anyf,status) +\end{verbatim} + +\begin{description} +\item[7 ] Get an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Undefined pixels + in the array will be set equal to the value of 'nullval', + unless nullval=0 in which case no testing for undefined pixels will + be performed. The first and last rows in the table to be read + are specified by fpixels(naxis+1) and lpixels(naxis+1), and hence + are treated as the next higher dimension of the FITS N-dimensional + array. The INCS parameter specifies the sampling interval in + each dimension between the data elements that will be returned. +\end{description} + +\begin{verbatim} + FTGSV[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) +\end{verbatim} + +\begin{description} +\item[8 ] Get an arbitrary data subsection from an N-dimensional array + in a binary table vector column. Any Undefined + pixels in the array will have the corresponding 'flagvals' + element set equal to .TRUE. The first and last rows in the table + to be read are specified by fpixels(naxis+1) and lpixels(naxis+1), + and hence are treated as the next higher dimension of the FITS + N-dimensional array. The INCS parameter specifies the sampling + interval in each dimension between the data elements that will be + returned. +\end{description} + +\begin{verbatim} + FTGSF[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) +\end{verbatim} + +\begin{description} +\item[9 ] Get bit values from a byte ('B') or bit (`X`) table column (in the + CDU). LRAY is an array of logical values corresponding to the + sequence of bits to be read. If LRAY is true then the + corresponding bit was set to 1, otherwise the bit was set to 0. + Note that in the case of 'X' columns, FITSIO will read all 8 bits + of each byte whether they are formally valid or not. Thus if the + column is defined as '4X', and one calls FTGCX with fbit=1 and + nbit=8, then all 8 bits will be read from the first byte (as + opposed to reading the first 4 bits from the first row and then the + first 4 bits from the next row), even though the last 4 bits of + each byte are formally not defined. +\end{description} + +\begin{verbatim} + FTGCX(unit,colnum,frow,fbit,nbit, > lray,status) +\end{verbatim} + +\begin{description} +\item[10] Read any consecutive set of bits from an 'X' or 'B' column and + interpret them as an unsigned n-bit integer. NBIT must be less than + or equal to 16 when calling FTGCXI, and less than or equal to 32 when + calling FTGCXJ; there is no limit on the value of NBIT for FTGCXD, but + the returned double precision value only has 48 bits of precision on + most 32-bit word machines. The NBITS bits are interpreted as an + unsigned integer unless NBITS = 16 (in FTGCXI) or 32 (in FTGCXJ) in which + case the string of bits are interpreted as 16-bit or 32-bit 2's + complement signed integers. If NROWS is greater than 1 then the + same set of bits will be read from sequential rows in the table + starting with row FROW. Note that the numbering convention + used here for the FBIT parameter adopts 1 for the first element of the + vector of bits; this is the Most Significant Bit of the integer value. +\end{description} + +\begin{verbatim} + FTGCX[IJD](unit,colnum,frow,nrows,fbit,nbit, > array,status) +\end{verbatim} + +\begin{description} +\item[11] Get the descriptor for a variable length column in a binary table. + The descriptor consists of 2 integer parameters: the number of elements + in the array and the starting offset relative to the start of the heap. + The first routine returns a single descriptor whereas the second routine + returns the descriptors for a range of rows in the table. +\end{description} + +\begin{verbatim} + FTGDES(unit,colnum,rownum, > nelements,offset,status) + FFGDESSunit,colnum,firstrow,nrows > nelements,offset, status) +\end{verbatim} + +\begin{description} +\item[12] Put the descriptor for a variable length column in a binary table. + This subroutine can be used in conjunction with FTGDES to enable + 2 or more arrays to point to the same storage location to save + storage space if the arrays are identical. +\end{description} + +\begin{verbatim} + FTPDES(unit,colnum,rownum,nelements,offset, > status) +\end{verbatim} + + +\section{Row Selection and Calculator Routines \label{FTFROW}} + +These routines all parse and evaluate an input string containing a user +defined arithmetic expression. The first 3 routines select rows in a +FITS table, based on whether the expression evaluates to true (not +equal to zero) or false (zero). The other routines evaluate the +expression and calculate a value for each row of the table. The +allowed expression syntax is described in the row filter section in the +earlier `Extended File Name Syntax' chapter of this document. The +expression may also be written to a text file, and the name of the +file, prepended with a '@' character may be supplied for the 'expr' +parameter (e.g. '@filename.txt'). The expression in the file can +be arbitrarily complex and extend over multiple lines of the file. +Lines that begin with 2 slash characters ('//') will be ignored and +may be used to add comments to the file. + + +\begin{description} +\item[1 ] Evaluate a boolean expression over the indicated rows, returning an + array of flags indicating which rows evaluated to TRUE/FALSE +\end{description} + +\begin{verbatim} + FTFROW(unit,expr,firstrow, nrows, > n_good_rows, row_status, status) +\end{verbatim} + +\begin{description} +\item[2 ] Find the first row which satisfies the input boolean expression +\end{description} + +\begin{verbatim} + FTFFRW(unit, expr, > rownum, status) +\end{verbatim} + +\begin{description} +\item[3 ]Evaluate an expression on all rows of a table. If the input and output +files are not the same, copy the TRUE rows to the output file. If the +files are the same, delete the FALSE rows (preserve the TRUE rows). +\end{description} + +\begin{verbatim} + FTSROW(inunit, outunit, expr, > status) +\end{verbatim} + +\begin{description} +\item[4 ] Calculate an expression for the indicated rows of a table, returning +the results, cast as datatype (TSHORT, TDOUBLE, etc), in array. If +nulval==NULL, UNDEFs will be zeroed out. For vector results, the number +of elements returned may be less than nelements if nelements is not an +even multiple of the result dimension. Call FTTEXP to obtain +the dimensions of the results. +\end{description} + +\begin{verbatim} + FTCROW(unit,datatype,expr,firstrow,nelements,nulval, > + array,anynul,status) +\end{verbatim} + +\begin{description} +\item[5 ]Evaluate an expression and write the result either to a column (if +the expression is a function of other columns in the table) or to a +keyword (if the expression evaluates to a constant and is not a +function of other columns in the table). In the former case, the +parName parameter is the name of the column (which may or may not already +exist) into which to write the results, and parInfo contains an +optional TFORM keyword value if a new column is being created. If a +TFORM value is not specified then a default format will be used, +depending on the expression. If the expression evaluates to a constant, +then the result will be written to the keyword name given by the +parName parameter, and the parInfo parameter may be used to supply an +optional comment for the keyword. If the keyword does not already +exist, then the name of the keyword must be preceded with a '\#' character, +otherwise the result will be written to a column with that name. +\end{description} + + +\begin{verbatim} + FTCALC(inunit, expr, outunit, parName, parInfo, > status) +\end{verbatim} + +\begin{description} +\item[6 ] This calculator routine is similar to the previous routine, except +that the expression is only evaluated over the specified +row ranges. nranges specifies the number of row ranges, and firstrow +and lastrow give the starting and ending row number of each range. +\end{description} + +\begin{verbatim} + FTCALC_RNG(inunit, expr, outunit, parName, parInfo, + nranges, firstrow, lastrow, > status) +\end{verbatim} + +\begin{description} +\item[7 ]Evaluate the given expression and return information on the result. +\end{description} + +\begin{verbatim} + FTTEXP(unit, expr, > datatype, nelem, naxis, naxes, status) +\end{verbatim} + + + +\section{Celestial Coordinate System Subroutines \label{FTGICS}} + +The FITS community has adopted a set of keyword conventions that define +the transformations needed to convert between pixel locations in an +image and the corresponding celestial coordinates on the sky, or more +generally, that define world coordinates that are to be associated with +any pixel location in an n-dimensional FITS array. CFITSIO is distributed +with a couple of self-contained World Coordinate System (WCS) routines, +however, these routines DO NOT support all the latest WCS conventions, +so it is STRONGLY RECOMMENDED that software developers use a more robust +external WCS library. Several recommended libraries are: + +\begin{verbatim} + WCSLIB - supported by Mark Calabretta + WCSTools - supported by Doug Mink + AST library - developed by the U.K. Starlink project +\end{verbatim} + +More information about the WCS keyword conventions and links to all of +these WCS libraries can be found on the FITS Support Office web site at +http://fits.gsfc.nasa.gov under the WCS link. + +The functions provided in these external WCS libraries will need access to +the WCS information contained in the FITS file headers. One convenient +way to pass this information to the extermal library is to use FITSIO +to copy the header keywords into one long character string, and then +pass this string to an interface routine in the external library that +will extract the necessary WCS information (e.g., see the astFitsChan +and astPutCards routines in the Starlink AST library). + +The following FITSIO routines DO NOT support the more recent WCS conventions +that have been approved as part of the FITS standard. Consequently, +the following routines ARE NOW DEPRECATED. It is STRONGLY RECOMMENDED +that software developers not use these routines, and instead use an +external WCS library, as described above. + +These routines are included mainly for backward compatibility with +existing software. They support the following standard map +projections: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, and -AIT (these are the +legal values for the coordtype parameter). These routines are based +on similar functions in Classic AIPS. All the angular quantities are +given in units of degrees. + + +\begin{description} +\item[1 ] Get the values of all the standard FITS celestial coordinate system + keywords from the header of a FITS image (i.e., the primary array or + an image extension). These values may then be passed to the subroutines + that perform the coordinate transformations. If any or all of the WCS + keywords are not present, then default values will be returned. If + the first coordinate axis is the declination-like coordinate, then + this routine will swap them so that the longitudinal-like coordinate + is returned as the first axis. + + If the file uses the newer 'CDj\_i' WCS transformation matrix + keywords instead of old style 'CDELTn' and 'CROTA2' keywords, then + this routine will calculate and return the values of the equivalent + old-style keywords. Note that the conversion from the new-style + keywords to the old-style values is sometimes only an + approximation, so if the approximation is larger than an internally + defined threshold level, then CFITSIO will still return the + approximate WCS keyword values, but will also return with status = + 506, to warn the calling program that approximations have been + made. It is then up to the calling program to decide whether the + approximations are sufficiently accurate for the particular + application, or whether more precise WCS transformations must be + performed using new-style WCS keywords directly. +\end{description} + +\begin{verbatim} + FTGICS(unit, > xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) +\end{verbatim} + +\begin{description} +\item[2 ] Get the values of all the standard FITS celestial coordinate system + keywords from the header of a FITS table where the X and Y (or RA and + DEC coordinates are stored in 2 separate columns of the table. + These values may then be passed to the subroutines that perform the + coordinate transformations. +\end{description} + +\begin{verbatim} + FTGTCS(unit,xcol,ycol, > + xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) +\end{verbatim} + +\begin{description} +\item[3 ] Calculate the celestial coordinate corresponding to the input + X and Y pixel location in the image. +\end{description} + +\begin{verbatim} + FTWLDP(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpos,ypos,status) +\end{verbatim} + +\begin{description} +\item[4 ] Calculate the X and Y pixel location corresponding to the input + celestial coordinate in the image. +\end{description} + +\begin{verbatim} + FTXYPX(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpix,ypix,status) +\end{verbatim} + + +\section{File Checksum Subroutines \label{FTPCKS}} + +The following routines either compute or validate the checksums for the +CHDU. The DATASUM keyword is used to store the numerical value of the +32-bit, 1's complement checksum for the data unit alone. If there is +no data unit then the value is set to zero. The numerical value is +stored as an ASCII string of digits, enclosed in quotes, because the +value may be too large to represent as a 32-bit signed integer. The +CHECKSUM keyword is used to store the ASCII encoded COMPLEMENT of the +checksum for the entire HDU. Storing the complement, rather than the +actual checksum, forces the checksum for the whole HDU to equal zero. +If the file has been modified since the checksums were computed, then +the HDU checksum will usually not equal zero. These checksum keyword +conventions are based on a paper by Rob Seaman published in the +proceedings of the ADASS IV conference in Baltimore in November 1994 +and a later revision in June 1995. + + +\begin{description} +\item[1 ] Compute and write the DATASUM and CHECKSUM keyword values for the CHDU + into the current header. The DATASUM value is the 32-bit checksum + for the data unit, expressed as a decimal integer enclosed in single + quotes. The CHECKSUM keyword value is a 16-character string which + is the ASCII-encoded value for the complement of the checksum for + the whole HDU. If these keywords already exist, their values + will be updated only if necessary (i.e., if the file has been modified + since the original keyword values were computed). +\end{description} + +\begin{verbatim} + FTPCKS(unit, > status) +\end{verbatim} + +\begin{description} +\item[2 ] Update the CHECKSUM keyword value in the CHDU, assuming that the + DATASUM keyword exists and already has the correct value. This routine + calculates the new checksum for the current header unit, adds it to the + data unit checksum, encodes the value into an ASCII string, and writes + the string to the CHECKSUM keyword. +\end{description} + +\begin{verbatim} + FTUCKS(unit, > status) +\end{verbatim} + +\begin{description} +\item[3 ] Verify the CHDU by computing the checksums and comparing + them with the keywords. The data unit is verified correctly + if the computed checksum equals the value of the DATASUM + keyword. The checksum for the entire HDU (header plus data unit) is + correct if it equals zero. The output DATAOK and HDUOK parameters + in this subroutine are integers which will have a value = 1 + if the data or HDU is verified correctly, a value = 0 + if the DATASUM or CHECKSUM keyword is not present, or value = -1 + if the computed checksum is not correct. +\end{description} + +\begin{verbatim} + FTVCKS(unit, > dataok,hduok,status) +\end{verbatim} + +\begin{description} +\item[4 ] Compute and return the checksum values for the CHDU (as + double precision variables) without creating or modifying the + CHECKSUM and DATASUM keywords. This routine is used internally by + FTVCKS, but may be useful in other situations as well. +\end{description} + +\begin{verbatim} + FTGCKS(unit, > datasum,hdusum,status) +\end{verbatim} + +\begin{description} +\item[5 ] Encode a checksum value (stored in a double precision variable) + into a 16-character string. If COMPLEMENT = .true. then the 32-bit + sum value will be complemented before encoding. +\end{description} + +\begin{verbatim} + FTESUM(sum,complement, > checksum) +\end{verbatim} + +\begin{description} +\item[6 ] Decode a 16 character checksum string into a double precision value. + If COMPLEMENT = .true. then the 32-bit sum value will be complemented + after decoding. +\end{description} + +\begin{verbatim} + FTDSUM(checksum,complement, > sum) +\end{verbatim} + + +\section{ Date and Time Utility Routines \label{FTGSDT}} + +The following routines help to construct or parse the FITS date/time +strings. Starting in the year 2000, the FITS DATE keyword values (and +the values of other `DATE-' keywords) must have the form 'YYYY-MM-DD' +(date only) or 'YYYY-MM-DDThh:mm:ss.ddd...' (date and time) where the +number of decimal places in the seconds value is optional. These times +are in UTC. The older 'dd/mm/yy' date format may not be used for dates +after 01 January 2000. + + +\begin{description} +\item[1 ] Get the current system date. The returned year has 4 digits + (1999, 2000, etc.) +\end{description} + +\begin{verbatim} + FTGSDT( > day, month, year, status ) +\end{verbatim} + + +\begin{description} +\item[2 ] Get the current system date and time string ('YYYY-MM-DDThh:mm:ss'). +The time will be in UTC/GMT if available, as indicated by a returned timeref +value = 0. If the returned value of timeref = 1 then this indicates that +it was not possible to convert the local time to UTC, and thus the local +time was returned. +\end{description} + +\begin{verbatim} + FTGSTM(> datestr, timeref, status) +\end{verbatim} + + +\begin{description} +\item[3 ] Construct a date string from the input date values. If the year +is between 1900 and 1998, inclusive, then the returned date string will +have the old FITS format ('dd/mm/yy'), otherwise the date string will +have the new FITS format ('YYYY-MM-DD'). Use FTTM2S instead + to always return a date string using the new FITS format. +\end{description} + +\begin{verbatim} + FTDT2S( year, month, day, > datestr, status) +\end{verbatim} + + +\begin{description} +\item[4 ] Construct a new-format date + time string ('YYYY-MM-DDThh:mm:ss.ddd...'). + If the year, month, and day values all = 0 then only the time is encoded + with format 'hh:mm:ss.ddd...'. The decimals parameter specifies how many + decimal places of fractional seconds to include in the string. If `decimals' + is negative, then only the date will be return ('YYYY-MM-DD'). +\end{description} + +\begin{verbatim} + FTTM2S( year, month, day, hour, minute, second, decimals, + > datestr, status) +\end{verbatim} + + +\begin{description} +\item[5 ] Return the date as read from the input string, where the string may be +in either the old ('dd/mm/yy') or new ('YYYY-MM-DDThh:mm:ss' or +'YYYY-MM-DD') FITS format. +\end{description} + +\begin{verbatim} + FTS2DT(datestr, > year, month, day, status) +\end{verbatim} + + +\begin{description} +\item[6 ] Return the date and time as read from the input string, where the +string may be in either the old or new FITS format. The returned hours, +minutes, and seconds values will be set to zero if the input string +does not include the time ('dd/mm/yy' or 'YYYY-MM-DD') . Similarly, +the returned year, month, and date values will be set to zero if the +date is not included in the input string ('hh:mm:ss.ddd...'). +\end{description} + +\begin{verbatim} + FTS2TM(datestr, > year, month, day, hour, minute, second, status) +\end{verbatim} + + +\section{General Utility Subroutines \label{FTGHAD}} + +The following utility subroutines may be useful for certain applications: + + +\begin{description} +\item[1 ] Return the starting byte address of the CHDU and the next HDU. +\end{description} + +\begin{verbatim} + FTGHAD(iunit, > curaddr,nextaddr) +\end{verbatim} + +\begin{description} +\item[2 ] Convert a character string to uppercase (operates in place). +\end{description} + +\begin{verbatim} + FTUPCH(string) +\end{verbatim} + +\begin{description} +\item[3 ] Compare the input template string against the reference string + to see if they match. The template string may contain wildcard + characters: '*' will match any sequence of characters (including + zero characters) and '%' will match any single character in the + reference string. If CASESN = .true. then the match will be + case sensitive. The returned MATCH parameter will be .true. if + the 2 strings match, and EXACT will be .true. if the match is + exact (i.e., if no wildcard characters were used in the match). + Both strings must be 68 characters or less in length. +\end{description} + +\begin{verbatim} + FTCMPS(str_template,string,casesen, > match,exact) +\end{verbatim} + + +\begin{description} +\item[4 ] Test that the keyword name contains only legal characters: A-Z,0-9, + hyphen, and underscore. +\end{description} + +\begin{verbatim} + FTTKEY(keyword, > status) +\end{verbatim} + +\begin{description} +\item[5 ] Test that the keyword record contains only legal printable ASCII + characters +\end{description} + +\begin{verbatim} + FTTREC(card, > status) +\end{verbatim} + +\begin{description} +\item[6 ] Test whether the current header contains any NULL (ASCII 0) characters. + These characters are illegal in the header, but they will go undetected + by most of the CFITSIO keyword header routines, because the null is + interpreted as the normal end-of-string terminator. This routine returns + the position of the first null character in the header, or zero if there + are no nulls. For example a returned value of 110 would indicate that + the first NULL is located in the 30th character of the second keyword + in the header (recall that each header record is 80 characters long). + Note that this is one of the few FITSIO routines in which the returned + value is not necessarily equal to the status value). +\end{description} + +\begin{verbatim} + FTNCHK(unit, > status) +\end{verbatim} + +\begin{description} +\item[7 ] Parse a header keyword record and return the name of the keyword + and the length of the name. + The keyword name normally occupies the first 8 characters of the + record, except under the HIERARCH convention where the name can + be up to 70 characters in length. +\end{description} + +\begin{verbatim} + FTGKNM(card, > keyname, keylength, status) +\end{verbatim} + +\begin{description} +\item[8 ] Parse a header keyword record. + This subroutine parses the input header record to return the value (as + a character string) and comment strings. If the keyword has no + value (columns 9-10 not equal to '= '), then the value string is returned + blank and the comment string is set equal to column 9 - 80 of the + input string. +\end{description} + +\begin{verbatim} + FTPSVC(card, > value,comment,status) +\end{verbatim} + +\begin{description} +\item[9 ] Construct a sequence keyword name (ROOT + nnn). + This subroutine appends the sequence number to the root string to create + a keyword name (e.g., 'NAXIS' + 2 = 'NAXIS2') +\end{description} + +\begin{verbatim} + FTKEYN(keyroot,seq_no, > keyword,status) +\end{verbatim} + +\begin{description} +\item[10] Construct a sequence keyword name (n + ROOT). + This subroutine concatenates the sequence number to the front of the + root string to create a keyword name (e.g., 1 + 'CTYP' = '1CTYP') +\end{description} + +\begin{verbatim} + FTNKEY(seq_no,keyroot, > keyword,status) +\end{verbatim} + +\begin{description} +\item[11] Determine the datatype of a keyword value string. + This subroutine parses the keyword value string (usually columns 11-30 + of the header record) to determine its datatype. +\end{description} + +\begin{verbatim} + FTDTYP(value, > dtype,status) +\end{verbatim} + +\begin{description} +\item[11] Return the class of input header record. The record is classified + into one of the following categories (the class values are + defined in fitsio.h). Note that this is one of the few FITSIO + routines that does not return a status value. +\end{description} + +\begin{verbatim} + Class Value Keywords + TYP_STRUC_KEY 10 SIMPLE, BITPIX, NAXIS, NAXISn, EXTEND, BLOCKED, + GROUPS, PCOUNT, GCOUNT, END + XTENSION, TFIELDS, TTYPEn, TBCOLn, TFORMn, THEAP, + and the first 4 COMMENT keywords in the primary array + that define the FITS format. + TYP_CMPRS_KEY 20 The experimental keywords used in the compressed + image format ZIMAGE, ZCMPTYPE, ZNAMEn, ZVALn, + ZTILEn, ZBITPIX, ZNAXISn, ZSCALE, ZZERO, ZBLANK + TYP_SCAL_KEY 30 BSCALE, BZERO, TSCALn, TZEROn + TYP_NULL_KEY 40 BLANK, TNULLn + TYP_DIM_KEY 50 TDIMn + TYP_RANG_KEY 60 TLMINn, TLMAXn, TDMINn, TDMAXn, DATAMIN, DATAMAX + TYP_UNIT_KEY 70 BUNIT, TUNITn + TYP_DISP_KEY 80 TDISPn + TYP_HDUID_KEY 90 EXTNAME, EXTVER, EXTLEVEL, HDUNAME, HDUVER, HDULEVEL + TYP_CKSUM_KEY 100 CHECKSUM, DATASUM + TYP_WCS_KEY 110 CTYPEn, CUNITn, CRVALn, CRPIXn, CROTAn, CDELTn + CDj_is, PVj_ms, LONPOLEs, LATPOLEs + TCTYPn, TCTYns, TCUNIn, TCUNns, TCRVLn, TCRVns, TCRPXn, + TCRPks, TCDn_k, TCn_ks, TPVn_m, TPn_ms, TCDLTn, TCROTn + jCTYPn, jCTYns, jCUNIn, jCUNns, jCRVLn, jCRVns, iCRPXn, + iCRPns, jiCDn, jiCDns, jPVn_m, jPn_ms, jCDLTn, jCROTn + (i,j,m,n are integers, s is any letter) + TYP_REFSYS_KEY 120 EQUINOXs, EPOCH, MJD-OBSs, RADECSYS, RADESYSs + TYP_COMM_KEY 130 COMMENT, HISTORY, (blank keyword) + TYP_CONT_KEY 140 CONTINUE + TYP_USER_KEY 150 all other keywords + + class = FTGKCL (char *card) +\end{verbatim} + +\begin{description} +\item[12] Parse the 'TFORM' binary table column format string. + This subroutine parses the input TFORM character string and returns the + integer datatype code, the repeat count of the field, and, in the case + of character string fields, the length of the unit string. The following + datatype codes are returned (the negative of the value is returned + if the column contains variable-length arrays): +\end{description} + +\begin{verbatim} + Datatype DATACODE value + bit, X 1 + byte, B 11 + logical, L 14 + ASCII character, A 16 + short integer, I 21 + integer, J 41 + real, E 42 + double precision, D 82 + complex 83 + double complex 163 + + FTBNFM(tform, > datacode,repeat,width,status) +\end{verbatim} + +\begin{description} +\item[13] Parse the 'TFORM' keyword value that defines the column format in + an ASCII table. This routine parses the input TFORM character + string and returns the datatype code, the width of the column, + and (if it is a floating point column) the number of decimal places + to the right of the decimal point. The returned datatype codes are + the same as for the binary table, listed above, with the following + additional rules: integer columns that are between 1 and 4 characters + wide are defined to be short integers (code = 21). Wider integer + columns are defined to be regular integers (code = 41). Similarly, + Fixed decimal point columns (with TFORM = 'Fw.d') are defined to + be single precision reals (code = 42) if w is between 1 and 7 characters + wide, inclusive. Wider 'F' columns will return a double precision + data code (= 82). 'Ew.d' format columns will have datacode = 42, + and 'Dw.d' format columns will have datacode = 82. +\end{description} + +\begin{verbatim} + FTASFM(tform, > datacode,width,decimals,status) +\end{verbatim} + +\begin{description} +\item[14] Calculate the starting column positions and total ASCII table width + based on the input array of ASCII table TFORM values. The SPACE input + parameter defines how many blank spaces to leave between each column + (it is recommended to have one space between columns for better human + readability). +\end{description} + +\begin{verbatim} + FTGABC(tfields,tform,space, > rowlen,tbcol,status) +\end{verbatim} + +\begin{description} +\item[15] Parse a template string and return a formatted 80-character string + suitable for appending to (or deleting from) a FITS header file. + This subroutine is useful for parsing lines from an ASCII template file + and reformatting them into legal FITS header records. The formatted + string may then be passed to the FTPREC, FTMCRD, or FTDKEY subroutines + to append or modify a FITS header record. +\end{description} + +\begin{verbatim} + FTGTHD(template, > card,hdtype,status) +\end{verbatim} + The input TEMPLATE character string generally should contain 3 tokens: + (1) the KEYNAME, (2) the VALUE, and (3) the COMMENT string. The + TEMPLATE string must adhere to the following format: + + +\begin{description} +\item[- ] The KEYNAME token must begin in columns 1-8 and be a maximum of 8 + characters long. If the first 8 characters of the template line are + blank then the remainder of the line is considered to be a FITS comment + (with a blank keyword name). A legal FITS keyword name may only + contain the characters A-Z, 0-9, and '-' (minus sign) and + underscore. This subroutine will automatically convert any lowercase + characters to uppercase in the output string. If KEYNAME = 'COMMENT' + or 'HISTORY' then the remainder of the line is considered to be a FITS + COMMENT or HISTORY record, respectively. +\end{description} + + +\begin{description} +\item[- ] The VALUE token must be separated from the KEYNAME token by one or more + spaces and/or an '=' character. The datatype of the VALUE token + (numeric, logical, or character string) is automatically determined + and the output CARD string is formatted accordingly. The value + token may be forced to be interpreted as a string (e.g. if it is a + string of numeric digits) by enclosing it in single quotes. +\end{description} + + +\begin{description} +\item[- ] The COMMENT token is optional, but if present must be separated from + the VALUE token by at least one blank space. A leading '/' character + may be used to mark the beginning of the comment field, otherwise the + comment field begins with the first non-blank character following the + value token. +\end{description} + + +\begin{description} +\item[- ] One exception to the above rules is that if the first non-blank + character in the template string is a minus sign ('-') followed + by a single token, or a single token followed by an equal sign, + then it is interpreted as the name of a keyword which is to be + deleted from the FITS header. +\end{description} + + +\begin{description} +\item[- ] The second exception is that if the template string starts with + a minus sign and is followed by 2 tokens then the second token + is interpreted as the new name for the keyword specified by + first token. In this case the old keyword name (first token) + is returned in characters 1-8 of the returned CARD string, and + the new keyword name (the second token) is returned in characters + 41-48 of the returned CARD string. These old and new names + may then be passed to the FTMNAM subroutine which will change + the keyword name. +\end{description} + + The HDTYPE output parameter indicates how the returned CARD string + should be interpreted: + +\begin{verbatim} + hdtype interpretation + ------ ------------------------------------------------- + -2 Modify the name of the keyword given in CARD(1:8) + to the new name given in CARD(41:48) + + -1 CARD(1:8) contains the name of a keyword to be deleted + from the FITS header. + + 0 append the CARD string to the FITS header if the + keyword does not already exist, otherwise update + the value/comment if the keyword is already present + in the header. + + 1 simply append this keyword to the FITS header (CARD + is either a HISTORY or COMMENT keyword). + + 2 This is a FITS END record; it should not be written + to the FITS header because FITSIO automatically + appends the END record when the header is closed. +\end{verbatim} + EXAMPLES: The following lines illustrate valid input template strings: + +\begin{verbatim} + INTVAL 7 This is an integer keyword + RVAL 34.6 / This is a floating point keyword + EVAL=-12.45E-03 This is a floating point keyword in exponential notation + lval F This is a boolean keyword + This is a comment keyword with a blank keyword name + SVAL1 = 'Hello world' / this is a string keyword + SVAL2 '123.5' this is also a string keyword + sval3 123+ / this is also a string keyword with the value '123+ ' + # the following template line deletes the DATE keyword + - DATE + # the following template line modifies the NAME keyword to OBJECT + - NAME OBJECT +\end{verbatim} + +\begin{description} +\item[16] Parse the input string containing a list of rows or row ranges, and + return integer arrays containing the first and last row in each + range. For example, if rowlist = "3-5, 6, 8-9" then it will + return numranges = 3, rangemin = 3, 6, 8 and rangemax = 5, 6, 9. + At most, 'maxranges' number of ranges will be returned. 'maxrows' + is the maximum number of rows in the table; any rows or ranges + larger than this will be ignored. The rows must be specified in + increasing order, and the ranges must not overlap. A minus sign + may be use to specify all the rows to the upper or lower bound, so + "50-" means all the rows from 50 to the end of the table, and "-" + means all the rows in the table, from 1 - maxrows. +\end{description} + +\begin{verbatim} + FTRWRG(rowlist, maxrows, maxranges, > + numranges, rangemin, rangemax, status) +\end{verbatim} + + +\chapter{ Summary of all FITSIO User-Interface Subroutines } + + Error Status Routines page~\pageref{FTVERS} + +\begin{verbatim} + FTVERS( > version) + FTGERR(status, > errtext) + FTGMSG( > errmsg) + FTRPRT (stream, > status) + FTPMSG(errmsg) + FTPMRK + FTCMSG + FTCMRK +\end{verbatim} + FITS File Open and Close Subroutines: page~\pageref{FTOPEN} + +\begin{verbatim} + FTOPEN(unit,filename,rwmode, > blocksize,status) + FTDKOPEN(unit,filename,rwmode, > blocksize,status) + FTNOPN(unit,filename,rwmode, > status) + FTDOPN(unit,filename,rwmode, > status) + FTTOPN(unit,filename,rwmode, > status) + FTIOPN(unit,filename,rwmode, > status) + FTREOPEN(unit, > newunit, status) + FTINIT(unit,filename,blocksize, > status) + FTDKINIT(unit,filename,blocksize, > status) + FTTPLT(unit, filename, tplfilename, > status) + FTFLUS(unit, > status) + FTCLOS(unit, > status) + FTDELT(unit, > status) + FTGIOU( > iounit, status) + FTFIOU(iounit, > status) + CFITS2Unit(fitsfile *ptr) (C routine) + CUnit2FITS(int unit) (C routine) + FTEXTN(filename, > nhdu, status) + FTFLNM(unit, > filename, status) + FTFLMD(unit, > iomode, status) + FFURLT(unit, > urltype, status) + FTIURL(filename, > filetype, infile, outfile, extspec, filter, + binspec, colspec, status) + FTRTNM(filename, > rootname, status) + FTEXIST(filename, > exist, status) +\end{verbatim} + HDU-Level Operations: page~\pageref{FTMAHD} + +\begin{verbatim} + FTMAHD(unit,nhdu, > hdutype,status) + FTMRHD(unit,nmove, > hdutype,status) + FTGHDN(unit, > nhdu) + FTMNHD(unit, hdutype, extname, extver, > status) + FTGHDT(unit, > hdutype, status) + FTTHDU(unit, > hdunum, status) + FTCRHD(unit, > status) + FTIIMG(unit,bitpix,naxis,naxes, > status) + FTITAB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) + FTIBIN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) + FTRSIM(unit,bitpix,naxis,naxes,status) + FTDHDU(unit, > hdutype,status) + FTCPFL(iunit,ounit,previous, current, following, > status) + FTCOPY(iunit,ounit,morekeys, > status) + FTCPHD(inunit, outunit, > status) + FTCPDT(iunit,ounit, > status) +\end{verbatim} + Subroutines to specify or modify the structure of the CHDU: page~\pageref{FTRDEF} + +\begin{verbatim} + FTRDEF(unit, > status) (DEPRECATED) + FTPDEF(unit,bitpix,naxis,naxes,pcount,gcount, > status) (DEPRECATED) + FTADEF(unit,rowlen,tfields,tbcol,tform,nrows > status) (DEPRECATED) + FTBDEF(unit,tfields,tform,varidat,nrows > status) (DEPRECATED) + FTDDEF(unit,bytlen, > status) (DEPRECATED) + FTPTHP(unit,theap, > status) +\end{verbatim} + Header Space and Position Subroutines: page~\pageref{FTHDEF} + +\begin{verbatim} + FTHDEF(unit,morekeys, > status) + FTGHSP(iunit, > keysexist,keysadd,status) + FTGHPS(iunit, > keysexist,key_no,status) +\end{verbatim} + Read or Write Standard Header Subroutines: page~\pageref{FTPHPR} + +\begin{verbatim} + FTPHPS(unit,bitpix,naxis,naxes, > status) + FTPHPR(unit,simple,bitpix,naxis,naxes,pcount,gcount,extend, > status) + FTGHPR(unit,maxdim, > simple,bitpix,naxis,naxes,pcount,gcount,extend, + status) + FTPHTB(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,extname, > + status) + FTGHTB(unit,maxdim, > rowlen,nrows,tfields,ttype,tbcol,tform,tunit, + extname,status) + FTPHBN(unit,nrows,tfields,ttype,tform,tunit,extname,varidat > status) + FTGHBN(unit,maxdim, > nrows,tfields,ttype,tform,tunit,extname,varidat, + status) +\end{verbatim} + Write Keyword Subroutines: page~\pageref{FTPREC} + +\begin{verbatim} + FTPREC(unit,card, > status) + FTPCOM(unit,comment, > status) + FTPHIS(unit,history, > status) + FTPDAT(unit, > status) + FTPKY[JLS](unit,keyword,keyval,comment, > status) + FTPKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTPKLS(unit,keyword,keyval,comment, > status) + FTPLSW(unit, > status) + FTPKYU(unit,keyword,comment, > status) + FTPKN[JLS](unit,keyroot,startno,no_keys,keyvals,comments, > status) + FTPKN[EDFG](unit,keyroot,startno,no_keys,keyvals,decimals,comments, > + status) + FTCPKYinunit, outunit, innum, outnum, keyroot, > status) + FTPKYT(unit,keyword,intval,dblval,comment, > status) + FTPKTP(unit, filename, > status) + FTPUNT(unit,keyword,units, > status) +\end{verbatim} + Insert Keyword Subroutines: page~\pageref{FTIREC} + +\begin{verbatim} + FTIREC(unit,key_no,card, > status) + FTIKY[JLS](unit,keyword,keyval,comment, > status) + FTIKLS(unit,keyword,keyval,comment, > status) + FTIKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTIKYU(unit,keyword,comment, > status) +\end{verbatim} + Read Keyword Subroutines: page~\pageref{FTGREC} + +\begin{verbatim} + FTGREC(unit,key_no, > card,status) + FTGKYN(unit,key_no, > keyword,value,comment,status) + FTGCRD(unit,keyword, > card,status) + FTGNXK(unit,inclist,ninc,exclist,nexc, > card,status) + FTGKEY(unit,keyword, > value,comment,status) + FTGKY[EDJLS](unit,keyword, > keyval,comment,status) + FTGKN[EDJLS](unit,keyroot,startno,max_keys, > keyvals,nfound,status) + FTGKYT(unit,keyword, > intval,dblval,comment,status) + FTGUNT(unit,keyword, > units,status) +\end{verbatim} + Modify Keyword Subroutines: page~\pageref{FTMREC} + +\begin{verbatim} + FTMREC(unit,key_no,card, > status) + FTMCRD(unit,keyword,card, > status) + FTMNAM(unit,oldkey,keyword, > status) + FTMCOM(unit,keyword,comment, > status) + FTMKY[JLS](unit,keyword,keyval,comment, > status) + FTMKLS(unit,keyword,keyval,comment, > status) + FTMKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTMKYU(unit,keyword,comment, > status) +\end{verbatim} + Update Keyword Subroutines: page~\pageref{FTUCRD} + +\begin{verbatim} + FTUCRD(unit,keyword,card, > status) + FTUKY[JLS](unit,keyword,keyval,comment, > status) + FTUKLS(unit,keyword,keyval,comment, > status) + FTUKY[EDFG](unit,keyword,keyval,decimals,comment, > status) + FTUKYU(unit,keyword,comment, > status) +\end{verbatim} + Delete Keyword Subroutines: page~\pageref{FTDREC} + +\begin{verbatim} + FTDREC(unit,key_no, > status) + FTDKEY(unit,keyword, > status) +\end{verbatim} + Define Data Scaling Parameters and Undefined Pixel Flags: page~\pageref{FTPSCL} + +\begin{verbatim} + FTPSCL(unit,bscale,bzero, > status) + FTTSCL(unit,colnum,tscal,tzero, > status) + FTPNUL(unit,blank, > status) + FTSNUL(unit,colnum,snull > status) + FTTNUL(unit,colnum,tnull > status) +\end{verbatim} + FITS Primary Array or IMAGE Extension I/O Subroutines: page~\pageref{FTPPR} + +\begin{verbatim} + FTGIDT(unit, > bitpix,status) + FTGIET(unit, > bitpix,status) + FTGIDM(unit, > naxis,status) + FTGISZ(unit, maxdim, > naxes,status) + FTGIPR(unit, maxdim, > bitpix,naxis,naxes,status) + FTPPR[BIJED](unit,group,fpixel,nelements,values, > status) + FTPPN[BIJED](unit,group,fpixel,nelements,values,nullval > status) + FTPPRU(unit,group,fpixel,nelements, > status) + FTGPV[BIJED](unit,group,fpixel,nelements,nullval, > values,anyf,status) + FTGPF[BIJED](unit,group,fpixel,nelements, > values,flagvals,anyf,status) + FTPGP[BIJED](unit,group,fparm,nparm,values, > status) + FTGGP[BIJED](unit,group,fparm,nparm, > values,status) + FTP2D[BIJED](unit,group,dim1,naxis1,naxis2,image, > status) + FTP3D[BIJED](unit,group,dim1,dim2,naxis1,naxis2,naxis3,cube, > status) + FTG2D[BIJED](unit,group,nullval,dim1,naxis1,naxis2, > image,anyf,status) + FTG3D[BIJED](unit,group,nullval,dim1,dim2,naxis1,naxis2,naxis3, > + cube,anyf,status) + FTPSS[BIJED](unit,group,naxis,naxes,fpixels,lpixels,array, > status) + FTGSV[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) + FTGSF[BIJED](unit,group,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) +\end{verbatim} + Table Column Information Subroutines: page~\pageref{FTGCNO} + +\begin{verbatim} + FTGNRW(unit, > nrows, status) + FTGNCL(unit, > ncols, status) + FTGCNO(unit,casesen,coltemplate, > colnum,status) + FTGCNN(unit,casesen,coltemplate, > colnam,colnum,status) + FTGTCL(unit,colnum, > datacode,repeat,width,status) + FTEQTY(unit,colnum, > datacode,repeat,width,status) + FTGCDW(unit,colnum, > dispwidth,status) + FTGACL(unit,colnum, > + ttype,tbcol,tunit,tform,tscal,tzero,snull,tdisp,status) + FTGBCL(unit,colnum, > + ttype,tunit,datatype,repeat,tscal,tzero,tnull,tdisp,status) + FTPTDM(unit,colnum,naxis,naxes, > status) + FTGTDM(unit,colnum,maxdim, > naxis,naxes,status) + FTDTDM(unit,tdimstr,colnum,maxdim, > naxis,naxes, status) + FFGRSZ(unit, > nrows,status) +\end{verbatim} + Low-Level Table Access Subroutines: page~\pageref{FTGTBS} + +\begin{verbatim} + FTGTBS(unit,frow,startchar,nchars, > string,status) + FTPTBS(unit,frow,startchar,nchars,string, > status) + FTGTBB(unit,frow,startchar,nchars, > array,status) + FTPTBB(unit,frow,startchar,nchars,array, > status) +\end{verbatim} + Edit Rows or Columns page~\pageref{FTIROW} + +\begin{verbatim} + FTIROW(unit,frow,nrows, > status) + FTDROW(unit,frow,nrows, > status) + FTDRRG(unit,rowrange, > status) + FTDRWS(unit,rowlist,nrows, > status) + FTICOL(unit,colnum,ttype,tform, > status) + FTICLS(unit,colnum,ncols,ttype,tform, > status) + FTMVEC(unit,colnum,newveclen, > status) + FTDCOL(unit,colnum, > status) + FTCPCL(inunit,outunit,incolnum,outcolnum,createcol, > status); +\end{verbatim} + Read and Write Column Data Routines page~\pageref{FTPCLS} + +\begin{verbatim} + FTPCL[SLBIJEDCM](unit,colnum,frow,felem,nelements,values, > status) + FTPCN[BIJED](unit,colnum,frow,felem,nelements,values,nullval > status) + FTPCLX(unit,colnum,frow,fbit,nbit,lray, > status) + FTPCLU(unit,colnum,frow,felem,nelements, > status) + FTGCL(unit,colnum,frow,felem,nelements, > values,status) + FTGCV[SBIJEDCM](unit,colnum,frow,felem,nelements,nullval, > + values,anyf,status) + FTGCF[SLBIJEDCM](unit,colnum,frow,felem,nelements, > + values,flagvals,anyf,status) + FTGSV[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs,nullval, > + array,anyf,status) + FTGSF[BIJED](unit,colnum,naxis,naxes,fpixels,lpixels,incs, > + array,flagvals,anyf,status) + FTGCX(unit,colnum,frow,fbit,nbit, > lray,status) + FTGCX[IJD](unit,colnum,frow,nrows,fbit,nbit, > array,status) + FTGDES(unit,colnum,rownum, > nelements,offset,status) + FTPDES(unit,colnum,rownum,nelements,offset, > status) +\end{verbatim} + Row Selection and Calculator Routines: page~\pageref{FTFROW} + +\begin{verbatim} + FTFROW(unit,expr,firstrow, nrows, > n_good_rows, row_status, status) + FTFFRW(unit, expr, > rownum, status) + FTSROW(inunit, outunit, expr, > status ) + FTCROW(unit,datatype,expr,firstrow,nelements,nulval, > + array,anynul,status) + FTCALC(inunit, expr, outunit, parName, parInfo, > status) + FTCALC_RNG(inunit, expr, outunit, parName, parInfo, + nranges, firstrow, lastrow, > status) + FTTEXP(unit, expr, > datatype, nelem, naxis, naxes, status) +\end{verbatim} + Celestial Coordinate System Subroutines: page~\pageref{FTGICS} + +\begin{verbatim} + FTGICS(unit, > xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) + FTGTCS(unit,xcol,ycol, > + xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coordtype,status) + FTWLDP(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpos,ypos,status) + FTXYPX(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + coordtype, > xpix,ypix,status) +\end{verbatim} + File Checksum Subroutines: page~\pageref{FTPCKS} + +\begin{verbatim} + FTPCKS(unit, > status) + FTUCKS(unit, > status) + FTVCKS(unit, > dataok,hduok,status) + FTGCKS(unit, > datasum,hdusum,status) + FTESUM(sum,complement, > checksum) + FTDSUM(checksum,complement, > sum) + +\end{verbatim} + Time and Date Utility Subroutines: page~\pageref{FTGSDT} + +\begin{verbatim} + FTGSDT( > day, month, year, status ) + FTGSTM(> datestr, timeref, status) + FTDT2S( year, month, day, > datestr, status) + FTTM2S( year, month, day, hour, minute, second, decimals, + > datestr, status) + FTS2DT(datestr, > year, month, day, status) + FTS2TM(datestr, > year, month, day, hour, minute, second, status) +\end{verbatim} + General Utility Subroutines: page~\pageref{FTGHAD} + +\begin{verbatim} + FTGHAD(unit, > curaddr,nextaddr) + FTUPCH(string) + FTCMPS(str_template,string,casesen, > match,exact) + FTTKEY(keyword, > status) + FTTREC(card, > status) + FTNCHK(unit, > status) + FTGKNM(unit, > keyword, keylength, status) + FTPSVC(card, > value,comment,status) + FTKEYN(keyroot,seq_no, > keyword,status) + FTNKEY(seq_no,keyroot, > keyword,status) + FTDTYP(value, > dtype,status) + class = FTGKCL(card) + FTASFM(tform, > datacode,width,decimals,status) + FTBNFM(tform, > datacode,repeat,width,status) + FTGABC(tfields,tform,space, > rowlen,tbcol,status) + FTGTHD(template, > card,hdtype,status) + FTRWRG(rowlist, maxrows, maxranges, > numranges, rangemin, + rangemax, status) +\end{verbatim} + +\chapter{ Parameter Definitions } + +\begin{verbatim} +anyf - (logical) set to TRUE if any of the returned data values are undefined +array - (any datatype except character) array of bytes to be read or written. +bitpix - (integer) bits per pixel: 8, 16, 32, -32, or -64 +blank - (integer) value used for undefined pixels in integer primary array +blocksize - (integer) 2880-byte logical record blocking factor + (if 0 < blocksize < 11) or the actual block size in bytes + (if 10 < blocksize < 28800). As of version 3.3 of FITSIO, + blocksizes greater than 2880 are no longer supported. +bscale - (double precision) scaling factor for the primary array +bytlen - (integer) length of the data unit, in bytes +bzero - (double precision) zero point for primary array scaling +card - (character*80) header record to be read or written +casesen - (logical) will string matching be case sensitive? +checksum - (character*16) encoded checksum string +colname - (character) ASCII name of the column +colnum - (integer) number of the column (first column = 1) +coltemplate - (character) template string to be matched to column names +comment - (character) the keyword comment field +comments - (character array) keyword comment fields +compid - (integer) the type of computer that the program is running on +complement - (logical) should the checksum be complemented? +coordtype - (character) type of coordinate projection (-SIN, -TAN, -ARC, + -NCP, -GLS, -MER, or -AIT) +cube - 3D data cube of the appropriate datatype +curaddr - (integer) starting address (in bytes) of the CHDU +datacode - (integer) symbolic code of the binary table column datatype +dataok - (integer) was the data unit verification successful (=1) or + not (= -1). Equals zero if the DATASUM keyword is not present. +datasum - (double precision) 32-bit 1's complement checksum for the data unit +datatype - (character) datatype (format) of the binary table column +datestr - (string) FITS date/time string: 'YYYY-MM-DDThh:mm:ss.ddd', + 'YYYY-MM-dd', or 'dd/mm/yy' +day - (integer) current day of the month +dblval - (double precision) fractional part of the keyword value +decimals - (integer) number of decimal places to be displayed +dim1 - (integer) actual size of the first dimension of the image or cube array +dim2 - (integer) actual size of the second dimension of the cube array +dispwidth - (integer) - the display width (length of string) for a column +dtype - (character) datatype of the keyword ('C', 'L', 'I', or 'F') + C = character string + L = logical + I = integer + F = floating point number +errmsg - (character*80) oldest error message on the internal stack +errtext - (character*30) descriptive error message corresponding to error number +casesen - (logical) true if column name matching is case sensitive +exact - (logical) do the strings match exactly, or were wildcards used? +exclist (character array) list of names to be excluded from search +exists - flag indicating whether the file or compressed file exists on disk +extend - (logical) true if there may be extensions following the primary data +extname - (character) value of the EXTNAME keyword (if not blank) +fbit - (integer) first bit in the field to be read or written +felem - (integer) first pixel of the element vector (ignored for ASCII tables) +filename - (character) name of the FITS file +flagvals - (logical array) True if corresponding data element is undefined +fparm - (integer) sequence number of the first group parameter to read or write +fpixel - (integer) the first pixel position +fpixels - (integer array) the first included pixel in each dimension +frow - (integer) beginning row number (first row of table = 1) +gcount - (integer) value of the GCOUNT keyword (usually = 1) +group - (integer) sequence number of the data group (=0 for non-grouped data) +hdtype - (integer) header record type: -1=delete; 0=append or replace; + 1=append; 2=this is the END keyword +hduok - (integer) was the HDU verification successful (=1) or + not (= -1). Equals zero if the CHECKSUM keyword is not present. +hdusum - (double precision) 32 bit 1's complement checksum for the entire CHDU +hdutype - (integer) type of HDU: 0 = primary array or IMAGE, 1 = ASCII table, + 2 = binary table, -1 = unknown +history - (character) the HISTORY keyword comment string +hour - (integer) hour from 0 - 23 +image - 2D image of the appropriate datatype +inclist (character array) list of names to be included in search +incs - (integer array) sampling interval for pixels in each FITS dimension +intval - (integer) integer part of the keyword value +iounit - (integer) value of an unused I/O unit number +iunit - (integer) logical unit number associated with the input FITS file, 1-199 +key_no - (integer) sequence number (starting with 1) of the keyword record +keylength - (integer) length of the keyword name +keyroot - (character) root string for the keyword name +keysadd -(integer) number of new keyword records which can fit in the CHU +keysexist - (integer) number of existing keyword records in the CHU +keyval - value of the keyword in the appropriate datatype +keyvals - (array) value of the keywords in the appropriate datatype +keyword - (character*8) name of a keyword +lray - (logical array) array of logical values corresponding to the bit array +lpixels - (integer array) the last included pixel in each dimension +match - (logical) do the 2 strings match? +maxdim - (integer) dimensioned size of the NAXES, TTYPE, TFORM or TUNIT arrays +max_keys - (integer) maximum number of keywords to search for +minute - (integer) minute of an hour (0 - 59) +month - (integer) current month of the year (1 - 12) +morekeys - (integer) will leave space in the header for this many more keywords +naxes - (integer array) size of each dimension in the FITS array +naxis - (integer) number of dimensions in the FITS array +naxis1 - (integer) length of the X/first axis of the FITS array +naxis2 - (integer) length of the Y/second axis of the FITS array +naxis3 - (integer) length of the Z/third axis of the FITS array +nbit - (integer) number of bits in the field to read or write +nchars - (integer) number of characters to read and return +ncols - (integer) number of columns +nelements - (integer) number of data elements to read or write +nexc (integer) number of names in the exclusion list (may = 0) +nhdu - (integer) absolute number of the HDU (1st HDU = 1) +ninc (integer) number of names in the inclusion list +nmove - (integer) number of HDUs to move (+ or -), relative to current position +nfound - (integer) number of keywords found (highest keyword number) +no_keys - (integer) number of keywords to write in the sequence +nparm - (integer) number of group parameters to read or write +nrows - (integer) number of rows in the table +nullval - value to represent undefined pixels, of the appropriate datatype +nextaddr - (integer) starting address (in bytes) of the HDU following the CHDU +offset - (integer) byte offset in the heap to the first element of the array +oldkey - (character) old name of keyword to be modified +ounit - (integer) logical unit number associated with the output FITS file 1-199 +pcount - (integer) value of the PCOUNT keyword (usually = 0) +repeat - (integer) length of element vector (e.g. 12J); ignored for ASCII table +rot - (double precision) celestial coordinate rotation angle (degrees) +rowlen - (integer) length of a table row, in characters or bytes +rowlist - (integer array) list of row numbers to be deleted in increasing order +rownum - (integer) number of the row (first row = 1) +rowrange- (string) list of rows or row ranges to be deleted +rwmode - (integer) file access mode: 0 = readonly, 1 = readwrite +second (double)- second within minute (0 - 60.9999999999) (leap second!) +seq_no - (integer) the sequence number to append to the keyword root name +simple - (logical) does the FITS file conform to all the FITS standards +snull - (character) value used to represent undefined values in ASCII table +space - (integer) number of blank spaces to leave between ASCII table columns +startchar - (integer) first character in the row to be read +startno - (integer) value of the first keyword sequence number (usually 1) +status - (integer) returned error status code (0 = OK) +str_template (character) template string to be matched to reference string +stream - (character) output stream for the report: either 'STDOUT' or 'STDERR' +string - (character) character string +sum - (double precision) 32 bit unsigned checksum value +tbcol - (integer array) column number of the first character in the field(s) +tdisp - (character) Fortran type display format for the table column +template-(character) template string for a FITS header record +tfields - (integer) number of fields (columns) in the table +tform - (character array) format of the column(s); allowed values are: + For ASCII tables: Iw, Aw, Fww.dd, Eww.dd, or Dww.dd + For binary tables: rL, rX, rB, rI, rJ, rA, rAw, rE, rD, rC, rM + where 'w'=width of the field, 'd'=no. of decimals, 'r'=repeat count + Note that the 'rAw' form is non-standard extension to the + TFORM keyword syntax that is not specifically defined in the + Binary Tables definition document. +theap - (integer) zero indexed byte offset of starting address of the heap + relative to the beginning of the binary table data +tnull - (integer) value used to represent undefined values in binary table +ttype - (character array) label for table column(s) +tscal - (double precision) scaling factor for table column +tunit - (character array) physical unit for table column(s) +tzero - (double precision) scaling zero point for table column +unit - (integer) logical unit number associated with the FITS file (1-199) +units - (character) the keyword units string (e.g., 'km/s') +value - (character) the keyword value string +values - array of data values of the appropriate datatype +varidat - (integer) size in bytes of the 'variable length data area' + following the binary table data (usually = 0) +version - (real) current revision number of the library +width - (integer) width of the character string field +xcol - (integer) number of the column containing the X coordinate values +xinc - (double precision) X axis coordinate increment at reference pixel (deg) +xpix - (double precision) X axis pixel location +xpos - (double precision) X axis celestial coordinate (usually RA) (deg) +xrpix - (double precision) X axis reference pixel array location +xrval - (double precision) X axis coordinate value at the reference pixel (deg) +ycol - (integer) number of the column containing the X coordinate values +year - (integer) last 2 digits of the year (00 - 99) +yinc - (double precision) Y axis coordinate increment at reference pixel (deg) +ypix - (double precision) y axis pixel location +ypos - (double precision) y axis celestial coordinate (usually DEC) (deg) +yrpix - (double precision) Y axis reference pixel array location +yrval - (double precision) Y axis coordinate value at the reference pixel (deg) +\end{verbatim} + +\chapter{ FITSIO Error Status Codes } + +\begin{verbatim} +Status codes in the range -99 to -999 and 1 to 999 are reserved for future +FITSIO use. + + 0 OK, no error +101 input and output files are the same +103 too many FITS files open at once; all internal buffers full +104 error opening existing file +105 error creating new FITS file; (does a file with this name already exist?) +106 error writing record to FITS file +107 end-of-file encountered while reading record from FITS file +108 error reading record from file +110 error closing FITS file +111 internal array dimensions exceeded +112 Cannot modify file with readonly access +113 Could not allocate memory +114 illegal logical unit number; must be between 1 - 199, inclusive +115 NULL input pointer to routine +116 error seeking position in file + +121 invalid URL prefix on file name +122 tried to register too many IO drivers +123 driver initialization failed +124 matching driver is not registered +125 failed to parse input file URL +126 parse error in range list + +151 bad argument in shared memory driver +152 null pointer passed as an argument +153 no more free shared memory handles +154 shared memory driver is not initialized +155 IPC error returned by a system call +156 no memory in shared memory driver +157 resource deadlock would occur +158 attempt to open/create lock file failed +159 shared memory block cannot be resized at the moment + + +201 header not empty; can't write required keywords +202 specified keyword name was not found in the header +203 specified header record number is out of bounds +204 keyword value field is blank +205 keyword value string is missing the closing quote character +207 illegal character in keyword name or header record +208 keyword does not have expected name. Keyword out of sequence? +209 keyword does not have expected integer value +210 could not find the required END header keyword +211 illegal BITPIX keyword value +212 illegal NAXIS keyword value +213 illegal NAXISn keyword value: must be 0 or positive integer +214 illegal PCOUNT keyword value +215 illegal GCOUNT keyword value +216 illegal TFIELDS keyword value +217 negative ASCII or binary table width value (NAXIS1) +218 negative number of rows in ASCII or binary table (NAXIS2) +219 column name (TTYPE keyword) not found +220 illegal SIMPLE keyword value +221 could not find the required SIMPLE header keyword +222 could not find the required BITPIX header keyword +223 could not find the required NAXIS header keyword +224 could not find all the required NAXISn keywords in the header +225 could not find the required XTENSION header keyword +226 the CHDU is not an ASCII table extension +227 the CHDU is not a binary table extension +228 could not find the required PCOUNT header keyword +229 could not find the required GCOUNT header keyword +230 could not find the required TFIELDS header keyword +231 could not find all the required TBCOLn keywords in the header +232 could not find all the required TFORMn keywords in the header +233 the CHDU is not an IMAGE extension +234 illegal TBCOL keyword value; out of range +235 this operation only allowed for ASCII or BINARY table extension +236 column is too wide to fit within the specified width of the ASCII table +237 the specified column name template matched more than one column name +241 binary table row width is not equal to the sum of the field widths +251 unrecognizable type of FITS extension +252 unrecognizable FITS record +253 END keyword contains non-blank characters in columns 9-80 +254 Header fill area contains non-blank characters +255 Data fill area contains non-blank on non-zero values +261 unable to parse the TFORM keyword value string +262 unrecognizable TFORM datatype code +263 illegal TDIMn keyword value + +301 illegal HDU number; less than 1 or greater than internal buffer size +302 column number out of range (1 - 999) +304 attempt to move to negative file record number +306 attempted to read or write a negative number of bytes in the FITS file +307 illegal starting row number for table read or write operation +308 illegal starting element number for table read or write operation +309 attempted to read or write character string in non-character table column +310 attempted to read or write logical value in non-logical table column +311 illegal ASCII table TFORM format code for attempted operation +312 illegal binary table TFORM format code for attempted operation +314 value for undefined pixels has not been defined +317 attempted to read or write descriptor in a non-descriptor field +320 number of array dimensions out of range +321 first pixel number is greater than the last pixel number +322 attempt to set BSCALE or TSCALn scaling parameter = 0 +323 illegal axis length less than 1 + +340 NOT_GROUP_TABLE 340 Grouping function error +341 HDU_ALREADY_MEMBER +342 MEMBER_NOT_FOUND +343 GROUP_NOT_FOUND +344 BAD_GROUP_ID +345 TOO_MANY_HDUS_TRACKED +346 HDU_ALREADY_TRACKED +347 BAD_OPTION +348 IDENTICAL_POINTERS +349 BAD_GROUP_ATTACH +350 BAD_GROUP_DETACH + +360 NGP_NO_MEMORY malloc failed +361 NGP_READ_ERR read error from file +362 NGP_NUL_PTR null pointer passed as an argument. + Passing null pointer as a name of + template file raises this error +363 NGP_EMPTY_CURLINE line read seems to be empty (used + internally) +364 NGP_UNREAD_QUEUE_FULL cannot unread more then 1 line (or single + line twice) +365 NGP_INC_NESTING too deep include file nesting (infinite + loop, template includes itself ?) +366 NGP_ERR_FOPEN fopen() failed, cannot open template file +367 NGP_EOF end of file encountered and not expected +368 NGP_BAD_ARG bad arguments passed. Usually means + internal parser error. Should not happen +369 NGP_TOKEN_NOT_EXPECT token not expected here + +401 error attempting to convert an integer to a formatted character string +402 error attempting to convert a real value to a formatted character string +403 cannot convert a quoted string keyword to an integer +404 attempted to read a non-logical keyword value as a logical value +405 cannot convert a quoted string keyword to a real value +406 cannot convert a quoted string keyword to a double precision value +407 error attempting to read character string as an integer +408 error attempting to read character string as a real value +409 error attempting to read character string as a double precision value +410 bad keyword datatype code +411 illegal number of decimal places while formatting floating point value +412 numerical overflow during implicit datatype conversion +413 error compressing image +414 error uncompressing image +420 error in date or time conversion + +431 syntax error in parser expression +432 expression did not evaluate to desired type +433 vector result too large to return in array +434 data parser failed not sent an out column +435 bad data encounter while parsing column +436 parse error: output file not of proper type + +501 celestial angle too large for projection +502 bad celestial coordinate or pixel value +503 error in celestial coordinate calculation +504 unsupported type of celestial projection +505 required celestial coordinate keywords not found +506 approximate wcs keyword values were returned +\end{verbatim} +\end{document} diff --git a/pkg/tbtables/cfitsio/fitsio.toc b/pkg/tbtables/cfitsio/fitsio.toc new file mode 100644 index 00000000..2f800381 --- /dev/null +++ b/pkg/tbtables/cfitsio/fitsio.toc @@ -0,0 +1,90 @@ +\contentsline {chapter}{\numberline {1}Introduction }{1} +\contentsline {chapter}{\numberline {2} Creating FITSIO/CFITSIO }{3} +\contentsline {section}{\numberline {2.1}Building the Library}{3} +\contentsline {section}{\numberline {2.2}Testing the Library}{6} +\contentsline {section}{\numberline {2.3}Linking Programs with FITSIO}{7} +\contentsline {section}{\numberline {2.4}Getting Started with FITSIO}{8} +\contentsline {section}{\numberline {2.5}Example Program}{8} +\contentsline {section}{\numberline {2.6}Legal Stuff}{9} +\contentsline {section}{\numberline {2.7}Acknowledgements}{10} +\contentsline {chapter}{\numberline {3} A FITS Primer }{13} +\contentsline {chapter}{\numberline {4} Extended File Name Syntax }{15} +\contentsline {section}{\numberline {4.1}Overview}{15} +\contentsline {section}{\numberline {4.2}Filetype}{18} +\contentsline {subsection}{\numberline {4.2.1}Notes about HTTP proxy servers}{18} +\contentsline {subsection}{\numberline {4.2.2}Notes about the root filetype}{18} +\contentsline {subsection}{\numberline {4.2.3}Notes about the shmem filetype:}{20} +\contentsline {section}{\numberline {4.3}Base Filename}{21} +\contentsline {section}{\numberline {4.4}Output File Name when Opening an Existing File}{23} +\contentsline {section}{\numberline {4.5}Template File Name when Creating a New File}{24} +\contentsline {section}{\numberline {4.6}HDU Location Specification}{24} +\contentsline {section}{\numberline {4.7}Image Section}{25} +\contentsline {section}{\numberline {4.8}Column and Keyword Filtering Specification}{26} +\contentsline {section}{\numberline {4.9}Row Filtering Specification}{28} +\contentsline {subsection}{\numberline {4.9.1}General Syntax}{28} +\contentsline {subsection}{\numberline {4.9.2}Bit Masks}{30} +\contentsline {subsection}{\numberline {4.9.3}Vector Columns}{31} +\contentsline {subsection}{\numberline {4.9.4}Good Time Interval Filtering}{33} +\contentsline {subsection}{\numberline {4.9.5}Spatial Region Filtering}{33} +\contentsline {subsection}{\numberline {4.9.6}Example Row Filters}{36} +\contentsline {section}{\numberline {4.10} Binning or Histogramming Specification}{37} +\contentsline {chapter}{\numberline {5}Template Files }{41} +\contentsline {section}{\numberline {5.1}Detailed Template Line Format}{41} +\contentsline {section}{\numberline {5.2}Auto-indexing of Keywords}{42} +\contentsline {section}{\numberline {5.3}Template Parser Directives}{43} +\contentsline {section}{\numberline {5.4}Formal Template Syntax}{43} +\contentsline {section}{\numberline {5.5}Errors}{44} +\contentsline {section}{\numberline {5.6}Examples}{44} +\contentsline {chapter}{\numberline {6}FITSIO Conventions and Guidelines }{47} +\contentsline {section}{\numberline {6.1}CFITSIO Size Limitations}{47} +\contentsline {section}{\numberline {6.2}Multiple Access to the Same FITS File}{48} +\contentsline {section}{\numberline {6.3}Current Header Data Unit (CHDU)}{48} +\contentsline {section}{\numberline {6.4}Subroutine Names}{48} +\contentsline {section}{\numberline {6.5}Subroutine Families and Datatypes}{49} +\contentsline {section}{\numberline {6.6}Implicit Data Type Conversion}{50} +\contentsline {section}{\numberline {6.7}Data Scaling}{50} +\contentsline {section}{\numberline {6.8}Error Status Values and the Error Message Stack}{51} +\contentsline {section}{\numberline {6.9}Variable-Length Array Facility in Binary Tables}{51} +\contentsline {section}{\numberline {6.10}Support for IEEE Special Values}{52} +\contentsline {section}{\numberline {6.11}When the Final Size of the FITS HDU is Unknown}{53} +\contentsline {section}{\numberline {6.12}Local FITS Conventions supported by FITSIO}{53} +\contentsline {subsection}{\numberline {6.12.1}Support for Long String Keyword Values.}{54} +\contentsline {subsection}{\numberline {6.12.2}Arrays of Fixed-Length Strings in Binary Tables}{54} +\contentsline {subsection}{\numberline {6.12.3}Keyword Units Strings}{55} +\contentsline {subsection}{\numberline {6.12.4}HIERARCH Convention for Extended Keyword Names}{55} +\contentsline {section}{\numberline {6.13}Optimizing Code for Maximum Processing Speed}{56} +\contentsline {subsection}{\numberline {6.13.1}Background Information: How CFITSIO Manages Data I/O}{57} +\contentsline {chapter}{\numberline {7} The CFITSIO Iterator Function }{61} +\contentsline {chapter}{\numberline {8} Basic Interface Routines }{63} +\contentsline {section}{\numberline {8.1}FITSIO Error Status Routines }{63} +\contentsline {section}{\numberline {8.2}File I/O Routines}{64} +\contentsline {section}{\numberline {8.3}Keyword I/O Routines}{66} +\contentsline {section}{\numberline {8.4}Data I/O Routines}{66} +\contentsline {chapter}{\numberline {9} Advanced Interface Subroutines }{69} +\contentsline {section}{\numberline {9.1}FITS File Open and Close Subroutines: }{69} +\contentsline {section}{\numberline {9.2}HDU-Level Operations }{72} +\contentsline {section}{\numberline {9.3}Define or Redefine the structure of the CHDU }{75} +\contentsline {section}{\numberline {9.4}FITS Header I/O Subroutines}{76} +\contentsline {subsection}{\numberline {9.4.1}Header Space and Position Routines }{76} +\contentsline {subsection}{\numberline {9.4.2}Read or Write Standard Header Routines }{77} +\contentsline {subsection}{\numberline {9.4.3}Write Keyword Subroutines }{78} +\contentsline {subsection}{\numberline {9.4.4}Insert Keyword Subroutines }{80} +\contentsline {subsection}{\numberline {9.4.5}Read Keyword Subroutines }{81} +\contentsline {subsection}{\numberline {9.4.6}Modify Keyword Subroutines }{82} +\contentsline {subsection}{\numberline {9.4.7}Update Keyword Subroutines }{83} +\contentsline {subsection}{\numberline {9.4.8}Delete Keyword Subroutines }{84} +\contentsline {section}{\numberline {9.5}Data Scaling and Undefined Pixel Parameters }{84} +\contentsline {section}{\numberline {9.6}FITS Primary Array or IMAGE Extension I/O Subroutines }{85} +\contentsline {section}{\numberline {9.7}FITS ASCII and Binary Table Data I/O Subroutines}{88} +\contentsline {subsection}{\numberline {9.7.1}Column Information Subroutines }{88} +\contentsline {subsection}{\numberline {9.7.2}Low-Level Table Access Subroutines }{91} +\contentsline {subsection}{\numberline {9.7.3}Edit Rows or Columns }{92} +\contentsline {subsection}{\numberline {9.7.4}Read and Write Column Data Routines }{93} +\contentsline {section}{\numberline {9.8}Row Selection and Calculator Routines }{96} +\contentsline {section}{\numberline {9.9}Celestial Coordinate System Subroutines }{98} +\contentsline {section}{\numberline {9.10}File Checksum Subroutines }{99} +\contentsline {section}{\numberline {9.11} Date and Time Utility Routines }{101} +\contentsline {section}{\numberline {9.12}General Utility Subroutines }{102} +\contentsline {chapter}{\numberline {10} Summary of all FITSIO User-Interface Subroutines }{109} +\contentsline {chapter}{\numberline {11} Parameter Definitions }{117} +\contentsline {chapter}{\numberline {12} FITSIO Error Status Codes }{123} diff --git a/pkg/tbtables/cfitsio/fitsio2.h b/pkg/tbtables/cfitsio/fitsio2.h new file mode 100644 index 00000000..6910a57e --- /dev/null +++ b/pkg/tbtables/cfitsio/fitsio2.h @@ -0,0 +1,1135 @@ +#ifndef _FITSIO2_H +#define _FITSIO2_H + +#include "fitsio.h" + +/* Setting SUPPORT_64_BIT_INTEGERS to 1 will enable CFITSIO to read */ +/* and write images with BITPIX = 64 and binary table columns with */ +/* TFORMn = 'K'. Otherwise, setting SUPPORT_64_BIT_INTEGERS to 0 */ +/* will cause CFITSIO to not recognize these non-standard 64-bit */ +/* FITS datatypes. */ + +#define SUPPORT_64BIT_INTEGERS 1 + +/* + If REPLACE_LINKS is defined, then whenever CFITSIO fails to open + a file with write access because it is a soft link to a file that + only has read access, then CFITSIO will attempt to replace + the link with a local copy of the file, with write access. This + feature was originally added to support the ftools in the Hera + environment, where many of the user's data file are soft links. +*/ +#if defined(BUILD_HERA) +#define REPLACE_LINKS 1 +#endif + +#define USE_LARGE_VALUE -99 /* flag used when writing images */ + +#define DBUFFSIZE 28800 /* size of data buffer in bytes */ + +#define NIOBUF 40 /* number of IO buffers to create */ + /* !! Significantly increasing NIOBUF may degrade performance !! */ +#define NMAXFILES 300 /* maximum number of FITS files that can be opened */ + /* CFITSIO will allocate (NMAXFILES * 80) bytes of memory */ + +#define IOBUFLEN 2880 /* size in bytes of each IO buffer (DONT CHANGE!) */ +#define MINDIRECT 8640 /* minimum size for direct reads and writes */ + /* MINDIRECT must have a value >= 8640 */ + +#define NATIVE 0 /* a generic machine that uses IEEE formats */ +#define ULTRIX 1 +#define ALPHA_OSF 2 +#define VAXVMS 3 +#define ALPHAVMS 4 +#define IBMPC 5 +#define CRAY 6 +#define PC64BIT 7 + +#define GFLOAT 1 +#define IEEEFLOAT 2 + +/* the following are used to determine what type machine we are running on */ + +/* the following block determines the size of longs on SGI IRIX machines */ +#if defined(_MIPS_SZLONG) +# if _MIPS_SZLONG == 32 +# define LONGSIZE 32 +# elif _MIPS_SZLONG == 64 +# define LONGSIZE 64 +# else +# error "can't handle long size given by _MIPS_SZLONG" +# endif +#endif + +#if defined(vax) && defined(VMS) + +#define MACHINE VAXVMS +#define BYTESWAPPED TRUE + +#elif defined(__alpha) && defined(__VMS) + +#if (__D_FLOAT == TRUE) + +/* this float option is the same as for VAX/VMS machines. */ +#define MACHINE VAXVMS +#define BYTESWAPPED TRUE + +#elif (__G_FLOAT == TRUE) + +/* G_FLOAT is the default for ALPHA VMS systems */ +#define MACHINE ALPHAVMS +#define BYTESWAPPED TRUE +#define FLOATTYPE GFLOAT + +#elif (__IEEE_FLOAT == TRUE) + +#define MACHINE ALPHAVMS +#define BYTESWAPPED TRUE +#define FLOATTYPE IEEEFLOAT + +#endif + +#elif defined(__alpha) && ( defined(__unix__) || defined(__NetBSD__) ) + +#define MACHINE ALPHA_OSF +#define BYTESWAPPED TRUE +#define LONGSIZE 64 + +#elif defined(ultrix) && defined(unix) + +#define MACHINE ULTRIX +#define BYTESWAPPED TRUE + +#elif defined(__sparcv9) + +/* SUN Solaris7 in 64-bit mode */ +#define BYTESWAPPED FALSE +#define MACHINE NATIVE +#define LONGSIZE 64 + +#elif defined(__i386) || defined(__i386__) || defined(__i486__) || defined(__i586__) + +/* IBM PC */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(_MSC_VER) || defined(__BORLANDC__) || defined(__TURBOC__) + +/* IBM PC running DOS or Windows */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(_NI_mswin_) || defined(__EMX__) + +/* LabWindows/CVI with Windows, or PC runnin OS/2 */ +#define MACHINE IBMPC +#define BYTESWAPPED TRUE + +#elif defined(__ia64__) || defined(__x86_64__) + +/* Intel itanium 64-bit PC, or AMD opteron 64-bit PC */ +#define BYTESWAPPED TRUE +#define MACHINE PC64BIT +#define LONGSIZE 64 + +#else + +/* assume machine uses the same IEEE formats as used in FITS files */ +#define MACHINE NATIVE +#define BYTESWAPPED FALSE + +#endif + +/* assume longs are 4 bytes long, unless previously set otherwise */ +#ifndef LONGSIZE +#define LONGSIZE 32 +#endif + +#define IGNORE_EOF 1 +#define REPORT_EOF 0 +#define DATA_UNDEFINED -1 +#define NULL_UNDEFINED 1234554321 +#define ASCII_NULL_UNDEFINED 1 /* indicate no defined null value */ + +#define maxvalue(A,B) ((A) > (B) ? (A) : (B)) +#define minvalue(A,B) ((A) < (B) ? (A) : (B)) + +/* faster string comparison macros */ +#define FSTRCMP(a,b) ((a)[0]<(b)[0]? -1:(a)[0]>(b)[0]?1:strcmp((a),(b))) +#define FSTRNCMP(a,b,n) ((a)[0]<(b)[0]?-1:(a)[0]>(b)[0]?1:strncmp((a),(b),(n))) + +#if defined(__VMS) || defined(VMS) + +#define FNANMASK 0xFFFF /* mask all bits */ +#define DNANMASK 0xFFFF /* mask all bits */ + +#else + +#define FNANMASK 0x7F80 /* mask bits 1 - 8; all set on NaNs */ + /* all 0 on underflow or 0. */ + +#define DNANMASK 0x7FF0 /* mask bits 1 - 11; all set on NaNs */ + /* all 0 on underflow or 0. */ + +#endif + +#if MACHINE == CRAY + /* + Cray machines: the large negative integer corresponds + to the 3 most sig digits set to 1. If these + 3 bits are set in a floating point number (64 bits), then it represents + a reserved value (i.e., a NaN) + */ +#define fnan(L) ( (L) >= 0xE000000000000000 ? 1 : 0) ) + +#else + /* these functions work for both big and little endian machines */ + /* that use the IEEE floating point format for internal numbers */ + + /* These functions tests whether the float value is a reserved IEEE */ + /* value such as a Not-a-Number (NaN), or underflow, overflow, or */ + /* infinity. The functions returns 1 if the value is a NaN, overflow */ + /* or infinity; it returns 2 if the value is an denormalized underflow */ + /* value; otherwise it returns 0. fnan tests floats, dnan tests doubles */ + +#define fnan(L) \ + ( (L & FNANMASK) == FNANMASK ? 1 : (L & FNANMASK) == 0 ? 2 : 0) + +#define dnan(L) \ + ( (L & DNANMASK) == DNANMASK ? 1 : (L & DNANMASK) == 0 ? 2 : 0) + +#endif + +#define DSCHAR_MAX 127.49 /* max double value that fits in an signed char */ +#define DSCHAR_MIN -128.49 /* min double value that fits in an signed char */ +#define DUCHAR_MAX 255.49 /* max double value that fits in an unsigned char */ +#define DUCHAR_MIN -0.49 /* min double value that fits in an unsigned char */ +#define DUSHRT_MAX 65535.49 /* max double value that fits in a unsigned short*/ +#define DUSHRT_MIN -0.49 /* min double value that fits in an unsigned short */ +#define DSHRT_MAX 32767.49 /* max double value that fits in a short */ +#define DSHRT_MIN -32768.49 /* min double value that fits in a short */ + +#if LONGSIZE == 32 +# define DLONG_MAX 2147483647.49 /* max double value that fits in a long */ +# define DLONG_MIN -2147483648.49 /* min double value that fits in a long */ +# define DULONG_MAX 4294967295.49 /* max double that fits in a unsigned long */ +#else +# define DLONG_MAX 9.2233720368547752E18 /* max double value long */ +# define DLONG_MIN -9.2233720368547752E18 /* min double value long */ +# define DULONG_MAX 1.84467440737095504E19 /* max double value ulong */ +#endif + +#define DULONG_MIN -0.49 /* min double value that fits in an unsigned long */ +#define DLONGLONG_MAX 9.2233720368547752E18 /* max double value longlong */ +#define DLONGLONG_MIN -9.2233720368547752E18 /* min double value longlong */ +#define DUINT_MAX 4294967295.49 /* max dbl that fits in a unsigned 4-byte int */ +#define DUINT_MIN -0.49 /* min dbl that fits in an unsigned 4-byte int */ +#define DINT_MAX 2147483647.49 /* max double value that fits in a 4-byte int */ +#define DINT_MIN -2147483648.49 /* min double value that fits in a 4-byte int */ + +#ifndef UINT32_MAX +#define UINT32_MAX 4294967295U /* max unsigned 32-bit integer */ +#endif +#ifndef INT32_MAX +#define INT32_MAX 2147483647 /* max 32-bit integer */ +#endif +#ifndef INT32_MIN +#define INT32_MIN (-INT32_MAX -1) /* min 32-bit integer */ +#endif + +#ifndef LONGLONG_MAX + +#ifdef LLONG_MAX +/* Linux and Solaris definition */ +#define LONGLONG_MAX LLONG_MAX +#define LONGLONG_MIN LLONG_MIN + +#elif defined(LONG_LONG_MAX) +#define LONGLONG_MAX LONG_LONG_MAX +#define LONGLONG_MIN LONG_LONG_MIN + +#elif defined(__LONG_LONG_MAX__) +/* Mac OS X & CYGWIN defintion */ +#define LONGLONG_MAX __LONG_LONG_MAX__ +#define LONGLONG_MIN (-LONGLONG_MAX -1LL) + +#elif defined(INT64_MAX) +/* windows definition */ +#define LONGLONG_MAX INT64_MAX +#define LONGLONG_MIN INT64_MIN + +#elif defined(_I64_MAX) +/* windows definition */ +#define LONGLONG_MAX _I64_MAX +#define LONGLONG_MIN _I64_MIN + +#elif defined(HAVE_LONGLONG) +/* compiler has a 'long long' or equivalent type */ +#define LONGLONG_MAX 9223372036854775807LL /* max 64-bit integer */ +#define LONGLONG_MIN (-LONGLONG_MAX -1LL) /* min 64-bit integer */ + +#elif (LONGSIZE == 64) +/* Compiler may not have a 'long long' type, but sizeof(long) = 64 */ +#define LONGLONG_MAX 9223372036854775807L /* max 64-bit integer */ +#define LONGLONG_MIN (-LONGLONG_MAX -1L) /* min 64-bit integer */ + +#else +/* define a default value, even if it is never used */ +#define LONGLONG_MAX LONG_MAX +#define LONGLONG_MIN LONG_MIN +#endif +#endif /* end of ndef LONGLONG_MAX section */ + + +#define COMPRESS_NULL_VALUE -2147483647 + +int ffmkky(char *keyname, char *keyval, char *comm, char *card, int *status); +int ffgnky(fitsfile *fptr, char *card, int *status); +void ffcfmt(char *tform, char *cform); +void ffcdsp(char *tform, char *cform); +void ffswap2(short *values, long nvalues); +void ffswap4(INT32BIT *values, long nvalues); +void ffswap8(double *values, long nvalues); +int ffi2c(long ival, char *cval, int *status); +int ffl2c(int lval, char *cval, int *status); +int ffs2c(char *instr, char *outstr, int *status); +int ffr2f(float fval, int decim, char *cval, int *status); +int ffr2e(float fval, int decim, char *cval, int *status); +int ffd2f(double dval, int decim, char *cval, int *status); +int ffd2e(double dval, int decim, char *cval, int *status); +int ffc2ii(char *cval, long *ival, int *status); +int ffc2ll(char *cval, int *lval, int *status); +int ffc2rr(char *cval, float *fval, int *status); +int ffc2dd(char *cval, double *dval, int *status); +int ffc2x(char *cval, char *dtype, long *ival, int *lval, char *sval, + double *dval, int *status); +int ffc2s(char *instr, char *outstr, int *status); +int ffc2i(char *cval, long *ival, int *status); +int ffc2r(char *cval, float *fval, int *status); +int ffc2d(char *cval, double *dval, int *status); +int ffc2l(char *cval, int *lval, int *status); +void ffxmsg(int action, char *err_message); +int ffgcnt(fitsfile *fptr, char *value, int *status); +int ffgtkn(fitsfile *fptr, int numkey, char *keyname, long *value, int *status); +int fftkyn(fitsfile *fptr, int numkey, char *keyname, char *value, int *status); +int ffgphd(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis, + long naxes[], long *pcount, long *gcount, int *extend, double *bscale, + double *bzero, long *blank, int *nspace, int *status); +int ffgttb(fitsfile *fptr, long *rowlen, long *nrows, long *pcount, + long *tfield, int *status); + +int ffmkey(fitsfile *fptr, char *card, int *status); + +int ffmbyt(fitsfile *fptr, OFF_T bytpos, int ignore_err, int *status); +int ffgbyt(fitsfile *fptr, long nbytes, void *buffer, int *status); +int ffpbyt(fitsfile *fptr, long nbytes, void *buffer, int *status); +int ffgbytoff(fitsfile *fptr, long gsize, long ngroups, long offset, + void *buffer, int *status); +int ffpbytoff(fitsfile *fptr, long gsize, long ngroups, long offset, + void *buffer, int *status); +int ffldrc(fitsfile *fptr, long record, int err_mode, int *status); +int ffwhbf(fitsfile *fptr, int *nbuff); +int ffbfeof(fitsfile *fptr, int *status); +int ffbfwt(int nbuff, int *status); +int fits_get_num_files(void); +int ffpxsz(int datatype); + +int ffourl(char *url, char *urltype, char *outfile, char *tmplfile, + char *compspec, int *status); +int ffparsecompspec(fitsfile *fptr, char *compspec, int *status); +int ffoptplt(fitsfile *fptr, const char *tempname, int *status); +int fits_is_this_a_copy(char *urltype); +int fits_store_Fptr(FITSfile *Fptr, int *status); +int fits_clear_Fptr(FITSfile *Fptr, int *status); +int fits_already_open(fitsfile **fptr, char *url, + char *urltype, char *infile, char *extspec, char *rowfilter, + char *binspec, char *colspec, int mode,int *isopen, int *status); +int ffedit_columns(fitsfile **fptr, char *outfile, char *expr, int *status); +int fits_get_col_minmax(fitsfile *fptr, int colnum, float *datamin, + float *datamax, int *status); +int ffwritehisto(long totaln, long offset, long firstn, long nvalues, + int narrays, iteratorCol *imagepars, void *userPointer); +int ffcalchist(long totalrows, long offset, long firstrow, long nrows, + int ncols, iteratorCol *colpars, void *userPointer); +int fits_copy_image_cell(fitsfile **fptr, char *outfile, char *colname, + long rownum, int *status); +int fits_copy_image_keywords(fitsfile *infptr, fitsfile *outfptr, int *status); +int ffrhdu(fitsfile *fptr, int *hdutype, int *status); +int ffpinit(fitsfile *fptr, int *status); +int ffainit(fitsfile *fptr, int *status); +int ffbinit(fitsfile *fptr, int *status); +int ffchdu(fitsfile *fptr, int *status); +int ffwend(fitsfile *fptr, int *status); +int ffpdfl(fitsfile *fptr, int *status); +int ffuptf(fitsfile *fptr, int *status); + +int ffdblk(fitsfile *fptr, long nblocks, int *status); +int ffgext(fitsfile *fptr, int moveto, int *exttype, int *status); +int ffgtbc(fitsfile *fptr, long *totalwidth, int *status); +int ffgtbp(fitsfile *fptr, char *name, char *value, int *status); +int ffiblk(fitsfile *fptr, long nblock, int headdata, int *status); +int ffshft(fitsfile *fptr, OFF_T firstbyte, OFF_T nbytes, OFF_T nshift, + int *status); + +int ffgcpr(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, int writemode, double *scale, double *zero, char *tform, + long *twidth, int *tcode, int *maxelem, OFF_T *startpos, + OFF_T *elemnum, long *incre, OFF_T *repeat, OFF_T *rowlen, + int *hdutype, long *tnull, char *snull, int *status); + +int ffflushx(FITSfile *fptr); +int ffseek(FITSfile *fptr, OFF_T position); +int ffread(FITSfile *fptr, long nbytes, void *buffer, + int *status); +int ffwrite(FITSfile *fptr, long nbytes, void *buffer, + int *status); +int fftrun(fitsfile *fptr, OFF_T filesize, int *status); + +int ffpcluc(fitsfile *fptr, int colnum, long firstrow, long firstelem, long + nelem, int *status); + +int ffgcll(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, long + nelem, int nultyp, char nulval, char *array, char *nularray, + int *anynul, int *status); +int ffgcls(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int nultyp, char *nulval, + char **array, char *nularray, int *anynul, int *status); +int ffgcls2(fitsfile *fptr, int colnum, long firstrow, long firstelem, + long nelem, int nultyp, char *nulval, + char **array, char *nularray, int *anynul, int *status); +int ffgclb(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, unsigned char nulval, + unsigned char *array, char *nularray, int *anynul, int *status); +int ffgclsb(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, signed char nulval, + signed char *array, char *nularray, int *anynul, int *status); +int ffgclui(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, unsigned short nulval, + unsigned short *array, char *nularray, int *anynul, int *status); +int ffgcli(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, short nulval, + short *array, char *nularray, int *anynul, int *status); +int ffgcluj(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, unsigned long nulval, + unsigned long *array, char *nularray, int *anynul, int *status); +int ffgcljj(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, LONGLONG nulval, + LONGLONG *array, char *nularray, int *anynul, int *status); +int ffgclj(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, long nulval, long *array, + char *nularray, int *anynul, int *status); +int ffgcluk(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, unsigned int nulval, + unsigned int *array, char *nularray, int *anynul, int *status); +int ffgclk(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, int nulval, int *array, + char *nularray, int *anynul, int *status); +int ffgcle(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, float nulval, float *array, + char *nularray, int *anynul, int *status); +int ffgcld(fitsfile *fptr, int colnum, long firstrow, OFF_T firstelem, + long nelem, long elemincre, int nultyp, double nulval, + double *array, char *nularray, int *anynul, int *status); + +int ffpi1b(fitsfile *fptr, long nelem, long incre, unsigned char *buffer, + int *status); +int ffpi2b(fitsfile *fptr, long nelem, long incre, short *buffer, int *status); +int ffpi4b(fitsfile *fptr, long nelem, long incre, INT32BIT *buffer, + int *status); +int ffpi8b(fitsfile *fptr, long nelem, long incre, long *buffer, int *status); +int ffpr4b(fitsfile *fptr, long nelem, long incre, float *buffer, int *status); +int ffpr8b(fitsfile *fptr, long nelem, long incre, double *buffer, int *status); + +int ffgi1b(fitsfile *fptr, OFF_T pos, long nelem, long incre, + unsigned char *buffer, int *status); +int ffgi2b(fitsfile *fptr, OFF_T pos, long nelem, long incre, short *buffer, + int *status); +int ffgi4b(fitsfile *fptr, OFF_T pos, long nelem, long incre, INT32BIT *buffer, + int *status); +int ffgi8b(fitsfile *fptr, OFF_T pos, long nelem, long incre, long *buffer, + int *status); +int ffgr4b(fitsfile *fptr, OFF_T pos, long nelem, long incre, float *buffer, + int *status); +int ffgr8b(fitsfile *fptr, OFF_T pos, long nelem, long incre, double *buffer, + int *status); + +int ffcins(fitsfile *fptr, long naxis1, long naxis2, long nbytes, + long bytepos, int *status); +int ffcdel(fitsfile *fptr, long naxis1, long naxis2, long nbytes, + long bytepos, int *status); +int ffkshf(fitsfile *fptr, int firstcol, int tfields, int nshift, int *status); + +int fffi1i1(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned char nullval, char + *nullarray, int *anynull, unsigned char *output, int *status); +int fffi2i1(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffi4i1(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffi8i1(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffr4i1(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffr8i1(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char nullval, char *nullarray, + int *anynull, unsigned char *output, int *status); +int fffstri1(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned char nullval, char *nullarray, int *anynull, + unsigned char *output, int *status); + +int fffi1s1(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, signed char nullval, char + *nullarray, int *anynull, signed char *output, int *status); +int fffi2s1(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, signed char nullval, char *nullarray, + int *anynull, signed char *output, int *status); +int fffi4s1(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, signed char nullval, char *nullarray, + int *anynull, signed char *output, int *status); +int fffi8s1(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, signed char nullval, char *nullarray, + int *anynull, signed char *output, int *status); +int fffr4s1(float *input, long ntodo, double scale, double zero, + int nullcheck, signed char nullval, char *nullarray, + int *anynull, signed char *output, int *status); +int fffr8s1(double *input, long ntodo, double scale, double zero, + int nullcheck, signed char nullval, char *nullarray, + int *anynull, signed char *output, int *status); +int fffstrs1(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + signed char nullval, char *nullarray, int *anynull, + signed char *output, int *status); + +int fffi1u2(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned short nullval, + char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffi2u2(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffi4u2(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffi8u2(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffr4u2(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffr8u2(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned short nullval, char *nullarray, + int *anynull, unsigned short *output, int *status); +int fffstru2(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned short nullval, char *nullarray, int *anynull, + unsigned short *output, int *status); + +int fffi1i2(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffi2i2(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffi4i2(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffi8i2(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffr4i2(float *input, long ntodo, double scale, double zero, + int nullcheck, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffr8i2(double *input, long ntodo, double scale, double zero, + int nullcheck, short nullval, char *nullarray, + int *anynull, short *output, int *status); +int fffstri2(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + short nullval, char *nullarray, int *anynull, short *output, + int *status); + +int fffi1u4(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned long nullval, + char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffi2u4(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffi4u4(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffi8u4(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffr4u4(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffr8u4(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned long nullval, char *nullarray, + int *anynull, unsigned long *output, int *status); +int fffstru4(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned long nullval, char *nullarray, int *anynull, + unsigned long *output, int *status); + +int fffi1i4(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffi2i4(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffi4i4(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffi8i4(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffr4i4(float *input, long ntodo, double scale, double zero, + int nullcheck, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffr8i4(double *input, long ntodo, double scale, double zero, + int nullcheck, long nullval, char *nullarray, + int *anynull, long *output, int *status); +int fffstri4(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + long nullval, char *nullarray, int *anynull, long *output, + int *status); + +int fffi1int(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffi2int(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffi4int(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffi8int(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffr4int(float *input, long ntodo, double scale, double zero, + int nullcheck, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffr8int(double *input, long ntodo, double scale, double zero, + int nullcheck, int nullval, char *nullarray, + int *anynull, int *output, int *status); +int fffstrint(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + int nullval, char *nullarray, int *anynull, int *output, + int *status); + +int fffi1uint(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, unsigned int nullval, + char *nullarray, int *anynull, unsigned int *output, int *status); +int fffi2uint(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffi4uint(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffi8uint(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffr4uint(float *input, long ntodo, double scale, double zero, + int nullcheck, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffr8uint(double *input, long ntodo, double scale, double zero, + int nullcheck, unsigned int nullval, char *nullarray, + int *anynull, unsigned int *output, int *status); +int fffstruint(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + unsigned int nullval, char *nullarray, int *anynull, + unsigned int *output, int *status); + +int fffi1i8(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, LONGLONG nullval, + char *nullarray, int *anynull, LONGLONG *output, int *status); +int fffi2i8(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, LONGLONG nullval, char *nullarray, + int *anynull, LONGLONG *output, int *status); +int fffi4i8(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, LONGLONG nullval, char *nullarray, + int *anynull, LONGLONG *output, int *status); +int fffi8i8(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, LONGLONG tnull, LONGLONG nullval, char *nullarray, + int *anynull, LONGLONG *output, int *status); +int fffr4i8(float *input, long ntodo, double scale, double zero, + int nullcheck, LONGLONG nullval, char *nullarray, + int *anynull, LONGLONG *output, int *status); +int fffr8i8(double *input, long ntodo, double scale, double zero, + int nullcheck, LONGLONG nullval, char *nullarray, + int *anynull, LONGLONG *output, int *status); +int fffstri8(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + LONGLONG nullval, char *nullarray, int *anynull, LONGLONG *output, + int *status); + +int fffi1r4(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffi2r4(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffi4r4(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffi8r4(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffr4r4(float *input, long ntodo, double scale, double zero, + int nullcheck, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffr8r4(double *input, long ntodo, double scale, double zero, + int nullcheck, float nullval, char *nullarray, + int *anynull, float *output, int *status); +int fffstrr4(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + float nullval, char *nullarray, int *anynull, float *output, + int *status); + +int fffi1r8(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffi2r8(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffi4r8(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffi8r8(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, long tnull, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffr4r8(float *input, long ntodo, double scale, double zero, + int nullcheck, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffr8r8(double *input, long ntodo, double scale, double zero, + int nullcheck, double nullval, char *nullarray, + int *anynull, double *output, int *status); +int fffstrr8(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + double nullval, char *nullarray, int *anynull, double *output, + int *status); + +int ffi1fi1(unsigned char *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffs1fi1(signed char *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffu2fi1(unsigned short *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffi2fi1(short *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffu4fi1(unsigned long *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffi4fi1(long *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffi8fi1(LONGLONG *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffuintfi1(unsigned int *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffintfi1(int *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffr4fi1(float *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); +int ffr8fi1(double *array, long ntodo, double scale, double zero, + unsigned char *buffer, int *status); + +int ffi1fi2(unsigned char *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffs1fi2(signed char *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffu2fi2(unsigned short *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffi2fi2(short *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffu4fi2(unsigned long *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffi4fi2(long *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffi8fi2(LONGLONG *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffuintfi2(unsigned int *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffintfi2(int *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffr4fi2(float *array, long ntodo, double scale, double zero, + short *buffer, int *status); +int ffr8fi2(double *array, long ntodo, double scale, double zero, + short *buffer, int *status); + +int ffi1fi4(unsigned char *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffs1fi4(signed char *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffu2fi4(unsigned short *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffi2fi4(short *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffu4fi4(unsigned long *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffi4fi4(long *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffi8fi4(LONGLONG *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffuintfi4(unsigned int *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffintfi4(int *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffr4fi4(float *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); +int ffr8fi4(double *array, long ntodo, double scale, double zero, + INT32BIT *buffer, int *status); + +int fflongfi8(long *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffi8fi8(LONGLONG *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffi2fi8(short *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffi1fi8(unsigned char *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffs1fi8(signed char *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffr4fi8(float *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffr8fi8(double *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffintfi8(int *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffu2fi8(unsigned short *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffu4fi8(unsigned long *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); +int ffuintfi8(unsigned int *array, long ntodo, double scale, double zero, + LONGLONG *buffer, int *status); + +int ffi1fr4(unsigned char *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffs1fr4(signed char *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffu2fr4(unsigned short *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffi2fr4(short *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffu4fr4(unsigned long *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffi4fr4(long *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffi8fr4(LONGLONG *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffuintfr4(unsigned int *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffintfr4(int *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffr4fr4(float *array, long ntodo, double scale, double zero, + float *buffer, int *status); +int ffr8fr4(double *array, long ntodo, double scale, double zero, + float *buffer, int *status); + +int ffi1fr8(unsigned char *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffs1fr8(signed char *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffu2fr8(unsigned short *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffi2fr8(short *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffu4fr8(unsigned long *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffi4fr8(long *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffi8fr8(LONGLONG *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffuintfr8(unsigned int *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffintfr8(int *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffr4fr8(float *array, long ntodo, double scale, double zero, + double *buffer, int *status); +int ffr8fr8(double *array, long ntodo, double scale, double zero, + double *buffer, int *status); + +int ffi1fstr(unsigned char *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffs1fstr(signed char *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffu2fstr(unsigned short *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffi2fstr(short *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffu4fstr(unsigned long *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffi4fstr(long *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffi8fstr(LONGLONG *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffintfstr(int *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffuintfstr(unsigned int *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffr4fstr(float *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); +int ffr8fstr(double *input, long ntodo, double scale, double zero, + char *cform, long twidth, char *output, int *status); + +/* the following 4 routines are VMS macros used on VAX or Alpha VMS */ +void ieevpd(double *inarray, double *outarray, long *nvals); +void ieevud(double *inarray, double *outarray, long *nvals); +void ieevpr(float *inarray, float *outarray, long *nvals); +void ieevur(float *inarray, float *outarray, long *nvals); + +/* routines related to the lexical parser */ +int ffselect_table(fitsfile **fptr, char *outfile, char *expr, int *status); +int ffiprs( fitsfile *fptr, int compressed, char *expr, int maxdim, + int *datatype, long *nelem, int *naxis, long *naxes, + int *status ); +void ffcprs( void ); +int ffcvtn( int inputType, void *input, char *undef, long ntodo, + int outputType, void *nulval, void *output, + int *anynull, int *status ); +int parse_data( long totalrows, long offset, long firstrow, + long nrows, int nCols, iteratorCol *colData, + void *userPtr ); +int uncompress_hkdata( fitsfile *fptr, long ntimes, + double *times, int *status ); +int ffffrw_work( long totalrows, long offset, long firstrow, + long nrows, int nCols, iteratorCol *colData, + void *userPtr ); + + +/* image compression routines */ +int fits_write_compressed_img(fitsfile *fptr, + int datatype, long *fpixel, long *lpixel, + int nullcheck, void *array, void *nulval, + int *status); +int fits_write_compressed_pixels(fitsfile *fptr, + int datatype, OFF_T fpixel, long npixels, + int nullcheck, void *array, void *nulval, + int *status); +int fits_write_compressed_img_plane(fitsfile *fptr, int datatype, + int bytesperpixel, long nplane, long *firstcoord, long *lastcoord, + long *naxes, int nullcheck, + void *array, void *nullval, long *nread, int *status); + +int imcomp_init_table(fitsfile *outfptr, int compress_type, + int bitpix, int naxis,long *naxes,long *tilesize, + int rice_blocksize,int rice_nbits,int *status); +int imcomp_calc_max_elem (int comptype, int nx, int blocksize); +int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr, + int *status); +int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr, + int *status); +int imcomp_compress_tile (fitsfile *outfptr, long row, + int datatype, void *tiledata, long tilelen, int *status); + +/* image decompression routines */ + +int fits_read_compressed_img(fitsfile *fptr, + int datatype, long *fpixel,long *lpixel,long *inc, + int nullcheck, void *nulval, void *array, char *nullarray, + int *anynul, int *status); +int fits_read_compressed_pixels(fitsfile *fptr, + int datatype, OFF_T fpixel, long npixels, + int nullcheck, void *nulval, void *array, char *nullarray, + int *anynul, int *status); +int fits_read_compressed_img_plane(fitsfile *fptr, int datatype, + int bytesperpixel, long nplane, long *firstcoord, long *lastcoord, + long *inc, long *naxes, int nullcheck, void *nullval, + void *array, char *nullarray, int *anynul, long *nread, int *status); + +int imcomp_get_compressed_image_par(fitsfile *infptr, int *status); +int imcomp_decompress_tile (fitsfile *infptr, + int nrow, int tilesize, int datatype, int nullcheck, + void *nulval, void *buffer, char *bnullarray, int *anynul, + int *status); +int imcomp_copy_overlap (char *tile, int pixlen, int ndim, + long *tfpixel, long *tlpixel, char *bnullarray, char *image, + long *fpixel, long *lpixel, long *inc, int nullcheck, char *nullarray, + int *status); +int imcomp_merge_overlap (char *tile, int pixlen, int ndim, + long *tfpixel, long *tlpixel, char *bnullarray, char *image, + long *fpixel, long *lpixel, int nullcheck, int *status); + +int fits_quantize_float (float fdata[], int nx, float in_null_value, + int noise_bits, int idata[], double *bscale, double *bzero, + int *iminval, int *imaxval); +int fits_quantize_double (double fdata[], int nx, double in_null_value, + int noise_bits, int idata[], double *bscale, double *bzero, + int *iminval, int *imaxval); +int fits_rcomp(int a[], int nx, unsigned char *c, int clen,int nblock); +int fits_rdecomp (unsigned char *c, int clen, unsigned int array[], int nx, + int nblock); + +int pl_p2li (int *pxsrc, int xs, short *lldst, int npix); +int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix); + +/* general driver routines */ + +int urltype2driver(char *urltype, int *driver); +int fits_init_cfitsio(void); + +int fits_register_driver( char *prefix, + int (*init)(void), + int (*fitsshutdown)(void), + int (*setoptions)(int option), + int (*getoptions)(int *options), + int (*getversion)(int *version), + int (*checkfile) (char *urltype, char *infile, char *outfile), + int (*fitsopen)(char *filename, int rwmode, int *driverhandle), + int (*fitscreate)(char *filename, int *driverhandle), + int (*fitstruncate)(int driverhandle, OFF_T filesize), + int (*fitsclose)(int driverhandle), + int (*fremove)(char *filename), + int (*size)(int driverhandle, OFF_T *size), + int (*flush)(int driverhandle), + int (*seek)(int driverhandle, OFF_T offset), + int (*fitsread) (int driverhandle, void *buffer, long nbytes), + int (*fitswrite)(int driverhandle, void *buffer, long nbytes)); + +/* file driver I/O routines */ + +int file_init(void); +int file_setoptions(int options); +int file_getoptions(int *options); +int file_getversion(int *version); +int file_shutdown(void); +int file_checkfile(char *urltype, char *infile, char *outfile); +int file_open(char *filename, int rwmode, int *driverhandle); +int file_compress_open(char *filename, int rwmode, int *hdl); +int file_openfile(char *filename, int rwmode, FILE **diskfile); +int file_create(char *filename, int *driverhandle); +int file_truncate(int driverhandle, OFF_T filesize); +int file_size(int driverhandle, OFF_T *filesize); +int file_close(int driverhandle); +int file_remove(char *filename); +int file_flush(int driverhandle); +int file_seek(int driverhandle, OFF_T offset); +int file_read (int driverhandle, void *buffer, long nbytes); +int file_write(int driverhandle, void *buffer, long nbytes); +int file_is_compressed(char *filename); + +/* memory driver I/O routines */ + +int mem_init(void); +int mem_setoptions(int options); +int mem_getoptions(int *options); +int mem_getversion(int *version); +int mem_shutdown(void); +int mem_create(char *filename, int *handle); +int mem_create_comp(char *filename, int *handle); +int mem_openmem(void **buffptr, size_t *buffsize, size_t deltasize, + void *(*memrealloc)(void *p, size_t newsize), int *handle); +int mem_createmem(size_t memsize, int *handle); +int stdin_checkfile(char *urltype, char *infile, char *outfile); +int stdin_open(char *filename, int rwmode, int *handle); +int stdin2mem(int hd); +int stdin2file(int hd); +int stdout_close(int handle); +int mem_compress_openrw(char *filename, int rwmode, int *hdl); +int mem_compress_open(char *filename, int rwmode, int *hdl); +int mem_compress_stdin_open(char *filename, int rwmode, int *hdl); +int mem_iraf_open(char *filename, int rwmode, int *hdl); +int mem_rawfile_open(char *filename, int rwmode, int *hdl); +int mem_size(int handle, OFF_T *filesize); +int mem_truncate(int handle, OFF_T filesize); +int mem_close_free(int handle); +int mem_close_keep(int handle); +int mem_close_comp(int handle); +int mem_seek(int handle, OFF_T offset); +int mem_read(int hdl, void *buffer, long nbytes); +int mem_write(int hdl, void *buffer, long nbytes); +int mem_uncompress2mem(char *filename, FILE *diskfile, int hdl); + +int iraf2mem(char *filename, char **buffptr, size_t *buffsize, + size_t *filesize, int *status); + +/* root driver I/O routines */ + +int root_init(void); +int root_setoptions(int options); +int root_getoptions(int *options); +int root_getversion(int *version); +int root_shutdown(void); +int root_open(char *filename, int rwmode, int *driverhandle); +int root_create(char *filename, int *driverhandle); +int root_close(int driverhandle); +int root_flush(int driverhandle); +int root_seek(int driverhandle, OFF_T offset); +int root_read (int driverhandle, void *buffer, long nbytes); +int root_write(int driverhandle, void *buffer, long nbytes); +int root_size(int handle, OFF_T *filesize); + +/* http driver I/O routines */ + +int http_checkfile(char *urltype, char *infile, char *outfile); +int http_open(char *filename, int rwmode, int *driverhandle); +int http_file_open(char *filename, int rwmode, int *driverhandle); +int http_compress_open(char *filename, int rwmode, int *driverhandle); + +/* ftp driver I/O routines */ + +int ftp_checkfile(char *urltype, char *infile, char *outfile); +int ftp_open(char *filename, int rwmode, int *driverhandle); +int ftp_file_open(char *filename, int rwmode, int *driverhandle); +int ftp_compress_open(char *filename, int rwmode, int *driverhandle); + + +int uncompress2mem(char *filename, FILE *diskfile, + char **buffptr, size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, int *status); + +int uncompress2mem_from_mem( + char *inmemptr, + size_t inmemsize, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +int uncompress2file(char *filename, + FILE *indiskfile, + FILE *outdiskfile, + int *status); + +int compress2mem_from_mem( + char *inmemptr, + size_t inmemsize, + char **buffptr, + size_t *buffsize, + void *(*mem_realloc)(void *p, size_t newsize), + size_t *filesize, + int *status); + +int compress2file_from_mem( + char *inmemptr, + size_t inmemsize, + FILE *outdiskfile, + size_t *filesize, /* O - size of file, in bytes */ + int *status); + +/* ==================== SHARED MEMORY DRIVER SECTION ======================= */ + +#ifdef HAVE_SHMEM_SERVICES +#include "drvrsmem.h" +#endif + +/* ==================== END OF SHARED MEMORY DRIVER SECTION ================ */ + +#endif + + +#if defined(vms) || defined(__vms) || defined(WIN32) || defined(__WIN32__) || (defined(macintosh) && !defined(TARGET_API_MAC_CARBON)) + +/* ================================================================== */ +/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */ +/* ================================================================== */ + +int strcasecmp (const char *s1, const char *s2 ); +int strncasecmp(const char *s1, const char *s2, size_t n); + +#endif diff --git a/pkg/tbtables/cfitsio/getcol.c b/pkg/tbtables/cfitsio/getcol.c new file mode 100644 index 00000000..31506d9f --- /dev/null +++ b/pkg/tbtables/cfitsio/getcol.c @@ -0,0 +1,919 @@ + +/* This file, getcol.c, contains routines that read data elements from */ +/* a FITS image or table. There are generic datatype routines. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffgpxv( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long *firstpix, /* I - coord of first pixel to read (1s based) */ + long nelem, /* I - number of values to read */ + void *nulval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + int naxis, ii; + long naxes[9]; + OFF_T dimsize = 1, firstelem; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* get the size of the image */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, 9, naxes, status); + + /* calculate the position of the first element in the array */ + firstelem = 0; + for (ii=0; ii < naxis; ii++) + { + firstelem += ((firstpix[ii] - 1) * dimsize); + dimsize *= naxes[ii]; + } + firstelem++; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (datatype == TBYTE) + { + if (nulval == 0) + ffgpvb(fptr, 1, firstelem, nelem, 0, + (unsigned char *) array, anynul, status); + else + ffgpvb(fptr, 1, firstelem, nelem, *(unsigned char *) nulval, + (unsigned char *) array, anynul, status); + } + else if (datatype == TSBYTE) + { + if (nulval == 0) + ffgpvsb(fptr, 1, firstelem, nelem, 0, + (signed char *) array, anynul, status); + else + ffgpvsb(fptr, 1, firstelem, nelem, *(signed char *) nulval, + (signed char *) array, anynul, status); + } + else if (datatype == TUSHORT) + { + if (nulval == 0) + ffgpvui(fptr, 1, firstelem, nelem, 0, + (unsigned short *) array, anynul, status); + else + ffgpvui(fptr, 1, firstelem, nelem, *(unsigned short *) nulval, + (unsigned short *) array, anynul, status); + } + else if (datatype == TSHORT) + { + if (nulval == 0) + ffgpvi(fptr, 1, firstelem, nelem, 0, + (short *) array, anynul, status); + else + ffgpvi(fptr, 1, firstelem, nelem, *(short *) nulval, + (short *) array, anynul, status); + } + else if (datatype == TUINT) + { + if (nulval == 0) + ffgpvuk(fptr, 1, firstelem, nelem, 0, + (unsigned int *) array, anynul, status); + else + ffgpvuk(fptr, 1, firstelem, nelem, *(unsigned int *) nulval, + (unsigned int *) array, anynul, status); + } + else if (datatype == TINT) + { + if (nulval == 0) + ffgpvk(fptr, 1, firstelem, nelem, 0, + (int *) array, anynul, status); + else + ffgpvk(fptr, 1, firstelem, nelem, *(int *) nulval, + (int *) array, anynul, status); + } + else if (datatype == TULONG) + { + if (nulval == 0) + ffgpvuj(fptr, 1, firstelem, nelem, 0, + (unsigned long *) array, anynul, status); + else + ffgpvuj(fptr, 1, firstelem, nelem, *(unsigned long *) nulval, + (unsigned long *) array, anynul, status); + } + else if (datatype == TLONG) + { + if (nulval == 0) + ffgpvj(fptr, 1, firstelem, nelem, 0, + (long *) array, anynul, status); + else + ffgpvj(fptr, 1, firstelem, nelem, *(long *) nulval, + (long *) array, anynul, status); + } + else if (datatype == TLONGLONG) + { + if (nulval == 0) + ffgpvjj(fptr, 1, firstelem, nelem, 0, + (LONGLONG *) array, anynul, status); + else + ffgpvjj(fptr, 1, firstelem, nelem, *(LONGLONG *) nulval, + (LONGLONG *) array, anynul, status); + } + else if (datatype == TFLOAT) + { + if (nulval == 0) + ffgpve(fptr, 1, firstelem, nelem, 0, + (float *) array, anynul, status); + else + ffgpve(fptr, 1, firstelem, nelem, *(float *) nulval, + (float *) array, anynul, status); + } + else if (datatype == TDOUBLE) + { + if (nulval == 0) + ffgpvd(fptr, 1, firstelem, nelem, 0, + (double *) array, anynul, status); + else + { + ffgpvd(fptr, 1, firstelem, nelem, *(double *) nulval, + (double *) array, anynul, status); + } + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpxf( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long *firstpix, /* I - coord of first pixel to read (1s based) */ + long nelem, /* I - number of values to read */ + void *array, /* O - array of values that are returned */ + char *nullarray, /* O - returned array of null value flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + The nullarray values will = 1 if the corresponding array value is null. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + int naxis, ii; + long naxes[9]; + OFF_T dimsize = 1, firstelem; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* get the size of the image */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, 9, naxes, status); + + /* calculate the position of the first element in the array */ + firstelem = 0; + for (ii=0; ii < naxis; ii++) + { + firstelem += ((firstpix[ii] - 1) * dimsize); + dimsize *= naxes[ii]; + } + firstelem++; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (datatype == TBYTE) + { + ffgpfb(fptr, 1, firstelem, nelem, + (unsigned char *) array, nullarray, anynul, status); + } + else if (datatype == TSBYTE) + { + ffgpfsb(fptr, 1, firstelem, nelem, + (signed char *) array, nullarray, anynul, status); + } + else if (datatype == TUSHORT) + { + ffgpfui(fptr, 1, firstelem, nelem, + (unsigned short *) array, nullarray, anynul, status); + } + else if (datatype == TSHORT) + { + ffgpfi(fptr, 1, firstelem, nelem, + (short *) array, nullarray, anynul, status); + } + else if (datatype == TUINT) + { + ffgpfuk(fptr, 1, firstelem, nelem, + (unsigned int *) array, nullarray, anynul, status); + } + else if (datatype == TINT) + { + ffgpfk(fptr, 1, firstelem, nelem, + (int *) array, nullarray, anynul, status); + } + else if (datatype == TULONG) + { + ffgpfuj(fptr, 1, firstelem, nelem, + (unsigned long *) array, nullarray, anynul, status); + } + else if (datatype == TLONG) + { + ffgpfj(fptr, 1, firstelem, nelem, + (long *) array, nullarray, anynul, status); + } + else if (datatype == TLONGLONG) + { + ffgpfjj(fptr, 1, firstelem, nelem, + (LONGLONG *) array, nullarray, anynul, status); + } + else if (datatype == TFLOAT) + { + ffgpfe(fptr, 1, firstelem, nelem, + (float *) array, nullarray, anynul, status); + } + else if (datatype == TDOUBLE) + { + ffgpfd(fptr, 1, firstelem, nelem, + (double *) array, nullarray, anynul, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsv( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc , /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dim. */ + void *nulval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an section of values from the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + int naxis; + long naxes[9]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* get the size of the image */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, 9, naxes, status); + + if (datatype == TBYTE) + { + if (nulval == 0) + ffgsvb(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (unsigned char *) array, anynul, status); + else + ffgsvb(fptr, 1, naxis, naxes, blc, trc, inc, *(unsigned char *) nulval, + (unsigned char *) array, anynul, status); + } + else if (datatype == TSBYTE) + { + if (nulval == 0) + ffgsvsb(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (signed char *) array, anynul, status); + else + ffgsvsb(fptr, 1, naxis, naxes, blc, trc, inc, *(signed char *) nulval, + (signed char *) array, anynul, status); + } + else if (datatype == TUSHORT) + { + if (nulval == 0) + ffgsvui(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (unsigned short *) array, anynul, status); + else + ffgsvui(fptr, 1, naxis, naxes,blc, trc, inc, *(unsigned short *) nulval, + (unsigned short *) array, anynul, status); + } + else if (datatype == TSHORT) + { + if (nulval == 0) + ffgsvi(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (short *) array, anynul, status); + else + ffgsvi(fptr, 1, naxis, naxes, blc, trc, inc, *(short *) nulval, + (short *) array, anynul, status); + } + else if (datatype == TUINT) + { + if (nulval == 0) + ffgsvuk(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (unsigned int *) array, anynul, status); + else + ffgsvuk(fptr, 1, naxis, naxes, blc, trc, inc, *(unsigned int *) nulval, + (unsigned int *) array, anynul, status); + } + else if (datatype == TINT) + { + if (nulval == 0) + ffgsvk(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (int *) array, anynul, status); + else + ffgsvk(fptr, 1, naxis, naxes, blc, trc, inc, *(int *) nulval, + (int *) array, anynul, status); + } + else if (datatype == TULONG) + { + if (nulval == 0) + ffgsvuj(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (unsigned long *) array, anynul, status); + else + ffgsvuj(fptr, 1, naxis, naxes, blc, trc, inc, *(unsigned long *) nulval, + (unsigned long *) array, anynul, status); + } + else if (datatype == TLONG) + { + if (nulval == 0) + ffgsvj(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (long *) array, anynul, status); + else + ffgsvj(fptr, 1, naxis, naxes, blc, trc, inc, *(long *) nulval, + (long *) array, anynul, status); + } + else if (datatype == TLONGLONG) + { + if (nulval == 0) + ffgsvjj(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (LONGLONG *) array, anynul, status); + else + ffgsvjj(fptr, 1, naxis, naxes, blc, trc, inc, *(LONGLONG *) nulval, + (LONGLONG *) array, anynul, status); + } + else if (datatype == TFLOAT) + { + if (nulval == 0) + ffgsve(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (float *) array, anynul, status); + else + ffgsve(fptr, 1, naxis, naxes, blc, trc, inc, *(float *) nulval, + (float *) array, anynul, status); + } + else if (datatype == TDOUBLE) + { + if (nulval == 0) + ffgsvd(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (double *) array, anynul, status); + else + ffgsvd(fptr, 1, naxis, naxes, blc, trc, inc, *(double *) nulval, + (double *) array, anynul, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpv( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + void *nulval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (datatype == TBYTE) + { + if (nulval == 0) + ffgpvb(fptr, 1, firstelem, nelem, 0, + (unsigned char *) array, anynul, status); + else + ffgpvb(fptr, 1, firstelem, nelem, *(unsigned char *) nulval, + (unsigned char *) array, anynul, status); + } + else if (datatype == TSBYTE) + { + if (nulval == 0) + ffgpvsb(fptr, 1, firstelem, nelem, 0, + (signed char *) array, anynul, status); + else + ffgpvsb(fptr, 1, firstelem, nelem, *(signed char *) nulval, + (signed char *) array, anynul, status); + } + else if (datatype == TUSHORT) + { + if (nulval == 0) + ffgpvui(fptr, 1, firstelem, nelem, 0, + (unsigned short *) array, anynul, status); + else + ffgpvui(fptr, 1, firstelem, nelem, *(unsigned short *) nulval, + (unsigned short *) array, anynul, status); + } + else if (datatype == TSHORT) + { + if (nulval == 0) + ffgpvi(fptr, 1, firstelem, nelem, 0, + (short *) array, anynul, status); + else + ffgpvi(fptr, 1, firstelem, nelem, *(short *) nulval, + (short *) array, anynul, status); + } + else if (datatype == TUINT) + { + if (nulval == 0) + ffgpvuk(fptr, 1, firstelem, nelem, 0, + (unsigned int *) array, anynul, status); + else + ffgpvuk(fptr, 1, firstelem, nelem, *(unsigned int *) nulval, + (unsigned int *) array, anynul, status); + } + else if (datatype == TINT) + { + if (nulval == 0) + ffgpvk(fptr, 1, firstelem, nelem, 0, + (int *) array, anynul, status); + else + ffgpvk(fptr, 1, firstelem, nelem, *(int *) nulval, + (int *) array, anynul, status); + } + else if (datatype == TULONG) + { + if (nulval == 0) + ffgpvuj(fptr, 1, firstelem, nelem, 0, + (unsigned long *) array, anynul, status); + else + ffgpvuj(fptr, 1, firstelem, nelem, *(unsigned long *) nulval, + (unsigned long *) array, anynul, status); + } + else if (datatype == TLONG) + { + if (nulval == 0) + ffgpvj(fptr, 1, firstelem, nelem, 0, + (long *) array, anynul, status); + else + ffgpvj(fptr, 1, firstelem, nelem, *(long *) nulval, + (long *) array, anynul, status); + } + else if (datatype == TLONGLONG) + { + if (nulval == 0) + ffgpvjj(fptr, 1, firstelem, nelem, 0, + (LONGLONG *) array, anynul, status); + else + ffgpvjj(fptr, 1, firstelem, nelem, *(LONGLONG *) nulval, + (LONGLONG *) array, anynul, status); + } + else if (datatype == TFLOAT) + { + if (nulval == 0) + ffgpve(fptr, 1, firstelem, nelem, 0, + (float *) array, anynul, status); + else + ffgpve(fptr, 1, firstelem, nelem, *(float *) nulval, + (float *) array, anynul, status); + } + else if (datatype == TDOUBLE) + { + if (nulval == 0) + ffgpvd(fptr, 1, firstelem, nelem, 0, + (double *) array, anynul, status); + else + { + ffgpvd(fptr, 1, firstelem, nelem, *(double *) nulval, + (double *) array, anynul, status); + } + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpf( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + void *array, /* O - array of values that are returned */ + char *nullarray, /* O - array of null value flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + The nullarray values will = 1 if the corresponding array value is null. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (datatype == TBYTE) + { + ffgpfb(fptr, 1, firstelem, nelem, + (unsigned char *) array, nullarray, anynul, status); + } + else if (datatype == TSBYTE) + { + ffgpfsb(fptr, 1, firstelem, nelem, + (signed char *) array, nullarray, anynul, status); + } + else if (datatype == TUSHORT) + { + ffgpfui(fptr, 1, firstelem, nelem, + (unsigned short *) array, nullarray, anynul, status); + } + else if (datatype == TSHORT) + { + ffgpfi(fptr, 1, firstelem, nelem, + (short *) array, nullarray, anynul, status); + } + else if (datatype == TUINT) + { + ffgpfuk(fptr, 1, firstelem, nelem, + (unsigned int *) array, nullarray, anynul, status); + } + else if (datatype == TINT) + { + ffgpfk(fptr, 1, firstelem, nelem, + (int *) array, nullarray, anynul, status); + } + else if (datatype == TULONG) + { + ffgpfuj(fptr, 1, firstelem, nelem, + (unsigned long *) array, nullarray, anynul, status); + } + else if (datatype == TLONG) + { + ffgpfj(fptr, 1, firstelem, nelem, + (long *) array, nullarray, anynul, status); + } + else if (datatype == TLONGLONG) + { + ffgpfjj(fptr, 1, firstelem, nelem, + (LONGLONG *) array, nullarray, anynul, status); + } + else if (datatype == TFLOAT) + { + ffgpfe(fptr, 1, firstelem, nelem, + (float *) array, nullarray, anynul, status); + } + else if (datatype == TDOUBLE) + { + ffgpfd(fptr, 1, firstelem, nelem, + (double *) array, nullarray, anynul, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcv( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + void *nulval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a table column. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of true if any pixels are undefined. +*/ +{ + char cdummy[2]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (datatype == TBIT) + { + ffgcx(fptr, colnum, firstrow, firstelem, nelem, (char *) array, status); + } + else if (datatype == TBYTE) + { + if (nulval == 0) + ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (unsigned char *) array, cdummy, anynul, status); + else + ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(unsigned char *) + nulval, (unsigned char *) array, cdummy, anynul, status); + } + else if (datatype == TSBYTE) + { + if (nulval == 0) + ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (signed char *) array, cdummy, anynul, status); + else + ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(signed char *) + nulval, (signed char *) array, cdummy, anynul, status); + } + else if (datatype == TUSHORT) + { + if (nulval == 0) + ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (unsigned short *) array, cdummy, anynul, status); + else + ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 1, + *(unsigned short *) nulval, + (unsigned short *) array, cdummy, anynul, status); + } + else if (datatype == TSHORT) + { + if (nulval == 0) + ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (short *) array, cdummy, anynul, status); + else + ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(short *) + nulval, (short *) array, cdummy, anynul, status); + } + else if (datatype == TUINT) + { + if (nulval == 0) + ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (unsigned int *) array, cdummy, anynul, status); + else + ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, + *(unsigned int *) nulval, (unsigned int *) array, cdummy, anynul, + status); + } + else if (datatype == TINT) + { + if (nulval == 0) + ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (int *) array, cdummy, anynul, status); + else + ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(int *) + nulval, (int *) array, cdummy, anynul, status); + } + else if (datatype == TULONG) + { + if (nulval == 0) + ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (unsigned long *) array, cdummy, anynul, status); + else + ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, + *(unsigned long *) nulval, + (unsigned long *) array, cdummy, anynul, status); + } + else if (datatype == TLONG) + { + if (nulval == 0) + ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (long *) array, cdummy, anynul, status); + else + ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(long *) + nulval, (long *) array, cdummy, anynul, status); + } + else if (datatype == TLONGLONG) + { + if (nulval == 0) + ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (LONGLONG *) array, cdummy, anynul, status); + else + ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(LONGLONG *) + nulval, (LONGLONG *) array, cdummy, anynul, status); + } + else if (datatype == TFLOAT) + { + if (nulval == 0) + ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0., + (float *) array, cdummy, anynul, status); + else + ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(float *) + nulval,(float *) array, cdummy, anynul, status); + } + else if (datatype == TDOUBLE) + { + if (nulval == 0) + ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0., + (double *) array, cdummy, anynul, status); + else + ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(double *) + nulval, (double *) array, cdummy, anynul, status); + } + else if (datatype == TCOMPLEX) + { + if (nulval == 0) + ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, 0., (float *) array, cdummy, anynul, status); + else + ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, *(float *) nulval, (float *) array, cdummy, anynul, status); + } + else if (datatype == TDBLCOMPLEX) + { + if (nulval == 0) + ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, 0., (double *) array, cdummy, anynul, status); + else + ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, *(double *) nulval, (double *) array, cdummy, anynul, status); + } + + else if (datatype == TLOGICAL) + { + if (nulval == 0) + ffgcll(fptr, colnum, firstrow, firstelem, nelem, 1, 0, + (char *) array, cdummy, anynul, status); + else + ffgcll(fptr, colnum, firstrow, firstelem, nelem, 1, *(char *) nulval, + (char *) array, cdummy, anynul, status); + } + else if (datatype == TSTRING) + { + if (nulval == 0) + { + cdummy[0] = '\0'; + ffgcls(fptr, colnum, firstrow, firstelem, nelem, 1, + cdummy, (char **) array, cdummy, anynul, status); + } + else + ffgcls(fptr, colnum, firstrow, firstelem, nelem, 1, (char *) + nulval, (char **) array, cdummy, anynul, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcf( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + void *array, /* O - array of values that are returned */ + char *nullarray, /* O - array of null value flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a table column. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + ANYNUL is returned with a value of true if any pixels are undefined. +*/ +{ + void *nulval; /* dummy argument */ + double dnulval = 0.; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + nulval = &dnulval; /* set to a harmless value; this is never used */ + + if (datatype == TBIT) + { + ffgcx(fptr, colnum, firstrow, firstelem, nelem, (char *) array, status); + } + else if (datatype == TBYTE) + { + ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(unsigned char *) + nulval, (unsigned char *) array, nullarray, anynul, status); + } + else if (datatype == TSBYTE) + { + ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(signed char *) + nulval, (signed char *) array, nullarray, anynul, status); + } + else if (datatype == TUSHORT) + { + ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 2, + *(unsigned short *) nulval, + (unsigned short *) array, nullarray, anynul, status); + } + else if (datatype == TSHORT) + { + ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(short *) + nulval, (short *) array, nullarray, anynul, status); + } + else if (datatype == TUINT) + { + ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, + *(unsigned int *) nulval, (unsigned int *) array, nullarray, anynul, + status); + } + else if (datatype == TINT) + { + ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(int *) + nulval, (int *) array, nullarray, anynul, status); + } + else if (datatype == TULONG) + { + ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, + *(unsigned long *) nulval, + (unsigned long *) array, nullarray, anynul, status); + } + else if (datatype == TLONG) + { + ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(long *) + nulval, (long *) array, nullarray, anynul, status); + } + else if (datatype == TLONGLONG) + { + ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(LONGLONG *) + nulval, (LONGLONG *) array, nullarray, anynul, status); + } + else if (datatype == TFLOAT) + { + ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(float *) + nulval,(float *) array, nullarray, anynul, status); + } + else if (datatype == TDOUBLE) + { + ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(double *) + nulval, (double *) array, nullarray, anynul, status); + } + else if (datatype == TCOMPLEX) + { + ffgcfc(fptr, colnum, firstrow, firstelem, nelem, + (float *) array, nullarray, anynul, status); + } + else if (datatype == TDBLCOMPLEX) + { + ffgcfm(fptr, colnum, firstrow, firstelem, nelem, + (double *) array, nullarray, anynul, status); + } + + else if (datatype == TLOGICAL) + { + ffgcll(fptr, colnum, firstrow, firstelem, nelem, 2, *(char *) nulval, + (char *) array, nullarray, anynul, status); + } + else if (datatype == TSTRING) + { + ffgcls(fptr, colnum, firstrow, firstelem, nelem, 2, (char *) + nulval, (char **) array, nullarray, anynul, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/getcolb.c b/pkg/tbtables/cfitsio/getcolb.c new file mode 100644 index 00000000..9390064a --- /dev/null +++ b/pkg/tbtables/cfitsio/getcolb.c @@ -0,0 +1,2111 @@ +/* This file, getcolb.c, contains routines that read data elements from */ +/* a FITS image or table, with unsigned char (unsigned byte) data type. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned char nulval, /* I - value for undefined pixels */ + unsigned char *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + unsigned char nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TBYTE, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclb(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned char *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TBYTE, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclb(fptr, 2, row, firstelem, nelem, 1, 2, 0, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2db(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned char nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned char *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3db(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3db(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned char nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned char *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + unsigned char nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TBYTE, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgclb(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgclb(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned char nulval, /* I - value to set undefined pixels */ + unsigned char *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii, i0, i1, i2, i3, i4, i5, i6, i7, i8, row, rstr, rstp, rinc; + long str[9], stp[9], incr[9], dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + unsigned char nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvb is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TBYTE, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvb: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgclb(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned char *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + int hdutype, anyf; + unsigned char nulval = 0; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvb is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TBYTE, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvb: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgclb(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned char *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclb(fptr, 1, row, firstelem, nelem, 1, 1, 0, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned char nulval, /* I - value for null pixels */ + unsigned char *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned char *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + unsigned char dummy = 0; + + ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgclb( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + unsigned char nulval, /* I - value for null pixels if nultyp = 1 */ + unsigned char *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + union u_tag { + char charval; + unsigned char ucharval; + } u; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + ffgcpr( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status); + + /* special case */ + if (tcode == TLOGICAL && elemincre == 1) + { + u.ucharval = nulval; + ffgcll(fptr, colnum, firstrow, firstelem, nelem, nultyp, + u.charval, (char *) array, nularray, anynul, status); + + return(*status); + } + + if (strchr(tform,'A') != NULL) + { + if (*status == BAD_ELEM_NUM) + { + /* ignore this error message */ + *status = 0; + ffcmsg(); /* clear error stack */ + } + + /* interpret a 'A' ASCII column as a 'B' byte column ('8A' == '8B') */ + /* This is an undocumented 'feature' in CFITSIO */ + + /* we have to reset some of the values returned by ffgcpr */ + + tcode = TBYTE; + incre = 1; /* each element is 1 byte wide */ + repeat = twidth; /* total no. of chars in the col */ + twidth = 1; /* width of each element */ + scale = 1.0; /* no scaling */ + zero = 0.0; + tnull = NULL_UNDEFINED; /* don't test for nulls */ + maxelem = DBUFFSIZE; + } + + if (*status > 0) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING && hdutype == ASCII_TBL) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default, check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TBYTE) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0.) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, &array[next], status); + if (convert) + fffi1i1(&array[next], ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2i1((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4i1((INT32BIT *) buffer, ntodo, scale, zero, nulcheck, + (INT32BIT) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONGLONG): + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8i1( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4i1((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8i1((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + /* interpret the string as an ASCII formated number */ + fffstri1((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read bytes from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgclb).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgclb).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1i1(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output,/* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { /* this routine is normally not called in this case */ + memcpy(output, input, ntodo ); + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2i1(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output,/* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4i1(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output,/* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8i1(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output,/* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj, kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DUCHAR_MIN ) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4i1(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output,/* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + /* use redundant boolean logic in following statement */ + /* to suppress irritating Borland compiler warning message */ + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8i1(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output,/* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstri1(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + unsigned char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcold.c b/pkg/tbtables/cfitsio/getcold.c new file mode 100644 index 00000000..dfe77f89 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcold.c @@ -0,0 +1,1768 @@ +/* This file, getcold.c, contains routines that read data elements from */ +/* a FITS image or table, with double datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvd( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double nulval, /* I - value for undefined pixels */ + double *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + double nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TDOUBLE, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcld(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfd( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TDOUBLE, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcld(fptr, 2, row, firstelem, nelem, 1, 2, 0., + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2dd(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + double nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + double *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3dd(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3dd(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + double nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + double *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + double nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TDOUBLE, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgcld(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgcld(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvd(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + double nulval, /* I - value to set undefined pixels */ + double *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + double nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvd is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TDOUBLE, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvd: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgcld(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfd(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + double *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + int hdutype, anyf; + double nulval = 0; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvd is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TDOUBLE, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvd: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcld(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpd( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcld(fptr, 1, row, firstelem, nelem, 1, 1, 0., + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvd(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double nulval, /* I - value for null pixels */ + double *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvm(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double nulval, /* I - value for null pixels */ + double *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. + + TSCAL and ZERO should not be used with complex values. +*/ +{ + char cdummy; + + /* a complex double value is interpreted as a pair of double values, */ + /* thus need to multiply the first element and number of elements by 2 */ + + ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, nulval, array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfd(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + double dummy = 0; + + ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfm(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + double *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. + + TSCAL and ZERO should not be used with complex values. +*/ +{ + long ii, jj; + float dummy = 0; + char *carray; + + /* a complex double value is interpreted as a pair of double values, */ + /* thus need to multiply the first element and number of elements by 2 */ + + /* allocate temporary array */ + carray = (char *) calloc(nelem * 2, 1); + + ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 2, dummy, array, carray, anynul, status); + + for (ii = 0, jj = 0; jj < nelem; ii += 2, jj++) + { + if (carray[ii] || carray[ii + 1]) + nularray[jj] = 1; + else + nularray[jj] = 0; + } + + free(carray); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcld( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + double nulval, /* I - value for null pixels if nultyp = 1 */ + double *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TDOUBLE) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0.) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, &array[next], status); + if (convert) + fffr8r8(&array[next], ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1r8((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2r8((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4r8((INT32BIT *) buffer, ntodo, scale, zero, nulcheck, + (INT32BIT) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONGLONG): + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8r8( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4r8((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstrr8((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgcld).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgcld).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1r8(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (double) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2r8(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (double) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4r8(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (double) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8r8(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + unsigned long *uinput; + long ii,jj, kk; + double dvalue; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + output[ii] = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + output[ii] = (double) uinput[jj] * 4294967296. + uinput[kk]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + output[ii] = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + output[ii] = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = dvalue * scale + zero; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (double) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4r8(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + output[ii] = (double) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = zero; + } + else + output[ii] = input[ii] * scale + zero; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8r8(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + memcpy(output, input, ntodo * sizeof(double) ); + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + { + nullarray[ii] = 1; + /* explicitly set value in case output contains a NaN */ + output[ii] = DOUBLENULLVALUE; + } + } + else /* it's an underflow */ + output[ii] = 0; + } + else + output[ii] = input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + { + nullarray[ii] = 1; + /* explicitly set value in case output contains a NaN */ + output[ii] = DOUBLENULLVALUE; + } + } + else /* it's an underflow */ + output[ii] = zero; + } + else + output[ii] = input[ii] * scale + zero; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstrr8(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + double nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + double *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + output[ii] = (dvalue * scale + zero); /* apply the scaling */ + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcole.c b/pkg/tbtables/cfitsio/getcole.c new file mode 100644 index 00000000..1e6d40d0 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcole.c @@ -0,0 +1,1775 @@ +/* This file, getcole.c, contains routines that read data elements from */ +/* a FITS image or table, with float datatype */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpve( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float nulval, /* I - value for undefined pixels */ + float *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + float nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TFLOAT, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcle(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfe( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TFLOAT, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcle(fptr, 2, row, firstelem, nelem, 1, 2, 0.F, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2de(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + float nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + float *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3de(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3de(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + float nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + float *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + float nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TFLOAT, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgcle(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgcle(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsve(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + float nulval, /* I - value to set undefined pixels */ + float *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + float nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsve is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TFLOAT, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsve: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgcle(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfe(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + float *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + int hdutype, anyf; + float nulval = 0; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsve is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TFLOAT, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsve: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcle(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpe( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcle(fptr, 1, row, firstelem, nelem, 1, 1, 0.F, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcve(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float nulval, /* I - value for null pixels */ + float *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvc(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float nulval, /* I - value for null pixels */ + float *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. + + TSCAL and ZERO should not be used with complex values. +*/ +{ + char cdummy; + + /* a complex value is interpreted as a pair of float values, thus */ + /* need to multiply the first element and number of elements by 2 */ + + ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem *2, + 1, 1, nulval, array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfe(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + float dummy = 0; + + ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfc(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + float *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. + + TSCAL and ZERO should not be used with complex values. +*/ +{ + long ii, jj; + float dummy = 0; + char *carray; + + /* a complex value is interpreted as a pair of float values, thus */ + /* need to multiply the first element and number of elements by 2 */ + + /* allocate temporary array */ + carray = (char *) calloc(nelem * 2, 1); + + ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 2, dummy, array, carray, anynul, status); + + for (ii = 0, jj = 0; jj < nelem; ii += 2, jj++) + { + if (carray[ii] || carray[ii + 1]) + nularray[jj] = 1; + else + nularray[jj] = 0; + } + + free(carray); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcle( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + float nulval, /* I - value for null pixels if nultyp = 1 */ + float *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TFLOAT) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0.) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, &array[next], status); + if (convert) + fffr4r4(&array[next], ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1r4((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2r4((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4r4((INT32BIT *) buffer, ntodo, scale, zero, nulcheck, + (INT32BIT) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + case (TLONGLONG): + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8r4( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8r4((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstrr4((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgcle).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgcle).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1r4(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = ( (double) input[ii] ) * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (float) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = ( (double) input[ii] ) * scale + zero; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2r4(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (float) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4r4(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (float) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8r4(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + unsigned long *uinput; + long ii,jj, kk; + double dvalue; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + output[ii] = (float) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + output[ii] = (float) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = (float) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = dvalue * scale + zero; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (float) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + output[ii] = input[ii] * scale + zero; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4r4(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + memcpy(output, input, ntodo * sizeof(float) ); + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + { + nullarray[ii] = 1; + /* explicitly set value in case output contains a NaN */ + output[ii] = FLOATNULLVALUE; + } + } + else /* it's an underflow */ + output[ii] = 0; + } + else + output[ii] = input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + { + nullarray[ii] = 1; + /* explicitly set value in case output contains a NaN */ + output[ii] = FLOATNULLVALUE; + } + } + else /* it's an underflow */ + output[ii] = zero; + } + else + output[ii] = input[ii] * scale + zero; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8r4(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + output[ii] = input[ii] * scale + zero; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + output[ii] = (double) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = zero; + } + else + output[ii] = input[ii] * scale + zero; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstrr4(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + float nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + float *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + output[ii] = (float) (dvalue * scale + zero); /* apply the scaling */ + + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcoli.c b/pkg/tbtables/cfitsio/getcoli.c new file mode 100644 index 00000000..2ec1dd1f --- /dev/null +++ b/pkg/tbtables/cfitsio/getcoli.c @@ -0,0 +1,2043 @@ +/* This file, getcoli.c, contains routines that read data elements from */ +/* a FITS image or table, with short datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvi( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + short nulval, /* I - value for undefined pixels */ + short *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + short nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + fits_read_compressed_pixels(fptr, TSHORT, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcli(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfi( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + short *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TSHORT, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcli(fptr, 2, row, firstelem, nelem, 1, 2, 0, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2di(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + short nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + short *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3di(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3di(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + short nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + short *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + short nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TSHORT, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgcli(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgcli(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvi(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + short nulval, /* I - value to set undefined pixels */ + short *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + short nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvi is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TSHORT, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvi: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgcli(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfi(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + short *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + int hdutype, anyf; + short nulval = 0; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvi is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TSHORT, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvi: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcli(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpi( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + short *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcli(fptr, 1, row, firstelem, nelem, 1, 1, 0, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvi(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + short nulval, /* I - value for null pixels */ + short *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfi(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + short *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + short dummy = 0; + + ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcli( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + short nulval, /* I - value for null pixels if nultyp = 1 */ + short *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TSHORT) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0.) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, &array[next], status); + if (convert) + fffi2i2(&array[next], ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONGLONG): + + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8i2( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1i2((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4i2((INT32BIT *) buffer, ntodo, scale, zero, nulcheck, + (INT32BIT) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4i2((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8i2((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstri2((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgcli).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgcli).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1i2(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (short) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2i2(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + memcpy(output, input, ntodo * sizeof(short) ); + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4i2(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8i2(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj,kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0, jj = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4i2(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (zero > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8i2(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (zero > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstri2(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcolj.c b/pkg/tbtables/cfitsio/getcolj.c new file mode 100644 index 00000000..f7df81c6 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcolj.c @@ -0,0 +1,3856 @@ +/* This file, getcolj.c, contains routines that read data elements from */ +/* a FITS image or table, with long data type. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long nulval, /* I - value for undefined pixels */ + long *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + long nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TLONG, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclj(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TLONG, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclj(fptr, 2, row, firstelem, nelem, 1, 2, 0L, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2dj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3dj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3dj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + long *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3], nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TLONG, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgclj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgclj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + long nulval, /* I - value to set undefined pixels */ + long *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + long nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TLONG, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgclj(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + long *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + long nulval = 0; + int hdutype, anyf; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TLONG, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgclj(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclj(fptr, 1, row, firstelem, nelem, 1, 1, 0L, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long nulval, /* I - value for null pixels */ + long *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + long dummy = 0; + + ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgclj( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + long nulval, /* I - value for null pixels if nultyp = 1 */ + long *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + if (ffgcpr(fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TLONG) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0. && LONGSIZE == 32) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next], + status); + if (convert) + fffi4i4((INT32BIT *) &array[next], ntodo, scale, zero, + nulcheck, (INT32BIT) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TLONGLONG): + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8i4((LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1i4((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2i4((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4i4((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8i4((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstri4((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgclj).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgclj).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1i4(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (long) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2i4(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (long) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4i4(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; + + Process the array of data in reverse order, to handle the case where + the input data is 4-bytes and the output is 8-bytes and the conversion + is being done in place in the same array. +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + output[ii] = (long) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = input[ii]; + + } + } + else /* must scale the data */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8i4(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj,kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < LONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (input[ii] > LONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < LONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (input[ii] > LONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4i4(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (input[ii] > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (input[ii] > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (zero > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8i4(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (input[ii] > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (input[ii] > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (zero > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstri4(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MIN; + } + else if (dvalue > DLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + output[ii] = (long) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} + +/* ======================================================================== */ +/* the following routines support the 'long long' data type */ +/* ======================================================================== */ + +/*--------------------------------------------------------------------------*/ +int ffgpvjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + LONGLONG nulval, /* I - value for undefined pixels */ + LONGLONG *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + LONGLONG nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TLONGLONG, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcljj(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + LONGLONG *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + LONGLONG dummy = 0; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TLONGLONG, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcljj(fptr, 2, row, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2djj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + LONGLONG nulval ,/* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + LONGLONG *array,/* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3djj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3djj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + LONGLONG nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + LONGLONG *array,/* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + LONGLONG nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TLONGLONG, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgcljj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgcljj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvjj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + LONGLONG nulval,/* I - value to set undefined pixels */ + LONGLONG *array,/* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + LONGLONG nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TLONGLONG, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgcljj(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfjj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + LONGLONG *array,/* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + LONGLONG nulval = 0; + int hdutype, anyf; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TLONGLONG, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcljj(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + LONGLONG *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + LONGLONG dummy = 0; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcljj(fptr, 1, row, firstelem, nelem, 1, 1, dummy, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvjj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + LONGLONG nulval, /* I - value for null pixels */ + LONGLONG *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfjj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + LONGLONG *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + LONGLONG dummy = 0; + + ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcljj( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + LONGLONG nulval, /* I - value for null pixels if nultyp = 1 */ + LONGLONG *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + if (ffgcpr(fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TLONGLONG) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0.) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TLONGLONG): + ffgi8b(fptr, readptr, ntodo, incre, (long *) &array[next], + status); + if (convert) + fffi8i8((LONGLONG *) &array[next], ntodo, scale, zero, + nulcheck, (LONGLONG) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4i8((INT32BIT *) buffer, ntodo, scale, zero, + nulcheck, (INT32BIT) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1i8((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2i8((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4i8((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8i8((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstri8((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgclj).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgclj).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1i8(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (LONGLONG) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2i8(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (LONGLONG) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4i8(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (LONGLONG) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (LONGLONG) input[ii]; + + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8i8(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = input[ii]; + + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4i8(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (zero > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8i8(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (zero > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstri8(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + LONGLONG *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcolk.c b/pkg/tbtables/cfitsio/getcolk.c new file mode 100644 index 00000000..f9a72d69 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcolk.c @@ -0,0 +1,2037 @@ +/* This file, getcolk.c, contains routines that read data elements from */ +/* a FITS image or table, with 'int' data type. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + int nulval, /* I - value for undefined pixels */ + int *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + int nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TINT, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclk(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + int *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TINT, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclk(fptr, 2, row, firstelem, nelem, 1, 2, 0L, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2dk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + int nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + int *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3dk(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3dk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + int nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + int *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + int nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TINT, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgclk(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgclk(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + int nulval, /* I - value to set undefined pixels */ + int *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + int nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TINT, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvk: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgclk(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + int *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + long nulval = 0; + int hdutype, anyf; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TINT, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgclk(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + int *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclk(fptr, 1, row, firstelem, nelem, 1, 1, 0L, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + int nulval, /* I - value for null pixels */ + int *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + int *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + int dummy = 0; + + ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgclk( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + int nulval, /* I - value for null pixels if nultyp = 1 */ + int *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int convert, nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* call the 'short' or 'long' version of this routine, if possible */ + if (sizeof(int) == sizeof(short)) + ffgcli(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp, + (short) nulval, (short *) array, nularray, anynul, status); + else if (sizeof(int) == sizeof(long)) + ffgclj(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp, + (long) nulval, (long *) array, nularray, anynul, status); + else + { + /* + This is a special case: sizeof(int) is not equal to sizeof(short) or + sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes, + int = 4 bytes, and long = 8 bytes. + */ + + buffer = cbuff; + power = 1.; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + convert = 1; + if (tcode == TLONG) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + + if (nulcheck == 0 && scale == 1. && zero == 0.) + convert = 0; /* no need to scale data or find nulls */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next], + status); + if (convert) + fffi4int((INT32BIT *) &array[next], ntodo, scale, zero, + nulcheck, (INT32BIT) tnull, nulval, + &nularray[next], anynul, &array[next], status); + break; + case (TLONGLONG): + + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8int( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1int((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2int((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4int((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8int((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstrint((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgclk).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgclk).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + } /* end of DEC Alpha special case */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1int(unsigned char *input,/* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (int) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2int(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (int) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4int(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (int) input[ii]; /* copy input to output */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (int) input[ii]; + + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8int(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj,kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < INT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (input[ii] > INT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < INT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (input[ii] > INT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4int(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (input[ii] > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (input[ii] > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (zero > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8int(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (input[ii] > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (input[ii] > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (zero > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstrint(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + output[ii] = (long) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcoll.c b/pkg/tbtables/cfitsio/getcoll.c new file mode 100644 index 00000000..a8a8516b --- /dev/null +++ b/pkg/tbtables/cfitsio/getcoll.c @@ -0,0 +1,612 @@ +/* This file, getcoll.c, contains routines that read data elements from */ +/* a FITS image or table, with logical datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffgcvl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + char nulval, /* I - value for null pixels */ + char *array, /* O - array of values */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of logical values from a column in the current FITS HDU. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcll( fptr, colnum, firstrow, firstelem, nelem, 1, nulval, array, + &cdummy, anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + char *array, /* O - array of values */ + int *status) /* IO - error status */ +/* + !!!! THIS ROUTINE IS DEPRECATED AND SHOULD NOT BE USED !!!!!! + !!!! USE ffgcvl INSTEAD !!!!!! + Read an array of logical values from a column in the current FITS HDU. + No checking for null values will be performed. +*/ +{ + char nulval = 0; + int anynul; + + ffgcvl( fptr, colnum, firstrow, firstelem, nelem, nulval, array, + &anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + char *array, /* O - array of values */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of logical values from a column in the current FITS HDU. +*/ +{ + char nulval = 0; + + ffgcll( fptr, colnum, firstrow, firstelem, nelem, 2, nulval, array, + nularray, anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcll( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + char nulval, /* I - value for null pixels if nultyp = 1 */ + char *array, /* O - array of values */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of logical values from a column in the current FITS HDU. +*/ +{ + int tcode, maxelem, hdutype, ii, nulcheck; + long twidth, incre, rownum; + long tnull, remain, next, ntodo; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + double scale, zero; + char tform[20]; + char message[FLEN_ERRMSG]; + char snull[20]; /* the FITS null value */ + unsigned char buffer[DBUFFSIZE], *buffptr; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode != TLOGICAL) + return(*status = NOT_LOGICAL_COL); + + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default, check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + /*---------------------------------------------------------------------*/ + /* Now read the logical values from the FITS column. */ + /*---------------------------------------------------------------------*/ + + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + ntodo = remain; /* max number of elements to read at one time */ + + while (ntodo) + { + /* + limit the number of pixels to read at one time to the number that + remain in the current vector. + */ + ntodo = minvalue(ntodo, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + readptr = startpos + (rowlen * rownum) + (elemnum * incre); + + ffgi1b(fptr, readptr, ntodo, incre, buffer, status); + + /* convert from T or F to 1 or 0 */ + buffptr = buffer; + for (ii = 0; ii < ntodo; ii++, next++, buffptr++) + { + if (*buffptr == 'T') + array[next] = 1; + else if (*buffptr =='F') + array[next] = 0; + else if (*buffptr == 0) + { + array[next] = nulval; /* set null values to input nulval */ + if (anynul) + *anynul = 1; + + if (nulcheck == 2) + { + nularray[next] = 1; /* set null flags */ + } + } + else /* some other illegal character; return the char value */ + { + array[next] = (char) *buffptr; + } + } + + if (*status > 0) /* test for error during previous read operation */ + { + sprintf(message, + "Error reading elements %ld thruough %ld of logical array (ffgcl).", + next+1, next + ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + elemnum += ntodo; + + if (elemnum == repeat) /* completed a row; start on later row */ + { + elemnum = 0; + rownum++; + } + } + ntodo = remain; /* this is the maximum number to do in next loop */ + + } /* End of main while Loop */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcx( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long frow, /* I - first row to write (1 = 1st row) */ + long fbit, /* I - first bit to write (1 = 1st) */ + long nbit, /* I - number of bits to write */ + char *larray, /* O - array of logicals corresponding to bits */ + int *status) /* IO - error status */ +/* + read an array of logical values from a specified bit or byte + column of the binary table. larray is set = TRUE, if the corresponding + bit = 1, otherwise it is set to FALSE. + The binary table column being read from must have datatype 'B' or 'X'. +*/ +{ + OFF_T bstart; + long offset, fbyte, bitloc, ndone; + long ii, repeat, rstart, estart; + int tcode, descrp; + unsigned char cbuff; + static unsigned char onbit[8] = {128, 64, 32, 16, 8, 4, 2, 1}; + tcolumn *colptr; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check input parameters */ + if (nbit < 1) + return(*status); + else if (frow < 1) + return(*status = BAD_ROW_NUM); + else if (fbit < 1) + return(*status = BAD_ELEM_NUM); + + /* position to the correct HDU */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + fbyte = (fbit + 7) / 8; + bitloc = fbit - 1 - ((fbit - 1) / 8 * 8); + ndone = 0; + rstart = frow - 1; + estart = fbyte - 1; + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + tcode = colptr->tdatatype; + + if (abs(tcode) > TBYTE) + return(*status = NOT_LOGICAL_COL); /* not correct datatype column */ + + if (tcode > 0) + { + descrp = FALSE; /* not a variable length descriptor column */ + /* N.B: REPEAT is the number of bytes, not number of bits */ + repeat = (long) colptr->trepeat; + + if (tcode == TBIT) + repeat = (repeat + 7) / 8; /* convert from bits to bytes */ + + if (fbyte > repeat) + return(*status = BAD_ELEM_NUM); + + /* calc the i/o pointer location to start of sequence of pixels */ + bstart = (fptr->Fptr)->datastart + ((fptr->Fptr)->rowlength * rstart) + + colptr->tbcol + estart; + } + else + { + descrp = TRUE; /* a variable length descriptor column */ + /* only bit arrays (tform = 'X') are supported for variable */ + /* length arrays. REPEAT is the number of BITS in the array. */ + + ffgdes(fptr, colnum, frow, &repeat, &offset, status); + + if (tcode == -TBIT) + repeat = (repeat + 7) / 8; + + if ((fbit + nbit + 6) / 8 > repeat) + return(*status = BAD_ELEM_NUM); + + /* calc the i/o pointer location to start of sequence of pixels */ + bstart = (fptr->Fptr)->datastart + offset + (fptr->Fptr)->heapstart + estart; + } + + /* move the i/o pointer to the start of the pixel sequence */ + if (ffmbyt(fptr, bstart, REPORT_EOF, status) > 0) + return(*status); + + /* read the next byte */ + while (1) + { + if (ffgbyt(fptr, 1, &cbuff, status) > 0) + return(*status); + + for (ii = bitloc; (ii < 8) && (ndone < nbit); ii++, ndone++) + { + if(cbuff & onbit[ii]) /* test if bit is set */ + larray[ndone] = TRUE; + else + larray[ndone] = FALSE; + } + + if (ndone == nbit) /* finished all the bits */ + return(*status); + + /* not done, so get the next byte */ + if (!descrp) + { + estart++; + if (estart == repeat) + { + /* move the i/o pointer to the next row of pixels */ + estart = 0; + rstart = rstart + 1; + bstart = (fptr->Fptr)->datastart + ((fptr->Fptr)->rowlength * rstart) + + colptr->tbcol; + + ffmbyt(fptr, bstart, REPORT_EOF, status); + } + } + bitloc = 0; + } +} +/*--------------------------------------------------------------------------*/ +int ffgcxui(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long nrows, /* I - no. of rows to read */ + long input_first_bit, /* I - first bit to read (1 = 1st) */ + int input_nbits, /* I - number of bits to read (<= 32) */ + unsigned short *array, /* O - array of integer values */ + int *status) /* IO - error status */ +/* + Read a consecutive string of bits from an 'X' or 'B' column and + interprete them as an unsigned integer. The number of bits must be + less than or equal to 16 or the total number of bits in the column, + which ever is less. +*/ +{ + int ii, firstbit, nbits, bytenum, startbit, numbits, endbit; + int firstbyte, lastbyte, nbytes, rshift, lshift; + unsigned short colbyte[5]; + tcolumn *colptr; + char message[81]; + + if (*status > 0 || nrows == 0) + return(*status); + + /* check input parameters */ + if (firstrow < 1) + { + sprintf(message, "Starting row number is less than 1: %ld (ffgcxui)", + firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + else if (input_first_bit < 1) + { + sprintf(message, "Starting bit number is less than 1: %ld (ffgcxui)", + input_first_bit); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + else if (input_nbits > 16) + { + sprintf(message, "Number of bits to read is > 16: %d (ffgcxui)", + input_nbits); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + + /* position to the correct HDU */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype != BINARY_TBL) + { + ffpmsg("This is not a binary table extension (ffgcxui)"); + return(*status = NOT_BTABLE); + } + + if (colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d (ffgcxui)", + colnum); + ffpmsg(message); + sprintf(message, " There are %d columns in this table.", + (fptr->Fptr)->tfield ); + ffpmsg(message); + + return(*status = BAD_COL_NUM); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + if (abs(colptr->tdatatype) > TBYTE) + { + ffpmsg("Can only read bits from X or B type columns. (ffgcxui)"); + return(*status = NOT_LOGICAL_COL); /* not correct datatype column */ + } + + firstbyte = (input_first_bit - 1 ) / 8 + 1; + lastbyte = (input_first_bit + input_nbits - 2) / 8 + 1; + nbytes = lastbyte - firstbyte + 1; + + if (colptr->tdatatype == TBIT && + input_first_bit + input_nbits - 1 > (long) colptr->trepeat) + { + ffpmsg("Too many bits. Tried to read past width of column (ffgcxui)"); + return(*status = BAD_ELEM_NUM); + } + else if (colptr->tdatatype == TBYTE && lastbyte > (long) colptr->trepeat) + { + ffpmsg("Too many bits. Tried to read past width of column (ffgcxui)"); + return(*status = BAD_ELEM_NUM); + } + + for (ii = 0; ii < nrows; ii++) + { + /* read the relevant bytes from the row */ + if (ffgcvui(fptr, colnum, firstrow+ii, firstbyte, nbytes, 0, + colbyte, NULL, status) > 0) + { + ffpmsg("Error reading bytes from column (ffgcxui)"); + return(*status); + } + + firstbit = (input_first_bit - 1) % 8; /* modulus operator */ + nbits = input_nbits; + + array[ii] = 0; + + /* select and shift the bits from each byte into the output word */ + while(nbits) + { + bytenum = firstbit / 8; + + startbit = firstbit % 8; + numbits = minvalue(nbits, 8 - startbit); + endbit = startbit + numbits - 1; + + rshift = 7 - endbit; + lshift = nbits - numbits; + + array[ii] = ((colbyte[bytenum] >> rshift) << lshift) | array[ii]; + + nbits -= numbits; + firstbit += numbits; + } + } + + return(*status); +} + +/*--------------------------------------------------------------------------*/ +int ffgcxuk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long nrows, /* I - no. of rows to read */ + long input_first_bit, /* I - first bit to read (1 = 1st) */ + int input_nbits, /* I - number of bits to read (<= 32) */ + unsigned int *array, /* O - array of integer values */ + int *status) /* IO - error status */ +/* + Read a consecutive string of bits from an 'X' or 'B' column and + interprete them as an unsigned integer. The number of bits must be + less than or equal to 32 or the total number of bits in the column, + which ever is less. +*/ +{ + int ii, firstbit, nbits, bytenum, startbit, numbits, endbit; + int firstbyte, lastbyte, nbytes, rshift, lshift; + unsigned int colbyte[5]; + tcolumn *colptr; + char message[81]; + + if (*status > 0 || nrows == 0) + return(*status); + + /* check input parameters */ + if (firstrow < 1) + { + sprintf(message, "Starting row number is less than 1: %ld (ffgcxuk)", + firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + else if (input_first_bit < 1) + { + sprintf(message, "Starting bit number is less than 1: %ld (ffgcxuk)", + input_first_bit); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + else if (input_nbits > 32) + { + sprintf(message, "Number of bits to read is > 32: %d (ffgcxuk)", + input_nbits); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + + /* position to the correct HDU */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if ((fptr->Fptr)->hdutype != BINARY_TBL) + { + ffpmsg("This is not a binary table extension (ffgcxuk)"); + return(*status = NOT_BTABLE); + } + + if (colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d (ffgcxuk)", + colnum); + ffpmsg(message); + sprintf(message, " There are %d columns in this table.", + (fptr->Fptr)->tfield ); + ffpmsg(message); + + return(*status = BAD_COL_NUM); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + if (abs(colptr->tdatatype) > TBYTE) + { + ffpmsg("Can only read bits from X or B type columns. (ffgcxuk)"); + return(*status = NOT_LOGICAL_COL); /* not correct datatype column */ + } + + firstbyte = (input_first_bit - 1 ) / 8 + 1; + lastbyte = (input_first_bit + input_nbits - 2) / 8 + 1; + nbytes = lastbyte - firstbyte + 1; + + if (colptr->tdatatype == TBIT && + input_first_bit + input_nbits - 1 > (long) colptr->trepeat) + { + ffpmsg("Too many bits. Tried to read past width of column (ffgcxuk)"); + return(*status = BAD_ELEM_NUM); + } + else if (colptr->tdatatype == TBYTE && lastbyte > (long) colptr->trepeat) + { + ffpmsg("Too many bits. Tried to read past width of column (ffgcxuk)"); + return(*status = BAD_ELEM_NUM); + } + + for (ii = 0; ii < nrows; ii++) + { + /* read the relevant bytes from the row */ + if (ffgcvuk(fptr, colnum, firstrow+ii, firstbyte, nbytes, 0, + colbyte, NULL, status) > 0) + { + ffpmsg("Error reading bytes from column (ffgcxuk)"); + return(*status); + } + + firstbit = (input_first_bit - 1) % 8; /* modulus operator */ + nbits = input_nbits; + + array[ii] = 0; + + /* select and shift the bits from each byte into the output word */ + while(nbits) + { + bytenum = firstbit / 8; + + startbit = firstbit % 8; + numbits = minvalue(nbits, 8 - startbit); + endbit = startbit + numbits - 1; + + rshift = 7 - endbit; + lshift = nbits - numbits; + + array[ii] = ((colbyte[bytenum] >> rshift) << lshift) | array[ii]; + + nbits -= numbits; + firstbit += numbits; + } + } + + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcols.c b/pkg/tbtables/cfitsio/getcols.c new file mode 100644 index 00000000..b3c25209 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcols.c @@ -0,0 +1,743 @@ +/* This file, getcols.c, contains routines that read data elements from */ +/* a FITS image or table, with a character string datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +/* stddef.h is apparently needed to define size_t */ +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffgcvs( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of strings to read */ + char *nulval, /* I - string for null pixels */ + char **array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of string values from a column in the current FITS HDU. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = null in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy[2]; + + ffgcls(fptr, colnum, firstrow, firstelem, nelem, 1, nulval, + array, cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfs( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of strings to read */ + char **array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of string values from a column in the current FITS HDU. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + char dummy[2]; + + ffgcls(fptr, colnum, firstrow, firstelem, nelem, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcls( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of strings to read */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + char *nulval, /* I - value for null pixels if nultyp = 1 */ + char **array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of string values from a column in the current FITS HDU. + Returns a formated string value, regardless of the datatype of the column +*/ +{ + int tcode, hdutype, tstatus, scaled, intcol, dwidth, nulwidth, ll; + long ii, jj; + tcolumn *colptr; + char message[FLEN_ERRMSG], *carray, keyname[FLEN_KEYWORD]; + char cform[20], dispfmt[20], tmpstr[80]; + unsigned char byteval; + float *earray; + double *darray, tscale = 1.0; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d", + colnum); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + tcode = abs(colptr->tdatatype); + + if (tcode == TSTRING) + { + /* simply call the string column reading routine */ + ffgcls2(fptr, colnum, firstrow, firstelem, nelem, nultyp, nulval, + array, nularray, anynul, status); + } + else if (tcode == TLOGICAL) + { + /* allocate memory for the array of logical values */ + carray = (char *) malloc(nelem); + + /* call the logical column reading routine */ + ffgcll(fptr, colnum, firstrow, firstelem, nelem, nultyp, *nulval, + carray, nularray, anynul, status); + + if (*status <= 0) + { + /* convert logical values to "T", "F", or "N" (Null) */ + for (ii = 0; ii < nelem; ii++) + { + if (carray[ii] == 1) + strcpy(array[ii], "T"); + else if (carray[ii] == 0) + strcpy(array[ii], "F"); + else /* undefined values = 2 */ + strcpy(array[ii],"N"); + } + } + + free(carray); /* free the memory */ + } + else if (tcode == TCOMPLEX) + { + /* allocate memory for the array of double values */ + earray = (float *) calloc(nelem * 2, sizeof(float) ); + + ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, FLOATNULLVALUE, earray, nularray, anynul, status); + + if (*status <= 0) + { + + /* determine the format for the output strings */ + + ffgcdw(fptr, colnum, &dwidth, status); + dwidth = (dwidth - 3) / 2; + + /* use the TDISPn keyword if it exists */ + ffkeyn("TDISP", colnum, keyname, status); + tstatus = 0; + cform[0] = '\0'; + + if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0) + { + /* convert the Fortran style format to a C style format */ + ffcdsp(dispfmt, cform); + } + + if (!cform[0]) + strcpy(cform, "%14.6E"); + + /* write the formated string for each value: "(real,imag)" */ + jj = 0; + for (ii = 0; ii < nelem; ii++) + { + strcpy(array[ii], "("); + + /* test for null value */ + if (earray[jj] == FLOATNULLVALUE) + { + strcpy(tmpstr, "NULL"); + if (nultyp == 2) + nularray[ii] = 1; + } + else + sprintf(tmpstr, cform, earray[jj]); + + strncat(array[ii], tmpstr, dwidth); + strcat(array[ii], ","); + jj++; + + /* test for null value */ + if (earray[jj] == FLOATNULLVALUE) + { + strcpy(tmpstr, "NULL"); + if (nultyp == 2) + nularray[ii] = 1; + } + else + sprintf(tmpstr, cform, earray[jj]); + + strncat(array[ii], tmpstr, dwidth); + strcat(array[ii], ")"); + jj++; + } + } + + free(earray); /* free the memory */ + } + else if (tcode == TDBLCOMPLEX) + { + /* allocate memory for the array of double values */ + darray = (double *) calloc(nelem * 2, sizeof(double) ); + + ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + 1, 1, DOUBLENULLVALUE, darray, nularray, anynul, status); + + if (*status <= 0) + { + /* determine the format for the output strings */ + + ffgcdw(fptr, colnum, &dwidth, status); + dwidth = (dwidth - 3) / 2; + + /* use the TDISPn keyword if it exists */ + ffkeyn("TDISP", colnum, keyname, status); + tstatus = 0; + cform[0] = '\0'; + + if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0) + { + /* convert the Fortran style format to a C style format */ + ffcdsp(dispfmt, cform); + } + + if (!cform[0]) + strcpy(cform, "%23.15E"); + + /* write the formated string for each value: "(real,imag)" */ + jj = 0; + for (ii = 0; ii < nelem; ii++) + { + strcpy(array[ii], "("); + + /* test for null value */ + if (darray[jj] == DOUBLENULLVALUE) + { + strcpy(tmpstr, "NULL"); + if (nultyp == 2) + nularray[ii] = 1; + } + else + sprintf(tmpstr, cform, darray[jj]); + + strncat(array[ii], tmpstr, dwidth); + strcat(array[ii], ","); + jj++; + + /* test for null value */ + if (darray[jj] == DOUBLENULLVALUE) + { + strcpy(tmpstr, "NULL"); + if (nultyp == 2) + nularray[ii] = 1; + } + else + sprintf(tmpstr, cform, darray[jj]); + + strncat(array[ii], tmpstr, dwidth); + strcat(array[ii], ")"); + jj++; + } + } + + free(darray); /* free the memory */ + } + else + { + /* allocate memory for the array of double values */ + darray = (double *) calloc(nelem, sizeof(double) ); + + /* read all other numeric type columns as doubles */ + if (ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, nultyp, + DOUBLENULLVALUE, darray, nularray, anynul, status) > 0) + { + free(darray); + return(*status); + } + + /* determine the format for the output strings */ + + ffgcdw(fptr, colnum, &dwidth, status); + + /* check if column is scaled */ + ffkeyn("TSCAL", colnum, keyname, status); + tstatus = 0; + scaled = 0; + if (ffgkyd(fptr, keyname, &tscale, NULL, &tstatus) == 0) + { + if (tscale != 1.0) + scaled = 1; /* yes, this is a scaled column */ + } + + intcol = 0; + if (tcode <= TLONG && !scaled) + intcol = 1; /* this is an unscaled integer column */ + + /* use the TDISPn keyword if it exists */ + ffkeyn("TDISP", colnum, keyname, status); + tstatus = 0; + cform[0] = '\0'; + + if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0) + { + /* convert the Fortran style TDISPn to a C style format */ + ffcdsp(dispfmt, cform); + } + + if (!cform[0]) + { + /* no TDISPn keyword; use TFORMn instead */ + + ffkeyn("TFORM", colnum, keyname, status); + ffgkys(fptr, keyname, dispfmt, NULL, status); + + if (scaled && tcode <= TSHORT) + { + /* scaled short integer column == float */ + strcpy(cform, "%#14.6G"); + } + else if (scaled && tcode == TLONG) + { + /* scaled long integer column == double */ + strcpy(cform, "%#23.15G"); + } + else + { + ffghdt(fptr, &hdutype, status); + if (hdutype == ASCII_TBL) + { + /* convert the Fortran style TFORMn to a C style format */ + ffcdsp(dispfmt, cform); + } + else + { + /* this is a binary table, need to convert the format */ + if (tcode == TBIT) { /* 'X' */ + strcpy(cform, "%4d"); + } else if (tcode == TBYTE) { /* 'B' */ + strcpy(cform, "%4d"); + } else if (tcode == TSHORT) { /* 'I' */ + strcpy(cform, "%6d"); + } else if (tcode == TLONG) { /* 'J' */ + strcpy(cform, "%11.0f"); + intcol = 0; /* needed to support unsigned int */ + } else if (tcode == TFLOAT) { /* 'E' */ + strcpy(cform, "%#14.6G"); + } else if (tcode == TDOUBLE) { /* 'D' */ + strcpy(cform, "%#23.15G"); + } + } + } + } + + /* write the formated string for each value */ + nulwidth = strlen(nulval); + for (ii = 0; ii < nelem; ii++) + { + if (tcode == TBIT) + { + byteval = (char) darray[ii]; + + for (ll=0; ll < 8; ll++) + { + if ( ((unsigned char) (byteval << ll)) >> 7 ) + *(array[ii] + ll) = '1'; + else + *(array[ii] + ll) = '0'; + } + *(array[ii] + 8) = '\0'; + } + /* test for null value */ + else if ( (nultyp == 1 && darray[ii] == DOUBLENULLVALUE) || + (nultyp == 2 && nularray[ii]) ) + { + *array[ii] = '\0'; + if (dwidth < nulwidth) + strncat(array[ii], nulval, dwidth); + else + sprintf(array[ii],"%*s",dwidth,nulval); + } + else + { + if (intcol) + sprintf(tmpstr, cform, (int) darray[ii]); + else + sprintf(tmpstr, cform, darray[ii]); + + *array[ii] = '\0'; + strncat(array[ii], tmpstr, dwidth); + } + } + + free(darray); /* free the memory */ + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcdw( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column (1 = 1st col) */ + int *width, /* O - display width */ + int *status) /* IO - error status */ +/* + Get Column Display Width. +*/ +{ + tcolumn *colptr; + char *cptr; + char message[FLEN_ERRMSG], keyname[FLEN_KEYWORD], dispfmt[20]; + int tcode, hdutype, tstatus, scaled; + double tscale; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d", + colnum); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + tcode = abs(colptr->tdatatype); + + /* use the TDISPn keyword if it exists */ + ffkeyn("TDISP", colnum, keyname, status); + + *width = 0; + tstatus = 0; + if (ffgkys(fptr, keyname, dispfmt, NULL, &tstatus) == 0) + { + /* parse TDISPn get the display width */ + cptr = dispfmt; + while(*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == 'A' || *cptr == 'a' || + *cptr == 'I' || *cptr == 'i' || + *cptr == 'O' || *cptr == 'o' || + *cptr == 'Z' || *cptr == 'z' || + *cptr == 'F' || *cptr == 'f' || + *cptr == 'E' || *cptr == 'e' || + *cptr == 'D' || *cptr == 'd' || + *cptr == 'G' || *cptr == 'g') + { + + while(!isdigit((int) *cptr) && *cptr != '\0') /* find 1st digit */ + cptr++; + + *width = atoi(cptr); + if (tcode >= TCOMPLEX) + *width = (2 * (*width)) + 3; + } + } + + if (*width == 0) + { + /* no valid TDISPn keyword; use TFORMn instead */ + + ffkeyn("TFORM", colnum, keyname, status); + ffgkys(fptr, keyname, dispfmt, NULL, status); + + /* check if column is scaled */ + ffkeyn("TSCAL", colnum, keyname, status); + tstatus = 0; + scaled = 0; + + if (ffgkyd(fptr, keyname, &tscale, NULL, &tstatus) == 0) + { + if (tscale != 1.0) + scaled = 1; /* yes, this is a scaled column */ + } + + if (scaled && tcode <= TSHORT) + { + /* scaled short integer col == float; default format is 14.6G */ + *width = 14; + } + else if (scaled && tcode == TLONG) + { + /* scaled long integer col == double; default format is 23.15G */ + *width = 23; + } + else + { + ffghdt(fptr, &hdutype, status); /* get type of table */ + if (hdutype == ASCII_TBL) + { + /* parse TFORMn get the display width */ + cptr = dispfmt; + while(!isdigit((int) *cptr) && *cptr != '\0') /* find 1st digit */ + cptr++; + + *width = atoi(cptr); + } + else + { + /* this is a binary table */ + if (tcode == TBIT) /* 'X' */ + *width = 8; + else if (tcode == TBYTE) /* 'B' */ + *width = 4; + else if (tcode == TSHORT) /* 'I' */ + *width = 6; + else if (tcode == TLONG) /* 'J' */ + *width = 11; + else if (tcode == TFLOAT) /* 'E' */ + *width = 14; + else if (tcode == TDOUBLE) /* 'D' */ + *width = 23; + else if (tcode == TCOMPLEX) /* 'C' */ + *width = 31; + else if (tcode == TDBLCOMPLEX) /* 'M' */ + *width = 49; + else if (tcode == TLOGICAL) /* 'L' */ + *width = 1; + else if (tcode == TSTRING) /* 'A' */ + { + cptr = dispfmt; + while(!isdigit((int) *cptr) && *cptr != '\0') + cptr++; + + *width = atoi(cptr); + + if (*width < 1) + *width = 1; /* default is at least 1 column */ + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcls2 ( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of strings to read */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + char *nulval, /* I - value for null pixels if nultyp = 1 */ + char **array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of string values from a column in the current FITS HDU. +*/ +{ + long nullen; + int tcode, maxelem, hdutype, nulcheck; + long twidth, incre, rownum; + long ii, jj, ntodo, tnull, remain, next; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + double scale, zero; + char tform[20]; + char message[FLEN_ERRMSG]; + char snull[20]; /* the FITS null value */ + tcolumn *colptr; + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + char *buffer, *arrayptr; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d", + colnum); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + tcode = colptr->tdatatype; + + if (tcode == -TSTRING) /* variable length column in a binary table? */ + { + /* only read a single string; ignore value of firstelem */ + + if (ffgcpr( fptr, colnum, firstrow, 1, 1, 0, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + remain = 1; + twidth = repeat; + } + else if (tcode == TSTRING) + { + if (ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + remain = nelem; + } + else + return(*status = NOT_ASCII_COL); + + nullen = strlen(snull); /* length of the undefined pixel string */ + if (nullen == 0) + nullen = 1; + + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval[0] == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; /* null value string in ASCII table not defined */ + + else if (nullen > twidth) + nulcheck = 0; /* null value string is longer than width of column */ + /* thus impossible for any column elements to = null */ + + /*---------------------------------------------------------------------*/ + /* Now read the strings one at a time from the FITS column. */ + /*---------------------------------------------------------------------*/ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + ffmbyt(fptr, readptr, REPORT_EOF, status); /* move to read position */ + + /* read the array of strings from the FITS file into the buffer */ + + if (incre == twidth) + ffgbyt(fptr, ntodo * twidth, cbuff, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, cbuff, status); + + /* copy from the buffer into the user's array of strings */ + /* work backwards from last char of last string to 1st char of 1st */ + + buffer = ((char *) cbuff) + (ntodo * twidth) - 1; + + for (ii = next + ntodo - 1; ii >= next; ii--) + { + arrayptr = array[ii] + twidth - 1; + + for (jj = twidth - 1; jj > 0; jj--) /* ignore trailing blanks */ + { + if (*buffer == ' ') + { + buffer--; + arrayptr--; + } + else + break; + } + *(arrayptr + 1) = 0; /* write the string terminator */ + + for (; jj >= 0; jj--) /* copy the string itself */ + { + *arrayptr = *buffer; + buffer--; + arrayptr--; + } + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (nulcheck && !strncmp(snull, array[ii], nullen) ) + { + *anynul = 1; /* this is a null value */ + if (nultyp == 1) + strcpy(array[ii], nulval); + else + nularray[ii] = 1; + } + } + + if (*status > 0) /* test for error during previous read operation */ + { + sprintf(message, + "Error reading elements %ld thru %ld of data array (ffpcls).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + next += ntodo; + remain -= ntodo; + if (remain) + { + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/getcolsb.c b/pkg/tbtables/cfitsio/getcolsb.c new file mode 100644 index 00000000..b04c6795 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcolsb.c @@ -0,0 +1,2133 @@ +/* This file, getcolsb.c, contains routines that read data elements from */ +/* a FITS image or table, with signed char (signed byte) data type. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvsb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + signed char nulval, /* I - value for undefined pixels */ + signed char *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + signed char nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TSBYTE, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclsb(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfsb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + signed char *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TSBYTE, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclsb(fptr, 2, row, firstelem, nelem, 1, 2, 0, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2dsb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + signed char nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + signed char *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3dsb(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3dsb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + signed char nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + signed char *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + signed char nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TSBYTE, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgclsb(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgclsb(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvsb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + signed char nulval, /* I - value to set undefined pixels */ + signed char *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii, i0, i1, i2, i3, i4, i5, i6, i7, i8, row, rstr, rstp, rinc; + long str[9], stp[9], incr[9], dir[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + signed char nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvsb is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TSBYTE, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + dir[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + if (hdutype == IMAGE_HDU) + { + dir[ii] = -1; + } + else + { + sprintf(msg, "ffgsvsb: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + dsize[ii] = dsize[ii] * dir[ii]; + } + dsize[naxis] = dsize[naxis] * dir[naxis]; + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1; + ninc = incr[0] * dir[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8]) + { + for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7]) + { + for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6]) + { + for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5]) + { + for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4]) + { + for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3]) + { + for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2]) + { + for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1]) + { + + felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] + + (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] + + (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] + + (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8]; + + if ( ffgclsb(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfsb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + signed char *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + int hdutype, anyf; + signed char nulval = 0; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvsb is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TSBYTE, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvsb: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgclsb(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpsb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + signed char *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclsb(fptr, 1, row, firstelem, nelem, 1, 1, 0, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvsb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + signed char nulval, /* I - value for null pixels */ + signed char *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfsb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + signed char *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + signed char dummy = 0; + + ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgclsb(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + signed char nulval, /* I - value for null pixels if nultyp = 1 */ + signed char *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int nulcheck, readcheck = 0; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + union u_tag { + char charval; + signed char scharval; + } u; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (elemincre < 0) + readcheck = -1; /* don't do range checking in this case */ + + ffgcpr( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status); + + /* special case: read column of T/F logicals */ + if (tcode == TLOGICAL && elemincre == 1) + { + u.scharval = nulval; + ffgcll(fptr, colnum, firstrow, firstelem, nelem, nultyp, + u.charval, (char *) array, nularray, anynul, status); + + return(*status); + } + + if (strchr(tform,'A') != NULL) + { + if (*status == BAD_ELEM_NUM) + { + /* ignore this error message */ + *status = 0; + ffcmsg(); /* clear error stack */ + } + + /* interpret a 'A' ASCII column as a 'B' byte column ('8A' == '8B') */ + /* This is an undocumented 'feature' in CFITSIO */ + + /* we have to reset some of the values returned by ffgcpr */ + + tcode = TBYTE; + incre = 1; /* each element is 1 byte wide */ + repeat = twidth; /* total no. of chars in the col */ + twidth = 1; /* width of each element */ + scale = 1.0; /* no scaling */ + zero = 0.0; + tnull = NULL_UNDEFINED; /* don't test for nulls */ + maxelem = DBUFFSIZE; + } + + if (*status > 0) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING && hdutype == ASCII_TBL) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default, check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + if (elemincre >= 0) + { + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + } + else + { + ntodo = minvalue(ntodo, (elemnum/(-elemincre) +1)); + } + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) &array[next], status); + fffi1s1((unsigned char *)&array[next], ntodo, scale, zero, + nulcheck, (unsigned char) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2s1((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4s1((INT32BIT *) buffer, ntodo, scale, zero, nulcheck, + (INT32BIT) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONGLONG): + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8s1( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4s1((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8s1((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + /* interpret the string as an ASCII formated number */ + fffstrs1((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read bytes from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgclsb).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgclsb).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + else if (elemnum < 0) /* completed a row; start on a previous row */ + { + rowincre = (-elemnum - 1) / repeat + 1; + rownum -= rowincre; + elemnum = (rowincre * repeat) + elemnum; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1s1(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == -128.) + { + /* Instead of subtracting 128, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(signed char *) &input[ii] ) ^ 0x80; + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; /* copy input */ + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == -128.) + { + /* Instead of subtracting 128, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = ( *(signed char *) &input[ii] ) ^ 0x80; + } + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (signed char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2s1(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < -128) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + + else + { + if (input[ii] < -128) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4s1(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < -128) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < -128) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8s1(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj, kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DSCHAR_MIN ) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < -128) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < -128) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4s1(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + /* use redundant boolean logic in following statement */ + /* to suppress irritating Borland compiler warning message */ + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (zero > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8s1(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (input[ii] > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (zero > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstrs1(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + signed char nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + signed char *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DSCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = -128; + } + else if (dvalue > DSCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + output[ii] = (signed char) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcolui.c b/pkg/tbtables/cfitsio/getcolui.c new file mode 100644 index 00000000..7852aa4c --- /dev/null +++ b/pkg/tbtables/cfitsio/getcolui.c @@ -0,0 +1,2050 @@ +/* This file, getcolui.c, contains routines that read data elements from */ +/* a FITS image or table, with unsigned short datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvui( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned short nulval, /* I - value for undefined pixels */ + unsigned short *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + unsigned short nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TUSHORT, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclui(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfui( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned short *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TUSHORT, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclui(fptr, 2, row, firstelem, nelem, 1, 2, 0, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2dui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned short nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned short *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3dui(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3dui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned short nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned short *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + unsigned short nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TUSHORT, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgclui(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgclui(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvui(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned short nulval, /* I - value to set undefined pixels */ + unsigned short *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + unsigned short nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvui is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TUSHORT, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvui: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + if ( ffgclui(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfui(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned short *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + int hdutype, anyf; + unsigned short nulval = 0; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvi is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TUSHORT, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvi: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgclui(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpui( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned short *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgclui(fptr, 1, row, firstelem, nelem, 1, 1, 0, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvui(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned short nulval, /* I - value for null pixels */ + unsigned short *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfui(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned short *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + unsigned short dummy = 0; + + ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgclui( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + unsigned short nulval, /* I - value for null pixels if nultyp = 1 */ + unsigned short *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int nulcheck; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + if (tcode == TSHORT) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, + (short *) &array[next], status); + fffi2u2((short *) &array[next], ntodo, scale, + zero, nulcheck, (short) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TLONGLONG): + + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8u2( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1u2((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4u2((INT32BIT *) buffer, ntodo, scale, zero, nulcheck, + (INT32BIT) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4u2((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8u2((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstru2((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgclui).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgclui).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1u2(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (unsigned short) input[ii]; /* copy input */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2u2(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 32768.) + { + /* Instead of adding 32768, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(unsigned short *) &input[ii] ) ^ 0x8000; + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned short) input[ii]; /* copy input */ + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 32768.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = ( *(unsigned short *) &input[ii] ) ^ 0x8000; + } + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned short) input[ii]; /* copy input */ + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4u2(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > USHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > USHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8u2(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj,kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > USHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > USHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4u2(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8u2(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstru2(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned short *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DUSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcoluj.c b/pkg/tbtables/cfitsio/getcoluj.c new file mode 100644 index 00000000..5cdf486c --- /dev/null +++ b/pkg/tbtables/cfitsio/getcoluj.c @@ -0,0 +1,2044 @@ +/* This file, getcoluj.c, contains routines that read data elements from */ +/* a FITS image or table, with unsigned long data type. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvuj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned long nulval, /* I - value for undefined pixels */ + unsigned long *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + unsigned long nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TULONG, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcluj(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfuj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned long *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TULONG, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcluj(fptr, 2, row, firstelem, nelem, 1, 2, 0L, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2duj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned long nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned long *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3duj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3duj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned long nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned long *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + unsigned long nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TULONG, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgcluj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgcluj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvuj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned long nulval, /* I - value to set undefined pixels */ + unsigned long *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + unsigned long nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvuj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TULONG, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvuj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcluj(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfuj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned long *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + unsigned long nulval = 0; + int hdutype, anyf; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TULONG, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcluj(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpuj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned long *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcluj(fptr, 1, row, firstelem, nelem, 1, 1, 0L, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvuj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned long nulval, /* I - value for null pixels */ + unsigned long *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfuj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned long *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + unsigned long dummy = 0; + + ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcluj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + unsigned long nulval, /* I - value for null pixels if nultyp = 1 */ + unsigned long *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int nulcheck; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + if (tcode == TLONG) /* Special Case: */ + { /* no type convertion required, so read */ + maxelem = nelem; /* data directly into output buffer. */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next], + status); + fffi4u4((INT32BIT *) &array[next], ntodo, scale, zero, + nulcheck, (INT32BIT) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TLONGLONG): + + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8u4( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1u4((unsigned char *) buffer, ntodo, scale, zero, nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2u4((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4u4((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8u4((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstru4((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgcluj).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgcluj).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1u4(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (unsigned long) input[ii]; /* copy input */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2u4(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4u4(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; + + Process the array of data in reverse order, to handle the case where + the input data is 4-bytes and the output is 8-bytes and the conversion + is being done in place in the same array. +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 2147483648.) + { + /* Instead of adding 2147483648, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = ntodo - 1; ii >= 0; ii--) + output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000; + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned long) input[ii]; /* copy input */ + } + } + else /* must scale the data */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 2147483648.) + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000; + } + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned long) input[ii]; /* copy input */ + } + } + else /* must scale the data */ + { + for (ii = ntodo - 1; ii >= 0; ii--) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8u4(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj,kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk =+ 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > ULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > ULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4u4(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8u4(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstru4(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned long *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DULONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getcoluk.c b/pkg/tbtables/cfitsio/getcoluk.c new file mode 100644 index 00000000..fdbe5395 --- /dev/null +++ b/pkg/tbtables/cfitsio/getcoluk.c @@ -0,0 +1,2059 @@ +/* This file, getcolk.c, contains routines that read data elements from */ +/* a FITS image or table, with 'unsigned int' data type. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgpvuk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned int nulval, /* I - value for undefined pixels */ + unsigned int *array, /* O - array of values that are returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Undefined elements will be set equal to NULVAL, unless NULVAL=0 + in which case no checking for undefined values will be performed. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + char cdummy; + int nullcheck = 1; + unsigned int nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_pixels(fptr, TUINT, firstelem, nelem, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcluk(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfuk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned int *array, /* O - array of values that are returned */ + char *nularray, /* O - array of null pixel flags */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). + Any undefined pixels in the returned array will be set = 0 and the + corresponding nularray value will be set = 1. + ANYNUL is returned with a value of .true. if any pixels are undefined. +*/ +{ + long row; + int nullcheck = 2; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TUINT, firstelem, nelem, + nullcheck, NULL, array, nularray, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcluk(fptr, 2, row, firstelem, nelem, 1, 2, 0L, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2duk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned int nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned int *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + /* call the 3D reading routine, with the 3rd dimension = 1 */ + + ffg3duk(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3duk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + unsigned int nulval, /* set undefined pixels equal to this */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned int *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an entire 3-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being read). Any null + values in the array will be set equal to the value of nulval, unless + nulval = 0 in which case no null checking will be performed. +*/ +{ + long tablerow, nfits, narray, ii, jj; + char cdummy; + int nullcheck = 1; + long inc[] = {1,1,1}; + long fpixel[] = {1,1,1}; + long lpixel[3]; + unsigned int nullvalue; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TUINT, fpixel, lpixel, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so read all at once */ + ffgcluk(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to read */ + narray = 0; /* next pixel in output array to be filled */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* reading naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffgcluk(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval, + &array[narray], &cdummy, anynul, status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsvuk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned int nulval, /* I - value to set undefined pixels */ + unsigned int *array, /* O - array to be filled and returned */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9]; + long nelem, nultyp, ninc, numcol; + OFF_T felem, dsize[10]; + int hdutype, anyf; + char ldummy, msg[FLEN_ERRMSG]; + int nullcheck = 1; + unsigned int nullvalue; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvuk is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + nullvalue = nulval; /* set local variable */ + + fits_read_compressed_img(fptr, TUINT, blc, trc, inc, + nullcheck, &nullvalue, array, NULL, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 1; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvuk: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcluk(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &ldummy, &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsfuk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read (1 = 1st) */ + int naxis, /* I - number of dimensions in the FITS array */ + long *naxes, /* I - size of each dimension */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc, /* I - 'top right corner' of the subsection */ + long *inc, /* I - increment to be applied in each dimension */ + unsigned int *array, /* O - array to be filled and returned */ + char *flagval, /* O - set to 1 if corresponding value is null */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a subsection of data values from an image or a table column. + This routine is set up to handle a maximum of nine dimensions. +*/ +{ + long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc; + long str[9],stp[9],incr[9],dsize[10]; + long felem, nelem, nultyp, ninc, numcol; + long nulval = 0; + int hdutype, anyf; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis); + ffpmsg(msg); + return(*status = BAD_DIMEN); + } + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_img(fptr, TUINT, blc, trc, inc, + nullcheck, NULL, array, flagval, anynul, status); + return(*status); + } + +/* + if this is a primary array, then the input COLNUM parameter should + be interpreted as the row number, and we will alway read the image + data from column 2 (any group parameters are in column 1). +*/ + if (ffghdt(fptr, &hdutype, status) > 0) + return(*status); + + if (hdutype == IMAGE_HDU) + { + /* this is a primary array, or image extension */ + if (colnum == 0) + { + rstr = 1; + rstp = 1; + } + else + { + rstr = colnum; + rstp = colnum; + } + rinc = 1; + numcol = 2; + } + else + { + /* this is a table, so the row info is in the (naxis+1) elements */ + rstr = blc[naxis]; + rstp = trc[naxis]; + rinc = inc[naxis]; + numcol = colnum; + } + + nultyp = 2; + if (anynul) + *anynul = FALSE; + + i0 = 0; + for (ii = 0; ii < 9; ii++) + { + str[ii] = 1; + stp[ii] = 1; + incr[ii] = 1; + dsize[ii] = 1; + } + + for (ii = 0; ii < naxis; ii++) + { + if (trc[ii] < blc[ii]) + { + sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1); + ffpmsg(msg); + return(*status = BAD_PIX_NUM); + } + + str[ii] = blc[ii]; + stp[ii] = trc[ii]; + incr[ii] = inc[ii]; + dsize[ii + 1] = dsize[ii] * naxes[ii]; + } + + if (naxis == 1 && naxes[0] == 1) + { + /* This is not a vector column, so read all the rows at once */ + nelem = (rstp - rstr) / rinc + 1; + ninc = rinc; + rstp = rstr; + } + else + { + /* have to read each row individually, in all dimensions */ + nelem = (stp[0] - str[0]) / inc[0] + 1; + ninc = incr[0]; + } + + for (row = rstr; row <= rstp; row += rinc) + { + for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8]) + { + for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7]) + { + for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6]) + { + for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5]) + { + for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4]) + { + for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3]) + { + for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2]) + { + for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1]) + { + felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] + + (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] + + (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] + + (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8]; + + if ( ffgcluk(fptr, numcol, row, felem, nelem, ninc, nultyp, + nulval, &array[i0], &flagval[i0], &anyf, status) > 0) + return(*status); + + if (anyf && anynul) + *anynul = TRUE; + + i0 += nelem; + } + } + } + } + } + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffggpuk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned int *array, /* O - array of values that are returned */ + int *status) /* IO - error status */ +/* + Read an array of group parameters from the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being read). +*/ +{ + long row; + int idummy; + char cdummy; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffgcluk(fptr, 1, row, firstelem, nelem, 1, 1, 0L, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvuk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned int nulval, /* I - value for null pixels */ + unsigned int *array, /* O - array of values that are read */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Any undefined pixels will be set equal to the value of 'nulval' unless + nulval = 0 in which case no checks for undefined pixels will be made. +*/ +{ + char cdummy; + + ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfuk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + long firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + unsigned int *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags: 1 if null pixel; else 0 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. Automatic + datatype conversion will be performed if the datatype of the column does not + match the datatype of the array parameter. The output values will be scaled + by the FITS TSCALn and TZEROn values if these values have been defined. + Nularray will be set = 1 if the corresponding array pixel is undefined, + otherwise nularray will = 0. +*/ +{ + int dummy = 0; + + ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcluk( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to read (1 = 1st col) */ + long firstrow, /* I - first row to read (1 = 1st row) */ + OFF_T firstelem, /* I - first vector element to read (1 = 1st) */ + long nelem, /* I - number of values to read */ + long elemincre, /* I - pixel increment; e.g., 2 = every other */ + int nultyp, /* I - null value handling code: */ + /* 1: set undefined pixels = nulval */ + /* 2: set nularray=1 for undefined pixels */ + unsigned int nulval, /* I - value for null pixels if nultyp = 1 */ + unsigned int *array, /* O - array of values that are read */ + char *nularray, /* O - array of flags = 1 if nultyp = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read an array of values from a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer be a virtual column in a 1 or more grouped FITS primary + array or image extension. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The output array of values will be converted from the datatype of the column + and will be scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + double scale, zero, power = 1.; + int tcode, maxelem, hdutype, xcode, decimals; + long twidth, incre, rownum, remain, next, ntodo; + long ii, rowincre, tnull, xwidth; + int nulcheck; + OFF_T repeat, startpos, elemnum, readptr, rowlen; + char tform[20]; + char message[81]; + char snull[20]; /* the FITS null value if reading from ASCII table */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */ + return(*status); + + /* call the 'short' or 'long' version of this routine, if possible */ + if (sizeof(int) == sizeof(short)) + ffgclui(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp, + (unsigned short) nulval, (unsigned short *) array, nularray, anynul, + status); + else if (sizeof(int) == sizeof(long)) + ffgcluj(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp, + (unsigned long) nulval, (unsigned long *) array, nularray, anynul, + status); + else + { + /* + This is a special case: sizeof(int) is not equal to sizeof(short) or + sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes, + int = 4 bytes, and long = 8 bytes. + */ + + buffer = cbuff; + + if (anynul) + *anynul = 0; + + if (nultyp == 2) + memset(nularray, 0, nelem); /* initialize nullarray */ + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if ( ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 0, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + + incre *= elemincre; /* multiply incre to just get every nth pixel */ + + if (tcode == TSTRING) /* setup for ASCII tables */ + { + /* get the number of implied decimal places if no explicit decmal point */ + ffasfm(tform, &xcode, &xwidth, &decimals, status); + for(ii = 0; ii < decimals; ii++) + power *= 10.; + } + /*------------------------------------------------------------------*/ + /* Decide whether to check for null values in the input FITS file: */ + /*------------------------------------------------------------------*/ + nulcheck = nultyp; /* by default check for null values in the FITS file */ + + if (nultyp == 1 && nulval == 0) + nulcheck = 0; /* calling routine does not want to check for nulls */ + + else if (tcode%10 == 1 && /* if reading an integer column, and */ + tnull == NULL_UNDEFINED) /* if a null value is not defined, */ + nulcheck = 0; /* then do not check for null values. */ + + else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TBYTE && (tnull > 255 || tnull < 0) ) + nulcheck = 0; /* Impossible null value */ + + else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED) + nulcheck = 0; + + /*----------------------------------------------------------------------*/ + /* If FITS column and output data array have same datatype, then we do */ + /* not need to use a temporary buffer to store intermediate datatype. */ + /*----------------------------------------------------------------------*/ + if (tcode == TLONG) /* Special Case: */ + { /* data are 4-bytes long, so read */ + maxelem = nelem; /* data directly into output buffer. */ + } + + /*---------------------------------------------------------------------*/ + /* Now read the pixels from the FITS column. If the column does not */ + /* have the same datatype as the output array, then we have to read */ + /* the raw values into a temporary buffer (of limited size). In */ + /* the case of a vector colum read only 1 vector of values at a time */ + /* then skip to the next row if more values need to be read. */ + /* After reading the raw values, then call the fffXXYY routine to (1) */ + /* test for undefined values, (2) convert the datatype if necessary, */ + /* and (3) scale the values by the FITS TSCALn and TZEROn linear */ + /* scaling parameters. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to read */ + next = 0; /* next element in array to be read */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to read at one time to the number that + will fit in the buffer or to the number of pixels that remain in + the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1)); + + readptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * (incre / elemincre)); + + switch (tcode) + { + case (TLONG): + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next], + status); + fffi4uint((INT32BIT *) &array[next], ntodo, scale, zero, + nulcheck, (INT32BIT) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TLONGLONG): + + ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status); + fffi8uint( (LONGLONG *) buffer, ntodo, scale, zero, + nulcheck, (long) tnull, nulval, &nularray[next], + anynul, &array[next], status); + break; + case (TBYTE): + ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer, + status); + fffi1uint((unsigned char *) buffer, ntodo, scale, zero,nulcheck, + (unsigned char) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSHORT): + ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status); + fffi2uint((short *) buffer, ntodo, scale, zero, nulcheck, + (short) tnull, nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TFLOAT): + ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status); + fffr4uint((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8uint((double *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TSTRING): + ffmbyt(fptr, readptr, REPORT_EOF, status); + + if (incre == twidth) /* contiguous bytes */ + ffgbyt(fptr, ntodo * twidth, buffer, status); + else + ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + fffstruint((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + sprintf(message, + "Cannot read numbers from column %d which has format %s", + colnum, tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous read operation */ + { + if (hdutype > 0) + sprintf(message, + "Error reading elements %ld thru %ld from column %d (ffgcluk).", + next+1, next+ntodo, colnum); + else + sprintf(message, + "Error reading elements %ld thru %ld from image (ffgcluk).", + next+1, next+ntodo); + + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum = elemnum + (ntodo * elemincre); + + if (elemnum >= repeat) /* completed a row; start on later row */ + { + rowincre = elemnum / repeat; + rownum += rowincre; + elemnum = elemnum - (rowincre * repeat); + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while reading FITS data."); + *status = NUM_OVERFLOW; + } + + } /* end of DEC Alpha special case */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi1uint(unsigned char *input,/* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned char tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (unsigned int) input[ii]; /* copy input */ + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2uint(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + short tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi4uint(INT32BIT *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 2147483648.) + { + /* Instead of adding 2147483648, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000; + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned int) input[ii]; /* copy to output */ + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 2147483648.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000; + } + } + else if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8uint(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + long tnull, /* I - value of FITS TNULLn keyword if any */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to tnull. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + + /* This block of code is only used in cases where there is */ + /* no native 8-byte integer support. We have to interpret */ + /* the corresponding pair of 4-byte integers which are */ + /* are equivalent to the 8-byte integer. */ + + long ii,jj,kk; + double dvalue; + unsigned long *uinput; + + uinput = (unsigned long *) input; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = ((uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.) * scale + zero; + else /* positive number */ + dvalue = (uinput[jj] * 4294967296. + uinput[kk]) + * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == (double) tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (uinput[jj] & 0x80000000) /* negative number */ + dvalue = (uinput[jj] ^ 0xffffffff) * -4294967296. - + (uinput[kk] ^ 0xffffffff) - 1.; + else /* positive number */ + dvalue = uinput[jj] * 4294967296. + uinput[kk]; + + if (dvalue == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = dvalue * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + +#else + + /* this block works on machines which support an 8-byte integer type */ + + long ii; + double dvalue; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] == tnull) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4uint(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 2) + { + if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8uint(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. + Check for null values and do datatype conversion and scaling if required. + The nullcheck code value determines how any null values in the input array + are treated. A null value is an input pixel that is equal to NaN. If + nullcheck = 0, then no checking for nulls is performed and any null values + will be transformed just like any other pixel. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + long ii; + double dvalue; + short *sptr, iret; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + else /* must check for null values */ + { + sptr = (short *) input; + +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + if (scale == 1. && zero == 0.) /* no scaling */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + output[ii] = 0; + } + else + { + if (input[ii] < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) input[ii]; + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++, sptr += 4) + { + if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */ + { + if (iret == 1) /* is it a NaN? */ + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + else /* it's an underflow */ + { + if (zero < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstruint(char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + long twidth, /* I - width of each substring of chars */ + double implipower, /* I - power of 10 of implied decimal */ + int nullcheck, /* I - null checking code; 0 = don't check */ + /* 1:set null pixels = nullval */ + /* 2: if null pixel, set nullarray = 1 */ + char *snull, /* I - value of FITS null string, if any */ + unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */ + char *nullarray, /* I - bad pixel array, if nullcheck = 2 */ + int *anynull, /* O - set to 1 if any pixels are null */ + unsigned int *output, /* O - array of converted pixels */ + int *status) /* IO - error status */ +/* + Copy input to output following reading of the input from a FITS file. Check + for null values and do scaling if required. The nullcheck code value + determines how any null values in the input array are treated. A null + value is an input pixel that is equal to snull. If nullcheck= 0, then + no special checking for nulls is performed. If nullcheck = 1, then the + output pixel will be set = nullval if the corresponding input pixel is null. + If nullcheck = 2, then if the pixel is null then the corresponding value of + nullarray will be set to 1; the value of nullarray for non-null pixels + will = 0. The anynull parameter will be set = 1 if any of the returned + pixels are null, otherwise anynull will be returned with a value = 0; +*/ +{ + int nullen; + long ii; + double dvalue; + char *cstring, message[81]; + char *cptr, *tpos; + char tempstore, chrzero = '0'; + double val, power; + int exponent, sign, esign, decpt; + + nullen = strlen(snull); + cptr = input; /* pointer to start of input string */ + for (ii = 0; ii < ntodo; ii++) + { + cstring = cptr; + /* temporarily insert a null terminator at end of the string */ + tpos = cptr + twidth; + tempstore = *tpos; + *tpos = 0; + + /* check if null value is defined, and if the */ + /* column string is identical to the null string */ + if (snull[0] != ASCII_NULL_UNDEFINED && + !strncmp(snull, cptr, nullen) ) + { + if (nullcheck) + { + *anynull = 1; + if (nullcheck == 1) + output[ii] = nullval; + else + nullarray[ii] = 1; + } + cptr += twidth; + } + else + { + /* value is not the null value, so decode it */ + /* remove any embedded blank characters from the string */ + + decpt = 0; + sign = 1; + val = 0.; + power = 1.; + exponent = 0; + esign = 1; + + while (*cptr == ' ') /* skip leading blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for leading sign */ + { + if (*cptr == '-') + sign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and value */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + + if (*cptr == '.') /* check for decimal point */ + { + decpt = 1; /* set flag to show there was a decimal point */ + cptr++; + while (*cptr == ' ') /* skip any blanks */ + cptr++; + + while (*cptr >= '0' && *cptr <= '9') + { + val = val * 10. + *cptr - chrzero; /* accumulate the value */ + power = power * 10.; + cptr++; + + while (*cptr == ' ') /* skip embedded blanks in the value */ + cptr++; + } + } + + if (*cptr == 'E' || *cptr == 'D') /* check for exponent */ + { + cptr++; + while (*cptr == ' ') /* skip blanks */ + cptr++; + + if (*cptr == '-' || *cptr == '+') /* check for exponent sign */ + { + if (*cptr == '-') + esign = -1; + + cptr++; + + while (*cptr == ' ') /* skip blanks between sign and exp */ + cptr++; + } + + while (*cptr >= '0' && *cptr <= '9') + { + exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */ + cptr++; + + while (*cptr == ' ') /* skip embedded blanks */ + cptr++; + } + } + + if (*cptr != 0) /* should end up at the null terminator */ + { + sprintf(message, "Cannot read number from ASCII table"); + ffpmsg(message); + sprintf(message, "Column field = %s.", cstring); + ffpmsg(message); + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + return(*status = BAD_C2D); + } + + if (!decpt) /* if no explicit decimal, use implied */ + power = implipower; + + dvalue = (sign * val / power) * pow(10., (double) (esign * exponent)); + + dvalue = dvalue * scale + zero; /* apply the scaling */ + + if (dvalue < DUINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (long) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/getkey.c b/pkg/tbtables/cfitsio/getkey.c new file mode 100644 index 00000000..698eb55c --- /dev/null +++ b/pkg/tbtables/cfitsio/getkey.c @@ -0,0 +1,2544 @@ +/* This file, getkey.c, contains routines that read keywords from */ +/* a FITS header. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +/* stddef.h is apparently needed to define size_t */ +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffghsp(fitsfile *fptr, /* I - FITS file pointer */ + int *nexist, /* O - number of existing keywords in header */ + int *nmore, /* O - how many more keywords will fit */ + int *status) /* IO - error status */ +/* + returns the number of existing keywords (not counting the END keyword) + and the number of more keyword that will fit in the current header + without having to insert more FITS blocks. +*/ +{ + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + *nexist = ( ((fptr->Fptr)->headend) - + ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80; + + if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if (nmore) + *nmore = -1; /* data not written yet, so room for any keywords */ + } + else + { + /* calculate space available between the data and the END card */ + if (nmore) + *nmore = ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) / 80 - 1; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffghps(fitsfile *fptr, /* I - FITS file pointer */ + int *nexist, /* O - number of existing keywords in header */ + int *position, /* O - position of next keyword to be read */ + int *status) /* IO - error status */ +/* + return the number of existing keywords and the position of the next + keyword that will be read. +*/ +{ + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + *nexist = ( ((fptr->Fptr)->headend) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80; + *position = ( ((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80 + 1; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffnchk(fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + function returns the position of the first null character (ASCII 0), if + any, in the current header. Null characters are illegal, but the other + CFITSIO routines that read the header will not detect this error, because + the null gets interpreted as a normal end of string character. +*/ +{ + long ii, nblock; + OFF_T bytepos; + int length, nullpos; + char block[2881]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + return(0); /* Don't check a file that is just being created. */ + /* It cannot contain nulls since CFITSIO wrote it. */ + } + else + { + /* calculate number of blocks in the header */ + nblock = ( (fptr->Fptr)->datastart - + (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) / 2880; + } + + bytepos = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]; + ffmbyt(fptr, bytepos, REPORT_EOF, status); /* move to read pos. */ + + block[2880] = '\0'; + for (ii = 0; ii < nblock; ii++) + { + if (ffgbyt(fptr, 2880, block, status) > 0) + return(0); /* read error of some sort */ + + length = strlen(block); + if (length != 2880) + { + nullpos = (ii * 2880) + length + 1; + return(nullpos); + } + } + + return(0); +} +/*--------------------------------------------------------------------------*/ +int ffmaky(fitsfile *fptr, /* I - FITS file pointer */ + int nrec, /* I - one-based keyword number to move to */ + int *status) /* IO - error status */ +{ +/* + move pointer to the specified absolute keyword position. E.g. this keyword + will then be read by the next call to ffgnky. +*/ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] + ( (nrec - 1) * 80); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmrky(fitsfile *fptr, /* I - FITS file pointer */ + int nmove, /* I - relative number of keywords to move */ + int *status) /* IO - error status */ +{ +/* + move pointer to the specified keyword position relative to the current + position. E.g. this keyword will then be read by the next call to ffgnky. +*/ + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + (fptr->Fptr)->nextkey += (nmove * 80); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgnky(fitsfile *fptr, /* I - FITS file pointer */ + char *card, /* O - card string */ + int *status) /* IO - error status */ +/* + read the next keyword from the header - used internally by cfitsio +*/ +{ + int jj, nrec; + OFF_T bytepos, endhead; + char message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + card[0] = '\0'; /* make sure card is terminated, even affer read error */ + +/* + Check that nextkey points to a legal keyword position. Note that headend + is the current end of the header, i.e., the position where a new keyword + would be appended, however, if there are more than 1 FITS block worth of + blank keywords at the end of the header (36 keywords per 2880 byte block) + then the actual physical END card must be located at a starting position + which is just 2880 bytes prior to the start of the data unit. +*/ + + bytepos = (fptr->Fptr)->nextkey; + endhead = maxvalue( ((fptr->Fptr)->headend), ((fptr->Fptr)->datastart - 2880) ); + + /* nextkey must be < endhead and > than headstart */ + if (bytepos > endhead || + bytepos < (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + { + nrec=(bytepos - (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) / 80 + 1; + sprintf(message, "Cannot get keyword number %d. It does not exist.", + nrec); + ffpmsg(message); + return(*status = KEY_OUT_BOUNDS); + } + + ffmbyt(fptr, bytepos, REPORT_EOF, status); /* move to read pos. */ + + card[80] = '\0'; /* make sure card is terminate, even if ffgbyt fails */ + + if (ffgbyt(fptr, 80, card, status) <= 0) + { + (fptr->Fptr)->nextkey += 80; /* increment pointer to next keyword */ + + /* strip off trailing blanks with terminated string */ + jj = 79; + while (jj >= 0 && card[jj] == ' ') + jj--; + + card[jj + 1] = '\0'; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgnxk( fitsfile *fptr, /* I - FITS file pointer */ + char **inclist, /* I - list of included keyword names */ + int ninc, /* I - number of names in inclist */ + char **exclist, /* I - list of excluded keyword names */ + int nexc, /* I - number of names in exclist */ + char *card, /* O - first matching keyword */ + int *status) /* IO - error status */ +/* + Return the next keyword that matches one of the names in inclist + but does not match any of the names in exclist. The search + goes from the current position to the end of the header, only. + Wild card characters may be used in the name lists ('*', '?' and '#'). +*/ +{ + int casesn, match, exact, namelen; + long ii, jj; + char keybuf[FLEN_CARD], keyname[FLEN_KEYWORD]; + + card[0] = '\0'; + if (*status > 0) + return(*status); + + casesn = FALSE; + + /* get next card, and return with an error if hit end of header */ + while( ffgcrd(fptr, "*", keybuf, status) <= 0) + { + ffgknm(keybuf, keyname, &namelen, status); /* get the keyword name */ + + /* does keyword match any names in the include list? */ + for (ii = 0; ii < ninc; ii++) + { + ffcmps(inclist[ii], keyname, casesn, &match, &exact); + if (match) + { + /* does keyword match any names in the exclusion list? */ + jj = -1; + while ( ++jj < nexc ) + { + ffcmps(exclist[jj], keyname, casesn, &match, &exact); + if (match) + break; + } + + if (jj >= nexc) + { + /* not in exclusion list, so return this keyword */ + strcat(card, keybuf); + return(*status); + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgky( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + char *keyname, /* I - name of keyword to read */ + void *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the keyword value and comment from the FITS header. + Reads a keyword value with the datatype specified by the 2nd argument. +*/ +{ + long longval; + double doubleval; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (datatype == TSTRING) + { + ffgkys(fptr, keyname, (char *) value, comm, status); + } + else if (datatype == TBYTE) + { + if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > UCHAR_MAX || longval < 0) + *status = NUM_OVERFLOW; + else + *(unsigned char *) value = longval; + } + } + else if (datatype == TSBYTE) + { + if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > 127 || longval < -128) + *status = NUM_OVERFLOW; + else + *(signed char *) value = longval; + } + } + else if (datatype == TUSHORT) + { + if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > USHRT_MAX || longval < 0) + *status = NUM_OVERFLOW; + else + *(unsigned short *) value = longval; + } + } + else if (datatype == TSHORT) + { + if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > SHRT_MAX || longval < SHRT_MIN) + *status = NUM_OVERFLOW; + else + *(short *) value = longval; + } + } + else if (datatype == TUINT) + { + if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > (long) UINT_MAX || longval < 0) + *status = NUM_OVERFLOW; + else + *(unsigned int *) value = longval; + } + } + else if (datatype == TINT) + { + if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > INT_MAX || longval < INT_MIN) + *status = NUM_OVERFLOW; + else + *(int *) value = longval; + } + } + else if (datatype == TLOGICAL) + { + ffgkyl(fptr, keyname, (int *) value, comm, status); + } + else if (datatype == TULONG) + { + if (ffgkyd(fptr, keyname, &doubleval, comm, status) <= 0) + { + if (doubleval > (double) ULONG_MAX || doubleval < 0) + *status = NUM_OVERFLOW; + else + *(unsigned long *) value = doubleval; + } + } + else if (datatype == TLONG) + { + ffgkyj(fptr, keyname, (long *) value, comm, status); + } + else if (datatype == TFLOAT) + { + ffgkye(fptr, keyname, (float *) value, comm, status); + } + else if (datatype == TDOUBLE) + { + ffgkyd(fptr, keyname, (double *) value, comm, status); + } + else if (datatype == TCOMPLEX) + { + ffgkyc(fptr, keyname, (float *) value, comm, status); + } + else if (datatype == TDBLCOMPLEX) + { + ffgkym(fptr, keyname, (double *) value, comm, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkey( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + char *keyval, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the keyword value and comment. + The value is just the literal string of characters in the value field + of the keyword. In the case of a string valued keyword, the returned + value includes the leading and closing quote characters. The value may be + up to 70 characters long, and the comment may be up to 72 characters long. + If the keyword has no value (no equal sign in column 9) then a null value + is returned. +*/ +{ + char card[FLEN_CARD]; + + keyval[0] = '\0'; + if (comm) + comm[0] = '\0'; + + if (*status > 0) + return(*status); + + if (ffgcrd(fptr, keyname, card, status) > 0) /* get the 80-byte card */ + return(*status); + + ffpsvc(card, keyval, comm, status); /* parse the value and comment */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgrec( fitsfile *fptr, /* I - FITS file pointer */ + int nrec, /* I - number of keyword to read */ + char *card, /* O - keyword card */ + int *status) /* IO - error status */ +/* + Read (get) the nrec-th keyword, returning the entire keyword card up to + 80 characters long. The first keyword in the header has nrec = 1, not 0. + The returned card value is null terminated with any trailing blank + characters removed. If nrec = 0, then this routine simply moves the + current header pointer to the top of the header. +*/ +{ + if (*status > 0) + return(*status); + + if (nrec == 0) + { + ffmaky(fptr, 1, status); /* simply move to beginning of header */ + card[0] = '\0'; /* and return null card */ + } + else if (nrec > 0) + { + ffmaky(fptr, nrec, status); + ffgnky(fptr, card, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcrd( fitsfile *fptr, /* I - FITS file pointer */ + char *name, /* I - name of keyword to read */ + char *card, /* O - keyword card */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the entire keyword card up to + 80 characters long. The first keyword in the header has nrec = 1, not 0. + The returned card value is null terminated with any trailing blank + characters removed. + + If the input name contains wild cards ('?' matches any single char + and '*' matches any sequence of chars, # matches any string of decimal + digits) then the search ends once the end of header is reached and does + not automatically resume from the top of the header. +*/ +{ + int nkeys, nextkey, ntodo, namelen, namelen_limit, namelenminus1, cardlen; + int ii = 0, jj, kk, wild, match, exact, hier = 0; + char keyname[FLEN_KEYWORD], cardname[FLEN_KEYWORD]; + char *ptr1, *ptr2, *gotstar; + + if (*status > 0) + return(*status); + + *keyname = '\0'; + + while (name[ii] == ' ') /* skip leading blanks in name */ + ii++; + + strncat(keyname, &name[ii], FLEN_KEYWORD - 1); + + namelen = strlen(keyname); + + while (namelen > 0 && keyname[namelen - 1] == ' ') + namelen--; /* ignore trailing blanks in name */ + + keyname[namelen] = '\0'; /* terminate the name */ + + for (ii=0; ii < namelen; ii++) + keyname[ii] = toupper(keyname[ii]); /* make upper case */ + + if (FSTRNCMP("HIERARCH", keyname, 8) == 0) + { + if (namelen == 8) + { + /* special case: just looking for any HIERARCH keyword */ + hier = 1; + } + else + { + /* ignore the leading HIERARCH and look for the 'real' name */ + /* starting with first non-blank character following HIERARCH */ + ptr1 = keyname; + ptr2 = &keyname[8]; + + while(*ptr2 == ' ') + ptr2++; + + namelen = 0; + while(*ptr2) + { + *ptr1 = *ptr2; + ptr1++; + ptr2++; + namelen++; + } + *ptr1 = '\0'; + } + } + + /* does input name contain wild card chars? ('?', '*', or '#') */ + /* wild cards are currently not supported with HIERARCH keywords */ + + namelen_limit = namelen; + gotstar = 0; + if (namelen < 9 && + (strchr(keyname,'?') || (gotstar = strchr(keyname,'*')) || + strchr(keyname,'#')) ) + { + wild = 1; + + /* if we found a '*' wild card in the name, there might be */ + /* more than one. Support up to 2 '*' in the template. */ + /* Thus we need to compare keywords whose names have at least */ + /* namelen - 2 characters. */ + if (gotstar) + namelen_limit -= 2; + } + else + wild = 0; + + ffghps(fptr, &nkeys, &nextkey, status); /* get no. keywords and position */ + + namelenminus1 = maxvalue(namelen - 1, 1); + ntodo = nkeys - nextkey + 1; /* first, read from next keyword to end */ + for (jj=0; jj < 2; jj++) + { + for (kk = 0; kk < ntodo; kk++) + { + ffgnky(fptr, card, status); /* get next keyword */ + + if (hier) + { + if (FSTRNCMP("HIERARCH", card, 8) == 0) + return(*status); /* found a HIERARCH keyword */ + } + else + { + ffgknm(card, cardname, &cardlen, status); /* get the keyword name */ + + if (cardlen >= namelen_limit) /* can't match if card < name */ + { + /* if there are no wild cards, lengths must be the same */ + if (!( !wild && cardlen != namelen) ) + { + for (ii=0; ii < cardlen; ii++) + { + /* make sure keyword is in uppercase */ + if (cardname[ii] > 96) + { + /* This assumes the ASCII character set in which */ + /* upper case characters start at ASCII(97) */ + /* Timing tests showed that this is 20% faster */ + /* than calling the isupper function. */ + + cardname[ii] = toupper(cardname[ii]); /* make upper case */ + } + } + + if (wild) + { + ffcmps(keyname, cardname, 1, &match, &exact); + if (match) + return(*status); /* found a matching keyword */ + } + else if (keyname[namelenminus1] == cardname[namelenminus1]) + { + /* test the last character of the keyword name first, on */ + /* the theory that it is less likely to match then the first */ + /* character since many keywords begin with 'T', for example */ + + if (FSTRNCMP(keyname, cardname, namelenminus1) == 0) + { + return(*status); /* found the matching keyword */ + } + } + } + } + } + } + + if (wild || jj == 1) + break; /* stop at end of header if template contains wildcards */ + + ffmaky(fptr, 1, status); /* reset pointer to beginning of header */ + ntodo = nextkey - 1; /* number of keyword to read */ + } + + return(*status = KEY_NO_EXIST); /* couldn't find the keyword */ +} +/*--------------------------------------------------------------------------*/ +int ffgknm( char *card, /* I - keyword card */ + char *name, /* O - name of the keyword */ + int *length, /* O - length of the keyword name */ + int *status) /* IO - error status */ + +/* + Return the name of the keyword, and the name length. This supports the + ESO HIERARCH convention where keyword names may be > 8 characters long. +*/ +{ + char *ptr1, *ptr2; + int ii; + + *name = '\0'; + *length = 0; + + /* support for ESO HIERARCH keywords; find the '=' */ + if (FSTRNCMP(card, "HIERARCH ", 9) == 0) + { + ptr2 = strchr(card, '='); + + if (!ptr2) /* no value indicator ??? */ + { + /* this probably indicates an error, so just return FITS name */ + strcat(name, "HIERARCH"); + *length = 8; + return(*status); + } + + /* find the start and end of the HIERARCH name */ + ptr1 = &card[9]; + while (*ptr1 == ' ') /* skip spaces */ + ptr1++; + + strncat(name, ptr1, ptr2 - ptr1); + ii = ptr2 - ptr1; + + while (ii > 0 && name[ii - 1] == ' ') /* remove trailing spaces */ + ii--; + + name[ii] = '\0'; + *length = ii; + } + else + { + for (ii = 0; ii < 8; ii++) + { + /* look for string terminator, or a blank */ + if (*(card+ii) != ' ' && *(card+ii) !='\0') + { + *(name+ii) = *(card+ii); + } + else + { + name[ii] = '\0'; + *length = ii; + return(*status); + } + } + + /* if we got here, keyword is 8 characters long */ + name[8] = '\0'; + *length = 8; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgunt( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + char *unit, /* O - keyword units */ + int *status) /* IO - error status */ +/* + Read (get) the units string from the comment field of the existing + keyword. This routine uses a local FITS convention (not defined in the + official FITS standard) in which the units are enclosed in + square brackets following the '/' comment field delimiter, e.g.: + + KEYWORD = 12 / [kpc] comment string goes here +*/ +{ + char valstring[FLEN_VALUE]; + char comm[FLEN_COMMENT]; + char *loc; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + + if (comm[0] == '[') + { + loc = strchr(comm, ']'); /* find the closing bracket */ + if (loc) + *loc = '\0'; /* terminate the string */ + + strcpy(unit, &comm[1]); /* copy the string */ + } + else + unit[0] = '\0'; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkys( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + char *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Get KeYword with a String value: + Read (get) a simple string valued keyword. The returned value may be up to + 68 chars long ( + 1 null terminator char). The routine does not support the + HEASARC convention for continuing long string values over multiple keywords. + The ffgkls routine may be used to read long continued strings. The returned + comment string may be up to 69 characters long (including null terminator). +*/ +{ + char valstring[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + value[0] = '\0'; + ffc2s(valstring, value, status); /* remove quotes from string */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkls( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + char **value, /* O - pointer to keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Get Keyword with possible Long String value: + Read (get) the named keyword, returning the value and comment. + The returned value string may be arbitrarily long (by using the HEASARC + convention for continuing long string values over multiple keywords) so + this routine allocates the required memory for the returned string value. + It is up to the calling routine to free the memory once it is finished + with the value string. The returned comment string may be up to 69 + characters long. +*/ +{ + char valstring[FLEN_VALUE]; + int contin; + size_t len; + + if (*status > 0) + return(*status); + + *value = NULL; /* initialize a null pointer in case of error */ + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + + if (*status > 0) + return(*status); + + if (!valstring[0]) /* null value string? */ + { + *value = (char *) malloc(1); /* allocate and return a null string */ + **value = '\0'; + } + else + { + /* allocate space, plus 1 for null */ + *value = (char *) malloc(strlen(valstring) + 1); + + ffc2s(valstring, *value, status); /* convert string to value */ + len = strlen(*value); + + /* If last character is a & then value may be continued on next keyword */ + contin = 1; + while (contin) + { + if (len && *(*value+len-1) == '&') /* is last char an anpersand? */ + { + ffgcnt(fptr, valstring, status); + if (*valstring) /* a null valstring indicates no continuation */ + { + *(*value+len-1) = '\0'; /* erase the trailing & char */ + len += strlen(valstring) - 1; + *value = (char *) realloc(*value, len + 1); /* increase size */ + strcat(*value, valstring); /* append the continued chars */ + } + else + contin = 0; + } + else + contin = 0; + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcnt( fitsfile *fptr, /* I - FITS file pointer */ + char *value, /* O - continued string value */ + int *status) /* IO - error status */ +/* + Attempt to read the next keyword, returning the string value + if it is a continuation of the previous string keyword value. + This uses the HEASARC convention for continuing long string values + over multiple keywords. Each continued string is terminated with a + backslash character, and the continuation follows on the next keyword + which must have the name CONTINUE without an equal sign in column 9 + of the card. If the next card is not a continuation, then the returned + value string will be null. +*/ +{ + int tstatus; + char card[FLEN_CARD], strval[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + tstatus = 0; + value[0] = '\0'; + + if (ffgnky(fptr, card, &tstatus) > 0) /* read next keyword */ + return(*status); /* hit end of header */ + + if (strncmp(card, "CONTINUE ", 10) == 0) /* a continuation card? */ + { + strncpy(card, "D2345678= ", 10); /* overwrite a dummy keyword name */ + ffpsvc(card, strval, comm, &tstatus); /* get the string value */ + ffc2s(strval, value, &tstatus); /* remove the surrounding quotes */ + + if (tstatus) /* return null if error status was returned */ + value[0] = '\0'; + } + else + ffmrky(fptr, -1, status); /* reset the keyword pointer */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkyl( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + int *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The returned value = 1 if the keyword is true, else = 0 if false. + The comment may be up to 69 characters long. +*/ +{ + char valstring[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + ffc2l(valstring, value, status); /* convert string to value */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkyj( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + long *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The value will be implicitly converted to a (long) integer if it not + already of this datatype. The comment may be up to 69 characters long. +*/ +{ + char valstring[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + ffc2i(valstring, value, status); /* convert string to value */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkye( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + float *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The value will be implicitly converted to a float if it not + already of this datatype. The comment may be up to 69 characters long. +*/ +{ + char valstring[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + ffc2r(valstring, value, status); /* convert string to value */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkyd( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + double *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The value will be implicitly converted to a double if it not + already of this datatype. The comment may be up to 69 characters long. +*/ +{ + char valstring[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + ffc2d(valstring, value, status); /* convert string to value */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkyc( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + float *value, /* O - keyword value (real,imag) */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The keyword must have a complex value. No implicit data conversion + will be performed. +*/ +{ + char valstring[FLEN_VALUE], message[81]; + int len; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + + if (valstring[0] != '(' ) /* test that this is a complex keyword */ + { + sprintf(message, "keyword %s does not have a complex value (ffgkyc):", + keyname); + ffpmsg(message); + ffpmsg(valstring); + return(*status = BAD_C2F); + } + + valstring[0] = ' '; /* delete the opening parenthesis */ + len = strcspn(valstring, ")" ); + valstring[len] = '\0'; /* delete the closing parenthesis */ + + len = strcspn(valstring, ","); + valstring[len] = '\0'; + + ffc2r(valstring, &value[0], status); /* convert the real part */ + ffc2r(&valstring[len + 1], &value[1], status); /* convert imag. part */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkym( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + double *value, /* O - keyword value (real,imag) */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The keyword must have a complex value. No implicit data conversion + will be performed. +*/ +{ + char valstring[FLEN_VALUE], message[81]; + int len; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + + if (valstring[0] != '(' ) /* test that this is a complex keyword */ + { + sprintf(message, "keyword %s does not have a complex value (ffgkym):", + keyname); + ffpmsg(message); + ffpmsg(valstring); + return(*status = BAD_C2D); + } + + valstring[0] = ' '; /* delete the opening parenthesis */ + len = strcspn(valstring, ")" ); + valstring[len] = '\0'; /* delete the closing parenthesis */ + + len = strcspn(valstring, ","); + valstring[len] = '\0'; + + ffc2d(valstring, &value[0], status); /* convert the real part */ + ffc2d(&valstring[len + 1], &value[1], status); /* convert the imag. part */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkyt( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to read */ + long *ivalue, /* O - integer part of keyword value */ + double *fraction, /* O - fractional part of keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the named keyword, returning the value and comment. + The integer and fractional parts of the value are returned in separate + variables, to allow more numerical precision to be passed. This + effectively passes a 'triple' precision value, with a 4-byte integer + and an 8-byte fraction. The comment may be up to 69 characters long. +*/ +{ + char valstring[FLEN_VALUE]; + char *loc; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + + /* read the entire value string as a double, to get the integer part */ + ffc2d(valstring, fraction, status); + + *ivalue = (long) *fraction; + + *fraction = *fraction - *ivalue; + + /* see if we need to read the fractional part again with more precision */ + /* look for decimal point, without an exponential E or D character */ + + loc = strchr(valstring, '.'); + if (loc) + { + if (!strchr(valstring, 'E') && !strchr(valstring, 'D')) + ffc2d(loc, fraction, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkyn( fitsfile *fptr, /* I - FITS file pointer */ + int nkey, /* I - number of the keyword to read */ + char *keyname, /* O - name of the keyword */ + char *value, /* O - keyword value */ + char *comm, /* O - keyword comment */ + int *status) /* IO - error status */ +/* + Read (get) the nkey-th keyword returning the keyword name, value and comment. + The value is just the literal string of characters in the value field + of the keyword. In the case of a string valued keyword, the returned + value includes the leading and closing quote characters. The value may be + up to 70 characters long, and the comment may be up to 72 characters long. + If the keyword has no value (no equal sign in column 9) then a null value + is returned. If comm = NULL, then do not return the comment string. +*/ +{ + char card[FLEN_CARD], sbuff[FLEN_CARD]; + int namelen; + + keyname[0] = '\0'; + value[0] = '\0'; + if (comm) + comm[0] = '\0'; + + if (*status > 0) + return(*status); + + if (ffgrec(fptr, nkey, card, status) > 0 ) /* get the 80-byte card */ + return(*status); + + ffgknm(card, keyname, &namelen, status); /* get the keyword name */ + + if (ffpsvc(card, value, comm, status) > 0) /* parse value and comment */ + return(*status); + + if (fftrec(keyname, status) > 0) /* test keyword name; catches no END */ + { + sprintf(sbuff,"Name of keyword no. %d contains illegal character(s): %s", + nkey, keyname); + ffpmsg(sbuff); + + if (nkey % 36 == 0) /* test if at beginning of 36-card FITS record */ + ffpmsg(" (This may indicate a missing END keyword)."); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkns( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - root name of keywords to read */ + int nstart, /* I - starting index number */ + int nmax, /* I - maximum number of keywords to return */ + char *value[], /* O - array of pointers to keyword values */ + int *nfound, /* O - number of values that were returned */ + int *status) /* IO - error status */ +/* + Read (get) an indexed array of keywords with index numbers between + NSTART and (NSTART + NMAX -1) inclusive. + This routine does NOT support the HEASARC long string convention. +*/ +{ + int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval; + long ival; + char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD]; + char svalue[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, 8); + + lenroot = strlen(keyroot); + if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */ + return(*status); + + for (ii=0; ii < lenroot; ii++) /* make sure upper case */ + keyroot[ii] = toupper(keyroot[ii]); + + ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */ + + undefinedval = FALSE; + for (ii=3; ii <= nkeys; ii++) + { + if (ffgrec(fptr, ii, card, status) > 0) /* get next keyword */ + return(*status); + + if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */ + { + keyindex[0] = '\0'; + strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */ + + tstatus = 0; + if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */ + { + if (ival <= nend && ival >= nstart) + { + ffpsvc(card, svalue, comm, status); /* parse the value */ + ffc2s(svalue, value[ival-nstart], status); /* convert */ + if (ival - nstart + 1 > *nfound) + *nfound = ival - nstart + 1; /* max found */ + + if (*status == VALUE_UNDEFINED) + { + undefinedval = TRUE; + *status = 0; /* reset status to read remaining values */ + } + } + } + } + } + if (undefinedval && (*status <= 0) ) + *status = VALUE_UNDEFINED; /* report at least 1 value undefined */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgknl( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - root name of keywords to read */ + int nstart, /* I - starting index number */ + int nmax, /* I - maximum number of keywords to return */ + int *value, /* O - array of keyword values */ + int *nfound, /* O - number of values that were returned */ + int *status) /* IO - error status */ +/* + Read (get) an indexed array of keywords with index numbers between + NSTART and (NSTART + NMAX -1) inclusive. + The returned value = 1 if the keyword is true, else = 0 if false. +*/ +{ + int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval; + long ival; + char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD]; + char svalue[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, 8); + + lenroot = strlen(keyroot); + if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */ + return(*status); + + for (ii=0; ii < lenroot; ii++) /* make sure upper case */ + keyroot[ii] = toupper(keyroot[ii]); + + ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */ + + ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */ + + undefinedval = FALSE; + for (ii=3; ii <= nkeys; ii++) + { + if (ffgnky(fptr, card, status) > 0) /* get next keyword */ + return(*status); + + if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */ + { + keyindex[0] = '\0'; + strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */ + + tstatus = 0; + if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */ + { + if (ival <= nend && ival >= nstart) + { + ffpsvc(card, svalue, comm, status); /* parse the value */ + ffc2l(svalue, &value[ival-nstart], status); /* convert*/ + if (ival - nstart + 1 > *nfound) + *nfound = ival - nstart + 1; /* max found */ + + if (*status == VALUE_UNDEFINED) + { + undefinedval = TRUE; + *status = 0; /* reset status to read remaining values */ + } + } + } + } + } + if (undefinedval && (*status <= 0) ) + *status = VALUE_UNDEFINED; /* report at least 1 value undefined */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgknj( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - root name of keywords to read */ + int nstart, /* I - starting index number */ + int nmax, /* I - maximum number of keywords to return */ + long *value, /* O - array of keyword values */ + int *nfound, /* O - number of values that were returned */ + int *status) /* IO - error status */ +/* + Read (get) an indexed array of keywords with index numbers between + NSTART and (NSTART + NMAX -1) inclusive. +*/ +{ + int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval; + long ival; + char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD]; + char svalue[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, 8); + + lenroot = strlen(keyroot); + if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */ + return(*status); + + for (ii=0; ii < lenroot; ii++) /* make sure upper case */ + keyroot[ii] = toupper(keyroot[ii]); + + ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */ + + ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */ + + undefinedval = FALSE; + for (ii=3; ii <= nkeys; ii++) + { + if (ffgnky(fptr, card, status) > 0) /* get next keyword */ + return(*status); + + if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */ + { + keyindex[0] = '\0'; + strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */ + + tstatus = 0; + if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */ + { + if (ival <= nend && ival >= nstart) + { + ffpsvc(card, svalue, comm, status); /* parse the value */ + ffc2i(svalue, &value[ival-nstart], status); /* convert */ + if (ival - nstart + 1 > *nfound) + *nfound = ival - nstart + 1; /* max found */ + + if (*status == VALUE_UNDEFINED) + { + undefinedval = TRUE; + *status = 0; /* reset status to read remaining values */ + } + } + } + } + } + if (undefinedval && (*status <= 0) ) + *status = VALUE_UNDEFINED; /* report at least 1 value undefined */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgkne( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - root name of keywords to read */ + int nstart, /* I - starting index number */ + int nmax, /* I - maximum number of keywords to return */ + float *value, /* O - array of keyword values */ + int *nfound, /* O - number of values that were returned */ + int *status) /* IO - error status */ +/* + Read (get) an indexed array of keywords with index numbers between + NSTART and (NSTART + NMAX -1) inclusive. +*/ +{ + int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval; + long ival; + char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD]; + char svalue[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, 8); + + lenroot = strlen(keyroot); + if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */ + return(*status); + + for (ii=0; ii < lenroot; ii++) /* make sure upper case */ + keyroot[ii] = toupper(keyroot[ii]); + + ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */ + + ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */ + + undefinedval = FALSE; + for (ii=3; ii <= nkeys; ii++) + { + if (ffgnky(fptr, card, status) > 0) /* get next keyword */ + return(*status); + + if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */ + { + keyindex[0] = '\0'; + strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */ + + tstatus = 0; + if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */ + { + if (ival <= nend && ival >= nstart) + { + ffpsvc(card, svalue, comm, status); /* parse the value */ + ffc2r(svalue, &value[ival-nstart], status); /* convert */ + if (ival - nstart + 1 > *nfound) + *nfound = ival - nstart + 1; /* max found */ + + if (*status == VALUE_UNDEFINED) + { + undefinedval = TRUE; + *status = 0; /* reset status to read remaining values */ + } + } + } + } + } + if (undefinedval && (*status <= 0) ) + *status = VALUE_UNDEFINED; /* report at least 1 value undefined */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgknd( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - root name of keywords to read */ + int nstart, /* I - starting index number */ + int nmax, /* I - maximum number of keywords to return */ + double *value, /* O - array of keyword values */ + int *nfound, /* O - number of values that were returned */ + int *status) /* IO - error status */ +/* + Read (get) an indexed array of keywords with index numbers between + NSTART and (NSTART + NMAX -1) inclusive. +*/ +{ + int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval; + long ival; + char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD]; + char svalue[FLEN_VALUE], comm[FLEN_COMMENT]; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, 8); + + lenroot = strlen(keyroot); + if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */ + return(*status); + + for (ii=0; ii < lenroot; ii++) /* make sure upper case */ + keyroot[ii] = toupper(keyroot[ii]); + + ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */ + + ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */ + + undefinedval = FALSE; + for (ii=3; ii <= nkeys; ii++) + { + if (ffgnky(fptr, card, status) > 0) /* get next keyword */ + return(*status); + + if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */ + { + keyindex[0] = '\0'; + strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */ + + tstatus = 0; + if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */ + { + if (ival <= nend && ival >= nstart) /* is index within range? */ + { + ffpsvc(card, svalue, comm, status); /* parse the value */ + ffc2d(svalue, &value[ival-nstart], status); /* convert */ + if (ival - nstart + 1 > *nfound) + *nfound = ival - nstart + 1; /* max found */ + + if (*status == VALUE_UNDEFINED) + { + undefinedval = TRUE; + *status = 0; /* reset status to read remaining values */ + } + } + } + } + } + if (undefinedval && (*status <= 0) ) + *status = VALUE_UNDEFINED; /* report at least 1 value undefined */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtdm(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of the column to read */ + int maxdim, /* I - maximum no. of dimensions to read; */ + int *naxis, /* O - number of axes in the data array */ + long naxes[], /* O - length of each data axis */ + int *status) /* IO - error status */ +/* + read and parse the TDIMnnn keyword to get the dimensionality of a column +*/ +{ + int tstatus = 0; + char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + ffkeyn("TDIM", colnum, keyname, status); /* construct keyword name */ + + ffgkys(fptr, keyname, tdimstr, NULL, &tstatus); /* try reading keyword */ + + ffdtdm(fptr, tdimstr, colnum, maxdim,naxis, naxes, status); /* decode it */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdtdm(fitsfile *fptr, /* I - FITS file pointer */ + char *tdimstr, /* I - TDIMn keyword value string. e.g. (10,10) */ + int colnum, /* I - number of the column */ + int maxdim, /* I - maximum no. of dimensions to read; */ + int *naxis, /* O - number of axes in the data array */ + long naxes[], /* O - length of each data axis */ + int *status) /* IO - error status */ +/* + decode the TDIMnnn keyword to get the dimensionality of a column. + Check that the value is legal and consistent with the TFORM value. +*/ +{ + long dimsize, totalpix = 1; + char *loc, *lastloc, message[81]; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + return(*status = BAD_COL_NUM); + + colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */ + colptr += (colnum - 1); /* increment to the correct column */ + + if (!tdimstr[0]) /* TDIMn keyword doesn't exist? */ + { + *naxis = 1; /* default = 1 dimensional */ + if (maxdim > 0) + naxes[0] = (long) colptr->trepeat; /* default length = repeat */ + } + else + { + *naxis = 0; + + loc = strchr(tdimstr, '(' ); /* find the opening quote */ + if (!loc) + { + sprintf(message, "Illegal TDIM keyword value: %s", tdimstr); + return(*status = BAD_TDIM); + } + + while (loc) + { + loc++; + dimsize = strtol(loc, &loc, 10); /* read size of next dimension */ + if (*naxis < maxdim) + naxes[*naxis] = dimsize; + + if (dimsize < 0) + { + ffpmsg("one or more TDIM values are less than 0 (ffdtdm)"); + ffpmsg(tdimstr); + return(*status = BAD_TDIM); + } + + totalpix *= dimsize; + (*naxis)++; + lastloc = loc; + loc = strchr(loc, ','); /* look for comma before next dimension */ + } + + loc = strchr(lastloc, ')' ); /* check for the closing quote */ + if (!loc) + { + sprintf(message, "Illegal TDIM keyword value: %s", tdimstr); + return(*status = BAD_TDIM); + } + + if ((long) colptr->trepeat != totalpix) + { + sprintf(message, + "column vector length, %ld, does not equal TDIMn array size, %ld", + (long) colptr->trepeat, totalpix); + ffpmsg(message); + ffpmsg(tdimstr); + return(*status = BAD_TDIM); + } + } + return(*status); +} + +/*--------------------------------------------------------------------------*/ +int ffghpr(fitsfile *fptr, /* I - FITS file pointer */ + int maxdim, /* I - maximum no. of dimensions to read; */ + int *simple, /* O - does file conform to FITS standard? 1/0 */ + int *bitpix, /* O - number of bits per data value pixel */ + int *naxis, /* O - number of axes in the data array */ + long naxes[], /* O - length of each data axis */ + long *pcount, /* O - number of group parameters (usually 0) */ + long *gcount, /* O - number of random groups (usually 1 or 0) */ + int *extend, /* O - may FITS file haave extensions? */ + int *status) /* IO - error status */ +/* + Get keywords from the Header of the PRimary array: + Check that the keywords conform to the FITS standard and return the + parameters which determine the size and structure of the primary array + or IMAGE extension. +*/ +{ + int idummy; + long ldummy; + double ddummy; + + ffgphd(fptr, maxdim, simple, bitpix, naxis, naxes, pcount, gcount, extend, + &ddummy, &ddummy, &ldummy, &idummy, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffghtb(fitsfile *fptr, /* I - FITS file pointer */ + int maxfield, /* I - maximum no. of columns to read; */ + long *naxis1, /* O - length of table row in bytes */ + long *naxis2, /* O - number of rows in the table */ + int *tfields, /* O - number of columns in the table */ + char **ttype, /* O - name of each column */ + long *tbcol, /* O - byte offset in row to each column */ + char **tform, /* O - value of TFORMn keyword for each column */ + char **tunit, /* O - value of TUNITn keyword for each column */ + char *extnm, /* O - value of EXTNAME keyword, if any */ + int *status) /* IO - error status */ +/* + Get keywords from the Header of the ASCII TaBle: + Check that the keywords conform to the FITS standard and return the + parameters which describe the table. +*/ +{ + int ii, maxf, nfound, tstatus; + long pcount, fields; + char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT]; + char xtension[FLEN_VALUE], message[81]; + + if (*status > 0) + return(*status); + + /* read the first keyword of the extension */ + ffgkyn(fptr, 1, name, value, comm, status); + + if (!strcmp(name, "XTENSION")) + { + if (ffc2s(value, xtension, status) > 0) /* get the value string */ + { + ffpmsg("Bad value string for XTENSION keyword:"); + ffpmsg(value); + return(*status); + } + + /* allow the quoted string value to begin in any column and */ + /* allow any number of trailing blanks before the closing quote */ + if ( (value[0] != '\'') || /* first char must be a quote */ + ( strcmp(xtension, "TABLE") ) ) + { + sprintf(message, + "This is not a TABLE extension: %s", value); + ffpmsg(message); + return(*status = NOT_ATABLE); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + sprintf(message, + "First keyword of the extension is not XTENSION: %s", name); + ffpmsg(message); + return(*status = NO_XTENSION); + } + + if (ffgttb(fptr, naxis1, naxis2, &pcount, &fields, status) > 0) + return(*status); + + if (pcount != 0) + { + sprintf(message, "PCOUNT = %ld is illegal in ASCII table; must = 0", + pcount); + ffpmsg(message); + return(*status = BAD_PCOUNT); + } + + if (tfields) + *tfields = fields; + + if (maxfield < 0) + maxf = fields; + else + maxf = minvalue(maxfield, fields); + + if (maxf > 0) + { + for (ii = 0; ii < maxf; ii++) + { /* initialize optional keyword values */ + if (ttype) + *ttype[ii] = '\0'; + + if (tunit) + *tunit[ii] = '\0'; + } + + + if (ttype) + ffgkns(fptr, "TTYPE", 1, maxf, ttype, &nfound, status); + + if (tunit) + ffgkns(fptr, "TUNIT", 1, maxf, tunit, &nfound, status); + + if (*status > 0) + return(*status); + + if (tbcol) + { + ffgknj(fptr, "TBCOL", 1, maxf, tbcol, &nfound, status); + + if (*status > 0 || nfound != maxf) + { + ffpmsg( + "Required TBCOL keyword(s) not found in ASCII table header (ffghtb)."); + return(*status = NO_TBCOL); + } + } + + if (tform) + { + ffgkns(fptr, "TFORM", 1, maxf, tform, &nfound, status); + + if (*status > 0 || nfound != maxf) + { + ffpmsg( + "Required TFORM keyword(s) not found in ASCII table header (ffghtb)."); + return(*status = NO_TFORM); + } + } + } + + if (extnm) + { + extnm[0] = '\0'; + + tstatus = *status; + ffgkys(fptr, "EXTNAME", extnm, comm, status); + + if (*status == KEY_NO_EXIST) + *status = tstatus; /* keyword not required, so ignore error */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffghbn(fitsfile *fptr, /* I - FITS file pointer */ + int maxfield, /* I - maximum no. of columns to read; */ + long *naxis2, /* O - number of rows in the table */ + int *tfields, /* O - number of columns in the table */ + char **ttype, /* O - name of each column */ + char **tform, /* O - TFORMn value for each column */ + char **tunit, /* O - TUNITn value for each column */ + char *extnm, /* O - value of EXTNAME keyword, if any */ + long *pcount, /* O - value of PCOUNT keyword */ + int *status) /* IO - error status */ +/* + Get keywords from the Header of the BiNary table: + Check that the keywords conform to the FITS standard and return the + parameters which describe the table. +*/ +{ + int ii, maxf, nfound, tstatus; + long naxis1, fields; + char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT]; + char xtension[FLEN_VALUE], message[81]; + + if (*status > 0) + return(*status); + + /* read the first keyword of the extension */ + ffgkyn(fptr, 1, name, value, comm, status); + + if (!strcmp(name, "XTENSION")) + { + if (ffc2s(value, xtension, status) > 0) /* get the value string */ + { + ffpmsg("Bad value string for XTENSION keyword:"); + ffpmsg(value); + return(*status); + } + + /* allow the quoted string value to begin in any column and */ + /* allow any number of trailing blanks before the closing quote */ + if ( (value[0] != '\'') || /* first char must be a quote */ + ( strcmp(xtension, "BINTABLE") && + strcmp(xtension, "A3DTABLE") && + strcmp(xtension, "3DTABLE") + ) ) + { + sprintf(message, + "This is not a BINTABLE extension: %s", value); + ffpmsg(message); + return(*status = NOT_BTABLE); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + sprintf(message, + "First keyword of the extension is not XTENSION: %s", name); + ffpmsg(message); + return(*status = NO_XTENSION); + } + + if (ffgttb(fptr, &naxis1, naxis2, pcount, &fields, status) > 0) + return(*status); + + if (tfields) + *tfields = fields; + + if (maxfield < 0) + maxf = fields; + else + maxf = minvalue(maxfield, fields); + + if (maxf > 0) + { + for (ii = 0; ii < maxf; ii++) + { /* initialize optional keyword values */ + if (ttype) + *ttype[ii] = '\0'; + + if (tunit) + *tunit[ii] = '\0'; + } + + if (ttype) + ffgkns(fptr, "TTYPE", 1, maxf, ttype, &nfound, status); + + if (tunit) + ffgkns(fptr, "TUNIT", 1, maxf, tunit, &nfound, status); + + if (*status > 0) + return(*status); + + if (tform) + { + ffgkns(fptr, "TFORM", 1, maxf, tform, &nfound, status); + + if (*status > 0 || nfound != maxf) + { + ffpmsg( + "Required TFORM keyword(s) not found in binary table header (ffghbn)."); + return(*status = NO_TFORM); + } + } + } + + if (extnm) + { + extnm[0] = '\0'; + + tstatus = *status; + ffgkys(fptr, "EXTNAME", extnm, comm, status); + + if (*status == KEY_NO_EXIST) + *status = tstatus; /* keyword not required, so ignore error */ + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgphd(fitsfile *fptr, /* I - FITS file pointer */ + int maxdim, /* I - maximum no. of dimensions to read; */ + int *simple, /* O - does file conform to FITS standard? 1/0 */ + int *bitpix, /* O - number of bits per data value pixel */ + int *naxis, /* O - number of axes in the data array */ + long naxes[], /* O - length of each data axis */ + long *pcount, /* O - number of group parameters (usually 0) */ + long *gcount, /* O - number of random groups (usually 1 or 0) */ + int *extend, /* O - may FITS file haave extensions? */ + double *bscale, /* O - array pixel linear scaling factor */ + double *bzero, /* O - array pixel linear scaling zero point */ + long *blank, /* O - value used to represent undefined pixels */ + int *nspace, /* O - number of blank keywords prior to END */ + int *status) /* IO - error status */ +{ +/* + Get the Primary HeaDer parameters. Check that the keywords conform to + the FITS standard and return the parameters which determine the size and + structure of the primary array or IMAGE extension. +*/ + int unknown, found_end, tstatus, ii, nextkey, namelen; + long longbitpix, longnaxis, axislen; + char message[FLEN_ERRMSG], keyword[FLEN_KEYWORD]; + char card[FLEN_CARD]; + char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT]; + char xtension[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if (simple) + *simple = 1; + + unknown = 0; + + /*--------------------------------------------------------------------*/ + /* Get 1st keyword of HDU and test whether it is SIMPLE or XTENSION */ + /*--------------------------------------------------------------------*/ + ffgkyn(fptr, 1, name, value, comm, status); + + if ((fptr->Fptr)->curhdu == 0) /* Is this the beginning of the FITS file? */ + { + if (!strcmp(name, "SIMPLE")) + { + if (value[0] == 'F') + { + if (simple) + *simple=0; /* not a simple FITS file */ + } + else if (value[0] != 'T') + return(*status = BAD_SIMPLE); + } + + else + { + sprintf(message, + "First keyword of the file is not SIMPLE: %s", name); + ffpmsg(message); + return(*status = NO_SIMPLE); + } + } + + else /* not beginning of the file, so presumably an IMAGE extension */ + { /* or it could be a compressed image in a binary table */ + + if (!strcmp(name, "XTENSION")) + { + if (ffc2s(value, xtension, status) > 0) /* get the value string */ + { + ffpmsg("Bad value string for XTENSION keyword:"); + ffpmsg(value); + return(*status); + } + + /* allow the quoted string value to begin in any column and */ + /* allow any number of trailing blanks before the closing quote */ + if ( (value[0] != '\'') || /* first char must be a quote */ + ( strcmp(xtension, "IMAGE") && + strcmp(xtension, "IUEIMAGE") ) ) + { + unknown = 1; /* unknown type of extension; press on anyway */ + sprintf(message, + "This is not an IMAGE extension: %s", value); + ffpmsg(message); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + sprintf(message, + "First keyword of the extension is not XTENSION: %s", name); + ffpmsg(message); + return(*status = NO_XTENSION); + } + } + + if (unknown && (fptr->Fptr)->compressimg) + { + /* this is a compressed image, so read ZBITPIX, ZNAXIS keywords */ + unknown = 0; /* reset flag */ + ffxmsg(3, message); /* clear previous spurious error message */ + + if (bitpix) + { + ffgidt(fptr, bitpix, status); /* get bitpix value */ + + if (*status > 0) + { + ffpmsg("Error reading BITPIX value of compressed image"); + return(*status); + } + } + + if (naxis) + { + ffgidm(fptr, naxis, status); /* get NAXIS value */ + + if (*status > 0) + { + ffpmsg("Error reading NAXIS value of compressed image"); + return(*status); + } + } + + if (naxes) + { + ffgisz(fptr, maxdim, naxes, status); /* get NAXISn value */ + + if (*status > 0) + { + ffpmsg("Error reading NAXISn values of compressed image"); + return(*status); + } + } + + nextkey = 9; /* skip required table keywords in the following search */ + } + else + { + + /*----------------------------------------------------------------*/ + /* Get 2nd keyword; test whether it is BITPIX with legal value */ + /*----------------------------------------------------------------*/ + ffgkyn(fptr, 2, name, value, comm, status); /* BITPIX = 2nd keyword */ + + if (strcmp(name, "BITPIX")) + { + sprintf(message, + "Second keyword of the extension is not BITPIX: %s", name); + ffpmsg(message); + return(*status = NO_BITPIX); + } + + if (ffc2ii(value, &longbitpix, status) > 0) + { + sprintf(message, + "Value of BITPIX keyword is not an integer: %s", value); + ffpmsg(message); + return(*status = BAD_BITPIX); + } + else if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG && + longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG && + longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG) + { + sprintf(message, + "Illegal value for BITPIX keyword: %s", value); + ffpmsg(message); + return(*status = BAD_BITPIX); + } + if (bitpix) + *bitpix = longbitpix; /* do explicit type conversion */ + + /*---------------------------------------------------------------*/ + /* Get 3rd keyword; test whether it is NAXIS with legal value */ + /*---------------------------------------------------------------*/ + ffgtkn(fptr, 3, "NAXIS", &longnaxis, status); + + if (*status == BAD_ORDER) + return(*status = NO_NAXIS); + else if (*status == NOT_POS_INT || longnaxis > 999) + { + sprintf(message,"NAXIS = %ld is illegal", longnaxis); + ffpmsg(message); + return(*status = BAD_NAXIS); + } + else + if (naxis) + *naxis = longnaxis; /* do explicit type conversion */ + + /*---------------------------------------------------------*/ + /* Get the next NAXISn keywords and test for legal values */ + /*---------------------------------------------------------*/ + for (ii=0, nextkey=4; ii < longnaxis; ii++, nextkey++) + { + ffkeyn("NAXIS", ii+1, keyword, status); + ffgtkn(fptr, 4+ii, keyword, &axislen, status); + + if (*status == BAD_ORDER) + return(*status = NO_NAXES); + else if (*status == NOT_POS_INT) + return(*status = BAD_NAXES); + else if (ii < maxdim) + if (naxes) + naxes[ii] = axislen; + } + } + + /*---------------------------------------------------------*/ + /* now look for other keywords of interest: */ + /* BSCALE, BZERO, BLANK, PCOUNT, GCOUNT, EXTEND, and END */ + /*---------------------------------------------------------*/ + + /* initialize default values in case keyword is not present */ + if (bscale) + *bscale = 1.0; + if (bzero) + *bzero = 0.0; + if (pcount) + *pcount = 0; + if (gcount) + *gcount = 1; + if (extend) + *extend = 0; + if (blank) + *blank = NULL_UNDEFINED; /* no default null value for BITPIX=8,16,32 */ + + *nspace = 0; + found_end = 0; + tstatus = *status; + + for (; !found_end; nextkey++) + { + /* get next keyword */ + /* don't use ffgkyn here because it trys to parse the card to read */ + /* the value string, thus failing to read the file just because of */ + /* minor syntax errors in optional keywords. */ + + if (ffgrec(fptr, nextkey, card, status) > 0 ) /* get the 80-byte card */ + { + if (*status == KEY_OUT_BOUNDS) + { + found_end = 1; /* simply hit the end of the header */ + *status = tstatus; /* reset error status */ + } + else + { + ffpmsg("Failed to find the END keyword in header (ffgphd)."); + } + } + else /* got the next keyword without error */ + { + ffgknm(card, name, &namelen, status); /* get the keyword name */ + + if (fftrec(name, status) > 0) /* test keyword name; catches no END */ + { + sprintf(message, + "Name of keyword no. %d contains illegal character(s): %s", + nextkey, name); + ffpmsg(message); + + if (nextkey % 36 == 0) /* test if at beginning of 36-card record */ + ffpmsg(" (This may indicate a missing END keyword)."); + } + + if (!strcmp(name, "BSCALE") && bscale) + { + *nspace = 0; /* reset count of blank keywords */ + ffpsvc(card, value, comm, status); /* parse value and comment */ + + if (ffc2dd(value, bscale, status) > 0) /* convert to double */ + { + /* reset error status and continue, but still issue warning */ + *status = tstatus; + *bscale = 1.0; + + sprintf(message, + "Error reading BSCALE keyword value as a double: %s", value); + ffpmsg(message); + } + } + + else if (!strcmp(name, "BZERO") && bzero) + { + *nspace = 0; /* reset count of blank keywords */ + ffpsvc(card, value, comm, status); /* parse value and comment */ + + if (ffc2dd(value, bzero, status) > 0) /* convert to double */ + { + /* reset error status and continue, but still issue warning */ + *status = tstatus; + *bzero = 0.0; + + sprintf(message, + "Error reading BZERO keyword value as a double: %s", value); + ffpmsg(message); + } + } + + else if (!strcmp(name, "BLANK") && blank) + { + *nspace = 0; /* reset count of blank keywords */ + ffpsvc(card, value, comm, status); /* parse value and comment */ + + if (ffc2ii(value, blank, status) > 0) /* convert to long */ + { + /* reset error status and continue, but still issue warning */ + *status = tstatus; + *blank = NULL_UNDEFINED; + + sprintf(message, + "Error reading BLANK keyword value as an integer: %s", value); + ffpmsg(message); + } + } + + else if (!strcmp(name, "PCOUNT") && pcount) + { + *nspace = 0; /* reset count of blank keywords */ + ffpsvc(card, value, comm, status); /* parse value and comment */ + + if (ffc2ii(value, pcount, status) > 0) /* convert to long */ + { + sprintf(message, + "Error reading PCOUNT keyword value as an integer: %s", value); + ffpmsg(message); + } + } + + else if (!strcmp(name, "GCOUNT") && gcount) + { + *nspace = 0; /* reset count of blank keywords */ + ffpsvc(card, value, comm, status); /* parse value and comment */ + + if (ffc2ii(value, gcount, status) > 0) /* convert to long */ + { + sprintf(message, + "Error reading GCOUNT keyword value as an integer: %s", value); + ffpmsg(message); + } + } + + else if (!strcmp(name, "EXTEND") && extend) + { + *nspace = 0; /* reset count of blank keywords */ + ffpsvc(card, value, comm, status); /* parse value and comment */ + + if (ffc2ll(value, extend, status) > 0) /* convert to logical */ + { + /* reset error status and continue, but still issue warning */ + *status = tstatus; + *extend = 0; + + sprintf(message, + "Error reading EXTEND keyword value as a logical: %s", value); + ffpmsg(message); + } + } + + else if (!strcmp(name, "END")) + found_end = 1; + + else if (!card[0] ) + *nspace = *nspace + 1; /* this is a blank card in the header */ + + else + *nspace = 0; /* reset count of blank keywords immediately + before the END keyword to zero */ + } + + if (*status > 0) /* exit on error after writing error message */ + { + if ((fptr->Fptr)->curhdu == 0) + ffpmsg( + "Failed to read the required primary array header keywords."); + else + ffpmsg( + "Failed to read the required image extension header keywords."); + + return(*status); + } + } + + if (unknown) + *status = NOT_IMAGE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgttb(fitsfile *fptr, /* I - FITS file pointer*/ + long *rowlen, /* O - length of a table row, in bytes */ + long *nrows, /* O - number of rows in the table */ + long *pcount, /* O - value of PCOUNT keyword */ + long *tfields, /* O - number of fields in the table */ + int *status) /* IO - error status */ +{ +/* + Get and Test TaBle; + Test that this is a legal ASCII or binary table and get some keyword values. + We assume that the calling routine has already tested the 1st keyword + of the extension to ensure that this is really a table extension. +*/ + if (*status > 0) + return(*status); + + if (fftkyn(fptr, 2, "BITPIX", "8", status) == BAD_ORDER) /* 2nd keyword */ + return(*status = NO_BITPIX); /* keyword not BITPIX */ + else if (*status == NOT_POS_INT) + return(*status = BAD_BITPIX); /* value != 8 */ + + if (fftkyn(fptr, 3, "NAXIS", "2", status) == BAD_ORDER) /* 3rd keyword */ + return(*status = NO_NAXIS); /* keyword not NAXIS */ + else if (*status == NOT_POS_INT) + return(*status = BAD_NAXIS); /* value != 2 */ + + if (ffgtkn(fptr, 4, "NAXIS1", rowlen, status) == BAD_ORDER) /* 4th key */ + return(*status = NO_NAXES); /* keyword not NAXIS1 */ + else if (*status == NOT_POS_INT) + return(*status == BAD_NAXES); /* bad NAXIS1 value */ + + if (ffgtkn(fptr, 5, "NAXIS2", nrows, status) == BAD_ORDER) /* 5th key */ + return(*status = NO_NAXES); /* keyword not NAXIS2 */ + else if (*status == NOT_POS_INT) + return(*status == BAD_NAXES); /* bad NAXIS2 value */ + + if (ffgtkn(fptr, 6, "PCOUNT", pcount, status) == BAD_ORDER) /* 6th key */ + return(*status = NO_PCOUNT); /* keyword not PCOUNT */ + else if (*status == NOT_POS_INT) + return(*status = BAD_PCOUNT); /* bad PCOUNT value */ + + if (fftkyn(fptr, 7, "GCOUNT", "1", status) == BAD_ORDER) /* 7th keyword */ + return(*status = NO_GCOUNT); /* keyword not GCOUNT */ + else if (*status == NOT_POS_INT) + return(*status = BAD_GCOUNT); /* value != 1 */ + + if (ffgtkn(fptr, 8, "TFIELDS", tfields, status) == BAD_ORDER) /* 8th key*/ + return(*status = NO_TFIELDS); /* keyword not TFIELDS */ + else if (*status == NOT_POS_INT || *tfields > 999) + return(*status == BAD_TFIELDS); /* bad TFIELDS value */ + + + if (*status > 0) + ffpmsg( + "Error reading required keywords in the table header (FTGTTB)."); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtkn(fitsfile *fptr, /* I - FITS file pointer */ + int numkey, /* I - number of the keyword to read */ + char *name, /* I - expected name of the keyword */ + long *value, /* O - integer value of the keyword */ + int *status) /* IO - error status */ +{ +/* + test that keyword number NUMKEY has the expected name and get the + integer value of the keyword. Return an error if the keyword + name does not match the input name, or if the value of the + keyword is not a positive integer. +*/ + char keyname[FLEN_KEYWORD], valuestring[FLEN_VALUE]; + char comm[FLEN_COMMENT], message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + keyname[0] = '\0'; + valuestring[0] = '\0'; + + if (ffgkyn(fptr, numkey, keyname, valuestring, comm, status) <= 0) + { + if (strcmp(keyname, name) ) + *status = BAD_ORDER; /* incorrect keyword name */ + + else + { + ffc2ii(valuestring, value, status); /* convert to integer */ + + if (*status > 0 || *value < 0 ) + *status = NOT_POS_INT; + } + + if (*status > 0) + { + sprintf(message, + "ffgtkn found unexpected keyword or value for keyword no. %d.", + numkey); + ffpmsg(message); + + sprintf(message, + " Expected positive integer keyword %s, but instead", name); + ffpmsg(message); + + sprintf(message, + " found keyword %s with value %s", keyname, valuestring); + ffpmsg(message); + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftkyn(fitsfile *fptr, /* I - FITS file pointer */ + int numkey, /* I - number of the keyword to read */ + char *name, /* I - expected name of the keyword */ + char *value, /* I - expected value of the keyword */ + int *status) /* IO - error status */ +{ +/* + test that keyword number NUMKEY has the expected name and the + expected value string. +*/ + char keyname[FLEN_KEYWORD], valuestring[FLEN_VALUE]; + char comm[FLEN_COMMENT], message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + keyname[0] = '\0'; + valuestring[0] = '\0'; + + if (ffgkyn(fptr, numkey, keyname, valuestring, comm, status) <= 0) + { + if (strcmp(keyname, name) ) + *status = BAD_ORDER; /* incorrect keyword name */ + + if (strcmp(value, valuestring) ) + *status = NOT_POS_INT; /* incorrect keyword value */ + } + + if (*status > 0) + { + sprintf(message, + "fftkyn found unexpected keyword or value for keyword no. %d.", + numkey); + ffpmsg(message); + + sprintf(message, + " Expected keyword %s with value %s, but", name, value); + ffpmsg(message); + + sprintf(message, + " found keyword %s with value %s", keyname, valuestring); + ffpmsg(message); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffh2st(fitsfile *fptr, /* I - FITS file pointer */ + char **header, /* O - returned header string */ + int *status) /* IO - error status */ + +/* + read header keywords into a long string of chars. This routine allocates + memory for the string, so the calling routine must eventually free the + memory when it is not needed any more. +*/ +{ + int nkeys; + long nrec; + OFF_T headstart; + + if (*status > 0) + return(*status); + + /* get number of keywords in the header (doesn't include END) */ + if (ffghsp(fptr, &nkeys, NULL, status) > 0) + return(*status); + + nrec = (nkeys / 36 + 1); + + /* allocate memory for all the keywords (multiple of 2880 bytes) */ + *header = (char *) calloc ( nrec * 2880 + 1, 1); + if (!(*header)) + { + *status = MEMORY_ALLOCATION; + ffpmsg("failed to allocate memory to hold all the header keywords"); + return(*status); + } + + ffghof(fptr, &headstart, NULL, NULL, status); /* get header address */ + ffmbyt(fptr, headstart, REPORT_EOF, status); /* move to header */ + ffgbyt(fptr, nrec * 2880, *header, status); /* copy header */ + *(*header + (nrec * 2880)) = '\0'; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffhdr2str( fitsfile *fptr, /* I - FITS file pointer */ + int exclude_comm, /* I - if TRUE, exclude commentary keywords */ + char **exclist, /* I - list of excluded keyword names */ + int nexc, /* I - number of names in exclist */ + char **header, /* O - returned header string */ + int *nkeys, /* O - returned number of 80-char keywords */ + int *status) /* IO - error status */ +/* + read header keywords into a long string of chars. This routine allocates + memory for the string, so the calling routine must eventually free the + memory when it is not needed any more. If exclude_comm is TRUE, then all + the COMMENT, HISTORY, and keywords will be excluded from the output + string of keywords. Any other list of keywords to be excluded may be + specified with the exclist parameter. +*/ +{ + int casesn, match, exact, totkeys; + long ii, jj; + char keybuf[162], keyname[FLEN_KEYWORD], *headptr; + + *nkeys = 0; + + if (*status > 0) + return(*status); + + /* get number of keywords in the header (doesn't include END) */ + if (ffghsp(fptr, &totkeys, NULL, status) > 0) + return(*status); + + /* allocate memory for all the keywords (multiple of 2880 bytes) */ + *header = (char *) calloc ( (totkeys + 1) * 80 + 1, 1); + if (!(*header)) + { + *status = MEMORY_ALLOCATION; + ffpmsg("failed to allocate memory to hold all the header keywords"); + return(*status); + } + + headptr = *header; + casesn = FALSE; + + /* read every keyword */ + for (ii = 1; ii <= totkeys; ii++) + { + ffgrec(fptr, ii, keybuf, status); + /* pad record with blanks so that it is at least 80 chars long */ + strcat(keybuf, + " "); + + keyname[0] = '\0'; + strncat(keyname, keybuf, 8); /* copy the keyword name */ + + if (exclude_comm) + { + if (!FSTRCMP("COMMENT ", keyname) || + !FSTRCMP("HISTORY ", keyname) || + !FSTRCMP(" ", keyname) ) + continue; /* skip this commentary keyword */ + } + + /* does keyword match any names in the exclusion list? */ + for (jj = 0; jj < nexc; jj++ ) + { + ffcmps(exclist[jj], keyname, casesn, &match, &exact); + if (match) + break; + } + + if (jj == nexc) + { + /* not in exclusion list, add this keyword to the string */ + strcpy(headptr, keybuf); + headptr += 80; + (*nkeys)++; + } + } + + /* add the END keyword */ + strcpy(headptr, + "END "); + headptr += 80; + (*nkeys)++; + + *headptr = '\0'; /* terminate the header string */ + realloc(*header, (*nkeys *80) + 1); /* minimize the allocated memory */ + + return(*status); +} diff --git a/pkg/tbtables/cfitsio/group.c b/pkg/tbtables/cfitsio/group.c new file mode 100644 index 00000000..9b5a481d --- /dev/null +++ b/pkg/tbtables/cfitsio/group.c @@ -0,0 +1,6418 @@ +/* This file, group.c, contains the grouping convention suport routines. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ +/* */ +/* The group.c module of CFITSIO was written by Donald G. Jennings of */ +/* the INTEGRAL Science Data Centre (ISDC) under NASA contract task */ +/* 66002J6. The above copyright laws apply. Copyright guidelines of The */ +/* University of Geneva might also apply. */ + +/* The following routines are designed to create, read, and manipulate */ +/* FITS Grouping Tables as defined in the FITS Grouping Convention paper */ +/* by Jennings, Pence, Folk and Schlesinger. The development of the */ +/* grouping structure was partially funded under the NASA AISRP Program. */ + +#include "fitsio2.h" +#include "group.h" +#include +#include +#include + +#define HEX_ESCAPE '%' + +/*--------------------------------------------------------------------------- + Change record: + +D. Jennings, 18/06/98, version 1.0 of group module delivered to B. Pence for + integration into CFITSIO 2.005 + +D. Jennings, 17/11/98, fixed bug in ffgtcpr(). Now use fits_find_nextkey() + correctly and insert auxiliary keyword records + directly before the TTYPE1 keyword in the copied + group table. + +D. Jennings, 22/01/99, ffgmop() now looks for relative file paths when + the MEMBER_LOCATION information is given in a + grouping table. + +D. Jennings, 01/02/99, ffgtop() now looks for relatve file paths when + the GRPLCn keyword value is supplied in the member + HDU header. + +D. Jennings, 01/02/99, ffgtam() now trys to construct relative file paths + from the member's file to the group table's file + (and visa versa) when both the member's file and + group table file are of access type FILE://. + +D. Jennings, 05/05/99, removed the ffgtcn() function; made obsolete by + fits_get_url(). + +D. Jennings, 05/05/99, updated entire module to handle partial URLs and + absolute URLs more robustly. Host dependent directory + paths are now converted to true URLs before being + read from/written to grouping tables. + +D. Jennings, 05/05/99, added the following new functions (note, none of these + are directly callable by the application) + + int fits_path2url() + int fits_url2path() + int fits_get_cwd() + int fits_get_url() + int fits_clean_url() + int fits_relurl2url() + int fits_encode_url() + int fits_unencode_url() + int fits_is_url_absolute() + +-----------------------------------------------------------------------------*/ + +/*---------------------------------------------------------------------------*/ +int ffgtcr(fitsfile *fptr, /* FITS file pointer */ + char *grpname, /* name of the grouping table */ + int grouptype, /* code specifying the type of + grouping table information: + GT_ID_ALL_URI 0 ==> defualt (all columns) + GT_ID_REF 1 ==> ID by reference + GT_ID_POS 2 ==> ID by position + GT_ID_ALL 3 ==> ID by ref. and position + GT_ID_REF_URI 11 ==> (1) + URI info + GT_ID_POS_URI 12 ==> (2) + URI info */ + int *status )/* return status code */ + +/* + create a grouping table at the end of the current FITS file. This + function makes the last HDU in the file the CHDU, then calls the + fits_insert_group() function to actually create the new grouping table. +*/ + +{ + int hdutype; + int hdunum; + + + if(*status != 0) return(*status); + + + *status = fits_get_num_hdus(fptr,&hdunum,status); + + /* If hdunum is 0 then we are at the beginning of the file and + we actually haven't closed the first header yet, so don't do + anything more */ + + if (0 != hdunum) { + + *status = fits_movabs_hdu(fptr,hdunum,&hdutype,status); + } + + /* Now, the whole point of the above two fits_ calls was to get to + the end of file. Let's ignore errors at this point and keep + going since any error is likely to mean that we are already at the + EOF, or the file is fatally corrupted. If we are at the EOF then + the next fits_ call will be ok. If it's corrupted then the + next call will fail, but that's not big deal at this point. + */ + + if (0 != *status ) *status = 0; + + *status = fits_insert_group(fptr,grpname,grouptype,status); + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtis(fitsfile *fptr, /* FITS file pointer */ + char *grpname, /* name of the grouping table */ + int grouptype, /* code specifying the type of + grouping table information: + GT_ID_ALL_URI 0 ==> defualt (all columns) + GT_ID_REF 1 ==> ID by reference + GT_ID_POS 2 ==> ID by position + GT_ID_ALL 3 ==> ID by ref. and position + GT_ID_REF_URI 11 ==> (1) + URI info + GT_ID_POS_URI 12 ==> (2) + URI info */ + int *status) /* return status code */ + +/* + insert a grouping table just after the current HDU of the current FITS file. + This is the same as fits_create_group() only it allows the user to select + the place within the FITS file to add the grouping table. +*/ + +{ + + int tfields = 0; + int hdunum = 0; + int hdutype = 0; + int extver = 0; + int i; + + long pcount = 0; + + char *ttype[6]; + char *tform[6]; + + char ttypeBuff[102]; + char tformBuff[54]; + + char extname[] = "GROUPING"; + char keyword[FLEN_KEYWORD]; + char keyvalue[FLEN_VALUE]; + char comment[FLEN_COMMENT]; + + do + { + + /* set up the ttype and tform character buffers */ + + for(i = 0; i < 6; ++i) + { + ttype[i] = ttypeBuff+(i*17); + tform[i] = tformBuff+(i*9); + } + + /* define the columns required according to the grouptype parameter */ + + *status = ffgtdc(grouptype,0,0,0,0,0,0,ttype,tform,&tfields,status); + + /* create the grouping table using the columns defined above */ + + *status = fits_insert_btbl(fptr,0,tfields,ttype,tform,NULL, + NULL,pcount,status); + + if(*status != 0) continue; + + /* + retrieve the hdu position of the new grouping table for + future use + */ + + fits_get_hdu_num(fptr,&hdunum); + + /* + add the EXTNAME and EXTVER keywords to the HDU just after the + TFIELDS keyword; for now the EXTVER value is set to 0, it will be + set to the correct value later on + */ + + fits_read_keyword(fptr,"TFIELDS",keyvalue,comment,status); + + fits_insert_key_str(fptr,"EXTNAME",extname, + "HDU contains a Grouping Table",status); + fits_insert_key_lng(fptr,"EXTVER",0,"Grouping Table vers. (this file)", + status); + + /* + if the grpname parameter value was defined (Non NULL and non zero + length) then add the GRPNAME keyword and value + */ + + if(grpname != NULL && strlen(grpname) > 0) + fits_insert_key_str(fptr,"GRPNAME",grpname,"Grouping Table name", + status); + + /* + add the TNULL keywords and values for each integer column defined; + integer null values are zero (0) for the MEMBER_POSITION and + MEMBER_VERSION columns. + */ + + for(i = 0; i < tfields && *status == 0; ++i) + { + if(strcasecmp(ttype[i],"MEMBER_POSITION") == 0 || + strcasecmp(ttype[i],"MEMBER_VERSION") == 0) + { + sprintf(keyword,"TFORM%d",i+1); + *status = fits_read_key_str(fptr,keyword,keyvalue,comment, + status); + + sprintf(keyword,"TNULL%d",i+1); + + *status = fits_insert_key_lng(fptr,keyword,0,"Column Null Value", + status); + } + } + + /* + determine the correct EXTVER value for the new grouping table + by finding the highest numbered grouping table EXTVER value + the currently exists + */ + + for(extver = 1; + (fits_movnam_hdu(fptr,ANY_HDU,"GROUPING",extver,status)) == 0; + ++extver); + + if(*status == BAD_HDU_NUM) *status = 0; + + /* + move back to the new grouping table HDU and update the EXTVER + keyword value + */ + + fits_movabs_hdu(fptr,hdunum,&hdutype,status); + + fits_modify_key_lng(fptr,"EXTVER",extver,"&",status); + + }while(0); + + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtch(fitsfile *gfptr, /* FITS pointer to group */ + int grouptype, /* code specifying the type of + grouping table information: + GT_ID_ALL_URI 0 ==> defualt (all columns) + GT_ID_REF 1 ==> ID by reference + GT_ID_POS 2 ==> ID by position + GT_ID_ALL 3 ==> ID by ref. and position + GT_ID_REF_URI 11 ==> (1) + URI info + GT_ID_POS_URI 12 ==> (2) + URI info */ + int *status) /* return status code */ + + +/* + Change the grouping table structure of the grouping table pointed to by + gfptr. The grouptype code specifies the new structure of the table. This + operation only adds or removes grouping table columns, it does not add + or delete group members (i.e., table rows). If the grouping table already + has the desired structure then no operations are performed and function + simply returns with a (0) success status code. If the requested structure + change creates new grouping table columns, then the column values for all + existing members will be filled with the appropriate null values. +*/ + +{ + int xtensionCol, extnameCol, extverCol, positionCol, locationCol, uriCol; + int ncols = 0; + int colnum = 0; + int nrows = 0; + int grptype = 0; + int i,j; + + long intNull = 0; + long tfields = 0; + + char *tform[6]; + char *ttype[6]; + + unsigned char charNull[1] = {'\0'}; + + char ttypeBuff[102]; + char tformBuff[54]; + + char keyword[FLEN_KEYWORD]; + char keyvalue[FLEN_VALUE]; + char comment[FLEN_COMMENT]; + + + if(*status != 0) return(*status); + + do + { + /* set up the ttype and tform character buffers */ + + for(i = 0; i < 6; ++i) + { + ttype[i] = ttypeBuff+(i*17); + tform[i] = tformBuff+(i*9); + } + + /* retrieve positions of all Grouping table reserved columns */ + + *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol, + &locationCol,&uriCol,&grptype,status); + + if(*status != 0) continue; + + /* determine the total number of grouping table columns */ + + *status = fits_read_key_lng(gfptr,"TFIELDS",&tfields,comment,status); + + /* define grouping table columns to be added to the configuration */ + + *status = ffgtdc(grouptype,xtensionCol,extnameCol,extverCol,positionCol, + locationCol,uriCol,ttype,tform,&ncols,status); + + /* + delete any grouping tables columns that exist but do not belong to + new desired configuration; note that we delete before creating new + columns for (file size) efficiency reasons + */ + + switch(grouptype) + { + + case GT_ID_ALL_URI: + + /* no columns to be deleted in this case */ + + break; + + case GT_ID_REF: + + if(positionCol != 0) + { + *status = fits_delete_col(gfptr,positionCol,status); + --tfields; + if(uriCol > positionCol) --uriCol; + if(locationCol > positionCol) --locationCol; + } + if(uriCol != 0) + { + *status = fits_delete_col(gfptr,uriCol,status); + --tfields; + if(locationCol > uriCol) --locationCol; + } + if(locationCol != 0) + *status = fits_delete_col(gfptr,locationCol,status); + + break; + + case GT_ID_POS: + + if(xtensionCol != 0) + { + *status = fits_delete_col(gfptr,xtensionCol,status); + --tfields; + if(extnameCol > xtensionCol) --extnameCol; + if(extverCol > xtensionCol) --extverCol; + if(uriCol > xtensionCol) --uriCol; + if(locationCol > xtensionCol) --locationCol; + } + if(extnameCol != 0) + { + *status = fits_delete_col(gfptr,extnameCol,status); + --tfields; + if(extverCol > extnameCol) --extverCol; + if(uriCol > extnameCol) --uriCol; + if(locationCol > extnameCol) --locationCol; + } + if(extverCol != 0) + { + *status = fits_delete_col(gfptr,extverCol,status); + --tfields; + if(uriCol > extverCol) --uriCol; + if(locationCol > extverCol) --locationCol; + } + if(uriCol != 0) + { + *status = fits_delete_col(gfptr,uriCol,status); + --tfields; + if(locationCol > uriCol) --locationCol; + } + if(locationCol != 0) + { + *status = fits_delete_col(gfptr,locationCol,status); + --tfields; + } + + break; + + case GT_ID_ALL: + + if(uriCol != 0) + { + *status = fits_delete_col(gfptr,uriCol,status); + --tfields; + if(locationCol > uriCol) --locationCol; + } + if(locationCol != 0) + { + *status = fits_delete_col(gfptr,locationCol,status); + --tfields; + } + + break; + + case GT_ID_REF_URI: + + if(positionCol != 0) + { + *status = fits_delete_col(gfptr,positionCol,status); + --tfields; + } + + break; + + case GT_ID_POS_URI: + + if(xtensionCol != 0) + { + *status = fits_delete_col(gfptr,xtensionCol,status); + --tfields; + if(extnameCol > xtensionCol) --extnameCol; + if(extverCol > xtensionCol) --extverCol; + } + if(extnameCol != 0) + { + *status = fits_delete_col(gfptr,extnameCol,status); + --tfields; + if(extverCol > extnameCol) --extverCol; + } + if(extverCol != 0) + { + *status = fits_delete_col(gfptr,extverCol,status); + --tfields; + } + + break; + + default: + + *status = BAD_OPTION; + ffpmsg("Invalid value for grouptype parameter specified (ffgtch)"); + break; + + } + + /* + add all the new grouping table columns that were not there + previously but are called for by the grouptype parameter + */ + + for(i = 0; i < ncols && *status == 0; ++i) + *status = fits_insert_col(gfptr,tfields+i+1,ttype[i],tform[i],status); + + /* + add the TNULL keywords and values for each new integer column defined; + integer null values are zero (0) for the MEMBER_POSITION and + MEMBER_VERSION columns. Insert a null ("/0") into each new string + column defined: MEMBER_XTENSION, MEMBER_NAME, MEMBER_URI_TYPE and + MEMBER_LOCATION. Note that by convention a null string is the + TNULL value for character fields so no TNULL is required. + */ + + for(i = 0; i < ncols && *status == 0; ++i) + { + if(strcasecmp(ttype[i],"MEMBER_POSITION") == 0 || + strcasecmp(ttype[i],"MEMBER_VERSION") == 0) + { + /* col contains int data; set TNULL and insert 0 for each col */ + + *status = fits_get_colnum(gfptr,CASESEN,ttype[i],&colnum, + status); + + sprintf(keyword,"TFORM%d",colnum); + + *status = fits_read_key_str(gfptr,keyword,keyvalue,comment, + status); + + sprintf(keyword,"TNULL%d",colnum); + + *status = fits_insert_key_lng(gfptr,keyword,0, + "Column Null Value",status); + + for(j = 1; j <= nrows && *status == 0; ++j) + *status = fits_write_col_lng(gfptr,colnum,j,1,1,&intNull, + status); + } + else if(strcasecmp(ttype[i],"MEMBER_XTENSION") == 0 || + strcasecmp(ttype[i],"MEMBER_NAME") == 0 || + strcasecmp(ttype[i],"MEMBER_URI_TYPE") == 0 || + strcasecmp(ttype[i],"MEMBER_LOCATION") == 0) + { + + /* new col contains character data; insert NULLs into each col */ + + *status = fits_get_colnum(gfptr,CASESEN,ttype[i],&colnum, + status); + + for(j = 1; j <= nrows && *status == 0; ++j) + /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/ + *status = fits_write_col_byt(gfptr,colnum,j,1,1,charNull, + status); + } + } + + }while(0); + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtrm(fitsfile *gfptr, /* FITS file pointer to group */ + int rmopt, /* code specifying if member + elements are to be deleted: + OPT_RM_GPT ==> remove only group table + OPT_RM_ALL ==> recursively remove members + and their members (if groups) */ + int *status) /* return status code */ + +/* + remove a grouping table, and optionally all its members. Any groups + containing the grouping table are updated, and all members (if not + deleted) have their GRPIDn and GRPLCn keywords updated accordingly. + If the (deleted) members are members of another grouping table then those + tables are also updated. The CHDU of the FITS file pointed to by gfptr must + be positioned to the grouping table to be deleted. +*/ + +{ + int hdutype; + + long i; + long nmembers = 0; + + HDUtracker HDU; + + + if(*status != 0) return(*status); + + /* + remove the grouping table depending upon the rmopt parameter + */ + + switch(rmopt) + { + + case OPT_RM_GPT: + + /* + for this option, the grouping table is deleted, but the member + HDUs remain; in this case we only have to remove each member from + the grouping table by calling fits_remove_member() with the + OPT_RM_ENTRY option + */ + + /* get the number of members contained by this table */ + + *status = fits_get_num_members(gfptr,&nmembers,status); + + /* loop over all grouping table members and remove them */ + + for(i = nmembers; i > 0 && *status == 0; --i) + *status = fits_remove_member(gfptr,i,OPT_RM_ENTRY,status); + + break; + + case OPT_RM_ALL: + + /* + for this option the entire Group is deleted -- this includes all + members and their members (if grouping tables themselves). Call + the recursive form of this function to perform the removal. + */ + + /* add the current grouping table to the HDUtracker struct */ + + HDU.nHDU = 0; + + *status = fftsad(gfptr,&HDU,NULL,NULL); + + /* call the recursive group remove function */ + + *status = ffgtrmr(gfptr,&HDU,status); + + /* free the memory allocated to the HDUtracker struct */ + + for(i = 0; i < HDU.nHDU; ++i) + { + free(HDU.filename[i]); + free(HDU.newFilename[i]); + } + + break; + + default: + + *status = BAD_OPTION; + ffpmsg("Invalid value for the rmopt parameter specified (ffgtrm)"); + break; + + } + + /* + if all went well then unlink and delete the grouping table HDU + */ + + *status = ffgmul(gfptr,0,status); + + *status = fits_delete_hdu(gfptr,&hdutype,status); + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtcp(fitsfile *infptr, /* input FITS file pointer */ + fitsfile *outfptr, /* output FITS file pointer */ + int cpopt, /* code specifying copy options: + OPT_GCP_GPT (0) ==> copy only grouping table + OPT_GCP_ALL (2) ==> recusrively copy members + and their members (if + groups) */ + int *status) /* return status code */ + +/* + copy a grouping table, and optionally all its members, to a new FITS file. + If the cpopt is set to OPT_GCP_GPT (copy grouping table only) then the + existing members have their GRPIDn and GRPLCn keywords updated to reflect + the existance of the new group, since they now belong to another group. If + cpopt is set to OPT_GCP_ALL (copy grouping table and members recursively) + then the original members are not updated; the new grouping table is + modified to include only the copied member HDUs and not the original members. + + Note that the recursive version of this function, ffgtcpr(), is called + to perform the group table copy. In the case of cpopt == OPT_GCP_GPT + ffgtcpr() does not actually use recursion. +*/ + +{ + int i; + + HDUtracker HDU; + + + if(*status != 0) return(*status); + + /* make sure infptr and outfptr are not the same pointer */ + + if(infptr == outfptr) *status = IDENTICAL_POINTERS; + else + { + + /* initialize the HDUtracker struct */ + + HDU.nHDU = 0; + + *status = fftsad(infptr,&HDU,NULL,NULL); + + /* + call the recursive form of this function to copy the grouping table. + If the cpopt is OPT_GCP_GPT then there is actually no recursion + performed + */ + + *status = ffgtcpr(infptr,outfptr,cpopt,&HDU,status); + + /* free memory allocated for the HDUtracker struct */ + + for(i = 0; i < HDU.nHDU; ++i) + { + free(HDU.filename[i]); + free(HDU.newFilename[i]); + } + } + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtmg(fitsfile *infptr, /* FITS file ptr to source grouping table */ + fitsfile *outfptr, /* FITS file ptr to target grouping table */ + int mgopt, /* code specifying merge options: + OPT_MRG_COPY (0) ==> copy members to target + group, leaving source + group in place + OPT_MRG_MOV (1) ==> move members to target + group, source group is + deleted after merge */ + int *status) /* return status code */ + + +/* + merge two grouping tables by combining their members into a single table. + The source grouping table must be the CHDU of the fitsfile pointed to by + infptr, and the target grouping table must be the CHDU of the fitsfile to by + outfptr. All members of the source grouping table shall be copied to the + target grouping table. If the mgopt parameter is OPT_MRG_COPY then the source + grouping table continues to exist after the merge. If the mgopt parameter + is OPT_MRG_MOV then the source grouping table is deleted after the merge, + and all member HDUs are updated accordingly. +*/ +{ + long i ; + long nmembers = 0; + + fitsfile *tmpfptr = NULL; + + + if(*status != 0) return(*status); + + do + { + + *status = fits_get_num_members(infptr,&nmembers,status); + + for(i = 1; i <= nmembers && *status == 0; ++i) + { + *status = fits_open_member(infptr,i,&tmpfptr,status); + *status = fits_add_group_member(outfptr,tmpfptr,0,status); + + if(*status == HDU_ALREADY_MEMBER) *status = 0; + + if(tmpfptr != NULL) + { + fits_close_file(tmpfptr,status); + tmpfptr = NULL; + } + } + + if(*status != 0) continue; + + if(mgopt == OPT_MRG_MOV) + *status = fits_remove_group(infptr,OPT_RM_GPT,status); + + }while(0); + + if(tmpfptr != NULL) + { + fits_close_file(tmpfptr,status); + } + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtcm(fitsfile *gfptr, /* FITS file pointer to grouping table */ + int cmopt, /* code specifying compact options + OPT_CMT_MBR (1) ==> compact only direct + members (if groups) + OPT_CMT_MBR_DEL (11) ==> (1) + delete all + compacted groups */ + int *status) /* return status code */ + +/* + "Compact" a group pointed to by the FITS file pointer gfptr. This + is achieved by flattening the tree structure of a group and its + (grouping table) members. All members HDUs of a grouping table which is + itself a member of the grouping table gfptr are added to gfptr. Optionally, + the grouping tables which are "compacted" are deleted. If the grouping + table contains no members that are themselves grouping tables then this + function performs a NOOP. +*/ + +{ + long i; + long nmembers = 0; + + char keyvalue[FLEN_VALUE]; + char comment[FLEN_COMMENT]; + + fitsfile *mfptr = NULL; + + + if(*status != 0) return(*status); + + do + { + if(cmopt != OPT_CMT_MBR && cmopt != OPT_CMT_MBR_DEL) + { + *status = BAD_OPTION; + ffpmsg("Invalid value for cmopt parameter specified (ffgtcm)"); + continue; + } + + /* reteive the number of grouping table members */ + + *status = fits_get_num_members(gfptr,&nmembers,status); + + /* + loop over all the grouping table members; if the member is a + grouping table then merge its members with the parent grouping + table + */ + + for(i = 1; i <= nmembers && *status == 0; ++i) + { + *status = fits_open_member(gfptr,i,&mfptr,status); + + if(*status != 0) continue; + + *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,comment,status); + + /* if no EXTNAME keyword then cannot be a grouping table */ + + if(*status == KEY_NO_EXIST) + { + *status = 0; + continue; + } + prepare_keyvalue(keyvalue); + + if(*status != 0) continue; + + /* if EXTNAME == "GROUPING" then process member as grouping table */ + + if(strcasecmp(keyvalue,"GROUPING") == 0) + { + /* merge the member (grouping table) into the grouping table */ + + *status = fits_merge_groups(mfptr,gfptr,OPT_MRG_COPY,status); + + *status = fits_close_file(mfptr,status); + mfptr = NULL; + + /* + remove the member from the grouping table now that all of + its members have been transferred; if cmopt is set to + OPT_CMT_MBR_DEL then remove and delete the member + */ + + if(cmopt == OPT_CMT_MBR) + *status = fits_remove_member(gfptr,i,OPT_RM_ENTRY,status); + else + *status = fits_remove_member(gfptr,i,OPT_RM_MBR,status); + } + else + { + /* not a grouping table; just close the opened member */ + + *status = fits_close_file(mfptr,status); + mfptr = NULL; + } + } + + }while(0); + + return(*status); +} + +/*--------------------------------------------------------------------------*/ +int ffgtvf(fitsfile *gfptr, /* FITS file pointer to group */ + long *firstfailed, /* Member ID (if positive) of first failed + member HDU verify check or GRPID index + (if negitive) of first failed group + link verify check. */ + int *status) /* return status code */ + +/* + check the integrity of a grouping table to make sure that all group members + are accessible and all the links to other grouping tables are valid. The + firstfailed parameter returns the member ID of the first member HDU to fail + verification if positive or the first group link to fail if negative; + otherwise firstfailed contains a return value of 0. +*/ + +{ + long i; + long nmembers = 0; + long ngroups = 0; + + char errstr[FLEN_VALUE]; + + fitsfile *fptr = NULL; + + + if(*status != 0) return(*status); + + *firstfailed = 0; + + do + { + /* + attempt to open all the members of the grouping table. We stop + at the first member which cannot be opened (which implies that it + cannot be located) + */ + + *status = fits_get_num_members(gfptr,&nmembers,status); + + for(i = 1; i <= nmembers && *status == 0; ++i) + { + *status = fits_open_member(gfptr,i,&fptr,status); + fits_close_file(fptr,status); + } + + /* + if the status is non-zero from the above loop then record the + member index that caused the error + */ + + if(*status != 0) + { + *firstfailed = i; + sprintf(errstr,"Group table verify failed for member %ld (ffgtvf)", + i); + ffpmsg(errstr); + continue; + } + + /* + attempt to open all the groups linked to this grouping table. We stop + at the first group which cannot be opened (which implies that it + cannot be located) + */ + + *status = fits_get_num_groups(gfptr,&ngroups,status); + + for(i = 1; i <= ngroups && *status == 0; ++i) + { + *status = fits_open_group(gfptr,i,&fptr,status); + fits_close_file(fptr,status); + } + + /* + if the status from the above loop is non-zero, then record the + GRPIDn index of the group that caused the failure + */ + + if(*status != 0) + { + *firstfailed = -1*i; + sprintf(errstr, + "Group table verify failed for GRPID index %ld (ffgtvf)",i); + ffpmsg(errstr); + continue; + } + + }while(0); + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtop(fitsfile *mfptr, /* FITS file pointer to the member HDU */ + int grpid, /* group ID (GRPIDn index) within member HDU */ + fitsfile **gfptr, /* FITS file pointer to grouping table HDU */ + int *status) /* return status code */ + +/* + open the grouping table that contains the member HDU. The member HDU must + be the CHDU of the FITS file pointed to by mfptr, and the grouping table + is identified by the Nth index number of the GRPIDn keywords specified in + the member HDU's header. The fitsfile gfptr pointer is positioned with the + appropriate FITS file with the grouping table as the CHDU. If the group + grouping table resides in a file other than the member then an attempt + is first made to open the file readwrite, and failing that readonly. + + Note that it is possible for the GRPIDn/GRPLCn keywords in a member + header to be non-continuous, e.g., GRPID1, GRPID2, GRPID5, GRPID6. In + such cases, the grpid index value specified in the function call shall + identify the (grpid)th GRPID value. In the above example, if grpid == 3, + then the group specified by GRPID5 would be opened. +*/ +{ + int i; + int found; + + long ngroups = 0; + long grpExtver = 0; + + char keyword[FLEN_KEYWORD]; + char keyvalue[FLEN_FILENAME]; + char *tkeyvalue; + char location[FLEN_FILENAME]; + char location1[FLEN_FILENAME]; + char location2[FLEN_FILENAME]; + char comment[FLEN_COMMENT]; + + char *url[2]; + + + if(*status != 0) return(*status); + + do + { + /* set the grouping table pointer to NULL for error checking later */ + + *gfptr = NULL; + + /* + make sure that the group ID requested is valid ==> cannot be + larger than the number of GRPIDn keywords in the member HDU header + */ + + *status = fits_get_num_groups(mfptr,&ngroups,status); + + if(grpid > ngroups) + { + *status = BAD_GROUP_ID; + sprintf(comment, + "GRPID index %d larger total GRPID keywords %ld (ffgtop)", + grpid,ngroups); + ffpmsg(comment); + continue; + } + + /* + find the (grpid)th group that the member HDU belongs to and read + the value of the GRPID(grpid) keyword; fits_get_num_groups() + automatically re-enumerates the GRPIDn/GRPLCn keywords to fill in + any gaps + */ + + sprintf(keyword,"GRPID%d",grpid); + + *status = fits_read_key_lng(mfptr,keyword,&grpExtver,comment,status); + + if(*status != 0) continue; + + /* + if the value of the GRPIDn keyword is positive then the member is + in the same FITS file as the grouping table and we only have to + reopen the current FITS file. Else the member and grouping table + HDUs reside in different files and another FITS file must be opened + as specified by the corresponding GRPLCn keyword + + The DO WHILE loop only executes once and is used to control the + file opening logic. + */ + + do + { + if(grpExtver > 0) + { + /* + the member resides in the same file as the grouping + table, so just reopen the grouping table file + */ + + *status = fits_reopen_file(mfptr,gfptr,status); + continue; + } + + else if(grpExtver == 0) + { + /* a GRPIDn value of zero (0) is undefined */ + + *status = BAD_GROUP_ID; + sprintf(comment,"Invalid value of %ld for GRPID%d (ffgtop)", + grpExtver,grpid); + ffpmsg(comment); + continue; + } + + /* + The GRPLCn keyword value is negative, which implies that + the grouping table must reside in another FITS file; + search for the corresponding GRPLCn keyword + */ + + /* set the grpExtver value positive */ + + grpExtver = -1*grpExtver; + + /* read the GRPLCn keyword value */ + + sprintf(keyword,"GRPLC%d",grpid); + /* SPR 1738 */ + *status = fits_read_key_longstr(mfptr,keyword,&tkeyvalue,comment, + status); + if (0 == *status) { + strcpy(keyvalue,tkeyvalue); + free(tkeyvalue); + } + + + /* if the GRPLCn keyword was not found then there is a problem */ + + if(*status == KEY_NO_EXIST) + { + *status = BAD_GROUP_ID; + + sprintf(comment,"Cannot find GRPLC%d keyword (ffgtop)", + grpid); + ffpmsg(comment); + + continue; + } + + prepare_keyvalue(keyvalue); + + /* + if the GRPLCn keyword value specifies an absolute URL then + try to open the file; we cannot attempt any relative URL + or host-dependent file path reconstruction + */ + + if(fits_is_url_absolute(keyvalue)) + { + ffpmsg("Try to open group table file as absolute URL (ffgtop)"); + + *status = fits_open_file(gfptr,keyvalue,READWRITE,status); + + /* if the open was successful then continue */ + + if(*status == 0) continue; + + /* if READWRITE failed then try opening it READONLY */ + + ffpmsg("OK, try open group table file as READONLY (ffgtop)"); + + *status = 0; + *status = fits_open_file(gfptr,keyvalue,READONLY,status); + + /* continue regardless of the outcome */ + + continue; + } + + /* + see if the URL gives a file path that is absolute on the + host machine + */ + + *status = fits_url2path(keyvalue,location1,status); + + *status = fits_open_file(gfptr,location1,READWRITE,status); + + /* if the file opened then continue */ + + if(*status == 0) continue; + + /* if READWRITE failed then try opening it READONLY */ + + ffpmsg("OK, try open group table file as READONLY (ffgtop)"); + + *status = 0; + *status = fits_open_file(gfptr,location1,READONLY,status); + + /* if the file opened then continue */ + + if(*status == 0) continue; + + /* + the grouping table location given by GRPLCn must specify a + relative URL. We assume that this URL is relative to the + member HDU's FITS file. Try to construct a full URL location + for the grouping table's FITS file and then open it + */ + + *status = 0; + + /* retrieve the URL information for the member HDU's file */ + + url[0] = location1; url[1] = location2; + + *status = fits_get_url(mfptr,url[0],url[1],NULL,NULL,NULL,status); + + /* + It is possible that the member HDU file has an initial + URL it was opened with and a real URL that the file actually + exists at (e.g., an HTTP accessed file copied to a local + file). For each possible URL try to construct a + */ + + for(i = 0, found = 0, *gfptr = NULL; i < 2 && !found; ++i) + { + + /* the url string could be empty */ + + if(*url[i] == 0) continue; + + /* + create a full URL from the partial and the member + HDU file URL + */ + + *status = fits_relurl2url(url[i],keyvalue,location,status); + + /* if an error occured then contniue */ + + if(*status != 0) + { + *status = 0; + continue; + } + + /* + if the location does not specify an access method + then turn it into a host dependent path + */ + + if(! fits_is_url_absolute(location)) + { + *status = fits_url2path(location,url[i],status); + strcpy(location,url[i]); + } + + /* try to open the grouping table file READWRITE */ + + *status = fits_open_file(gfptr,location,READWRITE,status); + + if(*status != 0) + { + /* try to open the grouping table file READONLY */ + + ffpmsg("opening file as READWRITE failed (ffgtop)"); + ffpmsg("OK, try to open file as READONLY (ffgtop)"); + *status = 0; + *status = fits_open_file(gfptr,location,READONLY,status); + } + + /* either set the found flag or reset the status flag */ + + if(*status == 0) + found = 1; + else + *status = 0; + } + + }while(0); /* end of file opening loop */ + + /* if an error occured with the file opening then exit */ + + if(*status != 0) continue; + + if(*gfptr == NULL) + { + ffpmsg("Cannot open or find grouping table FITS file (ffgtop)"); + *status = GROUP_NOT_FOUND; + continue; + } + + /* search for the grouping table in its FITS file */ + + *status = fits_movnam_hdu(*gfptr,ANY_HDU,"GROUPING",(int)grpExtver, + status); + + if(*status != 0) *status = GROUP_NOT_FOUND; + + }while(0); + + if(*status != 0 && *gfptr != NULL) + { + fits_close_file(*gfptr,status); + *gfptr = NULL; + } + + return(*status); +} +/*---------------------------------------------------------------------------*/ +int ffgtam(fitsfile *gfptr, /* FITS file pointer to grouping table HDU */ + fitsfile *mfptr, /* FITS file pointer to member HDU */ + int hdupos, /* member HDU position IF in the same file as + the grouping table AND mfptr == NULL */ + int *status) /* return status code */ + +/* + add a member HDU to an existing grouping table. The fitsfile pointer gfptr + must be positioned with the grouping table as the CHDU. The member HDU + may either be identifed with the fitsfile *mfptr (which must be positioned + to the member HDU) or the hdupos parameter (the HDU number of the member + HDU) if both reside in the same FITS file. The hdupos value is only used + if the mfptr parameter has a value of NULL (0). The new member HDU shall + have the appropriate GRPIDn and GRPLCn keywords created in its header. + + Note that if the member HDU to be added to the grouping table is already + a member of the group then it will not be added a sceond time. +*/ + +{ + int xtensionCol,extnameCol,extverCol,positionCol,locationCol,uriCol; + int memberPosition = 0; + int grptype = 0; + int hdutype = 0; + int useLocation = 0; + int nkeys = 6; + int found; + int i; + + int memberIOstate; + int groupIOstate; + int iomode; + + long memberExtver = 0; + long groupExtver = 0; + long memberID = 0; + long nmembers = 0; + long ngroups = 0; + long grpid = 0; + + char memberAccess1[FLEN_VALUE]; + char memberAccess2[FLEN_VALUE]; + char memberFileName[FLEN_FILENAME]; + char memberLocation[FLEN_FILENAME]; + char grplc[FLEN_FILENAME]; + char *tgrplc; + char memberHDUtype[FLEN_VALUE]; + char memberExtname[FLEN_VALUE]; + char memberURI[] = "URL"; + + char groupAccess1[FLEN_VALUE]; + char groupAccess2[FLEN_VALUE]; + char groupFileName[FLEN_FILENAME]; + char groupLocation[FLEN_FILENAME]; + + char cwd[FLEN_FILENAME]; + + char *keys[] = {"GRPNAME","EXTVER","EXTNAME","TFIELDS","GCOUNT","EXTEND"}; + char *tmpPtr[1]; + + char keyword[FLEN_KEYWORD]; + char card[FLEN_CARD]; + + unsigned char charNull[] = {'\0'}; + + fitsfile *tmpfptr = NULL; + + int parentStatus = 0; + + if(*status != 0) return(*status); + + do + { + /* + make sure the grouping table can be modified before proceeding + */ + + fits_file_mode(gfptr,&iomode,status); + + if(iomode != READWRITE) + { + ffpmsg("cannot modify grouping table (ffgtam)"); + *status = BAD_GROUP_ATTACH; + continue; + } + + /* + if the calling function supplied the HDU position of the member + HDU instead of fitsfile pointer then get a fitsfile pointer + */ + + if(mfptr == NULL) + { + *status = fits_reopen_file(gfptr,&tmpfptr,status); + *status = fits_movabs_hdu(tmpfptr,hdupos,&hdutype,status); + + if(*status != 0) continue; + } + else + tmpfptr = mfptr; + + /* + determine all the information about the member HDU that will + be needed later; note that we establish the default values for + all information values that are not explicitly found + */ + + *status = fits_read_key_str(tmpfptr,"XTENSION",memberHDUtype,card, + status); + + if(*status == KEY_NO_EXIST) + { + strcpy(memberHDUtype,"PRIMARY"); + *status = 0; + } + prepare_keyvalue(memberHDUtype); + + *status = fits_read_key_lng(tmpfptr,"EXTVER",&memberExtver,card,status); + + if(*status == KEY_NO_EXIST) + { + memberExtver = 1; + *status = 0; + } + + *status = fits_read_key_str(tmpfptr,"EXTNAME",memberExtname,card, + status); + + if(*status == KEY_NO_EXIST) + { + memberExtname[0] = 0; + *status = 0; + } + prepare_keyvalue(memberExtname); + + fits_get_hdu_num(tmpfptr,&memberPosition); + + /* + Determine if the member HDU's FITS file location needs to be + taken into account when building its grouping table reference + + If the member location needs to be used (==> grouping table and member + HDU reside in different files) then create an appropriate URL for + the member HDU's file and grouping table's file. Note that the logic + for this is rather complicated + */ + + /* SPR 3463, don't do this + if(tmpfptr->Fptr == gfptr->Fptr) + { */ + /* + member HDU and grouping table reside in the same file, no need + to use the location information */ + + /* printf ("same file\n"); + + useLocation = 0; + memberIOstate = 1; + *memberFileName = 0; + } + else + { */ + /* + the member HDU and grouping table FITS file location information + must be used. + + First determine the correct driver and file name for the group + table and member HDU files. If either are disk files then + construct an absolute file path for them. Finally, if both are + disk files construct relative file paths from the group(member) + file to the member(group) file. + + */ + + /* set the USELOCATION flag to true */ + + useLocation = 1; + + /* + get the location, access type and iostate (RO, RW) of the + member HDU file + */ + + *status = fits_get_url(tmpfptr,memberFileName,memberLocation, + memberAccess1,memberAccess2,&memberIOstate, + status); + + /* + if the memberFileName string is empty then use the values of + the memberLocation string. This corresponds to a file where + the "real" file is a temporary memory file, and we must assume + the the application really wants the original file to be the + group member + */ + + if(strlen(memberFileName) == 0) + { + strcpy(memberFileName,memberLocation); + strcpy(memberAccess1,memberAccess2); + } + + /* + get the location, access type and iostate (RO, RW) of the + grouping table file + */ + + *status = fits_get_url(gfptr,groupFileName,groupLocation, + groupAccess1,groupAccess2,&groupIOstate, + status); + + if(*status != 0) continue; + + /* + the grouping table file must be writable to continue + */ + + if(groupIOstate == 0) + { + ffpmsg("cannot modify grouping table (ffgtam)"); + *status = BAD_GROUP_ATTACH; + continue; + } + + /* + determine how to construct the resulting URLs for the member and + group files + */ + + if(strcasecmp(groupAccess1,"file://") && + strcasecmp(memberAccess1,"file://")) + { + *cwd = 0; + /* + nothing to do in this case; both the member and group files + must be of an access type that already gives valid URLs; + i.e., URLs that we can pass directly to the file drivers + */ + } + else + { + /* + retrieve the Current Working Directory as a Unix-like + URL standard string + */ + + *status = fits_get_cwd(cwd,status); + + /* + create full file path for the member HDU FITS file URL + if it is of access type file:// + */ + + if(strcasecmp(memberAccess1,"file://") == 0) + { + if(*memberFileName == '/') + { + strcpy(memberLocation,memberFileName); + } + else + { + strcpy(memberLocation,cwd); + strcat(memberLocation,"/"); + strcat(memberLocation,memberFileName); + } + + *status = fits_clean_url(memberLocation,memberFileName, + status); + } + + /* + create full file path for the grouping table HDU FITS file URL + if it is of access type file:// + */ + + if(strcasecmp(groupAccess1,"file://") == 0) + { + if(*groupFileName == '/') + { + strcpy(groupLocation,groupFileName); + } + else + { + strcpy(groupLocation,cwd); + strcat(groupLocation,"/"); + strcat(groupLocation,groupFileName); + } + + *status = fits_clean_url(groupLocation,groupFileName,status); + } + + /* + if both the member and group files are disk files then + create a relative path (relative URL) strings with + respect to the grouping table's file and the grouping table's + file with respect to the member HDU's file + */ + + if(strcasecmp(groupAccess1,"file://") == 0 && + strcasecmp(memberAccess1,"file://") == 0) + { + fits_url2relurl(memberFileName,groupFileName, + groupLocation,status); + fits_url2relurl(groupFileName,memberFileName, + memberLocation,status); + + /* + copy the resulting partial URL strings to the + memberFileName and groupFileName variables for latter + use in the function + */ + + strcpy(memberFileName,memberLocation); + strcpy(groupFileName,groupLocation); + } + } + /* beo done */ + /* } */ + + + /* retrieve the grouping table's EXTVER value */ + + *status = fits_read_key_lng(gfptr,"EXTVER",&groupExtver,card,status); + + /* + if useLocation is true then make the group EXTVER value negative + for the subsequent GRPIDn/GRPLCn matching + */ + /* SPR 3463 change test */ + if(tmpfptr->Fptr != gfptr->Fptr) groupExtver = -1*groupExtver; + + /* retrieve the number of group members */ + + *status = fits_get_num_members(gfptr,&nmembers,status); + + do { + + /* + make sure the member HDU is not already an entry in the + grouping table before adding it + */ + + *status = ffgmf(gfptr,memberHDUtype,memberExtname,memberExtver, + memberPosition,memberFileName,&memberID,status); + + if(*status == MEMBER_NOT_FOUND) *status = 0; + else if(*status == 0) + { + parentStatus = HDU_ALREADY_MEMBER; + ffpmsg("Specified HDU is already a member of the Grouping table (ffgtam)"); + continue; + } + else continue; + + /* + if the member HDU is not already recorded in the grouping table + then add it + */ + + /* add a new row to the grouping table */ + + *status = fits_insert_rows(gfptr,nmembers,1,status); + ++nmembers; + + /* retrieve the grouping table column IDs and structure type */ + + *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol, + &locationCol,&uriCol,&grptype,status); + + /* fill in the member HDU data in the new grouping table row */ + + *tmpPtr = memberHDUtype; + + if(xtensionCol != 0) + fits_write_col_str(gfptr,xtensionCol,nmembers,1,1,tmpPtr,status); + + *tmpPtr = memberExtname; + + if(extnameCol != 0) + { + if(strlen(memberExtname) != 0) + fits_write_col_str(gfptr,extnameCol,nmembers,1,1,tmpPtr,status); + else + /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/ + fits_write_col_byt(gfptr,extnameCol,nmembers,1,1,charNull,status); + } + + if(extverCol != 0) + fits_write_col_lng(gfptr,extverCol,nmembers,1,1,&memberExtver, + status); + + if(positionCol != 0) + fits_write_col_int(gfptr,positionCol,nmembers,1,1, + &memberPosition,status); + + *tmpPtr = memberFileName; + + if(locationCol != 0) + { + /* Change the test for SPR 3463 */ + if(tmpfptr->Fptr != gfptr->Fptr) + fits_write_col_str(gfptr,locationCol,nmembers,1,1,tmpPtr,status); + else + /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/ + fits_write_col_byt(gfptr,locationCol,nmembers,1,1,charNull,status); + } + + *tmpPtr = memberURI; + + if(uriCol != 0) + { + + /* Change the test for SPR 3463 */ + + if(tmpfptr->Fptr != gfptr->Fptr) + fits_write_col_str(gfptr,uriCol,nmembers,1,1,tmpPtr,status); + else + /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/ + fits_write_col_byt(gfptr,uriCol,nmembers,1,1,charNull,status); + } + } while(0); + + if(0 != *status) continue; + /* + add GRPIDn/GRPLCn keywords to the member HDU header to link + it to the grouing table if the they do not already exist and + the member file is RW + */ + + fits_file_mode(tmpfptr,&iomode,status); + + if(memberIOstate == 0 || iomode != READWRITE) + { + ffpmsg("cannot add GRPID/LC keywords to member HDU: (ffgtam)"); + ffpmsg(memberFileName); + continue; + } + + *status = fits_get_num_groups(tmpfptr,&ngroups,status); + + /* + look for the GRPID/LC keywords in the member HDU; if the keywords + for the back-link to the grouping table already exist then no + need to add them again + */ + + for(i = 1, found = 0; i <= ngroups && !found && *status == 0; ++i) + { + sprintf(keyword,"GRPID%d",(int)ngroups); + *status = fits_read_key_lng(tmpfptr,keyword,&grpid,card,status); + + if(grpid == groupExtver) + { + if(grpid < 0) + { + + /* have to make sure the GRPLCn keyword matches too */ + + sprintf(keyword,"GRPLC%d",(int)ngroups); + /* SPR 1738 */ + *status = fits_read_key_longstr(mfptr,keyword,&tgrplc,card, + status); + if (0 == *status) { + strcpy(grplc,tgrplc); + free(tgrplc); + } + + /* + always compare files using absolute paths + the presence of a non-empty cwd indicates + that the file names may require conversion + to absolute paths + */ + + if(0 < strlen(cwd)) { + /* temp buffer for use in assembling abs. path(s) */ + char tmp[FLEN_FILENAME]; + + /* make grplc absolute if necessary */ + if(!fits_is_url_absolute(grplc)) { + fits_path2url(grplc,groupLocation,status); + + if(groupLocation[0] != '/') + { + strcpy(tmp, cwd); + strcat(tmp,"/"); + strcat(tmp,groupLocation); + fits_clean_url(tmp,grplc,status); + } + } + + /* make groupFileName absolute if necessary */ + if(!fits_is_url_absolute(groupFileName)) { + fits_path2url(groupFileName,groupLocation,status); + + if(groupLocation[0] != '/') + { + strcpy(tmp, cwd); + strcat(tmp,"/"); + strcat(tmp,groupLocation); + /* + note: use groupLocation (which is not used + below this block), to store the absolute + file name instead of using groupFileName. + The latter may be needed unaltered if the + GRPLC is written below + */ + + fits_clean_url(tmp,groupLocation,status); + } + } + } + /* + see if the grplc value and the group file name match + */ + + if(strcmp(grplc,groupLocation) == 0) found = 1; + } + else + { + /* the match is found with GRPIDn alone */ + found = 1; + } + } + } + + /* + if FOUND is true then no need to continue + */ + + if(found) + { + ffpmsg("HDU already has GRPID/LC keywords for group table (ffgtam)"); + continue; + } + + /* + add the GRPID/LC keywords to the member header for this grouping + table + + If NGROUPS == 0 then we must position the header pointer to the + record where we want to insert the GRPID/LC keywords (the pointer + is already correctly positioned if the above search loop activiated) + */ + + if(ngroups == 0) + { + /* + no GRPIDn/GRPLCn keywords currently exist in header so try + to position the header pointer to a desirable position + */ + + for(i = 0, *status = KEY_NO_EXIST; + i < nkeys && *status == KEY_NO_EXIST; ++i) + { + *status = 0; + *status = fits_read_card(tmpfptr,keys[i],card,status); + } + + /* all else fails: move write pointer to end of header */ + + if(*status == KEY_NO_EXIST) + { + *status = 0; + fits_get_hdrspace(tmpfptr,&nkeys,&i,status); + ffgrec(tmpfptr,nkeys,card,status); + } + + /* any other error status then abort */ + + if(*status != 0) continue; + } + + /* + now that the header pointer is positioned for the GRPID/LC + keyword insertion increment the number of group links counter for + the member HDU + */ + + ++ngroups; + + /* + if the member HDU and grouping table reside in the same FITS file + then there is no need to add a GRPLCn keyword + */ + /* SPR 3463 change test */ + if(tmpfptr->Fptr == gfptr->Fptr) + { + /* add the GRPIDn keyword only */ + + sprintf(keyword,"GRPID%d",(int)ngroups); + fits_insert_key_lng(tmpfptr,keyword,groupExtver, + "EXTVER of Group containing this HDU",status); + } + else + { + /* add the GRPIDn and GRPLCn keywords */ + + sprintf(keyword,"GRPID%d",(int)ngroups); + fits_insert_key_lng(tmpfptr,keyword,groupExtver, + "EXTVER of Group containing this HDU",status); + + sprintf(keyword,"GRPLC%d",(int)ngroups); + /* SPR 1738 */ + fits_insert_key_longstr(tmpfptr,keyword,groupFileName, + "URL of file containing Group",status); + fits_write_key_longwarn(tmpfptr,status); + + } + + }while(0); + + /* close the tmpfptr pointer if it was opened in this function */ + + if(mfptr == NULL) + { + *status = fits_close_file(tmpfptr,status); + } + + *status = 0 == *status ? parentStatus : *status; + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgtnm(fitsfile *gfptr, /* FITS file pointer to grouping table */ + long *nmembers, /* member count of the groping table */ + int *status) /* return status code */ + +/* + return the number of member HDUs in a grouping table. The fitsfile pointer + gfptr must be positioned with the grouping table as the CHDU. The number + of grouping table member HDUs is just the NAXIS2 value of the grouping + table. +*/ + +{ + char keyvalue[FLEN_VALUE]; + char comment[FLEN_COMMENT]; + + + if(*status != 0) return(*status); + + *status = fits_read_keyword(gfptr,"EXTNAME",keyvalue,comment,status); + + if(*status == KEY_NO_EXIST) + *status = NOT_GROUP_TABLE; + else + { + prepare_keyvalue(keyvalue); + + if(strcasecmp(keyvalue,"GROUPING") != 0) + { + *status = NOT_GROUP_TABLE; + ffpmsg("Specified HDU is not a Grouping table (ffgtnm)"); + } + + *status = fits_read_key_lng(gfptr,"NAXIS2",nmembers,comment,status); + } + + return(*status); +} + +/*--------------------------------------------------------------------------*/ +int ffgmng(fitsfile *mfptr, /* FITS file pointer to member HDU */ + long *ngroups, /* total number of groups linked to HDU */ + int *status) /* return status code */ + +/* + return the number of groups to which a HDU belongs, as defined by the number + of GRPIDn/GRPLCn keyword records that appear in the HDU header. The + fitsfile pointer mfptr must be positioned with the member HDU as the CHDU. + Each time this function is called, the indicies of the GRPIDn/GRPLCn + keywords are checked to make sure they are continuous (ie no gaps) and + are re-enumerated to eliminate gaps if gaps are found to be present. +*/ + +{ + int offset; + int index; + int newIndex; + int i; + + long grpid; + + char *inclist[] = {"GRPID#"}; + char keyword[FLEN_KEYWORD]; + char newKeyword[FLEN_KEYWORD]; + char card[FLEN_CARD]; + char comment[FLEN_COMMENT]; + char *tkeyvalue; + + if(*status != 0) return(*status); + + *ngroups = 0; + + /* reset the member HDU keyword counter to the beginning */ + + *status = ffgrec(mfptr,0,card,status); + + /* + search for the number of GRPIDn keywords in the member HDU header + and count them with the ngroups variable + */ + + while(*status == 0) + { + /* read the next GRPIDn keyword in the series */ + + *status = fits_find_nextkey(mfptr,inclist,1,NULL,0,card,status); + + if(*status != 0) continue; + + ++(*ngroups); + } + + if(*status == KEY_NO_EXIST) *status = 0; + + /* + read each GRPIDn/GRPLCn keyword and adjust their index values so that + there are no gaps in the index count + */ + + for(index = 1, offset = 0, i = 1; i <= *ngroups && *status == 0; ++index) + { + sprintf(keyword,"GRPID%d",index); + + /* try to read the next GRPIDn keyword in the series */ + + *status = fits_read_key_lng(mfptr,keyword,&grpid,card,status); + + /* if not found then increment the offset counter and continue */ + + if(*status == KEY_NO_EXIST) + { + *status = 0; + ++offset; + } + else + { + /* + increment the number_keys_found counter and see if the index + of the keyword needs to be updated + */ + + ++i; + + if(offset > 0) + { + /* compute the new index for the GRPIDn/GRPLCn keywords */ + newIndex = index - offset; + + /* update the GRPIDn keyword index */ + + sprintf(newKeyword,"GRPID%d",newIndex); + fits_modify_name(mfptr,keyword,newKeyword,status); + + /* If present, update the GRPLCn keyword index */ + + sprintf(keyword,"GRPLC%d",index); + sprintf(newKeyword,"GRPLC%d",newIndex); + /* SPR 1738 */ + *status = fits_read_key_longstr(mfptr,keyword,&tkeyvalue,comment, + status); + if (0 == *status) { + fits_delete_key(mfptr,keyword,status); + fits_insert_key_longstr(mfptr,newKeyword,tkeyvalue,comment,status); + fits_write_key_longwarn(mfptr,status); + free(tkeyvalue); + } + + + if(*status == KEY_NO_EXIST) *status = 0; + } + } + } + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgmop(fitsfile *gfptr, /* FITS file pointer to grouping table */ + long member, /* member ID (row num) within grouping table */ + fitsfile **mfptr, /* FITS file pointer to member HDU */ + int *status) /* return status code */ + +/* + open a grouping table member, returning a pointer to the member's FITS file + with the CHDU set to the member HDU. The grouping table must be the CHDU of + the FITS file pointed to by gfptr. The member to open is identified by its + row number within the grouping table (first row/member == 1). + + If the member resides in a FITS file different from the grouping + table the member file is first opened readwrite and if this fails then + it is opened readonly. For access type of FILE:// the member file is + searched for assuming (1) an absolute path is given, (2) a path relative + to the CWD is given, and (3) a path relative to the grouping table file + but not relative to the CWD is given. If all of these fail then the + error FILE_NOT_FOUND is returned. +*/ + +{ + int xtensionCol,extnameCol,extverCol,positionCol,locationCol,uriCol; + int grptype,hdutype; + int dummy; + + long hdupos = 0; + long extver = 0; + + char xtension[FLEN_VALUE]; + char extname[FLEN_VALUE]; + char uri[FLEN_VALUE]; + char grpLocation1[FLEN_FILENAME]; + char grpLocation2[FLEN_FILENAME]; + char mbrLocation1[FLEN_FILENAME]; + char mbrLocation2[FLEN_FILENAME]; + char mbrLocation3[FLEN_FILENAME]; + char cwd[FLEN_FILENAME]; + char card[FLEN_CARD]; + char nstr[] = {'\0'}; + char *tmpPtr[1]; + + + if(*status != 0) return(*status); + + do + { + /* + retrieve the Grouping Convention reserved column positions within + the grouping table + */ + + *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol, + &locationCol,&uriCol,&grptype,status); + + if(*status != 0) continue; + + /* + extract the member information from grouping table + */ + + tmpPtr[0] = xtension; + + if(xtensionCol != 0) + { + + *status = fits_read_col_str(gfptr,xtensionCol,member,1,1,nstr, + tmpPtr,&dummy,status); + + /* convert the xtension string to a hdutype code */ + + if(strcasecmp(xtension,"PRIMARY") == 0) hdutype = IMAGE_HDU; + else if(strcasecmp(xtension,"IMAGE") == 0) hdutype = IMAGE_HDU; + else if(strcasecmp(xtension,"TABLE") == 0) hdutype = ASCII_TBL; + else if(strcasecmp(xtension,"BINTABLE") == 0) hdutype = BINARY_TBL; + else hdutype = ANY_HDU; + } + + tmpPtr[0] = extname; + + if(extnameCol != 0) + *status = fits_read_col_str(gfptr,extnameCol,member,1,1,nstr, + tmpPtr,&dummy,status); + + if(extverCol != 0) + *status = fits_read_col_lng(gfptr,extverCol,member,1,1,0, + (long*)&extver,&dummy,status); + + if(positionCol != 0) + *status = fits_read_col_lng(gfptr,positionCol,member,1,1,0, + (long*)&hdupos,&dummy,status); + + tmpPtr[0] = mbrLocation1; + + if(locationCol != 0) + *status = fits_read_col_str(gfptr,locationCol,member,1,1,nstr, + tmpPtr,&dummy,status); + tmpPtr[0] = uri; + + if(uriCol != 0) + *status = fits_read_col_str(gfptr,uriCol,member,1,1,nstr, + tmpPtr,&dummy,status); + + if(*status != 0) continue; + + /* + decide what FITS file the member HDU resides in and open the file + using the fitsfile* pointer mfptr; note that this logic is rather + complicated and is based primiarly upon if a URL specifier is given + for the member file in the grouping table + */ + + switch(grptype) + { + + case GT_ID_POS: + case GT_ID_REF: + case GT_ID_ALL: + + /* + no location information is given so we must assume that the + member HDU resides in the same FITS file as the grouping table; + if the grouping table was incorrectly constructed then this + assumption will be false, but there is nothing to be done about + it at this point + */ + + *status = fits_reopen_file(gfptr,mfptr,status); + + break; + + case GT_ID_REF_URI: + case GT_ID_POS_URI: + case GT_ID_ALL_URI: + + /* + The member location column exists. Determine if the member + resides in the same file as the grouping table or in a + separate file; open the member file in either case + */ + + if(strlen(mbrLocation1) == 0) + { + /* + since no location information was given we must assume + that the member is in the same FITS file as the grouping + table + */ + + *status = fits_reopen_file(gfptr,mfptr,status); + } + else + { + /* + make sure the location specifiation is "URL"; we cannot + decode any other URI types at this time + */ + + if(strcasecmp(uri,"URL") != 0) + { + *status = FILE_NOT_OPENED; + sprintf(card, + "Cannot open member HDU file with URI type %s (ffgmop)", + uri); + ffpmsg(card); + + continue; + } + + /* + The location string for the member is not NULL, so it + does not necessially reside in the same FITS file as the + grouping table. + + Three cases are attempted for opening the member's file + in the following order: + + 1. The URL given for the member's file is absolute (i.e., + access method supplied); try to open the member + + 2. The URL given for the member's file is not absolute but + is an absolute file path; try to open the member as a file + after the file path is converted to a host-dependent form + + 3. The URL given for the member's file is not absolute + and is given as a relative path to the location of the + grouping table's file. Create an absolute URL using the + grouping table's file URL and try to open the member. + + If all three cases fail then an error is returned. In each + case the file is first opened in read/write mode and failing + that readonly mode. + + The following DO loop is only used as a mechanism to break + (continue) when the proper file opening method is found + */ + + do + { + /* + CASE 1: + + See if the member URL is absolute (i.e., includes a + access directive) and if so open the file + */ + + if(fits_is_url_absolute(mbrLocation1)) + { + /* + the URL must specify an access method, which + implies that its an absolute reference + + regardless of the access method, pass the whole + URL to the open function for processing + */ + + ffpmsg("member URL is absolute, try open R/W (ffgmop)"); + + *status = fits_open_file(mfptr,mbrLocation1,READWRITE, + status); + + if(*status == 0) continue; + + *status = 0; + + /* + now try to open file using full URL specs in + readonly mode + */ + + ffpmsg("OK, now try to open read-only (ffgmop)"); + + *status = fits_open_file(mfptr,mbrLocation1,READONLY, + status); + + /* break from DO loop regardless of status */ + + continue; + } + + /* + CASE 2: + + If we got this far then the member URL location + has no access type ==> FILE:// Try to open the member + file using the URL as is, i.e., assume that it is given + as absolute, if it starts with a '/' character + */ + + ffpmsg("Member URL is of type FILE (ffgmop)"); + + if(*mbrLocation1 == '/') + { + ffpmsg("Member URL specifies abs file path (ffgmop)"); + + /* + convert the URL path to a host dependent path + */ + + *status = fits_url2path(mbrLocation1,mbrLocation2, + status); + + ffpmsg("Try to open member URL in R/W mode (ffgmop)"); + + *status = fits_open_file(mfptr,mbrLocation2,READWRITE, + status); + + if(*status == 0) continue; + + *status = 0; + + /* + now try to open file using the URL as an absolute + path in readonly mode + */ + + ffpmsg("OK, now try to open read-only (ffgmop)"); + + *status = fits_open_file(mfptr,mbrLocation2,READONLY, + status); + + /* break from the Do loop regardless of the status */ + + continue; + } + + /* + CASE 3: + + If we got this far then the URL does not specify an + absoulte file path or URL with access method. Since + the path to the group table's file is (obviously) valid + for the CWD, create a full location string for the + member HDU using the grouping table URL as a basis + + The only problem is that the grouping table file might + have two URLs, the original one used to open it and + the one that points to the real file being accessed + (i.e., a file accessed via HTTP but transferred to a + local disk file). Have to attempt to build a URL to + the member HDU file using both of these URLs if + defined. + */ + + ffpmsg("Try to open member file as relative URL (ffgmop)"); + + /* get the URL information for the grouping table file */ + + *status = fits_get_url(gfptr,grpLocation1,grpLocation2, + NULL,NULL,NULL,status); + + /* + if the "real" grouping table file URL is defined then + build a full url for the member HDU file using it + and try to open the member HDU file + */ + + if(*grpLocation1) + { + /* make sure the group location is absolute */ + + if(! fits_is_url_absolute(grpLocation1) && + *grpLocation1 != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,grpLocation1); + strcpy(grpLocation1,cwd); + } + + /* create a full URL for the member HDU file */ + + *status = fits_relurl2url(grpLocation1,mbrLocation1, + mbrLocation2,status); + + if(*status != 0) continue; + + /* + if the URL does not have an access method given then + translate it into a host dependent file path + */ + + if(! fits_is_url_absolute(mbrLocation2)) + { + *status = fits_url2path(mbrLocation2,mbrLocation3, + status); + strcpy(mbrLocation2,mbrLocation3); + } + + /* try to open the member file READWRITE */ + + *status = fits_open_file(mfptr,mbrLocation2,READWRITE, + status); + + if(*status == 0) continue; + + *status = 0; + + /* now try to open in readonly mode */ + + ffpmsg("now try to open file as READONLY (ffgmop)"); + + *status = fits_open_file(mfptr,mbrLocation2,READONLY, + status); + + if(*status == 0) continue; + + *status = 0; + } + + /* + if we got this far then either the "real" grouping table + file URL was not defined or all attempts to open the + resulting member HDU file URL failed. + + if the "original" grouping table file URL is defined then + build a full url for the member HDU file using it + and try to open the member HDU file + */ + + if(*grpLocation2) + { + /* make sure the group location is absolute */ + + if(! fits_is_url_absolute(grpLocation2) && + *grpLocation2 != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,grpLocation2); + strcpy(grpLocation2,cwd); + } + + /* create an absolute URL for the member HDU file */ + + *status = fits_relurl2url(grpLocation2,mbrLocation1, + mbrLocation2,status); + if(*status != 0) continue; + + /* + if the URL does not have an access method given then + translate it into a host dependent file path + */ + + if(! fits_is_url_absolute(mbrLocation2)) + { + *status = fits_url2path(mbrLocation2,mbrLocation3, + status); + strcpy(mbrLocation2,mbrLocation3); + } + + /* try to open the member file READWRITE */ + + *status = fits_open_file(mfptr,mbrLocation2,READWRITE, + status); + + if(*status == 0) continue; + + *status = 0; + + /* now try to open in readonly mode */ + + ffpmsg("now try to open file as READONLY (ffgmop)"); + + *status = fits_open_file(mfptr,mbrLocation2,READONLY, + status); + + if(*status == 0) continue; + + *status = 0; + } + + /* + if we got this far then the member HDU file could not + be opened using any method. Log the error. + */ + + ffpmsg("Cannot open member HDU FITS file (ffgmop)"); + *status = MEMBER_NOT_FOUND; + + }while(0); + } + + break; + + default: + + /* no default action */ + + break; + } + + if(*status != 0) continue; + + /* + attempt to locate the member HDU within its FITS file as determined + and opened above + */ + + switch(grptype) + { + + case GT_ID_POS: + case GT_ID_POS_URI: + + /* + try to find the member hdu in the the FITS file pointed to + by mfptr based upon its HDU posistion value. Note that is + impossible to verify if the HDU is actually the correct HDU due + to a lack of information. + */ + + *status = fits_movabs_hdu(*mfptr,(int)hdupos,&hdutype,status); + + break; + + case GT_ID_REF: + case GT_ID_REF_URI: + + /* + try to find the member hdu in the FITS file pointed to + by mfptr based upon its XTENSION, EXTNAME and EXTVER keyword + values + */ + + *status = fits_movnam_hdu(*mfptr,hdutype,extname,extver,status); + + if(*status == BAD_HDU_NUM) + { + *status = MEMBER_NOT_FOUND; + ffpmsg("Cannot find specified member HDU (ffgmop)"); + } + + /* + if the above function returned without error then the + mfptr is pointed to the member HDU + */ + + break; + + case GT_ID_ALL: + case GT_ID_ALL_URI: + + /* + if the member entry has reference information then use it + (ID by reference is safer than ID by position) else use + the position information + */ + + if(strlen(xtension) > 0 && strlen(extname) > 0 && extver > 0) + { + /* valid reference info exists so use it */ + + /* try to find the member hdu in the grouping table's file */ + + *status = fits_movnam_hdu(*mfptr,hdutype,extname,extver,status); + + if(*status == BAD_HDU_NUM) + { + *status = MEMBER_NOT_FOUND; + ffpmsg("Cannot find specified member HDU (ffgmop)"); + } + } + else + { + *status = fits_movabs_hdu(*mfptr,(int)hdupos,&hdutype, + status); + if(*status == END_OF_FILE) *status = MEMBER_NOT_FOUND; + } + + /* + if the above function returned without error then the + mfptr is pointed to the member HDU + */ + + break; + + default: + + /* no default action */ + + break; + } + + }while(0); + + if(*status != 0 && *mfptr != NULL) + { + fits_close_file(*mfptr,status); + } + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgmcp(fitsfile *gfptr, /* FITS file pointer to group */ + fitsfile *mfptr, /* FITS file pointer to new member + FITS file */ + long member, /* member ID (row num) within grouping table */ + int cpopt, /* code specifying copy options: + OPT_MCP_ADD (0) ==> add copied member to the + grouping table + OPT_MCP_NADD (1) ==> do not add member copy to + the grouping table + OPT_MCP_REPL (2) ==> replace current member + entry with member copy */ + int *status) /* return status code */ + +/* + copy a member HDU of a grouping table to a new FITS file. The grouping table + must be the CHDU of the FITS file pointed to by gfptr. The copy of the + group member shall be appended to the end of the FITS file pointed to by + mfptr. If the cpopt parameter is set to OPT_MCP_ADD then the copy of the + member is added to the grouping table as a new member, if OPT_MCP_NADD + then the copied member is not added to the grouping table, and if + OPT_MCP_REPL then the copied member is used to replace the original member. + The copied member HDU also has its EXTVER value updated so that its + combination of XTENSION, EXTNAME and EXVTER is unique within its new + FITS file. +*/ + +{ + int numkeys = 0; + int keypos = 0; + int hdunum = 0; + int hdutype = 0; + int i; + + char *incList[] = {"GRPID#","GRPLC#"}; + char extname[FLEN_VALUE]; + char card[FLEN_CARD]; + char comment[FLEN_COMMENT]; + char keyname[FLEN_CARD]; + char value[FLEN_CARD]; + + fitsfile *tmpfptr = NULL; + + + if(*status != 0) return(*status); + + do + { + /* open the member HDU to be copied */ + + *status = fits_open_member(gfptr,member,&tmpfptr,status); + + if(*status != 0) continue; + + /* + if the member is a grouping table then copy it with a call to + fits_copy_group() using the "copy only the grouping table" option + + if it is not a grouping table then copy the hdu with fits_copy_hdu() + remove all GRPIDn and GRPLCn keywords, and update the EXTVER keyword + value + */ + + /* get the member HDU's EXTNAME value */ + + *status = fits_read_key_str(tmpfptr,"EXTNAME",extname,comment,status); + + /* if no EXTNAME value was found then set the extname to a null string */ + + if(*status == KEY_NO_EXIST) + { + extname[0] = 0; + *status = 0; + } + else if(*status != 0) continue; + + prepare_keyvalue(extname); + + /* if a grouping table then copy with fits_copy_group() */ + + if(strcasecmp(extname,"GROUPING") == 0) + *status = fits_copy_group(tmpfptr,mfptr,OPT_GCP_GPT,status); + else + { + /* copy the non-grouping table HDU the conventional way */ + + *status = fits_copy_hdu(tmpfptr,mfptr,0,status); + + ffgrec(mfptr,0,card,status); + + /* delete all the GRPIDn and GRPLCn keywords in the copied HDU */ + + while(*status == 0) + { + *status = fits_find_nextkey(mfptr,incList,2,NULL,0,card,status); + *status = fits_get_hdrpos(mfptr,&numkeys,&keypos,status); + /* SPR 1738 */ + *status = fits_read_keyn(mfptr,keypos-1,keyname,value, + comment,status); + *status = fits_read_record(mfptr,keypos-1,card,status); + *status = fits_delete_key(mfptr,keyname,status); + } + + if(*status == KEY_NO_EXIST) *status = 0; + if(*status != 0) continue; + } + + /* + if the member HDU does not have an EXTNAME keyword then add one + with a default value + */ + + if(strlen(extname) == 0) + { + if(fits_get_hdu_num(tmpfptr,&hdunum) == 1) + { + strcpy(extname,"PRIMARY"); + *status = fits_write_key_str(mfptr,"EXTNAME",extname, + "HDU was Formerly a Primary Array", + status); + } + else + { + strcpy(extname,"DEFAULT"); + *status = fits_write_key_str(mfptr,"EXTNAME",extname, + "default EXTNAME set by CFITSIO", + status); + } + } + + /* + update the member HDU's EXTVER value (add it if not present) + */ + + fits_get_hdu_num(mfptr,&hdunum); + fits_get_hdu_type(mfptr,&hdutype,status); + + /* set the EXTVER value to 0 for now */ + + *status = fits_modify_key_lng(mfptr,"EXTVER",0,NULL,status); + + /* if the EXTVER keyword was not found then add it */ + + if(*status == KEY_NO_EXIST) + { + *status = 0; + *status = fits_read_key_str(mfptr,"EXTNAME",extname,comment, + status); + *status = fits_insert_key_lng(mfptr,"EXTVER",0, + "Extension version ID",status); + } + + if(*status != 0) continue; + + /* find the first available EXTVER value for the copied HDU */ + + for(i = 1; fits_movnam_hdu(mfptr,hdutype,extname,i,status) == 0; ++i); + + *status = 0; + + fits_movabs_hdu(mfptr,hdunum,&hdutype,status); + + /* reset the copied member HDUs EXTVER value */ + + *status = fits_modify_key_lng(mfptr,"EXTVER",(long)i,NULL,status); + + /* + perform member copy operations that are dependent upon the cpopt + parameter value + */ + + switch(cpopt) + { + case OPT_MCP_ADD: + + /* + add the copied member to the grouping table, leaving the + entry for the original member in place + */ + + *status = fits_add_group_member(gfptr,mfptr,0,status); + + break; + + case OPT_MCP_NADD: + + /* + nothing to do for this copy option + */ + + break; + + case OPT_MCP_REPL: + + /* + remove the original member from the grouping table and add the + copied member in its place + */ + + *status = fits_remove_member(gfptr,member,OPT_RM_ENTRY,status); + *status = fits_add_group_member(gfptr,mfptr,0,status); + + break; + + default: + + *status = BAD_OPTION; + ffpmsg("Invalid value specified for the cmopt parameter (ffgmcp)"); + + break; + } + + }while(0); + + if(tmpfptr != NULL) + { + fits_close_file(tmpfptr,status); + } + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgmtf(fitsfile *infptr, /* FITS file pointer to source grouping table */ + fitsfile *outfptr, /* FITS file pointer to target grouping table */ + long member, /* member ID within source grouping table */ + int tfopt, /* code specifying transfer opts: + OPT_MCP_ADD (0) ==> copy member to dest. + OPT_MCP_MOV (3) ==> move member to dest. */ + int *status) /* return status code */ + +/* + transfer a group member from one grouping table to another. The source + grouping table must be the CHDU of the fitsfile pointed to by infptr, and + the destination grouping table must be the CHDU of the fitsfile to by + outfptr. If the tfopt parameter is OPT_MCP_ADD then the member is made a + member of the target group and remains a member of the source group. If + the tfopt parameter is OPT_MCP_MOV then the member is deleted from the + source group after the transfer to the destination group. The member to be + transfered is identified by its row number within the source grouping table. +*/ + +{ + fitsfile *mfptr = NULL; + + + if(*status != 0) return(*status); + + if(tfopt != OPT_MCP_MOV && tfopt != OPT_MCP_ADD) + { + *status = BAD_OPTION; + ffpmsg("Invalid value specified for the tfopt parameter (ffgmtf)"); + } + else + { + /* open the member of infptr to be transfered */ + + *status = fits_open_member(infptr,member,&mfptr,status); + + /* add the member to the outfptr grouping table */ + + *status = fits_add_group_member(outfptr,mfptr,0,status); + + /* close the member HDU */ + + *status = fits_close_file(mfptr,status); + + /* + if the tfopt is "move member" then remove it from the infptr + grouping table + */ + + if(tfopt == OPT_MCP_MOV) + *status = fits_remove_member(infptr,member,OPT_RM_ENTRY,status); + } + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int ffgmrm(fitsfile *gfptr, /* FITS file pointer to group table */ + long member, /* member ID (row num) in the group */ + int rmopt, /* code specifying the delete option: + OPT_RM_ENTRY ==> delete the member entry + OPT_RM_MBR ==> delete entry and member HDU */ + int *status) /* return status code */ + +/* + remove a member HDU from a grouping table. The fitsfile pointer gfptr must + be positioned with the grouping table as the CHDU, and the member to + delete is identified by its row number in the table (first member == 1). + The rmopt parameter determines if the member entry is deleted from the + grouping table (in which case GRPIDn and GRPLCn keywords in the member + HDU's header shall be updated accordingly) or if the member HDU shall + itself be removed from its FITS file. +*/ + +{ + int found = 0; + int hdutype = 0; + int index = 0; + int iomode = 0; + + long i; + long ngroups = 0; + long nmembers = 0; + long groupExtver = 0; + long grpid = 0; + + char grpLocation1[FLEN_FILENAME]; + char grpLocation2[FLEN_FILENAME]; + char grpLocation3[FLEN_FILENAME]; + char cwd[FLEN_FILENAME]; + char keyword[FLEN_KEYWORD]; + /* SPR 1738 This can now be longer */ + char grplc[FLEN_FILENAME]; + char *tgrplc; + char keyvalue[FLEN_VALUE]; + char card[FLEN_CARD]; + char *editLocation; + + fitsfile *mfptr = NULL; + + + if(*status != 0) return(*status); + + do + { + /* + make sure the grouping table can be modified before proceeding + */ + + fits_file_mode(gfptr,&iomode,status); + + if(iomode != READWRITE) + { + ffpmsg("cannot modify grouping table (ffgtam)"); + *status = BAD_GROUP_DETACH; + continue; + } + + /* open the group member to be deleted and get its IOstatus*/ + + *status = fits_open_member(gfptr,member,&mfptr,status); + *status = fits_file_mode(mfptr,&iomode,status); + + /* + if the member HDU is to be deleted then call fits_unlink_member() + to remove it from all groups to which it belongs (including + this one) and then delete it. Note that if the member is a + grouping table then we have to recursively call fits_remove_member() + for each member of the member before we delete the member itself. + */ + + if(rmopt == OPT_RM_MBR) + { + /* cannot delete a PHDU */ + if(fits_get_hdu_num(mfptr,&hdutype) == 1) + { + *status = BAD_HDU_NUM; + continue; + } + + /* determine if the member HDU is itself a grouping table */ + + *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,card,status); + + /* if no EXTNAME is found then the HDU cannot be a grouping table */ + + if(*status == KEY_NO_EXIST) + { + keyvalue[0] = 0; + *status = 0; + } + prepare_keyvalue(keyvalue); + + /* Any other error is a reason to abort */ + + if(*status != 0) continue; + + /* if the EXTNAME == GROUPING then the member is a grouping table */ + + if(strcasecmp(keyvalue,"GROUPING") == 0) + { + /* remove each of the grouping table members */ + + *status = fits_get_num_members(mfptr,&nmembers,status); + + for(i = nmembers; i > 0 && *status == 0; --i) + *status = fits_remove_member(mfptr,i,OPT_RM_ENTRY,status); + + if(*status != 0) continue; + } + + /* unlink the member HDU from all groups that contain it */ + + *status = ffgmul(mfptr,0,status); + + if(*status != 0) continue; + + /* reset the grouping table HDU struct */ + + fits_set_hdustruc(gfptr,status); + + /* delete the member HDU */ + + if(iomode != READONLY) + *status = fits_delete_hdu(mfptr,&hdutype,status); + } + else if(rmopt == OPT_RM_ENTRY) + { + /* + The member HDU is only to be removed as an entry from this + grouping table. Actions are (1) find the GRPIDn/GRPLCn + keywords that link the member to the grouping table, (2) + remove the GRPIDn/GRPLCn keyword from the member HDU header + and (3) remove the member entry from the grouping table + */ + + /* + there is no need to seach for and remove the GRPIDn/GRPLCn + keywords from the member HDU if it has not been opened + in READWRITE mode + */ + + if(iomode == READWRITE) + { + /* + determine the group EXTVER value of the grouping table; if + the member HDU and grouping table HDU do not reside in the + same file then set the groupExtver value to its negative + */ + + *status = fits_read_key_lng(gfptr,"EXTVER",&groupExtver,card, + status); + if(mfptr->Fptr != gfptr->Fptr) groupExtver = -1*groupExtver; + + /* + retrieve the URLs for the grouping table; note that it is + possible that the grouping table file has two URLs, the + one used to open it and the "real" one pointing to the + actual file being accessed + */ + + *status = fits_get_url(gfptr,grpLocation1,grpLocation2,NULL, + NULL,NULL,status); + + if(*status != 0) continue; + + /* + if either of the group location strings specify a relative + file path then convert them into absolute file paths + */ + + *status = fits_get_cwd(cwd,status); + + if(*grpLocation1 != 0 && *grpLocation1 != '/' && + !fits_is_url_absolute(grpLocation1)) + { + strcpy(grpLocation3,cwd); + strcat(grpLocation3,"/"); + strcat(grpLocation3,grpLocation1); + fits_clean_url(grpLocation3,grpLocation1,status); + } + + if(*grpLocation2 != 0 && *grpLocation2 != '/' && + !fits_is_url_absolute(grpLocation2)) + { + strcpy(grpLocation3,cwd); + strcat(grpLocation3,"/"); + strcat(grpLocation3,grpLocation2); + fits_clean_url(grpLocation3,grpLocation2,status); + } + + /* + determine the number of groups to which the member HDU + belongs + */ + + *status = fits_get_num_groups(mfptr,&ngroups,status); + + /* reset the HDU keyword position counter to the beginning */ + + *status = ffgrec(mfptr,0,card,status); + + /* + loop over all the GRPIDn keywords in the member HDU header + and find the appropriate GRPIDn and GRPLCn keywords that + identify it as belonging to the group + */ + + for(index = 1, found = 0; index <= ngroups && *status == 0 && + !found; ++index) + { + /* read the next GRPIDn keyword in the series */ + + sprintf(keyword,"GRPID%d",index); + + *status = fits_read_key_lng(mfptr,keyword,&grpid,card, + status); + if(*status != 0) continue; + + /* + grpid value == group EXTVER value then we could have a + match + */ + + if(grpid == groupExtver && grpid > 0) + { + /* + if GRPID is positive then its a match because + both the member HDU and grouping table HDU reside + in the same FITS file + */ + + found = index; + } + else if(grpid == groupExtver && grpid < 0) + { + /* + have to look at the GRPLCn value to determine a + match because the member HDU and grouping table + HDU reside in different FITS files + */ + + sprintf(keyword,"GRPLC%d",index); + + /* SPR 1738 */ + *status = fits_read_key_longstr(mfptr,keyword,&tgrplc, + card, status); + if (0 == *status) { + strcpy(grplc,tgrplc); + free(tgrplc); + } + + if(*status == KEY_NO_EXIST) + { + /* + no GRPLCn keyword value found ==> grouping + convention not followed; nothing we can do + about it, so just continue + */ + + sprintf(card,"No GRPLC%d found for GRPID%d", + index,index); + ffpmsg(card); + *status = 0; + continue; + } + else if (*status != 0) continue; + + /* construct the URL for the GRPLCn value */ + + prepare_keyvalue(grplc); + + /* + if the grplc value specifies a relative path then + turn it into a absolute file path for comparison + purposes + */ + + if(*grplc != 0 && !fits_is_url_absolute(grplc) && + *grplc != '/') + { + /* No, wrong, + strcpy(grpLocation3,cwd); + should be */ + *status = fits_file_name(mfptr,grpLocation3,status); + /* Remove everything after the last / */ + if (NULL != (editLocation = strrchr(grpLocation3,'/'))) { + *editLocation = '\0'; + } + + strcat(grpLocation3,"/"); + strcat(grpLocation3,grplc); + *status = fits_clean_url(grpLocation3,grplc, + status); + } + + /* + if the absolute value of GRPIDn is equal to the + EXTVER value of the grouping table and (one of the + possible two) grouping table file URL matches the + GRPLCn keyword value then we hava a match + */ + + if(strcmp(grplc,grpLocation1) == 0 || + strcmp(grplc,grpLocation2) == 0) + found = index; + } + } + + /* + if found == 0 (false) after the above search then we assume + that it is due to an inpromper updating of the GRPIDn and + GRPLCn keywords in the member header ==> nothing to delete + in the header. Else delete the GRPLCn and GRPIDn keywords + that identify the member HDU with the group HDU and + re-enumerate the remaining GRPIDn and GRPLCn keywords + */ + + if(found != 0) + { + sprintf(keyword,"GRPID%d",found); + *status = fits_delete_key(mfptr,keyword,status); + + sprintf(keyword,"GRPLC%d",found); + *status = fits_delete_key(mfptr,keyword,status); + + *status = 0; + + /* call fits_get_num_groups() to re-enumerate the GRPIDn */ + + *status = fits_get_num_groups(mfptr,&ngroups,status); + } + } + + /* + finally, remove the member entry from the current grouping table + pointed to by gfptr + */ + + *status = fits_delete_rows(gfptr,member,1,status); + } + else + { + *status = BAD_OPTION; + ffpmsg("Invalid value specified for the rmopt parameter (ffgmrm)"); + } + + }while(0); + + if(mfptr != NULL) + { + fits_close_file(mfptr,status); + } + + return(*status); +} + +/*--------------------------------------------------------------------------- + Grouping Table support functions + ---------------------------------------------------------------------------*/ +int ffgtgc(fitsfile *gfptr, /* pointer to the grouping table */ + int *xtensionCol, /* column ID of the MEMBER_XTENSION column */ + int *extnameCol, /* column ID of the MEMBER_NAME column */ + int *extverCol, /* column ID of the MEMBER_VERSION column */ + int *positionCol, /* column ID of the MEMBER_POSITION column */ + int *locationCol, /* column ID of the MEMBER_LOCATION column */ + int *uriCol, /* column ID of the MEMBER_URI_TYPE column */ + int *grptype, /* group structure type code specifying the + grouping table columns that are defined: + GT_ID_ALL_URI (0) ==> all columns defined + GT_ID_REF (1) ==> reference cols only + GT_ID_POS (2) ==> position col only + GT_ID_ALL (3) ==> ref & pos cols + GT_ID_REF_URI (11) ==> ref & loc cols + GT_ID_POS_URI (12) ==> pos & loc cols */ + int *status) /* return status code */ +/* + examine the grouping table pointed to by gfptr and determine the column + index ID of each possible grouping column. If a column is not found then + an index of 0 is returned. the grptype parameter returns the structure + of the grouping table ==> what columns are defined. +*/ + +{ + + char keyvalue[FLEN_VALUE]; + char comment[FLEN_COMMENT]; + + + if(*status != 0) return(*status); + + do + { + /* + if the HDU does not have an extname of "GROUPING" then it is not + a grouping table + */ + + *status = fits_read_key_str(gfptr,"EXTNAME",keyvalue,comment,status); + + if(*status == KEY_NO_EXIST) + { + *status = NOT_GROUP_TABLE; + ffpmsg("Specified HDU is not a Grouping Table (ffgtgc)"); + } + if(*status != 0) continue; + + prepare_keyvalue(keyvalue); + + if(strcasecmp(keyvalue,"GROUPING") != 0) + { + *status = NOT_GROUP_TABLE; + continue; + } + + /* + search for the MEMBER_XTENSION, MEMBER_NAME, MEMBER_VERSION, + MEMBER_POSITION, MEMBER_LOCATION and MEMBER_URI_TYPE columns + and determine their column index ID + */ + + *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_XTENSION",xtensionCol, + status); + + if(*status == COL_NOT_FOUND) + { + *status = 0; + *xtensionCol = 0; + } + + if(*status != 0) continue; + + *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_NAME",extnameCol,status); + + if(*status == COL_NOT_FOUND) + { + *status = 0; + *extnameCol = 0; + } + + if(*status != 0) continue; + + *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_VERSION",extverCol, + status); + + if(*status == COL_NOT_FOUND) + { + *status = 0; + *extverCol = 0; + } + + if(*status != 0) continue; + + *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_POSITION",positionCol, + status); + + if(*status == COL_NOT_FOUND) + { + *status = 0; + *positionCol = 0; + } + + if(*status != 0) continue; + + *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_LOCATION",locationCol, + status); + + if(*status == COL_NOT_FOUND) + { + *status = 0; + *locationCol = 0; + } + + if(*status != 0) continue; + + *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_URI_TYPE",uriCol, + status); + + if(*status == COL_NOT_FOUND) + { + *status = 0; + *uriCol = 0; + } + + if(*status != 0) continue; + + /* + determine the type of grouping table structure used by this + grouping table and record it in the grptype parameter + */ + + if(*xtensionCol && *extnameCol && *extverCol && *positionCol && + *locationCol && *uriCol) + *grptype = GT_ID_ALL_URI; + + else if(*xtensionCol && *extnameCol && *extverCol && + *locationCol && *uriCol) + *grptype = GT_ID_REF_URI; + + else if(*xtensionCol && *extnameCol && *extverCol && *positionCol) + *grptype = GT_ID_ALL; + + else if(*xtensionCol && *extnameCol && *extverCol) + *grptype = GT_ID_REF; + + else if(*positionCol && *locationCol && *uriCol) + *grptype = GT_ID_POS_URI; + + else if(*positionCol) + *grptype = GT_ID_POS; + + else + *status = NOT_GROUP_TABLE; + + }while(0); + + /* + if the table contained more than one column with a reserved name then + this cannot be considered a vailid grouping table + */ + + if(*status == COL_NOT_UNIQUE) + { + *status = NOT_GROUP_TABLE; + ffpmsg("Specified HDU has multipule Group table cols defined (ffgtgc)"); + } + + return(*status); +} + +/*****************************************************************************/ +int ffgtdc(int grouptype, /* code specifying the type of + grouping table information: + GT_ID_ALL_URI 0 ==> defualt (all columns) + GT_ID_REF 1 ==> ID by reference + GT_ID_POS 2 ==> ID by position + GT_ID_ALL 3 ==> ID by ref. and position + GT_ID_REF_URI 11 ==> (1) + URI info + GT_ID_POS_URI 12 ==> (2) + URI info */ + int xtensioncol, /* does MEMBER_XTENSION already exist? */ + int extnamecol, /* does MEMBER_NAME aleady exist? */ + int extvercol, /* does MEMBER_VERSION already exist? */ + int positioncol, /* does MEMBER_POSITION already exist? */ + int locationcol, /* does MEMBER_LOCATION already exist? */ + int uricol, /* does MEMBER_URI_TYPE aleardy exist? */ + char *ttype[], /* array of grouping table column TTYPE names + to define (if *col var false) */ + char *tform[], /* array of grouping table column TFORM values + to define (if*col variable false) */ + int *ncols, /* number of TTYPE and TFORM values returned */ + int *status) /* return status code */ + +/* + create the TTYPE and TFORM values for the grouping table according to the + value of the grouptype parameter and the values of the *col flags. The + resulting TTYPE and TFORM are returned in ttype[] and tform[] respectively. + The number of TTYPE and TFORMs returned is given by ncols. Both the TTYPE[] + and TTFORM[] arrays must contain enough pre-allocated strings to hold + the returned information. +*/ + +{ + + int i = 0; + + char xtension[] = "MEMBER_XTENSION"; + char xtenTform[] = "8A"; + + char name[] = "MEMBER_NAME"; + char nameTform[] = "32A"; + + char version[] = "MEMBER_VERSION"; + char verTform[] = "1J"; + + char position[] = "MEMBER_POSITION"; + char posTform[] = "1J"; + + char URI[] = "MEMBER_URI_TYPE"; + char URITform[] = "3A"; + + char location[] = "MEMBER_LOCATION"; + /* SPR 01720, move from 160A to 256A */ + char locTform[] = "256A"; + + + if(*status != 0) return(*status); + + switch(grouptype) + { + + case GT_ID_ALL_URI: + + if(xtensioncol == 0) + { + strcpy(ttype[i],xtension); + strcpy(tform[i],xtenTform); + ++i; + } + if(extnamecol == 0) + { + strcpy(ttype[i],name); + strcpy(tform[i],nameTform); + ++i; + } + if(extvercol == 0) + { + strcpy(ttype[i],version); + strcpy(tform[i],verTform); + ++i; + } + if(positioncol == 0) + { + strcpy(ttype[i],position); + strcpy(tform[i],posTform); + ++i; + } + if(locationcol == 0) + { + strcpy(ttype[i],location); + strcpy(tform[i],locTform); + ++i; + } + if(uricol == 0) + { + strcpy(ttype[i],URI); + strcpy(tform[i],URITform); + ++i; + } + break; + + case GT_ID_REF: + + if(xtensioncol == 0) + { + strcpy(ttype[i],xtension); + strcpy(tform[i],xtenTform); + ++i; + } + if(extnamecol == 0) + { + strcpy(ttype[i],name); + strcpy(tform[i],nameTform); + ++i; + } + if(extvercol == 0) + { + strcpy(ttype[i],version); + strcpy(tform[i],verTform); + ++i; + } + break; + + case GT_ID_POS: + + if(positioncol == 0) + { + strcpy(ttype[i],position); + strcpy(tform[i],posTform); + ++i; + } + break; + + case GT_ID_ALL: + + if(xtensioncol == 0) + { + strcpy(ttype[i],xtension); + strcpy(tform[i],xtenTform); + ++i; + } + if(extnamecol == 0) + { + strcpy(ttype[i],name); + strcpy(tform[i],nameTform); + ++i; + } + if(extvercol == 0) + { + strcpy(ttype[i],version); + strcpy(tform[i],verTform); + ++i; + } + if(positioncol == 0) + { + strcpy(ttype[i],position); + strcpy(tform[i], posTform); + ++i; + } + + break; + + case GT_ID_REF_URI: + + if(xtensioncol == 0) + { + strcpy(ttype[i],xtension); + strcpy(tform[i],xtenTform); + ++i; + } + if(extnamecol == 0) + { + strcpy(ttype[i],name); + strcpy(tform[i],nameTform); + ++i; + } + if(extvercol == 0) + { + strcpy(ttype[i],version); + strcpy(tform[i],verTform); + ++i; + } + if(locationcol == 0) + { + strcpy(ttype[i],location); + strcpy(tform[i],locTform); + ++i; + } + if(uricol == 0) + { + strcpy(ttype[i],URI); + strcpy(tform[i],URITform); + ++i; + } + break; + + case GT_ID_POS_URI: + + if(positioncol == 0) + { + strcpy(ttype[i],position); + strcpy(tform[i],posTform); + ++i; + } + if(locationcol == 0) + { + strcpy(ttype[i],location); + strcpy(tform[i],locTform); + ++i; + } + if(uricol == 0) + { + strcpy(ttype[i],URI); + strcpy(tform[i],URITform); + ++i; + } + break; + + default: + + *status = BAD_OPTION; + ffpmsg("Invalid value specified for the grouptype parameter (ffgtdc)"); + + break; + + } + + *ncols = i; + + return(*status); +} + +/*****************************************************************************/ +int ffgmul(fitsfile *mfptr, /* pointer to the grouping table member HDU */ + int rmopt, /* 0 ==> leave GRPIDn/GRPLCn keywords, + 1 ==> remove GRPIDn/GRPLCn keywords */ + int *status) /* return status code */ + +/* + examine all the GRPIDn and GRPLCn keywords in the member HDUs header + and remove the member from the grouping tables referenced; This + effectively "unlinks" the member from all of its groups. The rmopt + specifies if the GRPIDn/GRPLCn keywords are to be removed from the + member HDUs header after the unlinking. +*/ + +{ + int memberPosition = 0; + int iomode; + + long index = 0; + long ngroups = 0; + long memberExtver = 0; + long memberID = 0; + + char mbrLocation1[FLEN_FILENAME]; + char mbrLocation2[FLEN_FILENAME]; + char memberHDUtype[FLEN_VALUE]; + char memberExtname[FLEN_VALUE]; + char keyword[FLEN_KEYWORD]; + char card[FLEN_CARD]; + + fitsfile *gfptr = NULL; + + + if(*status != 0) return(*status); + + do + { + /* + determine location parameters of the member HDU; note that + default values are supplied if the expected keywords are not + found + */ + + *status = fits_read_key_str(mfptr,"XTENSION",memberHDUtype,card,status); + + if(*status == KEY_NO_EXIST) + { + strcpy(memberHDUtype,"PRIMARY"); + *status = 0; + } + prepare_keyvalue(memberHDUtype); + + *status = fits_read_key_lng(mfptr,"EXTVER",&memberExtver,card,status); + + if(*status == KEY_NO_EXIST) + { + memberExtver = 1; + *status = 0; + } + + *status = fits_read_key_str(mfptr,"EXTNAME",memberExtname,card,status); + + if(*status == KEY_NO_EXIST) + { + memberExtname[0] = 0; + *status = 0; + } + prepare_keyvalue(memberExtname); + + fits_get_hdu_num(mfptr,&memberPosition); + + *status = fits_get_url(mfptr,mbrLocation1,mbrLocation2,NULL,NULL, + NULL,status); + + if(*status != 0) continue; + + /* + open each grouping table linked to this HDU and remove the member + from the grouping tables + */ + + *status = fits_get_num_groups(mfptr,&ngroups,status); + + /* loop over each group linked to the member HDU */ + + for(index = 1; index <= ngroups && *status == 0; ++index) + { + /* open the (index)th group linked to the member HDU */ + + *status = fits_open_group(mfptr,index,&gfptr,status); + + /* if the group could not be opened then just skip it */ + + if(*status != 0) + { + *status = 0; + sprintf(card,"Cannot open the %dth group table (ffgmul)", + (int)index); + ffpmsg(card); + continue; + } + + /* + make sure the grouping table can be modified before proceeding + */ + + fits_file_mode(gfptr,&iomode,status); + + if(iomode != READWRITE) + { + sprintf(card,"The %dth group cannot be modified (ffgtam)", + (int)index); + ffpmsg(card); + continue; + } + + /* + try to find the member's row within the grouping table; first + try using the member HDU file's "real" URL string then try + using its originally opened URL string if either string exist + */ + + memberID = 0; + + if(strlen(mbrLocation1) != 0) + { + *status = ffgmf(gfptr,memberHDUtype,memberExtname,memberExtver, + memberPosition,mbrLocation1,&memberID,status); + } + + if(*status == MEMBER_NOT_FOUND && strlen(mbrLocation2) != 0) + { + *status = 0; + *status = ffgmf(gfptr,memberHDUtype,memberExtname,memberExtver, + memberPosition,mbrLocation2,&memberID,status); + } + + /* if the member was found then delete it from the grouping table */ + + if(*status == 0) + *status = fits_delete_rows(gfptr,memberID,1,status); + + /* + continue the loop over all member groups even if an error + was generated + */ + + if(*status == MEMBER_NOT_FOUND) + { + ffpmsg("cannot locate member's entry in group table (ffgmul)"); + } + *status = 0; + + /* + close the file pointed to by gfptr if it is non NULL to + prepare for the next loop iterration + */ + + if(gfptr != NULL) + { + fits_close_file(gfptr,status); + gfptr = NULL; + } + } + + if(*status != 0) continue; + + /* + if rmopt is non-zero then find and delete the GRPIDn/GRPLCn + keywords from the member HDU header + */ + + if(rmopt != 0) + { + fits_file_mode(mfptr,&iomode,status); + + if(iomode == READONLY) + { + ffpmsg("Cannot modify member HDU, opened READONLY (ffgmul)"); + continue; + } + + /* delete all the GRPIDn/GRPLCn keywords */ + + for(index = 1; index <= ngroups && *status == 0; ++index) + { + sprintf(keyword,"GRPID%d",(int)index); + fits_delete_key(mfptr,keyword,status); + + sprintf(keyword,"GRPLC%d",(int)index); + fits_delete_key(mfptr,keyword,status); + + if(*status == KEY_NO_EXIST) *status = 0; + } + } + }while(0); + + /* make sure the gfptr has been closed */ + + if(gfptr != NULL) + { + fits_close_file(gfptr,status); + } + +return(*status); +} + +/*--------------------------------------------------------------------------*/ +int ffgmf(fitsfile *gfptr, /* pointer to grouping table HDU to search */ + char *xtension, /* XTENSION value for member HDU */ + char *extname, /* EXTNAME value for member HDU */ + int extver, /* EXTVER value for member HDU */ + int position, /* HDU position value for member HDU */ + char *location, /* FITS file location value for member HDU */ + long *member, /* member HDU ID within group table (if found) */ + int *status) /* return status code */ + +/* + try to find the entry for the member HDU defined by the xtension, extname, + extver, position, and location parameters within the grouping table + pointed to by gfptr. If the member HDU is found then its ID (row number) + within the grouping table is returned in the member variable; if not + found then member is returned with a value of 0 and the status return + code will be set to MEMBER_NOT_FOUND. + + Note that the member HDU postion information is used to obtain a member + match only if the grouping table type is GT_ID_POS_URI or GT_ID_POS. This + is because the position information can become invalid much more + easily then the reference information for a group member. +*/ + +{ + int xtensionCol,extnameCol,extverCol,positionCol,locationCol,uriCol; + int mposition = 0; + int grptype; + int dummy; + int i; + + long nmembers = 0; + long mextver = 0; + + char charBuff1[FLEN_FILENAME]; + char charBuff2[FLEN_FILENAME]; + char tmpLocation[FLEN_FILENAME]; + char mbrLocation1[FLEN_FILENAME]; + char mbrLocation2[FLEN_FILENAME]; + char mbrLocation3[FLEN_FILENAME]; + char grpLocation1[FLEN_FILENAME]; + char grpLocation2[FLEN_FILENAME]; + char cwd[FLEN_FILENAME]; + + char nstr[] = {'\0'}; + char *tmpPtr[2]; + + if(*status != 0) return(*status); + + *member = 0; + + tmpPtr[0] = charBuff1; + tmpPtr[1] = charBuff2; + + + if(*status != 0) return(*status); + + /* + if the passed LOCATION value is not an absolute URL then turn it + into an absolute path + */ + + if(location == NULL) + { + *tmpLocation = 0; + } + + else if(*location == 0) + { + *tmpLocation = 0; + } + + else if(!fits_is_url_absolute(location)) + { + fits_path2url(location,tmpLocation,status); + + if(*tmpLocation != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,tmpLocation); + fits_clean_url(cwd,tmpLocation,status); + } + } + + else + strcpy(tmpLocation,location); + + /* + retrieve the Grouping Convention reserved column positions within + the grouping table + */ + + *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol, + &locationCol,&uriCol,&grptype,status); + + /* retrieve the number of group members */ + + *status = fits_get_num_members(gfptr,&nmembers,status); + + /* + loop over all grouping table rows until the member HDU is found + */ + + for(i = 1; i <= nmembers && *member == 0 && *status == 0; ++i) + { + if(xtensionCol != 0) + { + fits_read_col_str(gfptr,xtensionCol,i,1,1,nstr,tmpPtr,&dummy,status); + if(strcasecmp(tmpPtr[0],xtension) != 0) continue; + } + + if(extnameCol != 0) + { + fits_read_col_str(gfptr,extnameCol,i,1,1,nstr,tmpPtr,&dummy,status); + if(strcasecmp(tmpPtr[0],extname) != 0) continue; + } + + if(extverCol != 0) + { + fits_read_col_lng(gfptr,extverCol,i,1,1,0, + (long*)&mextver,&dummy,status); + if(extver != mextver) continue; + } + + /* note we only use postionCol if we have to */ + + if(positionCol != 0 && + (grptype == GT_ID_POS || grptype == GT_ID_POS_URI)) + { + fits_read_col_int(gfptr,positionCol,i,1,1,0, + &mposition,&dummy,status); + if(position != mposition) continue; + } + + /* + if no location string was passed to the function then assume that + the calling application does not wish to use it as a comparision + critera ==> if we got this far then we have a match + */ + + if(location == NULL) + { + ffpmsg("NULL Location string given ==> ingore location (ffgmf)"); + *member = i; + continue; + } + + /* + if the grouping table MEMBER_LOCATION column exists then read the + location URL for the member, else set the location string to + a zero-length string for subsequent comparisions + */ + + if(locationCol != 0) + { + fits_read_col_str(gfptr,locationCol,i,1,1,nstr,tmpPtr,&dummy,status); + strcpy(mbrLocation1,tmpPtr[0]); + *mbrLocation2 = 0; + } + else + *mbrLocation1 = 0; + + /* + if the member location string from the grouping table is zero + length (either implicitly or explicitly) then assume that the + member HDU is in the same file as the grouping table HDU; retrieve + the possible URL values of the grouping table HDU file + */ + + if(*mbrLocation1 == 0) + { + /* retrieve the possible URLs of the grouping table file */ + *status = fits_get_url(gfptr,mbrLocation1,mbrLocation2,NULL,NULL, + NULL,status); + + /* if non-NULL, make sure the first URL is absolute or a full path */ + if(*mbrLocation1 != 0 && !fits_is_url_absolute(mbrLocation1) && + *mbrLocation1 != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,mbrLocation1); + fits_clean_url(cwd,mbrLocation1,status); + } + + /* if non-NULL, make sure the first URL is absolute or a full path */ + if(*mbrLocation2 != 0 && !fits_is_url_absolute(mbrLocation2) && + *mbrLocation2 != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,mbrLocation2); + fits_clean_url(cwd,mbrLocation2,status); + } + } + + /* + if the member location was specified, then make sure that it is + either an absolute URL or specifies a full path + */ + + else if(!fits_is_url_absolute(mbrLocation1) && *mbrLocation1 != '/') + { + strcpy(mbrLocation2,mbrLocation1); + + /* get the possible URLs for the grouping table file */ + *status = fits_get_url(gfptr,grpLocation1,grpLocation2,NULL,NULL, + NULL,status); + + if(*grpLocation1 != 0) + { + /* make sure the first grouping table URL is absolute */ + if(!fits_is_url_absolute(grpLocation1) && *grpLocation1 != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,grpLocation1); + fits_clean_url(cwd,grpLocation1,status); + } + + /* create an absoute URL for the member */ + + fits_relurl2url(grpLocation1,mbrLocation1,mbrLocation3,status); + + /* + if URL construction succeeded then copy it to the + first location string; else set the location string to + empty + */ + + if(*status == 0) + { + strcpy(mbrLocation1,mbrLocation3); + } + + else if(*status == URL_PARSE_ERROR) + { + *status = 0; + *mbrLocation1 = 0; + } + } + else + *mbrLocation1 = 0; + + if(*grpLocation2 != 0) + { + /* make sure the second grouping table URL is absolute */ + if(!fits_is_url_absolute(grpLocation2) && *grpLocation2 != '/') + { + fits_get_cwd(cwd,status); + strcat(cwd,"/"); + strcat(cwd,grpLocation2); + fits_clean_url(cwd,grpLocation2,status); + } + + /* create an absolute URL for the member */ + + fits_relurl2url(grpLocation2,mbrLocation2,mbrLocation3,status); + + /* + if URL construction succeeded then copy it to the + second location string; else set the location string to + empty + */ + + if(*status == 0) + { + strcpy(mbrLocation2,mbrLocation3); + } + + else if(*status == URL_PARSE_ERROR) + { + *status = 0; + *mbrLocation2 = 0; + } + } + else + *mbrLocation2 = 0; + } + + /* + compare the passed member HDU file location string with the + (possibly two) member location strings to see if there is a match + */ + + if(strcmp(mbrLocation1,tmpLocation) != 0 && + strcmp(mbrLocation2,tmpLocation) != 0 ) continue; + + /* if we made it this far then a match to the member HDU was found */ + + *member = i; + } + + /* if a match was not found then set the return status code */ + + if(*member == 0 && *status == 0) + { + *status = MEMBER_NOT_FOUND; + ffpmsg("Cannot find specified member HDU (ffgmf)"); + } + + return(*status); +} + +/*-------------------------------------------------------------------------- + Recursive Group Functions + --------------------------------------------------------------------------*/ +int ffgtrmr(fitsfile *gfptr, /* FITS file pointer to group */ + HDUtracker *HDU, /* list of processed HDUs */ + int *status) /* return status code */ + +/* + recursively remove a grouping table and all its members. Each member of + the grouping table pointed to by gfptr it processed. If the member is itself + a grouping table then ffgtrmr() is recursively called to process all + of its members. The HDUtracker struct *HDU is used to make sure a member + is not processed twice, thus avoiding an infinite loop (e.g., a grouping + table contains itself as a member). +*/ + +{ + int i; + int hdutype; + + long nmembers = 0; + + char keyvalue[FLEN_VALUE]; + char comment[FLEN_COMMENT]; + + fitsfile *mfptr = NULL; + + + if(*status != 0) return(*status); + + /* get the number of members contained by this grouping table */ + + *status = fits_get_num_members(gfptr,&nmembers,status); + + /* loop over all group members and delete them */ + + for(i = nmembers; i > 0 && *status == 0; --i) + { + /* open the member HDU */ + + *status = fits_open_member(gfptr,i,&mfptr,status); + + /* if the member cannot be opened then just skip it and continue */ + + if(*status == MEMBER_NOT_FOUND) + { + *status = 0; + continue; + } + + /* Any other error is a reason to abort */ + + if(*status != 0) continue; + + /* add the member HDU to the HDUtracker struct */ + + *status = fftsad(mfptr,HDU,NULL,NULL); + + /* status == HDU_ALREADY_TRACKED ==> HDU has already been processed */ + + if(*status == HDU_ALREADY_TRACKED) + { + *status = 0; + fits_close_file(mfptr,status); + continue; + } + else if(*status != 0) continue; + + /* determine if the member HDU is itself a grouping table */ + + *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,comment,status); + + /* if no EXTNAME is found then the HDU cannot be a grouping table */ + + if(*status == KEY_NO_EXIST) + { + *status = 0; + keyvalue[0] = 0; + } + prepare_keyvalue(keyvalue); + + /* Any other error is a reason to abort */ + + if(*status != 0) continue; + + /* + if the EXTNAME == GROUPING then the member is a grouping table + and we must call ffgtrmr() to process its members + */ + + if(strcasecmp(keyvalue,"GROUPING") == 0) + *status = ffgtrmr(mfptr,HDU,status); + + /* + unlink all the grouping tables that contain this HDU as a member + and then delete the HDU (if not a PHDU) + */ + + if(fits_get_hdu_num(mfptr,&hdutype) == 1) + *status = ffgmul(mfptr,1,status); + else + { + *status = ffgmul(mfptr,0,status); + *status = fits_delete_hdu(mfptr,&hdutype,status); + } + + /* close the fitsfile pointer */ + + fits_close_file(mfptr,status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtcpr(fitsfile *infptr, /* input FITS file pointer */ + fitsfile *outfptr, /* output FITS file pointer */ + int cpopt, /* code specifying copy options: + OPT_GCP_GPT (0) ==> cp only grouping table + OPT_GCP_ALL (2) ==> recusrively copy + members and their members (if groups) */ + HDUtracker *HDU, /* list of already copied HDUs */ + int *status) /* return status code */ + +/* + copy a Group to a new FITS file. If the cpopt parameter is set to + OPT_GCP_GPT (copy grouping table only) then the existing members have their + GRPIDn and GRPLCn keywords updated to reflect the existance of the new group, + since they now belong to another group. If cpopt is set to OPT_GCP_ALL + (copy grouping table and members recursively) then the original members are + not updated; the new grouping table is modified to include only the copied + member HDUs and not the original members. + + Note that this function is recursive. When copt is OPT_GCP_ALL it will call + itself whenever a member HDU of the current grouping table is itself a + grouping table (i.e., EXTNAME = 'GROUPING'). +*/ + +{ + + int i; + int nexclude = 8; + int hdutype = 0; + int groupHDUnum = 0; + int numkeys = 0; + int keypos = 0; + int startSearch = 0; + int newPosition = 0; + + long nmembers = 0; + long tfields = 0; + long newTfields = 0; + + char keyword[FLEN_KEYWORD]; + char keyvalue[FLEN_VALUE]; + char card[FLEN_CARD]; + char comment[FLEN_CARD]; + char *tkeyvalue; + + char *includeList[] = {"*"}; + char *excludeList[] = {"EXTNAME","EXTVER","GRPNAME","GRPID#","GRPLC#", + "THEAP","TDIM#","T????#"}; + + fitsfile *mfptr = NULL; + + + if(*status != 0) return(*status); + + do + { + /* + create a new grouping table in the FITS file pointed to by outptr + */ + + *status = fits_get_num_members(infptr,&nmembers,status); + + *status = fits_read_key_str(infptr,"GRPNAME",keyvalue,card,status); + + if(*status == KEY_NO_EXIST) + { + keyvalue[0] = 0; + *status = 0; + } + prepare_keyvalue(keyvalue); + + *status = fits_create_group(outfptr,keyvalue,GT_ID_ALL_URI,status); + + /* save the new grouping table's HDU position for future use */ + + fits_get_hdu_num(outfptr,&groupHDUnum); + + /* update the HDUtracker struct with the grouping table's new position */ + + *status = fftsud(infptr,HDU,groupHDUnum,NULL); + + /* + Now populate the copied grouping table depending upon the + copy option parameter value + */ + + switch(cpopt) + { + + /* + for the "copy grouping table only" option we only have to + add the members of the original grouping table to the new + grouping table + */ + + case OPT_GCP_GPT: + + for(i = 1; i <= nmembers && *status == 0; ++i) + { + *status = fits_open_member(infptr,i,&mfptr,status); + *status = fits_add_group_member(outfptr,mfptr,0,status); + + fits_close_file(mfptr,status); + mfptr = NULL; + } + + break; + + case OPT_GCP_ALL: + + /* + for the "copy the entire group" option + */ + + /* loop over all the grouping table members */ + + for(i = 1; i <= nmembers && *status == 0; ++i) + { + /* open the ith member */ + + *status = fits_open_member(infptr,i,&mfptr,status); + + if(*status != 0) continue; + + /* add it to the HDUtracker struct */ + + *status = fftsad(mfptr,HDU,&newPosition,NULL); + + /* if already copied then just add the member to the group */ + + if(*status == HDU_ALREADY_TRACKED) + { + *status = 0; + *status = fits_add_group_member(outfptr,NULL,newPosition, + status); + fits_close_file(mfptr,status); + mfptr = NULL; + continue; + } + else if(*status != 0) continue; + + /* see if the member is a grouping table */ + + *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,card, + status); + + if(*status == KEY_NO_EXIST) + { + keyvalue[0] = 0; + *status = 0; + } + prepare_keyvalue(keyvalue); + + /* + if the member is a grouping table then copy it and all of + its members using ffgtcpr(), else copy it using + fits_copy_member(); the outptr will point to the newly + copied member upon return from both functions + */ + + if(strcasecmp(keyvalue,"GROUPING") == 0) + *status = ffgtcpr(mfptr,outfptr,OPT_GCP_ALL,HDU,status); + else + *status = fits_copy_member(infptr,outfptr,i,OPT_MCP_NADD, + status); + + /* retrieve the position of the newly copied member */ + + fits_get_hdu_num(outfptr,&newPosition); + + /* update the HDUtracker struct with member's new position */ + + if(strcasecmp(keyvalue,"GROUPING") != 0) + *status = fftsud(mfptr,HDU,newPosition,NULL); + + /* move the outfptr back to the copied grouping table HDU */ + + *status = fits_movabs_hdu(outfptr,groupHDUnum,&hdutype,status); + + /* add the copied member HDU to the copied grouping table */ + + *status = fits_add_group_member(outfptr,NULL,newPosition,status); + + /* close the mfptr pointer */ + + fits_close_file(mfptr,status); + mfptr = NULL; + } + + break; + + default: + + *status = BAD_OPTION; + ffpmsg("Invalid value specified for cmopt parameter (ffgtcpr)"); + break; + } + + if(*status != 0) continue; + + /* + reposition the outfptr to the grouping table so that the grouping + table is the CHDU upon return to the calling function + */ + + fits_movabs_hdu(outfptr,groupHDUnum,&hdutype,status); + + /* + copy all auxiliary keyword records from the original grouping table + to the new grouping table; they are copied in their original order + and inserted just before the TTYPE1 keyword record + */ + + *status = fits_read_card(outfptr,"TTYPE1",card,status); + *status = fits_get_hdrpos(outfptr,&numkeys,&keypos,status); + --keypos; + + startSearch = 8; + + while(*status == 0) + { + ffgrec(infptr,startSearch,card,status); + + *status = fits_find_nextkey(infptr,includeList,1,excludeList, + nexclude,card,status); + + *status = fits_get_hdrpos(infptr,&numkeys,&startSearch,status); + + --startSearch; + /* SPR 1738 */ + if (strncmp(card,"GRPLC",5)) { + /* Not going to be a long string so we're ok */ + *status = fits_insert_record(outfptr,keypos,card,status); + } else { + /* We could have a long string */ + *status = fits_read_record(infptr,startSearch,card,status); + card[9] = '\0'; + *status = fits_read_key_longstr(infptr,card,&tkeyvalue,comment, + status); + if (0 == *status) { + fits_insert_key_longstr(outfptr,card,tkeyvalue,comment,status); + fits_write_key_longwarn(outfptr,status); + free(tkeyvalue); + } + } + + ++keypos; + } + + + if(*status == KEY_NO_EXIST) + *status = 0; + else if(*status != 0) continue; + + /* + search all the columns of the original grouping table and copy + those to the new grouping table that were not part of the grouping + convention. Note that is legal to have additional columns in a + grouping table. Also note that the order of the columns may + not be the same in the original and copied grouping table. + */ + + /* retrieve the number of columns in the original and new group tables */ + + *status = fits_read_key_lng(infptr,"TFIELDS",&tfields,card,status); + *status = fits_read_key_lng(outfptr,"TFIELDS",&newTfields,card,status); + + for(i = 1; i <= tfields; ++i) + { + sprintf(keyword,"TTYPE%d",i); + *status = fits_read_key_str(infptr,keyword,keyvalue,card,status); + + if(*status == KEY_NO_EXIST) + { + *status = 0; + keyvalue[0] = 0; + } + prepare_keyvalue(keyvalue); + + if(strcasecmp(keyvalue,"MEMBER_XTENSION") != 0 && + strcasecmp(keyvalue,"MEMBER_NAME") != 0 && + strcasecmp(keyvalue,"MEMBER_VERSION") != 0 && + strcasecmp(keyvalue,"MEMBER_POSITION") != 0 && + strcasecmp(keyvalue,"MEMBER_LOCATION") != 0 && + strcasecmp(keyvalue,"MEMBER_URI_TYPE") != 0 ) + { + *status = fits_copy_col(infptr,outfptr,i,newTfields,1,status); + ++newTfields; + } + } + + }while(0); + + if(mfptr != NULL) + { + fits_close_file(mfptr,status); + } + + return(*status); +} + +/*-------------------------------------------------------------------------- + HDUtracker struct manipulation functions + --------------------------------------------------------------------------*/ +int fftsad(fitsfile *mfptr, /* pointer to an member HDU */ + HDUtracker *HDU, /* pointer to an HDU tracker struct */ + int *newPosition, /* new HDU position of the member HDU */ + char *newFileName) /* file containing member HDU */ + +/* + add an HDU to the HDUtracker struct pointed to by HDU. The HDU is only + added if it does not already reside in the HDUtracker. If it already + resides in the HDUtracker then the new HDU postion and file name are + returned in newPosition and newFileName (if != NULL) +*/ + +{ + int i; + int hdunum; + int status = 0; + + char filename1[FLEN_FILENAME]; + char filename2[FLEN_FILENAME]; + + do + { + /* retrieve the HDU's position within the FITS file */ + + fits_get_hdu_num(mfptr,&hdunum); + + /* retrieve the HDU's file name */ + + status = fits_file_name(mfptr,filename1,&status); + + /* parse the file name and construct the "standard" URL for it */ + + status = ffrtnm(filename1,filename2,&status); + + /* + examine all the existing HDUs in the HDUtracker an see if this HDU + has already been registered + */ + + for(i = 0; + i < HDU->nHDU && !(HDU->position[i] == hdunum + && strcmp(HDU->filename[i],filename2) == 0); + ++i); + + if(i != HDU->nHDU) + { + status = HDU_ALREADY_TRACKED; + if(newPosition != NULL) *newPosition = HDU->newPosition[i]; + if(newFileName != NULL) strcpy(newFileName,HDU->newFilename[i]); + continue; + } + + if(HDU->nHDU == MAX_HDU_TRACKER) + { + status = TOO_MANY_HDUS_TRACKED; + continue; + } + + HDU->filename[i] = (char*) malloc(FLEN_FILENAME * sizeof(char)); + + if(HDU->filename[i] == NULL) + { + status = MEMORY_ALLOCATION; + continue; + } + + HDU->newFilename[i] = (char*) malloc(FLEN_FILENAME * sizeof(char)); + + if(HDU->newFilename[i] == NULL) + { + status = MEMORY_ALLOCATION; + free(HDU->filename[i]); + continue; + } + + HDU->position[i] = hdunum; + HDU->newPosition[i] = hdunum; + + strcpy(HDU->filename[i],filename2); + strcpy(HDU->newFilename[i],filename2); + + ++(HDU->nHDU); + + }while(0); + + return(status); +} +/*--------------------------------------------------------------------------*/ +int fftsud(fitsfile *mfptr, /* pointer to an member HDU */ + HDUtracker *HDU, /* pointer to an HDU tracker struct */ + int newPosition, /* new HDU position of the member HDU */ + char *newFileName) /* file containing member HDU */ + +/* + update the HDU information in the HDUtracker struct pointed to by HDU. The + HDU to update is pointed to by mfptr. If non-zero, the value of newPosition + is used to update the HDU->newPosition[] value for the mfptr, and if + non-NULL the newFileName value is used to update the HDU->newFilename[] + value for mfptr. +*/ + +{ + int i; + int hdunum; + int status = 0; + + char filename1[FLEN_FILENAME]; + char filename2[FLEN_FILENAME]; + + + /* retrieve the HDU's position within the FITS file */ + + fits_get_hdu_num(mfptr,&hdunum); + + /* retrieve the HDU's file name */ + + status = fits_file_name(mfptr,filename1,&status); + + /* parse the file name and construct the "standard" URL for it */ + + status = ffrtnm(filename1,filename2,&status); + + /* + examine all the existing HDUs in the HDUtracker an see if this HDU + has already been registered + */ + + for(i = 0; i < HDU->nHDU && + !(HDU->position[i] == hdunum && strcmp(HDU->filename[i],filename2) == 0); + ++i); + + /* if previously registered then change newPosition and newFileName */ + + if(i != HDU->nHDU) + { + if(newPosition != 0) HDU->newPosition[i] = newPosition; + if(newFileName != NULL) + { + strcpy(HDU->newFilename[i],newFileName); + } + } + else + status = MEMBER_NOT_FOUND; + + return(status); +} + +/*---------------------------------------------------------------------------*/ + +void prepare_keyvalue(char *keyvalue) /* string containing keyword value */ + +/* + strip off all single quote characters "'" and blank spaces from a keyword + value retrieved via fits_read_key*() routines + + this is necessary so that a standard comparision of keyword values may + be made +*/ + +{ + + int i; + int length; + + /* + strip off any leading or trailing single quotes (`) and (') from + the keyword value + */ + + length = strlen(keyvalue) - 1; + + if(keyvalue[0] == '\'' && keyvalue[length] == '\'') + { + for(i = 0; i < length - 1; ++i) keyvalue[i] = keyvalue[i+1]; + keyvalue[length-1] = 0; + } + + /* + strip off any trailing blanks from the keyword value; note that if the + keyvalue consists of nothing but blanks then no blanks are stripped + */ + + length = strlen(keyvalue) - 1; + + for(i = 0; i < length && keyvalue[i] == ' '; ++i); + + if(i != length) + { + for(i = length; i >= 0 && keyvalue[i] == ' '; --i) keyvalue[i] = '\0'; + } +} + +/*--------------------------------------------------------------------------- + Host dependent directory path to/from URL functions + --------------------------------------------------------------------------*/ +int fits_path2url(char *inpath, /* input file path string */ + char *outpath, /* output file path string */ + int *status) + /* + convert a file path into its Unix-style equivelent for URL + purposes. Note that this process is platform dependent. This + function supports Unix, MSDOS/WIN32, VMS and Macintosh platforms. + The plaform dependant code is conditionally compiled depending upon + the setting of the appropriate C preprocessor macros. + */ +{ + char buff[FLEN_FILENAME]; + +#if defined(WINNT) || defined(__WINNT__) + + /* + Microsoft Windows NT case. We assume input file paths of the form: + + //disk/path/filename + + All path segments may be null, so that a single file name is the + simplist case. + + The leading "//" becomes a single "/" if present. If no "//" is present, + then make sure the resulting URL path is relative, i.e., does not + begin with a "/". In other words, the only way that an absolute URL + file path may be generated is if the drive specification is given. + */ + + if(*status > 0) return(*status); + + if(inpath[0] == '/') + { + strcpy(buff,inpath+1); + } + else + { + strcpy(buff,inpath); + } + +#elif defined(MSDOS) || defined(__WIN32__) || defined(WIN32) + + /* + MSDOS or Microsoft windows/NT case. The assumed form of the + input path is: + + disk:\path\filename + + All path segments may be null, so that a single file name is the + simplist case. + + All back-slashes '\' become slashes '/'; if the path starts with a + string of the form "X:" then it is replaced with "/X/" + */ + + int i,j,k; + int size; + if(*status > 0) return(*status); + + for(i = 0, j = 0, size = strlen(inpath), buff[0] = 0; + i < size; j = strlen(buff)) + { + switch(inpath[i]) + { + + case ':': + + /* + must be a disk desiginator; add a slash '/' at the start of + outpath to designate that the path is absolute, then change + the colon ':' to a slash '/' + */ + + for(k = j; k >= 0; --k) buff[k+1] = buff[k]; + buff[0] = '/'; + strcat(buff,"/"); + ++i; + + break; + + case '\\': + + /* just replace the '\' with a '/' IF its not the first character */ + + if(i != 0 && buff[(j == 0 ? 0 : j-1)] != '/') + { + buff[j] = '/'; + buff[j+1] = 0; + } + + ++i; + + break; + + default: + + /* copy the character from inpath to buff as is */ + + buff[j] = inpath[i]; + buff[j+1] = 0; + ++i; + + break; + } + } + +#elif defined(VMS) || defined(vms) || defined(__vms) + + /* + VMS case. Assumed format of the input path is: + + node::disk:[path]filename.ext;version + + Any part of the file path may be missing, so that in the simplist + case a single file name/extension is given. + + all brackets "[", "]" and dots "." become "/"; dashes "-" become "..", + all single colons ":" become ":/", all double colons "::" become + "FILE://" + */ + + int i,j,k; + int done; + int size; + + if(*status > 0) return(*status); + + /* see if inpath contains a directory specification */ + + if(strchr(inpath,']') == NULL) + done = 1; + else + done = 0; + + for(i = 0, j = 0, size = strlen(inpath), buff[0] = 0; + i < size && j < FLEN_FILENAME - 8; j = strlen(buff)) + { + switch(inpath[i]) + { + + case ':': + + /* + must be a logical/symbol separator or (in the case of a double + colon "::") machine node separator + */ + + if(inpath[i+1] == ':') + { + /* insert a "FILE://" at the start of buff ==> machine given */ + + for(k = j; k >= 0; --k) buff[k+7] = buff[k]; + strncpy(buff,"FILE://",7); + i += 2; + } + else if(strstr(buff,"FILE://") == NULL) + { + /* insert a "/" at the start of buff ==> absolute path */ + + for(k = j; k >= 0; --k) buff[k+1] = buff[k]; + buff[0] = '/'; + ++i; + } + else + ++i; + + /* a colon always ==> path separator */ + + strcat(buff,"/"); + + break; + + case ']': + + /* end of directory spec, file name spec begins after this */ + + done = 1; + + buff[j] = '/'; + buff[j+1] = 0; + ++i; + + break; + + case '[': + + /* + begin directory specification; add a '/' only if the last char + is not '/' + */ + + if(i != 0 && buff[(j == 0 ? 0 : j-1)] != '/') + { + buff[j] = '/'; + buff[j+1] = 0; + } + + ++i; + + break; + + case '.': + + /* + directory segment separator or file name/extension separator; + we decide which by looking at the value of done + */ + + if(!done) + { + /* must be a directory segment separator */ + if(inpath[i-1] == '[') + { + strcat(buff,"./"); + ++j; + } + else + buff[j] = '/'; + } + else + /* must be a filename/extension separator */ + buff[j] = '.'; + + buff[j+1] = 0; + + ++i; + + break; + + case '-': + + /* + a dash is the same as ".." in Unix speak, but lets make sure + that its not part of the file name first! + */ + + if(!done) + /* must be part of the directory path specification */ + strcat(buff,".."); + else + { + /* the dash is part of the filename, so just copy it as is */ + buff[j] = '-'; + buff[j+1] = 0; + } + + ++i; + + break; + + default: + + /* nothing special, just copy the character as is */ + + buff[j] = inpath[i]; + buff[j+1] = 0; + + ++i; + + break; + + } + } + + if(j > FLEN_FILENAME - 8) + { + *status = URL_PARSE_ERROR; + ffpmsg("resulting path to URL conversion too big (fits_path2url)"); + } + +#elif defined(macintosh) + + /* + MacOS case. The assumed form of the input path is: + + disk:path:filename + + It is assumed that all paths are absolute with disk and path specified, + unless no colons ":" are supplied with the string ==> a single file name + only. All colons ":" become slashes "/", and if one or more colon is + encountered then the path is specified as absolute. + */ + + int i,j,k; + int firstColon; + int size; + + if(*status > 0) return(*status); + + for(i = 0, j = 0, firstColon = 1, size = strlen(inpath), buff[0] = 0; + i < size; j = strlen(buff)) + { + switch(inpath[i]) + { + + case ':': + + /* + colons imply path separators. If its the first colon encountered + then assume that its the disk designator and add a slash to the + beginning of the buff string + */ + + if(firstColon) + { + firstColon = 0; + + for(k = j; k >= 0; --k) buff[k+1] = buff[k]; + buff[0] = '/'; + } + + /* all colons become slashes */ + + strcat(buff,"/"); + + ++i; + + break; + + default: + + /* copy the character from inpath to buff as is */ + + buff[j] = inpath[i]; + buff[j+1] = 0; + + ++i; + + break; + } + } + +#else + + /* + Default Unix case. + + Nothing special to do here except to remove the double or more // and + replace them with single / + */ + + int ii = 0; + int jj = 0; + + if(*status > 0) return(*status); + + while (inpath[ii]) { + if (inpath[ii] == '/' && inpath[ii+1] == '/') { + /* do nothing */ + } else { + buff[jj] = inpath[ii]; + jj++; + } + ii++; + } + buff[jj] = '\0'; + /* printf("buff is %s\ninpath is %s\n",buff,inpath); */ + /* strcpy(buff,inpath); */ + +#endif + + /* + encode all "unsafe" and "reserved" URL characters + */ + + *status = fits_encode_url(buff,outpath,status); + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int fits_url2path(char *inpath, /* input file path string */ + char *outpath, /* output file path string */ + int *status) + /* + convert a Unix-style URL into a platform dependent directory path. + Note that this process is platform dependent. This + function supports Unix, MSDOS/WIN32, VMS and Macintosh platforms. Each + platform dependent code segment is conditionally compiled depending + upon the setting of the appropriate C preprocesser macros. + */ +{ + char buff[FLEN_FILENAME]; + int absolute; + +#if defined(MSDOS) || defined(__WIN32__) || defined(WIN32) + char *tmpStr; +#elif defined(VMS) || defined(vms) || defined(__vms) + int i; + char *tmpStr; +#elif defined(macintosh) + char *tmpStr; +#endif + + if(*status != 0) return(*status); + + /* + make a copy of the inpath so that we can manipulate it + */ + + strcpy(buff,inpath); + + /* + convert any encoded characters to their unencoded values + */ + + *status = fits_unencode_url(inpath,buff,status); + + /* + see if the URL is given as absolute w.r.t. the "local" file system + */ + + if(buff[0] == '/') + absolute = 1; + else + absolute = 0; + +#if defined(WINNT) || defined(__WINNT__) + + /* + Microsoft Windows NT case. We create output paths of the form + + //disk/path/filename + + All path segments but the last may be null, so that a single file name + is the simplist case. + */ + + if(absolute) + { + strcpy(outpath,"/"); + strcat(outpath,buff); + } + else + { + strcpy(outpath,buff); + } + +#elif defined(MSDOS) || defined(__WIN32__) || defined(WIN32) + + /* + MSDOS or Microsoft windows/NT case. The output path will be of the + form + + disk:\path\filename + + All path segments but the last may be null, so that a single file name + is the simplist case. + */ + + /* + separate the URL into tokens at each slash '/' and process until + all tokens have been examined + */ + + for(tmpStr = strtok(buff,"/"), outpath[0] = 0; + tmpStr != NULL; tmpStr = strtok(NULL,"/")) + { + strcat(outpath,tmpStr); + + /* + if the absolute flag is set then process the token as a disk + specification; else just process it as a directory path or filename + */ + + if(absolute) + { + strcat(outpath,":\\"); + absolute = 0; + } + else + strcat(outpath,"\\"); + } + + /* remove the last "\" from the outpath, it does not belong there */ + + outpath[strlen(outpath)-1] = 0; + +#elif defined(VMS) || defined(vms) || defined(__vms) + + /* + VMS case. The output path will be of the form: + + node::disk:[path]filename.ext;version + + Any part of the file path may be missing execpt filename.ext, so that in + the simplist case a single file name/extension is given. + + if the path is specified as relative starting with "./" then the first + part of the VMS path is "[.". If the path is relative and does not start + with "./" (e.g., "a/b/c") then the VMS path is constructed as + "[a.b.c]" + */ + + /* + separate the URL into tokens at each slash '/' and process until + all tokens have been examined + */ + + for(tmpStr = strtok(buff,"/"), outpath[0] = 0; + tmpStr != NULL; tmpStr = strtok(NULL,"/")) + { + + if(strcasecmp(tmpStr,"FILE:") == 0) + { + /* the next token should contain the DECnet machine name */ + + tmpStr = strtok(NULL,"/"); + if(tmpStr == NULL) continue; + + strcat(outpath,tmpStr); + strcat(outpath,"::"); + + /* set the absolute flag to true for the next token */ + absolute = 1; + } + + else if(strcmp(tmpStr,"..") == 0) + { + /* replace all Unix-like ".." with VMS "-" */ + + if(strlen(outpath) == 0) strcat(outpath,"["); + strcat(outpath,"-."); + } + + else if(strcmp(tmpStr,".") == 0 && strlen(outpath) == 0) + { + /* + must indicate a relative path specifier + */ + + strcat(outpath,"[."); + } + + else if(strchr(tmpStr,'.') != NULL) + { + /* + must be up to the file name; turn the last "." path separator + into a "]" and then add the file name to the outpath + */ + + i = strlen(outpath); + if(i > 0 && outpath[i-1] == '.') outpath[i-1] = ']'; + + strcat(outpath,tmpStr); + } + + else + { + /* + process the token as a a directory path segement + */ + + if(absolute) + { + /* treat the token as a disk specifier */ + absolute = 0; + strcat(outpath,tmpStr); + strcat(outpath,":["); + } + else if(strlen(outpath) == 0) + { + /* treat the token as the first directory path specifier */ + strcat(outpath,"["); + strcat(outpath,tmpStr); + strcat(outpath,"."); + } + else + { + /* treat the token as an imtermediate path specifier */ + strcat(outpath,tmpStr); + strcat(outpath,"."); + } + } + } + +#elif defined(macintosh) + + /* + MacOS case. The output path will be of the form + + disk:path:filename + + All path segments but the last may be null, so that a single file name + is the simplist case. + */ + + /* + separate the URL into tokens at each slash '/' and process until + all tokens have been examined + */ + + for(tmpStr = strtok(buff,"/"), outpath[0] = 0; + tmpStr != NULL; tmpStr = strtok(NULL,"/")) + { + strcat(outpath,tmpStr); + strcat(outpath,":"); + } + + /* remove the last ":" from the outpath, it does not belong there */ + + outpath[strlen(outpath)-1] = 0; + +#else + + /* + Default Unix case. + + Nothing special to do here + */ + + strcpy(outpath,buff); + +#endif + + return(*status); +} + +/****************************************************************************/ +int fits_get_cwd(char *cwd, /* IO current working directory string */ + int *status) + /* + retrieve the string containing the current working directory absolute + path in Unix-like URL standard notation. It is assumed that the CWD + string has a size of at least FLEN_FILENAME. + + Note that this process is platform dependent. This + function supports Unix, MSDOS/WIN32, VMS and Macintosh platforms. Each + platform dependent code segment is conditionally compiled depending + upon the setting of the appropriate C preprocesser macros. + */ +{ + + char buff[FLEN_FILENAME]; + + + if(*status != 0) return(*status); + +#if defined(macintosh) + + /* + MacOS case. Currently unknown !!!! + */ + + *buff = 0; + +#else + /* + Good old getcwd() seems to work with all other platforms + */ + + getcwd(buff,FLEN_FILENAME); + +#endif + + /* + convert the cwd string to a URL standard path string + */ + + fits_path2url(buff,cwd,status); + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int fits_get_url(fitsfile *fptr, /* I ptr to FITS file to evaluate */ + char *realURL, /* O URL of real FITS file */ + char *startURL, /* O URL of starting FITS file */ + char *realAccess, /* O true access method of FITS file */ + char *startAccess,/* O "official" access of FITS file */ + int *iostate, /* O can this file be modified? */ + int *status) +/* + For grouping convention purposes, determine the URL of the FITS file + associated with the fitsfile pointer fptr. The true access type (file://, + mem://, shmem://, root://), starting "official" access type, and iostate + (0 ==> readonly, 1 ==> readwrite) are also returned. + + It is assumed that the url string has enough room to hold the resulting + URL, and the the accessType string has enough room to hold the access type. +*/ +{ + int i; + int tmpIOstate = 0; + + char infile[FLEN_FILENAME]; + char outfile[FLEN_FILENAME]; + char tmpStr1[FLEN_FILENAME]; + char tmpStr2[FLEN_FILENAME]; + char tmpStr3[FLEN_FILENAME]; + char tmpStr4[FLEN_FILENAME]; + char *tmpPtr; + + + if(*status != 0) return(*status); + + do + { + /* + retrieve the member HDU's file name as opened by ffopen() + and parse it into its constitutent pieces; get the currently + active driver token too + */ + + *tmpStr1 = *tmpStr2 = *tmpStr3 = *tmpStr4 = 0; + + *status = fits_file_name(fptr,tmpStr1,status); + + *status = ffiurl(tmpStr1,NULL,infile,outfile,NULL,tmpStr2,tmpStr3, + tmpStr4,status); + + if((*tmpStr2) || (*tmpStr3) || (*tmpStr4)) tmpIOstate = -1; + + *status = ffurlt(fptr,tmpStr3,status); + + strcpy(tmpStr4,tmpStr3); + + *status = ffrtnm(tmpStr1,tmpStr2,status); + strcpy(tmpStr1,tmpStr2); + + /* + for grouping convention purposes (only) determine the URL of the + actual FITS file being used for the given fptr, its true access + type (file://, mem://, shmem://, root://) and its iostate (0 ==> + read only, 1 ==> readwrite) + */ + + /* + The first set of access types are "simple" in that they do not + use any redirection to temporary memory or outfiles + */ + + /* standard disk file driver is in use */ + + if(strcasecmp(tmpStr3,"file://") == 0) + { + tmpIOstate = 1; + + if(strlen(outfile)) strcpy(tmpStr1,outfile); + else *tmpStr2 = 0; + + /* + make sure no FILE:// specifier is given in the tmpStr1 + or tmpStr2 strings; the convention calls for local files + to have no access specification + */ + + if((tmpPtr = strstr(tmpStr1,"://")) != NULL) + { + strcpy(infile,tmpPtr+3); + strcpy(tmpStr1,infile); + } + + if((tmpPtr = strstr(tmpStr2,"://")) != NULL) + { + strcpy(infile,tmpPtr+3); + strcpy(tmpStr2,infile); + } + } + + /* file stored in conventional memory */ + + else if(strcasecmp(tmpStr3,"mem://") == 0) + { + if(tmpIOstate < 0) + { + /* file is a temp mem file only */ + ffpmsg("cannot make URL from temp MEM:// file (fits_get_url)"); + *status = URL_PARSE_ERROR; + } + else + { + /* file is a "perminate" mem file for this process */ + tmpIOstate = 1; + *tmpStr2 = 0; + } + } + + /* file stored in conventional memory */ + + else if(strcasecmp(tmpStr3,"memkeep://") == 0) + { + strcpy(tmpStr3,"mem://"); + *tmpStr4 = 0; + *tmpStr2 = 0; + tmpIOstate = 1; + } + + /* file residing in shared memory */ + + else if(strcasecmp(tmpStr3,"shmem://") == 0) + { + *tmpStr4 = 0; + *tmpStr2 = 0; + tmpIOstate = 1; + } + + /* file accessed via the ROOT network protocol */ + + else if(strcasecmp(tmpStr3,"root://") == 0) + { + *tmpStr4 = 0; + *tmpStr2 = 0; + tmpIOstate = 1; + } + + /* + the next set of access types redirect the contents of the original + file to an special outfile because the original could not be + directly modified (i.e., resides on the network, was compressed). + In these cases the URL string takes on the value of the OUTFILE, + the access type becomes file://, and the iostate is set to 1 (can + read/write to the file). + */ + + /* compressed file uncompressed and written to disk */ + + else if(strcasecmp(tmpStr3,"compressfile://") == 0) + { + strcpy(tmpStr1,outfile); + strcpy(tmpStr2,infile); + strcpy(tmpStr3,"file://"); + strcpy(tmpStr4,"file://"); + tmpIOstate = 1; + } + + /* HTTP accessed file written locally to disk */ + + else if(strcasecmp(tmpStr3,"httpfile://") == 0) + { + strcpy(tmpStr1,outfile); + strcpy(tmpStr3,"file://"); + strcpy(tmpStr4,"http://"); + tmpIOstate = 1; + } + + /* FTP accessd file written locally to disk */ + + else if(strcasecmp(tmpStr3,"ftpfile://") == 0) + { + strcpy(tmpStr1,outfile); + strcpy(tmpStr3,"file://"); + strcpy(tmpStr4,"ftp://"); + tmpIOstate = 1; + } + + /* file from STDIN written to disk */ + + else if(strcasecmp(tmpStr3,"stdinfile://") == 0) + { + strcpy(tmpStr1,outfile); + strcpy(tmpStr3,"file://"); + strcpy(tmpStr4,"stdin://"); + tmpIOstate = 1; + } + + /* + the following access types use memory resident files as temporary + storage; they cannot be modified or be made group members for + grouping conventions purposes, but their original files can be. + Thus, their tmpStr3s are reset to mem://, their iostate + values are set to 0 (for no-modification), and their URL string + values remain set to their original values + */ + + /* compressed disk file uncompressed into memory */ + + else if(strcasecmp(tmpStr3,"compress://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr2,infile); + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"file://"); + tmpIOstate = 0; + } + + /* HTTP accessed file transferred into memory */ + + else if(strcasecmp(tmpStr3,"http://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"http://"); + tmpIOstate = 0; + } + + /* HTTP accessed compressed file transferred into memory */ + + else if(strcasecmp(tmpStr3,"httpcompress://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"http://"); + tmpIOstate = 0; + } + + /* FTP accessed file transferred into memory */ + + else if(strcasecmp(tmpStr3,"ftp://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"ftp://"); + tmpIOstate = 0; + } + + /* FTP accessed compressed file transferred into memory */ + + else if(strcasecmp(tmpStr3,"ftpcompress://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"ftp://"); + tmpIOstate = 0; + } + + /* + The last set of access types cannot be used to make a meaningful URL + strings from; thus an error is generated + */ + + else if(strcasecmp(tmpStr3,"stdin://") == 0) + { + *status = URL_PARSE_ERROR; + ffpmsg("cannot make vaild URL from stdin:// (fits_get_url)"); + *tmpStr1 = *tmpStr2 = 0; + } + + else if(strcasecmp(tmpStr3,"stdout://") == 0) + { + *status = URL_PARSE_ERROR; + ffpmsg("cannot make vaild URL from stdout:// (fits_get_url)"); + *tmpStr1 = *tmpStr2 = 0; + } + + else if(strcasecmp(tmpStr3,"irafmem://") == 0) + { + *status = URL_PARSE_ERROR; + ffpmsg("cannot make vaild URL from irafmem:// (fits_get_url)"); + *tmpStr1 = *tmpStr2 = 0; + } + + if(*status != 0) continue; + + /* + assign values to the calling parameters if they are non-NULL + */ + + if(realURL != NULL) + { + if(strlen(tmpStr1) == 0) + *realURL = 0; + else + { + if((tmpPtr = strstr(tmpStr1,"://")) != NULL) + { + tmpPtr += 3; + i = (long)tmpPtr - (long)tmpStr1; + strncpy(realURL,tmpStr1,i); + } + else + { + tmpPtr = tmpStr1; + i = 0; + } + + *status = fits_path2url(tmpPtr,realURL+i,status); + } + } + + if(startURL != NULL) + { + if(strlen(tmpStr2) == 0) + *startURL = 0; + else + { + if((tmpPtr = strstr(tmpStr2,"://")) != NULL) + { + tmpPtr += 3; + i = (long)tmpPtr - (long)tmpStr2; + strncpy(startURL,tmpStr2,i); + } + else + { + tmpPtr = tmpStr2; + i = 0; + } + + *status = fits_path2url(tmpPtr,startURL+i,status); + } + } + + if(realAccess != NULL) strcpy(realAccess,tmpStr3); + if(startAccess != NULL) strcpy(startAccess,tmpStr4); + if(iostate != NULL) *iostate = tmpIOstate; + + }while(0); + + return(*status); +} + +/*-------------------------------------------------------------------------- + URL parse support functions + --------------------------------------------------------------------------*/ + +/* simple push/pop/shift/unshift string stack for use by fits_clean_url */ +typedef char* grp_stack_data; /* type of data held by grp_stack */ + +typedef struct grp_stack_item_struct { + grp_stack_data data; /* value of this stack item */ + struct grp_stack_item_struct* next; /* next stack item */ + struct grp_stack_item_struct* prev; /* previous stack item */ +} grp_stack_item; + +typedef struct grp_stack_struct { + size_t stack_size; /* number of items on stack */ + grp_stack_item* top; /* top item */ +} grp_stack; + +static char* grp_stack_default = NULL; /* initial value for new instances + of grp_stack_data */ + +/* the following functions implement the group string stack grp_stack */ +static void delete_grp_stack(grp_stack** mystack); +static grp_stack_item* grp_stack_append( + grp_stack_item* last, grp_stack_data data +); +static grp_stack_data grp_stack_remove(grp_stack_item* last); +static grp_stack* new_grp_stack(void); +static grp_stack_data pop_grp_stack(grp_stack* mystack); +static void push_grp_stack(grp_stack* mystack, grp_stack_data data); +static grp_stack_data shift_grp_stack(grp_stack* mystack); +/* static void unshift_grp_stack(grp_stack* mystack, grp_stack_data data); */ + +int fits_clean_url(char *inURL, /* I input URL string */ + char *outURL, /* O output URL string */ + int *status) +/* + clean the URL by eliminating any ".." or "." specifiers in the inURL + string, and write the output to the outURL string. + + Note that this function must have a valid Unix-style URL as input; platform + dependent path strings are not allowed. + */ +{ + grp_stack* mystack; /* stack to hold pieces of URL */ + char* tmp; + + if(*status) return *status; + + mystack = new_grp_stack(); + *outURL = 0; + + do { + /* handle URL scheme and domain if they exist */ + tmp = strstr(inURL, "://"); + if(tmp) { + /* there is a URL scheme, so look for the end of the domain too */ + tmp = strchr(tmp + 3, '/'); + if(tmp) { + /* tmp is now the end of the domain, so + * copy URL scheme and domain as is, and terminate by hand */ + size_t string_size = (size_t) (tmp - inURL); + strncpy(outURL, inURL, string_size); + outURL[string_size] = 0; + + /* now advance the input pointer to just after the domain and go on */ + inURL = tmp; + } else { + /* '/' was not found, which means there are no path-like + * portions, so copy whole inURL to outURL and we're done */ + strcpy(outURL, inURL); + continue; /* while(0) */ + } + } + + /* explicitly copy a leading / (absolute path) */ + if('/' == *inURL) strcat(outURL, "/"); + + /* now clean the remainder of the inURL. push URL segments onto + * stack, dealing with .. and . as we go */ + tmp = strtok(inURL, "/"); /* finds first / */ + while(tmp) { + if(!strcmp(tmp, "..")) { + /* discard previous URL segment, if there was one. if not, + * add the .. to the stack if this is *not* an absolute path + * (for absolute paths, leading .. has no effect, so skip it) */ + if(0 < mystack->stack_size) pop_grp_stack(mystack); + else if('/' != *inURL) push_grp_stack(mystack, tmp); + } else { + /* always just skip ., but otherwise add segment to stack */ + if(strcmp(tmp, ".")) push_grp_stack(mystack, tmp); + } + tmp = strtok(NULL, "/"); /* get the next segment */ + } + + /* stack now has pieces of cleaned URL, so just catenate them + * onto output string until stack is empty */ + while(0 < mystack->stack_size) { + tmp = shift_grp_stack(mystack); + strcat(outURL, tmp); + strcat(outURL, "/"); + } + outURL[strlen(outURL) - 1] = 0; /* blank out trailing / */ + } while(0); + delete_grp_stack(&mystack); + return *status; +} + +/* free all stack contents using pop_grp_stack before freeing the + * grp_stack itself */ +static void delete_grp_stack(grp_stack** mystack) { + if(!mystack || !*mystack) return; + while((*mystack)->stack_size) pop_grp_stack(*mystack); + free(*mystack); + *mystack = NULL; +} + +/* append an item to the stack, handling the special case of the first + * item appended */ +static grp_stack_item* grp_stack_append( + grp_stack_item* last, grp_stack_data data +) { + /* first create a new stack item, and copy data to it */ + grp_stack_item* new_item = (grp_stack_item*) malloc(sizeof(grp_stack_item)); + new_item->data = data; + if(last) { + /* attach this item between the "last" item and its "next" item */ + new_item->next = last->next; + new_item->prev = last; + last->next->prev = new_item; + last->next = new_item; + } else { + /* stack is empty, so "next" and "previous" both point back to it */ + new_item->next = new_item; + new_item->prev = new_item; + } + return new_item; +} + +/* remove an item from the stack, handling the special case of the last + * item removed */ +static grp_stack_data grp_stack_remove(grp_stack_item* last) { + grp_stack_data retval = last->data; + last->prev->next = last->next; + last->next->prev = last->prev; + free(last); + return retval; +} + +/* create new stack dynamically, and give it valid initial values */ +static grp_stack* new_grp_stack(void) { + grp_stack* retval = (grp_stack*) malloc(sizeof(grp_stack)); + if(retval) { + retval->stack_size = 0; + retval->top = NULL; + } + return retval; +} + +/* return the value at the top of the stack and remove it, updating + * stack_size. top->prev becomes the new "top" */ +static grp_stack_data pop_grp_stack(grp_stack* mystack) { + grp_stack_data retval = grp_stack_default; + if(mystack && mystack->top) { + grp_stack_item* newtop = mystack->top->prev; + retval = grp_stack_remove(mystack->top); + mystack->top = newtop; + if(0 == --mystack->stack_size) mystack->top = NULL; + } + return retval; +} + +/* add to the stack after the top element. the added element becomes + * the new "top" */ +static void push_grp_stack(grp_stack* mystack, grp_stack_data data) { + if(!mystack) return; + mystack->top = grp_stack_append(mystack->top, data); + ++mystack->stack_size; + return; +} + +/* return the value at the bottom of the stack and remove it, updating + * stack_size. "top" pointer is unaffected */ +static grp_stack_data shift_grp_stack(grp_stack* mystack) { + grp_stack_data retval = grp_stack_default; + if(mystack && mystack->top) { + retval = grp_stack_remove(mystack->top->next); /* top->next == bottom */ + if(0 == --mystack->stack_size) mystack->top = NULL; + } + return retval; +} + +/* add to the stack after the top element. "top" is unaffected, except + * in the special case of an initially empty stack */ +/* static void unshift_grp_stack(grp_stack* mystack, grp_stack_data data) { + if(!mystack) return; + if(mystack->top) grp_stack_append(mystack->top, data); + else mystack->top = grp_stack_append(NULL, data); + ++mystack->stack_size; + return; + } */ + +/*--------------------------------------------------------------------------*/ +int fits_url2relurl(char *refURL, /* I reference URL string */ + char *absURL, /* I absoulute URL string to process */ + char *relURL, /* O resulting relative URL string */ + int *status) +/* + create a relative URL to the file referenced by absURL with respect to the + reference URL refURL. The relative URL is returned in relURL. + + Both refURL and absURL must be absolute URL strings; i.e. either begin + with an access method specification "XXX://" or with a '/' character + signifiying that they are absolute file paths. + + Note that it is possible to make a relative URL from two input URLs + (absURL and refURL) that are not compatable. This function does not + check to see if the resulting relative URL makes any sence. For instance, + it is impossible to make a relative URL from the following two inputs: + + absURL = ftp://a.b.c.com/x/y/z/foo.fits + refURL = /a/b/c/ttt.fits + + The resulting relURL will be: + + ../../../ftp://a.b.c.com/x/y/z/foo.fits + + Which is syntically correct but meaningless. The problem is that a file + with an access method of ftp:// cannot be expressed a a relative URL to + a local disk file. +*/ + +{ + int i,j; + int refcount,abscount; + int refsize,abssize; + int done; + + + if(*status != 0) return(*status); + + do + { + /* + refURL and absURL must be absolute to process + */ + + if(!(fits_is_url_absolute(refURL) || *refURL == '/') || + !(fits_is_url_absolute(absURL) || *absURL == '/')) + { + *status = URL_PARSE_ERROR; + ffpmsg("Cannot make rel. URL from non abs. URLs (fits_url2relurl)"); + continue; + } + + /* determine the size of the refURL and absURL strings */ + + refsize = strlen(refURL); + abssize = strlen(absURL); + + /* process the two URL strings and build the relative URL between them */ + + + for(done = 0, refcount = 0, abscount = 0; + !done && refcount < refsize && abscount < abssize; + ++refcount, ++abscount) + { + for(; abscount < abssize && absURL[abscount] == '/'; ++abscount); + for(; refcount < refsize && refURL[refcount] == '/'; ++refcount); + + /* find the next path segment in absURL */ + for(i = abscount; absURL[i] != '/' && i < abssize; ++i); + + /* find the next path segment in refURL */ + for(j = refcount; refURL[j] != '/' && j < refsize; ++j); + + /* do the two path segments match? */ + if(i == j && + strncmp(absURL+abscount, refURL+refcount,i-refcount) == 0) + { + /* they match, so ignore them and continue */ + abscount = i; refcount = j; + continue; + } + + /* we found a difference in the paths in refURL and absURL */ + + /* initialize the relative URL string */ + relURL[0] = 0; + + /* + for every path segment remaining in the refURL string, append + a "../" path segment to the relataive URL relURL + */ + + for(j = refcount; j < refsize; ++j) + if(refURL[j] == '/') strcat(relURL,"../"); + + /* copy all remaining characters of absURL to the output relURL */ + + strcat(relURL,absURL+abscount); + + /* we are done building the relative URL */ + done = 1; + } + + }while(0); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_relurl2url(char *refURL, /* I reference URL string */ + char *relURL, /* I relative URL string to process */ + char *absURL, /* O absolute URL string */ + int *status) +/* + create an absolute URL from a relative url and a reference URL. The + reference URL is given by the FITS file pointed to by fptr. + + The construction of the absolute URL from the partial and reference URl + is performed using the rules set forth in: + + http://www.w3.org/Addressing/URL/URL_TOC.html + and + http://www.w3.org/Addressing/URL/4_3_Partial.html + + Note that the relative URL string relURL must conform to the Unix-like + URL syntax; host dependent partial URL strings are not allowed. +*/ +{ + int i; + + char tmpStr[FLEN_FILENAME]; + + char *tmpStr1, *tmpStr2; + + + if(*status != 0) return(*status); + + do + { + + /* + make a copy of the reference URL string refURL for parsing purposes + */ + + strcpy(tmpStr,refURL); + + /* + if the reference file has an access method of mem:// or shmem:// + then we cannot use it as the basis of an absolute URL construction + for a partial URL + */ + + if(strncasecmp(tmpStr,"MEM:",4) == 0 || + strncasecmp(tmpStr,"SHMEM:",6) == 0) + { + ffpmsg("ref URL has access mem:// or shmem:// (fits_relurl2url)"); + ffpmsg(" cannot construct full URL from a partial URL and "); + ffpmsg(" MEM/SHMEM base URL"); + *status = URL_PARSE_ERROR; + continue; + } + + if(relURL[0] != '/') + { + /* + just append the relative URL string to the reference URL + string (minus the reference URL file name) to form the + absolute URL string + */ + + tmpStr1 = strrchr(tmpStr,'/'); + + if(tmpStr1 != NULL) tmpStr1[1] = 0; + else tmpStr[0] = 0; + + strcat(tmpStr,relURL); + } + else + { + /* + have to parse the refURL string for the first occurnace of the + same number of '/' characters as contained in the beginning of + location that is not followed by a greater number of consective + '/' charaters (yes, that is a confusing statement); this is the + location in the refURL string where the relURL string is to + be appended to form the new absolute URL string + */ + + /* + first, build up a slash pattern string that has one more + slash in it than the starting slash pattern of the + relURL string + */ + + strcpy(absURL,"/"); + + for(i = 0; relURL[i] == '/'; ++i) strcat(absURL,"/"); + + /* + loop over the refURL string until the slash pattern stored + in absURL is no longer found + */ + + for(tmpStr1 = tmpStr, i = strlen(absURL); + (tmpStr2 = strstr(tmpStr1,absURL)) != NULL; + tmpStr1 = tmpStr2 + i); + + /* reduce the slash pattern string by one slash */ + + absURL[i-1] = 0; + + /* + search for the slash pattern in the remaining portion + of the refURL string + */ + + tmpStr2 = strstr(tmpStr1,absURL); + + /* if no slash pattern match was found */ + + if(tmpStr2 == NULL) + { + /* just strip off the file name from the refURL */ + + tmpStr2 = strrchr(tmpStr1,'/'); + + if(tmpStr2 != NULL) tmpStr2[0] = 0; + else tmpStr[0] = 0; + } + else + { + /* set a string terminator at the slash pattern match */ + + *tmpStr2 = 0; + } + + /* + conatenate the relURL string to the refURL string to form + the absURL + */ + + strcat(tmpStr,relURL); + } + + /* + normalize the absURL by removing any ".." or "." specifiers + in the string + */ + + *status = fits_clean_url(tmpStr,absURL,status); + + }while(0); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_encode_url(char *inpath, /* I URL to be encoded */ + char *outpath, /* O output encoded URL */ + int *status) + /* + encode all URL "unsafe" and "reserved" characters using the "%XX" + convention, where XX stand for the two hexidecimal digits of the + encode character's ASCII code. + + Note that the output path is at least as large as, if not larger than + the input path, so that OUTPATH should be passed to this function + with room for growth. If not a runtime error could result. It is + assumed that OUTPATH has been allocated with enough room to hold + the resulting encoded URL. + + This function was adopted from code in the libwww.a library available + via the W3 consortium + */ +{ + unsigned char a; + + char *p; + char *q; + char *hex = "0123456789ABCDEF"; + +unsigned const char isAcceptable[96] = +{/* 0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF */ + + 0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0,0xF,0xE,0x0,0xF,0xF,0xC, + /* 2x !"#$%&'()*+,-./ */ + 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0x8,0x0,0x0,0x0,0x0,0x0, + /* 3x 0123456789:;<=>? */ + 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF, + /* 4x @ABCDEFGHIJKLMNO */ + 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0x0,0x0,0x0,0x0,0xF, + /* 5X PQRSTUVWXYZ[\]^_ */ + 0x0,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF, + /* 6x `abcdefghijklmno */ + 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0x0,0x0,0x0,0x0,0x0 + /* 7X pqrstuvwxyz{\}~DEL */ +}; + + if(*status != 0) return(*status); + + /* loop over all characters in inpath until '\0' is encountered */ + + for(q = outpath, p = inpath; *p; p++) + { + a = (unsigned char)*p; + + /* if the charcter requires encoding then process it */ + + if(!( a>=32 && a<128 && (isAcceptable[a-32]))) + { + /* add a '%' character to the outpath */ + *q++ = HEX_ESCAPE; + /* add the most significant ASCII code hex value */ + *q++ = hex[a >> 4]; + /* add the least significant ASCII code hex value */ + *q++ = hex[a & 15]; + } + /* else just copy the character as is */ + else *q++ = *p; + } + + /* null terminate the outpath string */ + + *q++ = 0; + + return(*status); +} + +/*---------------------------------------------------------------------------*/ +int fits_unencode_url(char *inpath, /* I input URL with encoding */ + char *outpath, /* O unencoded URL */ + int *status) + /* + unencode all URL "unsafe" and "reserved" characters to their actual + ASCII representation. All tokens of the form "%XX" where XX is the + hexidecimal code for an ASCII character, are searched for and + translated into the actuall ASCII character (so three chars become + 1 char). + + It is assumed that OUTPATH has enough room to hold the unencoded + URL. + + This function was adopted from code in the libwww.a library available + via the W3 consortium + */ + +{ + char *p; + char *q; + char c; + + if(*status != 0) return(*status); + + p = inpath; + q = outpath; + + /* + loop over all characters in the inpath looking for the '%' escape + character; if found the process the escape sequence + */ + + while(*p != 0) + { + /* + if the character is '%' then unencode the sequence, else + just copy the character from inpath to outpath + */ + + if (*p == HEX_ESCAPE) + { + if((c = *(++p)) != 0) + { + *q = ( + (c >= '0' && c <= '9') ? + (c - '0') : ((c >= 'A' && c <= 'F') ? + (c - 'A' + 10) : (c - 'a' + 10)) + )*16; + + if((c = *(++p)) != 0) + { + *q = *q + ( + (c >= '0' && c <= '9') ? + (c - '0') : ((c >= 'A' && c <= 'F') ? + (c - 'A' + 10) : (c - 'a' + 10)) + ); + p++, q++; + } + } + } + else + *q++ = *p++; + } + + /* terminate the outpath */ + *q = 0; + + return(*status); +} +/*---------------------------------------------------------------------------*/ + +int fits_is_url_absolute(char *url) +/* + Return a True (1) or False (0) value indicating whether or not the passed + URL string contains an access method specifier or not. Note that this is + a boolean function and it neither reads nor returns the standard error + status parameter +*/ +{ + char *tmpStr1, *tmpStr2; + + char reserved[] = {':',';','/','?','@','&','=','+','$',','}; + + /* + The rule for determing if an URL is relative or absolute is that it (1) + must have a colon ":" and (2) that the colon must appear before any other + reserved URL character in the URL string. We first see if a colon exists, + get its position in the string, and then check to see if any of the other + reserved characters exists and if their position in the string is greater + than that of the colons. + */ + + if( (tmpStr1 = strchr(url,reserved[0])) != NULL && + ((tmpStr2 = strchr(url,reserved[1])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[2])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[3])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[4])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[5])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[6])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[7])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[8])) == NULL || tmpStr2 > tmpStr1) && + ((tmpStr2 = strchr(url,reserved[9])) == NULL || tmpStr2 > tmpStr1) ) + { + return(1); + } + else + { + return(0); + } +} diff --git a/pkg/tbtables/cfitsio/group.h b/pkg/tbtables/cfitsio/group.h new file mode 100644 index 00000000..f7aae5b1 --- /dev/null +++ b/pkg/tbtables/cfitsio/group.h @@ -0,0 +1,65 @@ +#define MAX_HDU_TRACKER 1000 + +typedef struct _HDUtracker HDUtracker; + +struct _HDUtracker +{ + int nHDU; + + char *filename[MAX_HDU_TRACKER]; + int position[MAX_HDU_TRACKER]; + + char *newFilename[MAX_HDU_TRACKER]; + int newPosition[MAX_HDU_TRACKER]; +}; + +/* functions used internally in the grouping convention module */ + +int ffgtdc(int grouptype, int xtensioncol, int extnamecol, int extvercol, + int positioncol, int locationcol, int uricol, char *ttype[], + char *tform[], int *ncols, int *status); + +int ffgtgc(fitsfile *gfptr, int *xtensionCol, int *extnameCol, int *extverCol, + int *positionCol, int *locationCol, int *uriCol, int *grptype, + int *status); + +int ffgmul(fitsfile *mfptr, int rmopt, int *status); + +int ffgmf(fitsfile *gfptr, char *xtension, char *extname, int extver, + int position, char *location, long *member, int *status); + +int ffgtrmr(fitsfile *gfptr, HDUtracker *HDU, int *status); + +int ffgtcpr(fitsfile *infptr, fitsfile *outfptr, int cpopt, HDUtracker *HDU, + int *status); + +int fftsad(fitsfile *mfptr, HDUtracker *HDU, int *newPosition, + char *newFileName); + +int fftsud(fitsfile *mfptr, HDUtracker *HDU, int newPosition, + char *newFileName); + +void prepare_keyvalue(char *keyvalue); + +int fits_path2url(char *inpath, char *outpath, int *status); + +int fits_url2path(char *inpath, char *outpath, int *status); + +int fits_get_cwd(char *cwd, int *status); + +int fits_get_url(fitsfile *fptr, char *realURL, char *startURL, + char *realAccess, char *startAccess, int *iostate, + int *status); + +int fits_clean_url(char *inURL, char *outURL, int *status); + +int fits_relurl2url(char *refURL, char *relURL, char *absURL, int *status); + +int fits_url2relurl(char *refURL, char *absURL, char *relURL, int *status); + +int fits_encode_url(char *inpath, char *outpath, int *status); + +int fits_unencode_url(char *inpath, char *outpath, int *status); + +int fits_is_url_absolute(char *url); + diff --git a/pkg/tbtables/cfitsio/grparser.c b/pkg/tbtables/cfitsio/grparser.c new file mode 100644 index 00000000..d21c098a --- /dev/null +++ b/pkg/tbtables/cfitsio/grparser.c @@ -0,0 +1,1365 @@ +/* T E M P L A T E P A R S E R + ============================= + + by Jerzy.Borkowski@obs.unige.ch + + Integral Science Data Center + ch. d'Ecogia 16 + 1290 Versoix + Switzerland + +14-Oct-98: initial release +16-Oct-98: code cleanup, #include included, now gcc -Wall prints no + warnings during compilation. Bugfix: now one can specify additional + columns in group HDU. Autoindexing also works in this situation + (colunms are number from 7 however). +17-Oct-98: bugfix: complex keywords were incorrectly written (was TCOMPLEX should + be TDBLCOMPLEX). +20-Oct-98: bugfix: parser was writing EXTNAME twice, when first HDU in template is + defined with XTENSION IMAGE then parser creates now dummy PHDU, + SIMPLE T is now allowed only at most once and in first HDU only. + WARNING: one should not define EXTNAME keyword for GROUP HDUs, as + they have them already defined by parser (EXTNAME = GROUPING). + Parser accepts EXTNAME oin GROUP HDU definition, but in this + case multiple EXTNAME keywords will present in HDU header. +23-Oct-98: bugfix: unnecessary space was written to FITS file for blank + keywords. +24-Oct-98: syntax change: empty lines and lines with only whitespaces are + written to FITS files as blank keywords (if inside group/hdu + definition). Previously lines had to have at least 8 spaces. + Please note, that due to pecularities of CFITSIO if the + last keyword(s) defined for given HDU are blank keywords + consisting of only 80 spaces, then (some of) those keywords + may be silently deleted by CFITSIO. +13-Nov-98: bugfix: parser was writing GRPNAME twice. Parser still creates + GRPNAME keywords for GROUP HDU's which do not specify them. + However, values (of form DEFAULT_GROUP_XXX) are assigned + not necessarily in order HDUs appear in template file, but + rather in order parser completes their creation in FITS + file. Also, when including files, if fopen fails, parser + tries to open file with a name = directory_of_top_level + file + name of file to be included, as long as name + of file to be included does not specify absolute pathname. +16-Nov-98: bugfix to bugfix from 13-Nov-98 +19-Nov-98: EXTVER keyword is now automatically assigned value by parser. +17-Dev-98: 2 new things added: 1st: CFITSIO_INCLUDE_FILES environment + variable can contain a colon separated list of directories + to look for when looking for template include files (and master + template also). 2nd: it is now possible to append template + to nonempty FITS. file. fitsfile *ff no longer needs to point + to an empty FITS file with 0 HDUs in it. All data written by + parser will simple be appended at the end of file. +22-Jan-99: changes to parser: when in append mode parser initially scans all + existing HDUs to built a list of already used EXTNAME/EXTVERs +22-Jan-99: Bruce O'Neel, bugfix : TLONG should always reference long type + variable on OSF/Alpha and on 64-bit archs in general +20-Jun-2002 Wm Pence, added support for the HIERARCH keyword convention in + which keyword names can effectively be longer than 8 characters. + Example: + HIERARCH LongKeywordName = 'value' / comment +30-Jan-2003 Wm Pence, bugfix: ngp_read_xtension was testing for "ASCIITABLE" + instead of "TABLE" as the XTENSION value of an ASCII table, + and it did not allow for optional trailing spaces in the + "IMAGE" or "TABLE" string. +16-Dec-2003 James Peachey: ngp_keyword_all_write was modified to apply + comments from the template file to the output file in + the case of reserved keywords (e.g. tform#, ttype# etcetera). +*/ + + +#include +#include + +#ifdef sparc +#include +#include +#endif + +#include +#include "fitsio.h" +#include "grparser.h" + +NGP_RAW_LINE ngp_curline = { NULL, NULL, NULL, NGP_TTYPE_UNKNOWN, NULL, NGP_FORMAT_OK, 0 }; +NGP_RAW_LINE ngp_prevline = { NULL, NULL, NULL, NGP_TTYPE_UNKNOWN, NULL, NGP_FORMAT_OK, 0 }; + +int ngp_inclevel = 0; /* number of included files, 1 - means mean file */ +int ngp_grplevel = 0; /* group nesting level, 0 - means no grouping */ + +FILE *ngp_fp[NGP_MAX_INCLUDE]; /* stack of included file handles */ +int ngp_keyidx = NGP_TOKEN_UNKNOWN; /* index of token in current line */ +NGP_TOKEN ngp_linkey; /* keyword after line analyze */ + +char ngp_master_dir[NGP_MAX_FNAME]; /* directory of top level include file */ + +NGP_TKDEF ngp_tkdef[] = /* tokens recognized by parser */ + { { "\\INCLUDE", NGP_TOKEN_INCLUDE }, + { "\\GROUP", NGP_TOKEN_GROUP }, + { "\\END", NGP_TOKEN_END }, + { "XTENSION", NGP_TOKEN_XTENSION }, + { "SIMPLE", NGP_TOKEN_SIMPLE }, + { NULL, NGP_TOKEN_UNKNOWN } + }; + +int master_grp_idx = 1; /* current unnamed group in object */ + +int ngp_extver_tab_size = 0; +NGP_EXTVER_TAB *ngp_extver_tab = NULL; + + +int ngp_get_extver(char *extname, int *version) + { NGP_EXTVER_TAB *p; + char *p2; + int i; + + if ((NULL == extname) || (NULL == version)) return(NGP_BAD_ARG); + if ((NULL == ngp_extver_tab) && (ngp_extver_tab_size > 0)) return(NGP_BAD_ARG); + if ((NULL != ngp_extver_tab) && (ngp_extver_tab_size <= 0)) return(NGP_BAD_ARG); + + for (i=0; i 0)) return(NGP_BAD_ARG); + if ((NULL != ngp_extver_tab) && (ngp_extver_tab_size <= 0)) return(NGP_BAD_ARG); + + for (i=0; i ngp_extver_tab[i].version) ngp_extver_tab[i].version = version; + return(NGP_OK); + } + } + + if (NULL == ngp_extver_tab) + { p = (NGP_EXTVER_TAB *)ngp_alloc(sizeof(NGP_EXTVER_TAB)); } + else + { p = (NGP_EXTVER_TAB *)ngp_realloc(ngp_extver_tab, (ngp_extver_tab_size + 1) * sizeof(NGP_EXTVER_TAB)); } + + if (NULL == p) return(NGP_NO_MEMORY); + + p2 = ngp_alloc(strlen(extname) + 1); + if (NULL == p2) + { ngp_free(p); + return(NGP_NO_MEMORY); + } + + strcpy(p2, extname); + ngp_extver_tab = p; + ngp_extver_tab[ngp_extver_tab_size].extname = p2; + ngp_extver_tab[ngp_extver_tab_size].version = version; + + ngp_extver_tab_size++; + + return(NGP_OK); + } + + +int ngp_delete_extver_tab(void) + { int i; + + if ((NULL == ngp_extver_tab) && (ngp_extver_tab_size > 0)) return(NGP_BAD_ARG); + if ((NULL != ngp_extver_tab) && (ngp_extver_tab_size <= 0)) return(NGP_BAD_ARG); + if ((NULL == ngp_extver_tab) && (0 == ngp_extver_tab_size)) return(NGP_OK); + + for (i=0; i= 'a') && (c1 <= 'z')) c1 += ('A' - 'a'); + + c2 = *p2; + if ((c2 >= 'a') && (c2 <= 'z')) c2 += ('A' - 'a'); + + if (c1 < c2) return(-1); + if (c1 > c2) return(1); + if (0 == c1) return(0); + p1++; + p2++; + } + } + +int ngp_strcasencmp(char *p1, char *p2, int n) + { char c1, c2; + int ii; + + for (ii=0;ii= 'a') && (c1 <= 'z')) c1 += ('A' - 'a'); + + c2 = *p2; + if ((c2 >= 'a') && (c2 <= 'z')) c2 += ('A' - 'a'); + + if (c1 < c2) return(-1); + if (c1 > c2) return(1); + if (0 == c1) return(0); + p1++; + p2++; + } + return(0); + } + + /* read one line from file */ + +int ngp_line_from_file(FILE *fp, char **p) + { int c, r, llen, allocsize, alen; + char *p2; + + if (NULL == fp) return(NGP_NUL_PTR); /* check for stupid args */ + if (NULL == p) return(NGP_NUL_PTR); /* more foolproof checks */ + + r = NGP_OK; /* initialize stuff, reset err code */ + llen = 0; /* 0 characters read so far */ + *p = (char *)ngp_alloc(1); /* preallocate 1 byte */ + allocsize = 1; /* signal that we have allocated 1 byte */ + if (NULL == *p) return(NGP_NO_MEMORY); /* if this failed, system is in dire straits */ + + for (;;) + { c = getc(fp); /* get next character */ + if (EOF == c) /* EOF signalled ? */ + { + if (ferror(fp)) r = NGP_READ_ERR; /* was it real error or simply EOF ? */ + if (0 == llen) return(NGP_EOF); /* signal EOF only if 0 characters read so far */ + break; + } + if ('\n' == c) break; /* end of line character ? */ + + llen++; /* we have new character, make room for it */ + alen = ((llen + NGP_ALLOCCHUNK) / NGP_ALLOCCHUNK) * NGP_ALLOCCHUNK; + if (alen > allocsize) + { p2 = (char *)ngp_realloc(*p, alen); /* realloc buffer, if there is need */ + if (NULL == p2) + { r = NGP_NO_MEMORY; + break; + } + *p = p2; + allocsize = alen; + } + (*p)[llen - 1] = c; /* copy character to buffer */ + } + + llen++; /* place for terminating \0 */ + if (llen != allocsize) + { p2 = (char *)ngp_realloc(*p, llen); + if (NULL == p2) r = NGP_NO_MEMORY; + else + { *p = p2; + (*p)[llen - 1] = 0; /* copy \0 to buffer */ + } + } + else + { (*p)[llen - 1] = 0; /* necessary when line read was empty */ + } + + if ((NGP_EOF != r) && (NGP_OK != r)) /* in case of errors free resources */ + { ngp_free(*p); + *p = NULL; + } + + return(r); /* return status code */ + } + + /* free current line structure */ + +int ngp_free_line(void) + { + if (NULL != ngp_curline.line) + { ngp_free(ngp_curline.line); + ngp_curline.line = NULL; + ngp_curline.name = NULL; + ngp_curline.value = NULL; + ngp_curline.comment = NULL; + ngp_curline.type = NGP_TTYPE_UNKNOWN; + ngp_curline.format = NGP_FORMAT_OK; + ngp_curline.flags = 0; + } + return(NGP_OK); + } + + /* free cached line structure */ + +int ngp_free_prevline(void) + { + if (NULL != ngp_prevline.line) + { ngp_free(ngp_prevline.line); + ngp_prevline.line = NULL; + ngp_prevline.name = NULL; + ngp_prevline.value = NULL; + ngp_prevline.comment = NULL; + ngp_prevline.type = NGP_TTYPE_UNKNOWN; + ngp_prevline.format = NGP_FORMAT_OK; + ngp_prevline.flags = 0; + } + return(NGP_OK); + } + + /* read one line */ + +int ngp_read_line_buffered(FILE *fp) + { + ngp_free_line(); /* first free current line (if any) */ + + if (NULL != ngp_prevline.line) /* if cached, return cached line */ + { ngp_curline = ngp_prevline; + ngp_prevline.line = NULL; + ngp_prevline.name = NULL; + ngp_prevline.value = NULL; + ngp_prevline.comment = NULL; + ngp_prevline.type = NGP_TTYPE_UNKNOWN; + ngp_prevline.format = NGP_FORMAT_OK; + ngp_prevline.flags = 0; + ngp_curline.flags = NGP_LINE_REREAD; + return(NGP_OK); + } + + ngp_curline.flags = 0; /* if not cached really read line from file */ + return(ngp_line_from_file(fp, &(ngp_curline.line))); + } + + /* unread line */ + +int ngp_unread_line(void) + { + if (NULL == ngp_curline.line) /* nothing to unread */ + return(NGP_EMPTY_CURLINE); + + if (NULL != ngp_prevline.line) /* we cannot unread line twice */ + return(NGP_UNREAD_QUEUE_FULL); + + ngp_prevline = ngp_curline; + ngp_curline.line = NULL; + return(NGP_OK); + } + + /* a first guess line decomposition */ + +int ngp_extract_tokens(NGP_RAW_LINE *cl) + { char *p, *s; + int cl_flags, i; + + p = cl->line; /* start from beginning of line */ + if (NULL == p) return(NGP_NUL_PTR); + + cl->name = cl->value = cl->comment = NULL; + cl->type = NGP_TTYPE_UNKNOWN; + cl->format = NGP_FORMAT_OK; + + cl_flags = 0; + + for (i=0;; i++) /* if 8 spaces at beginning then line is comment */ + { if ((0 == *p) || ('\n' == *p)) + { /* if line has only blanks -> write blank keyword */ + cl->line[0] = 0; /* create empty name (0 length string) */ + cl->comment = cl->name = cl->line; + cl->type = NGP_TTYPE_RAW; /* signal write unformatted to FITS file */ + return(NGP_OK); + } + if ((' ' != *p) && ('\t' != *p)) break; + if (i >= 7) + { + cl->comment = p + 1; + for (s = cl->comment;; s++) /* filter out any EOS characters in comment */ + { if ('\n' == *s) *s = 0; + if (0 == *s) break; + } + cl->line[0] = 0; /* create empty name (0 length string) */ + cl->name = cl->line; + cl->type = NGP_TTYPE_RAW; + return(NGP_OK); + } + p++; + } + + cl->name = p; + + for (;;) /* we need to find 1st whitespace */ + { if ((0 == *p) || ('\n' == *p)) + { *p = 0; + break; + } + + /* + from Richard Mathar, 2002-05-03, add 10 lines: + if upper/lowercase HIERARCH followed also by an equal sign... + */ + if( strncasecmp("HIERARCH",p,strlen("HIERARCH")) == 0 ) + { + char * const eqsi=strchr(p,'=') ; + if( eqsi ) + { + cl_flags |= NGP_FOUND_EQUAL_SIGN ; + p=eqsi ; + break ; + } + } + + if ((' ' == *p) || ('\t' == *p)) break; + if ('=' == *p) + { cl_flags |= NGP_FOUND_EQUAL_SIGN; + break; + } + + p++; + } + + if (*p) *(p++) = 0; /* found end of keyname so terminate string with zero */ + + if ((!ngp_strcasecmp("HISTORY", cl->name)) + || (!ngp_strcasecmp("COMMENT", cl->name)) + || (!ngp_strcasecmp("CONTINUE", cl->name))) + { cl->comment = p; + for (s = cl->comment;; s++) /* filter out any EOS characters in comment */ + { if ('\n' == *s) *s = 0; + if (0 == *s) break; + } + cl->type = NGP_TTYPE_RAW; + return(NGP_OK); + } + + if (!ngp_strcasecmp("\\INCLUDE", cl->name)) + { + for (;; p++) if ((' ' != *p) && ('\t' != *p)) break; /* skip whitespace */ + + cl->value = p; + for (s = cl->value;; s++) /* filter out any EOS characters */ + { if ('\n' == *s) *s = 0; + if (0 == *s) break; + } + cl->type = NGP_TTYPE_UNKNOWN; + return(NGP_OK); + } + + for (;; p++) + { if ((0 == *p) || ('\n' == *p)) return(NGP_OK); /* test if at end of string */ + if ((' ' == *p) || ('\t' == *p)) continue; /* skip whitespace */ + if (cl_flags & NGP_FOUND_EQUAL_SIGN) break; + if ('=' != *p) break; /* ignore initial equal sign */ + cl_flags |= NGP_FOUND_EQUAL_SIGN; + } + + if ('/' == *p) /* no value specified, comment only */ + { p++; + if ((' ' == *p) || ('\t' == *p)) p++; + cl->comment = p; + for (s = cl->comment;; s++) /* filter out any EOS characters in comment */ + { if ('\n' == *s) *s = 0; + if (0 == *s) break; + } + return(NGP_OK); + } + + if ('\'' == *p) /* we have found string within quotes */ + { cl->value = s = ++p; /* set pointer to beginning of that string */ + cl->type = NGP_TTYPE_STRING; /* signal that it is of string type */ + + for (;;) /* analyze it */ + { if ((0 == *p) || ('\n' == *p)) /* end of line -> end of string */ + { *s = 0; return(NGP_OK); } + + if ('\'' == *p) /* we have found doublequote */ + { if ((0 == p[1]) || ('\n' == p[1]))/* doublequote is the last character in line */ + { *s = 0; return(NGP_OK); } + if (('\t' == p[1]) || (' ' == p[1])) /* duoblequote was string terminator */ + { *s = 0; p++; break; } + if ('\'' == p[1]) p++; /* doublequote is inside string, convert "" -> " */ + } + + *(s++) = *(p++); /* compact string in place, necess. by "" -> " conversion */ + } + } + else /* regular token */ + { + cl->value = p; /* set pointer to token */ + cl->type = NGP_TTYPE_UNKNOWN; /* we dont know type at the moment */ + for (;; p++) /* we need to find 1st whitespace */ + { if ((0 == *p) || ('\n' == *p)) + { *p = 0; return(NGP_OK); } + if ((' ' == *p) || ('\t' == *p)) break; + } + if (*p) *(p++) = 0; /* found so terminate string with zero */ + } + + for (;; p++) + { if ((0 == *p) || ('\n' == *p)) return(NGP_OK); /* test if at end of string */ + if ((' ' != *p) && ('\t' != *p)) break; /* skip whitespace */ + } + + if ('/' == *p) /* no value specified, comment only */ + { p++; + if ((' ' == *p) || ('\t' == *p)) p++; + cl->comment = p; + for (s = cl->comment;; s++) /* filter out any EOS characters in comment */ + { if ('\n' == *s) *s = 0; + if (0 == *s) break; + } + return(NGP_OK); + } + + cl->format = NGP_FORMAT_ERROR; + return(NGP_OK); /* too many tokens ... */ + } + +/* try to open include file. If open fails and fname + does not specify absolute pathname, try to open fname + in any directory specified in CFITSIO_INCLUDE_FILES + environment variable. Finally try to open fname + relative to ngp_master_dir, which is directory of top + level include file +*/ + +int ngp_include_file(char *fname) /* try to open include file */ + { char *p, *p2, *cp, *envar, envfiles[NGP_MAX_ENVFILES]; + + if (NULL == fname) return(NGP_NUL_PTR); + + if (ngp_inclevel >= NGP_MAX_INCLUDE) /* too many include files */ + return(NGP_INC_NESTING); + + if (NULL == (ngp_fp[ngp_inclevel] = fopen(fname, "r"))) + { /* if simple open failed .. */ + envar = getenv("CFITSIO_INCLUDE_FILES"); /* scan env. variable, and retry to open */ + + if (NULL != envar) /* is env. variable defined ? */ + { strncpy(envfiles, envar, NGP_MAX_ENVFILES - 1); + envfiles[NGP_MAX_ENVFILES - 1] = 0; /* copy search path to local variable, env. is fragile */ + + for (p2 = strtok(envfiles, ":"); NULL != p2; p2 = strtok(NULL, ":")) + { + cp = (char *)ngp_alloc(strlen(fname) + strlen(p2) + 2); + if (NULL == cp) return(NGP_NO_MEMORY); + + strcpy(cp, p2); +#ifdef MSDOS + strcat(cp, "\\"); /* abs. pathname for MSDOS */ + +#else + strcat(cp, "/"); /* and for unix */ +#endif + strcat(cp, fname); + + ngp_fp[ngp_inclevel] = fopen(cp, "r"); + ngp_free(cp); + + if (NULL != ngp_fp[ngp_inclevel]) break; + } + } + + if (NULL == ngp_fp[ngp_inclevel]) /* finally try to open relative to top level */ + { +#ifdef MSDOS + if ('\\' == fname[0]) return(NGP_ERR_FOPEN); /* abs. pathname for MSDOS, does not support C:\\PATH */ +#else + if ('/' == fname[0]) return(NGP_ERR_FOPEN); /* and for unix */ +#endif + if (0 == ngp_master_dir[0]) return(NGP_ERR_FOPEN); + + p = ngp_alloc(strlen(fname) + strlen(ngp_master_dir) + 1); + if (NULL == p) return(NGP_NO_MEMORY); + + strcpy(p, ngp_master_dir); /* construct composite pathname */ + strcat(p, fname); /* comp = master + fname */ + + ngp_fp[ngp_inclevel] = fopen(p, "r");/* try to open composite */ + ngp_free(p); /* we don't need buffer anymore */ + + if (NULL == ngp_fp[ngp_inclevel]) + return(NGP_ERR_FOPEN); /* fail if error */ + } + } + + ngp_inclevel++; + return(NGP_OK); + } + + +/* read line in the intelligent way. All \INCLUDE directives are handled, + empty and comment line skipped. If this function returns NGP_OK, than + decomposed line (name, type, value in proper type and comment) are + stored in ngp_linkey structure. ignore_blank_lines parameter is zero + when parser is inside GROUP or HDU definition. Nonzero otherwise. +*/ + +int ngp_read_line(int ignore_blank_lines) + { int r, nc; + unsigned k; + + if (ngp_inclevel <= 0) /* do some sanity checking first */ + { ngp_keyidx = NGP_TOKEN_EOF; /* no parents, so report error */ + return(NGP_OK); + } + if (ngp_inclevel > NGP_MAX_INCLUDE) return(NGP_INC_NESTING); + if (NULL == ngp_fp[ngp_inclevel - 1]) return(NGP_NUL_PTR); + + for (;;) + { switch (r = ngp_read_line_buffered(ngp_fp[ngp_inclevel - 1])) + { case NGP_EOF: + ngp_inclevel--; /* end of file, revert to parent */ + if (ngp_fp[ngp_inclevel]) /* we can close old file */ + fclose(ngp_fp[ngp_inclevel]); + + ngp_fp[ngp_inclevel] = NULL; + if (ngp_inclevel <= 0) + { ngp_keyidx = NGP_TOKEN_EOF; /* no parents, so report error */ + return(NGP_OK); + } + continue; + + case NGP_OK: + if (ngp_curline.flags & NGP_LINE_REREAD) return(r); + break; + default: + return(r); + } + + switch (ngp_curline.line[0]) + { case 0: if (0 == ignore_blank_lines) break; /* ignore empty lines if told so */ + case '#': continue; /* ignore comment lines */ + } + + r = ngp_extract_tokens(&ngp_curline); /* analyse line, extract tokens and comment */ + if (NGP_OK != r) return(r); + + if (NULL == ngp_curline.name) continue; /* skip lines consisting only of whitespaces */ + + for (k = 0; k < strlen(ngp_curline.name); k++) + { if ((ngp_curline.name[k] >= 'a') && (ngp_curline.name[k] <= 'z')) + ngp_curline.name[k] += 'A' - 'a'; /* force keyword to be upper case */ + if (k == 7) break; /* only first 8 chars are required to be upper case */ + } + + for (k=0;; k++) /* find index of keyword in keyword table */ + { if (NGP_TOKEN_UNKNOWN == ngp_tkdef[k].code) break; + if (0 == strcmp(ngp_curline.name, ngp_tkdef[k].name)) break; + } + + ngp_keyidx = ngp_tkdef[k].code; /* save this index, grammar parser will need this */ + + if (NGP_TOKEN_INCLUDE == ngp_keyidx) /* if this is \INCLUDE keyword, try to include file */ + { if (NGP_OK != (r = ngp_include_file(ngp_curline.value))) return(r); + continue; /* and read next line */ + } + + ngp_linkey.type = NGP_TTYPE_UNKNOWN; /* now, get the keyword type, it's a long story ... */ + + if (NULL != ngp_curline.value) /* if no value given signal it */ + { if (NGP_TTYPE_STRING == ngp_curline.type) /* string type test */ + { ngp_linkey.type = NGP_TTYPE_STRING; + ngp_linkey.value.s = ngp_curline.value; + } + if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* bool type test */ + { if ((!ngp_strcasecmp("T", ngp_curline.value)) || (!ngp_strcasecmp("F", ngp_curline.value))) + { ngp_linkey.type = NGP_TTYPE_BOOL; + ngp_linkey.value.b = (ngp_strcasecmp("T", ngp_curline.value) ? 0 : 1); + } + } + if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* complex type test */ + { if (2 == sscanf(ngp_curline.value, "(%lg,%lg)%n", &(ngp_linkey.value.c.re), &(ngp_linkey.value.c.im), &nc)) + { if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc]) + || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc])) + { ngp_linkey.type = NGP_TTYPE_COMPLEX; + } + } + } + if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* real type test */ + { if (strchr(ngp_curline.value, '.') && (1 == sscanf(ngp_curline.value, "%lg%n", &(ngp_linkey.value.d), &nc))) + { if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc]) + || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc])) + { ngp_linkey.type = NGP_TTYPE_REAL; + } + } + } + if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* integer type test */ + { if (1 == sscanf(ngp_curline.value, "%d%n", &(ngp_linkey.value.i), &nc)) + { if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc]) + || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc])) + { ngp_linkey.type = NGP_TTYPE_INT; + } + } + } + if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* force string type */ + { ngp_linkey.type = NGP_TTYPE_STRING; + ngp_linkey.value.s = ngp_curline.value; + } + } + else + { if (NGP_TTYPE_RAW == ngp_curline.type) ngp_linkey.type = NGP_TTYPE_RAW; + else ngp_linkey.type = NGP_TTYPE_NULL; + } + + if (NULL != ngp_curline.comment) + { strncpy(ngp_linkey.comment, ngp_curline.comment, NGP_MAX_COMMENT); /* store comment */ + ngp_linkey.comment[NGP_MAX_COMMENT - 1] = 0; + } + else + { ngp_linkey.comment[0] = 0; + } + + strncpy(ngp_linkey.name, ngp_curline.name, NGP_MAX_NAME); /* and keyword's name */ + ngp_linkey.name[NGP_MAX_NAME - 1] = 0; + + if (strlen(ngp_linkey.name) > FLEN_KEYWORD) /* WDP: 20-Jun-2002: mod to support HIERARCH */ + { + return(NGP_BAD_ARG); /* cfitsio does not allow names > 8 chars */ + } + + return(NGP_OK); /* we have valid non empty line, so return success */ + } + } + + /* check whether keyword can be written as is */ + +int ngp_keyword_is_write(NGP_TOKEN *ngp_tok) + { int i, j, r, l, spc; + /* indexed variables not to write */ + + static char *nm[] = { "NAXIS", "TFORM", "TTYPE", NULL } ; + + /* non indexed variables not allowed to write */ + + static char *nmni[] = { "SIMPLE", "XTENSION", "BITPIX", "NAXIS", "PCOUNT", + "GCOUNT", "TFIELDS", "THEAP", "EXTEND", "EXTVER", + NULL } ; + + if (NULL == ngp_tok) return(NGP_NUL_PTR); + r = NGP_OK; + + for (j = 0; ; j++) /* first check non indexed */ + { if (NULL == nmni[j]) break; + if (0 == strcmp(nmni[j], ngp_tok->name)) return(NGP_BAD_ARG); + } + + for (j = 0; ; j++) /* now check indexed */ + { if (NULL == nm[j]) return(NGP_OK); + l = strlen(nm[j]); + if ((l < 1) || (l > 5)) continue; + if (0 == strncmp(nm[j], ngp_tok->name, l)) break; + } + + if ((ngp_tok->name[l] < '1') || (ngp_tok->name[l] > '9')) return(NGP_OK); + spc = 0; + for (i = l + 1; i < 8; i++) + { if (spc) { if (' ' != ngp_tok->name[i]) return(NGP_OK); } + else + { if ((ngp_tok->name[i] >= '0') || (ngp_tok->name[i] <= '9')) continue; + if (' ' == ngp_tok->name[i]) { spc = 1; continue; } + if (0 == ngp_tok->name[i]) break; + return(NGP_OK); + } + } + return(NGP_BAD_ARG); + } + + /* write (almost) all keywords from given HDU to disk */ + +int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode) + { int i, r, ib; + char buf[200]; + long l; + + + if (NULL == ngph) return(NGP_NUL_PTR); + if (NULL == ffp) return(NGP_NUL_PTR); + r = NGP_OK; + + for (i=0; itokcnt; i++) + { r = ngp_keyword_is_write(&(ngph->tok[i])); + if ((NGP_REALLY_ALL & mode) || (NGP_OK == r)) + { switch (ngph->tok[i].type) + { case NGP_TTYPE_BOOL: + ib = ngph->tok[i].value.b; + fits_write_key(ffp, TLOGICAL, ngph->tok[i].name, &ib, ngph->tok[i].comment, &r); + break; + case NGP_TTYPE_STRING: + fits_write_key_longstr(ffp, ngph->tok[i].name, ngph->tok[i].value.s, ngph->tok[i].comment, &r); + break; + case NGP_TTYPE_INT: + l = ngph->tok[i].value.i; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */ + fits_write_key(ffp, TLONG, ngph->tok[i].name, &l, ngph->tok[i].comment, &r); + break; + case NGP_TTYPE_REAL: + fits_write_key(ffp, TDOUBLE, ngph->tok[i].name, &(ngph->tok[i].value.d), ngph->tok[i].comment, &r); + break; + case NGP_TTYPE_COMPLEX: + fits_write_key(ffp, TDBLCOMPLEX, ngph->tok[i].name, &(ngph->tok[i].value.c), ngph->tok[i].comment, &r); + break; + case NGP_TTYPE_NULL: + fits_write_key_null(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r); + break; + case NGP_TTYPE_RAW: + if (0 == strcmp("HISTORY", ngph->tok[i].name)) + { fits_write_history(ffp, ngph->tok[i].comment, &r); + break; + } + if (0 == strcmp("COMMENT", ngph->tok[i].name)) + { fits_write_comment(ffp, ngph->tok[i].comment, &r); + break; + } + sprintf(buf, "%-8.8s%s", ngph->tok[i].name, ngph->tok[i].comment); + fits_write_record(ffp, buf, &r); + break; + } + } + else if (NGP_BAD_ARG == r) /* enhancement 10 dec 2003, James Peachey: template comments replace defaults */ + { r = NGP_OK; /* update comments of special keywords like TFORM */ + if (ngph->tok[i].comment && *ngph->tok[i].comment) /* do not update with a blank comment */ + { fits_modify_comment(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r); + } + } + else /* other problem, typically a blank token */ + { r = NGP_OK; /* skip this token, but continue */ + } + if (r) return(r); + } + + fits_set_hdustruc(ffp, &r); /* resync cfitsio */ + return(r); + } + + /* init HDU structure */ + +int ngp_hdu_init(NGP_HDU *ngph) + { if (NULL == ngph) return(NGP_NUL_PTR); + ngph->tok = NULL; + ngph->tokcnt = 0; + return(NGP_OK); + } + + /* clear HDU structure */ + +int ngp_hdu_clear(NGP_HDU *ngph) + { int i; + + if (NULL == ngph) return(NGP_NUL_PTR); + + for (i=0; itokcnt; i++) + { if (NGP_TTYPE_STRING == ngph->tok[i].type) + if (NULL != ngph->tok[i].value.s) + { ngp_free(ngph->tok[i].value.s); + ngph->tok[i].value.s = NULL; + } + } + + if (NULL != ngph->tok) ngp_free(ngph->tok); + + ngph->tok = NULL; + ngph->tokcnt = 0; + + return(NGP_OK); + } + + /* insert new token to HDU structure */ + +int ngp_hdu_insert_token(NGP_HDU *ngph, NGP_TOKEN *newtok) + { NGP_TOKEN *tkp; + + if (NULL == ngph) return(NGP_NUL_PTR); + if (NULL == newtok) return(NGP_NUL_PTR); + + if (0 == ngph->tokcnt) + tkp = (NGP_TOKEN *)ngp_alloc((ngph->tokcnt + 1) * sizeof(NGP_TOKEN)); + else + tkp = (NGP_TOKEN *)ngp_realloc(ngph->tok, (ngph->tokcnt + 1) * sizeof(NGP_TOKEN)); + + if (NULL == tkp) return(NGP_NO_MEMORY); + + ngph->tok = tkp; + ngph->tok[ngph->tokcnt] = *newtok; + + if (NGP_TTYPE_STRING == newtok->type) + { if (NULL != newtok->value.s) + { ngph->tok[ngph->tokcnt].value.s = (char *)ngp_alloc(1 + strlen(newtok->value.s)); + if (NULL == ngph->tok[ngph->tokcnt].value.s) return(NGP_NO_MEMORY); + strcpy(ngph->tok[ngph->tokcnt].value.s, newtok->value.s); + } + } + + ngph->tokcnt++; + return(NGP_OK); + } + + +int ngp_append_columns(fitsfile *ff, NGP_HDU *ngph, int aftercol) + { int r, i, j, exitflg, ngph_i; + char *my_tform, *my_ttype; + char ngph_ctmp; + + + if (NULL == ff) return(NGP_NUL_PTR); + if (NULL == ngph) return(NGP_NUL_PTR); + if (0 == ngph->tokcnt) return(NGP_OK); /* nothing to do ! */ + + r = NGP_OK; + exitflg = 0; + + for (j=aftercol; jtok[i].name, "TFORM%d%c", &ngph_i, &ngph_ctmp)) + { if ((NGP_TTYPE_STRING == ngph->tok[i].type) && (ngph_i == (j + 1))) + { my_tform = ngph->tok[i].value.s; + } + } + else if (1 == sscanf(ngph->tok[i].name, "TTYPE%d%c", &ngph_i, &ngph_ctmp)) + { if ((NGP_TTYPE_STRING == ngph->tok[i].type) && (ngph_i == (j + 1))) + { my_ttype = ngph->tok[i].value.s; + } + } + + if ((NULL != my_tform) && (my_ttype[0])) break; + + if (i < (ngph->tokcnt - 1)) continue; + exitflg = 1; + break; + } + if ((NGP_OK == r) && (NULL != my_tform)) + fits_insert_col(ff, j + 1, my_ttype, my_tform, &r); + + if ((NGP_OK != r) || exitflg) break; + } + return(r); + } + + /* read complete HDU */ + +int ngp_read_xtension(fitsfile *ff, int parent_hn, int simple_mode) + { int r, exflg, l, my_hn, tmp0, incrementor_index, i, j; + int ngph_dim, ngph_bitpix, ngph_node_type, my_version; + char incrementor_name[NGP_MAX_STRING], ngph_ctmp; + char *ngph_extname = 0; + long ngph_size[NGP_MAX_ARRAY_DIM]; + NGP_HDU ngph; + long lv; + + incrementor_name[0] = 0; /* signal no keyword+'#' found yet */ + incrementor_index = 0; + + if (NGP_OK != (r = ngp_hdu_init(&ngph))) return(r); + + if (NGP_OK != (r = ngp_read_line(0))) return(r); /* EOF always means error here */ + switch (NGP_XTENSION_SIMPLE & simple_mode) + { + case 0: if (NGP_TOKEN_XTENSION != ngp_keyidx) return(NGP_TOKEN_NOT_EXPECT); + break; + default: if (NGP_TOKEN_SIMPLE != ngp_keyidx) return(NGP_TOKEN_NOT_EXPECT); + break; + } + + if (NGP_OK != (r = ngp_hdu_insert_token(&ngph, &ngp_linkey))) return(r); + + for (;;) + { if (NGP_OK != (r = ngp_read_line(0))) return(r); /* EOF always means error here */ + exflg = 0; + switch (ngp_keyidx) + { + case NGP_TOKEN_SIMPLE: + r = NGP_TOKEN_NOT_EXPECT; + break; + + case NGP_TOKEN_END: + case NGP_TOKEN_XTENSION: + case NGP_TOKEN_GROUP: + r = ngp_unread_line(); /* WARNING - not break here .... */ + case NGP_TOKEN_EOF: + exflg = 1; + break; + + default: l = strlen(ngp_linkey.name); + if ((l >= 2) && (l <= 6)) + { if ('#' == ngp_linkey.name[l - 1]) + { if (0 == incrementor_name[0]) + { memcpy(incrementor_name, ngp_linkey.name, l - 1); + incrementor_name[l - 1] = 0; + } + if (((l - 1) == (int)strlen(incrementor_name)) && (0 == memcmp(incrementor_name, ngp_linkey.name, l - 1))) + { incrementor_index++; + } + sprintf(ngp_linkey.name + l - 1, "%d", incrementor_index); + } + } + r = ngp_hdu_insert_token(&ngph, &ngp_linkey); + break; + } + if ((NGP_OK != r) || exflg) break; + } + + if (NGP_OK == r) + { /* we should scan keywords, and calculate HDU's */ + /* structure ourselves .... */ + + ngph_node_type = NGP_NODE_INVALID; /* init variables */ + ngph_bitpix = 0; + ngph_extname = NULL; + for (i=0; i=1) && (j <= NGP_MAX_ARRAY_DIM)) + { ngph_size[j - 1] = ngph.tok[i].value.i; + } + } + } + + switch (ngph_node_type) + { case NGP_NODE_IMAGE: + if (NGP_XTENSION_FIRST == ((NGP_XTENSION_FIRST | NGP_XTENSION_SIMPLE) & simple_mode)) + { /* if caller signals that this is 1st HDU in file */ + /* and it is IMAGE defined with XTENSION, then we */ + /* need create dummy Primary HDU */ + fits_create_img(ff, 16, 0, NULL, &r); + } + /* create image */ + fits_create_img(ff, ngph_bitpix, ngph_dim, ngph_size, &r); + + /* update keywords */ + if (NGP_OK == r) r = ngp_keyword_all_write(&ngph, ff, NGP_NON_SYSTEM_ONLY); + break; + + case NGP_NODE_ATABLE: + case NGP_NODE_BTABLE: + /* create table, 0 rows and 0 columns for the moment */ + fits_create_tbl(ff, ((NGP_NODE_ATABLE == ngph_node_type) + ? ASCII_TBL : BINARY_TBL), + 0, 0, NULL, NULL, NULL, NULL, &r); + if (NGP_OK != r) break; + + /* add columns ... */ + r = ngp_append_columns(ff, &ngph, 0); + if (NGP_OK != r) break; + + /* add remaining keywords */ + r = ngp_keyword_all_write(&ngph, ff, NGP_NON_SYSTEM_ONLY); + if (NGP_OK != r) break; + + /* if requested add rows */ + if (ngph_size[1] > 0) fits_insert_rows(ff, 0, ngph_size[1], &r); + break; + + default: r = NGP_BAD_ARG; + break; + } + + } + + if ((NGP_OK == r) && (NULL != ngph_extname)) + { r = ngp_get_extver(ngph_extname, &my_version); /* write correct ext version number */ + lv = my_version; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */ + fits_write_key(ff, TLONG, "EXTVER", &lv, "auto assigned by template parser", &r); + } + + if (NGP_OK == r) + { if (parent_hn > 0) + { fits_get_hdu_num(ff, &my_hn); + fits_movabs_hdu(ff, parent_hn, &tmp0, &r); /* link us to parent */ + fits_add_group_member(ff, NULL, my_hn, &r); + fits_movabs_hdu(ff, my_hn, &tmp0, &r); + if (NGP_OK != r) return(r); + } + } + + if (NGP_OK != r) /* in case of error - delete hdu */ + { tmp0 = 0; + fits_delete_hdu(ff, NULL, &tmp0); + } + + ngp_hdu_clear(&ngph); + return(r); + } + + /* read complete GROUP */ + +int ngp_read_group(fitsfile *ff, char *grpname, int parent_hn) + { int r, exitflg, l, my_hn, tmp0, incrementor_index; + char grnm[NGP_MAX_STRING]; /* keyword holding group name */ + char incrementor_name[NGP_MAX_STRING]; + NGP_HDU ngph; + + incrementor_name[0] = 0; /* signal no keyword+'#' found yet */ + incrementor_index = 6; /* first 6 cols are used by group */ + + ngp_grplevel++; + if (NGP_OK != (r = ngp_hdu_init(&ngph))) return(r); + + r = NGP_OK; + if (NGP_OK != (r = fits_create_group(ff, grpname, GT_ID_ALL_URI, &r))) return(r); + fits_get_hdu_num(ff, &my_hn); + if (parent_hn > 0) + { fits_movabs_hdu(ff, parent_hn, &tmp0, &r); /* link us to parent */ + fits_add_group_member(ff, NULL, my_hn, &r); + fits_movabs_hdu(ff, my_hn, &tmp0, &r); + if (NGP_OK != r) return(r); + } + + for (exitflg = 0; 0 == exitflg;) + { if (NGP_OK != (r = ngp_read_line(0))) break; /* EOF always means error here */ + switch (ngp_keyidx) + { + case NGP_TOKEN_SIMPLE: + case NGP_TOKEN_EOF: + r = NGP_TOKEN_NOT_EXPECT; + break; + + case NGP_TOKEN_END: + ngp_grplevel--; + exitflg = 1; + break; + + case NGP_TOKEN_GROUP: + if (NGP_TTYPE_STRING == ngp_linkey.type) + { strncpy(grnm, ngp_linkey.value.s, NGP_MAX_STRING); + } + else + { sprintf(grnm, "DEFAULT_GROUP_%d", master_grp_idx++); + } + grnm[NGP_MAX_STRING - 1] = 0; + r = ngp_read_group(ff, grnm, my_hn); + break; /* we can have many subsequent GROUP defs */ + + case NGP_TOKEN_XTENSION: + r = ngp_unread_line(); + if (NGP_OK != r) break; + r = ngp_read_xtension(ff, my_hn, 0); + break; /* we can have many subsequent HDU defs */ + + default: l = strlen(ngp_linkey.name); + if ((l >= 2) && (l <= 6)) + { if ('#' == ngp_linkey.name[l - 1]) + { if (0 == incrementor_name[0]) + { memcpy(incrementor_name, ngp_linkey.name, l - 1); + incrementor_name[l - 1] = 0; + } + if (((l - 1) == (int)strlen(incrementor_name)) && (0 == memcmp(incrementor_name, ngp_linkey.name, l - 1))) + { incrementor_index++; + } + sprintf(ngp_linkey.name + l - 1, "%d", incrementor_index); + } + } + r = ngp_hdu_insert_token(&ngph, &ngp_linkey); + break; /* here we can add keyword */ + } + if (NGP_OK != r) break; + } + + fits_movabs_hdu(ff, my_hn, &tmp0, &r); /* back to our HDU */ + + if (NGP_OK == r) /* create additional columns, if requested */ + r = ngp_append_columns(ff, &ngph, 6); + + if (NGP_OK == r) /* and write keywords */ + r = ngp_keyword_all_write(&ngph, ff, NGP_NON_SYSTEM_ONLY); + + if (NGP_OK != r) /* delete group in case of error */ + { tmp0 = 0; + fits_remove_group(ff, OPT_RM_GPT, &tmp0); + } + + ngp_hdu_clear(&ngph); /* we are done with this HDU, so delete it */ + return(r); + } + + /* top level API functions */ + +/* read whole template. ff should point to the opened empty fits file. */ + +int fits_execute_template(fitsfile *ff, char *ngp_template, int *status) + { int r, exit_flg, first_extension, i, my_hn, tmp0, keys_exist, more_keys, used_ver; + char grnm[NGP_MAX_STRING], used_name[NGP_MAX_STRING]; + long luv; + + if (NULL == status) return(NGP_NUL_PTR); + if (NGP_OK != *status) return(*status); + + if ((NULL == ff) || (NULL == ngp_template)) + { *status = NGP_NUL_PTR; + return(*status); + } + + ngp_inclevel = 0; /* initialize things, not all should be zero */ + ngp_grplevel = 0; + master_grp_idx = 1; + exit_flg = 0; + ngp_master_dir[0] = 0; /* this should be before 1st call to ngp_include_file */ + first_extension = 1; /* we need to create PHDU */ + + if (NGP_OK != (r = ngp_delete_extver_tab())) + { *status = r; + return(r); + } + + fits_get_hdu_num(ff, &my_hn); /* our HDU position */ + if (my_hn <= 1) /* check whether we really need to create PHDU */ + { fits_movabs_hdu(ff, 1, &tmp0, status); + fits_get_hdrspace(ff, &keys_exist, &more_keys, status); + fits_movabs_hdu(ff, my_hn, &tmp0, status); + if (NGP_OK != *status) return(*status); /* error here means file is corrupted */ + if (keys_exist > 0) first_extension = 0; /* if keywords exist assume PHDU already exist */ + } + else + { first_extension = 0; /* PHDU (followed by 1+ extensions) exist */ + + for (i = 2; i<= my_hn; i++) + { *status = NGP_OK; + fits_movabs_hdu(ff, 1, &tmp0, status); + if (NGP_OK != *status) break; + + fits_read_key(ff, TSTRING, "EXTNAME", used_name, NULL, status); + if (NGP_OK != *status) continue; + + fits_read_key(ff, TLONG, "EXTVER", &luv, NULL, status); + used_ver = luv; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */ + if (VALUE_UNDEFINED == *status) + { used_ver = 1; + *status = NGP_OK; + } + + if (NGP_OK == *status) *status = ngp_set_extver(used_name, used_ver); + } + + fits_movabs_hdu(ff, my_hn, &tmp0, status); + } + if (NGP_OK != *status) return(*status); + + if (NGP_OK != (*status = ngp_include_file(ngp_template))) return(*status); + + for (i = strlen(ngp_template) - 1; i >= 0; i--) /* strlen is > 0, otherwise fopen failed */ + { +#ifdef MSDOS + if ('\\' == ngp_template[i]) break; +#else + if ('/' == ngp_template[i]) break; +#endif + } + + i++; + if (i > (NGP_MAX_FNAME - 1)) i = NGP_MAX_FNAME - 1; + + if (i > 0) + { memcpy(ngp_master_dir, ngp_template, i); + ngp_master_dir[i] = 0; + } + + + for (;;) + { if (NGP_OK != (r = ngp_read_line(1))) break; /* EOF always means error here */ + switch (ngp_keyidx) + { + case NGP_TOKEN_SIMPLE: + if (0 == first_extension) /* simple only allowed in first HDU */ + { r = NGP_TOKEN_NOT_EXPECT; + break; + } + if (NGP_OK != (r = ngp_unread_line())) break; + r = ngp_read_xtension(ff, 0, NGP_XTENSION_SIMPLE | NGP_XTENSION_FIRST); + first_extension = 0; + break; + + case NGP_TOKEN_XTENSION: + if (NGP_OK != (r = ngp_unread_line())) break; + r = ngp_read_xtension(ff, 0, (first_extension ? NGP_XTENSION_FIRST : 0)); + first_extension = 0; + break; + + case NGP_TOKEN_GROUP: + if (NGP_TTYPE_STRING == ngp_linkey.type) + { strncpy(grnm, ngp_linkey.value.s, NGP_MAX_STRING); } + else + { sprintf(grnm, "DEFAULT_GROUP_%d", master_grp_idx++); } + grnm[NGP_MAX_STRING - 1] = 0; + r = ngp_read_group(ff, grnm, 0); + first_extension = 0; + break; + + case NGP_TOKEN_EOF: + exit_flg = 1; + break; + + default: r = NGP_TOKEN_NOT_EXPECT; + break; + } + if (exit_flg || (NGP_OK != r)) break; + } + +/* all top level HDUs up to faulty one are left intact in case of i/o error. It is up + to the caller to call fits_close_file or fits_delete_file when this function returns + error. */ + + ngp_free_line(); /* deallocate last line (if any) */ + ngp_free_prevline(); /* deallocate cached line (if any) */ + ngp_delete_extver_tab(); /* delete extver table (if present), error ignored */ + + *status = r; + return(r); + } diff --git a/pkg/tbtables/cfitsio/grparser.h b/pkg/tbtables/cfitsio/grparser.h new file mode 100644 index 00000000..56bdea03 --- /dev/null +++ b/pkg/tbtables/cfitsio/grparser.h @@ -0,0 +1,185 @@ +/* T E M P L A T E P A R S E R H E A D E R F I L E + ===================================================== + + by Jerzy.Borkowski@obs.unige.ch + + Integral Science Data Center + ch. d'Ecogia 16 + 1290 Versoix + Switzerland + +14-Oct-98: initial release +16-Oct-98: reference to fitsio.h removed, also removed strings after #endif + directives to make gcc -Wall not to complain +20-Oct-98: added declarations NGP_XTENSION_SIMPLE and NGP_XTENSION_FIRST +24-Oct-98: prototype of ngp_read_line() function updated. +22-Jan-99: prototype for ngp_set_extver() function added. +20-Jun-2002 Wm Pence, added support for the HIERARCH keyword convention + (changed NGP_MAX_NAME from (20) to FLEN_KEYWORD) +*/ + +#ifndef GRPARSER_H_INCLUDED +#define GRPARSER_H_INCLUDED + +#ifdef __cplusplus +extern "C" { +#endif + + /* error codes - now defined in fitsio.h */ + + /* common constants definitions */ + +#define NGP_ALLOCCHUNK (1000) +#define NGP_MAX_INCLUDE (10) /* include file nesting limit */ +#define NGP_MAX_COMMENT (80) /* max size for comment */ +#define NGP_MAX_NAME FLEN_KEYWORD /* max size for KEYWORD (FITS limits it to 8 chars) */ + /* except HIERARCH can have longer effective keyword names */ +#define NGP_MAX_STRING (80) /* max size for various strings */ +#define NGP_MAX_ARRAY_DIM (999) /* max. number of dimensions in array */ +#define NGP_MAX_FNAME (1000) /* max size of combined path+fname */ +#define NGP_MAX_ENVFILES (10000) /* max size of CFITSIO_INCLUDE_FILES env. variable */ + +#define NGP_TOKEN_UNKNOWN (-1) /* token type unknown */ +#define NGP_TOKEN_INCLUDE (0) /* \INCLUDE token */ +#define NGP_TOKEN_GROUP (1) /* \GROUP token */ +#define NGP_TOKEN_END (2) /* \END token */ +#define NGP_TOKEN_XTENSION (3) /* XTENSION token */ +#define NGP_TOKEN_SIMPLE (4) /* SIMPLE token */ +#define NGP_TOKEN_EOF (5) /* End Of File pseudo token */ + +#define NGP_TTYPE_UNKNOWN (0) /* undef (yet) token type - invalid to print/write to disk */ +#define NGP_TTYPE_BOOL (1) /* boolean, it is 'T' or 'F' */ +#define NGP_TTYPE_STRING (2) /* something withing "" or starting with letter */ +#define NGP_TTYPE_INT (3) /* starting with digit and not with '.' */ +#define NGP_TTYPE_REAL (4) /* digits + '.' */ +#define NGP_TTYPE_COMPLEX (5) /* 2 reals, separated with ',' */ +#define NGP_TTYPE_NULL (6) /* NULL token, format is : NAME = / comment */ +#define NGP_TTYPE_RAW (7) /* HISTORY/COMMENT/8SPACES + comment string without / */ + +#define NGP_FOUND_EQUAL_SIGN (1) /* line contains '=' after keyword name */ + +#define NGP_FORMAT_OK (0) /* line format OK */ +#define NGP_FORMAT_ERROR (1) /* line format error */ + +#define NGP_NODE_INVALID (0) /* default node type - invalid (to catch errors) */ +#define NGP_NODE_IMAGE (1) /* IMAGE type */ +#define NGP_NODE_ATABLE (2) /* ASCII table type */ +#define NGP_NODE_BTABLE (3) /* BINARY table type */ + +#define NGP_NON_SYSTEM_ONLY (0) /* save all keywords except NAXIS,BITPIX,etc.. */ +#define NGP_REALLY_ALL (1) /* save really all keywords */ + +#define NGP_XTENSION_SIMPLE (1) /* HDU defined with SIMPLE T */ +#define NGP_XTENSION_FIRST (2) /* this is first extension in template */ + +#define NGP_LINE_REREAD (1) /* reread line */ + +#define NGP_BITPIX_INVALID (-12345) /* default BITPIX (to catch errors) */ + + /* common macro definitions */ + +#ifdef NGP_PARSER_DEBUG_MALLOC + +#define ngp_alloc(x) dal_malloc(x) +#define ngp_free(x) dal_free(x) +#define ngp_realloc(x,y) dal_realloc(x,y) + +#else + +#define ngp_alloc(x) malloc(x) +#define ngp_free(x) free(x) +#define ngp_realloc(x,y) realloc(x,y) + +#endif + + /* type definitions */ + +typedef struct NGP_RAW_LINE_STRUCT + { char *line; + char *name; + char *value; + int type; + char *comment; + int format; + int flags; + } NGP_RAW_LINE; + + +typedef union NGP_TOKVAL_UNION + { char *s; /* space allocated separately, be careful !!! */ + char b; + int i; + double d; + struct NGP_COMPLEX_STRUCT + { double re; + double im; + } c; /* complex value */ + } NGP_TOKVAL; + + +typedef struct NGP_TOKEN_STRUCT + { int type; + char name[NGP_MAX_NAME]; + NGP_TOKVAL value; + char comment[NGP_MAX_COMMENT]; + } NGP_TOKEN; + + +typedef struct NGP_HDU_STRUCT + { int tokcnt; + NGP_TOKEN *tok; + } NGP_HDU; + + +typedef struct NGP_TKDEF_STRUCT + { char *name; + int code; + } NGP_TKDEF; + + +typedef struct NGP_EXTVER_TAB_STRUCT + { char *extname; + int version; + } NGP_EXTVER_TAB; + + + /* globally visible variables declarations */ + +extern NGP_RAW_LINE ngp_curline; +extern NGP_RAW_LINE ngp_prevline; + +extern int ngp_extver_tab_size; +extern NGP_EXTVER_TAB *ngp_extver_tab; + + + /* globally visible functions declarations */ + +int ngp_get_extver(char *extname, int *version); +int ngp_set_extver(char *extname, int version); +int ngp_delete_extver_tab(void); +int ngp_strcasecmp(char *p1, char *p2); +int ngp_strcasencmp(char *p1, char *p2, int n); +int ngp_line_from_file(FILE *fp, char **p); +int ngp_free_line(void); +int ngp_free_prevline(void); +int ngp_read_line_buffered(FILE *fp); +int ngp_unread_line(void); +int ngp_extract_tokens(NGP_RAW_LINE *cl); +int ngp_include_file(char *fname); +int ngp_read_line(int ignore_blank_lines); +int ngp_keyword_is_write(NGP_TOKEN *ngp_tok); +int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode); +int ngp_hdu_init(NGP_HDU *ngph); +int ngp_hdu_clear(NGP_HDU *ngph); +int ngp_hdu_insert_token(NGP_HDU *ngph, NGP_TOKEN *newtok); +int ngp_append_columns(fitsfile *ff, NGP_HDU *ngph, int aftercol); +int ngp_read_xtension(fitsfile *ff, int parent_hn, int simple_mode); +int ngp_read_group(fitsfile *ff, char *grpname, int parent_hn); + + /* top level API function - now defined in fitsio.h */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/pkg/tbtables/cfitsio/histo.c b/pkg/tbtables/cfitsio/histo.c new file mode 100644 index 00000000..525f50fd --- /dev/null +++ b/pkg/tbtables/cfitsio/histo.c @@ -0,0 +1,1300 @@ +/* Globally defined histogram parameters */ +#include +#include +#include +#include +#include "fitsio2.h" + +typedef struct { /* Structure holding all the histogramming information */ + union { /* the iterator work functions (ffwritehist, ffcalchist) */ + char *b; /* need to do their job... passed via *userPointer. */ + short *i; + int *j; + float *r; + double *d; + } hist; + + fitsfile *tblptr; + + int haxis, hcolnum[4], himagetype; + long haxis1, haxis2, haxis3, haxis4; + float amin1, amin2, amin3, amin4; + float maxbin1, maxbin2, maxbin3, maxbin4; + float binsize1, binsize2, binsize3, binsize4; + int wtrecip, wtcolnum; + float weight; + char *rowselector; + +} histType; + +/*--------------------------------------------------------------------------*/ +int ffbins(char *binspec, /* I - binning specification */ + int *imagetype, /* O - image type, TINT or TSHORT */ + int *histaxis, /* O - no. of axes in the histogram */ + char colname[4][FLEN_VALUE], /* column name for axis */ + double *minin, /* minimum value for each axis */ + double *maxin, /* maximum value for each axis */ + double *binsizein, /* size of bins on each axis */ + char minname[4][FLEN_VALUE], /* keyword name for min */ + char maxname[4][FLEN_VALUE], /* keyword name for max */ + char binname[4][FLEN_VALUE], /* keyword name for binsize */ + double *wt, /* weighting factor */ + char *wtname, /* keyword or column name for weight */ + int *recip, /* the reciprocal of the weight? */ + int *status) +{ +/* + Parse the input binning specification string, returning the binning + parameters. Supports up to 4 dimensions. The binspec string has + one of these forms: + + bin binsize - 2D histogram with binsize on each axis + bin xcol - 1D histogram on column xcol + bin (xcol, ycol) = binsize - 2D histogram with binsize on each axis + bin x=min:max:size, y=min:max:size, z..., t... + bin x=:max, y=::size + bin x=size, y=min::size + + most other reasonable combinations are supported. +*/ + int ii, slen, defaulttype; + char *ptr, tmpname[30], *file_expr = NULL; + double dummy; + + if (*status > 0) + return(*status); + + /* set the default values */ + *histaxis = 2; + *imagetype = TINT; + defaulttype = 1; + *wt = 1.; + *recip = 0; + *wtname = '\0'; + + /* set default values */ + for (ii = 0; ii < 4; ii++) + { + *colname[ii] = '\0'; + *minname[ii] = '\0'; + *maxname[ii] = '\0'; + *binname[ii] = '\0'; + minin[ii] = DOUBLENULLVALUE; /* undefined values */ + maxin[ii] = DOUBLENULLVALUE; + binsizein[ii] = DOUBLENULLVALUE; + } + + ptr = binspec + 3; /* skip over 'bin' */ + + if (*ptr == 'i' ) /* bini */ + { + *imagetype = TSHORT; + defaulttype = 0; + ptr++; + } + else if (*ptr == 'j' ) /* binj; same as default */ + { + defaulttype = 0; + ptr ++; + } + else if (*ptr == 'r' ) /* binr */ + { + *imagetype = TFLOAT; + defaulttype = 0; + ptr ++; + } + else if (*ptr == 'd' ) /* bind */ + { + *imagetype = TDOUBLE; + defaulttype = 0; + ptr ++; + } + else if (*ptr == 'b' ) /* binb */ + { + *imagetype = TBYTE; + defaulttype = 0; + ptr ++; + } + + if (*ptr == '\0') /* use all defaults for other parameters */ + return(*status); + else if (*ptr != ' ') /* must be at least one blank */ + { + ffpmsg("binning specification syntax error:"); + ffpmsg(binspec); + return(*status = URL_PARSE_ERROR); + } + + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + if (*ptr == '\0') /* no other parameters; use defaults */ + return(*status); + + /* Check if need to import expression from a file */ + + if( *ptr=='@' ) { + if( ffimport_file( ptr+1, &file_expr, status ) ) return(*status); + ptr = file_expr; + while (*ptr == ' ') + ptr++; /* skip leading white space... again */ + } + + if (*ptr == '(' ) + { + /* this must be the opening parenthesis around a list of column */ + /* names, optionally followed by a '=' and the binning spec. */ + + for (ii = 0; ii < 4; ii++) + { + ptr++; /* skip over the '(', ',', or ' ') */ + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + slen = strcspn(ptr, " ,)"); + strncat(colname[ii], ptr, slen); /* copy 1st column name */ + + ptr += slen; + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + if (*ptr == ')' ) /* end of the list of names */ + { + *histaxis = ii + 1; + break; + } + } + + if (ii == 4) /* too many names in the list , or missing ')' */ + { + ffpmsg( + "binning specification has too many column names or is missing closing ')':"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status = URL_PARSE_ERROR); + } + + ptr++; /* skip over the closing parenthesis */ + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + if (*ptr == '\0') { + if( file_expr ) free( file_expr ); + return(*status); /* parsed the entire string */ + } + + else if (*ptr != '=') /* must be an equals sign now*/ + { + ffpmsg("illegal binning specification in URL:"); + ffpmsg(" an equals sign '=' must follow the column names"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status = URL_PARSE_ERROR); + } + + ptr++; /* skip over the equals sign */ + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + /* get the single range specification for all the columns */ + ffbinr(&ptr, tmpname, minin, + maxin, binsizein, minname[0], + maxname[0], binname[0], status); + if (*status > 0) + { + ffpmsg("illegal binning specification in URL:"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status); + } + + for (ii = 1; ii < *histaxis; ii++) + { + minin[ii] = minin[0]; + maxin[ii] = maxin[0]; + binsizein[ii] = binsizein[0]; + strcpy(minname[ii], minname[0]); + strcpy(maxname[ii], maxname[0]); + strcpy(binname[ii], binname[0]); + } + + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + if (*ptr == ';') + goto getweight; /* a weighting factor is specified */ + + if (*ptr != '\0') /* must have reached end of string */ + { + ffpmsg("illegal syntax after binning range specification in URL:"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status = URL_PARSE_ERROR); + } + + return(*status); + } /* end of case with list of column names in ( ) */ + + /* if we've reached this point, then the binning specification */ + /* must be of the form: XCOL = min:max:binsize, YCOL = ... */ + /* where the column name followed by '=' are optional. */ + /* If the column name is not specified, then use the default name */ + + for (ii = 0; ii < 4; ii++) /* allow up to 4 histogram dimensions */ + { + ffbinr(&ptr, colname[ii], &minin[ii], + &maxin[ii], &binsizein[ii], minname[ii], + maxname[ii], binname[ii], status); + + if (*status > 0) + { + ffpmsg("illegal syntax in binning range specification in URL:"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status); + } + + if (*ptr == '\0' || *ptr == ';') + break; /* reached the end of the string */ + + if (*ptr == ' ') + { + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + if (*ptr == '\0' || *ptr == ';') + break; /* reached the end of the string */ + + if (*ptr == ',') + ptr++; /* comma separates the next column specification */ + } + else if (*ptr == ',') + { + ptr++; /* comma separates the next column specification */ + } + else + { + ffpmsg("illegal characters following binning specification in URL:"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status = URL_PARSE_ERROR); + } + } + + if (ii == 4) + { + /* there are yet more characters in the string */ + ffpmsg("illegal binning specification in URL:"); + ffpmsg("apparently greater than 4 histogram dimensions"); + ffpmsg(binspec); + return(*status = URL_PARSE_ERROR); + } + else + *histaxis = ii + 1; + + /* special case: if a single number was entered it should be */ + /* interpreted as the binning factor for the default X and Y axes */ + + if (*histaxis == 1 && *colname[0] == '\0' && + minin[0] == DOUBLENULLVALUE && maxin[0] == DOUBLENULLVALUE) + { + *histaxis = 2; + binsizein[1] = binsizein[0]; + } + +getweight: + if (*ptr == ';') /* looks like a weighting factor is given */ + { + ptr++; + + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + recip = 0; + if (*ptr == '/') + { + *recip = 1; /* the reciprocal of the weight is entered */ + ptr++; + + while (*ptr == ' ') /* skip over blanks */ + ptr++; + } + + /* parse the weight as though it were a binrange. */ + /* either a column name or a numerical value will be returned */ + + ffbinr(&ptr, wtname, &dummy, &dummy, wt, tmpname, + tmpname, tmpname, status); + + if (*status > 0) + { + ffpmsg("illegal binning weight specification in URL:"); + ffpmsg(binspec); + if( file_expr ) free( file_expr ); + return(*status); + } + + /* creat a float datatype histogram by default, if weight */ + /* factor is not = 1.0 */ + + if (defaulttype && *wt != 1.0) + *imagetype = TFLOAT; + } + + while (*ptr == ' ') /* skip over blanks */ + ptr++; + + if (*ptr != '\0') /* should have reached the end of string */ + { + ffpmsg("illegal syntax after binning weight specification in URL:"); + ffpmsg(binspec); + *status = URL_PARSE_ERROR; + } + + if( file_expr ) free( file_expr ); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffbinr(char **ptr, + char *colname, + double *minin, + double *maxin, + double *binsizein, + char *minname, + char *maxname, + char *binname, + int *status) +/* + Parse the input binning range specification string, returning + the column name, histogram min and max values, and bin size. +*/ +{ + int slen, isanumber; + char token[FLEN_VALUE]; + + if (*status > 0) + return(*status); + + slen = fits_get_token(ptr, " ,=:;", token, &isanumber); /* get 1st token */ + + if (slen == 0 && (**ptr == '\0' || **ptr == ',' || **ptr == ';') ) + return(*status); /* a null range string */ + + if (!isanumber && **ptr != ':') + { + /* this looks like the column name */ + + if (token[0] == '#' && isdigit((int) token[1]) ) + { + /* omit the leading '#' in the column number */ + strcpy(colname, token+1); + } + else + strcpy(colname, token); + + while (**ptr == ' ') /* skip over blanks */ + (*ptr)++; + + if (**ptr != '=') + return(*status); /* reached the end */ + + (*ptr)++; /* skip over the = sign */ + + while (**ptr == ' ') /* skip over blanks */ + (*ptr)++; + + slen = fits_get_token(ptr, " ,:;", token, &isanumber); /* get token */ + } + + if (**ptr != ':') + { + /* this is the first token, and since it is not followed by */ + /* a ':' this must be the binsize token */ + if (!isanumber) + strcpy(binname, token); + else + *binsizein = strtod(token, NULL); + + return(*status); /* reached the end */ + } + else + { + /* the token contains the min value */ + if (slen) + { + if (!isanumber) + strcpy(minname, token); + else + *minin = strtod(token, NULL); + } + } + + (*ptr)++; /* skip the colon between the min and max values */ + slen = fits_get_token(ptr, " ,:;", token, &isanumber); /* get token */ + + /* the token contains the max value */ + if (slen) + { + if (!isanumber) + strcpy(maxname, token); + else + *maxin = strtod(token, NULL); + } + + if (**ptr != ':') + return(*status); /* reached the end; no binsize token */ + + (*ptr)++; /* skip the colon between the max and binsize values */ + slen = fits_get_token(ptr, " ,:;", token, &isanumber); /* get token */ + + /* the token contains the binsize value */ + if (slen) + { + if (!isanumber) + strcpy(binname, token); + else + *binsizein = strtod(token, NULL); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffhist(fitsfile **fptr, /* IO - pointer to table with X and Y cols; */ + /* on output, points to histogram image */ + char *outfile, /* I - name for the output histogram file */ + int imagetype, /* I - datatype for image: TINT, TSHORT, etc */ + int naxis, /* I - number of axes in the histogram image */ + char colname[4][FLEN_VALUE], /* I - column names */ + double *minin, /* I - minimum histogram value, for each axis */ + double *maxin, /* I - maximum histogram value, for each axis */ + double *binsizein, /* I - bin size along each axis */ + char minname[4][FLEN_VALUE], /* I - optional keywords for min */ + char maxname[4][FLEN_VALUE], /* I - optional keywords for max */ + char binname[4][FLEN_VALUE], /* I - optional keywords for binsize */ + double weightin, /* I - binning weighting factor */ + char wtcol[FLEN_VALUE], /* I - optional keyword or col for weight*/ + int recip, /* I - use reciprocal of the weight? */ + char *selectrow, /* I - optional array (length = no. of */ + /* rows in the table). If the element is true */ + /* then the corresponding row of the table will*/ + /* be included in the histogram, otherwise the */ + /* row will be skipped. Ingnored if *selectrow*/ + /* is equal to NULL. */ + int *status) +{ + int ii, datatype, repeat, imin, imax, ibin, bitpix, tstatus, use_datamax = 0; + long haxes[4]; + fitsfile *histptr; + char errmsg[FLEN_ERRMSG], keyname[FLEN_KEYWORD], card[FLEN_CARD]; + tcolumn *colptr; + iteratorCol imagepars[1]; + int n_cols = 1, nkeys; + long offset = 0; + long n_per_loop = -1; /* force whole array to be passed at one time */ + histType histData; /* Structure holding histogram info for iterator */ + + float amin[4], amax[4], binsize[4], maxbin[4]; + float datamin = FLOATNULLVALUE, datamax = FLOATNULLVALUE; + char svalue[FLEN_VALUE]; + double dvalue; + char cpref[4][FLEN_VALUE]; + char *cptr; + + if (*status > 0) + return(*status); + + if (naxis > 4) + { + ffpmsg("histogram has more than 4 dimensions"); + return(*status = BAD_DIMEN); + } + + /* reset position to the correct HDU if necessary */ + if ((*fptr)->HDUposition != ((*fptr)->Fptr)->curhdu) + ffmahd(*fptr, ((*fptr)->HDUposition) + 1, NULL, status); + + histData.tblptr = *fptr; + histData.himagetype = imagetype; + histData.haxis = naxis; + histData.rowselector = selectrow; + + if (imagetype == TBYTE) + bitpix = BYTE_IMG; + else if (imagetype == TSHORT) + bitpix = SHORT_IMG; + else if (imagetype == TINT) + bitpix = LONG_IMG; + else if (imagetype == TFLOAT) + bitpix = FLOAT_IMG; + else if (imagetype == TDOUBLE) + bitpix = DOUBLE_IMG; + else + return(*status = BAD_DATATYPE); + + /* The CPREF keyword, if it exists, gives the preferred columns. */ + /* Otherwise, assume "X", "Y", "Z", and "T" */ + + tstatus = 0; + ffgky(*fptr, TSTRING, "CPREF", cpref[0], NULL, &tstatus); + + if (!tstatus) + { + /* Preferred column names are given; separate them */ + cptr = cpref[0]; + + /* the first preferred axis... */ + while (*cptr != ',' && *cptr != '\0') + cptr++; + + if (*cptr != '\0') + { + *cptr = '\0'; + cptr++; + while (*cptr == ' ') + cptr++; + + strcpy(cpref[1], cptr); + cptr = cpref[1]; + + /* the second preferred axis... */ + while (*cptr != ',' && *cptr != '\0') + cptr++; + + if (*cptr != '\0') + { + *cptr = '\0'; + cptr++; + while (*cptr == ' ') + cptr++; + + strcpy(cpref[2], cptr); + cptr = cpref[2]; + + /* the third preferred axis... */ + while (*cptr != ',' && *cptr != '\0') + cptr++; + + if (*cptr != '\0') + { + *cptr = '\0'; + cptr++; + while (*cptr == ' ') + cptr++; + + strcpy(cpref[3], cptr); + + } + } + } + } + + for (ii = 0; ii < naxis; ii++) + { + + /* get the min, max, and binsize values from keywords, if specified */ + + if (*minname[ii]) + { + if (ffgky(*fptr, TDOUBLE, minname[ii], &minin[ii], NULL, status) ) + { + ffpmsg("error reading histogramming minimum keyword"); + ffpmsg(minname[ii]); + return(*status); + } + } + + if (*maxname[ii]) + { + if (ffgky(*fptr, TDOUBLE, maxname[ii], &maxin[ii], NULL, status) ) + { + ffpmsg("error reading histogramming maximum keyword"); + ffpmsg(maxname[ii]); + return(*status); + } + } + + if (*binname[ii]) + { + if (ffgky(*fptr, TDOUBLE, binname[ii], &binsizein[ii], NULL, status) ) + { + ffpmsg("error reading histogramming binsize keyword"); + ffpmsg(binname[ii]); + return(*status); + } + } + + if (binsizein[ii] == 0.) + { + ffpmsg("error: histogram binsize = 0"); + return(*status = ZERO_SCALE); + } + + if (*colname[ii] == '\0') + { + strcpy(colname[ii], cpref[ii]); /* try using the preferred column */ + if (*colname[ii] == '\0') + { + if (ii == 0) + strcpy(colname[ii], "X"); + else if (ii == 1) + strcpy(colname[ii], "Y"); + else if (ii == 2) + strcpy(colname[ii], "Z"); + else if (ii == 3) + strcpy(colname[ii], "T"); + } + } + + /* get the column number in the table */ + if (ffgcno(*fptr, CASEINSEN, colname[ii], histData.hcolnum+ii, status) + > 0) + { + strcpy(errmsg, "column for histogram axis doesn't exist: "); + strcat(errmsg, colname[ii]); + ffpmsg(errmsg); + return(*status); + } + + colptr = ((*fptr)->Fptr)->tableptr; + colptr += (histData.hcolnum[ii] - 1); + + repeat = colptr->trepeat; /* vector repeat factor of the column */ + if (repeat > 1) + { + strcpy(errmsg, "Can't bin a vector column: "); + strcat(errmsg, colname[ii]); + ffpmsg(errmsg); + return(*status = BAD_DATATYPE); + } + + /* get the datatype of the column */ + fits_get_coltype(*fptr, histData.hcolnum[ii], &datatype, + NULL, NULL, status); + + if (datatype < 0 || datatype == TSTRING) + { + strcpy(errmsg, "Inappropriate datatype; can't bin this column: "); + strcat(errmsg, colname[ii]); + ffpmsg(errmsg); + return(*status = BAD_DATATYPE); + } + + /* use TLMINn and TLMAXn keyword values if min and max were not given */ + /* else use actual data min and max if TLMINn and TLMAXn don't exist */ + + if (minin[ii] == DOUBLENULLVALUE) + { + ffkeyn("TLMIN", histData.hcolnum[ii], keyname, status); + if (ffgky(*fptr, TFLOAT, keyname, amin+ii, NULL, status) > 0) + { + /* use actual data minimum value for the histogram minimum */ + *status = 0; + if (fits_get_col_minmax(*fptr, histData.hcolnum[ii], amin+ii, &datamax, status) > 0) + { + strcpy(errmsg, "Error calculating datamin and datamax for column: "); + strcat(errmsg, colname[ii]); + ffpmsg(errmsg); + return(*status); + } + } + } + else + { + amin[ii] = minin[ii]; + } + + if (maxin[ii] == DOUBLENULLVALUE) + { + ffkeyn("TLMAX", histData.hcolnum[ii], keyname, status); + if (ffgky(*fptr, TFLOAT, keyname, &amax[ii], NULL, status) > 0) + { + *status = 0; + if(datamax != FLOATNULLVALUE) /* already computed max value */ + { + amax[ii] = datamax; + } + else + { + /* use actual data maximum value for the histogram maximum */ + if (fits_get_col_minmax(*fptr, histData.hcolnum[ii], &datamin, &amax[ii], status) > 0) + { + strcpy(errmsg, "Error calculating datamin and datamax for column: "); + strcat(errmsg, colname[ii]); + ffpmsg(errmsg); + return(*status); + } + } + } + use_datamax = 1; /* flag that the max was determined by the data values */ + /* and not specifically set by the calling program */ + } + else + { + amax[ii] = maxin[ii]; + } + + /* use TDBINn keyword or else 1 if bin size is not given */ + if (binsizein[ii] == DOUBLENULLVALUE) + { + tstatus = 0; + ffkeyn("TDBIN", histData.hcolnum[ii], keyname, &tstatus); + + if (ffgky(*fptr, TDOUBLE, keyname, binsizein + ii, NULL, &tstatus) > 0) + { + /* make at least 10 bins */ + binsizein[ii] = (amax[ii] - amin[ii]) / 10. ; + if (binsizein[ii] > 1.) + binsizein[ii] = 1.; /* use default bin size */ + } + } + + if ( (amin[ii] > amax[ii] && binsizein[ii] > 0. ) || + (amin[ii] < amax[ii] && binsizein[ii] < 0. ) ) + binsize[ii] = -binsizein[ii]; /* reverse the sign of binsize */ + else + binsize[ii] = binsizein[ii]; /* binsize has the correct sign */ + + ibin = binsize[ii]; + imin = amin[ii]; + imax = amax[ii]; + + /* Determine the range and number of bins in the histogram. This */ + /* depends on whether the input columns are integer or floats, so */ + /* treat each case separately. */ + + if (datatype <= TLONG && (float) imin == amin[ii] && + (float) imax == amax[ii] && + (float) ibin == binsize[ii] ) + { + /* This is an integer column and integer limits were entered. */ + /* Shift the lower and upper histogramming limits by 0.5, so that */ + /* the values fall in the center of the bin, not on the edge. */ + + haxes[ii] = (imax - imin) / ibin + 1; /* last bin may only */ + /* be partially full */ + maxbin[ii] = haxes[ii] + 1.; /* add 1. instead of .5 to avoid roundoff */ + + if (amin[ii] < amax[ii]) + { + amin[ii] = amin[ii] - 0.5; + amax[ii] = amax[ii] + 0.5; + } + else + { + amin[ii] = amin[ii] + 0.5; + amax[ii] = amax[ii] - 0.5; + } + } + else if (use_datamax) + { + /* Either the column datatype and/or the limits are floating point, */ + /* and the histogram limits are being defined by the min and max */ + /* values of the array. Add 1 to the number of histogram bins to */ + /* make sure that pixels that are equal to the maximum or are */ + /* in the last partial bin are included. */ + + maxbin[ii] = (amax[ii] - amin[ii]) / binsize[ii]; + haxes[ii] = maxbin[ii] + 1; + } + else + { + /* float datatype column and/or limits, and the maximum value to */ + /* include in the histogram is specified by the calling program. */ + /* The lower limit is inclusive, but upper limit is exclusive */ + maxbin[ii] = (amax[ii] - amin[ii]) / binsize[ii]; + haxes[ii] = maxbin[ii]; + + if (amin[ii] < amax[ii]) + { + if (amin[ii] + (haxes[ii] * binsize[ii]) < amax[ii]) + haxes[ii]++; /* need to include another partial bin */ + } + else + { + if (amin[ii] + (haxes[ii] * binsize[ii]) > amax[ii]) + haxes[ii]++; /* need to include another partial bin */ + } + } + } + + /* get the histogramming weighting factor */ + if (*wtcol) + { + /* first, look for a keyword with the weight value */ + if (ffgky(*fptr, TFLOAT, wtcol, &histData.weight, NULL, status) ) + { + /* not a keyword, so look for column with this name */ + *status = 0; + + /* get the column number in the table */ + if (ffgcno(*fptr, CASEINSEN, wtcol, &histData.wtcolnum, status) > 0) + { + ffpmsg( + "keyword or column for histogram weights doesn't exist: "); + ffpmsg(wtcol); + return(*status); + } + + histData.weight = FLOATNULLVALUE; + } + } + else + histData.weight = (float) weightin; + + if (histData.weight <= 0. && histData.weight != FLOATNULLVALUE) + { + ffpmsg("Illegal histogramming weighting factor <= 0."); + return(*status = URL_PARSE_ERROR); + } + + if (recip && histData.weight != FLOATNULLVALUE) + /* take reciprocal of weight */ + histData.weight = 1.0 / histData.weight; + + histData.wtrecip = recip; + + /* size of histogram is now known, so create temp output file */ + if (ffinit(&histptr, outfile, status) > 0) + { + ffpmsg("failed to create temp output file for histogram"); + return(*status); + } + + if (ffcrim(histptr, bitpix, histData.haxis, haxes, status) > 0) + { + ffpmsg("failed to create primary array histogram in temp file"); + ffclos(histptr, status); + return(*status); + } + + /* copy all non-structural keywords from the table to the image */ + fits_get_hdrspace(*fptr, &nkeys, NULL, status); + for (ii = 1; ii <= nkeys; ii++) + { + fits_read_record(*fptr, ii, card, status); + if (fits_get_keyclass(card) >= 120) + fits_write_record(histptr, card, status); + } + + /* Set global variables with histogram parameter values. */ + /* Use separate scalar variables rather than arrays because */ + /* it is more efficient when computing the histogram. */ + + histData.amin1 = amin[0]; + histData.maxbin1 = maxbin[0]; + histData.binsize1 = binsize[0]; + histData.haxis1 = haxes[0]; + + if (histData.haxis > 1) + { + histData.amin2 = amin[1]; + histData.maxbin2 = maxbin[1]; + histData.binsize2 = binsize[1]; + histData.haxis2 = haxes[1]; + + if (histData.haxis > 2) + { + histData.amin3 = amin[2]; + histData.maxbin3 = maxbin[2]; + histData.binsize3 = binsize[2]; + histData.haxis3 = haxes[2]; + + if (histData.haxis > 3) + { + histData.amin4 = amin[3]; + histData.maxbin4 = maxbin[3]; + histData.binsize4 = binsize[3]; + histData.haxis4 = haxes[3]; + } + } + } + + /* define parameters of image for the iterator function */ + fits_iter_set_file(imagepars, histptr); /* pointer to image */ + fits_iter_set_datatype(imagepars, imagetype); /* image datatype */ + fits_iter_set_iotype(imagepars, OutputCol); /* image is output */ + + /* call the iterator function to write out the histogram image */ + if (fits_iterate_data(n_cols, imagepars, offset, n_per_loop, + ffwritehisto, (void*)&histData, status) ) + return(*status); + + /* write the World Coordinate System (WCS) keywords */ + /* create default values if WCS keywords are not present in the table */ + for (ii = 0; ii < histData.haxis; ii++) + { + /* CTYPEn */ + tstatus = 0; + ffkeyn("TCTYP", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus); + if (tstatus) + { /* just use column name as the type */ + tstatus = 0; + ffkeyn("TTYPE", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus); + } + + if (!tstatus) + { + ffkeyn("CTYPE", ii + 1, keyname, &tstatus); + ffpky(histptr, TSTRING, keyname, svalue, "Coordinate Type", &tstatus); + } + else + tstatus = 0; + + /* CUNITn */ + ffkeyn("TCUNI", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus); + if (tstatus) + { /* use the column units */ + tstatus = 0; + ffkeyn("TUNIT", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus); + } + + if (!tstatus) + { + ffkeyn("CUNIT", ii + 1, keyname, &tstatus); + ffpky(histptr, TSTRING, keyname, svalue, "Coordinate Units", &tstatus); + } + else + tstatus = 0; + + /* CRPIXn - Reference Pixel */ + ffkeyn("TCRPX", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus); + if (tstatus) + { + dvalue = 1.0; /* choose first pixel in new image as ref. pix. */ + tstatus = 0; + } + else + { + /* calculate locate of the ref. pix. in the new image */ + dvalue = (dvalue - amin[ii]) / binsize[ii] + .5; + } + + ffkeyn("CRPIX", ii + 1, keyname, &tstatus); + ffpky(histptr, TDOUBLE, keyname, &dvalue, "Reference Pixel", &tstatus); + + /* CRVALn - Value at the location of the reference pixel */ + ffkeyn("TCRVL", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus); + if (tstatus) + { + /* calculate value at ref. pix. location (at center of 1st pixel) */ + dvalue = amin[ii] + binsize[ii]/2.; + tstatus = 0; + } + + ffkeyn("CRVAL", ii + 1, keyname, &tstatus); + ffpky(histptr, TDOUBLE, keyname, &dvalue, "Reference Value", &tstatus); + + /* CDELTn - unit size of pixels */ + ffkeyn("TCDLT", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus); + if (tstatus) + { + dvalue = 1.0; /* use default pixel size */ + tstatus = 0; + } + + dvalue = dvalue * binsize[ii]; + ffkeyn("CDELT", ii + 1, keyname, &tstatus); + ffpky(histptr, TDOUBLE, keyname, &dvalue, "Pixel size", &tstatus); + + /* CROTAn - Rotation angle (degrees CCW) */ + /* There should only be a CROTA2 keyword, and only for 2+ D images */ + if (ii == 1) + { + ffkeyn("TCROT", histData.hcolnum[ii], keyname, &tstatus); + ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus); + if (!tstatus && dvalue != 0.) /* only write keyword if angle != 0 */ + { + ffkeyn("CROTA", ii + 1, keyname, &tstatus); + ffpky(histptr, TDOUBLE, keyname, &dvalue, + "Rotation angle", &tstatus); + } + else + { + /* didn't find CROTA for the 2nd axis, so look for one */ + /* on the first axis */ + tstatus = 0; + ffkeyn("TCROT", histData.hcolnum[0], keyname, &tstatus); + ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus); + if (!tstatus && dvalue != 0.) /* only write keyword if angle != 0 */ + { + dvalue *= -1.; /* negate the value, because mirror image */ + ffkeyn("CROTA", ii + 1, keyname, &tstatus); + ffpky(histptr, TDOUBLE, keyname, &dvalue, + "Rotation angle", &tstatus); + } + } + } + } + + /* finally, close the original file and return ptr to the new image */ + ffclos(*fptr, status); + *fptr = histptr; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_col_minmax(fitsfile *fptr, int colnum, float *datamin, + float *datamax, int *status) +/* + Simple utility routine to compute the min and max value in a column +*/ +{ + int anynul; + long nrows, ntodo, firstrow, ii; + float array[1000], nulval; + + ffgky(fptr, TLONG, "NAXIS2", &nrows, NULL, status); /* no. of rows */ + + firstrow = 1; + nulval = FLOATNULLVALUE; + *datamin = 9.0E36F; + *datamax = -9.0E36F; + + while(nrows) + { + ntodo = minvalue(nrows, 100); + ffgcv(fptr, TFLOAT, colnum, firstrow, 1, ntodo, &nulval, array, + &anynul, status); + + for (ii = 0; ii < ntodo; ii++) + { + if (array[ii] != nulval) + { + *datamin = minvalue(*datamin, array[ii]); + *datamax = maxvalue(*datamax, array[ii]); + } + } + + nrows -= ntodo; + firstrow += ntodo; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffwritehisto(long totaln, long pixoffset, long firstn, long nvalues, + int narrays, iteratorCol *imagepars, void *userPointer) +/* + Interator work function that writes out the histogram. + The histogram values are calculated by another work function, ffcalchisto. + This work function only gets called once, and totaln = nvalues. +*/ +{ + iteratorCol colpars[5]; + int ii, status = 0, ncols; + long rows_per_loop = 0, offset = 0; + histType *histData; + + histData = (histType *)userPointer; + + /* store pointer to the histogram array, and initialize to zero */ + + switch( histData->himagetype ) { + case TBYTE: + histData->hist.b = (char * ) fits_iter_get_array(imagepars); + break; + case TSHORT: + histData->hist.i = (short * ) fits_iter_get_array(imagepars); + break; + case TINT: + histData->hist.j = (int * ) fits_iter_get_array(imagepars); + break; + case TFLOAT: + histData->hist.r = (float * ) fits_iter_get_array(imagepars); + break; + case TDOUBLE: + histData->hist.d = (double *) fits_iter_get_array(imagepars); + break; + } + + /* set the column parameters for the iterator function */ + for (ii = 0; ii < histData->haxis; ii++) + { + fits_iter_set_by_num(&colpars[ii], histData->tblptr, + histData->hcolnum[ii], TFLOAT, InputCol); + } + ncols = histData->haxis; + + if (histData->weight == FLOATNULLVALUE) + { + fits_iter_set_by_num(&colpars[histData->haxis], histData->tblptr, + histData->wtcolnum, TFLOAT, InputCol); + ncols = histData->haxis + 1; + } + + /* call iterator function to calc the histogram pixel values */ + fits_iterate_data(ncols, colpars, offset, rows_per_loop, + ffcalchist, (void*)histData, &status); + + return(status); +} +/*--------------------------------------------------------------------------*/ +int ffcalchist(long totalrows, long offset, long firstrow, long nrows, + int ncols, iteratorCol *colpars, void *userPointer) +/* + Interator work function that calculates values for the 2D histogram. +*/ +{ + long ii, ipix, iaxisbin; + float pix, axisbin; + static float *col1, *col2, *col3, *col4; /* static to preserve values */ + static float *wtcol; + static long incr2, incr3, incr4; + static histType histData; + static char *rowselect; + + /* Initialization procedures: execute on the first call */ + if (firstrow == 1) + { + + /* Copy input histogram data to static local variable so we */ + /* don't have to constantly dereference it. */ + + histData = *(histType*)userPointer; + rowselect = histData.rowselector; + + /* assign the input array pointers to local pointers */ + col1 = (float *) fits_iter_get_array(&colpars[0]); + if (histData.haxis > 1) + { + col2 = (float *) fits_iter_get_array(&colpars[1]); + incr2 = histData.haxis1; + + if (histData.haxis > 2) + { + col3 = (float *) fits_iter_get_array(&colpars[2]); + incr3 = incr2 * histData.haxis2; + + if (histData.haxis > 3) + { + col4 = (float *) fits_iter_get_array(&colpars[3]); + incr4 = incr3 * histData.haxis3; + } + } + } + + if (ncols > histData.haxis) /* then weights are give in a column */ + { + wtcol = (float *) fits_iter_get_array(&colpars[histData.haxis]); + } + } /* end of Initialization procedures */ + + /* Main loop: increment the histogram at position of each event */ + for (ii = 1; ii <= nrows; ii++) + { + if (rowselect) /* if a row selector array is supplied... */ + { + if (*rowselect) + { + rowselect++; /* this row is included in the histogram */ + } + else + { + rowselect++; /* this row is excluded from the histogram */ + continue; + } + } + + if (col1[ii] == FLOATNULLVALUE) /* test for null value */ + continue; + + pix = (col1[ii] - histData.amin1) / histData.binsize1; + ipix = (long) (pix + 1.); /* add 1 because the 1st pixel is the null value */ + + /* test if bin is within range */ + if (ipix < 1 || ipix > histData.haxis1 || pix > histData.maxbin1) + continue; + + if (histData.haxis > 1) + { + if (col2[ii] == FLOATNULLVALUE) + continue; + + axisbin = (col2[ii] - histData.amin2) / histData.binsize2; + iaxisbin = axisbin; + + if (axisbin < 0. || iaxisbin >= histData.haxis2 || axisbin > histData.maxbin2) + continue; + + ipix += (iaxisbin * incr2); + + if (histData.haxis > 2) + { + if (col3[ii] == FLOATNULLVALUE) + continue; + + axisbin = (col3[ii] - histData.amin3) / histData.binsize3; + iaxisbin = axisbin; + if (axisbin < 0. || iaxisbin >= histData.haxis3 || axisbin > histData.maxbin3) + continue; + + ipix += (iaxisbin * incr3); + + if (histData.haxis > 3) + { + if (col4[ii] == FLOATNULLVALUE) + continue; + + axisbin = (col4[ii] - histData.amin4) / histData.binsize4; + iaxisbin = axisbin; + if (axisbin < 0. || iaxisbin >= histData.haxis4 || axisbin > histData.maxbin4) + continue; + + ipix += (iaxisbin * incr4); + + } /* end of haxis > 3 case */ + } /* end of haxis > 2 case */ + } /* end of haxis > 1 case */ + + /* increment the histogram pixel */ + if (histData.weight != FLOATNULLVALUE) /* constant weight factor */ + { + if (histData.himagetype == TINT) + histData.hist.j[ipix] += histData.weight; + else if (histData.himagetype == TSHORT) + histData.hist.i[ipix] += histData.weight; + else if (histData.himagetype == TFLOAT) + histData.hist.r[ipix] += histData.weight; + else if (histData.himagetype == TDOUBLE) + histData.hist.d[ipix] += histData.weight; + else if (histData.himagetype == TBYTE) + histData.hist.b[ipix] += histData.weight; + } + else if (histData.wtrecip) /* use reciprocal of the weight */ + { + if (histData.himagetype == TINT) + histData.hist.j[ipix] += 1./wtcol[ii]; + else if (histData.himagetype == TSHORT) + histData.hist.i[ipix] += 1./wtcol[ii]; + else if (histData.himagetype == TFLOAT) + histData.hist.r[ipix] += 1./wtcol[ii]; + else if (histData.himagetype == TDOUBLE) + histData.hist.d[ipix] += 1./wtcol[ii]; + else if (histData.himagetype == TBYTE) + histData.hist.b[ipix] += 1./wtcol[ii]; + } + else /* no weights */ + { + if (histData.himagetype == TINT) + histData.hist.j[ipix] += wtcol[ii]; + else if (histData.himagetype == TSHORT) + histData.hist.i[ipix] += wtcol[ii]; + else if (histData.himagetype == TFLOAT) + histData.hist.r[ipix] += wtcol[ii]; + else if (histData.himagetype == TDOUBLE) + histData.hist.d[ipix] += wtcol[ii]; + else if (histData.himagetype == TBYTE) + histData.hist.b[ipix] += wtcol[ii]; + } + + } /* end of main loop over all rows */ + + return(0); +} + diff --git a/pkg/tbtables/cfitsio/imcompress.c b/pkg/tbtables/cfitsio/imcompress.c new file mode 100644 index 00000000..fbc3842c --- /dev/null +++ b/pkg/tbtables/cfitsio/imcompress.c @@ -0,0 +1,2997 @@ +# include +# include +# include +# include +# include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int fits_set_compression_type(fitsfile *fptr, /* I - FITS file pointer */ + int ctype, /* image compression type code; */ + /* allowed values: RICE_1, GZIP_1, PLIO_1, HCOMPRESS_1 */ + int *status) /* IO - error status */ +{ +/* + This routine specifies the image compression algorithm that should be + used when writing a FITS image. The image is divided into tiles, and + each tile is compressed and stored in a row of at variable length binary + table column. +*/ + (fptr->Fptr)->request_compress_type = ctype; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_set_tile_dim(fitsfile *fptr, /* I - FITS file pointer */ + int ndim, /* number of dimensions in the compressed image */ + long *dims, /* size of image compression tile in each dimension */ + /* default tile size = (NAXIS1, 1, 1, ...) */ + int *status) /* IO - error status */ +{ +/* + This routine specifies the size (dimension) of the image + compression tiles that should be used when writing a FITS + image. The image is divided into tiles, and each tile is compressed + and stored in a row of at variable length binary table column. +*/ + int ii; + + if (ndim < 0 || ndim > MAX_COMPRESS_DIM) + { + *status = BAD_DIMEN; + return(*status); + } + + for (ii = 0; ii < ndim; ii++) + { + (fptr->Fptr)->request_tilesize[ii] = dims[ii]; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_set_noise_bits(fitsfile *fptr, /* I - FITS file pointer */ + int noisebits, /* noise_bits parameter value */ + /* (default = 4) */ + int *status) /* IO - error status */ +{ +/* + This routine specifies the value of the noice_bits parameter that + should be used when compressing floating point images. The image is + divided into tiles, and each tile is compressed and stored in a row + of at variable length binary table column. +*/ + if (noisebits < 1 || noisebits > 16) + { + *status = DATA_COMPRESSION_ERR; + return(*status); + } + + (fptr->Fptr)->request_rice_nbits = noisebits; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_compression_type(fitsfile *fptr, /* I - FITS file pointer */ + int *ctype, /* image compression type code; */ + /* allowed values: RICE_1, GZIP_1, PLIO_1, HCOMPRESS_1 */ + int *status) /* IO - error status */ +{ +/* + This routine returns the image compression algorithm that should be + used when writing a FITS image. The image is divided into tiles, and + each tile is compressed and stored in a row of at variable length binary + table column. +*/ + *ctype = (fptr->Fptr)->request_compress_type; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_tile_dim(fitsfile *fptr, /* I - FITS file pointer */ + int ndim, /* number of dimensions in the compressed image */ + long *dims, /* size of image compression tile in each dimension */ + /* default tile size = (NAXIS1, 1, 1, ...) */ + int *status) /* IO - error status */ +{ +/* + This routine returns the size (dimension) of the image + compression tiles that should be used when writing a FITS + image. The image is divided into tiles, and each tile is compressed + and stored in a row of at variable length binary table column. +*/ + int ii; + + if (ndim < 0 || ndim > MAX_COMPRESS_DIM) + { + *status = BAD_DIMEN; + return(*status); + } + + for (ii = 0; ii < ndim; ii++) + { + dims[ii] = (fptr->Fptr)->request_tilesize[ii]; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_noise_bits(fitsfile *fptr, /* I - FITS file pointer */ + int *noisebits, /* noise_bits parameter value */ + /* (default = 4) */ + int *status) /* IO - error status */ + +{ +/* + This routine returns the value of the noice_bits parameter that + should be used when compressing floating point images. The image is + divided into tiles, and each tile is compressed and stored in a row + of at variable length binary table column. +*/ + + *noisebits = (fptr->Fptr)->request_rice_nbits; + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_compress_img(fitsfile *infptr, /* pointer to image to be compressed */ + fitsfile *outfptr, /* empty HDU for output compressed image */ + int compress_type, /* compression type code */ + /* RICE_1, HCOMPRESS_1, etc. */ + long *intilesize, /* size in each dimension of the tiles */ + /* NULL pointer means tile by rows */ + int blocksize, /* compression parameter: blocksize */ + int nbits, /* compression parameter: nbits */ + int *status) /* IO - error status */ + +/* + This routine initializes the output table, copies all the keywords, + and loops through the input image, compressing the data and + writing the compressed tiles to the output table. +*/ +{ + int ii, bitpix, naxis; + long naxes[MAX_COMPRESS_DIM], tilesize[MAX_COMPRESS_DIM]; + + if (*status > 0) + return(*status); + + /* get datatype and size of input image */ + if (fits_get_img_param(infptr, MAX_COMPRESS_DIM, &bitpix, + &naxis, naxes, status) > 0) + return(*status); + + if (naxis < 1 || naxis > MAX_COMPRESS_DIM) + { + ffpmsg("Image cannot be compressed: NAXIS out of range"); + return(*status = BAD_NAXIS); + } + + /* determine tile size */ + if (intilesize == NULL) /* caller did not specify tile size? */ + { + /* default case; compress each row of the image separately */ + tilesize[0] = naxes[0]; + for (ii = 1; ii < naxis; ii++) + { + tilesize[ii] = 1; + } + } + else + { + /* limit max tile size in each dimension to size of dimension */ + for (ii = 0; ii < naxis; ii++) + { + tilesize[ii] = minvalue(intilesize[ii], naxes[ii]); + } + } + + if (blocksize <= 0) + blocksize = 32; /* default value */ + + if (nbits <= 0) + nbits = 4; /* default value */ + + /* initialize output table */ + if (imcomp_init_table(outfptr, compress_type, bitpix, naxis, naxes, + tilesize, blocksize, nbits, status) > 0) + return (*status); + + /* Copy the image header keywords to the table header. */ + if (imcomp_copy_imheader(infptr, outfptr, status) > 0) + return (*status); + + /* turn off any intensity scaling (defined by BSCALE and BZERO */ + /* keywords) so that unscaled values will be read by CFITSIO */ + ffpscl(infptr, 1.0, 0.0, status); + + /* force a rescan of the output file keywords, so that */ + /* the compression parameters will be copied to the internal */ + /* fitsfile structure used by CFITSIO */ + ffrdef(outfptr, status); + + /* Read each image tile, compress, and write to a table row. */ + imcomp_compress_image (infptr, outfptr, status); + + /* force another rescan of the output file keywords, to */ + /* update PCOUNT and TFORMn = '1PB(iii)' keyword values. */ + ffrdef(outfptr, status); + + return (*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_init_table(fitsfile *outfptr, + int compress_type, + int bitpix, + int naxis, + long *naxes, + long *tiledim, + int rice_blocksize, + int rice_nbits, + int *status) + +/* + create a BINTABLE extension for the output compressed image. +*/ +{ + char keyname[FLEN_KEYWORD], zcmptype[12]; + int ii, ncols; + long nrows, tilesize[9] = {0,1,1,1,1,1,1,1,1}; + char *ttype[] = {"COMPRESSED_DATA", "UNCOMPRESSED_DATA", "ZSCALE", "ZZERO"}; + char *tform[4]; + char tf0[4], tf1[4], tf2[4], tf3[4]; + char *tunit[] = {"\0", "\0", "\0", "\0" }; + + if (*status > 0) + return(*status); + + for (ii = 0; ii < naxis; ii++) + tilesize[ii] = tiledim[ii]; /* copy input to local variable */ + + /* if legal tile dimensions are not defined, use NAXIS1 as the */ + /* first dimension and 1 for all the higher dimensions */ + + if (tilesize[0] <= 0) + tilesize[0] = naxes[0]; + + for (ii = 1; ii < naxis; ii++) + { + if (tilesize[ii] <= 0) + tilesize[ii] = 1; + } + + /* (only used to quantize floating point images) */ + if (rice_nbits < 1) /* use default value if input is not legal */ + rice_nbits = 4; + + /* ---- set up array of TFORM strings -------------------------------*/ + strcpy(tf0, "1PB"); + strcpy(tf2, "1D"); + strcpy(tf3, "1D"); + + tform[0] = tf0; + tform[1] = tf1; + tform[2] = tf2; + tform[3] = tf3; + + /* calculate number of rows in output table */ + nrows = 1; + for (ii = 0; ii < naxis; ii++) + { + nrows = nrows * ((naxes[ii] - 1)/ tilesize[ii] + 1); + } + + if (bitpix < 0 ) /* floating point image */ + ncols = 4; + else + ncols = 1; /* default table has just one 'COMPRESSED_DATA' column */ + + if (compress_type == RICE_1) + { + strcpy(zcmptype, "RICE_1"); + } + else if (compress_type == GZIP_1) + { + strcpy(zcmptype, "GZIP_1"); + } + else if (compress_type == PLIO_1) + { + strcpy(zcmptype, "PLIO_1"); + /* the PLIO compression algorithm outputs short integers, not bytes */ + strcpy(tform[0], "1PI"); + } + else if (compress_type == HCOMPRESS_1) + { + strcpy(zcmptype, "HCOMPRESS_1"); + } + else + { + ffpmsg("unknown compression type (imcomp_init_table)"); + return(*status = DATA_COMPRESSION_ERR); + } + + /* set correct datatype for any tiles that cannot be compressed */ + if (bitpix == SHORT_IMG) + strcpy(tform[1], "1PI"); + else if (bitpix == LONG_IMG) + strcpy(tform[1], "1PJ"); + else if (bitpix == FLOAT_IMG) + strcpy(tform[1], "1PE"); + else if (bitpix == DOUBLE_IMG) + strcpy(tform[1], "1PD"); + + /* create the bintable extension to contain the compressed image */ + ffcrtb(outfptr, BINARY_TBL, nrows, ncols, ttype, + tform, tunit, "COMPRESSED_IMAGE", status); + + /* Add standard header keywords. */ + ffpkyl (outfptr, "ZIMAGE", 1, + "extension contains compressed image", status); + + ffpkyj (outfptr, "ZBITPIX", (long) bitpix, + "data type of original image", status); + ffpkyj (outfptr, "ZNAXIS", (long) naxis, + "dimension of original image", status); + + for (ii = 0; ii < naxis; ii++) + { + sprintf (keyname, "ZNAXIS%d", ii+1); + ffpkyj (outfptr, keyname, naxes[ii], + "length of original image axis", status); + } + + for (ii = 0; ii < naxis; ii++) + { + sprintf (keyname, "ZTILE%d", ii+1); + ffpkyj (outfptr, keyname, tilesize[ii], + "size of tiles to be compressed", status); + } + + ffpkys (outfptr, "ZCMPTYPE", zcmptype, + "compression algorithm", status); + + + /* write any algorithm-specific keywords */ + if (compress_type == RICE_1) + { + ffpkys (outfptr, "ZNAME1", "BLOCKSIZE", + "compression block size", status); + ffpkyj (outfptr, "ZVAL1", (long) rice_blocksize, + "pixels per block", status); + + if (bitpix < 0 ) /* floating point image */ + { + ffpkys (outfptr, "ZNAME2", "NOISEBIT", + "floating point quantization level", status); + + ffpkyj (outfptr, "ZVAL2", (long) rice_nbits, + "floating point quantization level", status); + } + } + else + { + if (bitpix < 0 ) /* floating point image */ + { + ffpkys (outfptr, "ZNAME1", "NOISEBIT", + "floating point quantization level", status); + + ffpkyj (outfptr, "ZVAL1", (long) rice_nbits, + "floating point quantization level", status); + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_calc_max_elem (int comptype, int nx, int blocksize) + +/* This function returns the maximum number of bytes in a compressed + image line. +*/ +{ + if (comptype == RICE_1) + { + return (sizeof(float) * nx + nx / blocksize + 2 + 4); + } + else if (comptype == GZIP_1) + { + /* gzip usually compressed by at least a factor of 2 */ + /* If this size turns out to be too small, then the gzip */ + /* compression routine will allocate more space as required */ + + return(nx * sizeof(int) / 2); + } + else + return(nx * sizeof(int)); +} +/*--------------------------------------------------------------------------*/ +int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr, int *status) + +/* This routine does the following: + - reads an image one tile at a time + - if it is a float or double image, then it quantizes the pixels + - compresses the integer pixel values + - writes the compressed byte stream to the FITS file. + + If the tile cannot be quantized than the raw float or double values + are written to the output table. + +*/ +{ + double *tiledata = 0; + int anynul, gotnulls = 0, datatype, tstatus, colnum; + long ii, row, nelem, offset; + int naxis; + long maxtilelen, tilelen, incre[] = {1, 1, 1, 1, 1, 1}; + long naxes[MAX_COMPRESS_DIM], fpixel[MAX_COMPRESS_DIM]; + long lpixel[MAX_COMPRESS_DIM], tile[MAX_COMPRESS_DIM]; + long tilesize[MAX_COMPRESS_DIM]; + long i0, i1, i2, i3, i4, i5; + char card[FLEN_CARD]; + + if (*status > 0) + return(*status); + + maxtilelen = (outfptr->Fptr)->maxtilelen; + + /* allocate buffer to hold 1 tile of data */ + if ((outfptr->Fptr)->zbitpix == FLOAT_IMG) + { + datatype = TFLOAT; + tiledata = (double*) calloc (maxtilelen, sizeof (float)); + } + else if ((outfptr->Fptr)->zbitpix == DOUBLE_IMG) + { + datatype = TDOUBLE; + tiledata = (double*) calloc (maxtilelen, sizeof (double)); + } + else + { + datatype = TINT; + tiledata = (double*) calloc (maxtilelen, sizeof (int)); + } + + if (tiledata == NULL) + { + ffpmsg("Out of memory. (imcomp_compress_image)"); + return (*status = MEMORY_ALLOCATION); + } + + /* calculate size of tile in each dimension */ + naxis = (outfptr->Fptr)->zndim; + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + if (ii < naxis) + { + naxes[ii] = (outfptr->Fptr)->znaxis[ii]; + tilesize[ii] = (outfptr->Fptr)->tilesize[ii]; + } + else + { + naxes[ii] = 1; + tilesize[ii] = 1; + } + } + row = 1; + + /* set up big loop over up to 6 dimensions */ + for (i5 = 1; i5 <= naxes[5]; i5 += tilesize[5]) + { + fpixel[5] = i5; + lpixel[5] = minvalue(i5 + tilesize[5] - 1, naxes[5]); + tile[5] = lpixel[5] - fpixel[5] + 1; + for (i4 = 1; i4 <= naxes[4]; i4 += tilesize[4]) + { + fpixel[4] = i4; + lpixel[4] = minvalue(i4 + tilesize[4] - 1, naxes[4]); + tile[4] = lpixel[4] - fpixel[4] + 1; + for (i3 = 1; i3 <= naxes[3]; i3 += tilesize[3]) + { + fpixel[3] = i3; + lpixel[3] = minvalue(i3 + tilesize[3] - 1, naxes[3]); + tile[3] = lpixel[3] - fpixel[3] + 1; + for (i2 = 1; i2 <= naxes[2]; i2 += tilesize[2]) + { + fpixel[2] = i2; + lpixel[2] = minvalue(i2 + tilesize[2] - 1, naxes[2]); + tile[2] = lpixel[2] - fpixel[2] + 1; + for (i1 = 1; i1 <= naxes[1]; i1 += tilesize[1]) + { + fpixel[1] = i1; + lpixel[1] = minvalue(i1 + tilesize[1] - 1, naxes[1]); + tile[1] = lpixel[1] - fpixel[1] + 1; + for (i0 = 1; i0 <= naxes[0]; i0 += tilesize[0]) + { + fpixel[0] = i0; + lpixel[0] = minvalue(i0 + tilesize[0] - 1, naxes[0]); + tile[0] = lpixel[0] - fpixel[0] + 1; + + /* number of pixels in this tile */ + tilelen = tile[0]; + for (ii = 1; ii < naxis; ii++) + { + tilelen *= tile[ii]; + } + + /* read next tile of data from image */ + if (datatype == TFLOAT) + { + ffgsve(infptr, 1, naxis, naxes, fpixel, lpixel, incre, + FLOATNULLVALUE, (float *) tiledata, &anynul, status); + } + else if (datatype == TDOUBLE) + { + ffgsvd(infptr, 1, naxis, naxes, fpixel, lpixel, incre, + DOUBLENULLVALUE, tiledata, &anynul, status); + } + else /* read all integer data types as int */ + { + ffgsvk(infptr, 1, naxis, naxes, fpixel, lpixel, incre, + 0, (int *) tiledata, &anynul, status); + } + + /* now compress the tile, and write to row of binary table */ + + imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen, + status); + + /* set flag if we found any null values */ + if (anynul) + gotnulls = 1; + + /* check for any error in the previous operations */ + if (*status > 0) + { + ffpmsg("Error writing compressed image to table"); + free(tiledata); + return (*status); + } + + row++; + } + } + } + } + } + } + + free (tiledata); /* finished with this buffer */ + + /* insert ZBLANK keyword if necessary */ + if (gotnulls) + { + ffgcrd(outfptr, "ZCMPTYPE", card, status); + ffikyj(outfptr, "ZBLANK", COMPRESS_NULL_VALUE, + "null value in the compressed integer array", status); + } + + if (datatype >= TFLOAT ) + { + /* check if any data were written to the UNCOMPRESSED_DATA column */ + /* If not, then delete that column from the table */ + for (ii = 1; ii < row; ii++) + { + ffgdes (outfptr, (outfptr->Fptr)->cn_uncompressed, ii, + &nelem, &offset, status); + if (nelem) + break; + } + + if (!nelem) + { + tstatus = 0; + ffgcno(outfptr, CASEINSEN, "UNCOMPRESSED_DATA", &colnum, &tstatus); + if (tstatus == 0) + { + /* make sure table is properly terminated before deleting col */ + /* (in particular, make sure the '1PB(nnn)' keyword is updated */ + ffrdef(outfptr, status); + ffdcol(outfptr, colnum, status); + } + } + } + + return (*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_compress_tile (fitsfile *outfptr, + long row, + int datatype, + void *tiledata, + long tilelen, + int *status) + +/* + This is the main compression routine. + + This routine does the following to the input tile of pixels: + - if it is a float or double image, then it quantizes the pixels + - compresses the integer pixel values + - writes the compressed byte stream to the FITS file. + + If the tile cannot be quantized than the raw float or double values + are written to the output table. +*/ +{ + int *idata = 0; /* quantized integer data */ + short *cbuf; /* compressed data */ + int clen; /* size of cbuf */ + int flag = 1; /* true if data were quantized */ + int iminval = 0, imaxval = 0; /* min and max quantized integers */ + double bscale[1] = {1.}, bzero[1] = {0.}; /* scaling parameters */ + int nelem = 0; /* number of bytes */ + size_t gzip_nelem = 0; + long ii; + + if (*status > 0) + return(*status); + + if (datatype == TINT || datatype == TUINT) + { + /* POTENTIAL BUG?? When reading unsigned int values they will be */ + /* interpret them as signed integers? */ + idata = tiledata; + } + else + { + idata = (int*) calloc (tilelen, sizeof (int)); + if (idata == NULL) + { + ffpmsg("Out of memory. (imcomp_compress_tile)"); + return (*status = MEMORY_ALLOCATION); + } + + if (datatype == TSHORT) + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((short *)tiledata)[ii]; + } + else if (datatype == TUSHORT) + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((unsigned short *)tiledata)[ii]; + } + else if (datatype == TLONG) + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((long *)tiledata)[ii]; + } + else if (datatype == TBYTE) + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((unsigned char *)tiledata)[ii]; + } + else if (datatype == TSBYTE) + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((signed char *)tiledata)[ii]; + } + else if (datatype == TFLOAT) + { + /* if the tile-compressed table contains zscale and zzero columns */ + /* then scale and quantize the input floating point data. */ + /* Otherwise, just truncate the floats to integers. */ + if ((outfptr->Fptr)->cn_zscale > 0) + { + /* quantize the float values into integers */ + flag = fits_quantize_float ((float *) tiledata, tilelen, + FLOATNULLVALUE, (outfptr->Fptr)->rice_nbits, idata, + bscale, bzero, &iminval, &imaxval); + } + else + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((float *)tiledata)[ii]; + } + } + else if (datatype == TDOUBLE) + { + /* if the tile-compressed table contains zscale and zzero columns */ + /* then scale and quantize the input floating point data. */ + /* Otherwise, just truncate the floats to integers. */ + if ((outfptr->Fptr)->cn_zscale > 0) + { + /* quantize the double values into integers */ + flag = fits_quantize_double ((double *) tiledata, tilelen, + DOUBLENULLVALUE, (outfptr->Fptr)->rice_nbits, idata, + bscale, bzero, &iminval, &imaxval); + } + else + { + for (ii = 0; ii < tilelen; ii++) + idata[ii] = ((double *)tiledata)[ii]; + } + } + else + { + ffpmsg("unsupported datatype for compressing image"); + free(idata); + return(*status = BAD_DATATYPE); + } + } + + if (flag) + { + /* allocate buffer for the compressed tile bytes */ + clen = (outfptr->Fptr)->maxelem; + cbuf = (short *) calloc (clen, sizeof (unsigned char)); + if (cbuf == NULL) + { + ffpmsg("Out of memory. (imcomp_compress_tile)"); + if (datatype != TINT && datatype != TUINT) + free(idata); + return (*status = MEMORY_ALLOCATION); + } + + /* Compress the integer data, then write the compressed bytes */ + if ( (outfptr->Fptr)->compress_type == RICE_1) + { + nelem = fits_rcomp (idata, tilelen, (unsigned char *) cbuf, + clen, (outfptr->Fptr)->rice_blocksize); + + /* Write the compressed byte stream. */ + ffpclb(outfptr, (outfptr->Fptr)->cn_compressed, row, 1, + nelem, (unsigned char *) cbuf, status); + } + else if ( (outfptr->Fptr)->compress_type == PLIO_1) + { + if (iminval < 0 || imaxval > 16777215) + { + /* plio algorithn only supports positive 24 bit ints */ + ffpmsg("data out of range for PLIO compression (0 - 2**24)"); + if (datatype != TINT && datatype != TUINT) + free(idata); + return(*status = DATA_DECOMPRESSION_ERR); + } + + nelem = pl_p2li (idata, 1, cbuf, tilelen); + + /* Write the compressed byte stream. */ + ffpcli(outfptr, (outfptr->Fptr)->cn_compressed, row, 1, + nelem, cbuf, status); + } + else if ( (outfptr->Fptr)->compress_type == GZIP_1) + { + +#if BYTESWAPPED + ffswap4(idata, tilelen); /* reverse order of bytes */ +#endif + compress2mem_from_mem((char *) idata, tilelen * sizeof(int), + (char **) &cbuf, (size_t *) &clen, realloc, + &gzip_nelem, status); + + /* Write the compressed byte stream. */ + ffpclb(outfptr, (outfptr->Fptr)->cn_compressed, row, 1, + gzip_nelem, (unsigned char *) cbuf, status); + } + else if ( (outfptr->Fptr)->compress_type == HCOMPRESS_1) + { + /* add support for this compression algorithm here */ + } + + if (nelem < 0) /* error condition */ + { + if (datatype != TINT && datatype != TUINT) + free(idata); + free (cbuf); + ffpmsg + ("error compressing row of the image (imcomp_compress_tile)"); + return (*status = DATA_COMPRESSION_ERR); + } + + if ((outfptr->Fptr)->cn_zscale > 0) + { + /* write the linear scaling parameters */ + ffpcld (outfptr, (outfptr->Fptr)->cn_zscale, row, 1, 1, + bscale, status); + ffpcld (outfptr, (outfptr->Fptr)->cn_zzero, row, 1, 1, + bzero, status); + } + + free(cbuf); /* finished with this buffer */ + } + else /* floating point data couldn't be quantized */ + { + /* Write the original floating point data. */ + if (datatype == TFLOAT) + { + ffpcle (outfptr, (outfptr->Fptr)->cn_uncompressed, row, 1, + tilelen, (float *)tiledata, status); + } + else if (datatype == TDOUBLE) + { + ffpcld (outfptr, (outfptr->Fptr)->cn_uncompressed, row, 1, + tilelen, (double *)tiledata, status); + } + } + + if (datatype != TINT && datatype != TUINT) + free(idata); + + return (*status); +} +/*---------------------------------------------------------------------------*/ +int fits_write_compressed_img(fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the array to be written */ + long *infpixel, /* I - 'bottom left corner' of the subsection */ + long *inlpixel, /* I - 'top right corner' of the subsection */ + int nullcheck, /* I - 0 for no null checking */ + /* 1: pixels that are = nullval will be */ + /* written with the FITS null pixel value */ + /* (floating point arrays only) */ + void *array, /* I - array of values to be written */ + void *nullval, /* I - undefined pixel value (floating pt only) */ + int *status) /* IO - error status */ +/* + Write a section of a compressed image. +*/ +{ + int naxis[MAX_COMPRESS_DIM], tiledim[MAX_COMPRESS_DIM]; + long tilesize[MAX_COMPRESS_DIM], thistilesize[MAX_COMPRESS_DIM]; + long ftile[MAX_COMPRESS_DIM], ltile[MAX_COMPRESS_DIM]; + long tfpixel[MAX_COMPRESS_DIM], tlpixel[MAX_COMPRESS_DIM]; + long rowdim[MAX_COMPRESS_DIM], offset[MAX_COMPRESS_DIM],ntemp; + long fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM]; + int ii, i5, i4, i3, i2, i1, i0, ndim, irow, pixlen, tilenul; + void *buffer; + char *bnullarray = 0; + + if (*status > 0) + return(*status); + + if (!fits_is_compressed_image(fptr, status) ) + { + ffpmsg("CHDU is not a compressed image (fits_write_compressed_img)"); + return(*status = DATA_COMPRESSION_ERR); + } + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + /* get temporary space for uncompressing one image tile */ + if (datatype == TSHORT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (short)); + pixlen = sizeof(short); + } + else if (datatype == TINT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (int)); + pixlen = sizeof(int); + } + else if (datatype == TLONG) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (long)); + pixlen = sizeof(long); + } + else if (datatype == TFLOAT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (float)); + pixlen = sizeof(float); + } + else if (datatype == TDOUBLE) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (double)); + pixlen = sizeof(double); + } + else if (datatype == TUSHORT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (unsigned short)); + pixlen = sizeof(short); + } + else if (datatype == TUINT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (unsigned int)); + pixlen = sizeof(int); + } + else if (datatype == TULONG) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (unsigned long)); + pixlen = sizeof(long); + } + else if (datatype == TBYTE || datatype == TSBYTE) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (char)); + pixlen = 1; + } + else + { + ffpmsg("unsupported datatype for compressing image"); + return(*status = BAD_DATATYPE); + } + + if (buffer == NULL) + { + ffpmsg("Out of memory (fits_write_compress_img)"); + return (*status = MEMORY_ALLOCATION); + } + + /* initialize all the arrays */ + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + naxis[ii] = 1; + tiledim[ii] = 1; + tilesize[ii] = 1; + ftile[ii] = 1; + ltile[ii] = 1; + rowdim[ii] = 1; + } + + ndim = (fptr->Fptr)->zndim; + ntemp = 1; + for (ii = 0; ii < ndim; ii++) + { + fpixel[ii] = infpixel[ii]; + lpixel[ii] = inlpixel[ii]; + + /* calc number of tiles in each dimension, and tile containing */ + /* the first and last pixel we want to read in each dimension */ + naxis[ii] = (fptr->Fptr)->znaxis[ii]; + if (fpixel[ii] < 1) + { + free(buffer); + return(*status = BAD_PIX_NUM); + } + + tilesize[ii] = (fptr->Fptr)->tilesize[ii]; + tiledim[ii] = (naxis[ii] - 1) / tilesize[ii] + 1; + ftile[ii] = (fpixel[ii] - 1) / tilesize[ii] + 1; + ltile[ii] = minvalue((lpixel[ii] - 1) / tilesize[ii] + 1, + tiledim[ii]); + rowdim[ii] = ntemp; /* total tiles in each dimension */ + ntemp *= tiledim[ii]; + } + + /* support up to 6 dimensions for now */ + /* tfpixel and tlpixel are the first and last image pixels */ + /* along each dimension of the compression tile */ + for (i5 = ftile[5]; i5 <= ltile[5]; i5++) + { + tfpixel[5] = (i5 - 1) * tilesize[5] + 1; + tlpixel[5] = minvalue(tfpixel[5] + tilesize[5] - 1, + naxis[5]); + thistilesize[5] = tlpixel[5] - tfpixel[5] + 1; + offset[5] = (i5 - 1) * rowdim[5]; + for (i4 = ftile[4]; i4 <= ltile[4]; i4++) + { + tfpixel[4] = (i4 - 1) * tilesize[4] + 1; + tlpixel[4] = minvalue(tfpixel[4] + tilesize[4] - 1, + naxis[4]); + thistilesize[4] = thistilesize[5] * (tlpixel[4] - tfpixel[4] + 1); + offset[4] = (i4 - 1) * rowdim[4] + offset[5]; + for (i3 = ftile[3]; i3 <= ltile[3]; i3++) + { + tfpixel[3] = (i3 - 1) * tilesize[3] + 1; + tlpixel[3] = minvalue(tfpixel[3] + tilesize[3] - 1, + naxis[3]); + thistilesize[3] = thistilesize[4] * (tlpixel[3] - tfpixel[3] + 1); + offset[3] = (i3 - 1) * rowdim[3] + offset[4]; + for (i2 = ftile[2]; i2 <= ltile[2]; i2++) + { + tfpixel[2] = (i2 - 1) * tilesize[2] + 1; + tlpixel[2] = minvalue(tfpixel[2] + tilesize[2] - 1, + naxis[2]); + thistilesize[2] = thistilesize[3] * (tlpixel[2] - tfpixel[2] + 1); + offset[2] = (i2 - 1) * rowdim[2] + offset[3]; + for (i1 = ftile[1]; i1 <= ltile[1]; i1++) + { + tfpixel[1] = (i1 - 1) * tilesize[1] + 1; + tlpixel[1] = minvalue(tfpixel[1] + tilesize[1] - 1, + naxis[1]); + thistilesize[1] = thistilesize[2] * (tlpixel[1] - tfpixel[1] + 1); + offset[1] = (i1 - 1) * rowdim[1] + offset[2]; + for (i0 = ftile[0]; i0 <= ltile[0]; i0++) + { + tfpixel[0] = (i0 - 1) * tilesize[0] + 1; + tlpixel[0] = minvalue(tfpixel[0] + tilesize[0] - 1, + naxis[0]); + thistilesize[0] = thistilesize[1] * (tlpixel[0] - tfpixel[0] + 1); + /* calculate row of table containing this tile */ + irow = i0 + offset[1]; + + /* read and uncompress this row (tile) of the table */ + /* also do type conversion and undefined pixel substitution */ + /* at this point */ + + imcomp_decompress_tile(fptr, irow, thistilesize[0], + datatype, nullcheck, nullval, buffer, bnullarray, &tilenul, + status); + + if (*status == NO_COMPRESSED_TILE) + { + /* tile doesn't exist, so initialize to zero */ + memset(buffer, 0, pixlen * thistilesize[0]); + *status = 0; + } + + /* copy the intersecting pixels to this tile from the input */ + imcomp_merge_overlap(buffer, pixlen, ndim, tfpixel, tlpixel, + bnullarray, array, fpixel, lpixel, nullcheck, status); + + /* compress the tile again, and write it back to the FITS file */ + imcomp_compress_tile (fptr, irow, datatype, buffer, + thistilesize[0], status); + } + } + } + } + } + } + free(buffer); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_write_compressed_pixels(fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the array to be written */ + OFF_T fpixel, /* I - 'first pixel to write */ + long npixel, /* I - number of pixels to write */ + int nullcheck, /* I - 0 for no null checking */ + /* 1: pixels that are = nullval will be */ + /* written with the FITS null pixel value */ + /* (floating point arrays only) */ + void *array, /* I - array of values to write */ + void *nullval, /* I - value used to represent undefined pixels*/ + int *status) /* IO - error status */ +/* + Write a consecutive set of pixels to a compressed image. This routine + interpretes the n-dimensional image as a long one-dimensional array. + This is actually a rather inconvenient way to write compressed images in + general, and could be rather inefficient if the requested pixels to be + written are located in many different image compression tiles. + + The general strategy used here is to write the requested pixels in blocks + that correspond to rectangular image sections. +*/ +{ + int naxis, ii, bytesperpixel; + long naxes[MAX_COMPRESS_DIM], nread; + OFF_T tfirst, tlast, last0, last1, dimsize[MAX_COMPRESS_DIM]; + long nplane, firstcoord[MAX_COMPRESS_DIM], lastcoord[MAX_COMPRESS_DIM]; + char *arrayptr; + + if (*status > 0) + return(*status); + + arrayptr = (char *) array; + + /* get size of array pixels, in bytes */ + bytesperpixel = ffpxsz(datatype); + + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + naxes[ii] = 1; + firstcoord[ii] = 0; + lastcoord[ii] = 0; + } + + /* determine the dimensions of the image to be read */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, MAX_COMPRESS_DIM, naxes, status); + + /* calc the cumulative number of pixels in each successive dimension */ + dimsize[0] = 1; + for (ii = 1; ii < MAX_COMPRESS_DIM; ii++) + dimsize[ii] = dimsize[ii - 1] * naxes[ii - 1]; + + /* determine the coordinate of the first and last pixel in the image */ + /* Use zero based indexes here */ + tfirst = fpixel - 1; + tlast = tfirst + npixel - 1; + for (ii = naxis - 1; ii >= 0; ii--) + { + firstcoord[ii] = tfirst / dimsize[ii]; + lastcoord[ii] = tlast / dimsize[ii]; + tfirst = tfirst - firstcoord[ii] * dimsize[ii]; + tlast = tlast - lastcoord[ii] * dimsize[ii]; + } + + /* to simplify things, treat 1-D, 2-D, and 3-D images as separate cases */ + + if (naxis == 1) + { + /* Simple: just write the requested range of pixels */ + + firstcoord[0] = firstcoord[0] + 1; + lastcoord[0] = lastcoord[0] + 1; + fits_write_compressed_img(fptr, datatype, firstcoord, lastcoord, + nullcheck, array, nullval, status); + return(*status); + } + else if (naxis == 2) + { + nplane = 0; /* write 1st (and only) plane of the image */ + + fits_write_compressed_img_plane(fptr, datatype, bytesperpixel, + nplane, firstcoord, lastcoord, naxes, nullcheck, + array, nullval, &nread, status); + } + else if (naxis == 3) + { + /* test for special case: writing an integral number of planes */ + if (firstcoord[0] == 0 && firstcoord[1] == 0 && + lastcoord[0] == naxes[0] - 1 && lastcoord[1] == naxes[1] - 1) + { + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + /* convert from zero base to 1 base */ + (firstcoord[ii])++; + (lastcoord[ii])++; + } + + /* we can write the contiguous block of pixels in one go */ + fits_write_compressed_img(fptr, datatype, firstcoord, lastcoord, + nullcheck, array, nullval, status); + return(*status); + } + + /* save last coordinate in temporary variables */ + last0 = lastcoord[0]; + last1 = lastcoord[1]; + + if (firstcoord[2] < lastcoord[2]) + { + /* we will write up to the last pixel in all but the last plane */ + lastcoord[0] = naxes[0] - 1; + lastcoord[1] = naxes[1] - 1; + } + + /* write one plane of the cube at a time, for simplicity */ + for (nplane = firstcoord[2]; nplane <= lastcoord[2]; nplane++) + { + if (nplane == lastcoord[2]) + { + lastcoord[0] = last0; + lastcoord[1] = last1; + } + + fits_write_compressed_img_plane(fptr, datatype, bytesperpixel, + nplane, firstcoord, lastcoord, naxes, nullcheck, + arrayptr, nullval, &nread, status); + + /* for all subsequent planes, we start with the first pixel */ + firstcoord[0] = 0; + firstcoord[1] = 0; + + /* increment pointers to next elements to be written */ + arrayptr = arrayptr + nread * bytesperpixel; + } + } + else + { + ffpmsg("only 1D, 2D, or 3D images are currently supported"); + return(*status = DATA_COMPRESSION_ERR); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_write_compressed_img_plane(fitsfile *fptr, /* I - FITS file */ + int datatype, /* I - datatype of the array to be written */ + int bytesperpixel, /* I - number of bytes per pixel in array */ + long nplane, /* I - which plane of the cube to write */ + long *firstcoord, /* I coordinate of first pixel to write */ + long *lastcoord, /* I coordinate of last pixel to write */ + long *naxes, /* I size of each image dimension */ + int nullcheck, /* I - 0 for no null checking */ + /* 1: pixels that are = nullval will be */ + /* written with the FITS null pixel value */ + /* (floating point arrays only) */ + void *array, /* I - array of values that are written */ + void *nullval, /* I - value for undefined pixels */ + long *nread, /* O - total number of pixels written */ + int *status) /* IO - error status */ + + /* + in general we have to write the first partial row of the image, + followed by the middle complete rows, followed by the last + partial row of the image. If the first or last rows are complete, + then write them at the same time as all the middle rows. + */ +{ + /* bottom left coord. and top right coord. */ + long blc[MAX_COMPRESS_DIM], trc[MAX_COMPRESS_DIM]; + char *arrayptr; + + *nread = 0; + + arrayptr = (char *) array; + + blc[2] = nplane + 1; + trc[2] = nplane + 1; + + if (firstcoord[0] != 0) + { + /* have to read a partial first row */ + blc[0] = firstcoord[0] + 1; + blc[1] = firstcoord[1] + 1; + trc[1] = blc[1]; + if (lastcoord[1] == firstcoord[1]) + trc[0] = lastcoord[0] + 1; /* 1st and last pixels in same row */ + else + trc[0] = naxes[0]; /* read entire rest of the row */ + + fits_write_compressed_img(fptr, datatype, blc, trc, + nullcheck, arrayptr, nullval, status); + + *nread = *nread + trc[0] - blc[0] + 1; + + if (lastcoord[1] == firstcoord[1]) + { + return(*status); /* finished */ + } + + /* set starting coord to beginning of next line */ + firstcoord[0] = 0; + firstcoord[1] += 1; + arrayptr = arrayptr + (trc[0] - blc[0] + 1) * bytesperpixel; + } + + /* write contiguous complete rows of the image, if any */ + blc[0] = 1; + blc[1] = firstcoord[1] + 1; + trc[0] = naxes[0]; + + if (lastcoord[0] + 1 == naxes[0]) + { + /* can write the last complete row, too */ + trc[1] = lastcoord[1] + 1; + } + else + { + /* last row is incomplete; have to read it separately */ + trc[1] = lastcoord[1]; + } + + if (trc[1] >= blc[1]) /* must have at least one whole line to read */ + { + fits_write_compressed_img(fptr, datatype, blc, trc, + nullcheck, arrayptr, nullval, status); + + *nread = *nread + (trc[1] - blc[1] + 1) * naxes[0]; + + if (lastcoord[1] + 1 == trc[1]) + return(*status); /* finished */ + + /* increment pointers for the last partial row */ + arrayptr = arrayptr + (trc[1] - blc[1] + 1) * naxes[0] * bytesperpixel; + + } + + if (trc[1] == lastcoord[1] + 1) + return(*status); /* all done */ + + /* set starting and ending coord to last line */ + + trc[0] = lastcoord[0] + 1; + trc[1] = lastcoord[1] + 1; + blc[1] = trc[1]; + + fits_write_compressed_img(fptr, datatype, blc, trc, + nullcheck, arrayptr, nullval, status); + + *nread = *nread + trc[0] - blc[0] + 1; + + return(*status); +} + +/* ######################################################################## */ +/* ### Image Decompression Routines ### */ +/* ######################################################################## */ + +/*--------------------------------------------------------------------------*/ +int fits_decompress_img (fitsfile *infptr, /* image (bintable) to uncompress */ + fitsfile *outfptr, /* empty HDU for output uncompressed image */ + int *status) /* IO - error status */ + +/* + This routine decompresses the whole image and writes it to the output file. +*/ + +{ + double *data; + int ii, datatype = 0, byte_per_pix = 0; + int nullcheck, anynul; + long fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM]; + long inc[MAX_COMPRESS_DIM]; + long imgsize, memsize; + float *nulladdr, fnulval; + double dnulval; + + if (*status > 0) + return(*status); + + if (!fits_is_compressed_image(infptr, status) ) + { + ffpmsg("CHDU is not a compressed image (fits_decompress_img)"); + return(*status = DATA_DECOMPRESSION_ERR); + } + + /* create an empty output image with the correct dimensions */ + if (ffcrim(outfptr, (infptr->Fptr)->zbitpix, (infptr->Fptr)->zndim, + (infptr->Fptr)->znaxis, status) > 0) + { + ffpmsg("error creating output decompressed image HDU"); + return (*status); + } + /* Copy the table header to the image header. */ + if (imcomp_copy_imheader(infptr, outfptr, status) > 0) + { + ffpmsg("error copying header of compressed image"); + return (*status); + } + + /* force a rescan of the output header keywords, then reset the scaling */ + /* in case the BSCALE and BZERO keywords are present, so that the */ + /* decompressed values won't be scaled when written to the output image */ + ffrdef(outfptr, status); + ffpscl(outfptr, 1.0, 0.0, status); + ffpscl(infptr, 1.0, 0.0, status); + + /* initialize; no null checking is needed for integer images */ + nullcheck = 0; + nulladdr = &fnulval; + + /* determine datatype for image */ + if ((infptr->Fptr)->zbitpix == BYTE_IMG) + { + datatype = TBYTE; + byte_per_pix = 1; + } + else if ((infptr->Fptr)->zbitpix == SHORT_IMG) + { + datatype = TSHORT; + byte_per_pix = sizeof(short); + } + else if ((infptr->Fptr)->zbitpix == LONG_IMG) + { + datatype = TINT; + byte_per_pix = sizeof(int); + } + else if ((infptr->Fptr)->zbitpix == FLOAT_IMG) + { + /* In the case of float images we must check for NaNs */ + nullcheck = 1; + fnulval = FLOATNULLVALUE; + nulladdr = &fnulval; + datatype = TFLOAT; + byte_per_pix = sizeof(float); + } + else if ((infptr->Fptr)->zbitpix == DOUBLE_IMG) + { + /* In the case of double images we must check for NaNs */ + nullcheck = 1; + dnulval = DOUBLENULLVALUE; + nulladdr = (float *) &dnulval; + datatype = TDOUBLE; + byte_per_pix = sizeof(double); + } + + /* calculate size of the image (in pixels) */ + imgsize = 1; + for (ii = 0; ii < (infptr->Fptr)->zndim; ii++) + { + imgsize *= (infptr->Fptr)->znaxis[ii]; + fpixel[ii] = 1; /* Set first and last pixel to */ + lpixel[ii] = (infptr->Fptr)->znaxis[ii]; /* include the entire image. */ + inc[ii] = 1; + } + /* Calc equivalent number of double pixels same size as whole the image. */ + /* We use double datatype to force the memory to be aligned properly */ + memsize = ((imgsize * byte_per_pix) - 1) / sizeof(double) + 1; + + /* allocate memory for the image */ + data = (double*) calloc (memsize, sizeof(double)); + if (!data) + { + ffpmsg("Couldn't allocate memory for the uncompressed image"); + return(*status = MEMORY_ALLOCATION); + } + + /* uncompress the entire image into memory */ + /* This routine should be enhanced sometime to only need enough */ + /* memory to uncompress one tile at a time. */ + fits_read_compressed_img(infptr, datatype, fpixel, lpixel, inc, + nullcheck, nulladdr, data, NULL, &anynul, status); + + /* write the image to the output file */ + if (anynul) + fits_write_imgnull(outfptr, datatype, 1, imgsize, data, nulladdr, + status); + else + fits_write_img(outfptr, datatype, 1, imgsize, data, status); + + free(data); + return (*status); +} +/*---------------------------------------------------------------------------*/ +int fits_read_compressed_img(fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the array to be returned */ + long *infpixel, /* I - 'bottom left corner' of the subsection */ + long *inlpixel, /* I - 'top right corner' of the subsection */ + long *ininc, /* I - increment to be applied in each dimension */ + int nullcheck, /* I - 0 for no null checking */ + /* 1: set undefined pixels = nullval */ + /* 2: set nullarray=1 for undefined pixels */ + void *nullval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + char *nullarray, /* O - array of flags = 1 if nullcheck = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a section of a compressed image; Note: lpixel may be larger than the + size of the uncompressed image. Only the pixels within the image will be + returned. +*/ +{ + int naxis[MAX_COMPRESS_DIM], tiledim[MAX_COMPRESS_DIM]; + long tilesize[MAX_COMPRESS_DIM], thistilesize[MAX_COMPRESS_DIM]; + long ftile[MAX_COMPRESS_DIM], ltile[MAX_COMPRESS_DIM]; + long tfpixel[MAX_COMPRESS_DIM], tlpixel[MAX_COMPRESS_DIM]; + long rowdim[MAX_COMPRESS_DIM], offset[MAX_COMPRESS_DIM],ntemp; + long fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM]; + long inc[MAX_COMPRESS_DIM]; + int ii, i5, i4, i3, i2, i1, i0, ndim, irow, pixlen, tilenul; + void *buffer; + char *bnullarray = 0; + + if (*status > 0) + return(*status); + + if (!fits_is_compressed_image(fptr, status) ) + { + ffpmsg("CHDU is not a compressed image (fits_read_compressed_img)"); + return(*status = DATA_DECOMPRESSION_ERR); + } + + /* get temporary space for uncompressing one image tile */ + if (datatype == TSHORT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (short)); + pixlen = sizeof(short); + } + else if (datatype == TINT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (int)); + pixlen = sizeof(int); + } + else if (datatype == TLONG) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (long)); + pixlen = sizeof(long); + } + else if (datatype == TFLOAT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (float)); + pixlen = sizeof(float); + } + else if (datatype == TDOUBLE) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (double)); + pixlen = sizeof(double); + } + else if (datatype == TUSHORT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (unsigned short)); + pixlen = sizeof(short); + } + else if (datatype == TUINT) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (unsigned int)); + pixlen = sizeof(int); + } + else if (datatype == TULONG) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (unsigned long)); + pixlen = sizeof(long); + } + else if (datatype == TBYTE || datatype == TSBYTE) + { + buffer = calloc ((fptr->Fptr)->maxtilelen, sizeof (char)); + pixlen = 1; + } + else + { + ffpmsg("unsupported datatype for uncompressing image"); + return(*status = BAD_DATATYPE); + } + + if (buffer == NULL) + { + ffpmsg("Out of memory (fits_read_compress_img)"); + return (*status = MEMORY_ALLOCATION); + } + /* allocate memory for a null flag array, if needed */ + if (nullcheck == 2) + { + bnullarray = calloc ((fptr->Fptr)->maxtilelen, sizeof (char)); + + if (bnullarray == NULL) + { + ffpmsg("Out of memory (fits_read_compress_img)"); + free(buffer); + return (*status = MEMORY_ALLOCATION); + } + } + + /* initialize all the arrays */ + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + naxis[ii] = 1; + tiledim[ii] = 1; + tilesize[ii] = 1; + ftile[ii] = 1; + ltile[ii] = 1; + rowdim[ii] = 1; + } + + ndim = (fptr->Fptr)->zndim; + ntemp = 1; + for (ii = 0; ii < ndim; ii++) + { + /* support for mirror-reversed image sections */ + if (infpixel[ii] <= inlpixel[ii]) + { + fpixel[ii] = infpixel[ii]; + lpixel[ii] = inlpixel[ii]; + inc[ii] = ininc[ii]; + } + else + { + fpixel[ii] = inlpixel[ii]; + lpixel[ii] = infpixel[ii]; + inc[ii] = -ininc[ii]; + } + + /* calc number of tiles in each dimension, and tile containing */ + /* the first and last pixel we want to read in each dimension */ + naxis[ii] = (fptr->Fptr)->znaxis[ii]; + if (fpixel[ii] < 1) + { + if (nullcheck == 2) + { + free(bnullarray); + } + free(buffer); + return(*status = BAD_PIX_NUM); + } + + tilesize[ii] = (fptr->Fptr)->tilesize[ii]; + tiledim[ii] = (naxis[ii] - 1) / tilesize[ii] + 1; + ftile[ii] = (fpixel[ii] - 1) / tilesize[ii] + 1; + ltile[ii] = minvalue((lpixel[ii] - 1) / tilesize[ii] + 1, + tiledim[ii]); + rowdim[ii] = ntemp; /* total tiles in each dimension */ + ntemp *= tiledim[ii]; + } + + *anynul = 0; /* initialize */ + + /* support up to 6 dimensions for now */ + /* tfpixel and tlpixel are the first and last image pixels */ + /* along each dimension of the compression tile */ + for (i5 = ftile[5]; i5 <= ltile[5]; i5++) + { + tfpixel[5] = (i5 - 1) * tilesize[5] + 1; + tlpixel[5] = minvalue(tfpixel[5] + tilesize[5] - 1, + naxis[5]); + thistilesize[5] = tlpixel[5] - tfpixel[5] + 1; + offset[5] = (i5 - 1) * rowdim[5]; + for (i4 = ftile[4]; i4 <= ltile[4]; i4++) + { + tfpixel[4] = (i4 - 1) * tilesize[4] + 1; + tlpixel[4] = minvalue(tfpixel[4] + tilesize[4] - 1, + naxis[4]); + thistilesize[4] = thistilesize[5] * (tlpixel[4] - tfpixel[4] + 1); + offset[4] = (i4 - 1) * rowdim[4] + offset[5]; + for (i3 = ftile[3]; i3 <= ltile[3]; i3++) + { + tfpixel[3] = (i3 - 1) * tilesize[3] + 1; + tlpixel[3] = minvalue(tfpixel[3] + tilesize[3] - 1, + naxis[3]); + thistilesize[3] = thistilesize[4] * (tlpixel[3] - tfpixel[3] + 1); + offset[3] = (i3 - 1) * rowdim[3] + offset[4]; + for (i2 = ftile[2]; i2 <= ltile[2]; i2++) + { + tfpixel[2] = (i2 - 1) * tilesize[2] + 1; + tlpixel[2] = minvalue(tfpixel[2] + tilesize[2] - 1, + naxis[2]); + thistilesize[2] = thistilesize[3] * (tlpixel[2] - tfpixel[2] + 1); + offset[2] = (i2 - 1) * rowdim[2] + offset[3]; + for (i1 = ftile[1]; i1 <= ltile[1]; i1++) + { + tfpixel[1] = (i1 - 1) * tilesize[1] + 1; + tlpixel[1] = minvalue(tfpixel[1] + tilesize[1] - 1, + naxis[1]); + thistilesize[1] = thistilesize[2] * (tlpixel[1] - tfpixel[1] + 1); + offset[1] = (i1 - 1) * rowdim[1] + offset[2]; + for (i0 = ftile[0]; i0 <= ltile[0]; i0++) + { + tfpixel[0] = (i0 - 1) * tilesize[0] + 1; + tlpixel[0] = minvalue(tfpixel[0] + tilesize[0] - 1, + naxis[0]); + thistilesize[0] = thistilesize[1] * (tlpixel[0] - tfpixel[0] + 1); + /* calculate row of table containing this tile */ + irow = i0 + offset[1]; + + /* read and uncompress this row (tile) of the table */ + /* also do type conversion and undefined pixel substitution */ + /* at this point */ + imcomp_decompress_tile(fptr, irow, thistilesize[0], + datatype, nullcheck, nullval, buffer, bnullarray, &tilenul, + status); + + if (tilenul && anynul) + *anynul = 1; /* there are null pixels */ + + /* copy the intersecting pixels from this tile to the output */ + imcomp_copy_overlap(buffer, pixlen, ndim, tfpixel, tlpixel, + bnullarray, array, fpixel, lpixel, inc, nullcheck, + nullarray, status); + } + } + } + } + } + } + if (nullcheck == 2) + { + free(bnullarray); + } + free(buffer); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_read_compressed_pixels(fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the array to be returned */ + OFF_T fpixel, /* I - 'first pixel to read */ + long npixel, /* I - number of pixels to read */ + int nullcheck, /* I - 0 for no null checking */ + /* 1: set undefined pixels = nullval */ + /* 2: set nullarray=1 for undefined pixels */ + void *nullval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + char *nullarray, /* O - array of flags = 1 if nullcheck = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + int *status) /* IO - error status */ +/* + Read a consecutive set of pixels from a compressed image. This routine + interpretes the n-dimensional image as a long one-dimensional array. + This is actually a rather inconvenient way to read compressed images in + general, and could be rather inefficient if the requested pixels to be + read are located in many different image compression tiles. + + The general strategy used here is to read the requested pixels in blocks + that correspond to rectangular image sections. +*/ +{ + int naxis, ii, bytesperpixel, planenul; + long naxes[MAX_COMPRESS_DIM], nread; + long inc[MAX_COMPRESS_DIM]; + OFF_T tfirst, tlast, last0, last1, dimsize[MAX_COMPRESS_DIM]; + long nplane, firstcoord[MAX_COMPRESS_DIM], lastcoord[MAX_COMPRESS_DIM]; + char *arrayptr, *nullarrayptr; + + if (*status > 0) + return(*status); + + arrayptr = (char *) array; + nullarrayptr = nullarray; + + /* get size of array pixels, in bytes */ + bytesperpixel = ffpxsz(datatype); + + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + naxes[ii] = 1; + firstcoord[ii] = 0; + lastcoord[ii] = 0; + inc[ii] = 1; + } + + /* determine the dimensions of the image to be read */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, MAX_COMPRESS_DIM, naxes, status); + + /* calc the cumulative number of pixels in each successive dimension */ + dimsize[0] = 1; + for (ii = 1; ii < MAX_COMPRESS_DIM; ii++) + dimsize[ii] = dimsize[ii - 1] * naxes[ii - 1]; + + /* determine the coordinate of the first and last pixel in the image */ + /* Use zero based indexes here */ + tfirst = fpixel - 1; + tlast = tfirst + npixel - 1; + for (ii = naxis - 1; ii >= 0; ii--) + { + firstcoord[ii] = tfirst / dimsize[ii]; + lastcoord[ii] = tlast / dimsize[ii]; + tfirst = tfirst - firstcoord[ii] * dimsize[ii]; + tlast = tlast - lastcoord[ii] * dimsize[ii]; + } + + /* to simplify things, treat 1-D, 2-D, and 3-D images as separate cases */ + + if (naxis == 1) + { + /* Simple: just read the requested range of pixels */ + + firstcoord[0] = firstcoord[0] + 1; + lastcoord[0] = lastcoord[0] + 1; + fits_read_compressed_img(fptr, datatype, firstcoord, lastcoord, inc, + nullcheck, nullval, array, nullarray, anynul, status); + return(*status); + } + else if (naxis == 2) + { + nplane = 0; /* read 1st (and only) plane of the image */ + + fits_read_compressed_img_plane(fptr, datatype, bytesperpixel, + nplane, firstcoord, lastcoord, inc, naxes, nullcheck, nullval, + array, nullarray, anynul, &nread, status); + } + else if (naxis == 3) + { + /* test for special case: reading an integral number of planes */ + if (firstcoord[0] == 0 && firstcoord[1] == 0 && + lastcoord[0] == naxes[0] - 1 && lastcoord[1] == naxes[1] - 1) + { + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + /* convert from zero base to 1 base */ + (firstcoord[ii])++; + (lastcoord[ii])++; + } + + /* we can read the contiguous block of pixels in one go */ + fits_read_compressed_img(fptr, datatype, firstcoord, lastcoord, inc, + nullcheck, nullval, array, nullarray, anynul, status); + + return(*status); + } + + if (anynul) + *anynul = 0; /* initialize */ + + /* save last coordinate in temporary variables */ + last0 = lastcoord[0]; + last1 = lastcoord[1]; + + if (firstcoord[2] < lastcoord[2]) + { + /* we will read up to the last pixel in all but the last plane */ + lastcoord[0] = naxes[0] - 1; + lastcoord[1] = naxes[1] - 1; + } + + /* read one plane of the cube at a time, for simplicity */ + for (nplane = firstcoord[2]; nplane <= lastcoord[2]; nplane++) + { + if (nplane == lastcoord[2]) + { + lastcoord[0] = last0; + lastcoord[1] = last1; + } + + fits_read_compressed_img_plane(fptr, datatype, bytesperpixel, + nplane, firstcoord, lastcoord, inc, naxes, nullcheck, nullval, + arrayptr, nullarrayptr, &planenul, &nread, status); + + if (planenul && anynul) + *anynul = 1; /* there are null pixels */ + + /* for all subsequent planes, we start with the first pixel */ + firstcoord[0] = 0; + firstcoord[1] = 0; + + /* increment pointers to next elements to be read */ + arrayptr = arrayptr + nread * bytesperpixel; + if (nullarrayptr && (nullcheck == 2) ) + nullarrayptr = nullarrayptr + nread; + } + } + else + { + ffpmsg("only 1D, 2D, or 3D images are currently supported"); + return(*status = DATA_DECOMPRESSION_ERR); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_read_compressed_img_plane(fitsfile *fptr, /* I - FITS file */ + int datatype, /* I - datatype of the array to be returned */ + int bytesperpixel, /* I - number of bytes per pixel in array */ + long nplane, /* I - which plane of the cube to read */ + long *firstcoord, /* coordinate of first pixel to read */ + long *lastcoord, /* coordinate of last pixel to read */ + long *inc, /* increment of pixels to read */ + long *naxes, /* size of each image dimension */ + int nullcheck, /* I - 0 for no null checking */ + /* 1: set undefined pixels = nullval */ + /* 2: set nullarray=1 for undefined pixels */ + void *nullval, /* I - value for undefined pixels */ + void *array, /* O - array of values that are returned */ + char *nullarray, /* O - array of flags = 1 if nullcheck = 2 */ + int *anynul, /* O - set to 1 if any values are null; else 0 */ + long *nread, /* O - total number of pixels read and returned*/ + int *status) /* IO - error status */ + + /* + in general we have to read the first partial row of the image, + followed by the middle complete rows, followed by the last + partial row of the image. If the first or last rows are complete, + then read them at the same time as all the middle rows. + */ +{ + /* bottom left coord. and top right coord. */ + long blc[MAX_COMPRESS_DIM], trc[MAX_COMPRESS_DIM]; + char *arrayptr, *nullarrayptr; + int tnull; + + if (anynul) + *anynul = 0; + + *nread = 0; + + arrayptr = (char *) array; + nullarrayptr = nullarray; + + blc[2] = nplane + 1; + trc[2] = nplane + 1; + + if (firstcoord[0] != 0) + { + /* have to read a partial first row */ + blc[0] = firstcoord[0] + 1; + blc[1] = firstcoord[1] + 1; + trc[1] = blc[1]; + if (lastcoord[1] == firstcoord[1]) + trc[0] = lastcoord[0] + 1; /* 1st and last pixels in same row */ + else + trc[0] = naxes[0]; /* read entire rest of the row */ + + fits_read_compressed_img(fptr, datatype, blc, trc, inc, + nullcheck, nullval, arrayptr, nullarrayptr, &tnull, status); + + *nread = *nread + trc[0] - blc[0] + 1; + + if (tnull && anynul) + *anynul = 1; /* there are null pixels */ + + if (lastcoord[1] == firstcoord[1]) + { + return(*status); /* finished */ + } + + /* set starting coord to beginning of next line */ + firstcoord[0] = 0; + firstcoord[1] += 1; + arrayptr = arrayptr + (trc[0] - blc[0] + 1) * bytesperpixel; + if (nullarrayptr && (nullcheck == 2) ) + nullarrayptr = nullarrayptr + (trc[0] - blc[0] + 1); + + } + + /* read contiguous complete rows of the image, if any */ + blc[0] = 1; + blc[1] = firstcoord[1] + 1; + trc[0] = naxes[0]; + + if (lastcoord[0] + 1 == naxes[0]) + { + /* can read the last complete row, too */ + trc[1] = lastcoord[1] + 1; + } + else + { + /* last row is incomplete; have to read it separately */ + trc[1] = lastcoord[1]; + } + + if (trc[1] >= blc[1]) /* must have at least one whole line to read */ + { + fits_read_compressed_img(fptr, datatype, blc, trc, inc, + nullcheck, nullval, arrayptr, nullarrayptr, &tnull, status); + + *nread = *nread + (trc[1] - blc[1] + 1) * naxes[0]; + + if (tnull && anynul) + *anynul = 1; + + if (lastcoord[1] + 1 == trc[1]) + return(*status); /* finished */ + + /* increment pointers for the last partial row */ + arrayptr = arrayptr + (trc[1] - blc[1] + 1) * naxes[0] * bytesperpixel; + if (nullarrayptr && (nullcheck == 2) ) + nullarrayptr = nullarrayptr + (trc[1] - blc[1] + 1) * naxes[0]; + } + + if (trc[1] == lastcoord[1] + 1) + return(*status); /* all done */ + + /* set starting and ending coord to last line */ + + trc[0] = lastcoord[0] + 1; + trc[1] = lastcoord[1] + 1; + blc[1] = trc[1]; + + fits_read_compressed_img(fptr, datatype, blc, trc, inc, + nullcheck, nullval, arrayptr, nullarrayptr, &tnull, status); + + if (tnull) + *anynul = 1; + + *nread = *nread + trc[0] - blc[0] + 1; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_get_compressed_image_par(fitsfile *infptr, int *status) + +/* + This routine reads keywords from a BINTABLE extension containing a + compressed image. +*/ +{ + char keyword[FLEN_KEYWORD]; + char value[FLEN_VALUE]; + int ii, tstatus; + long expect_nrows, maxtilelen; + + if (*status > 0) + return(*status); + + /* Copy relevant header keyword values to structure */ + if (ffgky (infptr, TSTRING, "ZCMPTYPE", value, NULL, status) > 0) + { + ffpmsg("required ZCMPTYPE compression keyword not found in"); + ffpmsg(" imcomp_get_compressed_image_par"); + return(*status); + } + + (infptr->Fptr)->zcmptype[0] = '\0'; + strncat((infptr->Fptr)->zcmptype, value, 11); + + if (!FSTRCMP(value, "RICE_1") ) + (infptr->Fptr)->compress_type = RICE_1; + else if (!FSTRCMP(value, "HCOMPRESS_1") ) + (infptr->Fptr)->compress_type = HCOMPRESS_1; + else if (!FSTRCMP(value, "GZIP_1") ) + (infptr->Fptr)->compress_type = GZIP_1; + else if (!FSTRCMP(value, "PLIO_1") ) + (infptr->Fptr)->compress_type = PLIO_1; + else + { + ffpmsg("Unknown image compression type:"); + ffpmsg(value); + return (*status = DATA_DECOMPRESSION_ERR); + } + + if (ffgky (infptr, TINT, "ZBITPIX", &(infptr->Fptr)->zbitpix, + NULL, status) > 0) + { + ffpmsg("required ZBITPIX compression keyword not found"); + return(*status); + } + + if (ffgky (infptr,TINT, "ZNAXIS", &(infptr->Fptr)->zndim, NULL, status) > 0) + { + ffpmsg("required ZNAXIS compression keyword not found"); + return(*status); + } + + if ((infptr->Fptr)->zndim < 1) + { + ffpmsg("Compressed image has no data (ZNAXIS < 1)"); + return (*status = BAD_NAXIS); + } + + if ((infptr->Fptr)->zndim > MAX_COMPRESS_DIM) + { + ffpmsg("Compressed image has too many dimensions"); + return(*status = BAD_NAXIS); + } + + expect_nrows = 1; + maxtilelen = 1; + for (ii = 0; ii < (infptr->Fptr)->zndim; ii++) + { + /* get image size */ + sprintf (keyword, "ZNAXIS%d", ii+1); + ffgky (infptr, TLONG,keyword, &(infptr->Fptr)->znaxis[ii],NULL,status); + + if (*status > 0) + { + ffpmsg("required ZNAXISn compression keyword not found"); + return(*status); + } + + /* get compression tile size */ + sprintf (keyword, "ZTILE%d", ii+1); + + /* set default tile size in case keywords are not present */ + if (ii == 0) + (infptr->Fptr)->tilesize[0] = (infptr->Fptr)->znaxis[0]; + else + (infptr->Fptr)->tilesize[ii] = 1; + + tstatus = 0; + ffgky (infptr, TLONG, keyword, &(infptr->Fptr)->tilesize[ii], NULL, + &tstatus); + + expect_nrows *= (((infptr->Fptr)->znaxis[ii] - 1) / + (infptr->Fptr)->tilesize[ii]+ 1); + maxtilelen *= (infptr->Fptr)->tilesize[ii]; + } + + /* check number of rows */ + if (expect_nrows != (infptr->Fptr)->numrows) + { + ffpmsg( + "number of table rows != the number of tiles in compressed image"); + return (*status = DATA_DECOMPRESSION_ERR); + } + + /* read any algorithm specific parameters */ + if ((infptr->Fptr)->compress_type == RICE_1 ) + { + if (ffgky(infptr, TINT,"ZVAL1", &(infptr->Fptr)->rice_blocksize, + NULL, status) > 0) + { + ffpmsg("required ZVAL1 compression keyword not found"); + return(*status); + } + + if ((infptr->Fptr)->zbitpix < 0) + { + /* try to read the floating point quantization parameter */ + tstatus = 0; + ffgky(infptr, TINT,"ZVAL2", &(infptr->Fptr)->rice_nbits, + NULL, &tstatus); + } + } + else + { + if ((infptr->Fptr)->zbitpix < 0) + { + /* try to read the floating point quantization parameter */ + tstatus = 0; + ffgky(infptr, TINT,"ZVAL1", &(infptr->Fptr)->rice_nbits, + NULL, &tstatus); + } + } + + /* store number of pixels in each compression tile, */ + /* and max size of the compressed tile buffer */ + (infptr->Fptr)->maxtilelen = maxtilelen; + + (infptr->Fptr)->maxelem = + imcomp_calc_max_elem ((infptr->Fptr)->compress_type, maxtilelen, + (infptr->Fptr)->rice_blocksize); + + /* Get Column numbers. */ + if (ffgcno(infptr, CASEINSEN, "COMPRESSED_DATA", + &(infptr->Fptr)->cn_compressed, status) > 0) + { + ffpmsg("couldn't find COMPRESSED_DATA column (fits_get_compressed_img_par)"); + return(*status = DATA_DECOMPRESSION_ERR); + } + + ffpmrk(); /* put mark on message stack; erase any messages after this */ + + tstatus = 0; + ffgcno(infptr,CASEINSEN, "UNCOMPRESSED_DATA", + &(infptr->Fptr)->cn_uncompressed, &tstatus); + + tstatus = 0; + if (ffgcno(infptr, CASEINSEN, "ZSCALE", &(infptr->Fptr)->cn_zscale, + &tstatus) > 0) + { + /* CMPSCALE column doesn't exist; see if there is a keyword */ + tstatus = 0; + if (ffgky(infptr, TDOUBLE, "ZSCALE", &(infptr->Fptr)->zscale, NULL, + &tstatus) <= 0) + (infptr->Fptr)->cn_zscale = -1; /* flag for a constant ZSCALE */ + } + + tstatus = 0; + if (ffgcno(infptr, CASEINSEN, "ZZERO", &(infptr->Fptr)->cn_zzero, + &tstatus) > 0) + { + /* CMPZERO column doesn't exist; see if there is a keyword */ + tstatus = 0; + if (ffgky(infptr, TDOUBLE, "ZZERO", &(infptr->Fptr)->zzero, NULL, + &tstatus) <= 0) + (infptr->Fptr)->cn_zzero = -1; /* flag for a constant ZZERO */ + } + + tstatus = 0; + if (ffgcno(infptr, CASEINSEN, "ZBLANK", &(infptr->Fptr)->cn_zblank, + &tstatus) > 0) + { + /* CMPZERO column doesn't exist; see if there is a keyword */ + tstatus = 0; + if (ffgky(infptr, TINT, "ZBLANK", &(infptr->Fptr)->zblank, NULL, + &tstatus) <= 0) + (infptr->Fptr)->cn_zblank = -1; /* flag for a constant ZBLANK */ + } + + /* read the conventional BSCALE and BZERO scaling keywords, if present */ + tstatus = 0; + if (ffgky (infptr, TDOUBLE, "BSCALE", &(infptr->Fptr)->cn_bscale, + NULL, &tstatus) > 0) + { + (infptr->Fptr)->cn_bscale = 1.0; + } + + tstatus = 0; + if (ffgky (infptr, TDOUBLE, "BZERO", &(infptr->Fptr)->cn_bzero, + NULL, &tstatus) > 0) + { + (infptr->Fptr)->cn_bzero = 0.0; + } + + ffcmrk(); /* clear any spurious error messages, back to the mark */ + return (*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr, int *status) +/* + This routine reads the header keywords from the input image and + copies them to the output image; the manditory structural keywords + and the checksum keywords are not copied. If the DATE keyword is copied, + then it is updated with the current date and time. +*/ +{ + int nkeys, ii, keyclass; + char card[FLEN_CARD]; /* a header record */ + + if (*status > 0) + return(*status); + + ffghsp(infptr, &nkeys, NULL, status); /* get number of keywords in image */ + + for (ii = 5; ii <= nkeys; ii++) /* skip the first 4 keywords */ + { + ffgrec(infptr, ii, card, status); + + keyclass = ffgkcl(card); /* Get the type/class of keyword */ + + /* don't copy structural keywords or checksum keywords */ + if ((keyclass <= TYP_CMPRS_KEY) || (keyclass == TYP_CKSUM_KEY)) + continue; + + if (FSTRNCMP(card, "DATE ", 5) == 0) /* write current date */ + { + ffpdat(outfptr, status); + } + else if (FSTRNCMP(card, "EXTNAME ", 8) == 0) + { + /* don't copy default EXTNAME keyword from a compressed image */ + if (FSTRNCMP(card, "EXTNAME = 'COMPRESSED_IMAGE'", 28)) + { + /* if EXTNAME keyword already exists, overwrite it */ + /* otherwise append a new EXTNAME keyword */ + ffucrd(outfptr, "EXTNAME", card, status); + } + } + else + { + /* just copy the keyword to the output header */ + ffprec (outfptr, card, status); + } + + if (*status > 0) + return (*status); + } + return (*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_decompress_tile (fitsfile *infptr, + int nrow, /* I - row of table to read and uncompress */ + int tilelen, /* I - number of pixels in the tile */ + int datatype, /* I - datatype to be returned in 'buffer' */ + int nullcheck, /* I - 0 for no null checking */ + void *nulval, /* I - value to be used for undefined pixels */ + void *buffer, /* O - buffer for returned decompressed values */ + char *bnullarray, /* O - buffer for returned null flags */ + int *anynul, /* O - any null values returned? */ + int *status) + +/* This routine decompresses one tile of the image */ +{ + int *idata = 0; /* uncompressed integer data */ + size_t idatalen, tilebytesize; + int ii, tnull; /* value in the data which represents nulls */ + unsigned char *cbuf = 0; /* compressed data */ + unsigned char charnull = 0; + short *sbuf = 0; + short snull = 0; + int blocksize; + double bscale, bzero, dummy = 0; /* scaling parameters */ + long nelem = 0, offset = 0; /* number of bytes */ + + if (*status > 0) + return(*status); + + /* get length of the compressed byte stream */ + ffgdes (infptr, (infptr->Fptr)->cn_compressed, nrow, &nelem, &offset, + status); + + /* EOF error here indicates that this tile has not yet been written */ + if (*status == END_OF_FILE) + return(*status = NO_COMPRESSED_TILE); + + /* **************************************************************** */ + if (nelem == 0) /* tile was not compressed; read uncompressed data */ + { + if ((infptr->Fptr)->cn_uncompressed < 1 ) + { + return (*status = NO_COMPRESSED_TILE); + } + + /* no compressed data, so simply read the uncompressed data */ + /* directly from the UNCOMPRESSED_DATA column, then return */ + ffgdes (infptr, (infptr->Fptr)->cn_uncompressed, nrow, &nelem, + &offset, status); + + if (nelem == 0 && offset == 0) + return (*status = NO_COMPRESSED_TILE); + + if (nullcheck <= 1) + fits_read_col(infptr, datatype, (infptr->Fptr)->cn_uncompressed, + nrow, 1, nelem, nulval, buffer, anynul, status); + else + fits_read_colnull(infptr, datatype, (infptr->Fptr)->cn_uncompressed, + nrow, 1, nelem, buffer, bnullarray, anynul, status); + + return(*status); + } + + /* **************************************************************** */ + + if (nullcheck == 2) + { + for (ii = 0; ii < tilelen; ii++) /* initialize the null array */ + bnullarray[ii] = 0; + } + + if (anynul) + *anynul = 0; + + /* get linear scaling and offset values, if they exist */ + if ((infptr->Fptr)->cn_zscale == 0) + { + /* set default scaling, if scaling is not defined */ + bscale = 1.; + bzero = 0.; + } + else if ((infptr->Fptr)->cn_zscale == -1) + { + bscale = (infptr->Fptr)->zscale; + bzero = (infptr->Fptr)->zzero; + } + else + { + /* read the linear scale and offset values for this row */ + ffgcvd (infptr, (infptr->Fptr)->cn_zscale, nrow, 1, 1, 0., + &bscale, NULL, status); + ffgcvd (infptr, (infptr->Fptr)->cn_zzero, nrow, 1, 1, 0., + &bzero, NULL, status); + if (*status > 0) + { + ffpmsg("error reading scaling factor and offset for compressed tile"); + free(idata); + free (cbuf); + return (*status); + } + } + + if (bscale == 1.0 && bzero == 0.0 ) + { + /* if no other scaling has been specified, try using the values + given by the BSCALE and BZERO keywords, if any */ + + bscale = (infptr->Fptr)->cn_bscale; + bzero = (infptr->Fptr)->cn_bzero; + } + + /* ************************************************************* */ + + /* get the value used to represent nulls in the int array */ + if ((infptr->Fptr)->cn_zblank == 0) + { + nullcheck = 0; /* no null value; don't check for nulls */ + } + else if ((infptr->Fptr)->cn_zblank == -1) + { + tnull = (infptr->Fptr)->zblank; /* use the the ZBLANK keyword */ + } + else + { + /* read the null value for this row */ + ffgcvk (infptr, (infptr->Fptr)->cn_zblank, nrow, 1, 1, 0., + &tnull, NULL, status); + if (*status > 0) + { + ffpmsg("error reading null value for compressed tile"); + free(idata); + free (cbuf); + return (*status); + } + } + + /* ************************************************************* */ + + /* allocate memory for uncompressed integers */ + idata = (int*) calloc (tilelen, sizeof (int)); + if (idata == NULL) + { + ffpmsg("Out of memory for idata. (imcomp_decompress_tile)"); + return (*status = MEMORY_ALLOCATION); + } + + /* ************************************************************* */ + + if ((infptr->Fptr)->compress_type == RICE_1) + { + cbuf = (unsigned char *) calloc (nelem, sizeof (unsigned char)); + if (cbuf == NULL) + { + ffpmsg("Out of memory for cbuf. (imcomp_decompress_tile)"); + free(idata); + return (*status = MEMORY_ALLOCATION); + } + + /* read array of compressed bytes */ + if (fits_read_col(infptr, TBYTE, (infptr->Fptr)->cn_compressed, nrow, + 1, nelem, &charnull, cbuf, NULL, status) > 0) + { + ffpmsg("error reading compressed byte stream from binary table"); + free (cbuf); + free(idata); + return (*status); + } + + /* uncompress the data */ + blocksize = (infptr->Fptr)->rice_blocksize; + if ((*status = fits_rdecomp (cbuf, nelem, (unsigned int *)idata, + tilelen, blocksize))) + { + free (cbuf); + free(idata); + return (*status); + } + + free(cbuf); + } + + /* ************************************************************* */ + + else if ((infptr->Fptr)->compress_type == PLIO_1) + { + sbuf = (short *) calloc (nelem, sizeof (short)); + if (sbuf == NULL) + { + ffpmsg("Out of memory for sbuf. (imcomp_decompress_tile)"); + free(idata); + return (*status = MEMORY_ALLOCATION); + } + + /* read array of compressed bytes */ + if (fits_read_col(infptr, TSHORT, (infptr->Fptr)->cn_compressed, nrow, + 1, nelem, &snull, sbuf, NULL, status) > 0) + { + ffpmsg("error reading compressed byte stream from binary table"); + free(idata); + free (sbuf); + return (*status); + } + + pl_l2pi (sbuf, 1, idata, tilelen); /* uncompress the data */ + free(sbuf); + } + + /* ************************************************************* */ + + else if ((infptr->Fptr)->compress_type == GZIP_1) + { + cbuf = (unsigned char *) calloc (nelem, sizeof (unsigned char)); + if (cbuf == NULL) + { + ffpmsg("Out of memory for cbuf. (imcomp_decompress_tile)"); + free(idata); + return (*status = MEMORY_ALLOCATION); + } + + /* read array of compressed bytes */ + if (fits_read_col(infptr, TBYTE, (infptr->Fptr)->cn_compressed, nrow, + 1, nelem, &charnull, cbuf, NULL, status) > 0) + { + ffpmsg("error reading compressed byte stream from binary table"); + free(idata); + free (cbuf); + return (*status); + } + + /* uncompress the data */ + idatalen = tilelen * sizeof(int); + if (uncompress2mem_from_mem ((char *)cbuf, nelem, + (char **) &idata, &idatalen, realloc, &tilebytesize, status)) + { + ffpmsg("uncompress2mem_from_mem returned with an error"); + free(idata); + free (cbuf); + return (*status); + } + +#if BYTESWAPPED + ffswap4(idata, tilelen); /* reverse order of bytes */ +#endif + + if (idatalen != tilebytesize) + { + ffpmsg("error: uncompressed tile has wrong size"); + free(idata); + free (cbuf); + return (*status = DATA_DECOMPRESSION_ERR); + } + + free(cbuf); + } + + /* ************************************************************* */ + else + { + ffpmsg("unknown compression algorithm"); + free(idata); + return (*status = DATA_DECOMPRESSION_ERR); + } + + /* ************************************************************* */ + /* copy the uncompressed tile data to the output buffer, doing */ + /* null checking, datatype conversion and linear scaling, if necessary */ + + + if (nulval == 0) + nulval = &dummy; /* set address to dummy value */ + + if (datatype == TSHORT) + { + fffi4i2(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(short *) nulval, bnullarray, anynul, + (short *) buffer, status); + } + else if (datatype == TINT) + { + fffi4int(idata, (long) tilelen, bscale, bzero, nullcheck, tnull, + *(int *) nulval, bnullarray, anynul, + (int *) buffer, status); + } + else if (datatype == TLONG) + { + fffi4i4(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(long *) nulval, bnullarray, anynul, + (long *) buffer, status); + } + else if (datatype == TFLOAT) + { + fffi4r4(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(float *) nulval, bnullarray, anynul, + (float *) buffer, status); + } + else if (datatype == TDOUBLE) + { + fffi4r8(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(double *) nulval, bnullarray, anynul, + (double *) buffer, status); + } + else if (datatype == TBYTE) + { + fffi4i1(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(unsigned char *) nulval, bnullarray, anynul, + (unsigned char *) buffer, status); + } + else if (datatype == TSBYTE) + { + fffi4s1(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(signed char *) nulval, bnullarray, anynul, + (signed char *) buffer, status); + } + else if (datatype == TUSHORT) + { + fffi4u2(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(unsigned short *) nulval, bnullarray, anynul, + (unsigned short *) buffer, status); + } + else if (datatype == TUINT) + { + fffi4uint(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(unsigned int *) nulval, bnullarray, anynul, + (unsigned int *) buffer, status); + } + else if (datatype == TULONG) + { + fffi4u4(idata, tilelen, bscale, bzero, nullcheck, tnull, + *(unsigned long *) nulval, bnullarray, anynul, + (unsigned long *) buffer, status); + } + else + *status = BAD_DATATYPE; + + free(idata); + + return (*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_copy_overlap ( + char *tile, /* I - multi dimensional array of tile pixels */ + int pixlen, /* I - number of bytes in each tile or image pixel */ + int ndim, /* I - number of dimension in the tile and image */ + long *tfpixel, /* I - first pixel number in each dim. of the tile */ + long *tlpixel, /* I - last pixel number in each dim. of the tile */ + char *bnullarray, /* I - array of null flags; used if nullcheck = 2 */ + char *image, /* O - multi dimensional output image */ + long *fpixel, /* I - first pixel number in each dim. of the image */ + long *lpixel, /* I - last pixel number in each dim. of the image */ + long *ininc, /* I - increment to be applied in each image dimen. */ + int nullcheck, /* I - 0, 1: do nothing; 2: set nullarray for nulls */ + char *nullarray, + int *status) + +/* + copy the intersecting pixels from a decompressed tile to the output image. + Both the tile and the image must have the same number of dimensions. +*/ +{ + long imgdim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */ + /* output image, allowing for inc factor */ + long tiledim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */ + /* tile, array; inc factor is not relevant */ + long imgfpix[MAX_COMPRESS_DIM]; /* 1st img pix overlapping tile: 0 base, */ + /* allowing for inc factor */ + long imglpix[MAX_COMPRESS_DIM]; /* last img pix overlapping tile 0 base, */ + /* allowing for inc factor */ + long tilefpix[MAX_COMPRESS_DIM]; /* 1st tile pix overlapping img 0 base, */ + /* allowing for inc factor */ + long inc[MAX_COMPRESS_DIM]; /* local copy of input ininc */ + long i1, i2, i3, i4; /* offset along each axis of the image */ + long it1, it2, it3, it4; + long im1, im2, im3, im4; /* offset to image pixel, allowing for inc */ + long ipos, tf, tl; + long t2, t3, t4; /* offset along each axis of the tile */ + long tilepix, imgpix, tilepixbyte, imgpixbyte; + int ii, overlap_bytes, overlap_flags; + + if (*status > 0) + return(*status); + + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + /* set default values for higher dimensions */ + inc[ii] = 1; + imgdim[ii] = 1; + tiledim[ii] = 1; + imgfpix[ii] = 0; + imglpix[ii] = 0; + tilefpix[ii] = 0; + } + + /* ------------------------------------------------------------ */ + /* calc amount of overlap in each dimension; if there is zero */ + /* overlap in any dimension then just return */ + /* ------------------------------------------------------------ */ + + for (ii = 0; ii < ndim; ii++) + { + if (tlpixel[ii] < fpixel[ii] || tfpixel[ii] > lpixel[ii]) + return(*status); /* there are no overlapping pixels */ + + inc[ii] = ininc[ii]; + + /* calc dimensions of the output image section */ + imgdim[ii] = (lpixel[ii] - fpixel[ii]) / labs(inc[ii]) + 1; + if (imgdim[ii] < 1) + return(*status = NEG_AXIS); + + /* calc dimensions of the tile */ + tiledim[ii] = tlpixel[ii] - tfpixel[ii] + 1; + if (tiledim[ii] < 1) + return(*status = NEG_AXIS); + + if (ii > 0) + tiledim[ii] *= tiledim[ii - 1]; /* product of dimensions */ + + /* first and last pixels in image that overlap with the tile, 0 base */ + tf = tfpixel[ii] - 1; + tl = tlpixel[ii] - 1; + + /* skip this plane if it falls in the cracks of the subsampled image */ + while ((tf-(fpixel[ii] - 1)) % labs(inc[ii])) + { + tf++; + if (tf > tl) + return(*status); /* no overlapping pixels */ + } + + while ((tl-(fpixel[ii] - 1)) % labs(inc[ii])) + { + tl--; + if (tf > tl) + return(*status); /* no overlapping pixels */ + } + imgfpix[ii] = maxvalue((tf - fpixel[ii] +1) / labs(inc[ii]) , 0); + imglpix[ii] = minvalue((tl - fpixel[ii] +1) / labs(inc[ii]) , + imgdim[ii] - 1); + + /* first pixel in the tile that overlaps with the image (0 base) */ + tilefpix[ii] = maxvalue(fpixel[ii] - tfpixel[ii], 0); + + while ((tfpixel[ii] + tilefpix[ii] - fpixel[ii]) % labs(inc[ii])) + { + (tilefpix[ii])++; + if (tilefpix[ii] >= tiledim[ii]) + return(*status); /* no overlapping pixels */ + } +/* +printf("ii tfpixel, tlpixel %d %d %d \n",ii, tfpixel[ii], tlpixel[ii]); +printf("ii, tf, tl, imgfpix,imglpix, tilefpix %d %d %d %d %d %d\n",ii, + tf,tl,imgfpix[ii], imglpix[ii],tilefpix[ii]); +*/ + if (ii > 0) + imgdim[ii] *= imgdim[ii - 1]; /* product of dimensions */ + } + + /* ---------------------------------------------------------------- */ + /* calc number of pixels in each row (first dimension) that overlap */ + /* multiply by pixlen to get number of bytes to copy in each loop */ + /* ---------------------------------------------------------------- */ + + if (inc[0] != 1) + overlap_flags = 1; /* can only copy 1 pixel at a time */ + else + overlap_flags = imglpix[0] - imgfpix[0] + 1; /* can copy whole row */ + + overlap_bytes = overlap_flags * pixlen; + + /* support up to 5 dimensions for now */ + for (i4 = 0, it4=0; i4 <= imglpix[4] - imgfpix[4]; i4++, it4++) + { + /* increment plane if it falls in the cracks of the subsampled image */ + while (ndim > 4 && (tfpixel[4] + tilefpix[4] - fpixel[4] + it4) + % labs(inc[4]) != 0) + it4++; + + /* offset to start of hypercube */ + if (inc[4] > 0) + im4 = (i4 + imgfpix[4]) * imgdim[3]; + else + im4 = imgdim[4] - (i4 + 1 + imgfpix[4]) * imgdim[3]; + + t4 = (tilefpix[4] + it4) * tiledim[3]; + for (i3 = 0, it3=0; i3 <= imglpix[3] - imgfpix[3]; i3++, it3++) + { + /* increment plane if it falls in the cracks of the subsampled image */ + while (ndim > 3 && (tfpixel[3] + tilefpix[3] - fpixel[3] + it3) + % labs(inc[3]) != 0) + it3++; + + /* offset to start of cube */ + if (inc[3] > 0) + im3 = (i3 + imgfpix[3]) * imgdim[2] + im4; + else + im3 = imgdim[3] - (i3 + 1 + imgfpix[3]) * imgdim[2] + im4; + + t3 = (tilefpix[3] + it3) * tiledim[2] + t4; + + /* loop through planes of the image */ + for (i2 = 0, it2=0; i2 <= imglpix[2] - imgfpix[2]; i2++, it2++) + { + /* incre plane if it falls in the cracks of the subsampled image */ + while (ndim > 2 && (tfpixel[2] + tilefpix[2] - fpixel[2] + it2) + % labs(inc[2]) != 0) + it2++; + + /* offset to start of plane */ + if (inc[2] > 0) + im2 = (i2 + imgfpix[2]) * imgdim[1] + im3; + else + im2 = imgdim[2] - (i2 + 1 + imgfpix[2]) * imgdim[1] + im3; + + t2 = (tilefpix[2] + it2) * tiledim[1] + t3; + + /* loop through rows of the image */ + for (i1 = 0, it1=0; i1 <= imglpix[1] - imgfpix[1]; i1++, it1++) + { + /* incre row if it falls in the cracks of the subsampled image */ + while (ndim > 1 && (tfpixel[1] + tilefpix[1] - fpixel[1] + it1) + % labs(inc[1]) != 0) + it1++; + + /* calc position of first pixel in tile to be copied */ + tilepix = tilefpix[0] + (tilefpix[1] + it1) * tiledim[0] + t2; + + /* offset to start of row */ + if (inc[1] > 0) + im1 = (i1 + imgfpix[1]) * imgdim[0] + im2; + else + im1 = imgdim[1] - (i1 + 1 + imgfpix[1]) * imgdim[0] + im2; +/* +printf("inc = %d %d %d %d\n",inc[0],inc[1],inc[2],inc[3]); +printf("im1,im2,im3,im4 = %d %d %d %d\n",im1,im2,im3,im4); +*/ + /* offset to byte within the row */ + if (inc[0] > 0) + imgpix = imgfpix[0] + im1; + else + imgpix = imgdim[0] - 1 - imgfpix[0] + im1; +/* +printf("tilefpix0,1, imgfpix1, it1, inc1, t2= %d %d %d %d %d %d\n", + tilefpix[0],tilefpix[1],imgfpix[1],it1,inc[1], t2); +printf("i1, it1, tilepix, imgpix %d %d %d %d \n", i1, it1, tilepix, imgpix); +*/ + /* loop over pixels along one row of the image */ + for (ipos = imgfpix[0]; ipos <= imglpix[0]; ipos += overlap_flags) + { + if (nullcheck == 2) + { + /* copy overlapping null flags from tile to image */ + memcpy(nullarray + imgpix, bnullarray + tilepix, + overlap_flags); + } + + /* convert from image pixel to byte offset */ + tilepixbyte = tilepix * pixlen; + imgpixbyte = imgpix * pixlen; +/* +printf(" tilepix, tilepixbyte, imgpix, imgpixbyte= %d %d %d %d\n", + tilepix, tilepixbyte, imgpix, imgpixbyte); +*/ + /* copy overlapping row of pixels from tile to image */ + memcpy(image + imgpixbyte, tile + tilepixbyte, overlap_bytes); + + tilepix += (overlap_flags * labs(inc[0])); + if (inc[0] > 0) + imgpix += overlap_flags; + else + imgpix -= overlap_flags; + } + } + } + } + } + return(*status); +} + +/*--------------------------------------------------------------------------*/ +int imcomp_merge_overlap ( + char *tile, /* O - multi dimensional array of tile pixels */ + int pixlen, /* I - number of bytes in each tile or image pixel */ + int ndim, /* I - number of dimension in the tile and image */ + long *tfpixel, /* I - first pixel number in each dim. of the tile */ + long *tlpixel, /* I - last pixel number in each dim. of the tile */ + char *bnullarray, /* I - array of null flags; used if nullcheck = 2 */ + char *image, /* I - multi dimensional output image */ + long *fpixel, /* I - first pixel number in each dim. of the image */ + long *lpixel, /* I - last pixel number in each dim. of the image */ + int nullcheck, /* I - 0, 1: do nothing; 2: set nullarray for nulls */ + int *status) + +/* + Similar to imcomp_copy_overlap, except it copies the overlapping pixels from + the 'image' to the 'tile'. +*/ +{ + long imgdim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */ + /* output image, allowing for inc factor */ + long tiledim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */ + /* tile, array; inc factor is not relevant */ + long imgfpix[MAX_COMPRESS_DIM]; /* 1st img pix overlapping tile: 0 base, */ + /* allowing for inc factor */ + long imglpix[MAX_COMPRESS_DIM]; /* last img pix overlapping tile 0 base, */ + /* allowing for inc factor */ + long tilefpix[MAX_COMPRESS_DIM]; /* 1st tile pix overlapping img 0 base, */ + /* allowing for inc factor */ + long inc[MAX_COMPRESS_DIM]; /* local copy of input ininc */ + long i1, i2, i3, i4; /* offset along each axis of the image */ + long it1, it2, it3, it4; + long im1, im2, im3, im4; /* offset to image pixel, allowing for inc */ + long ipos, tf, tl; + long t2, t3, t4; /* offset along each axis of the tile */ + long tilepix, imgpix, tilepixbyte, imgpixbyte; + int ii, overlap_bytes, overlap_flags; + + if (*status > 0) + return(*status); + + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + /* set default values for higher dimensions */ + inc[ii] = 1; + imgdim[ii] = 1; + tiledim[ii] = 1; + imgfpix[ii] = 0; + imglpix[ii] = 0; + tilefpix[ii] = 0; + } + + /* ------------------------------------------------------------ */ + /* calc amount of overlap in each dimension; if there is zero */ + /* overlap in any dimension then just return */ + /* ------------------------------------------------------------ */ + + for (ii = 0; ii < ndim; ii++) + { + if (tlpixel[ii] < fpixel[ii] || tfpixel[ii] > lpixel[ii]) + return(*status); /* there are no overlapping pixels */ + + /* calc dimensions of the output image section */ + imgdim[ii] = (lpixel[ii] - fpixel[ii]) / labs(inc[ii]) + 1; + if (imgdim[ii] < 1) + return(*status = NEG_AXIS); + + /* calc dimensions of the tile */ + tiledim[ii] = tlpixel[ii] - tfpixel[ii] + 1; + if (tiledim[ii] < 1) + return(*status = NEG_AXIS); + + if (ii > 0) + tiledim[ii] *= tiledim[ii - 1]; /* product of dimensions */ + + /* first and last pixels in image that overlap with the tile, 0 base */ + tf = tfpixel[ii] - 1; + tl = tlpixel[ii] - 1; + + /* skip this plane if it falls in the cracks of the subsampled image */ + while ((tf-(fpixel[ii] - 1)) % labs(inc[ii])) + { + tf++; + if (tf > tl) + return(*status); /* no overlapping pixels */ + } + + while ((tl-(fpixel[ii] - 1)) % labs(inc[ii])) + { + tl--; + if (tf > tl) + return(*status); /* no overlapping pixels */ + } + imgfpix[ii] = maxvalue((tf - fpixel[ii] +1) / labs(inc[ii]) , 0); + imglpix[ii] = minvalue((tl - fpixel[ii] +1) / labs(inc[ii]) , + imgdim[ii] - 1); + + /* first pixel in the tile that overlaps with the image (0 base) */ + tilefpix[ii] = maxvalue(fpixel[ii] - tfpixel[ii], 0); + + while ((tfpixel[ii] + tilefpix[ii] - fpixel[ii]) % labs(inc[ii])) + { + (tilefpix[ii])++; + if (tilefpix[ii] >= tiledim[ii]) + return(*status); /* no overlapping pixels */ + } +/* +printf("ii tfpixel, tlpixel %d %d %d \n",ii, tfpixel[ii], tlpixel[ii]); +printf("ii, tf, tl, imgfpix,imglpix, tilefpix %d %d %d %d %d %d\n",ii, + tf,tl,imgfpix[ii], imglpix[ii],tilefpix[ii]); +*/ + if (ii > 0) + imgdim[ii] *= imgdim[ii - 1]; /* product of dimensions */ + } + + /* ---------------------------------------------------------------- */ + /* calc number of pixels in each row (first dimension) that overlap */ + /* multiply by pixlen to get number of bytes to copy in each loop */ + /* ---------------------------------------------------------------- */ + + if (inc[0] != 1) + overlap_flags = 1; /* can only copy 1 pixel at a time */ + else + overlap_flags = imglpix[0] - imgfpix[0] + 1; /* can copy whole row */ + + overlap_bytes = overlap_flags * pixlen; + + /* support up to 5 dimensions for now */ + for (i4 = 0, it4=0; i4 <= imglpix[4] - imgfpix[4]; i4++, it4++) + { + /* increment plane if it falls in the cracks of the subsampled image */ + while (ndim > 4 && (tfpixel[4] + tilefpix[4] - fpixel[4] + it4) + % labs(inc[4]) != 0) + it4++; + + /* offset to start of hypercube */ + if (inc[4] > 0) + im4 = (i4 + imgfpix[4]) * imgdim[3]; + else + im4 = imgdim[4] - (i4 + 1 + imgfpix[4]) * imgdim[3]; + + t4 = (tilefpix[4] + it4) * tiledim[3]; + for (i3 = 0, it3=0; i3 <= imglpix[3] - imgfpix[3]; i3++, it3++) + { + /* increment plane if it falls in the cracks of the subsampled image */ + while (ndim > 3 && (tfpixel[3] + tilefpix[3] - fpixel[3] + it3) + % labs(inc[3]) != 0) + it3++; + + /* offset to start of cube */ + if (inc[3] > 0) + im3 = (i3 + imgfpix[3]) * imgdim[2] + im4; + else + im3 = imgdim[3] - (i3 + 1 + imgfpix[3]) * imgdim[2] + im4; + + t3 = (tilefpix[3] + it3) * tiledim[2] + t4; + + /* loop through planes of the image */ + for (i2 = 0, it2=0; i2 <= imglpix[2] - imgfpix[2]; i2++, it2++) + { + /* incre plane if it falls in the cracks of the subsampled image */ + while (ndim > 2 && (tfpixel[2] + tilefpix[2] - fpixel[2] + it2) + % labs(inc[2]) != 0) + it2++; + + /* offset to start of plane */ + if (inc[2] > 0) + im2 = (i2 + imgfpix[2]) * imgdim[1] + im3; + else + im2 = imgdim[2] - (i2 + 1 + imgfpix[2]) * imgdim[1] + im3; + + t2 = (tilefpix[2] + it2) * tiledim[1] + t3; + + /* loop through rows of the image */ + for (i1 = 0, it1=0; i1 <= imglpix[1] - imgfpix[1]; i1++, it1++) + { + /* incre row if it falls in the cracks of the subsampled image */ + while (ndim > 1 && (tfpixel[1] + tilefpix[1] - fpixel[1] + it1) + % labs(inc[1]) != 0) + it1++; + + /* calc position of first pixel in tile to be copied */ + tilepix = tilefpix[0] + (tilefpix[1] + it1) * tiledim[0] + t2; + + /* offset to start of row */ + if (inc[1] > 0) + im1 = (i1 + imgfpix[1]) * imgdim[0] + im2; + else + im1 = imgdim[1] - (i1 + 1 + imgfpix[1]) * imgdim[0] + im2; +/* +printf("inc = %d %d %d %d\n",inc[0],inc[1],inc[2],inc[3]); +printf("im1,im2,im3,im4 = %d %d %d %d\n",im1,im2,im3,im4); +*/ + /* offset to byte within the row */ + if (inc[0] > 0) + imgpix = imgfpix[0] + im1; + else + imgpix = imgdim[0] - 1 - imgfpix[0] + im1; +/* +printf("tilefpix0,1, imgfpix1, it1, inc1, t2= %d %d %d %d %d %d\n", + tilefpix[0],tilefpix[1],imgfpix[1],it1,inc[1], t2); +printf("i1, it1, tilepix, imgpix %d %d %d %d \n", i1, it1, tilepix, imgpix); +*/ + /* loop over pixels along one row of the image */ + for (ipos = imgfpix[0]; ipos <= imglpix[0]; ipos += overlap_flags) + { + /* convert from image pixel to byte offset */ + tilepixbyte = tilepix * pixlen; + imgpixbyte = imgpix * pixlen; +/* +printf(" tilepix, tilepixbyte, imgpix, imgpixbyte= %d %d %d %d\n", + tilepix, tilepixbyte, imgpix, imgpixbyte); +*/ + /* copy overlapping row of pixels from image to tile */ + memcpy(tile + tilepixbyte, image + imgpixbyte, overlap_bytes); + + tilepix += (overlap_flags * labs(inc[0])); + if (inc[0] > 0) + imgpix += overlap_flags; + else + imgpix -= overlap_flags; + } + } + } + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/iraffits.c b/pkg/tbtables/cfitsio/iraffits.c new file mode 100644 index 00000000..db6940d6 --- /dev/null +++ b/pkg/tbtables/cfitsio/iraffits.c @@ -0,0 +1,1975 @@ +/*------------------------------------------------------------------------*/ +/* */ +/* These routines have been modified by William Pence for use by CFITSIO */ +/* The original files were provided by Doug Mink */ +/*------------------------------------------------------------------------*/ + +/* File imhfile.c + * August 6, 1998 + * By Doug Mink, based on Mike VanHilst's readiraf.c + + * Module: imhfile.c (IRAF .imh image file reading and writing) + * Purpose: Read and write IRAF image files (and translate headers) + * Subroutine: irafrhead (filename, lfhead, fitsheader, lihead) + * Read IRAF image header + * Subroutine: irafrimage (fitsheader) + * Read IRAF image pixels (call after irafrhead) + * Subroutine: same_path (pixname, hdrname) + * Put filename and header path together + * Subroutine: iraf2fits (hdrname, irafheader, nbiraf, nbfits) + * Convert IRAF image header to FITS image header + * Subroutine: irafgeti4 (irafheader, offset) + * Get 4-byte integer from arbitrary part of IRAF header + * Subroutine: irafgetc2 (irafheader, offset) + * Get character string from arbitrary part of IRAF v.1 header + * Subroutine: irafgetc (irafheader, offset) + * Get character string from arbitrary part of IRAF header + * Subroutine: iraf2str (irafstring, nchar) + * Convert 2-byte/char IRAF string to 1-byte/char string + * Subroutine: irafswap (bitpix,string,nbytes) + * Swap bytes in string in place, with FITS bits/pixel code + * Subroutine: irafswap2 (string,nbytes) + * Swap bytes in string in place + * Subroutine irafswap4 (string,nbytes) + * Reverse bytes of Integer*4 or Real*4 vector in place + * Subroutine irafswap8 (string,nbytes) + * Reverse bytes of Real*8 vector in place + + + * Copyright: 2000 Smithsonian Astrophysical Observatory + * You may do anything you like with this file except remove + * this copyright. The Smithsonian Astrophysical Observatory + * makes no representations about the suitability of this + * software for any purpose. It is provided "as is" without + * express or implied warranty. + */ + +#include /* define stderr, FD, and NULL */ +#include +#include /* stddef.h is apparently needed to define size_t */ +#include + +#define FILE_NOT_OPENED 104 + +/* Parameters from iraf/lib/imhdr.h for IRAF version 1 images */ +#define SZ_IMPIXFILE 79 /* name of pixel storage file */ +#define SZ_IMHDRFILE 79 /* length of header storage file */ +#define SZ_IMTITLE 79 /* image title string */ +#define LEN_IMHDR 2052 /* length of std header */ + +/* Parameters from iraf/lib/imhdr.h for IRAF version 2 images */ +#define SZ_IM2PIXFILE 255 /* name of pixel storage file */ +#define SZ_IM2HDRFILE 255 /* name of header storage file */ +#define SZ_IM2TITLE 383 /* image title string */ +#define LEN_IM2HDR 2046 /* length of std header */ + +/* Offsets into header in bytes for parameters in IRAF version 1 images */ +#define IM_HDRLEN 12 /* Length of header in 4-byte ints */ +#define IM_PIXTYPE 16 /* Datatype of the pixels */ +#define IM_NDIM 20 /* Number of dimensions */ +#define IM_LEN 24 /* Length (as stored) */ +#define IM_PHYSLEN 52 /* Physical length (as stored) */ +#define IM_PIXOFF 88 /* Offset of the pixels */ +#define IM_CTIME 108 /* Time of image creation */ +#define IM_MTIME 112 /* Time of last modification */ +#define IM_LIMTIME 116 /* Time of min,max computation */ +#define IM_MAX 120 /* Maximum pixel value */ +#define IM_MIN 124 /* Maximum pixel value */ +#define IM_PIXFILE 412 /* Name of pixel storage file */ +#define IM_HDRFILE 572 /* Name of header storage file */ +#define IM_TITLE 732 /* Image name string */ + +/* Offsets into header in bytes for parameters in IRAF version 2 images */ +#define IM2_HDRLEN 6 /* Length of header in 4-byte ints */ +#define IM2_PIXTYPE 10 /* Datatype of the pixels */ +#define IM2_SWAPPED 14 /* Pixels are byte swapped */ +#define IM2_NDIM 18 /* Number of dimensions */ +#define IM2_LEN 22 /* Length (as stored) */ +#define IM2_PHYSLEN 50 /* Physical length (as stored) */ +#define IM2_PIXOFF 86 /* Offset of the pixels */ +#define IM2_CTIME 106 /* Time of image creation */ +#define IM2_MTIME 110 /* Time of last modification */ +#define IM2_LIMTIME 114 /* Time of min,max computation */ +#define IM2_MAX 118 /* Maximum pixel value */ +#define IM2_MIN 122 /* Maximum pixel value */ +#define IM2_PIXFILE 126 /* Name of pixel storage file */ +#define IM2_HDRFILE 382 /* Name of header storage file */ +#define IM2_TITLE 638 /* Image name string */ + +/* Codes from iraf/unix/hlib/iraf.h */ +#define TY_CHAR 2 +#define TY_SHORT 3 +#define TY_INT 4 +#define TY_LONG 5 +#define TY_REAL 6 +#define TY_DOUBLE 7 +#define TY_COMPLEX 8 +#define TY_POINTER 9 +#define TY_STRUCT 10 +#define TY_USHORT 11 +#define TY_UBYTE 12 + +#define LEN_PIXHDR 1024 +#define MAXINT 2147483647 /* Biggest number that can fit in long */ + +static int isirafswapped(char *irafheader, int offset); +static int irafgeti4(char *irafheader, int offset); +static char *irafgetc2(char *irafheader, int offset, int nc); +static char *irafgetc(char *irafheader, int offset, int nc); +static char *iraf2str(char *irafstring, int nchar); +static char *irafrdhead(char *filename, int *lihead); +static int irafrdimage (char **buffptr, size_t *buffsize, + size_t *filesize, int *status); +static int iraftofits (char *hdrname, char *irafheader, int nbiraf, + char **buffptr, size_t *nbfits, size_t *fitssize, int *status); +static char *same_path(char *pixname, char *hdrname); + +static int swaphead=0; /* =1 to swap data bytes of IRAF header values */ +static int swapdata=0; /* =1 to swap bytes in IRAF data pixels */ + +static void irafswap(int bitpix, char *string, int nbytes); +static void irafswap2(char *string, int nbytes); +static void irafswap4(char *string, int nbytes); +static void irafswap8(char *string, int nbytes); +static int pix_version (char *irafheader); +static int irafncmp (char *irafheader, char *teststring, int nc); +static int machswap(void); +static int head_version (char *irafheader); +static int hgeti4(char* hstring, char* keyword, int* val); +static int hgets(char* hstring, char* keyword, int lstr, char* string); +static char* hgetc(char* hstring, char* keyword); +static char* ksearch(char* hstring, char* keyword); +static char *blsearch (char* hstring, char* keyword); +static char *strsrch (char* s1, char* s2); +static char *strnsrch ( char* s1,char* s2,int ls1); +static void hputi4(char* hstring,char* keyword, int ival); +static void hputs(char* hstring,char* keyword,char* cval); +static void hputcom(char* hstring,char* keyword,char* comment); +static void hputl(char* hstring,char* keyword,int lval); +static void hputc(char* hstring,char* keyword,char* cval); + +int iraf2mem(char *filename, char **buffptr, size_t *buffsize, + size_t *filesize, int *status); + +void ffpmsg(const char *err_message); + +/*--------------------------------------------------------------------------*/ +int iraf2mem(char *filename, /* name of input file */ + char **buffptr, /* O - memory pointer (initially NULL) */ + size_t *buffsize, /* O - size of mem buffer, in bytes */ + size_t *filesize, /* O - size of FITS file, in bytes */ + int *status) /* IO - error status */ + +/* + Driver routine that reads an IRAF image into memory, also converting + it into FITS format. +*/ +{ + char *irafheader; + int lenirafhead; + + *buffptr = NULL; + *buffsize = 0; + *filesize = 0; + + /* read IRAF header into dynamically created char array (free it later!) */ + irafheader = irafrdhead(filename, &lenirafhead); + + if (!irafheader) + { + return(*status = FILE_NOT_OPENED); + } + + /* convert IRAF header to FITS header in memory */ + iraftofits(filename, irafheader, lenirafhead, buffptr, buffsize, filesize, + status); + + /* don't need the IRAF header any more */ + free(irafheader); + + if (*status > 0) + return(*status); + + *filesize = (((*filesize - 1) / 2880 ) + 1 ) * 2880; /* multiple of 2880 */ + + /* append the image data onto the FITS header */ + irafrdimage(buffptr, buffsize, filesize, status); + + return(*status); +} + +/*--------------------------------------------------------------------------*/ +/* Subroutine: irafrdhead (was irafrhead in D. Mink's original code) + * Purpose: Open and read the iraf .imh file. + * Returns: NULL if failure, else pointer to IRAF .imh image header + * Notes: The imhdr format is defined in iraf/lib/imhdr.h, some of + * which defines or mimicked, above. + */ + +static char *irafrdhead ( + char *filename, /* Name of IRAF header file */ + int *lihead) /* Length of IRAF image header in bytes (returned) */ +{ + FILE *fd; + int nbr; + char *irafheader; + char errmsg[81]; + long nbhead; + int nihead; + + *lihead = 0; + + /* open the image header file */ + fd = fopen (filename, "rb"); + if (fd == NULL) { + ffpmsg("unable to open IRAF header file:"); + ffpmsg(filename); + return (NULL); + } + + /* Find size of image header file */ + if (fseek(fd, 0, 2) != 0) /* move to end of the file */ + { + ffpmsg("IRAFRHEAD: cannot seek in file:"); + ffpmsg(filename); + return(NULL); + } + + nbhead = ftell(fd); /* position = size of file */ + if (nbhead < 0) + { + ffpmsg("IRAFRHEAD: cannot get pos. in file:"); + ffpmsg(filename); + return(NULL); + } + + if (fseek(fd, 0, 0) != 0) /* move back to beginning */ + { + ffpmsg("IRAFRHEAD: cannot seek to beginning of file:"); + ffpmsg(filename); + return(NULL); + } + + /* allocate initial sized buffer */ + nihead = nbhead + 5000; + irafheader = (char *) calloc (1, nihead); + if (irafheader == NULL) { + sprintf(errmsg, "IRAFRHEAD Cannot allocate %d-byte header", + nihead); + ffpmsg(errmsg); + ffpmsg(filename); + return (NULL); + } + *lihead = nihead; + + /* Read IRAF header */ + nbr = fread (irafheader, 1, nbhead, fd); + fclose (fd); + + /* Reject if header less than minimum length */ + if (nbr < LEN_PIXHDR) { + sprintf(errmsg, "IRAFRHEAD header file: %d / %d bytes read.", + nbr,LEN_PIXHDR); + ffpmsg(errmsg); + ffpmsg(filename); + free (irafheader); + return (NULL); + } + + return (irafheader); +} +/*--------------------------------------------------------------------------*/ +static int irafrdimage ( + char **buffptr, /* FITS image header (filled) */ + size_t *buffsize, /* allocated size of the buffer */ + size_t *filesize, /* actual size of the FITS file */ + int *status) +{ + FILE *fd; + char *bang; + int nax, naxis1 = 1, naxis2 = 1, naxis3 = 1, naxis4 = 1, npaxis1, npaxis2; + int bitpix, bytepix, i; + char *fitsheader, *image; + int nbr, nbimage, nbaxis, nbl, nbx, nbdiff; + char *pixheader; + char *linebuff; + int imhver, lpixhead; + char pixname[SZ_IM2PIXFILE+1]; + char errmsg[81]; + size_t newfilesize; + + fitsheader = *buffptr; /* pointer to start of header */ + image = fitsheader + *filesize; /* pointer to start of the data */ + + /* Convert pixel file name to character string */ + hgets (fitsheader, "PIXFILE", SZ_IM2PIXFILE, pixname); + hgeti4 (fitsheader, "PIXOFF", &lpixhead); + + /* Open pixel file, ignoring machine name if present */ + if ((bang = strchr (pixname, '!')) != NULL ) + fd = fopen (bang + 1, "rb"); + else + fd = fopen (pixname, "rb"); + + /* Print error message and exit if pixel file is not found */ + if (!fd) { + ffpmsg("IRAFRIMAGE: Cannot open IRAF pixel file:"); + ffpmsg(pixname); + return (*status = FILE_NOT_OPENED); + } + + /* Read pixel header */ + pixheader = (char *) calloc (lpixhead, 1); + if (pixheader == NULL) { + ffpmsg("IRAFRIMAGE: Cannot alloc memory for pixel header"); + ffpmsg(pixname); + fclose (fd); + return (*status = FILE_NOT_OPENED); + } + nbr = fread (pixheader, 1, lpixhead, fd); + + /* Check size of pixel header */ + if (nbr < lpixhead) { + sprintf(errmsg, "IRAF pixel file: %d / %d bytes read.", + nbr,LEN_PIXHDR); + ffpmsg(errmsg); + free (pixheader); + fclose (fd); + return (*status = FILE_NOT_OPENED); + } + + /* check pixel header magic word */ + imhver = pix_version (pixheader); + if (imhver < 1) { + ffpmsg("File not valid IRAF pixel file:"); + ffpmsg(pixname); + free (pixheader); + fclose (fd); + return (*status = FILE_NOT_OPENED); + } + free (pixheader); + + /* Find number of bytes to read */ + hgeti4 (fitsheader,"NAXIS",&nax); + hgeti4 (fitsheader,"NAXIS1",&naxis1); + hgeti4 (fitsheader,"NPAXIS1",&npaxis1); + if (nax > 1) { + hgeti4 (fitsheader,"NAXIS2",&naxis2); + hgeti4 (fitsheader,"NPAXIS2",&npaxis2); + } + if (nax > 2) + hgeti4 (fitsheader,"NAXIS3",&naxis3); + if (nax > 3) + hgeti4 (fitsheader,"NAXIS4",&naxis4); + + hgeti4 (fitsheader,"BITPIX",&bitpix); + if (bitpix < 0) + bytepix = -bitpix / 8; + else + bytepix = bitpix / 8; + + nbimage = naxis1 * naxis2 * naxis3 * naxis4 * bytepix; + + newfilesize = *filesize + nbimage; /* header + data */ + newfilesize = (((newfilesize - 1) / 2880 ) + 1 ) * 2880; + + if (newfilesize > *buffsize) /* need to allocate more memory? */ + { + fitsheader = (char *) realloc (*buffptr, newfilesize); + if (fitsheader == NULL) { + sprintf(errmsg, "IRAFRIMAGE Cannot allocate %d-byte image buffer", + (int) (*filesize)); + ffpmsg(errmsg); + ffpmsg(pixname); + fclose (fd); + return (*status = FILE_NOT_OPENED); + } + } + + *buffptr = fitsheader; + *buffsize = newfilesize; + + image = fitsheader + *filesize; + *filesize = newfilesize; + + /* Read IRAF image all at once if physical and image dimensions are the same */ + if (npaxis1 == naxis1) + nbr = fread (image, 1, nbimage, fd); + + /* Read IRAF image one line at a time if physical and image dimensions differ */ + else { + nbdiff = (npaxis1 - naxis1) * bytepix; + nbaxis = naxis1 * bytepix; + linebuff = image; + nbr = 0; + if (naxis2 == 1 && naxis3 > 1) + naxis2 = naxis3; + for (i = 0; i < naxis2; i++) { + nbl = fread (linebuff, 1, nbaxis, fd); + nbr = nbr + nbl; + nbx = fseek (fd, nbdiff, SEEK_CUR); + linebuff = linebuff + nbaxis; + } + } + fclose (fd); + + /* Check size of image */ + if (nbr < nbimage) { + sprintf(errmsg, "IRAF pixel file: %d / %d bytes read.", + nbr,nbimage); + ffpmsg(errmsg); + ffpmsg(pixname); + return (*status = FILE_NOT_OPENED); + } + + /* Byte-reverse image, if necessary */ + if (swapdata) + irafswap (bitpix, image, nbimage); + + return (*status); +} +/*--------------------------------------------------------------------------*/ +/* Return IRAF image format version number from magic word in IRAF header*/ + +static int head_version ( + char *irafheader) /* IRAF image header from file */ + +{ + + /* Check header file magic word */ + if (irafncmp (irafheader, "imhdr", 5) != 0 ) { + if (strncmp (irafheader, "imhv2", 5) != 0) + return (0); + else + return (2); + } + else + return (1); +} + +/*--------------------------------------------------------------------------*/ +/* Return IRAF image format version number from magic word in IRAF pixel file */ + +static int pix_version ( + char *irafheader) /* IRAF image header from file */ +{ + + /* Check pixel file header magic word */ + if (irafncmp (irafheader, "impix", 5) != 0) { + if (strncmp (irafheader, "impv2", 5) != 0) + return (0); + else + return (2); + } + else + return (1); +} + +/*--------------------------------------------------------------------------*/ +/* Verify that file is valid IRAF imhdr or impix by checking first 5 chars + * Returns: 0 on success, 1 on failure */ + +static int irafncmp ( + +char *irafheader, /* IRAF image header from file */ +char *teststring, /* C character string to compare */ +int nc) /* Number of characters to compate */ + +{ + char *line; + + if ((line = iraf2str (irafheader, nc)) == NULL) + return (1); + if (strncmp (line, teststring, nc) == 0) { + free (line); + return (0); + } + else { + free (line); + return (1); + } +} +/*--------------------------------------------------------------------------*/ + +/* Convert IRAF image header to FITS image header, returning FITS header */ + +static int iraftofits ( + char *hdrname, /* IRAF header file name (may be path) */ + char *irafheader, /* IRAF image header */ + int nbiraf, /* Number of bytes in IRAF header */ + char **buffptr, /* pointer to the FITS header */ + size_t *nbfits, /* allocated size of the FITS header buffer */ + size_t *fitssize, /* Number of bytes in FITS header (returned) */ + /* = number of bytes to the end of the END keyword */ + int *status) +{ + char *objname; /* object name from FITS file */ + int lstr, i, j, k, ib, nax, nbits; + char *pixname, *newpixname, *bang, *chead; + char *fitsheader; + int nblock, nlines; + char *fhead, *fhead1, *fp, endline[81]; + char irafchar; + char fitsline[81]; + int pixtype; + int imhver, n, imu, pixoff, impixoff, immax, immin, imtime; + int imndim, imlen, imphyslen, impixtype; + char errmsg[81]; + + /* Set up last line of FITS header */ + (void)strncpy (endline,"END", 3); + for (i = 3; i < 80; i++) + endline[i] = ' '; + endline[80] = 0; + + /* Check header magic word */ + imhver = head_version (irafheader); + if (imhver < 1) { + ffpmsg("File not valid IRAF image header"); + ffpmsg(hdrname); + return(*status = FILE_NOT_OPENED); + } + if (imhver == 2) { + nlines = 24 + ((nbiraf - LEN_IM2HDR) / 81); + imndim = IM2_NDIM; + imlen = IM2_LEN; + imphyslen = IM2_PHYSLEN; + impixtype = IM2_PIXTYPE; + impixoff = IM2_PIXOFF; + imtime = IM2_MTIME; + immax = IM2_MAX; + immin = IM2_MIN; + } + else { + nlines = 24 + ((nbiraf - LEN_IMHDR) / 162); + imndim = IM_NDIM; + imlen = IM_LEN; + imphyslen = IM_PHYSLEN; + impixtype = IM_PIXTYPE; + impixoff = IM_PIXOFF; + imtime = IM_MTIME; + immax = IM_MAX; + immin = IM_MIN; + } + + /* Initialize FITS header */ + nblock = (nlines * 80) / 2880; + *nbfits = (nblock + 5) * 2880 + 4; + fitsheader = (char *) calloc (*nbfits, 1); + if (fitsheader == NULL) { + sprintf(errmsg, "IRAF2FITS Cannot allocate %d-byte FITS header", + (int) (*nbfits)); + ffpmsg(hdrname); + return (*status = FILE_NOT_OPENED); + } + + fhead = fitsheader; + *buffptr = fitsheader; + (void)strncpy (fitsheader, endline, 80); + hputl (fitsheader, "SIMPLE", 1); + fhead = fhead + 80; + + /* check if the IRAF file is in big endian (sun) format (= 0) or not. */ + /* This is done by checking the 4 byte integer in the header that */ + /* represents the iraf pixel type. This 4-byte word is guaranteed to */ + /* have the least sig byte != 0 and the most sig byte = 0, so if the */ + /* first byte of the word != 0, then the file in little endian format */ + /* like on an Alpha machine. */ + + swaphead = isirafswapped(irafheader, impixtype); + if (imhver == 1) + swapdata = swaphead; /* vers 1 data has same swapness as header */ + else + swapdata = irafgeti4 (irafheader, IM2_SWAPPED); + + /* Set pixel size in FITS header */ + pixtype = irafgeti4 (irafheader, impixtype); + switch (pixtype) { + case TY_CHAR: + nbits = 8; + break; + case TY_UBYTE: + nbits = 8; + break; + case TY_SHORT: + nbits = 16; + break; + case TY_USHORT: + nbits = -16; + break; + case TY_INT: + case TY_LONG: + nbits = 32; + break; + case TY_REAL: + nbits = -32; + break; + case TY_DOUBLE: + nbits = -64; + break; + default: + sprintf(errmsg,"Unsupported IRAF data type: %d", pixtype); + ffpmsg(errmsg); + ffpmsg(hdrname); + return (*status = FILE_NOT_OPENED); + } + hputi4 (fitsheader,"BITPIX",nbits); + hputcom (fitsheader,"BITPIX", "IRAF .imh pixel type"); + fhead = fhead + 80; + + /* Set image dimensions in FITS header */ + nax = irafgeti4 (irafheader, imndim); + hputi4 (fitsheader,"NAXIS",nax); + hputcom (fitsheader,"NAXIS", "IRAF .imh naxis"); + fhead = fhead + 80; + + n = irafgeti4 (irafheader, imlen); + hputi4 (fitsheader, "NAXIS1", n); + hputcom (fitsheader,"NAXIS1", "IRAF .imh image naxis[1]"); + fhead = fhead + 80; + + if (nax > 1) { + n = irafgeti4 (irafheader, imlen+4); + hputi4 (fitsheader, "NAXIS2", n); + hputcom (fitsheader,"NAXIS2", "IRAF .imh image naxis[2]"); + fhead = fhead + 80; + } + if (nax > 2) { + n = irafgeti4 (irafheader, imlen+8); + hputi4 (fitsheader, "NAXIS3", n); + hputcom (fitsheader,"NAXIS3", "IRAF .imh image naxis[3]"); + fhead = fhead + 80; + } + if (nax > 3) { + n = irafgeti4 (irafheader, imlen+12); + hputi4 (fitsheader, "NAXIS4", n); + hputcom (fitsheader,"NAXIS4", "IRAF .imh image naxis[4]"); + fhead = fhead + 80; + } + + /* Set object name in FITS header */ + if (imhver == 2) + objname = irafgetc (irafheader, IM2_TITLE, SZ_IM2TITLE); + else + objname = irafgetc2 (irafheader, IM_TITLE, SZ_IMTITLE); + if ((lstr = strlen (objname)) < 8) { + for (i = lstr; i < 8; i++) + objname[i] = ' '; + objname[8] = 0; + } + hputs (fitsheader,"OBJECT",objname); + hputcom (fitsheader,"OBJECT", "IRAF .imh title"); + free (objname); + fhead = fhead + 80; + + /* Save physical axis lengths so image file can be read */ + n = irafgeti4 (irafheader, imphyslen); + hputi4 (fitsheader, "NPAXIS1", n); + hputcom (fitsheader,"NPAXIS1", "IRAF .imh physical naxis[1]"); + fhead = fhead + 80; + if (nax > 1) { + n = irafgeti4 (irafheader, imphyslen+4); + hputi4 (fitsheader, "NPAXIS2", n); + hputcom (fitsheader,"NPAXIS2", "IRAF .imh physical naxis[2]"); + fhead = fhead + 80; + } + if (nax > 2) { + n = irafgeti4 (irafheader, imphyslen+8); + hputi4 (fitsheader, "NPAXIS3", n); + hputcom (fitsheader,"NPAXIS3", "IRAF .imh physical naxis[3]"); + fhead = fhead + 80; + } + if (nax > 3) { + n = irafgeti4 (irafheader, imphyslen+12); + hputi4 (fitsheader, "NPAXIS4", n); + hputcom (fitsheader,"NPAXIS4", "IRAF .imh physical naxis[4]"); + fhead = fhead + 80; + } + + /* Save image header filename in header */ + hputs (fitsheader,"IMHFILE",hdrname); + hputcom (fitsheader,"IMHFILE", "IRAF header file name"); + fhead = fhead + 80; + + /* Save image pixel file pathname in header */ + if (imhver == 2) + pixname = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE); + else + pixname = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE); + if (strncmp(pixname, "HDR", 3) == 0 ) { + newpixname = same_path (pixname, hdrname); + free (pixname); + pixname = newpixname; + } + if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) { + newpixname = same_path (pixname, hdrname); + free (pixname); + pixname = newpixname; + } + + if ((bang = strchr (pixname, '!')) != NULL ) + hputs (fitsheader,"PIXFILE",bang+1); + else + hputs (fitsheader,"PIXFILE",pixname); + free (pixname); + hputcom (fitsheader,"PIXFILE", "IRAF .pix pixel file"); + fhead = fhead + 80; + + /* Save image offset from star of pixel file */ + pixoff = irafgeti4 (irafheader, impixoff); + pixoff = (pixoff - 1) * 2; + hputi4 (fitsheader, "PIXOFF", pixoff); + hputcom (fitsheader,"PIXOFF", "IRAF .pix pixel offset (Do not change!)"); + fhead = fhead + 80; + + /* Save IRAF file format version in header */ + hputi4 (fitsheader,"IMHVER",imhver); + hputcom (fitsheader,"IMHVER", "IRAF .imh format version (1 or 2)"); + fhead = fhead + 80; + + /* Save flag as to whether to swap IRAF data for this file and machine */ + if (swapdata) + hputl (fitsheader, "PIXSWAP", 1); + else + hputl (fitsheader, "PIXSWAP", 0); + hputcom (fitsheader,"PIXSWAP", "IRAF pixels, FITS byte orders differ if T"); + fhead = fhead + 80; + + /* Add user portion of IRAF header to FITS header */ + fitsline[80] = 0; + if (imhver == 2) { + imu = LEN_IM2HDR; + chead = irafheader; + j = 0; + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + for (i = imu; i < nbiraf; i++) { + irafchar = chead[i]; + if (irafchar == 0) + break; + else if (irafchar == 10) { + (void)strncpy (fhead, fitsline, 80); + /* fprintf (stderr,"%80s\n",fitsline); */ + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + fhead = fhead + 80; + } + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + j = 0; + } + else { + if (j > 80) { + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + (void)strncpy (fhead, fitsline, 80); + /* fprintf (stderr,"%80s\n",fitsline); */ + j = 9; + fhead = fhead + 80; + } + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + } + if (irafchar > 32 && irafchar < 127) + fitsline[j] = irafchar; + j++; + } + } + } + else { + imu = LEN_IMHDR; + chead = irafheader; + if (swaphead == 1) + ib = 0; + else + ib = 1; + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + j = 0; + for (i = imu; i < nbiraf; i=i+2) { + irafchar = chead[i+ib]; + if (irafchar == 0) + break; + else if (irafchar == 10) { + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + (void)strncpy (fhead, fitsline, 80); + fhead = fhead + 80; + } + /* fprintf (stderr,"%80s\n",fitsline); */ + j = 0; + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + } + else { + if (j > 80) { + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + (void)strncpy (fhead, fitsline, 80); + j = 9; + fhead = fhead + 80; + } + /* fprintf (stderr,"%80s\n",fitsline); */ + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + } + if (irafchar > 32 && irafchar < 127) + fitsline[j] = irafchar; + j++; + } + } + } + + /* Add END to last line */ + (void)strncpy (fhead, endline, 80); + + /* Find end of last 2880-byte block of header */ + fhead = ksearch (fitsheader, "END") + 80; + nblock = *nbfits / 2880; + fhead1 = fitsheader + (nblock * 2880); + *fitssize = fhead - fitsheader; /* no. of bytes to end of END keyword */ + + /* Pad rest of header with spaces */ + strncpy (endline," ",3); + for (fp = fhead; fp < fhead1; fp = fp + 80) { + (void)strncpy (fp, endline,80); + } + + return (*status); +} + +/*--------------------------------------------------------------------------*/ +/* Put filename and header path together */ + +static char *same_path ( + +char *pixname, /* IRAF pixel file pathname */ +char *hdrname) /* IRAF image header file pathname */ + +{ + int len; + char *newpixname; + + newpixname = (char *) calloc (SZ_IM2PIXFILE, sizeof (char)); + + /* Pixel file is in same directory as header */ + if (strncmp(pixname, "HDR$", 4) == 0 ) { + (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE); + + /* find the end of the pathname */ + len = strlen (newpixname); +#ifndef VMS + while( (len > 0) && (newpixname[len-1] != '/') ) +#else + while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') ) +#endif + len--; + + /* add name */ + newpixname[len] = '\0'; + (void)strncat (newpixname, &pixname[4], SZ_IM2PIXFILE); + } + + /* Bare pixel file with no path is assumed to be same as HDR$filename */ + else if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) { + (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE); + + /* find the end of the pathname */ + len = strlen (newpixname); +#ifndef VMS + while( (len > 0) && (newpixname[len-1] != '/') ) +#else + while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') ) +#endif + len--; + + /* add name */ + newpixname[len] = '\0'; + (void)strncat (newpixname, pixname, SZ_IM2PIXFILE); + } + + /* Pixel file has same name as header file, but with .pix extension */ + else if (strncmp (pixname, "HDR", 3) == 0) { + + /* load entire header name string into name buffer */ + (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE); + len = strlen (newpixname); + newpixname[len-3] = 'p'; + newpixname[len-2] = 'i'; + newpixname[len-1] = 'x'; + } + + return (newpixname); +} + +/*--------------------------------------------------------------------------*/ +static int isirafswapped ( + +char *irafheader, /* IRAF image header */ +int offset) /* Number of bytes to skip before number */ + + /* check if the IRAF file is in big endian (sun) format (= 0) or not */ + /* This is done by checking the 4 byte integer in the header that */ + /* represents the iraf pixel type. This 4-byte word is guaranteed to */ + /* have the least sig byte != 0 and the most sig byte = 0, so if the */ + /* first byte of the word != 0, then the file in little endian format */ + /* like on an Alpha machine. */ + +{ + int swapped; + + if (irafheader[offset] != 0) + swapped = 1; + else + swapped = 0; + + return (swapped); +} +/*--------------------------------------------------------------------------*/ +static int irafgeti4 ( + +char *irafheader, /* IRAF image header */ +int offset) /* Number of bytes to skip before number */ + +{ + char *ctemp, *cheader; + int temp; + + cheader = irafheader; + ctemp = (char *) &temp; + + if (machswap() != swaphead) { + ctemp[3] = cheader[offset]; + ctemp[2] = cheader[offset+1]; + ctemp[1] = cheader[offset+2]; + ctemp[0] = cheader[offset+3]; + } + else { + ctemp[0] = cheader[offset]; + ctemp[1] = cheader[offset+1]; + ctemp[2] = cheader[offset+2]; + ctemp[3] = cheader[offset+3]; + } + return (temp); +} + +/*--------------------------------------------------------------------------*/ +/* IRAFGETC2 -- Get character string from arbitrary part of v.1 IRAF header */ + +static char *irafgetc2 ( + +char *irafheader, /* IRAF image header */ +int offset, /* Number of bytes to skip before string */ +int nc) /* Maximum number of characters in string */ + +{ + char *irafstring, *string; + + irafstring = irafgetc (irafheader, offset, 2*(nc+1)); + string = iraf2str (irafstring, nc); + free (irafstring); + + return (string); +} + +/*--------------------------------------------------------------------------*/ +/* IRAFGETC -- Get character string from arbitrary part of IRAF header */ + +static char *irafgetc ( + +char *irafheader, /* IRAF image header */ +int offset, /* Number of bytes to skip before string */ +int nc) /* Maximum number of characters in string */ + +{ + char *ctemp, *cheader; + int i; + + cheader = irafheader; + ctemp = (char *) calloc (nc+1, 1); + if (ctemp == NULL) { + ffpmsg("IRAFGETC Cannot allocate memory for string variable"); + return (NULL); + } + for (i = 0; i < nc; i++) { + ctemp[i] = cheader[offset+i]; + if (ctemp[i] > 0 && ctemp[i] < 32) + ctemp[i] = ' '; + } + + return (ctemp); +} + +/*--------------------------------------------------------------------------*/ +/* Convert IRAF 2-byte/char string to 1-byte/char string */ + +static char *iraf2str ( + +char *irafstring, /* IRAF 2-byte/character string */ +int nchar) /* Number of characters in string */ +{ + char *string; + int i, j; + + string = (char *) calloc (nchar+1, 1); + if (string == NULL) { + ffpmsg("IRAF2STR Cannot allocate memory for string variable"); + return (NULL); + } + + /* the chars are in bytes 1, 3, 5, ... if bigendian format (SUN) */ + /* else in bytes 0, 2, 4, ... if little endian format (Alpha) */ + + if (irafstring[0] != 0) + j = 0; + else + j = 1; + + /* Convert appropriate byte of input to output character */ + for (i = 0; i < nchar; i++) { + string[i] = irafstring[j]; + j = j + 2; + } + + return (string); +} + +/*--------------------------------------------------------------------------*/ +/* IRAFSWAP -- Reverse bytes of any type of vector in place */ + +static void irafswap ( + +int bitpix, /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +char *string, /* Address of starting point of bytes to swap */ +int nbytes) /* Number of bytes to swap */ + +{ + switch (bitpix) { + + case 16: + if (nbytes < 2) return; + irafswap2 (string,nbytes); + break; + + case 32: + if (nbytes < 4) return; + irafswap4 (string,nbytes); + break; + + case -16: + if (nbytes < 2) return; + irafswap2 (string,nbytes); + break; + + case -32: + if (nbytes < 4) return; + irafswap4 (string,nbytes); + break; + + case -64: + if (nbytes < 8) return; + irafswap8 (string,nbytes); + break; + + } + return; +} + +/*--------------------------------------------------------------------------*/ +/* IRAFSWAP2 -- Swap bytes in string in place */ + +static void irafswap2 ( + +char *string, /* Address of starting point of bytes to swap */ +int nbytes) /* Number of bytes to swap */ + +{ + char *sbyte, temp, *slast; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp = sbyte[0]; + sbyte[0] = sbyte[1]; + sbyte[1] = temp; + sbyte= sbyte + 2; + } + return; +} + +/*--------------------------------------------------------------------------*/ +/* IRAFSWAP4 -- Reverse bytes of Integer*4 or Real*4 vector in place */ + +static void irafswap4 ( + +char *string, /* Address of Integer*4 or Real*4 vector */ +int nbytes) /* Number of bytes to reverse */ + +{ + char *sbyte, *slast; + char temp0, temp1, temp2, temp3; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp3 = sbyte[0]; + temp2 = sbyte[1]; + temp1 = sbyte[2]; + temp0 = sbyte[3]; + sbyte[0] = temp0; + sbyte[1] = temp1; + sbyte[2] = temp2; + sbyte[3] = temp3; + sbyte = sbyte + 4; + } + + return; +} + +/*--------------------------------------------------------------------------*/ +/* IRAFSWAP8 -- Reverse bytes of Real*8 vector in place */ + +static void irafswap8 ( + +char *string, /* Address of Real*8 vector */ +int nbytes) /* Number of bytes to reverse */ + +{ + char *sbyte, *slast; + char temp[8]; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp[7] = sbyte[0]; + temp[6] = sbyte[1]; + temp[5] = sbyte[2]; + temp[4] = sbyte[3]; + temp[3] = sbyte[4]; + temp[2] = sbyte[5]; + temp[1] = sbyte[6]; + temp[0] = sbyte[7]; + sbyte[0] = temp[0]; + sbyte[1] = temp[1]; + sbyte[2] = temp[2]; + sbyte[3] = temp[3]; + sbyte[4] = temp[4]; + sbyte[5] = temp[5]; + sbyte[6] = temp[6]; + sbyte[7] = temp[7]; + sbyte = sbyte + 8; + } + return; +} + +/*--------------------------------------------------------------------------*/ +static int +machswap (void) + +{ + char *ctest; + int itest; + + itest = 1; + ctest = (char *)&itest; + if (*ctest) + return (1); + else + return (0); +} + +/*--------------------------------------------------------------------------*/ +/* the following routines were originally in hget.c */ +/*--------------------------------------------------------------------------*/ + + +static int lhead0 = 0; + +/*--------------------------------------------------------------------------*/ + +/* Extract long value for variable from FITS header string */ + +static int +hgeti4 (hstring,keyword,ival) + +char *hstring; /* character string containing FITS header information + in the format = {/ } */ +char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +int *ival; +{ +char *value; +double dval; +int minint; +char val[30]; + +/* Get value and comment from header string */ + value = hgetc (hstring,keyword); + +/* Translate value from ASCII to binary */ + if (value != NULL) { + minint = -MAXINT - 1; + strcpy (val, value); + dval = atof (val); + if (dval+0.001 > MAXINT) + *ival = MAXINT; + else if (dval >= 0) + *ival = (int) (dval + 0.001); + else if (dval-0.001 < minint) + *ival = minint; + else + *ival = (int) (dval - 0.001); + return (1); + } + else { + return (0); + } +} + +/*-------------------------------------------------------------------*/ +/* Extract string value for variable from FITS header string */ + +static int +hgets (hstring, keyword, lstr, str) + +char *hstring; /* character string containing FITS header information + in the format = {/ } */ +char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +int lstr; /* Size of str in characters */ +char *str; /* String (returned) */ +{ + char *value; + int lval; + +/* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + if (value != NULL) { + lval = strlen (value); + if (lval < lstr) + strcpy (str, value); + else if (lstr > 1) + strncpy (str, value, lstr-1); + else + str[0] = value[0]; + return (1); + } + else + return (0); +} + +/*-------------------------------------------------------------------*/ +/* Extract character value for variable from FITS header string */ + +static char * +hgetc (hstring,keyword0) + +char *hstring; /* character string containing FITS header information + in the format = {/ } */ +char *keyword0; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +{ + static char cval[80]; + char *value; + char cwhite[2]; + char squot[2], dquot[2], lbracket[2], rbracket[2], slash[2], comma[2]; + char keyword[81]; /* large for ESO hierarchical keywords */ + char line[100]; + char *vpos, *cpar = NULL; + char *q1, *q2 = NULL, *v1, *v2, *c1, *brack1, *brack2; + int ipar, i; + + squot[0] = 39; + squot[1] = 0; + dquot[0] = 34; + dquot[1] = 0; + lbracket[0] = 91; + lbracket[1] = 0; + comma[0] = 44; + comma[1] = 0; + rbracket[0] = 93; + rbracket[1] = 0; + slash[0] = 47; + slash[1] = 0; + +/* Find length of variable name */ + strncpy (keyword,keyword0, sizeof(keyword)-1); + brack1 = strsrch (keyword,lbracket); + if (brack1 == NULL) + brack1 = strsrch (keyword,comma); + if (brack1 != NULL) { + *brack1 = '\0'; + brack1++; + } + +/* Search header string for variable name */ + vpos = ksearch (hstring,keyword); + +/* Exit if not found */ + if (vpos == NULL) { + return (NULL); + } + +/* Initialize line to nulls */ + for (i = 0; i < 100; i++) + line[i] = 0; + +/* In standard FITS, data lasts until 80th character */ + +/* Extract entry for this variable from the header */ + strncpy (line,vpos,80); + +/* check for quoted value */ + q1 = strsrch (line,squot); + c1 = strsrch (line,slash); + if (q1 != NULL) { + if (c1 != NULL && q1 < c1) + q2 = strsrch (q1+1,squot); + else if (c1 == NULL) + q2 = strsrch (q1+1,squot); + else + q1 = NULL; + } + else { + q1 = strsrch (line,dquot); + if (q1 != NULL) { + if (c1 != NULL && q1 < c1) + q2 = strsrch (q1+1,dquot); + else if (c1 == NULL) + q2 = strsrch (q1+1,dquot); + else + q1 = NULL; + } + else { + q1 = NULL; + q2 = line + 10; + } + } + +/* Extract value and remove excess spaces */ + if (q1 != NULL) { + v1 = q1 + 1;; + v2 = q2; + c1 = strsrch (q2,"/"); + } + else { + v1 = strsrch (line,"=") + 1; + c1 = strsrch (line,"/"); + if (c1 != NULL) + v2 = c1; + else + v2 = line + 79; + } + +/* Ignore leading spaces */ + while (*v1 == ' ' && v1 < v2) { + v1++; + } + +/* Drop trailing spaces */ + *v2 = '\0'; + v2--; + while (*v2 == ' ' && v2 > v1) { + *v2 = '\0'; + v2--; + } + + if (!strcmp (v1, "-0")) + v1++; + strcpy (cval,v1); + value = cval; + +/* If keyword has brackets, extract appropriate token from value */ + if (brack1 != NULL) { + brack2 = strsrch (brack1,rbracket); + if (brack2 != NULL) + *brack2 = '\0'; + ipar = atoi (brack1); + if (ipar > 0) { + cwhite[0] = ' '; + cwhite[1] = '\0'; + for (i = 1; i <= ipar; i++) { + cpar = strtok (v1,cwhite); + v1 = NULL; + } + if (cpar != NULL) { + strcpy (cval,cpar); + } + else + value = NULL; + } + } + + return (value); +} + + +/*-------------------------------------------------------------------*/ +/* Find beginning of fillable blank line before FITS header keyword line */ + +static char * +blsearch (hstring,keyword) + +/* Find entry for keyword keyword in FITS header string hstring. + (the keyword may have a maximum of eight letters) + NULL is returned if the keyword is not found */ + +char *hstring; /* character string containing fits-style header + information in the format = {/ } + the default is that each entry is 80 characters long; + however, lines may be of arbitrary length terminated by + nulls, carriage returns or linefeeds, if packed is true. */ +char *keyword; /* character string containing the name of the variable + to be returned. ksearch searches for a line beginning + with this string. The string may be a character + literal or a character variable terminated by a null + or '$'. it is truncated to 8 characters. */ +{ + char *loc, *headnext, *headlast, *pval, *lc, *line; + char *bval; + int icol, nextchar, lkey, nleft, lhstr; + + pval = 0; + + /* Search header string for variable name */ + if (lhead0) + lhstr = lhead0; + else { + lhstr = 0; + while (lhstr < 57600 && hstring[lhstr] != 0) + lhstr++; + } + headlast = hstring + lhstr; + headnext = hstring; + pval = NULL; + while (headnext < headlast) { + nleft = headlast - headnext; + loc = strnsrch (headnext, keyword, nleft); + + /* Exit if keyword is not found */ + if (loc == NULL) { + break; + } + + icol = (loc - hstring) % 80; + lkey = strlen (keyword); + nextchar = (int) *(loc + lkey); + + /* If this is not in the first 8 characters of a line, keep searching */ + if (icol > 7) + headnext = loc + 1; + + /* If parameter name in header is longer, keep searching */ + else if (nextchar != 61 && nextchar > 32 && nextchar < 127) + headnext = loc + 1; + + /* If preceeding characters in line are not blanks, keep searching */ + else { + line = loc - icol; + for (lc = line; lc < loc; lc++) { + if (*lc != ' ') + headnext = loc + 1; + } + + /* Return pointer to start of line if match */ + if (loc >= headnext) { + pval = line; + break; + } + } + } + + /* Return NULL if keyword is found at start of FITS header string */ + if (pval == NULL) + return (pval); + + /* Return NULL if found the first keyword in the header */ + if (pval == hstring) + return (NULL); + + /* Find last nonblank line before requested keyword */ + bval = pval - 80; + while (!strncmp (bval," ",8)) + bval = bval - 80; + bval = bval + 80; + + /* Return pointer to calling program if blank lines found */ + if (bval < pval) + return (bval); + else + return (NULL); +} + + +/*-------------------------------------------------------------------*/ +/* Find FITS header line containing specified keyword */ + +static char *ksearch (hstring,keyword) + +/* Find entry for keyword keyword in FITS header string hstring. + (the keyword may have a maximum of eight letters) + NULL is returned if the keyword is not found */ + +char *hstring; /* character string containing fits-style header + information in the format = {/ } + the default is that each entry is 80 characters long; + however, lines may be of arbitrary length terminated by + nulls, carriage returns or linefeeds, if packed is true. */ +char *keyword; /* character string containing the name of the variable + to be returned. ksearch searches for a line beginning + with this string. The string may be a character + literal or a character variable terminated by a null + or '$'. it is truncated to 8 characters. */ +{ + char *loc, *headnext, *headlast, *pval, *lc, *line; + int icol, nextchar, lkey, nleft, lhstr; + + pval = 0; + +/* Search header string for variable name */ + if (lhead0) + lhstr = lhead0; + else { + lhstr = 0; + while (lhstr < 57600 && hstring[lhstr] != 0) + lhstr++; + } + headlast = hstring + lhstr; + headnext = hstring; + pval = NULL; + while (headnext < headlast) { + nleft = headlast - headnext; + loc = strnsrch (headnext, keyword, nleft); + + /* Exit if keyword is not found */ + if (loc == NULL) { + break; + } + + icol = (loc - hstring) % 80; + lkey = strlen (keyword); + nextchar = (int) *(loc + lkey); + + /* If this is not in the first 8 characters of a line, keep searching */ + if (icol > 7) + headnext = loc + 1; + + /* If parameter name in header is longer, keep searching */ + else if (nextchar != 61 && nextchar > 32 && nextchar < 127) + headnext = loc + 1; + + /* If preceeding characters in line are not blanks, keep searching */ + else { + line = loc - icol; + for (lc = line; lc < loc; lc++) { + if (*lc != ' ') + headnext = loc + 1; + } + + /* Return pointer to start of line if match */ + if (loc >= headnext) { + pval = line; + break; + } + } + } + +/* Return pointer to calling program */ + return (pval); + +} + +/*-------------------------------------------------------------------*/ +/* Find string s2 within null-terminated string s1 */ + +static char * +strsrch (s1, s2) + +char *s1; /* String to search */ +char *s2; /* String to look for */ + +{ + int ls1; + ls1 = strlen (s1); + return (strnsrch (s1, s2, ls1)); +} + +/*-------------------------------------------------------------------*/ +/* Find string s2 within string s1 */ + +static char * +strnsrch (s1, s2, ls1) + +char *s1; /* String to search */ +char *s2; /* String to look for */ +int ls1; /* Length of string being searched */ + +{ + char *s,*s1e; + char cfirst,clast; + int i,ls2; + + /* Return null string if either pointer is NULL */ + if (s1 == NULL || s2 == NULL) + return (NULL); + + /* A zero-length pattern is found in any string */ + ls2 = strlen (s2); + if (ls2 ==0) + return (s1); + + /* Only a zero-length string can be found in a zero-length string */ + if (ls1 ==0) + return (NULL); + + cfirst = s2[0]; + clast = s2[ls2-1]; + s1e = s1 + ls1 - ls2 + 1; + s = s1; + while (s < s1e) { + + /* Search for first character in pattern string */ + if (*s == cfirst) { + + /* If single character search, return */ + if (ls2 == 1) + return (s); + + /* Search for last character in pattern string if first found */ + if (s[ls2-1] == clast) { + + /* If two-character search, return */ + if (ls2 == 2) + return (s); + + /* If 3 or more characters, check for rest of search string */ + i = 1; + while (i < ls2 && s[i] == s2[i]) + i++; + + /* If entire string matches, return */ + if (i >= ls2) + return (s); + } + } + s++; + } + return (NULL); +} + +/*-------------------------------------------------------------------*/ +/* the following routines were originally in hget.c */ +/*-------------------------------------------------------------------*/ +/* HPUTI4 - Set int keyword = ival in FITS header string */ + +static void +hputi4 (hstring,keyword,ival) + + char *hstring; /* character string containing FITS-style header + information in the format + = {/ } + each entry is padded with spaces to 80 characters */ + + char *keyword; /* character string containing the name of the variable + to be returned. hput searches for a line beginning + with this string, and if there isn't one, creates one. + The first 8 characters of keyword must be unique. */ + int ival; /* int number */ +{ + char value[30]; + + /* Translate value from binary to ASCII */ + sprintf (value,"%d",ival); + + /* Put value into header string */ + hputc (hstring,keyword,value); + + /* Return to calling program */ + return; +} + +/*-------------------------------------------------------------------*/ + +/* HPUTL - Set keyword = F if lval=0, else T, in FITS header string */ + +static void +hputl (hstring, keyword,lval) + +char *hstring; /* FITS header */ +char *keyword; /* Keyword name */ +int lval; /* logical variable (0=false, else true) */ +{ + char value[8]; + + /* Translate value from binary to ASCII */ + if (lval) + strcpy (value, "T"); + else + strcpy (value, "F"); + + /* Put value into header string */ + hputc (hstring,keyword,value); + + /* Return to calling program */ + return; +} + +/*-------------------------------------------------------------------*/ + +/* HPUTS - Set character string keyword = 'cval' in FITS header string */ + +static void +hputs (hstring,keyword,cval) + +char *hstring; /* FITS header */ +char *keyword; /* Keyword name */ +char *cval; /* character string containing the value for variable + keyword. trailing and leading blanks are removed. */ +{ + char squot = 39; + char value[70]; + int lcval; + + /* find length of variable string */ + + lcval = strlen (cval); + if (lcval > 67) + lcval = 67; + + /* Put quotes around string */ + value[0] = squot; + strncpy (&value[1],cval,lcval); + value[lcval+1] = squot; + value[lcval+2] = 0; + + /* Put value into header string */ + hputc (hstring,keyword,value); + + /* Return to calling program */ + return; +} + +/*---------------------------------------------------------------------*/ +/* HPUTC - Set character string keyword = value in FITS header string */ + +static void +hputc (hstring,keyword,value) + +char *hstring; +char *keyword; +char *value; /* character string containing the value for variable + keyword. trailing and leading blanks are removed. */ +{ + char squot = 39; + char line[100]; + char newcom[50]; + char blank[80]; + char *v, *vp, *v1, *v2, *q1, *q2, *c1, *ve; + int lkeyword, lcom, lval, lc, i; + + for (i = 0; i < 80; i++) + blank[i] = ' '; + + /* find length of keyword and value */ + lkeyword = strlen (keyword); + lval = strlen (value); + + /* If COMMENT or HISTORY, always add it just before the END */ + if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 || + strncmp (keyword,"HISTORY",7) == 0)) { + + /* Find end of header */ + v1 = ksearch (hstring,"END"); + v2 = v1 + 80; + + /* Move END down one line */ + strncpy (v2, v1, 80); + + /* Insert keyword */ + strncpy (v1,keyword,7); + + /* Pad with spaces */ + for (vp = v1+lkeyword; vp < v2; vp++) + *vp = ' '; + + /* Insert comment */ + strncpy (v1+9,value,lval); + return; + } + + /* Otherwise search for keyword */ + else + v1 = ksearch (hstring,keyword); + + /* If parameter is not found, find a place to put it */ + if (v1 == NULL) { + + /* First look for blank lines before END */ + v1 = blsearch (hstring, "END"); + + /* Otherwise, create a space for it at the end of the header */ + if (v1 == NULL) { + ve = ksearch (hstring,"END"); + v1 = ve; + v2 = v1 + 80; + strncpy (v2, ve, 80); + } + else + v2 = v1 + 80; + lcom = 0; + newcom[0] = 0; + } + + /* Otherwise, extract the entry for this keyword from the header */ + else { + strncpy (line, v1, 80); + line[80] = 0; + v2 = v1 + 80; + + /* check for quoted value */ + q1 = strchr (line, squot); + if (q1 != NULL) + q2 = strchr (q1+1,squot); + else + q2 = line; + + /* extract comment and remove trailing spaces */ + + c1 = strchr (q2,'/'); + if (c1 != NULL) { + lcom = 80 - (c1 - line); + strncpy (newcom, c1+1, lcom); + vp = newcom + lcom - 1; + while (vp-- > newcom && *vp == ' ') + *vp = 0; + lcom = strlen (newcom); + } + else { + newcom[0] = 0; + lcom = 0; + } + } + + /* Fill new entry with spaces */ + for (vp = v1; vp < v2; vp++) + *vp = ' '; + + /* Copy keyword to new entry */ + strncpy (v1, keyword, lkeyword); + + /* Add parameter value in the appropriate place */ + vp = v1 + 8; + *vp = '='; + vp = v1 + 9; + *vp = ' '; + vp = vp + 1; + if (*value == squot) { + strncpy (vp, value, lval); + if (lval+12 > 31) + lc = lval + 12; + else + lc = 30; + } + else { + vp = v1 + 30 - lval; + strncpy (vp, value, lval); + lc = 30; + } + + /* Add comment in the appropriate place */ + if (lcom > 0) { + if (lc+2+lcom > 80) + lcom = 78 - lc; + vp = v1 + lc + 2; /* Jul 16 1997: was vp = v1 + lc * 2 */ + *vp = '/'; + vp = vp + 1; + strncpy (vp, newcom, lcom); + for (v = vp + lcom; v < v2; v++) + *v = ' '; + } + + return; +} + +/*-------------------------------------------------------------------*/ +/* HPUTCOM - Set comment for keyword or on line in FITS header string */ + +static void +hputcom (hstring,keyword,comment) + + char *hstring; + char *keyword; + char *comment; +{ + char squot; + char line[100]; + int lkeyword, lcom; + char *vp, *v1, *v2, *c0 = NULL, *c1, *q1, *q2; + + squot = 39; + +/* Find length of variable name */ + lkeyword = strlen (keyword); + +/* If COMMENT or HISTORY, always add it just before the END */ + if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 || + strncmp (keyword,"HISTORY",7) == 0)) { + + /* Find end of header */ + v1 = ksearch (hstring,"END"); + v2 = v1 + 80; + strncpy (v2, v1, 80); + + /* blank out new line and insert keyword */ + for (vp = v1; vp < v2; vp++) + *vp = ' '; + strncpy (v1, keyword, lkeyword); + } + +/* search header string for variable name */ + else { + v1 = ksearch (hstring,keyword); + v2 = v1 + 80; + + /* if parameter is not found, return without doing anything */ + if (v1 == NULL) { + return; + } + + /* otherwise, extract entry for this variable from the header */ + strncpy (line, v1, 80); + + /* check for quoted value */ + q1 = strchr (line,squot); + if (q1 != NULL) + q2 = strchr (q1+1,squot); + else + q2 = NULL; + + if (q2 == NULL || q2-line < 31) + c0 = v1 + 31; + else + c0 = v1 + (q2-line) + 2; /* allan: 1997-09-30, was c0=q2+2 */ + + strncpy (c0, "/ ",2); + } + +/* create new entry */ + lcom = strlen (comment); + + if (lcom > 0) { + c1 = c0 + 2; + if (c1+lcom > v2) + lcom = v2 - c1; + strncpy (c1, comment, lcom); + } + +} diff --git a/pkg/tbtables/cfitsio/iter_a.c b/pkg/tbtables/cfitsio/iter_a.c new file mode 100644 index 00000000..19ea1d1c --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_a.c @@ -0,0 +1,147 @@ +#include +#include +#include +#include "fitsio.h" + +/* + This program illustrates how to use the CFITSIO iterator function. + It reads and modifies the input 'iter_a.fit' file by computing a + value for the 'rate' column as a function of the values in the other + 'counts' and 'time' columns. +*/ +main() +{ + extern flux_rate(); /* external work function is passed to the iterator */ + fitsfile *fptr; + iteratorCol cols[3]; /* structure used by the iterator function */ + int n_cols; + long rows_per_loop, offset; + + int status, nkeys, keypos, hdutype, ii, jj; + char filename[] = "iter_a.fit"; /* name of rate FITS file */ + + status = 0; + + fits_open_file(&fptr, filename, READWRITE, &status); /* open file */ + + /* move to the desired binary table extension */ + if (fits_movnam_hdu(fptr, BINARY_TBL, "RATE", 0, &status) ) + fits_report_error(stderr, status); /* print out error messages */ + + n_cols = 3; /* number of columns */ + + /* define input column structure members for the iterator function */ + fits_iter_set_by_name(&cols[0], fptr, "COUNTS", TLONG, InputCol); + fits_iter_set_by_name(&cols[1], fptr, "TIME", TFLOAT, InputCol); + fits_iter_set_by_name(&cols[2], fptr, "RATE", TFLOAT, OutputCol); + + rows_per_loop = 0; /* use default optimum number of rows */ + offset = 0; /* process all the rows */ + + /* apply the rate function to each row of the table */ + printf("Calling iterator function...%d\n", status); + + fits_iterate_data(n_cols, cols, offset, rows_per_loop, + flux_rate, 0L, &status); + + fits_close_file(fptr, &status); /* all done */ + + if (status) + fits_report_error(stderr, status); /* print out error messages */ + + return(status); +} +/*--------------------------------------------------------------------------*/ +int flux_rate(long totalrows, long offset, long firstrow, long nrows, + int ncols, iteratorCol *cols, void *user_strct ) + +/* + Sample iterator function that calculates the output flux 'rate' column + by dividing the input 'counts' by the 'time' column. + It also applies a constant deadtime correction factor if the 'deadtime' + keyword exists. Finally, this creates or updates the 'LIVETIME' + keyword with the sum of all the individual integration times. +*/ +{ + int ii, status = 0; + + /* declare variables static to preserve their values between calls */ + static long *counts; + static float *interval; + static float *rate; + static float deadtime, livetime; /* must preserve values between calls */ + + /*--------------------------------------------------------*/ + /* Initialization procedures: execute on the first call */ + /*--------------------------------------------------------*/ + if (firstrow == 1) + { + if (ncols != 3) + return(-1); /* number of columns incorrect */ + + if (fits_iter_get_datatype(&cols[0]) != TLONG || + fits_iter_get_datatype(&cols[1]) != TFLOAT || + fits_iter_get_datatype(&cols[2]) != TFLOAT ) + return(-2); /* bad data type */ + + /* assign the input pointers to the appropriate arrays and null ptrs*/ + counts = (long *) fits_iter_get_array(&cols[0]); + interval = (float *) fits_iter_get_array(&cols[1]); + rate = (float *) fits_iter_get_array(&cols[2]); + + livetime = 0; /* initialize the total integration time */ + + /* try to get the deadtime keyword value */ + fits_read_key(cols[0].fptr, TFLOAT, "DEADTIME", &deadtime, '\0', + &status); + if (status) + { + deadtime = 1.0; /* default deadtime if keyword doesn't exist */ + } + else if (deadtime < 0. || deadtime > 1.0) + { + return(-1); /* bad deadtime value */ + } + + printf("deadtime = %f\n", deadtime); + } + + /*--------------------------------------------*/ + /* Main loop: process all the rows of data */ + /*--------------------------------------------*/ + + /* NOTE: 1st element of array is the null pixel value! */ + /* Loop from 1 to nrows, not 0 to nrows - 1. */ + + /* this version tests for null values */ + rate[0] = DOUBLENULLVALUE; /* define the value that represents null */ + + for (ii = 1; ii <= nrows; ii++) + { + if (counts[ii] == counts[0]) /* undefined counts value? */ + { + rate[ii] = DOUBLENULLVALUE; + } + else if (interval[ii] > 0.) + { + rate[ii] = counts[ii] / interval[ii] / deadtime; + livetime += interval[ii]; /* accumulate total integration time */ + } + else + return(-2); /* bad integration time */ + } + + /*-------------------------------------------------------*/ + /* Clean up procedures: after processing all the rows */ + /*-------------------------------------------------------*/ + + if (firstrow + nrows - 1 == totalrows) + { + /* update the LIVETIME keyword value */ + + fits_update_key(cols[0].fptr, TFLOAT, "LIVETIME", &livetime, + "total integration time", &status); + printf("livetime = %f\n", livetime); + } + return(0); /* return successful status */ +} diff --git a/pkg/tbtables/cfitsio/iter_a.f b/pkg/tbtables/cfitsio/iter_a.f new file mode 100644 index 00000000..e6221897 --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_a.f @@ -0,0 +1,224 @@ + program f77iterate_a + + external flux_rate + integer ncols + parameter (ncols=3) + integer units(ncols), colnum(ncols), datatype(ncols) + integer iotype(ncols), offset, rows_per_loop, status + character*70 colname(ncols) + integer iunit, blocksize + character*80 fname + +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + + + iunit = 15 + + units(1) = iunit + units(2) = iunit + units(3) = iunit + +C open the file + fname = 'iter_a.fit' + call ftopen(iunit,fname,1,blocksize,status) + +C move to the HDU containing the rate table + call ftmnhd(iunit, BINARY_TBL, 'RATE', 0, status) + +C Select iotypes for column data + iotype(1) = InputCol + iotype(2) = InputCol + iotype(3) = OutputCol + +C Select desired datatypes for column data + datatype(1) = TINT + datatype(2) = TFLOAT + datatype(3) = TFLOAT + +C find the column number corresponding to each column + call ftgcno( iunit, 0, 'counts', colnum(1), status ) + call ftgcno( iunit, 0, 'time', colnum(2), status ) + call ftgcno( iunit, 0, 'rate', colnum(3), status ) + +C use default optimum number of rows + rows_per_loop = 0 + offset = 0 + +C apply the rate function to each row of the table + print *, 'Calling iterator function...', status + +C although colname is not being used, still need to send a string +C array in the function + call ftiter( ncols, units, colnum, colname, datatype, iotype, + & offset, rows_per_loop, flux_rate, 3, status ) + + call ftclos(iunit, status) + stop + end + +C*************************************************************************** +C Sample iterator function that calculates the output flux 'rate' column +C by dividing the input 'counts' by the 'time' column. +C It also applies a constant deadtime correction factor if the 'deadtime' +C keyword exists. Finally, this creates or updates the 'LIVETIME' +C keyword with the sum of all the individual integration times. +C*************************************************************************** + subroutine flux_rate(totalrows, offset, firstrow, nrows, ncols, + & units, colnum, datatype, iotype, repeat, status, userData, + & counts, interval, rate ) + + integer totalrows, offset, firstrow, nrows, ncols + integer units(ncols), colnum(ncols), datatype(ncols) + integer iotype(ncols), repeat(ncols) + integer userData + +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + + integer counts(*) + real interval(*),rate(*) + + integer ii, status + character*80 comment + +C********************************************************************** +C must preserve these values between calls + real deadtime, livetime + common /fluxblock/ deadtime, livetime +C********************************************************************** + + if (status .ne. 0) return + +C -------------------------------------------------------- +C Initialization procedures: execute on the first call +C -------------------------------------------------------- + if (firstrow .eq. 1) then + if (ncols .ne. 3) then +C wrong number of columns + status = -1 + return + endif + + if (datatype(1).ne.TINT .or. datatype(2).ne.TFLOAT .or. + & datatype(3).ne.TFLOAT ) then +C bad data type + status = -2 + return + endif + +C try to get the deadtime keyword value + call ftgkye( units(1), 'DEADTIME', deadtime, comment, status ) + + if (status.ne.0) then +C default deadtime if keyword doesn't exist + deadtime = 1.0 + status = 0 + elseif (deadtime .lt. 0.0 .or. deadtime .gt. 1.0) then +C bad deadtime value + status = -3 + return + endif + + print *, 'deadtime = ', deadtime + + livetime = 0.0 + endif + +C -------------------------------------------- +C Main loop: process all the rows of data +C -------------------------------------------- + +C NOTE: 1st element of array is the null pixel value! +C Loop over elements 2 to nrows+1, not 1 to nrows. + +C this version ignores null values + +C set the output null value to zero to ignore nulls */ + rate(1) = 0.0 + do 10 ii = 2,nrows+1 + if ( interval(ii) .gt. 0.0) then + rate(ii) = counts(ii) / interval(ii) / deadtime + livetime = livetime + interval(ii) + else +C Nonsensical negative time interval + status = -3 + return + endif + 10 continue + +C ------------------------------------------------------- +C Clean up procedures: after processing all the rows +C ------------------------------------------------------- + + if (firstrow + nrows - 1 .eq. totalrows) then +C update the LIVETIME keyword value + + call ftukye( units(1),'LIVETIME', livetime, 3, + & 'total integration time', status ) + print *,'livetime = ', livetime + + endif + + return + end diff --git a/pkg/tbtables/cfitsio/iter_a.fit b/pkg/tbtables/cfitsio/iter_a.fit new file mode 100644 index 00000000..543646e3 --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_a.fit @@ -0,0 +1,1111 @@ +SIMPLE = T / file does conform to FITS standard BITPIX = 16 / number of bits per data pixel NAXIS = 0 / number of data axes EXTEND = T / FITS dataset may contain extensions COMMENT FITS (Flexible Image Transport System) format defined in Astronomy andCOMMENT Astrophysics Supplement Series v44/p363, v44/p371, v73/p359, v73/p365.COMMENT Contact the NASA Science Office of Standards and Technology for the COMMENT FITS Definition document #100 and other FITS information. HISTORY TASK:FMERGE on file ratefile.fits HISTORY fmerge3.1c at 29/12/97 16:1:37. HISTORY TASK:FMERGE on file m1.fits HISTORY fmerge3.1c at 29/12/97 16:2:30. HISTORY TASK:FMERGE on file m3.fits HISTORY fmerge3.1c at 29/12/97 16:3:38. HISTORY TASK:FMERGE on file m5.fits HISTORY fmerge3.1c at 29/12/97 16:4:15. HISTORY TASK:FMERGE on file m7.fits HISTORY fmerge3.1c at 29/12/97 16:5:1.0 HISTORY TASK:FMERGE on file m9.fits HISTORY fmerge3.1c at 29/12/97 16:6:48. END XTENSION= 'BINTABLE' / binary table extension BITPIX = 8 / 8-bit bytes NAXIS = 2 / 2-dimensional binary table NAXIS1 = 12 / width of table in bytes NAXIS2 = 10000 / number of rows in table PCOUNT = 0 / size of special data area GCOUNT = 1 / one data group (required keyword) TFIELDS = 3 / number of fields in each row TTYPE1 = 'Counts ' / label for field 1 TFORM1 = 'J ' / data format of field: 4-byte INTEGER TTYPE2 = 'Time ' / label for field 2 TFORM2 = 'E ' / data format of field: 4-byte REAL TTYPE3 = 'Rate ' / label for field 3 TFORM3 = 'E ' / data format of field: 4-byte REAL EXTNAME = 'rate ' / name of this binary table extension DEADTIME= 1.0 HISTORY This FITS file was created by the FCREATE task. HISTORY fcreate3.1 at 29/12/97 HISTORY File modified by user 'pence' with fv on 97-12-29T15:45:06 HISTORY File modified by user 'pence' with fv on 97-12-29T15:54:30 LIVETIME= 3.055450E+04 / total integration time HISTORY TASK:FMERGE copied 26924 rows from file ratefile.fits HISTORY TASK:FMERGE appended 26924 rows from file r2.fits HISTORY TASK:FMERGE copied 53848 rows from file m1.fits HISTORY TASK:FMERGE appended 53848 rows from file m2.fits HISTORY TASK:FMERGE copied 107696 rows from file m3.fits HISTORY TASK:FMERGE appended 107696 rows from file m4.fits HISTORY TASK:FMERGE copied 215392 rows from file m5.fits HISTORY TASK:FMERGE appended 215392 rows from file m6.fits HISTORY TASK:FMERGE copied 430784 rows from file m7.fits HISTORY TASK:FMERGE appended 430784 rows from file m8.fits HISTORY TASK:FMERGE copied 861568 rows from file m9.fits HISTORY TASK:FMERGE appended 861568 rows from file m10.fits HISTORY File modified by user 'pence' with fv on 97-12-30T10:44:37 HISTORY File modified by user 'pence' with fv on 97-12-30T10:51:44 HISTORY ftabcopy V4.0a copied columns from ratefile.fits HISTORY ftabcopy V4.0a at 5/1/98 23:10:24 END +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@ ?€@ÀdA A ?€@ ?€@@@AUU-@ð@À +?€A @@°?€@  \ No newline at end of file diff --git a/pkg/tbtables/cfitsio/iter_b.c b/pkg/tbtables/cfitsio/iter_b.c new file mode 100644 index 00000000..296f4e16 --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_b.c @@ -0,0 +1,114 @@ +#include +#include +#include +#include "fitsio.h" + +/* + This program illustrates how to use the CFITSIO iterator function. + It simply prints out the values in a character string and a logical + type column in a table, and toggles the value in the logical column + so that T -> F and F -> T. +*/ +main() +{ + extern str_iter(); /* external work function is passed to the iterator */ + fitsfile *fptr; + iteratorCol cols[2]; + int n_cols; + long rows_per_loop, offset; + int status = 0; + char filename[] = "iter_b.fit"; /* name of rate FITS file */ + + /* open the file and move to the correct extension */ + fits_open_file(&fptr, filename, READWRITE, &status); + fits_movnam_hdu(fptr, BINARY_TBL, "iter_test", 0, &status); + + /* define input column structure members for the iterator function */ + n_cols = 2; /* number of columns */ + + /* define input column structure members for the iterator function */ + fits_iter_set_by_name(&cols[0], fptr, "Avalue", TSTRING, InputOutputCol); + fits_iter_set_by_name(&cols[1], fptr, "Lvalue", TLOGICAL, InputOutputCol); + + rows_per_loop = 0; /* use default optimum number of rows */ + offset = 0; /* process all the rows */ + + /* apply the function to each row of the table */ + printf("Calling iterator function...%d\n", status); + + fits_iterate_data(n_cols, cols, offset, rows_per_loop, + str_iter, 0L, &status); + + fits_close_file(fptr, &status); /* all done */ + + if (status) + fits_report_error(stderr, status); /* print out error messages */ + + return(status); +} +/*--------------------------------------------------------------------------*/ +int str_iter(long totalrows, long offset, long firstrow, long nrows, + int ncols, iteratorCol *cols, void *user_strct ) + +/* + Sample iterator function. +*/ +{ + int ii; + + /* declare variables static to preserve their values between calls */ + static char **stringvals; + static char *logicalvals; + + /*--------------------------------------------------------*/ + /* Initialization procedures: execute on the first call */ + /*--------------------------------------------------------*/ + if (firstrow == 1) + { + if (ncols != 2) + return(-1); /* number of columns incorrect */ + + if (fits_iter_get_datatype(&cols[0]) != TSTRING || + fits_iter_get_datatype(&cols[1]) != TLOGICAL ) + return(-2); /* bad data type */ + + /* assign the input pointers to the appropriate arrays */ + stringvals = (char **) fits_iter_get_array(&cols[0]); + logicalvals = (char *) fits_iter_get_array(&cols[1]); + + printf("Total rows, No. rows = %d %d\n",totalrows, nrows); + } + + /*------------------------------------------*/ + /* Main loop: process all the rows of data */ + /*------------------------------------------*/ + + /* NOTE: 1st element of array is the null pixel value! */ + /* Loop from 1 to nrows, not 0 to nrows - 1. */ + + for (ii = 1; ii <= nrows; ii++) + { + printf("%s %d\n", stringvals[ii], logicalvals[ii]); + if (logicalvals[ii]) + { + logicalvals[ii] = FALSE; + strcpy(stringvals[ii], "changed to false"); + } + else + { + logicalvals[ii] = TRUE; + strcpy(stringvals[ii], "changed to true"); + } + } + + /*-------------------------------------------------------*/ + /* Clean up procedures: after processing all the rows */ + /*-------------------------------------------------------*/ + + if (firstrow + nrows - 1 == totalrows) + { + /* no action required in this case */ + } + + return(0); +} diff --git a/pkg/tbtables/cfitsio/iter_b.f b/pkg/tbtables/cfitsio/iter_b.f new file mode 100644 index 00000000..7a2a6e7d --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_b.f @@ -0,0 +1,193 @@ + program f77iterate_b + +C external work function is passed to the iterator + external str_iter + + integer ncols + parameter (ncols=2) + integer units(ncols), colnum(ncols), datatype(ncols) + integer iotype(ncols), offset, rows_per_loop, status + character*70 colname(ncols) + + integer iunit, blocksize + character*80 fname + +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + + status = 0 + + fname = 'iter_b.fit' + iunit = 15 + +C both columns are in the same FITS file + units(1) = iunit + units(2) = iunit + +C open the file and move to the correct extension + call ftopen(iunit,fname,1,blocksize,status) + call ftmnhd(iunit, BINARY_TBL, 'iter_test', 0, status) + +C define the desired columns by name + colname(1) = 'Avalue' + colname(2) = 'Lvalue' + +C leave column numbers undefined + colnum(1) = 0 + colnum(2) = 0 + +C define the desired datatype for each column: TSTRING & TLOGICAL + datatype(1) = TSTRING + datatype(2) = TLOGICAL + +C define whether columns are input, input/output, or output only +C Both in/out + iotype(1) = InputOutputCol + iotype(2) = InputOutputCol + +C use default optimum number of rows and process all the rows + rows_per_loop = 0 + offset = 0 + +C apply the function to each row of the table + print *,'Calling iterator function...', status + + call ftiter( ncols, units, colnum, colname, datatype, iotype, + & offset, rows_per_loop, str_iter, 0, status ) + + call ftclos(iunit, status) + +C print out error messages if problem + if (status.ne.0) call ftrprt('STDERR', status) + stop + end + +C-------------------------------------------------------------------------- +C +C Sample iterator function. +C +C-------------------------------------------------------------------------- + subroutine str_iter(totalrows, offset, firstrow, nrows, ncols, + & units, colnum, datatype, iotype, repeat, status, + & userData, stringCol, logicalCol ) + + integer totalrows,offset,firstrow,nrows,ncols,status + integer units(*),colnum(*),datatype(*),iotype(*),repeat(*) + integer userData + character*(*) stringCol(*) + logical logicalCol(*) + + integer ii + +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + + if (status .ne. 0) return + +C -------------------------------------------------------- +C Initialization procedures: execute on the first call +C -------------------------------------------------------- + if (firstrow .eq. 1) then + if (ncols .ne. 2) then + status = -1 + return + endif + + if (datatype(1).ne.TSTRING .or. datatype(2).ne.TLOGICAL) then + status = -2 + return + endif + + print *,'Total rows, No. rows = ',totalrows, nrows + + endif + +C ------------------------------------------- +C Main loop: process all the rows of data +C ------------------------------------------- + +C NOTE: 1st element of array is the null pixel value! +C Loop over elements 2 to nrows+1, not 1 to nrows. + + do 10 ii=2,nrows+1 + print *, stringCol(ii), logicalCol(ii) + if( logicalCol(ii) ) then + logicalCol(ii) = .false. + stringCol(ii) = 'changed to false' + else + logicalCol(ii) = .true. + stringCol(ii) = 'changed to true' + endif + 10 continue + +C ------------------------------------------------------- +C Clean up procedures: after processing all the rows +C ------------------------------------------------------- + + if (firstrow + nrows - 1 .eq. totalrows) then +C no action required in this case + endif + + return + end + diff --git a/pkg/tbtables/cfitsio/iter_b.fit b/pkg/tbtables/cfitsio/iter_b.fit new file mode 100644 index 00000000..9b4a086c Binary files /dev/null and b/pkg/tbtables/cfitsio/iter_b.fit differ diff --git a/pkg/tbtables/cfitsio/iter_c.c b/pkg/tbtables/cfitsio/iter_c.c new file mode 100644 index 00000000..bbf97742 --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_c.c @@ -0,0 +1,171 @@ +#include +#include +#include +#include "fitsio.h" + +/* + This example program illustrates how to use the CFITSIO iterator function. + + This program creates a 2D histogram of the X and Y columns of an event + list. The 'main' routine just creates the empty new image, then executes + the 'writehisto' work function by calling the CFITSIO iterator function. + + 'writehisto' opens the FITS event list that contains the X and Y columns. + It then calls a second work function, calchisto, (by recursively calling + the CFITSIO iterator function) which actually computes the 2D histogram. +*/ + +/* Globally defined parameters */ + +long xsize = 480; /* size of the histogram image */ +long ysize = 480; +long xbinsize = 32; +long ybinsize = 32; + +main() +{ + extern writehisto(); /* external work function passed to the iterator */ + extern long xsize, ysize; /* size of image */ + + fitsfile *fptr; + iteratorCol cols[1]; + int n_cols, status = 0; + long n_per_loop, offset, naxes[2]; + char filename[] = "histoimg.fit"; /* name of FITS image */ + + remove(filename); /* delete previous version of the file if it exists */ + fits_create_file(&fptr, filename, &status); /* create new output image */ + + naxes[0] = xsize; + naxes[1] = ysize; + fits_create_img(fptr, LONG_IMG, 2, naxes, &status); /* create primary HDU */ + + n_cols = 1; /* number of columns */ + + /* define input column structure members for the iterator function */ + fits_iter_set_by_name(&cols[0], fptr, " ", TLONG, OutputCol); + + n_per_loop = -1; /* force whole array to be passed at one time */ + offset = 0; /* don't skip over any pixels */ + + /* execute the function to create and write the 2D histogram */ + printf("Calling writehisto iterator work function... %d\n", status); + + fits_iterate_data(n_cols, cols, offset, n_per_loop, + writehisto, 0L, &status); + + fits_close_file(fptr, &status); /* all done; close the file */ + + if (status) + fits_report_error(stderr, status); /* print out error messages */ + else + printf("Program completed successfully.\n"); + + return(status); +} +/*--------------------------------------------------------------------------*/ +int writehisto(long totaln, long offset, long firstn, long nvalues, + int narrays, iteratorCol *histo, void *userPointer) +/* + Iterator work function that writes out the 2D histogram. + The histogram values are calculated by another work function, calchisto. + + This routine is executed only once since nvalues was forced to = totaln. +*/ +{ + extern calchisto(); /* external function called by the iterator */ + long *histogram; + fitsfile *tblptr; + iteratorCol cols[2]; + int n_cols, status = 0; + long rows_per_loop, rowoffset; + char filename[] = "iter_c.fit"; /* name of FITS table */ + + /* do sanity checking of input values */ + if (totaln != nvalues) + return(-1); /* whole image must be passed at one time */ + + if (narrays != 1) + return(-2); /* number of images is incorrect */ + + if (fits_iter_get_datatype(&histo[0]) != TLONG) + return(-3); /* input array has wrong data type */ + + /* assign the FITS array pointer to the global histogram pointer */ + histogram = (long *) fits_iter_get_array(&histo[0]); + + /* open the file and move to the table containing the X and Y columns */ + fits_open_file(&tblptr, filename, READONLY, &status); + fits_movnam_hdu(tblptr, BINARY_TBL, "EVENTS", 0, &status); + if (status) + return(status); + + n_cols = 2; /* number of columns */ + + /* define input column structure members for the iterator function */ + fits_iter_set_by_name(&cols[0], tblptr, "X", TLONG, InputCol); + fits_iter_set_by_name(&cols[1], tblptr, "Y", TLONG, InputCol); + + rows_per_loop = 0; /* take default number of rows per interation */ + rowoffset = 0; + + /* calculate the histogram */ + printf("Calling calchisto iterator work function... %d\n", status); + + fits_iterate_data(n_cols, cols, rowoffset, rows_per_loop, + calchisto, histogram, &status); + + fits_close_file(tblptr, &status); /* all done */ + return(status); +} +/*--------------------------------------------------------------------------*/ +int calchisto(long totalrows, long offset, long firstrow, long nrows, + int ncols, iteratorCol *cols, void *userPointer) + +/* + Interator work function that calculates values for the 2D histogram. +*/ +{ + extern long xsize, ysize, xbinsize, ybinsize; + long ii, ihisto, xbin, ybin; + static long *xcol, *ycol, *histogram; /* static to preserve values */ + + /*--------------------------------------------------------*/ + /* Initialization procedures: execute on the first call */ + /*--------------------------------------------------------*/ + if (firstrow == 1) + { + /* do sanity checking of input values */ + if (ncols != 2) + return(-3); /* number of arrays is incorrect */ + + if (fits_iter_get_datatype(&cols[0]) != TLONG || + fits_iter_get_datatype(&cols[1]) != TLONG) + return(-4); /* wrong datatypes */ + + /* assign the input array points to the X and Y arrays */ + xcol = (long *) fits_iter_get_array(&cols[0]); + ycol = (long *) fits_iter_get_array(&cols[1]); + histogram = (long *) userPointer; + + /* initialize the histogram image pixels = 0 */ + for (ii = 0; ii <= xsize * ysize; ii++) + histogram[ii] = 0L; + } + + /*------------------------------------------------------------------*/ + /* Main loop: increment the 2D histogram at position of each event */ + /*------------------------------------------------------------------*/ + + for (ii = 1; ii <= nrows; ii++) + { + xbin = xcol[ii] / xbinsize; + ybin = ycol[ii] / ybinsize; + + ihisto = ( ybin * xsize ) + xbin + 1; + histogram[ihisto]++; + } + + return(0); +} + diff --git a/pkg/tbtables/cfitsio/iter_c.f b/pkg/tbtables/cfitsio/iter_c.f new file mode 100644 index 00000000..f9abeaa8 --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_c.f @@ -0,0 +1,347 @@ + program f77iterate_c +C +C This example program illustrates how to use the CFITSIO iterator function. +C +C This program creates a 2D histogram of the X and Y columns of an event +C list. The 'main' routine just creates the empty new image, then executes +C the 'writehisto' work function by calling the CFITSIO iterator function. +C +C 'writehisto' opens the FITS event list that contains the X and Y columns. +C It then calls a second work function, calchisto, (by recursively calling +C the CFITSIO iterator function) which actually computes the 2D histogram. + +C external work function to be passed to the iterator + external writehisto + + integer ncols + parameter (ncols=1) + integer units(ncols), colnum(ncols), datatype(ncols) + integer iotype(ncols), offset, n_per_loop, status + character*70 colname(ncols) + + integer naxes(2), ounit, blocksize + character*80 fname + logical exists + +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + +C********************************************************************** +C Need to make these variables available to the 2 work functions + integer xsize,ysize,xbinsize,ybinsize + common /histcomm/ xsize,ysize,xbinsize,ybinsize +C********************************************************************** + + status = 0 + + xsize = 480 + ysize = 480 + xbinsize = 32 + ybinsize = 32 + + fname = 'histoimg.fit' + ounit = 15 + +C delete previous version of the file if it exists + inquire(file=fname,exist=exists) + if( exists ) then + open(ounit,file=fname,status='old') + close(ounit,status='delete') + endif + 99 blocksize = 2880 + +C create new output image + call ftinit(ounit,fname,blocksize,status) + + naxes(1) = xsize + naxes(2) = ysize + +C create primary HDU + call ftiimg(ounit,32,2,naxes,status) + + units(1) = ounit + +C Define column as TINT and Output + datatype(1) = TINT + iotype(1) = OutputCol + +C force whole array to be passed at one time + n_per_loop = -1 + offset = 0 + +C execute the function to create and write the 2D histogram + print *,'Calling writehisto iterator work function... ',status + + call ftiter( ncols, units, colnum, colname, datatype, iotype, + & offset, n_per_loop, writehisto, 0, status ) + + call ftclos(ounit, status) + +C print out error messages if problem + if (status.ne.0) then + call ftrprt('STDERR', status) + else + print *,'Program completed successfully.' + endif + + stop + end + +C-------------------------------------------------------------------------- +C +C Sample iterator function. +C +C Iterator work function that writes out the 2D histogram. +C The histogram values are calculated by another work function, calchisto. +C +C-------------------------------------------------------------------------- + subroutine writehisto(totaln, offset, firstn, nvalues, narrays, + & units_out, colnum_out, datatype_out, iotype_out, repeat, + & status, userData, histogram ) + + integer totaln,offset,firstn,nvalues,narrays,status + integer units_out(narrays),colnum_out(narrays) + integer datatype_out(narrays),iotype_out(narrays) + integer repeat(narrays) + integer histogram(*), userData + + external calchisto + integer ncols + parameter (ncols=2) + integer units(ncols), colnum(ncols), datatype(ncols) + integer iotype(ncols), rowoffset, rows_per_loop + character*70 colname(ncols) + + integer iunit, blocksize + character*80 fname + +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + +C********************************************************************** +C Need to make these variables available to the 2 work functions + integer xsize,ysize,xbinsize,ybinsize + common /histcomm/ xsize,ysize,xbinsize,ybinsize +C********************************************************************** + + if (status .ne. 0) return + +C name of FITS table + fname = 'iter_c.fit' + iunit = 16 + +C do sanity checking of input values + if (totaln .ne. nvalues) then +C whole image must be passed at one time + status = -1 + return + endif + + if (narrays .ne. 1) then +C number of images is incorrect + status = -2 + return + endif + + if (datatype_out(1) .ne. TINT) then +C input array has wrong data type + status = -3 + return + endif + +C open the file and move to the table containing the X and Y columns + call ftopen(iunit,fname,0,blocksize,status) + call ftmnhd(iunit, BINARY_TBL, 'EVENTS', 0, status) + if (status) return + +C both the columns are in the same FITS file + units(1) = iunit + units(2) = iunit + +C desired datatype for each column: TINT + datatype(1) = TINT + datatype(2) = TINT + +C names of the columns + colname(1) = 'X' + colname(2) = 'Y' + +C leave column numbers undefined + colnum(1) = 0 + colnum(2) = 0 + +C define whether columns are input, input/output, or output only +C Both input + iotype(1) = InputCol + iotype(1) = InputCol + +C take default number of rows per iteration + rows_per_loop = 0 + rowoffset = 0 + +C calculate the histogram + print *,'Calling calchisto iterator work function... ', status + + call ftiter( ncols, units, colnum, colname, datatype, iotype, + & rowoffset, rows_per_loop, calchisto, histogram, status ) + + call ftclos(iunit,status) + return + end + +C-------------------------------------------------------------------------- +C +C Iterator work function that calculates values for the 2D histogram. +C +C-------------------------------------------------------------------------- + subroutine calchisto(totalrows, offset, firstrow, nrows, ncols, + & units, colnum, datatype, iotype, repeat, status, + & histogram, xcol, ycol ) + + integer totalrows,offset,firstrow,nrows,ncols,status + integer units(ncols),colnum(ncols),datatype(ncols) + integer iotype(ncols),repeat(ncols) + integer histogram(*),xcol(*),ycol(*) +C include f77.inc ------------------------------------- +C Codes for FITS extension types + integer IMAGE_HDU, ASCII_TBL, BINARY_TBL + parameter ( + & IMAGE_HDU = 0, + & ASCII_TBL = 1, + & BINARY_TBL = 2 ) + +C Codes for FITS table data types + + integer TBIT,TBYTE,TLOGICAL,TSTRING,TSHORT,TINT + integer TFLOAT,TDOUBLE,TCOMPLEX,TDBLCOMPLEX + parameter ( + & TBIT = 1, + & TBYTE = 11, + & TLOGICAL = 14, + & TSTRING = 16, + & TSHORT = 21, + & TINT = 31, + & TFLOAT = 42, + & TDOUBLE = 82, + & TCOMPLEX = 83, + & TDBLCOMPLEX = 163 ) + +C Codes for iterator column types + + integer InputCol, InputOutputCol, OutputCol + parameter ( + & InputCol = 0, + & InputOutputCol = 1, + & OutputCol = 2 ) +C End of f77.inc ------------------------------------- + + integer ii, ihisto, xbin, ybin + +C********************************************************************** +C Need to make these variables available to the 2 work functions + integer xsize,ysize,xbinsize,ybinsize + common /histcomm/ xsize,ysize,xbinsize,ybinsize +C********************************************************************** + + if (status .ne. 0) return + +C -------------------------------------------------------- +C Initialization procedures: execute on the first call +C -------------------------------------------------------- + if (firstrow .eq. 1) then +C do sanity checking of input values + + if (ncols .ne. 2) then +C number of arrays is incorrect + status = -4 + return + endif + + if (datatype(1).ne.TINT .or. datatype(2).ne.TINT) then +C wrong datatypes + status = -5 + return + endif + +C initialize the histogram image pixels = 0, including null value + do 10 ii = 1, xsize * ysize + 1 + histogram(ii) = 0 + 10 continue + + endif + +C ------------------------------------------------------------------ +C Main loop: increment the 2D histogram at position of each event +C ------------------------------------------------------------------ + + do 20 ii=2,nrows+1 + xbin = xcol(ii) / xbinsize + ybin = ycol(ii) / ybinsize + + ihisto = ( ybin * xsize ) + xbin + 2 + histogram(ihisto) = histogram(ihisto) + 1 + 20 continue + + return + end + diff --git a/pkg/tbtables/cfitsio/iter_c.fit b/pkg/tbtables/cfitsio/iter_c.fit new file mode 100644 index 00000000..f8576741 --- /dev/null +++ b/pkg/tbtables/cfitsio/iter_c.fit @@ -0,0 +1,701 @@ +SIMPLE = T / file does conform to FITS standard BITPIX = 32 / number of bits per data pixel NAXIS = 0 / number of data axes EXTEND = T / FITS dataset may contain extensions COMMENT FITS (Flexible Image Transport System) format defined in Astronomy andCOMMENT Astrophysics Supplement Series v44/p363, v44/p371, v73/p359, v73/p365.COMMENT Contact the NASA Science Office of Standards and Technology for the COMMENT FITS Definition document #100 and other FITS information. END XTENSION= 'BINTABLE' / FITS 3D BINARY TABLE BITPIX = 8 / Binary data NAXIS = 2 / Table is a matrix NAXIS1 = 16 / Width of table in bytes NAXIS2 = 5000 / Number of entries in table PCOUNT = 0 / Random parameter count GCOUNT = 1 / Group count TFIELDS = 5 / Number of fields in each row EXTNAME = 'EVENTS ' / Table name EXTVER = 1 / Version number of table TFORM1 = '1I ' / Data type for field TTYPE1 = 'X ' / Label for field TUNIT1 = ' ' / Physical units for field TFORM2 = '1I ' / Data type for field TTYPE2 = 'Y ' / Label for field TUNIT2 = ' ' / Physical units for field TFORM3 = '1I ' / Data type for field TTYPE3 = 'PHA ' / Label for field TUNIT3 = ' ' / Physical units for field TFORM4 = '1D ' / Data type for field TTYPE4 = 'TIME ' / Label for field TUNIT4 = ' ' / Physical units for field TFORM5 = '1I ' / Data type for field TTYPE5 = 'DY ' / Label for field TUNIT5 = ' ' / Physical units for field TLMIN1 = 1 TLMAX1 = 15360 TLMIN2 = 1 TLMAX2 = 15360 NAXLEN = 2 / Number of QPOE axes AXLEN1 = 15360 / Dim. of qpoe axis 1 AXLEN2 = 15360 / Dim. of qpoe axis 2 TELESCOP= 'ROSAT ' / telescope (mission) name INSTRUME= 'PSPC ' / instrument (detector) name RADECSYS= 'FK5 ' / WCS for this file (e.g. Fk4) EQUINOX = 2.000000E3 / equinox (epoch) for WCS CTYPE1 = 'RA---TAN' / axis type for dim. 1 (e.g. RA---TAN) CTYPE2 = 'DEC--TAN' / axis type for dim. 2 (e.g. DEC--TAN) CRVAL1 = 8.588000E1 / sky coord of 1st axis (deg.) CRVAL2 = 6.926986E1 / sky coord of 2nd axis (deg.) CDELT1 = -1.388889E-4 / x degrees per pixel CDELT2 = 1.388889E-4 / y degrees per pixel CRPIX1 = 7.680000E3 / x pixel of tangent plane direction CRPIX2 = 7.680000E3 / y pixel of tangent plane direction CROTA2 = 0.000000E0 / rotation angle (degrees) MJD-OBS = 4.905444E4 / MJD of start of obs. DATE-OBS= '08/03/93' / date of observation start TIME-OBS= '10:30:32' / time of observation start DATE-END= '11/03/93' / date of observation end TIME-END= '05:02:18' / time of observation end XS-OBSID= 'US800282P.N1 ' / observation ID XS-SEQPI= 'ROTS, DR., ARNOLD,H. ' / XS-SUBIN= 2 / subinstrument id XS-OBSV = 800282 / observer id XS-CNTRY= 'USA ' / country where data was processed XS-FILTR= 0 / filter id: 0=none, 1=PSPC boron XS-MODE = 1 / pointing mode: 1=point,2=slew,3=scan XS-DANG = 0.000000E0 / detector roll angle (degrees) XS-MJDRD= 48043 / integer portion of mjd for SC clock start XS-MJDRF= 8.797453703700740E-1 / fractional portion of mjd for SC clock start XS-EVREF= 0 / day offset from mjdrday to evenr start times XS-TBASE= 0.000000000000000E0 / seconds from s/c clock start to obs start XS-ONTI = 1.476600000000000E4 / on time (seconds) XS-LIVTI= 1.476600000000000E4 / live time (seconds) XS-DTCOR= 1.000000E0 / dead time correction XS-BKDEN= 0.000000E0 / bkgd density cts/arcmin**2 XS-MINLT= 0.000000E0 / min live time factor XS-MAXLT= 0.000000E0 / max live time factor XS-XAOPT= 0.000000E0 / avg. opt. axis x in degrees from tangent planXS-YAOPT= 0.000000E0 / avg. opt. axis y in degrees from tangent planXS-XAOFF= 0.000000E0 / avg x aspect offset (degrees) XS-YAOFF= 0.000000E0 / avg y aspect offset (degrees) XS-RAROT= 0.000000E0 / avg aspect rotation (degrees) XS-XARMS= 0.000000E0 / avg x aspect RMS (arcsec) XS-YARMS= 0.000000E0 / avg y aspect RMS (arcsec) XS-RARMS= 0.000000E0 / avg aspect rotation RMS (degrees) XS-RAPT = 8.588000E1 / nominal right ascension (degrees) XS-DECPT= 6.926986E1 / nominal declination (degrees) XS-XPT = 4096 / target pointing direction (pixels) XS-YPT = 4096 / target pointing direction (pixels) XS-XDET = 8192 / x dimen. of detector XS-YDET = 8192 / y dimen. of detector XS-FOV = 0 / field of view (degrees) XS-INPXX= 2.595021E-4 / original degrees per pixel XS-INPXY= 2.595021E-4 / original degrees per pixel XS-XDOPT= 4.119000E3 / detector opt. axis x in detector pixels XS-YDOPT= 3.929000E3 / detector opt. axis y in detector pixels XS-CHANS= 256 / pha channels TDISP4 = 'I12 ' HISTORY modified by pence on Thu Apr 24 15:04:08 EDT 1997 HISTORY modified by pence on Thu Apr 24 15:07:24 EDT 1997 TDISP5 = 'I4 ' HISTORY modified by pence on Thu Apr 24 16:06:08 EDT 1997 HISTORY File modified by user 'pence' with fv on 97-11-25T14:34:58 HISTORY File modified by user 'pence' with fv on 98-01-12T14:03:09 HISTORY File modified by user 'pence' with fv on 98-02-06T15:18:24 END óµA”ÑU=àq1±&ØA”ÑUAÀ =#t6A”ÑVo€ö(²RA”ÑX/@¸)P#½FA”ÑX‰@ Y[ ƒA”ÑXÕÀê ,~ A”ÑY” @ SÁ?A”ÑZ¢ W^A”ÑZÄ€Ó},ŸaA”ÑZï@¨LzA”Ñ[": $÷A”Ñ^à Nr€ A”Ñ_MÀuëA”Ñ_†@˜'êìnA”Ñ`g@ ÷  NA”Ñ`§àç $þA”Ñaƒ@ ª°*Ÿ A”Ña¡¢+91í2A”Ña¦À©% ¢A”Ñb tB( A”ÑbD@ Ñ*vhA”ÑbÐ I X,4A”ÑbÛ@O¤®A”Ñc7e$¬.+ A”Ñc] 3 OA”ÑdW2+ý© A”Ñd†€¹*2ÊIA”Ñd¦ C é )A”Ñd×`ö[#A”Ñf$à™&•^A”Ñf® M ƒA”ÑgoÀÙ“ÑxA”ÑgÀ å!%ÚA”ÑjS -`hA”ÑkàÄ\× A”Ñk|À"0ç$SA”Ñl€@ +Œ?-aTA”Ñl×@à f)ü +A”Ñm~às1\#âA”Ñm¨` +Á ä A”Ñmà`-V %ÍA”Ñnü œ ½¿ A”Ñq×`¶5í A”Ñr{€©Ê “-A”ÑrÆàæ#*)ë +A”ÑrÛ Ps €A”Ñsg€›'Ú A”ÑtìÅyA”Ñu@ PwXA”Ñv`à#c A”Ñyã@3+ËKA”Ñ{/ §!” \/A”Ñ{Q@ u,D bA”Ñ{`÷ Ä: +A”Ñ{ó@g"Ç'*%A”Ñ|À Ä M*¨SA”Ñ} '2^Q A”Ñ}s f ›“A”Ñ~0`×"0YA”Ñ~ØÀêŠ +eA”Ñ Àë%ÄDIA”Ñ`!v3A”Ñ}ÀT"»-A”Ñ­€½î*¼ A”Ñ€þ X,A N A”Ñ„¿`ƒ($_A”Ñ„Éà +î¬éOA”Ñ„Ü`ëi :A”Ñ…Ï v*¦-DA”ц´€ ç0A”цï Û y A”чÀš§ A”чL ƒ$¨ )oA”ч™À)¢-bA”чæ@ +ÝA”шâà( Z(A”Ñ‹&@+ A”ÑŒý  ¬#±kA”Ñ /91Ö A”ÑŽh ‚¥¹4A”ÑŽo  'ASA”ÑŽ¾,/B%vA”Ñ–à íÙ3œ A”Ñji!?åA”Ѥ€ë{+×A”ÑÀf."D:A”Ñê ¼l3A”Ñõ€üP'× A”Ñ‘®` +Ð1° +A”Ñ’k DÝzA”Ñ”&…=A”Ñ•‹ vy#  +A”Ñ–@ Q3&A”Ñ–ˆÀ h'À3&0A”Ñ–À +á(A”Ñ™àA/ÑÄ A”Ñš€¡ï! ~A”Ñš: Öˆ‹A”Ñš¬@èSA”Ñ›& ˜ V2A”Ñžy *Ì&8A”ÑŸ‘@ ØÍZA”Ñ v`# YÁ¡A”Ñ£L€”S×A”Ñ£a@ç A”Ѥ€Í1,PA”Ѥn ’/3xwA”ѤÉÍ7 PA”ѥ꠿*E A”Ѧ« <3ŠëA”ѧ ¸ÊpA”ѧ=`? &Ò A”ѧÝ@zÊ– A”Ѩ\€h0¢¥A”ѨŒ õ“#ë?A”Ѩɠ (U+DA”Ñ©b*:BA”Ñ©Ýà¢$$A”Ñ©à-3DÙA”ѪLÔ*[3' A”Ѫ¡Ú³}zA”ÑÃl` +$s +ØA”Ñŵà—Ÿ.Å^A”ÑÅØà +§$_'A”ÑÈç  mF1 A”ÑÊ’€žÿ+ŠA”ÑË`O& ¿ A”ÑËÖ s ã7A”ÑËýà×"™A”ÑÍJ@/ P4ˆEA”ÑÍ»`ì ¸ +A”ÑÎÀàË+à A”ÑÎá`×þ'È A”ÑÏú€ +Û/Ù A”ÑЛÀÐÍ A”ÑÑh ð # +A”ÑÒàß+Ì"SEA”ÑÒ ©©A”ÑÒ« ø/Ž 35A”ÑÒÂÀ • ¾)7ÛA”ÑÓïà áÐ4¦A”ÑÔ4 ®ln A”ÑÔ:@2%åõ +A”ÑÔZ ?a ÄFA”ÑÔi€”.]´FA”ÑÕ*€ + + JA”ÑÕn`äÚ-§ A”ÑÖ`æ+ŠXA”ÑÖU`¥v A”ÑÖìW ŠA”Ñ×,à4`!A”Ñ©@"ÝdA”Ñ« C(ØjA”Ñ°À%,·&¨A”Ñæ€ >¤%L A”Ño@ +¿¥AA”ÑÀ"!!®#A”Ѳ 3$À A”Ñý` H/™& XA”Ñ h(-3ŠA”Ñ- ¢-øA”Ñ[À“,˜ A”Ñc`+%$A”ÑúÀÇ4ïSA”Ñ-zâ3â +A”ÑË 0(Õ%A”ÑÛÀ +J ]{ A”Ñ €y!7ÂA”Ñ‘ \'È A”ÑÌ` }&ø&|A”Ñù ¥&,Ô A”Ñ ë`eç9A”Ñ +—`d%x.A”Ñ à"±*WA”Ñp€Õˆ}A”Ñ5`õâ(ÛA”ÑO€È+ÌŠ9A”ÑXÀ|"rAA”Ñy€ Å\'«„A”Ñ7@ ÿÁ% A”Ñ +€ ^ ™ 8A”Ñe ‚)0ñA”Ѽ ÷31« A”ѯ W A”Ñ‚  ó" +ØA”Ñ°€¤ +RÕA”Ñ€<°s-A”ÑÃ`A °c A”Ñ`L2‹ªA”Ñ@ ,º'B@A”Ñ?à , ðA”ÑÄ`uþ(-A”Ñ×@ +…;A”ÑûIãwA”ÑC !% A”Ñmq%§,d+A”Ñq –÷ A”Ñè ,1{— A”ÑÕ`x v-tA”Ñk@k'£*Ò A”Ñ4`P c-sA”Ñ ò m!IŸSA”Ñ!¼àh!ü` +A”Ñ!í`÷CÖA”Ñ!òÂ$ÖÔ A”Ñ"Š¢%, ++A”Ñ#PÀkó;1A”Ñ$.€æ"¼ 6A”Ñ$•àl!H A”Ñ&- g%àA”Ñ'ý@ +‡ 4`PA”Ñ(Z@Ú _¨A”Ñ(È )-(”%A”Ñ)P€ ¶ …A”Ñ)w,)œ¶A”Ñ)ì` ª>ŒA”Ñ*A ©±¦ A”Ñ,*@f€° A”Ñ-I#ê{]A”Ñ-í@_t÷ A”Ñ.Ö yçn;A”Ñ/O Šb6œ A”Ñ/‹ ….'A”Ñ/öü4²vA”Ñ4S`†·/A”Ñ5€ú%;A”Ñ5à +Ôû¾4A”Ñ5./«ëA”Ñ5¹ ¤%{­A”Ñ6ˆ`¹!A”Ñ6ï` R×3ÏA”Ñ7_ÿ0r A”Ñ7µàû r!mA”Ñ8@ Ü>iA”Ñ9ƒ`Û/ŒÞWA”Ñ:f W·f A”Ñ;" y Ç"A”Ñ;:€ñé ‹ A”Ñ;S ³.b!Ð"A”Ñ;c` Æþ )eA”Ñ>@ ç)î"t{A”Ñ>à °íÑ-A”Ñ?=`ù N&D5A”Ñ?g  xb§0A”Ñ?å @Eï A”Ñ?ùÀ¿Ü PA”Ñ@'à‰Ç$üTA”Ñ@V  Ù.þVOA”Ñ@à Ë¢• A”Ñ@ú`ˆ×ÓA”ÑAW`s!È·A”ÑBÖ e,£s*A”ÑCX wæ1Ù +A”ÑCi€ñ$ù Z$A”ÑC— D +_(UA”ÑDî€ +QJëA”ÑE& —wA”ÑFÙ(%Ü'A”ÑF÷ b 1)Õ2A”ÑG +à ^ +^nA”ÑG;à¹-+§A”ÑHÀ¢ÎÎA”ÑJ€àóþ–GA”ÑJ› ®#$ÑA”ÑJ±@h1"%œ A”ÑJú@ ¡0"s A”ÑMo €3à›A”ÑNq ÏÜ A”ÑOø’/ñjA”ÑPc D#;(e A”ÑQ@ïâ-¡ A”ÑQ¨à\4d +A”ÑQþ |eA”ÑR)`G +èA”ÑR- “ 8,dA”ÑR3$x­3A”ÑTÉàŽ&¸&A”ÑV‚  +*È BAA”ÑWdÀù£× A”ÑW@óù3ëjA”ÑY8àÇ1m ¼A”ÑYóÀ ?!ÃÎ +A”Ñ\÷ (4Ì A”Ñ]Π³FPTA”Ñ^+Àû4È A”Ñ^é@)1¹*  A”Ñ_“`ú)*¥>A”Ñ`¾àF.ö{OA”Ñ`àëæ#¬JA”Ña Ž*˜7A”Ñb÷*4^ƒA”Ñb,`š,ã4A”Ñb¯@W´A”ÑeࢠZ'Ý&A”Ñeà +–ªf§A”Ñe1À}!ø'jA”Ñe¸€ “ ” A”Ñeá ™1Ö+ˆA”ÑfAà'~A”ÑfI÷!w A”ÑfrÌ“õA”Ñgˆ†(mA”Ñh@ u -¯EA”ÑhD¡.‚©6A”ÑiÀ  ÂØ A”Ñjj€À~ÜA”Ñjí #l ÁPA”Ñjô³(›"jHA”Ñk  â*~JA”ÑkáÀ‚!ù1`A”Ñkè@Jð#\8A”Ñlà \Ü1A”ÑlH@.ë%A”ÑnÜ€y/’/ A”Ño@Á%C#²A”Ño3` eA$»rA”ÑpS Xö A”Ñq€0÷ ænA”Ñq5À)I ’A”Ñq“@Ä2A”Ñr2Àü6 :A”Ñr·à[Äâ™A”ÑtÀ’%û+VA”Ñt¡N3žA”Ñtì © +A”Ñu’@ýG Š +A”Ñu•€í'–!ô{A”Ñvg 7 A”Ñv€-!Ë7A”Ñv­ —í%tA”Ñxë€ «'å4 A”Ñy“@ˆ¥1- A”Ñzl`&) ¦A”Ñz­ t#¿A”ÑzÇ  Ç(Ÿ3A”ÑzàÀm"Ô*A”Ñ{>À&BA”Ñ{lÀê6‚ A”Ñ}ïÀ(„"iA”Ñ~à ÿ%€_ A”Ñ~@Û)i%QA”Ñ~æ  +Yª4pA”Ñ~þ : &ûA”Ñ€‘@!:÷ A”Ñ€˜à¹Á)‹A”Ñà ù1ý!A”ÑL?Þ3A”Ñ €™ . A”Ñ‚BàÖA”Ñ‚Àý$Ÿ1f7A”Ñ‚á`2'“ùA”уI€UØ>A”у €$ž!A”Ñ…{À üÁLA”Ñ…” ÛA4JLA”Ñ…ä ¾s A”цNàdK?A”ц»€Ð +ë,|LA”ш5ÀA2ú(†A”ÑŒá&.! ç,A”ÑŒîà1gA”Ñ*@¨!’6–A”ÑŽU ¢ +<A”ÑŽàÈ 3A”ÑQ ¡--f +A”Ñ‹ ä&˜E +A”Ñ£àI2V(ÈA”Ѩ2±%ÛA”Ñ‘µ€ ™$C5Ê A”Ñ’ÿ ìÎìA”Ñ“D M-!WA”Ñ”‰ Š6~ A”Ñ”ý y¤ A”Ñ–Iì!=9A”Ñ–‹ 1¬ÓA”Ñ–½ ò© m A”Ñ™a€ + ð A”Ñ™÷ à |mA”Ñš~` ÷'¦³A”Ñšé€<HjA”Ñœo Ì 4ÓA”щ€±ÍA”Ñšà(×!© A”ÑÝ Ú&2"v A”Ñž¿  !)˜$ýA”Ñžå  +™-ˆ A”ÑžúàTÔ +A”ÑŸC ´° A”Ñ¢Y€ÏA”Ñ¢mÀ ÆËA”Ñ¢™€dY.òA”Ñ£ + }]A”Ñ£ à5ÓtA”Ñ£¬@ ¨A”Ѥ–@ï,˜ ìA”Ñ¥ A-¦&f A”Ñ¥£à £'œ0ž A”Ñ¥Ë@ˆYA”ѦʀtÖ#¹A”Ѧí Tò! A”ѧ¢ †4! A”ѧ½ «1ì!Y A”Ѩ$à L#¬A”ѨC s'y#UA”Ѩ{@ Ÿ, +N A”Ñ©|`±s Ñ +A”Ñ©àÛ´&×A”Ѫà +÷ Ä6A”Ñ«ààSR":A”Ѭ  +#Ó3A”Ѭ¬€my·A”Ñ¬Ü )åõA”Ѭú 6v"‘%A”Ñ­  4"Â#2A”Ñ®€ ÷çü A”Ñ®tÀÁ}("ŠA”Ñ®àÀ ° A”ѱdŽ bB A”Ѳ„ <.IÃSA”ѲÜlî|A”Ñ´°À£í)A”Ñ´ú jÌn A”ѵ6@m.™A”ѵj § ÷ +A”ѵØ`BØA”ѵí`|¤hA”Ѷ#à“Úa&A”ѹ Œ‹ÁA”ѹ !÷5Ä A”ѹ£à&'–3QA”Ѻò %.xÍ A”Ѽ‰`{(ú¢VA”ѽpà5š%˜A”ѽè` ® “{ A”ѽö ’ª%y-A”ѾO ¯)Žb A”ѾS€0*f' +PA”ÑÀ:€ ‰,6VA”ÑÃDÀÉ @(A”ÑßÀ&œA”ÑÅÓ` !2æ!r A”ÑÆ'` -^/5A”ÑÇkÀ +''- A”ÑÈ   +Ôs í A”ÑÉ â_$K[A”ÑÉž “ ŽÂA”ÑÉ·`ë%5 A”ÑÉÍ` ‰B5ßA”ÑÊ3€ò“!A”ÑÊe  ¦4û- A”ÑÊàŒŒA”ÑËÀ +œ%LA”Ñϧ B†M A”ÑÐ`Ø&˜ õA”ÑÐ]€© k) A”ÑÑÖ€Y, A”ÑÓiÀ 9-åA”ÑÓûà1—9 A”ÑÕ Î;)»A”ÑÕÜ@ ‹ x A”ÑÖ¸àí ÿ A”ÑÖð`6´!A”Ñ×T :©A”Ñ×\ 7t(A”ÑØXÀȬ!´ A”ÑØ•`’é–A”ÑØï€$ +1)VA”ÑÙ` +&bpA”ÑÙÿ@z0z+A”ÑÚ\à##èA”ÑÜS@ «",6HŸA”ÑÜ~€ð#;.#A”ÑÜÚ 73¦m%A”ÑÝž`Tj$©A”ÑÝÊ@ @) A”ÑÞX€ e˜ | A”ÑÞƒà ¾ÇA”ÑÞ¨à€`4!-A”ÑÞÌ`! ûàoA”Ñ߀ëp.A”Ñß @mú#˜A”Ñái@ X"§*A”Ñ㈠¤!9!OA”Ñå9  J-~1FA”Ñåg`ü» +D.A”Ñåà®u1jA”ÑåìÀ?)’!–'A”Ñæ€ ŽÒñ A”ÑæKà‘†Ñ A”Ñæ™à*(ó&¦A”Ñç¶` å™6ã%A”ÑêJ F!Ê$¿ A”Ñì€ P3¤º A”ÑíJ€åA”Ñî( Q5*2A”ÑîŽA ]A”Ñ𢠌ü6A”ÑñÀ@0 +‰,÷A”ÑñÏ€<4î‡A”ÑôÝ€ +ž¡A”Ñôà (­%oA”Ñ÷i€u!E5ò+A”Ñ÷p`3L Õ A”Ñø5@Ú!A”Ñø|@ ã™-­A”Ñù`T^A”ÑùßL.[)A A”ÑûWÀ<  * A”Ñü§ —[ÕA”ÑüÀàÞ'Ë +Ê A”Ñþ;àѧ!5A”ÑþýÀ ò¯5e:A”ÑÿI`–Ä ‡A”Ñ #@¬#V+uA”Ñ ­@­¼*A”Ñ Ï "ÄPA”Ñ ê Ó! =A”Ñ è ’""VRA”Ñ 4@ S +–#¶A”Ñ â€ .¬þ6A”Ñ +s€œ§îIA”Ñ Š %7|=A”Ñ Ÿ C/ A”Ñ ¼`ô.8 € A”Ñ Ú  caA”Ñ âàÆ,.A”Ñ ÓàuM&¢A”Ñ ý & û*8 A”Ñ €  ºç A”Ñ  €àXA”Ñ ¬à§&¿DA”Ñ ®à | A”Ñ Là–½A”Ñ Mà[(®"5A”Ñ Ûà S õA”Ñ ® ´,¯CA”Ñ ¬ ¬ "Ï~A”Ñ ³ î3úB5A”Ñ ´`¹îÇDA”Ñ Å€¡U!¾ +A”Ñ  §0é.éA”Ñ 3@s!A”Ñ `@ ¢#ô& A”Ñ Âk S è A”Ñ è ? QÆA”Ñ ñà ‡1òA”Ñ  >0ŸŸ A”Ñ hà˜©$[A”Ñ Æ` ܸ'(A”Ñ C 5ËA”Ñ U Ç)È +[ A”Ñ ¾ù,$ ýA”Ñ ú! ÚA”Ñ O€¤(2¡A”Ñ !­“  «A”Ñ #Àu("A”Ñ #` ”] A”Ñ %Ý`¡Ä5Ÿ A”Ñ &ÞÀ æíA”Ñ 't€=!ý ÏA”Ñ ' ¦‡A”Ñ (€ *©eAA”Ñ (:`¹(E  A”Ñ (‚` 7*«A”Ñ (§àÞ'»UA”Ñ ) ++!EA”Ñ +€ ¥ávjA”Ñ +±j#}$A”Ñ +À op6A”Ñ +Ð § ø6¾ +A”Ñ ,*`Ü',@A”Ñ ,Å@Q$1ÓA”Ñ -`?'a1KA”Ñ -Y h1ò±A”Ñ .b`”AÎ~A”Ñ .`Ñ!å +=A”Ñ .Ÿ  ï‰A”Ñ /# þÄ A”Ñ /Ë*£ú'A”Ñ 0Ä ƒ%’A”Ñ 1;€MÊ‚KA”Ñ 2:@>']ÎA”Ñ 3SÀ %&V A”Ñ 3Œ@ +Ã? N A”Ñ 3”à~ª:A”Ñ 4¡@ª%Ž(uFA”Ñ 4¹ :—+ A”Ñ 4àÀœ ÔYA”Ñ 8Àz6C6A”Ñ 8}X@& +A”Ñ :îÀ +Þ]¼AA”Ñ <á`Ç0h,o A”Ñ >? ˆö ¾A”Ñ ? r. – A”Ñ A7 ó+uGA”Ñ AÆ Z$ª&w +A”Ñ BG +_9 ©PA”Ñ C€Óv @A”Ñ Cµ@åa„A”Ñ D„€¢&¿ú A”Ñ E1ú™#Š>A”Ñ H*  ¹ +#A”Ñ HeÀ ³»ø A”Ñ J{À¢Ÿx A”Ñ JÔ@*%jZA”Ñ K­`§%¡-^*A”Ñ MÎ`«W4æÜA”Ñ Mã É][A”Ñ N`j­¢A”Ñ N? 5¿ã A”Ñ NX@| Ã*£ A”Ñ P` rŒ&È`A”Ñ Q˜ .Z¨JA”Ñ R™= R7A”Ñ S@¥\.÷A”Ñ S¯`e$?SA”Ñ TÛ Äì6W>A”Ñ TçÀÕ KÎ +A”Ñ TéÀLÑA”Ñ U2 ç»_A”Ñ V¾ 2 [.{SA”Ñ Wàbó qA”Ñ X Ì£EA”Ñ X  ÷ú/TA”Ñ Y€½ A”Ñ Z +`gù,ŒA”Ñ Z—€S Z Þ A”Ñ \c€À6JA”Ñ ]`ÔH}A”Ñ ]€˜ ÕäA”Ñ _%`Ä% +A”Ñ _–@ `?EA”Ñ `FÀ0)f A”Ñ `³²Ü(A”Ñ b,@¶2¢$m*A”Ñ cŸ +¾0¢ « A”Ñ da ü Z1A”Ñ eSà? +‰!A”Ñ e»  K° A”Ñ e ?-ž±0A”Ñ eîð$CpA”Ñ g4ÀÞ$¤ù A”Ñ gˆà æ+ÆA”Ñ h p:­A”Ñ h¢€'/ô!¯ A”Ñ iÀ ]ç5¶)A”Ñ iÀ4 ›öA”Ñ jJ o"j4òA”Ñ kÓ Þ!zA”Ñ kØq]KÞA”Ñ l Ë#ƒ0NA”Ñ mÌÀH)PY A”Ñ n€·*£¤A”Ñ pÒ`I‹-ZJA”Ñ qØ@–&I/A”Ñ r+@s!o2õ(A”Ñ rÀ,5A”Ñ uÀà ü ‚&„.A”Ñ uß õ'  A”Ñ v8€ÇƒuÎA”Ñ v· ‚f¶ +A”Ñ vÙî“"ŠdA”Ñ w˜à h+™ e°A”Ñ w¸ù $? A”Ñ yÍÀ ë¢(éA”Ñ { +€ +¾3f?A”Ñ {à „$Õ +A”Ñ |Ÿ€6Ä©A”Ñ €“`a&Ð'*A”Ñ >@ +(J a*A”Ñ ‚.` ‹-¦)w A”Ñ ƒ`i Î*Å A”Ñ ƒ>€ |%$³A”Ñ „H  2I#òA”Ñ „Œà —ð ™ A”Ñ †k€‘!T4­A”Ñ ‡l@"óA”Ñ ˆà A”Ñ ‰íÙ +HA”Ñ Š- Y3KA”Ñ ŠI *(|.`"A”Ñ ‹äàΦA”Ñ ŒTO +g(CA”Ñ ŒÖ  ÿ.`A”Ñ ¯àè"É4-A”Ñ Ž†@U£ÚA”Ñ Žú@¤¾ ñ®A”Ñ !À%ó‘A”Ñ ‘Z`ì0q ,A”Ñ ‘ëàà_8A”Ñ ’*`H2™+­ +A”Ñ ”ÍàþÏ(áSA”Ñ •÷ ê'f$¸A”Ñ –và R"î A”Ñ –à &V6iA”Ñ –÷àv-×A”Ñ —Ò j ¿A”Ñ ™`Ì+)5A”Ñ ™à +H"´ +A”Ñ œ`I>#ŸA”Ñ œ0 ]"þsA”Ñ œæ |"$ A”Ñ ` öJA”Ñ ;`›+ “A”Ñ A 0/¥ A”Ñ Ÿl€F%£*ÅvA”Ñ ¡* 7 ÓáA”Ñ ¡Ä@¦r/v +A”Ñ £¥àþGA”Ñ £Î §!½OA”Ñ ¥±à½&—4â A”Ñ ¥Ó Ês"Y1A”Ñ ¥í@ #Ë +A”Ñ ¦Àµ!Oe A”Ñ ¦m +@ +QA”Ñ ¦è ¿'@+gA”Ñ §àÍ+þ&—Ê*DA”Ñ ©º  úàA”Ñ ©È@}2Iœ A”Ñ ©ðàe€"A”Ñ ªÀ ž-ÚÝA”Ñ ª—à’!àˆA”Ñ ¬Öàî9- A”Ñ ¬í€ç5d#A”Ñ ®€­('.˜ A”Ñ ¯Z ï%ÁA”Ñ ¯jÀ t"¢ _A”Ñ ¯Ñ ó5P A”Ñ ¯ú@ }ŽE A”Ñ °§ÀTh„A”Ñ ±X@ Ð!'A”Ñ ²=À±)Ñ!#)A”Ñ ³và &&‚(%A”Ñ ´  ›ÿ0%7A”Ñ ´U€R •!A”Ñ ´{f!TA”Ñ ´Œ ®&¶ê0A”Ñ ´•€<ò/A”Ñ ¶`àÎ `3A”Ñ ¶kà0 Œ$D A”Ñ ¶s ,Š2x A”Ñ ¸ûÀÈ‹¢FA”Ñ ¹%à®f /A”Ñ ¹+€'ƒA”Ñ ¹êÀFr(ï A”Ñ º÷à +ú&yµA”Ñ ¼€ã6ššFA”Ñ ¼Làß*› A”Ñ ½?àY¿ ÝRA”Ñ ½ºÀÃ0‰A”Ñ ½ý µ õ#hA”Ñ ¾nà bA”Ñ ¾¶`N0ú";A”Ñ ¿øà 2%5E$A”Ñ ÂéàÒ5A”Ñ ÂïÀ„1µ)šA”Ñ ÃQÀ= ¸ ?CA”Ñ ÃÂ`G.‚!ŸvA”Ñ Å† « ×!Z4A”Ñ Åº@ ’,A$ A”Ñ ÆPÀ`†%% +A”Ñ ÆW@ Y¨"A”Ñ Æéà IP=A”Ñ Èp ¢ oó9A”Ñ Êq U/MøA”Ñ Ë©`,'% A”Ñ ËÑ@‹lÃA”Ñ Ì@#-¸,. +A”Ñ Ì„`"t ç{A”Ñ ÌÌ€ù-v9A”Ñ ÎÒ D*p:A”Ñ ÏÈ/¦9A”Ñ Ð@` ˜!ÍA”Ñ ÐF€ Î1¦(ÙA”Ñ Ðþ@ªDA”Ñ Óq N!fXA”Ñ ÓŠ@`"r÷A”Ñ Óª N&u*lA”Ñ Ô³ u,)U A”Ñ ÕÃ` Ž#=hA”Ñ ×'àl)A”Ñ ×ë€ó4õA”Ñ Ù¹@£ô*¡A”Ñ Ú€Ó$hA”Ñ Û€ò/êë A”Ñ ÜÉ C™]A”Ñ Üò`!;¨A”Ñ Ý(@#.*ÁtA”Ñ Ý¸€ß2" A”Ñ Þ@ Iö A”Ñ Þt`ð Ž-A”Ñ Þžj2…" A”Ñ Þ¯  : È5A”Ñ ß4ÖÍA”Ñ àV 1!Ô! +A”Ñ à†à ºO +§@A”Ñ á±àæ' 'A”Ñ á²  3: â A”Ñ â` Ù4û+l A”Ñ ä~%0J ËA”Ñ æ?À ©"‚`A”Ñ ç­À °)È¢A”Ñ çÁ•0!A”Ñ èç _nôÕA”Ñ ê 5ê!£ A”Ñ ê4 P–!WA”Ñ êKÀ§ O8A”Ñ ë5 Ãá A”Ñ ì³@Ú#'HA”Ñ ìµ€ w 1‹ +A”Ñ ìí*ë vA”Ñ ín Í$o4 A”Ñ î­ t3?A”Ñ îâ`rŒgA”Ñ ïG‰ê(¡A”Ñ ïOÀ +6³ A”Ñ ñ;À4->?A”Ñ ñ@àyð02QA”Ñ ñ‹à¡æ(¬A”Ñ ñ` êÐ(= +A”Ñ óä@ +ï 'yA”Ñ óø ¸6Ã#A”Ñ õL ê#†ÄA”Ñ õ’À ðÉ,¾1A”Ñ ÷Œ ï$ A”Ñ øà )â-A”Ñ ù5  +91/Ü A”Ñ ú`ò1à$¥@A”Ñ ú}€ +ù)?/ñ A”Ñ û p&—*Ì A”Ñ û] S(þXA”Ñ û¨às]ÙCA”Ñ üH`!(Ô%ÿA”Ñ üÚ€ +Â:1¢A”Ñ ý[ ß"è£)A”Ñ ýs€Ø*ú5¯A”Ñ þ@JH1TA”Ñ þy@%A6}KA”Ñ þÔàõ(… A”Ñ þÖ@͇ݧA”Ñ ÿ¯@v 3~ A”Ñ ÿü ‘ T1/A”Ñ!c â*î A”Ñ!¨ Ã~ +A”Ñ!Ê 5Æ65A”Ñ!jàôT19 +A”Ñ!Í`þ•/i=A”Ñ! @séŠ1A”Ñ!F 0t*A”Ñ!ä` $\ +A”Ñ! Tа 'A”Ñ! à/(ç)A”Ñ!mÀßðA”Ñ!ñ@·%€Ú=A”Ñ!þà 4ï ¨A”Ñ! ùɶA”Ñ!™ÀŸé(ê;A”Ñ!@ +) ŠA”Ñ!Àó ŽÄ +A”Ñ!ý?‹ÌA”Ñ! ¶%Ç,ê +A”Ñ!Y@L,‹~A”Ñ!7ÀÕ(×_A”Ñ!-€ :+ÁA”Ñ!> ™$ A”Ñ!V ‹0×DA”Ñ!î€ ËöÕ A”Ñ! @Y E +Ö A”Ñ!NÀÍF! A”Ñ!Å€¶ô5(A”Ñ!-@&)A”Ñ!6@ ^*4æA”Ñ!UàÒ U!œ A”Ñ!m¾-§ó A”Ñ!mà Ç4ŠåA”Ñ!кúIA”Ñ! Š`Û6žN%A”Ñ!!àó+è3–A”Ñ!!R`mG)\A”Ñ!"SàIr2vA”Ñ!"Ç€Æc ×A”Ñ!"È`¨5: A”Ñ!#3 } ¥lA”Ñ!' €.½8A”Ñ!'- jˆ‰NA”Ñ!'½À·58A”Ñ!(c Y #$A”Ñ!)=  è%¢&ñA”Ñ!)F€ +…0‘ SA”Ñ!*, .Ód +A”Ñ!-+~+¢A”Ñ!-¦|" +A”Ñ!-á`¡-o) A”Ñ!.Šàóß.A”Ñ!.®€€)¦/« A”Ñ!/Àª0ñ#ýA”Ñ!0 zÑ"A”Ñ!1.@!1– +A”Ñ!1=À×s*A”Ñ!1øà½"†?RA”Ñ!2<V›A”Ñ!2Ë T#~A”Ñ!3  €. Ó%A”Ñ!3¶ òÁ3ÐA”Ñ!4N@ô ) A”Ñ!4l 1ñ%- A”Ñ!4Ðà +Ì$$!cA”Ñ!4ñ  ”ÐÉA”Ñ!5‘`E¹.%QA”Ñ!5×€¥ s2&GA”Ñ!6\Àù (kA”Ñ!6Ž +l],A”Ñ!6±@Á)( +A”Ñ!7R –8F +A”Ñ!8@ýÞ7& A”Ñ!8m€Ú&ù6A”Ñ!8³`*Ê$àA”Ñ!8Ê 1zA”Ñ!9ÿ@à!ç,kA”Ñ!:u@Ø/F33A”Ñ!:—~ 2.4A”Ñ!:á 'Ú0Ú A”Ñ!;$@# Z‰A”Ñ!< )ŠÁgA”Ñ!<þàÁ&d7]A”Ñ!=e Æ.jV A”Ñ!=ˆ +*5A”Ñ!=ûá# "L A”Ñ!?…€ -¸"– +A”Ñ!@M€ 5¯àA”Ñ!@Áàö-Î A”Ñ!@Ò å0ÚA”Ñ!AGà));îA”Ñ!D ]!J ¼A”Ñ!DŸ€\ÑüA”Ñ!DÙ`Ô/!@A”Ñ!F` V"2A”Ñ!FÂàF#+#0OA”Ñ!G( ¶ Z\A”Ñ!GE`K((R A”Ñ!HEâ A”Ñ!H’ ã.‚7 A”Ñ!I /H¨RA”Ñ!J @4E1¸ A”Ñ!J9À] á,/A”Ñ!L d$,QA”Ñ!LSàQ!7òA”Ñ!Ld€ò%b!A”Ñ!L}  ¶qÚTA”Ñ!M@.*µ•…A”Ñ!M¿ J%(-wA”Ñ!Nfà%õ A”Ñ!N›K1ÂãA”Ñ!Ov½R1VA”Ñ!Q Ì!‰2A”Ñ!Qh ì#I'£ +A”Ñ!Sz€ +[: µA”Ñ!V# L3Ë úA”Ñ!V  þ, :A”Ñ!WzÀ1!(…A”Ñ!W© )¯5A”Ñ!WÏ@¢7ê ‘ A”Ñ!W÷€ ü­ MA”Ñ!X4€Ú3“µA”Ñ!YÀ¿)û#!'A”Ñ!Z€ e4--ç A”Ñ!Zu`!Ÿ °A”Ñ![FœA”Ñ![À2£âA”Ñ!\)àï Í-õ A”Ñ!]a P0er A”Ñ!]r î (A”Ñ!^aÀ,W,d A”Ñ!^q@X" A”Ñ!^¨`à'@A”Ñ!a.€ +ã&2» A”Ñ!a8@ÑOfaA”Ñ!a³@‹ ˜zA”Ñ!aú r]Ó A”Ñ!c8Àh5ñˆA”Ñ!cOÀÜ- zA”Ñ!cd€‰-ÁA”Ñ!d Ï Œ$ÁA”Ñ!dÆ •'²5 A”Ñ!e¤¡4Á%ŸA”Ñ!f!À +%Ñ+•sA”Ñ!fÔ@' `#| A”Ñ!g|` Ñè*˜A”Ñ!gªÀf) $;A”Ñ!gÉ  Û%ÞM®A”Ñ!güÀ5Þ-/A”Ñ!h¡ zØ PA”Ñ!háàv6à] A”Ñ!ià6ö6A”Ñ!iE œ!EŽA”Ñ!j +àš-„‘A”Ñ!j7 Rˆ1ô"A”Ñ!j:€(‘)‡ +A”Ñ!ji@ !Z,?A”Ñ!jÀ ! !A”Ñ!krà„Çð A”Ñ!k÷[V=A”Ñ!m µ-‚FA”Ñ!m@à“ +Ÿ  A”Ñ!mgàï!EŠA”Ñ!m €Z‡A”Ñ!o`Àº„øBA”Ñ!o†#3Ž DA”Ñ!o´` mLõA”Ñ!rbÀØð,«A”Ñ!r@)ÍP A”Ñ!rî %6A”Ñ!s B±3A”Ñ!sT€S!ã!/3A”Ñ!s‘ í6ù£A”Ñ!tŠ  • h$ÂA”Ñ!uâ` b='&(A”Ñ!vî@ gS,% +A”Ñ!w€h#c/Þ A”Ñ!y`  É A”Ñ!y=€'%a8 +A”Ñ!yØ`Š( çA”Ñ!z,€djú#A”Ñ!zr Ï )43A”Ñ!{.à +Ì· +aA”Ñ!~ õ LKA”Ñ!~— þ0\ã A”Ñ! ^ µ A”Ñ!1`«,çA”Ñ!n@yP ÉA”Ñ!Èy5-'A”Ñ!€“À—2êNA”Ñ! + º*A%ÖBA”Ñ!# l1û +A”Ñ!3ÀA7¿$ô6A”Ñ!A +»1SA”Ñ!Ð@• FA”Ñ!‚‡“ +ãA”Ñ!„UÀÁ+,€A”Ñ!„Á´#XA”Ñ!†C` § (M A”Ñ!†œ€ +Ô«"¥A”Ñ!†ê±xíA”Ñ!ˆJÀ{ï3] A”Ñ!ˆ› »ØC0A”Ñ!ˆ«€70¶^A”Ñ!ˆÓ_$Ó ¦A”Ñ!‰1@½.hÜ A”Ñ!ŠJ #7 +Š A”Ñ!ŠkÀôs Ó`A”Ñ!Š… 3.R%}A”Ñ!Šþ +þ*@(A”Ñ!‹y`@2Î"Ö A”Ñ!‹¯@ (#ï8] A”Ñ!ŒzÀ…0Ô13 A”Ñ!ŒÚàŸ(ª1íA”Ñ! + °XS A”Ñ!x@„mìA”Ñ!“ v " A”Ñ!Ž:Àk'sÖA”Ñ!Ža€ü/¶bCA”Ñ!%À8^A”Ñ!@!"Ý A”Ñ!‘ àØ3-¦A”Ñ!“S@K +A”Ñ!”–@ò,½á]A”Ñ!”˜`®3A”Ñ!”€ð†!ö A”Ñ!–# ÒJ7“A”Ñ!—›@G#µ/,A”Ñ!—è 6!w A”Ñ!—ò€ µM7A”Ñ!˜8àuf*-A”Ñ!˜Ü@ á’4¹ÇA”Ñ!™ œ9"5A”Ñ!™Ëb-L#¼ A”Ñ!™ï T +» A”Ñ!šV@¶"qA”Ñ!šz@Ã0‹F +A”Ñ!šîà‰¬xA”Ñ!µe Œ&66ÏA”Ñ!¶ŠQ"íO2A”Ñ!¶‹ D*B!²A”Ñ!¶È UÐA”Ñ!¶Ï`lðBA”Ñ!·Àÿ@A”Ñ!·x€¶A”Ñ!·™à Ÿ&×IA”Ñ!·þÀ /( $A”Ñ!¸XÐ +˜ +A”Ñ!¹ W,Ô,9A”Ñ!º Ì ÷*ÃFA”Ñ!º‡` +#%0fA”Ñ!º¶@ÍÇ­A”Ñ!¼?ÀF2*y A”Ñ!¼ÿ€Z $"ÉA”Ñ!½@@b£ …A”Ñ!ÀjÍÃA”Ñ!À¶ ÃÍ£lA”Ñ!ÚÀ'¹­A”Ñ!Ä?`ÿj A”Ñ!Äd Î"ÚlA”Ñ!Ä÷  ü/sA”Ñ!Å`«6+ &(A”Ñ!ÆVÀ ˆ1ï-H¼A”Ñ!Ç> Ç!s A”Ñ!È+àõ~»)]-A”Ñ!Ü_ +R-¦,žA”Ñ!Ü›€g Iö A”Ñ!Üà G8A”Ñ!Ý ?#CJA”Ñ!Ý^@Ú+2A”Ñ!ÞÞ@X AA”Ñ!áµ ‚à¥A”Ñ!áÁà>1  A”Ñ!â>@ 4¼y ÛÞ A”Ñ!ëP ¸%.THA”Ñ!ì#àø-qA”Ñ!ì© ‹+ qZA”Ñ!ì¬àb2çùA”Ñ!ìÚàÛ+/.¡1A”Ñ!î]@€µ"áA”Ñ!îÏÀ4«$íA”Ñ!îØ€ $&¢ÝA”Ñ!ïY h½8ÑA”Ñ!ñs`Æ%³ ÓA”Ñ!ñéÀgÞ +Ï9A”Ñ!òO@Ц,A”Ñ!ò’`¯?*i A”Ñ!òž À,X+ A”Ñ!óA@Q+¨ ã +A”Ñ!óΠû*p¢ A”Ñ!óï »" %o|A”Ñ!ô  ês,çA”Ñ!ö“` %, A”Ñ!ùt@EÉ5A”Ñ!ú×€Q©,@A”Ñ!û à & ë8áÇA”Ñ!û†`£ +o7 A”Ñ!û‹À½6aBA”Ñ!û˜€Î *q +A”Ñ!üé  nÚª +A”Ñ!ý<@ü2ØA”Ñ!ý¦@­0¹ ˜¤A”Ñ!ýæ@ ²+`!˜A”Ñ!ÿÕ  vÃ$ùA”Ñ"i  ” ±å A”Ñ"€7.è  A”Ñ"Ÿ'«!=-A”Ñ"W Û /‚A”Ñ"Šà¼êjA”Ñ"À€u4 bA”Ñ"ZàÔ& ¥2A”Ñ"¨€F'ñ A”Ñ" +Ô®*¨NA”Ñ" /` [ VA”Ñ"  (ê/‰ A”Ñ" +C@1 +Ð'(A”Ñ" 8  _:"ŽA”Ñ" w@ˆ-™(~ A”Ñ" È  °ƒ,º +A”Ñ"  b1ì”+A”Ñ"M…&¹*A”Ñ"+ ã.Ÿ(cA”Ñ"Ô ±6¹$õkA”Ñ"| 8.‡A”Ñ"¦`Ç.ç& A”Ñ"Û€tô GNA”Ñ"Ä q!µYA”Ñ"@&$F7¾ A”Ñ"ï » RA”Ñ"tÀ *wA”Ñ"ð@Ó/f(vA”Ñ"h  ŸLA”Ñ"¯Àç3›A”Ñ" À%f(þ&A”Ñ"&  æ!‹çA”Ñ"j |˜1åA”Ñ"{`´¤‰A”Ñ"‡@ݵ(c +A”Ñ"@ %8 ÆA”Ñ"§f ©kA”Ñ" ?  8A”Ñ"ÝÀéö6ìA”Ñ" Wñ}A”Ñ"˜àv.50A”Ñ") )YÀ A”Ñ"Ç`(\ A”Ñ"Ê  Ì'á A”Ñ" é€ {)i&hA”Ñ"#*€ ÔwMA”Ñ"$= ;5ù^ A”Ñ"$ O<k A”Ñ"$¦àà&  +A”Ñ"%4 $K93A”Ñ"%æ`ç¼+Æ A”Ñ"%ë€ > $~ A”Ñ"&R  ƒ +A”Ñ"&r`Õ+ÓL A”Ñ"&é q4¿)ìA”Ñ"'‚ ‘73EA”Ñ"'«€"ÑsA”Ñ"'þÀóf+›JA”Ñ"( °3g"]A”Ñ"(-à>(ƒ4EYA”Ñ"(‹½j&A”Ñ"(Ò ú%¸7è +A”Ñ"(Ó@õ *$[*`â$ö)DA”Ñ">Á ({q A”Ñ">Äà¢ûA”Ñ"?µ Ã%>-A”Ñ"@oà €Ý +OA”Ñ"Bàk*#3A”Ñ"BYà**H0 A”Ñ"CÀà)Ü^"A”Ñ"C¶`ƒ"bA”Ñ"D@ $÷5'5A”Ñ"D†ƒÂ"˜DA”Ñ"DÐ@Jù'eA”Ñ"F@ T +A/(A”Ñ"GÈ`&ÒÏA”Ñ"HÀç#±:A”Ñ"Inàf!?!CA”Ñ"IÛàa`!A”Ñ"K€  7)·A”Ñ"K +çÎÅ/A”Ñ"LW ±& ˜A”Ñ"M4 R ø¾KA”Ñ"M¶ r+,+qA”Ñ"NàC-t2GA”Ñ"NŒ ,v2'A”Ñ"P1Á4ðA”Ñ"QV€/Ÿ=]A”Ñ"Q¸ÀŽ"ï3^ A”Ñ"Rã}!8fA”Ñ"T 1+çGA”Ñ"UÀ@ ›3"³ A”Ñ"V€–&*A”Ñ"Vl€ý™)AA”Ñ"V­à +›¶LJA”Ñ"WqÀ_^0Í A”Ñ"X<€ )á7„A”Ñ"Xœ â ­0$EA”Ñ"Y[€_3+A”Ñ"Z"Àž,{5m…A”Ñ"ZÕ@Ùä6Ä A”Ñ"[Ý@Ô*¤)3A”Ñ"]·€ sl»\A”Ñ"^Þ@•#gA”Ñ"_‘ zq'_A”Ñ"`€  %!„$r^A”Ñ"`€ z'a_3A”Ñ"` )5F: A”Ñ"`© k!>F$A”Ñ"a3à!šiA”Ñ"aø@Rÿ"†A”Ñ"b4 M)½ËA”Ñ"bs`Ñ/›šA”Ñ"c&@ÉU 7A”Ñ"c4`÷Ux6A”Ñ"dãÀ[$R +A”Ñ"e@ å) ÕA”Ñ"e  *}'lcA”Ñ"ežÀ ·ú/d A”Ñ"fX`c0Ð A”Ñ"gQ@Qc‰A”Ñ"h +iO0›A”Ñ"h€€%¦0Q#A”Ñ"h! ê»!!_A”Ñ"h³ ~jA”Ñ"hΠ¿'\y A”Ñ"hÏQ(Ü â A”Ñ"jCÀ0£A”Ñ"n\àn ¢ ÀA”Ñ"oà~%÷ A”Ñ"ob 2ìë-A”Ñ"oŸ`&2°IA”Ñ"o°`Ö  ! A”Ñ"puû"Í7×A”Ñ"q£  …^A”Ñ"rÆ (eŠA”Ñ"r×àAß6 +A”Ñ"u{ N+H þ A”Ñ"vd ¶Î…MA”Ñ"vÐà@÷7áA”Ñ"w!@n :6A”Ñ"y€r35A”Ñ"z` õS½ A”Ñ"~Xà‡|3ŠjA”Ñ"p€“ÄA”Ñ"  >$FëA”Ñ"€-Ï=A”Ñ"‚4ÀþêA”Ñ"ƒˆ€ÖäÇA”Ñ"ƒ—  âÛA”Ñ"ƒµÀž&ø*eA”Ñ"…æ`æ'š.3(Ëì{A”Ñ"¡•@¯ôìA”Ñ"¢ê .  A”Ñ"£ø õ2±­>A”Ñ"¤àÝ Î'A”Ñ"¤.€ +ëBqA”Ñ"§FÀ¦0`&H A”Ñ"§K@ +{ ¶bA”Ñ"ªKà5è%/gA”Ñ"ªV€ ¿ BA”Ñ"¬& †ÖŠ6A”Ñ"®ÓÀT4ç¦7A”Ñ"¯l w0“$9 A”Ñ"¯¬€ ‹8SA”Ñ"°A@G%ÎA”Ñ"°Œ  (''Ï,A”Ñ"°Ë¸ ˜àA”Ñ"±*`t 3)> A”Ñ"±µ +â'à A”Ñ"²d`¢<.õ1A”Ñ"²ß È/"ù+A”Ñ"³§à I+ÒaA”Ñ"³Ìæ(O,á A”Ñ"´» aÂ+oJA”Ñ"µ‹  I BCA”Ñ"· Àa0NA”Ñ"·`9!ƒ$Õ A”Ñ"·à 6zÒ A”Ñ"·@ U'¨ìA”Ñ"¸ p² A”Ñ"¸-€Â7"ýA”Ñ"¸ÿ ²CƒA”Ñ"¹Î€‚ +if A”Ñ"º`¼"])B A”Ñ"»L@  1RA”Ñ"¼Ý@}0|(9 +A”Ñ"½ÍÀ c+S Z A”Ñ"¾K`‰9A”Ñ"¾„HjÖA”Ñ"¾™ P-7 TA”Ñ"¿g`j!èTA”Ñ"Àx`…$ .QA”Ñ"À‘@Ó3< A”Ñ"ÀÄ`h »¾A”Ñ"Á«€õ‹¼ A”Ñ"Áó ô5|mA”Ñ"Ä2À Æ  ¼ A”Ñ"ÄÊ`é4{!I A”Ñ"ÄÜ€ ×û.,TA”Ñ"Å› 3í"A”Ñ"Æ+€ o )œA”Ñ"Ær¡ ¢&ûA”Ñ"Æç` +ç%7{LA”Ñ"Çá€(\ì +A”Ñ"ÈEàÑ&±| A”Ñ"ÉþÀ&/ø*†A”Ñ"Ê' )ö2(A”Ñ"Ê@`n(̺ A”Ñ"Êt[%ß A”Ñ"Ê~  ªŸ A”Ñ"Ê„€Ð% t:A”Ñ"Ê¢ B&®1A”Ñ"ʹ`: +åA”Ñ"Ëà #ÚZ A”Ñ"ÌÑÀK4VWA”Ñ"Í@—­- +A”Ñ"Ï?À) ¡A”Ñ"Ïø ô +}ËRA”Ñ"Ѐì<#ÊA”Ñ"Ñ DëëA”Ñ"Ñ|Ž0i A”Ñ"Ñ­€PëÂA”Ñ"Ò9´$»S*A”Ñ"Òú ¹4H)ŽA”Ñ"Óœ j™ i@A”Ñ"Õ ›¹ŽA”Ñ"Ö1 „ +ÙTA”Ñ"Ö@îÝ JA”Ñ"×ÂÀí G A”Ñ"×Æ@χ’$A”Ñ"Ø+àvçä8A”Ñ"Ø°`.+A”Ñ"Øþ i(ÈmA”Ñ"Ù‚ÀÁ÷(ÐA”Ñ"Ú +%)¯ëDA”Ñ"Úý¦ !‘ A”Ñ"Û·àÅ%€àA”Ñ"Ûäào"à<A”Ñ"Ü`àOP)A”Ñ"Üm  ;6A”Ñ"Ü–€tæRCA”Ñ"ß )A”Ñ"á@iaúA”Ñ"á ü(É427A”Ñ"åš@YVŽA”Ñ"æÛ@¤/V'À A”Ñ"æã  › !Þ +A”Ñ"çä2 ,+ A”Ñ"ë5à ÓΣA”Ñ"ëV e"j PA”Ñ"ì÷àbŸqA”Ñ"í€ú&( ³A”Ñ"î¯à Úæ. A”Ñ"îâ(à W A”Ñ"îïÀtð5¼A”Ñ"ï< *"ö!1A”Ñ"ï¥à “p +A”Ñ"ðÇ@_! h A”Ñ"ñä@_$EâA”Ñ"ò—¡# Z-A”Ñ"õ€¿/‘6A”Ñ"ø} /‹ ÁA”Ñ"øƒÀv7±A”Ñ"øøà€(ï A”Ñ"øû€i! CA”Ñ"ùŒà103A”Ñ"ù¨` É%ì A”Ñ"ùÅÀ <AA”Ñ"ùüà$0/Ê +A”Ñ"úç%3&FA”Ñ"ú¸€=)»A”Ñ"û€O0H1ÈWA”Ñ"ûAà,( ;A”Ñ"û×à +Ü"ú +;A”Ñ"üL`öïA”Ñ"üj 1/B>A”Ñ"ýk@9-¡&46A”Ñ"ýäà +z)/#jA”Ñ"ÿ‘ 5+?A”Ñ#œ /A”Ñ#c@Æ"× +A”Ñ#]à 2ª5×+A”Ñ#í@##ÝŒ5A”Ñ#|@Y =A”Ñ#â@Ù° +Õ A”Ñ#á€é ú+A”Ñ#Ä€ ÀéA”Ñ# O@âs4b A”Ñ# o@w_Ð A”Ñ# ð€ù%A”Ñ# +kÀGA”Ñ# `a ª)àNA”Ñ# 9` +`"¢3èšA”Ñ# NàÃ¥ƒA”Ñ#5àú0ù A”Ñ#°@÷#«2ZA”Ñ#>`ˆ…‚pA”Ñ#P š%ÍA”Ñ#|*úA”Ñ#à9 @ Ç A”Ñ#.DsA”Ñ#  þ"( A”Ñ#j@ +Æ)£)A”Ñ#¯`ö(™ +A”Ñ#Å Þ L2/ A”Ñ#Àæy; +A”Ñ#iÀýš)A”Ñ#@ ¿,0ÃA”Ñ#1€ä#õ'IA”Ñ#t +b^7ÐA”Ñ#À€V«ž"A”Ñ#/à½2±^A”Ñ#H€<(ÀÆ A”Ñ#)` #qê‰A”Ñ#“ Ð0²#A”Ñ#n Ò%×5A”Ñ#†@ ñ +ÈA”Ñ#—€ÆB&ý'A”Ñ#o` +öU4ý A”Ñ#ï@V\:A”Ñ#ñÀ6× A”Ñ#öÀ ð  ,A”Ñ# ä ž1P)ô A”Ñ# ñÀ6+S2L€A”Ñ#! +.‡ á A”Ñ#!~@× 05A”Ñ#"NÀý-/XVA”Ñ#"`’,q0A”Ñ#"À>ã š.A”Ñ## R$X#$AA”Ñ##€ $i‹ +A”Ñ#$ʽ67A”Ñ#$’€5+ÙWA”Ñ#$éà±Q%™A”Ñ#'“@ 1k% A”Ñ#(ä@ +Ê$A”Ñ#*ìz Ý01 A”Ñ#,eàÇ(O× +A”Ñ#-ßB-Ç(^‚A”Ñ#.À 8%= #A”Ñ#/F`À£ A”Ñ#/p`ª1$ð A”Ñ#0Å` +Ý#‘1É +A”Ñ#1 Å0#:A”Ñ#1èÀ Ìï'4€‚'È-Ê +A”Ñ#>½À¡0â A A”Ñ#?€r#7 A”Ñ#@_ g¢2û A”Ñ#@b Š#­5"A”Ñ#BÂàñïú +A”Ñ#BØàŒÒ  A”Ñ#C´&ÍA”Ñ#D   +Òi. A”Ñ#FgÀ.3ç¨PA”Ñ#Fˆ€ˆ,Æ,þA”Ñ#F Ãe![0A”Ñ#FÇÀ¤1$A”Ñ#G? MÇ…A”Ñ#Gý`¸*A”Ñ#H±àM-@$= A”Ñ#J` d!J w A”Ñ#Jm@0pA”Ñ#K@è3)% A”Ñ#Kcà Ç“2Ï A”Ñ#L£ Ž+ä*A”Ñ#Mr26ûA”Ñ#Mx€¡»A”Ñ#M” ¯¿2A”Ñ#N×€Ü6„ì¶A”Ñ#O©à%`×A”Ñ#Oéœ#qþuA”Ñ#Oñ@·.µÁ2A”Ñ#P¥ š3ñùA”Ñ#Qh F H'µA”Ñ#Q` +?á+Æ +A”Ñ#R@E #A A”Ñ#Tà µ Ð öA”Ñ#T7`&#c A”Ñ#TE€Q/«*ê A”Ñ#T¬`¯05þ"A”Ñ#T®`+'Å A”Ñ#Uhà œ *>)A”Ñ#Uš @Ì(Ø A”Ñ#U¶À +› ­ §A”Ñ#V  ÒM3A”Ñ#VßàFà A”Ñ#WÂ`S(Ÿ  1A”Ñ#X3 §z/ÈA”Ñ#Xvë/y +A”Ñ#XÍà,)é&ƒ†A”Ñ#YV  +U +”A”Ñ#]¶ ik —.A”Ñ#_ €Ã2÷%ÒA”Ñ#_À +1#o'…A”Ñ#_Æ +%Ïé A”Ñ#`qà0N++A”Ñ#`Ë |xµA”Ñ#aù€%o–A”Ñ#b¿ Ë$©+» A”Ñ#c¸ ÔT#AA”Ñ#cÎà¬"í} A”Ñ#dà8 ™(JA”Ñ#fù€ (&…"> +A”Ñ#h•à Å uA”Ñ#hº€b!c!eA”Ñ#iTà '"A”Ñ#kà ý%‡vA”Ñ#l¦ —‹ÈA”Ñ#l±m$BRA”Ñ#m… Ú%rºKA”Ñ#m™8 òA”Ñ#n® –Ê A”Ñ#oMàÄ,÷ ¾A”Ñ#oŽ` 2¦%Ç A”Ñ#pR  $2¶¶A”Ñ#p•YA”Ñ#q!`Ï)¸-A”Ñ#s`ÈnŒÌA”Ñ#sz@H¹7d +A”Ñ#tp j¤mA”Ñ#u1€"âA”Ñ#u„€>}$xA”Ñ#u¥ ò-*[7A”Ñ#uÛ€³÷!Á A”Ñ#v + Ü4‡+A”Ñ#x?@d"8 aA”Ñ#xvà7m#vGA”Ñ#x©à '"Ú6à A”Ñ#y €!— ; A”Ñ#y-€(*ÐA”Ñ#y‡` \,Î7A”Ñ#yËÀ# ¶#A”Ñ#z´ ­-æ1¡^A”Ñ#|P`"ñ*ÏA”Ñ# àˆ)mWA”Ñ# Õ/!MA”Ñ#yÀ Áò$30A”Ñ#‚” à%:.ªA”Ñ#‚¢à.… A”Ñ#‚¶À£d* A”Ñ#ƒ` £5ìA”Ñ#ƒf@ 0E"^A”Ñ#ƒl€ èœA”Ñ#„A@>.H(2A”Ñ#…`õ%1ÐOA”Ñ#‡ž`r0(~A”Ñ#‡¥€ç +8/A”Ñ#ˆ@ 7;` A”Ñ#ˆ¨à _ A”Ñ#‰[ ¯"(ÝA”Ñ#‰¥  n+å8A”Ñ#‹CÀG.·# +A”Ñ#‹P@û/A”Ñ#‹Ú@C!Ÿ2A”Ñ#Œe Ô'2ºA”Ñ#ŒÉ€‡Ÿ(’ A”Ñ#Œÿà ò.8+úA”Ñ#6€ã +A”Ñ#ñ ¢3 !6A”Ñ#E€ ž/Ÿ +A”Ñ#m Ò(~ã A”Ñ#“H`¢®\A”Ñ#•À.äA”Ñ#•²@ð • A”Ñ#•ßËF5ZA”Ñ#–†`OG"A”Ñ#—o€ n!@&R A”Ñ#˜•@ +Î'Ë&fÖA”Ñ#™/` +f Ù9A”Ñ#™Æ@£"*ÄA”Ñ#šR€  x¼ A”Ñ#›Ò@”¸ÅA”Ñ#›ð@î ýrA”Ñ#œÀ¿^A”Ñ#œûÀV.àA”Ñ#a ;1¬A”Ñ#Ô ë/!Ã:A”Ñ#ž n!ÑÜA”Ñ#ž]`$º0Ö.A”Ñ#žº€&¿A”Ñ#Ÿ@W’| A”Ñ#Ÿ¦@Ð3*SA”Ñ#ŸÜÀ ( +)¯qA”Ñ#¡2ÀŸ* +A”Ñ#¢Høp-[A”Ñ#¢‡@ˆ +[+ºA”Ñ#¢Ó@ .R/Ä A”Ñ#£| A/*Î6A”Ñ#¤5 ¢!0A”Ñ#¤ËÀS/ƒß A”Ñ#¥“ÀÐ Œw +A”Ñ#§Ý ¾¢@ A”Ñ#ª!@D+% A”Ñ#«Ù  +â^À²A”Ñ#¬Nà7eá A”Ñ#¬d »0AA”Ñ#¬n ÿ-´› A”Ñ#­ô ·3Úô +A”Ñ#¯ @¤0–ØA”Ñ#°, ®øýA”Ñ#±1€oi’ A”Ñ#±j€¤)Ã+A”Ñ#²‡ÀÉ/A”Ñ#´š«%»7‚èA”Ñ#µ®À\Ý5:A”Ñ#¶, I¶ëA”Ñ#¶Ù `V4° A”Ñ#¶ý anA”Ñ#ºI€Žf -A”Ñ#º”àm +Š A”Ñ#¼È 3(ÔA”Ñ#¼÷àô.ËŸ +A”Ñ#½D Y"ô( A”Ñ#¾É€ ²æ&;.A”Ñ#¿‚ +Ý!ù,å A”Ñ#¿¡€3h"ïA”Ñ#Á¤ ]"Ë7A”Ñ#Áä`Â6%heA”Ñ#Â2à daã A”Ñ#Ã,À)fe A”Ñ#ÄWæ1 òA”Ñ#Å^€Uí0Ñ A”Ñ#ÅÞ`þÁA”Ñ#ǽàäX6A”Ñ#Ê +Àí)¬A.A”Ñ#Ê- *W%% A”Ñ#ʘà +Ø£2#}A”Ñ#ËJ 0 ¶pXA”Ñ#ËWÀpΆ A”Ñ#Ë£b‰µ A”Ñ#Ì~à”)ðŸA”Ñ#ÌÕx A”Ñ#Ìê ,‘-ÚA”Ñ#ÍÀ%b , +A”Ñ#Í× #Y+m A”Ñ#Î2 â–#;(A”Ñ#Îå »ÙqâA”Ñ#Ï ¦ F)‰PA”Ñ#Ïpà ++++Ç +A”Ñ#ÏàE3•ÖA”Ñ#ÐQ ¾-daA”Ñ#ÑN@–Q· A”Ñ#ÑÄ`ÞÉ1Ü +A”Ñ#Ò# ´1æA”Ñ#Ò¡½!xA”Ñ#Ò¤  ïþA”Ñ#ÓŽ€Þ*À3V A”Ñ#Ô<€@ y·+A”Ñ#Ô¶ %2¡A”Ñ#Ø.àï"µ}A”Ñ#Ømàs ù±'A”Ñ#Øœ7· A”Ñ#Øä Ò-9²A”Ñ#Úd i{º×A”Ñ#ÛDÀ‡†* +A”Ñ#Û¦1Â-~'A”Ñ#Ý€,'(: A”Ñ#ÞI@ Q¥ ®A”Ñ#ßÀ S.¸A”Ñ#à-`³¨$ÇA”Ñ#àrÀ Ü5¥$|A”Ñ#â°` +Å •(x A”Ñ#âúà +Ö(:$‰A”Ñ#âý ;¿%|$A”Ñ#ã+  £€¦A”Ñ#ãjÀæ*'PA”Ñ#㜠¦%̶A”Ñ#äkµxÔA”Ñ#åË@ë •%A”Ñ#ç¤À°5 ¥+A”Ñ#ç­` )ò® A”Ñ#èë  ´)Ì •-A”Ñ#é7€ ;5A”Ñ#é[X°A”Ñ#éÕ@œÙŒ]A”Ñ#ë…@ Ú ÌA”Ñ#ëžÀOk0A”Ñ#ëÄ`& !Ò A”Ñ#ì+@a&ü +žXA”Ñ#ìE &Ã[A”Ñ#ìq`c* A”Ñ#íD 8$Ë1? +A”Ñ#íÙ  "£7 A”Ñ#îÆ §é$XA”Ñ#ïà +6tÛ A”Ñ#ðS@€)0£ A”Ñ#ñYµ2eAA”Ñ#ñz€x!€A”Ñ#ñÿ@'Þ!ùA”Ñ#ò.À ”[ A”Ñ#ò® Ú8ßGA”Ñ#óÙ"«A”Ñ#óý *q A”Ñ#ôÝ ©+…$ïA”Ñ#ôÞ€ +Ë$HÈA”Ñ#ôö`S,ž&{*A”Ñ#ö è(ˆ Ÿ +A”Ñ#öq ]×™A”Ñ$˜  y+Ä@A”Ñ$ÊÀ² +¦A”Ñ$ÀXVŽ2A”Ñ$ÀË6DA”Ñ$f€ !6PXA”Ñ$ª ~0Ç"ÞA”Ñ$œ@ ˆGÙA”Ñ$`.-! +A”Ñ$¢àn‚4A”Ñ$ðý¨&AAA”ÑS´` +ò +OA”ÑSµ/ X³ ŸA”ÑSµh <%P7 -A”ÑSµÜ@É4¹%%A”ÑS·' +È*! A”ÑS·8 Ö›YA”ÑS·§ Çö-Š +A”ÑS¸@Ù&—3A”ÑS¸–À ú§PA”ÑS¸ü@¼,4 A”ÑSº_€T+?QA”ÑS»Sà¯Q!uA”ÑS»‘`7À2A”ÑS¼eÀ :'·?A”ÑS¼o +âí A”ÑS¼¯@†&{"A”ÑS½ü@ ú"Ì v A”ÑS¿J`ë>AA”ÑS¿yàÔ±&k +A”ÑS¿í` r-ŽA”ÑS¿òÀ ±.ÝA”ÑSÀ !Ë0ÙA”ÑS #Ö‡A”ÑSÊ 'ö4¥jA”ÑSá€@7Š + A”ÑSÄ @Ó$ +A”ÑSÅ@ ©Ï–7A”ÑSÆ€œ/æ1GA”ÑSÆÙÀ± ÛþA”ÑSÇ> AtýOA”ÑSÇ•`' +•%¼ +A”ÑSÇÄ Ö8ÒÍA”ÑSÈ1  iÏA”ÑSÊB€7p A”ÑSËÀŽ3Î'ö)A”ÑSÌ®à Zîq +A”ÑSÍ´ -D#b A”ÑSÎë (Ù²#A”ÑSÐà÷ @A”ÑSÐo` +H&WA”ÑSе` +±Û„A”ÑSÐà@w19"A”ÑSÑ–ÀGA”ÑSÓN@V3"TA”ÑSÓd` f!lA”ÑSÓoÀõ'Ì:A”ÑSÓ ®D NA”ÑSÔ CÉ"‚A”ÑSÔ=€ Õm"-A”ÑSÕŠ ÝŒ HA”ÑT.!  U{ " A”ÑT.I€Õ#è"{ A”ÑT/ýà PTóA”ÑT1/Š$`÷A”ÑT1F ­ï|A”ÑT2”àr žk A”ÑT37@`"Ð,ï +A”ÑT3`Ðwè|A”ÑT3¶@RvÑ/A”ÑT5°à.+Ä2A”ÑT5Ý — +@$®A”ÑT6³@ •"´é%A”ÑT6³à)f —ƒA”ÑT7ªÀ1XlA”ÑT7åÀÄ ¸A”ÑT9 š( Š?A”ÑT9c ]ö A”ÑT9| äŸ#%TA”ÑT: á/¯9 A”ÑT:{@A(|/bA”ÑT:½€3?+$A”ÑT:ÖàÝ•"ÍlA”ÑT=×` õ“ØA”ÑT=ã#‡A”ÑT=õ€.@1è A”ÑT>š@¨&à A”ÑT>· F¹"ZA”ÑT?À é~]A”ÑT?ÏÀi$*ÄA”ÑT?éàê! A”ÑT@Ê@‰ñ1˜A”ÑTC¿@‚ü A”ÑTD] ÊH(A”ÑTEÌà½(Ô *eA”ÑTEáÀL2(ä +A”ÑTFÌà×$– ¼A”ÑTG& ;4÷zA”ÑTGà¶6f&×RA”ÑTG»@ ü¿-kA”ÑTGãÀ¥åÕ*A”ÑTHÀ+ÊA”ÑTH€€_$XÎ A”ÑTI€@½ö%¯A”ÑTIò` j-Û%× A”ÑTJ À +ÿS7¾LA”ÑTJŒàVÜ21 A”ÑTJ§ ŠÏ— A”ÑTK: Ñ c A”ÑTKU § î"A”ÑTK^€ º +Õ½A”ÑTKë ½ —Š>A”ÑTKë@“".4 A”ÑTMj 7C0MA”ÑTN? ÜÝ60çA”ÑTQ\àÑ* ! A”ÑTRƒàq#øŽ A”ÑTR¤`Ä2ˆ%¸A”ÑTSYÀ +Ñ%5ZA”ÑTSå~(¼ A”ÑTTO@ +ë5a A”ÑTTÈ`é1“A”ÑTUˆ@;..1A”ÑTVÀàG"‚í A”ÑTW.€ÍŸ ö +A”ÑTW?€ûd]A”ÑTWo I4Ö] A”ÑTW—`V4¡<A”ÑTWÜ %5wÂA”ÑTX¹ ÷'ðA”ÑTXÆ@%59¼A”ÑTXÛ /Ì!]A”ÑTYJ`£4.6A”ÑTYP ø r—A”ÑTYu@Óø&·[A”ÑTYx` U*ÏŒ A”ÑTZ`˜WúQA”ÑT[7àè.|%¬ A”ÑT[ù 2ÕA”ÑT\n˜T%Ð A”ÑT\ò` œ+¡5A”ÑT]N`é §/A”ÑT]©àKŸ/A”ÑT^’ Ý,•ØA”ÑT^¶ ®1÷œ'A”ÑT^ÕG!ßA”ÑT_kM1A”ÑT_‡¼4±-AA”ÑTbÀ´$þ#œA”ÑTbk` ·ú5‹GA”ÑTb´@3\¡ A”ÑTcàã#.-Â)A”ÑTc¬ jÝ*1 A”ÑTcЀ Ç'ö(;A”ÑTcß` +‹žIA”ÑTdÈ@Å A”ÑTe.`®ÙËA”ÑTe<@(• +á-A”ÑTe@ ‚$iA”ÑTeà ¨&«&Œ A”ÑTf 0#A”ÑTfa2 |C¬A”ÑTgŽ ¹ ‡VA”ÑThç ó !‰A”ÑTi³F&ø8g +A”ÑTiä`‹(â#: A”ÑTj­à µ+'‹mA”ÑTjÑ  ƒ+º$1 A”ÑTjØ` ,t.˜A”ÑTkG u'hO A”ÑTk À3 &FA”ÑTlÎÀV&Ø)| A”ÑTm@ ~$ÈA”ÑTm!àQ3$) 2A”ÑTm5@ÿs£A”ÑTn4àÄ $ÕA”ÑTnÐ »ä =A”ÑTo àP ´ A”ÑTpâÀu |.fA”ÑTqR@J ÒÒ1A”ÑTqUÀŠ¸4A”ÑTrË@.& Ý A”ÑTrÑÀê# A”ÑTs%À¢%ö ±A”ÑTsâ€v6W!5A”ÑTt‹à .1 ¿ A”ÑTt » !&öOA”ÑTtø` ~%šA”ÑTvvײ*ôA”ÑTv—  ª/î +A”ÑTy³ 7¬Â:A”ÑTyÓ b & A”ÑTz<à Ó'µxA”ÑTz¯àÄ-xA”ÑT~+E5‡&iA”ÑT~Ñ€ +La1ø A”ÑT a ßA”ÑT€ö à+ A”ÑT¯€ öÝ%A”ÑT‚ÇŸA”ÑT‚äàñU(aNA”ÑT„  _ ‚ +A”ÑT„o  /5ä5A”ÑT„ç)«#ÉA”ÑT…^ v14$×A”ÑT…b€ ]w zA”ÑT†­0öW +A”ÑT‡Ñ@D#ˆ A”ÑTˆÕ€ + sð[A”ÑTŠ Àe4ç-]'A”ÑTŠyÀ[ zA”ÑTŠ¡€áY Ã/A”ÑT‹Š 6+ß A”ÑT‹Ã€ X!8'XA”ÑTŒ*` +é5SédA”ÑTŒ2 » ¾+z A”ÑTŒô€ Ú0•%,A”ÑT™€ 4*îlA”ÑT¶@”19 ¼ A”ÑTÊ£!Ç"’2A”ÑT‘«` hg2lA”ÑT’Ààšd'ö A”ÑT“ e,ˆ! A”ÑT“£à •‚/qA”ÑT•9à=i “ A”ÑT•=àb.ÈFKA”ÑT•K@J¤®mA”ÑT•á@‰1gA”ÑT–K€˜;,p&A”ÑT–u Y«FA”ÑT–úÀû$…A”ÑT—ÀŸ5ÌA”ÑT—à'.-¬ A”ÑT™[€/!ŠA”ÑT™ÃÀ° ¡g A”ÑTšøàD!Ñ-ÑA”ÑT›( g‹Ñ A”ÑT›/  .,“!A”ÑT›\@al)ÃA”ÑTœ4  +#(¹/s +A”ÑTœÄ`%(x7 A”ÑT« !*‹$A”ÑTž  C+RA”ÑTŸš`ßØ!Ó@A”ÑT jÀ ã%é +cA”ÑT ½`Ä'Ð-A”ÑT Ì 5!¼$A”ÑT¡w #ûA”ÑT¢d tCiA”ÑT£Ò€£2âA”ÑT£Ó ÆvN A”ÑT£ýàØ2|6A”ÑT¤÷`N4ì%HA”ÑT¥Ì@ +Ü9%.A”ÑT¦À ("6A”ÑT§– Ÿ+ø ˆA”ÑT§ÛÀ&'A”ÑT¨8  I o A”ÑT¨Uà~#÷$E +A”ÑT¨€ X]P A”ÑT¨”Ào³!ü=A”ÑT¨Ÿ †E#3 A”ÑT¨Ú€ ;4ñÓA”ÑT© ž'?/ÿbA”ÑT©C€ë,XxEA”ÑTª 8i&™&A”ÑTª)à Íê .EA”ÑTª’ ¶‚+HA”ÑTª¯  • .ðA”ÑTªéàpÐ)A”ÑT­€žÈ¸oA”ÑT®|Àì"ò7A”ÑT®Ö í +Þ"DGA”ÑT¯“ÀË"A”ÑT°« ¦2ïJPA”ÑT± /„æ A”ÑT³` É%­ƒA”ÑT³‘ÀÁ%ÞËTA”ÑT³ç`¸!Â& A”ÑT´Uàh0*š A”ÑT´`1-åBA”ÑT´°@²!ãµA”ÑT´ì€¶#r#lA”ÑTµ8À Ë ÂA”ÑT¶€é)úA”ÑT¶X` Žö"vHA”ÑT¶{À¦ LA”ÑT¸9`Å×}*A”ÑT¸|àK'ÿ8FA”ÑT¸¥HÁA”ÑT»å Bµ®A”ÑT¼~`s0ÌA”ÑT½À ó$ûCA”ÑT¾È€ ³," ² A”ÑT¿~Àü0»`A”ÑT¿ù€‚5)Y?A”ÑTÂC E*Ê0 +A”ÑTÂä`™*°cA”ÑTÃ`,¤&ÊA”ÑTÅŽ  %6 ~A”ÑTÆ6 ß#5qA”ÑTÈ æ½#žA”ÑTÈ'` ÀA”ÑTȨ€Œf+KNA”ÑTÈ÷@ 1H,Ù A”ÑTÌ `z#* +A”ÑTÍ! ºk&ÛA”ÑTÍK@ â1¸A”ÑTÎÄ@Fð¿A”ÑTÏ 10€äA”ÑTÐ{@£&¶ X!A”ÑTЀ€TÀ !A”ÑTÒªÀFÓ¾A”ÑTÒÉ€£.#"W A”ÑTÓJà ½(É0…MA”ÑTÓl€}&™ åA”ÑTÔ,`+-2#Ú:A”ÑTÔ  ü8!à7A”ÑTÔÂ`™.s²,A”ÑTÕyàs]6QA”ÑTÕ€`5½-€7A”ÑTÖe€¶‡#Á A”ÑTÖ´€ £Ý3A”ÑTÖØigß A”ÑT×/ 2±3 A”ÑT×/@r*·ÝPA”ÑT×çÀ*òA”ÑT×ñ@Ó46´ A”ÑTØ\€.1-,hA”ÑTÙ6‚#¡A”ÑTÙw  ¦5` A”ÑTÛ™À †}$ûA”ÑTÛë` Š–õA”ÑTܱ ¦î)A”ÑTÜù€øƒ0ÏA”ÑTÝD  $OL5A”ÑTÝ–àâ Œ+A”ÑTÞ¦À¤4#•A”ÑTß` ¼ ù(bA”ÑTßE€á +´+ùA”ÑTßX€ ”/3A”ÑTáÎÀö0ÚEA”ÑTáÝ15;‡ A”ÑTâä9'Ø A”ÑTãh  +öw5¹ A”ÑTãØ€9o;A”ÑTäšà¤³.A”ÑTä­€:!û-À A”ÑTäæÀS)î(Ê A”ÑTæ¸ …3ÝÀA”ÑT盀*“,Ú A”ÑTçû QÝIA”ÑTèÀH)(Þ A”ÑTê „(h!ƒ +A”ÑTê x5+PA”ÑTê@ 6,å‚ A”ÑTë/€áÔ"Ú +A”ÑTíS ®˜-K A”ÑTí¡@w#9- +A”ÑTíò <|"IA”ÑTîL`\a%OA”ÑTîÆ` 84ó#H#A”ÑTðÀ Ð*Á!¶ +A”ÑTð‚@ 8 0"A”ÑTðê ß%'’ A”ÑTðñ  +j.ZVA”ÑTñ| »)À A”ÑTó2à ¤{78,A”ÑTó¢ ¬´-0 +A”ÑTôG@Æ.z +¹A”ÑTôc@=¿Ñ9A”ÑTôêàùŸ °A”ÑTþ` †OA”ÑTþoTj N A”ÑTþp`ø%*A”ÑTþw  5Ô{ A”ÑTÿ}À”+?!ì/A”ÑTÿÜà &ý$A”ÑTÿñ Vð +* A”ÑUA@Ã-á¯,A”ÑU€$CA”ÑU& Ð+’ê +A”ÑUp #«,£\A”ÑUœ Â#q7.PA”ÑUt ( ’$Æ +A”ÑU„ :… A”ÑUb` XA”ÑUiàu ­-æA”ÑUÀOÁVA”ÑUß ©éÄsA”ÑU«Ã&¸µA”ÑU à;Ç(øA”ÑU |À +\_»A”ÑU +.๥ + A”ÑU +:`E$N'A”ÑU +Ë î `'¦A”ÑU   ÜÈ#¾ +A”ÑU SÀ #)<%A”ÑU € yRŒA”ÑU LG!1 A”ÑU ÛÀ& *A”ÑU àË°ž4A”ÑU . %"ã#ò5A”ÑU w g!9NA”ÑU ¦Àü@+A”ÑU Î`ô5ïø +A”ÑU@`®1/ A”ÑUŠ Ý +†A”ÑUÕ€6ló A”ÑU¡ ‡ ScA”ÑUGàù,”– +A”ÑUŒÀ0ñA”ÑU, Ñ/SÐBA”ÑUÊj»/FA”ÑU{Àí+ðóA”ÑUØ€A%d#efA”ÑUð  ‹¬.ðA”ÑU„Æ'Ë(JA”ÑU ͺÁ A”ÑU=Å ŠæjA”ÑUg`—+œ2$A”ÑUÅ W ,A”ÑUÑÛ˜ò(A”ÑU>€±²$éA”ÑU­` 5.;A”ÑUà@ä7,4A”ÑU$¿G( A”ÑU‘`ª8"l¦A”ÑUÍÀ ó-2ò A”ÑU,`6~Ô A”ÑU @m%V.A”ÑUr` 7Ç6d +A”ÑU`. '=ÎA”ÑU:€ Þ(q©rA”ÑUjÀ3&¢" sA”ÑUã@ "#èÙA”ÑU8à )ê/üA”ÑU’+ZA”ÑUó  €¸A”ÑU!³à< ®)A”ÑU!ôà*)©!ºA”ÑU"UÀ *§)WA”ÑU#   +V€(ÀA”ÑU#` +a è18A”ÑU#Š€g4€B +A”ÑU#±©v2ƒ!A”ÑU#ð v!0ŠA”ÑU%ËvR*A”ÑU%ÀHÅ8¼A”ÑU%ò`".R*O A”ÑU%õ`S!T/8A”ÑU&n lÜ)S +A”ÑU(6  Ã.øü A”ÑU(ƒ’#O"‰A”ÑU*' ¶/A”ÑU*Ò€?.+5A”ÑU+£Àë­ÛA”ÑU,. J€!A”ÑU,6G6s7A”ÑU,O ª&ñ÷A”ÑU,à} @A”ÑU- ù ,ÂA”ÑU-=àì @7À@A”ÑU-¤Àñ¶; A”ÑU.! óB-ñA”ÑU05àS )VA”ÑU0—À +$ ÅfA”ÑU0Ú@H&dµ A”ÑU2>€*)Wß +A”ÑU2UÝ 7'• A”ÑU2Ö ¶ Éo A”ÑU3] x*16NA”ÑU4  %žBA”ÑU5KàBÈ"A”ÑU5V€ Œ"§A”ÑU5Ï€a% A”ÑU6:@Ó£)dA”ÑU7¤` +p*> ÏA”ÑU7ÄÁ,û)0A”ÑU8:À÷+‡2†A”ÑU8l )”A”ÑU9Ê`J$’)ÒA”ÑU:ÿÀ 8A”ÑU;%À1ÆL +A”ÑU<š€x$&àA”ÑU=ˆ` +§-˜A”ÑU>Tà˜‡*ÏA”ÑU?) ä ~ A”ÑU?CŒ'? A”ÑU?… DÄ +QA”ÑU?¤ %Ñ)Ó A”ÑU?¯ -ý$àA”ÑU?Ç€ /% „A”ÑU?ꀪ!32 8A”ÑU@à×,â(ÓaA”ÑUA4  #,õ1T A”ÑUBI`›#Æ  A”ÑUBËÀeÎúA”ÑUC- /ÒmGA”ÑUC©àÔ(¨'© +A”ÑUCÔ€ ý:. A”ÑUCí )ê mA”ÑUGŒÀèZ:"A”ÑUGà>80…A”ÑUH@ +µ,ÈA”ÑUH÷ í{%.A”ÑUI$À [8-,A”ÑUI2À(u ÃA”ÑUI>à˜[A”ÑUIZàÜ[ +A”ÑUI[ S ™ A”ÑUJ, É0ª*P A”ÑUJ¸ 3 !'A”ÑUJ¿ ÜÊ+tA”ÑUKy`‚-ÝŒxA”ÑUL®™ü#=A”ÑUM ‰ pWRA”ÑUM Ç2ßUA”ÑUM-ÀZê¢lA”ÑUMÔ@¢4)Ì A”ÑUN¿+ !{A”ÑUO] £#7}&A”ÑUOÜ`n3| A”ÑUPk`…Dô/A”ÑUQ + °EšAA”ÑUQ†à9 $ª'A”ÑUQž€ Š3b!”A”ÑUQ¯` š%°˜*A”ÑUR`à5Ðy(A”ÑUR¦`$#8A”ÑUSC é, _qA”ÑUSï ÂJ™$A”ÑUTËÜ"w&§A”ÑUTÜà +×P{0A”ÑUU ô¼&º A”ÑUUˆ ­W5#A”ÑUU¸ý/Ds A”ÑUV€¯ — +A”ÑUVFÌ—l4A”ÑUWªà1!…"< A”ÑUXV€ =˜+'A”ÑUXy !2S*A”ÑUX¶ ¦(4$A”ÑUX ß"2 A”ÑUYÖ€m e2‹ +A”ÑU[là.è­A”ÑU[Ë`é"Ø A”ÑU\àH.ÃñA”ÑU\­`$|1Œ +A”ÑU\å`ê I%}fA”ÑU\ó@ Ù& ©/¬#‘|A”ÑU^ò€ º Q,;A”ÑU^ó   ÛA”ÑU_4À5¼2© +A”ÑU_‡ @5 +SA”ÑU_ð€71Æ[ A”ÑUat  +&éQ8A”ÑUaìÀË"j +½A”ÑUc8 ¬,È\A”ÑUc”àØ3($  A”ÑUdSà +õ0¯¤A”ÑUdsÀ¼ +ïUA”ÑUdÖ€!×30!A”ÑUe ,²æA”ÑUeà !Ï!$)A”ÑUe-  Ç©AA”ÑUfT Ñy4)A”ÑUfm s Ç §6A”ÑUgWD ÐÝA”ÑUh(`K V*²A”ÑUho  â7ñ ˜ A”ÑUix Ô)% /A”ÑUjK`!Ê&J +A”ÑUjß  '2pbA”ÑUlZ %@A”ÑUloà¸é'NA”ÑUluà +í3㦠+A”ÑUm4 °8¤NOA”ÑU©A  &µÊ(A”ÑUª„àÏ ÖHA”ÑUªÊà,2¹ A”ÑU«AŸ/@ß A”ÑU«JÀÍÜ(µA”ÑU«Ç@ Ü TMAA”ÑU¬úàÅ7&†A”ÑU­ Ž2Ó+)A”ÑU®@S à .A”ÑU®Ú@u© %8A”ÑU¯Ðàô4m@5A”ÑU°-À³ó*KA”ÑU°Ã€ ¹IA”ÑU±¨€lYA”ÑU²€“.ÿA”ÑU³ÀkA”ÑU³`y&d ÎA”ÑU³a …3ð,f A”ÑU´F —ú$¬A”ÑU¶Ô` ˜ A”ÑU·z@»Å "A”ÑU¸?è F/` A”ÑU¹L`C-C"­ A”ÑU¹y !{;A”ÑU¹„ [OåRA”ÑU¹ÆV‹"b8A”ÑUºS` )û ÑA”ÑUº¬ ¿ +A”ÑUºÝ`i 0ûA”ÑU¼OÀÒ L5A”ÑU¼œ@o¹ A”ÑU¼· ì +1?A”ÑU½ï`7 sª^A”ÑU¾Ü ( (  A”ÑU¿À +Û ¹0É?A”ÑU¿ÀÀ]*o A”ÑU¿ÏɃ5†A”ÑUÀ¡àZ€*= A”ÑUÂJ@ ±q2—A”ÑUà ” ± A”ÑUÃn`!”A”ÑUæ Ä#A5–A”ÑUÃÔÀš1¸aMA”ÑUÄ« ž³2%A”ÑUÆ /-D3A”ÑUÆH`ŽŽ$PA”ÑUÇIÀ ;(Ÿ+mA”ÑUǼ@µ! î A”ÑUÈàq!×,Ú A”ÑUÈq€S6_&N A”ÑUÈÒ` ª*âç(A”ÑUÉp`}Ë#· A”ÑUÊ  ¿ ‘A”ÑUÊ@9=!^YA”ÑUÊ6€j p*àA”ÑUË sœ'6FA”ÑUË< +ä.à(pA”ÑU˯Àñ«³ A”ÑUËÜ ¥Î$UA”ÑUÌyà !$ý˜3A”ÑUÌ× p‚%ÚA”ÑUÌà  H5kjA”ÑUÍñÀ‘$ÊA”ÑU·@ ßBÐ A”ÑU΢€¾&Ü’A”ÑUÎÊÀàq0 A”ÑUÎï Ø--"V A”ÑUÏY G«)ÄA”ÑUÏÈà +w/ˆO7A”ÑUÏÔ`2r+JA”ÑUÐÀ7 |ÂA”ÑUÑs€Í*kÙA”ÑUÑ… j,/tA”ÑUÑŒ€Z+%_A”ÑUÑÖ ða')=A”ÑUÒ’€ +yÕ0=A”ÑUÓÌ ´¡ A”ÑUÓ~`{½%¾8A”ÑUÓ¡` p 'A”ÑUÕ-à3:;6A”ÑUÕ2àCÏ0A”ÑUÕHà.2Ù A”ÑUÕo@¸ +ýç A”ÑU×±à7ÌA”ÑUØ €äWB?A”ÑUÙ·à5 +A”ÑUÚN`9ç6qfA”ÑUÚˆ Û† +ïA”ÑUÛC€Â†Z&A”ÑUÜ8 Ô0üS A”ÑUßr@p!ä1³ÑA”ÑUß÷À´ ´3ˆ A”ÑUàí Ì$P#ÏA”ÑUã‚` öíA”ÑUåРG<UA”ÑUåë€Á*Ù ` A”ÑUç{ˆ!û"­A”ÑUç®` °Á2A”ÑUçÿ`Í$¯/A”ÑUè®à¶ ÊA”ÑUé©`»Y%l A”ÑUêô Ñ#—4` A”ÑUê÷@, (ùAA”ÑUëº +(èRGA”ÑUë¿à܉¸ÁA”ÑUí' [  A”ÑUíÀÎ ¹G A”ÑUí> ÿ2­" A”ÑUíE æ YA”ÑUíÂ`Œ ‹)AA”ÑUî„  +Q#M0"A”ÑUñ q!A”ÑUòÐ '› 1A”ÑUóV`f4fÃWA”ÑUõ@†!ªùRA”ÑUõx`…C ÃA”ÑU÷Z MA”ÑUùxÀBø`1A”ÑUûØ€m+; A”ÑUüO€sÅ.µ‚A”ÑUüÍ9 ®- +A”ÑUüæ€:"ïiA”ÑUüñÀk$A”ÑUýB HðHA”ÑUÿ«€ñ 0HA”ÑUÿÚ€V A”ÑUÿÝ€ØRñA”ÑVg Çù6ˆ A”ÑVå —*¾ H A”ÑV'@(þ,_A”ÑV° (ó.B A”ÑV÷À A”ÑVÁ@cƒ$dA”ÑVÇ@ ©,+ 4A”ÑVn›¸ ‹1A”ÑV`ÝmÕ A”ÑV¶ ›c2A”ÑVô Õ µ)Ñ A”ÑVøÀ û Æ £ÔA”ÑV €t/7bA”ÑV ³—*l/äA”ÑV +˜ &"I6A”ÑV +Õ` 1*O"ó A”ÑV „@ -Q·A”ÑV ³Àü¥'A”ÑV ú ±è-I A”ÑV q`I‘ A”ÑV ª`0I)!A”ÑV@0§( A”ÑVh€ +m ½(WA”ÑVl  Ò+» 1A”ÑV®`? ·A”ÑVC %3,N1A”ÑVX€XœñA”ÑVö`iîAlA”ÑVÀŽå&ñ A”ÑV¥ +Ä +ü$A”ÑVª  -#¥A”ÑVœà ½*—7A”ÑV@€»wö A”ÑV)` '7 òA”ÑV¸ „-é ‹6A”ÑV‡ #B©A”ÑV]à)2´'cA”ÑVd@ 4!M-A”ÑVЀ$ßÆMA”ÑVZ€~!7ò;A”ÑV¯€%e * A”ÑV ½>4A”ÑVe€X/A A”ÑVÀ¦'€2,.A”ÑV[ 1A”ÑV3`!&Ã#b@A”ÑVƒà þ(1ùA”ÑV·€'0’{A”ÑV³§S A”ÑVé J5gA”ÑVÿà8(j A”ÑVF`X÷A”ÑVa`…/È óA”ÑV¯` É$ò%_A”ÑVð /ëAA”ÑV ã@w#2èA”ÑV ûÀíü|ÜA”ÑV!:`À |¿KA”ÑV"I^%[(œA”ÑV"‹À H÷"'?A”ÑV$*  ¡»'¥ A”ÑV$ +F$œ +A”ÑV%Dào©$^ A”ÑV%tà ;"JA”ÑV%‚À Š'¥$ ‡A”ÑV%ûÀ ”1´ A”ÑV&À‹e'±âA”ÑV'O` +`3P] A”ÑV(Àߤ5¦A”ÑV)P@Q¬, A”ÑV)e Çô4¯A”ÑV)³à¥+àeA”ÑV*yà»(1wA”ÑV*«àaP{ A”ÑV+J€#$§” A”ÑV+ò€¥Ÿ%A”ÑV,-@ ܇3ÓÀA”ÑV,ˆà¼tA”ÑV,Õ@J&"ÀA”ÑV-C€ ;º4ó +A”ÑV.U ;òÊ-A”ÑV/«àü  +éA”ÑV0€][- *A”ÑV0¹ ŒºA”ÑV1˜` +‘A”ÑV2: ·"£â:A”ÑV2?  +z$œ A”ÑV2d áâ¸?A”ÑV3 P.þÌA”ÑV3¸ í¥1A”ÑV3ÿàÎ'½Y A”ÑV4vÀO_ A”ÑV5Ò` Î#¢A”ÑV5ëÀ ü g® A”ÑV6Š,ÿNA”ÑV8àŸ11&ÖA”ÑV9«€ …– +õ A”ÑV9ßà 3*ùA”ÑV:. n$K2§ A”ÑV:2€ò " A”ÑV:Ô Ð$& +A”ÑV;· ;0Ù"Æ6A”ÑV;Éà ²!L%ìA”ÑV;ó  +â-+¸´A”ÑV<ð€$*›æA”ÑV>@¼)DA”ÑV>¶  ¡ý B +A”ÑV?é»#ÿ!A”ÑV?À `¬,A”ÑV?% x-N0€ A”ÑV?kÀ“YA”ÑV? +$­ +A”ÑV?×`í èA”ÑV@&@d)à3• A”ÑV@eQ šPA”ÑV@Ì@!fwUA”ÑV@ßànú-Ü A”ÑVA@@p#ÿ$A”ÑVB@:-wA”ÑVB-`x +LA”ÑVB@€t?m+A”ÑVCEÀ(³"ë A”ÑVCË@ (Q+KA”ÑVDÐ œ+1LA”ÑVE€B¾HA”ÑVEÀàrq3 LA”ÑVEø " +‚A”ÑVF´`f.ÍA”ÑVGÄ€“+ó +’A”ÑVGù€Ï'2"lA”ÑVH  `›*?A”ÑVJÄ »#>=A”ÑVK´@ #„ +ÇA”ÑVL!@%  ¾ A”ÑVLk á<c-A”ÑVMZÀ¬&,A”ÑVO=`I&L3A-A”ÑVO¸ n*Ê.U A”ÑVOø€ÌÕ&òA”ÑVP~@ ,p -A”ÑVQ @["k0A”ÑVQ2`J>.à A”ÑVQQ@ š*2A”ÑVQãÀ 5%!îA”ÑVST` Ïà*{A”ÑVUQ Ä"s)A”ÑVVÿ «"I A”ÑVWÀ Ì¿0A”ÑVWr@ê¢A”ÑVW¹ µ"(•A”ÑVWÉ º ·A”ÑVX2à õEJ.A”ÑVXÛ@0 %A”ÑVY ^œÊ,A”ÑVZaÀìNA”ÑVZË ©)Ã$ÈA”ÑV[=` +ã6&²A”ÑV[ô€ . @î A”ÑV\@[ã*;NA”ÑV\ð€£Ò!WA”ÑV]; t*Â*'A”ÑV]>@öþ_A”ÑV^à&&*@A”ÑV^k€ bþb A”ÑV^{ E… †CA”ÑV^» Ô.¹A”ÑV^¿e0÷/— A”ÑV_ÐÀµ Ý3A”ÑV`VÉh= A”ÑV`´€X \ü7A”ÑVaK M+Ã,eTA”ÑVa‡ °“$j A”ÑVa”à Ï"iA”ÑVbRÀ Žð.A”ÑVbs`-!K Ú4A”ÑVc h ?:A”ÑVc} ƒ)u2/ A”ÑVcй;l +A”ÑVe +ÀÎ(",gA”ÑVe0 Þ&˜¹A”ÑVfàq^A”ÑVfà”'ÞÔ‘A”ÑVf[À*'ÎöA”ÑVftôq&A”ÑVf¨ ™@6 A”ÑVh[ಠ¢ù A”ÑVh… 6##1A +A”ÑVh™ ‹ø rA”ÑViŸ` %A”ÑVj«€gÉ2Ù A”ÑVj½À˜1-,›A”ÑVjÄ@:2D u;A”ÑVk,à ¢0ÎA”ÑVkc`âë’A”ÑVkº`¥3A”ÑVl¡àC')& A”ÑVl´ ÿ"&l A”ÑVnK@ +Q… A”ÑVn¨@² A”ÑVo€%ïz +A”ÑVp 7"D ›A”ÑVpÊ i;)?"A”ÑVpÎà B ¥ 1+A”ÑVqLàã.Âp A”ÑVr1@ U/¹‘A”ÑVr× Î1m*ò A”ÑVuU` „(ZA”ÑVuà +l‚A A”ÑVuÄ Ò2vA”ÑVv~àd¥*"‰A”ÑVwm  !ï). A”ÑVxä ¹2:%5A”ÑVz  +"I,[ A”ÑVz„`G1¼1A”ÑVz˜À{#ì5´ A”ÑV{Và Á' A”ÑV{÷ 6 A”ÑV|4 j%W •UA”ÑV|F€u.”kA”ÑV~  ü.7yêA”ÑV~ã ˆ o aA”ÑV~øÀ³ ¢! +A”ÑV€ú Ä.Ä49A”ÑV€ü d#d+Ð[A”ÑVŒ`S(ø A”ÑVÀ5!© +? A”ÑV‚ J4tIMA”ÑVƒIM$9$È0A”ÑVªØ€©"s ’*A”ÑV¬T@ï V)¹A”ÑV¬tÀ ¥ /dA”ÑV® ‡m31A”ÑV®«€íÑ!“JA”ÑV®± º é A”ÑV¯àŸ!FA”ÑV°Z€ *ª® A”ÑV±&à€)v A”ÑV²€ ‰e ¼DA”ÑV²`@€0A”ÑV³ŽÀ@/d ÁA”ÑV´£À tô#' A”ÑV´Ñ P!˜RA”ÑVµdÀ*ûd A”ÑVµà`3GÕA”ÑVµú  BzšA”ÑV¶q €*a1 A”ÑV¶æ`IÞ A”ÑV·!€P£:A”ÑV·² ö¡ªA”ÑV·³ÀX¬2»A”ÑV¹³À'JA”ÑV»Ê2ü' A”ÑV½,àj&o%ž +A”ÑVÀS€ +W)[j A”ÑVÀ…Àwä1¿:A”ÑVÀÁ #á A”ÑVÁNà("î0q A”ÑVÁl@ÆmóA”ÑVÁ¾@ª •ÞA”ÑVÂë€t kA”ÑVÃ^€$4c":A”ÑVÃg ^ ×, A”ÑVì CÄòA”ÑVÄ´€¥ Ä+šA”ÑVŘ`¢  mA”ÑVÅ¥à¡4Ä$P A”ÑVÅñ  +à‹E€A”ÑVƆ@>)l1 +A”ÑVÆÛ` +d‰A”ÑVÇ€' Øð2A”ÑVÇX€s ̺DA”ÑVÈ¡@.F$A”ÑVÉ` +¶0Ê 5AA”ÑVÌ4ÀF-0³A”ÑVÍ,`(,,½A”ÑVÝŽ€MêúA”ÑVÞL ·5‚$ÛeA”ÑVÞt Ü%ÃâA”ÑVÞé`^Û0 A”ÑVß¹à%0Õ%’2A”ÑVßÉà ½5)¤A”ÑVຠÔ A”ÑVàÔc VA”ÑVá`¶,,ý +A”ÑVáÒ@{6yºA”ÑVâ Ð +ýŒ)A”ÑVâ„à¤h4ÄA”ÑVã, +h0× A”ÑVã™à´N$# A”ÑVä§` "üA”ÑVäÛ tÏäA”ÑVäö v )+A”ÑVå µ¸-¶A”ÑVå|àõ–RA”ÑVæ3~J•¤A”ÑVæÕàrºî¾A”ÑVç(àÜ!a$² A”ÑVç„à '†èA”ÑV甀C" + A”ÑVçõ` ø/æ#A\A”ÑVèÀ !ßXA”ÑVé, Bè¸ A”ÑWm`š!Ø31*A”ÑWàB"91 +A”ÑWY@E +V"m?A”ÑW¾ }%DA”ÑWÜÀÐ"Í +A”ÑW™ "B A”ÑW  :)I+nA”ÑWfàø0÷)%A”ÑW˜@È4qéA”ÑWÌ`f13ÇA”ÑW€ C2£ÈA”ÑW@@Rû&ÃA”ÑWB€ +”!Ø A”ÑW  ¡±2A”ÑWþ±¾)H8A”ÑW5 ¢B1A”ÑWn ]Z!?A”ÑWÌ '•Ö A”ÑWï j 7 žA”ÑWj@U.À+ÛOA”ÑWÀm¥*;7A”ÑW …öj'A”ÑWg Ž$È H +A”ÑW¯@Q"=,lA”ÑWöÑ Ò }A”ÑWz ¨µc +A”ÑW @Ë(LƒÜA”ÑWË`$ô ñA”ÑWãà)ÛA”ÑW €é#"³!A”ÑW!L ê+%ÔA”ÑW#­` R3 +µA”ÑW& $!%0?A”ÑW&- Ô°5¡A”ÑW&†€D +F +ìA”ÑW'¶@÷^4’ A”ÑW'ôÀ-µuA”ÑW)ûà.+Õ +A”ÑW*HÀ°Ñ)¹3A”ÑW+ìàÀ/!NA”ÑW,i &©÷A”ÑW--÷DI6A”ÑW-Î;$9šA”ÑW/D !Ö%îA”ÑW0ê +B,kK(A”ÑW1 f4i}A”ÑW2- ú A”ÑW2‘(Š19A”ÑW3`ßÏ”A”ÑW3 Ã,o÷A”ÑW3¢ Ã%j.«?A”ÑW4¯Àf Ç"9A”ÑW4´@ b3˜(ÄA”ÑW5@Áˆ3 A”ÑW5ëàêä!ú"A”ÑW6@ ¯/° A”ÑW6Ó ‚3öLA”ÑW7; /$·AA”ÑW7Œà´ Æ …;A”ÑW8‡`Š!T;=A”ÑW8à ÖÓ:YA”ÑW;û`¢0Ó"ÕgA”ÑW<Ó 54úwA”ÑW=þ€¦¿AA”ÑW>q0-à A”ÑW>N@E ³A”ÑW>œ€×Y)q3A”ÑW@a ÆÚ)PA”ÑW@…@ í²0Ï8A”ÑW@µ@U º~ A”ÑWA8 Gþ2¬A”ÑWA<ào&ï$' A”ÑWAe +ã$BÖ A”ÑWAo ¨ $kA”ÑWAË <¤%,A”ÑWB½ 1 c B A”ÑWBð` R6A”ÑWCŒ o'£/Ø +A”ÑWDyàž ãLA”ÑWDÈ  ì&|(A”ÑWDúà 0u,gA”ÑWE€õ*WäA”ÑWEw€ŽªA”ÑWE¾ ï KA”ÑWEê`"4QA”ÑWF`Š"!e&A”ÑWFê@ œ& *ƒA”ÑWG @Š/;ŸA”ÑWH4I=A”ÑWHœ` Ï*#>A”ÑWHý@ ()ÐÊ?A”ÑWI§ ó %>A”ÑWJ3`º+A%JA”ÑWJ>àl+á(¡$A”ÑWJç 5Å4å A”ÑWJì ¡ÜsA”ÑWLt`˜+>+ÌA”ÑWMàŽ¼#¸5A”ÑWN` ~3ž JIA”ÑWNË€ 6P!4A”ÑWNÛÀ wŠXA”ÑWOj@¶ñ4Q}A”ÑWPdÀÎ$9~9A”ÑWQ0 F ÃA”ÑWQr€ç+0 b.A”ÑWQw@¼#ª´A”ÑWRƒµ&,ÕqA”ÑWR¯@ ¹ò"aA”ÑWSA ð +)ðA”ÑWTC +‚ŠBA”ÑWU|`3¹ A”ÑWWÙ 4"ç+A”ÑWX&€iZ£A”ÑWX=@ïzÃkA”ÑWX«À +ÇÍA”ÑWX¬ —”)üYA”ÑWY!À‡B"vA”ÑWZ9 ~)Â9A”ÑW[€˜ H'EvA”ÑW[!@ Š'(r A”ÑW\€ˆ"9Õ A”ÑW\ ×$$÷A”ÑW\¬à +!þ–A”ÑW]¿ s&ZA”ÑW^è`D­,Ï*A”ÑW^þ`È oHA”ÑW`L`Y&##A”ÑWa  g3%Ó.A”ÑWaÉ@ä2A”ÑWe¾€*‚ÂA”ÑWfÆ€S¯= A”ÑWg`µ"ô7A”ÑWgX øÓ,§-A”ÑWg`às%™!ê A”ÑWh»À  +$ +A”ÑWhï Ü,rGA”ÑWi*ß vA”ÑWiË`¸öµ(A”ÑWjcà&, $UA”ÑWjx`)&]£A”ÑWk(€Á"*"A”ÑWkŸ •Ü TwA”ÑWlø v}!CA”ÑWp 4z%à1A”ÑWpüà ¹¯ Ä#A”ÑWq   Ã?8A”ÑWrK Ì G$MA”ÑWs¨@ )-¥A”ÑWt@1fA”ÑWt( $ RTwA”ÑWtM›!#ÇA”ÑWtš@ LB*A”ÑWu ‰ C Ã@A”ÑWu Z}÷A”ÑWv@¤ TãQA”ÑWw|Àˆ*ýÔA”ÑWw÷`Âa5A”ÑWy€ i'ÔÞ3A”ÑWy‹ÀÔ®A”ÑWy¦ ÖE +A”ÑWy€~4-7 A”ÑWyì $!Ø]A”ÑW{L@ Ϫ;A”ÑW{àÀ ¾òA”ÑW{óà1V%^$A”ÑW|Ï@ ˆ$ÂsA”ÑW}x€Å û - A”ÑW~ QŠ"GA”ÑWÿ  ~1ü'Õ A”ÑW€ .ì AGA”ÑW€o c à A”ÑW€ÿ€[ ­)EA”ÑW §&Ô{A”ÑWFà Ç k+» A”ÑW„@Y,¯0n%A”ÑW„, ã"2&n;A”ÑW„Y  Ë-&A”ÑW†PÀ«V08A”ÑW†ãŸ!'=iA”ÑW†û€ mù,Å +A”ÑW‡” `+$A”ÑW‡½@¹.5 +¨A”ÑW‡îé¼vA”ÑWˆÁà¨-XåA”ÑW‰› a't E $Ò­ A”ÑW¬£@+'A”ÑW­€è+Ê1/ +A”ÑW® +Œ"× ýA”ÑW®G P$e2. A”ÑW®§@nˆ×YA”ÑW®½ ‚~ A”ÑW¯ã ˜2râA”ÑW°Ÿ@/"fáA”ÑW²G@{ó*3A”ÑW³*ÀÛ- +[´A”ÑW´Í€Ñß&l A”ÑWµe  9åA”ÑWµÁ 0|…A”ÑWµÓ€°+ˆ(átA”ÑW¶@ÿ”+¢ +A”ÑW¶i ÜFA”ÑW·€ÂÚ4WA”ÑW¸ç`) +FÐA”ÑW»1€hê£FA”ÑW¼añÝ5‡A”ÑW¼„44íS$A”ÑW¼´`ÖÝ1ˆA”ÑW½Àq cMA”ÑW½VÀ„f«A”ÑW½` œòí±A”ÑW½eàŠ üÐA”ÑW¿ÉÒ‹A”ÑWÀ@ÿ$¢.MA”ÑWÀàƒÎlA”ÑWÀb`T,é© +A”ÑWÀ²`Õ#h! A”ÑWÀå ˜™™ A”ÑWÁaàZ”- &A”ÑWÁÓ}-f'4A”ÑWÀ±w1lA”ÑWÃÏà1î‘A”ÑWÃß 9bÇA”ÑWÄ)@@^ÕA”ÑWÅ`²™ÿ +A”ÑWÆ]€è¶A”ÑWÆØàk*s#A”ÑWÇ'@èI ++ A”ÑWÈI@G•6A”ÑWÊc@že#Ã\A”ÑWÊe@ ""³A”ÑWËÂà q0Š*kA”ÑWÌY`ð Ï,Î6A”ÑWÍF€Šˆ"ÎHA”ÑWÍÏ }û™fA”ÑWÎ!@x£)eA”ÑWÏE ¥¥+RA”ÑWÏË` íA”ÑWÏå€M F%>FA”ÑWÐÑ  +™ +].w A”ÑWÒ/ è"‘2— A”ÑWÒ5€^2Œ1,A”ÑWÒqàh!ÚX0A”ÑWÒïÀ!®0zrA”ÑWÓ÷ Œq(EA”ÑWÔ€ ˜-D.—A”ÑWÔàèe 3 A”ÑWÔ9` äª!’.A”ÑWÔ€  ^ +˜ A”ÑWÕ ‹2…ËA”ÑWÕAà‹IZ A”ÑWÖ@çŸ(^ A”ÑWÖ:` Ð'¸5A”ÑWÖ‡ C3QA”ÑWÖÃD2 $î A”ÑW×\à Ê'H2"A”ÑW×zÀdDA”ÑW×Þ@å¹% A”ÑW×ø€ +Ï5±-A”ÑWØ·` 03 ‡'A”ÑWÙ “)Æ+kA”ÑWÙ1`Í/% +A”ÑWÙU  â"Ÿ1†A”ÑWÙ” ó}/B A”ÑWÚ ) Þ› A”ÑWÚÚƒ.A”ÑWÜr€  W A”ÑWÜrÀ# 6DA”ÑWÝN€í ÔA”ÑWÝn@° 64ÒA”ÑWÞæ`V/¡,«0A”ÑWß Ò/  A”ÑWà3à0Ú‹5A”ÑWàïÀÅ1J,>A”ÑWá@ö.\A”ÑWá” DŠA”ÑWâMàŠ£A”ÑWâU ÷*.r A”ÑWâð2©2âdA”ÑWãp@è*1<A”ÑWãs ¬*áWqA”ÑWä"@s%+"qA”ÑWäK` Ûõ×A”ÑWå9À£ƒ2ºA”ÑWæŽàû+>A”ÑWæ™à÷³™ A”ÑWæ¯`*;$¢2A”ÑWæ×à ±+ºZ +A”ÑWé9¿ã ªA”ÑWê@äV< A”ÑWê˜àÙ%­b A”ÑWë°ÀÝ$D'¾ A”ÑWí + kA”ÑWí$ ´»´A”ÑWí5`(â3U A”ÑWíVà¯'•-E A”ÑWíu ü(¢2' A”ÑWí“ TÏ*ÒA”ÑWî Ç'¾¯:A”ÑWîš ¾sñA”ÑWï@€"-mA”ÑWïÉà7$°RA”ÑWñwÀ¿Ë 83A”ÑWñ–@~ã‰pA”ÑWòr¿- å +A”ÑWôSàp ü A”ÑWô”`i*?A”ÑWõ* Û"e4™0A”ÑWõI€d'Ÿ%A”ÑWö˜#JA”ÑW÷»`5 Ò"ëA”ÑWø +!3ÒA”ÑWùàŒ ƒJ.A”ÑWù Ð-Ò¼/A”ÑWù†`³%ÌFA”ÑWù†+îž\A”ÑWý¢ V°%VA”ÑWýÄ` [*À*A”ÑWþÌà æ/ñ A”ÑX¼àJ)ê A”ÑX+` ›ù7A”ÑXl€–583A”ÑX£` È&{ ÚA”ÑXô æ/ÈX9A”ÑXÿ Ý2w"*A”ÑX  \†áA”ÑXl`½P A”ÑX¯ ²e÷A”ÑXè »1ÞA”ÑX  E,B1Œ +A”ÑX ¨ ˆ1(yA”ÑX +­ ê +A”ÑX p #– ”SA”ÑX - (P+ØA”ÑX õÀÎ&gA”ÑX ™ž&A”ÑX†@ äÊ&ÚA”ÑXH +›YJ A”ÑXz v{+ŽA”ÑX’ »*œ.¥A”ÑX³@1ï%;A”ÑXö@ >ó" A”ÑX5àwÌõ A”ÑXbà²âA”ÑXl€ß<*Ÿ A”ÑX–€•'Œ"#EA”ÑXÓ@ &º&— A”ÑX"À µq C\A”ÑXK á"§$A”ÑXi` R 0d A”ÑX±à «)À A”ÑX²àm¥A”ÑXùÀŸ*“"A”ÑX3àE™ÍA”ÑX @³  oA”ÑX®œx#A”ÑX¾ h YW A”ÑX€l%S +A”ÑXc +Ü 7A”ÑXg ±!gh*A”ÑX®Àé2ù²sA”ÑX\ÀÙ4@ A”ÑXn@’#v('A”ÑXx€ 5w¥ A”ÑXª€ï ³2 A”ÑXá€ÿ)Ç )^A”ÑXç +"æ'Q A”ÑXÖ` ‘#˜ A”ÑX'`~z7UÃA”ÑX~JÀ(PA”ÑX°@°N– A”ÑX“ Lç+?³A”ÑX×`5÷¶BA”ÑX ½`â u³$A”ÑX à ­¬'E_A”ÑX!  +¼#îs A”ÑX"ñ@Ré.ñA”ÑX# ¥ h‰ A”ÑX#¾`0¹%׃A”ÑX%W  ¥1 A”ÑX%ñ@¯1ª$¨#A”ÑX&x +4%-ÌA”ÑX&£ ú!K}A”ÑX&®€(—GA”ÑX&Þ` k+S A”ÑX(và $R! A”ÑX(‡ ‹-‡UA”ÑX(ŽàÓ–»A”ÑX)× Ö0O'–2A”ÑX+ð€½ +I.ÚnA”ÑX,} ü',1¡A”ÑX,ËÀèÃ! A”ÑX-@© ’ +BA”ÑX-  ŸèxA”ÑX.@è$( ÑA”ÑX0L€ Vû A”ÑX0V€% y A”ÑX0²€u‰#ñ^A”ÑX2M ¾ ++âA”ÑX2S & +-A”ÑX3s,˜!- +A”ÑX3–` b#ƒ–A”ÑX3À ¼§£A”ÑX4I@´$åA”ÑX4›@µ#º4:A”ÑX4¶€¾.“-yA”ÑX5 À¼ ëA”ÑX5Aä.í¬A”ÑX5~fpÁ1A”ÑX5–`îê7éÖA”ÑX7ï@Ä3åA”ÑX8^ ,jA”ÑX8W@¹"B$A”ÑX8Z  3 Þ5A”ÑX93@€,¢çA”ÑX9Æ€%·"A”ÑX:g Ò%åA”ÑX=z@´ · ˜ A”ÑX=‚ sfA”ÑX>c ›DÙA”ÑX?»ð›&ÇA”ÑXA  (j +°'A”ÑXAV€¢-¬A”ÑXAg`>Þ¶ A”ÑXDGàä) A”ÑXEw€U‹'yA”ÑXF˜ 'O4?·A”ÑXG 6Œ +A”ÑXG$`ý÷0L A”ÑXGm ¨ +©+‚ A”ÑXGùÖ*\Y +A”ÑXI +€*_5*A”ÑXI– ½#QA”ÑXJÑà lß1^NA”ÑXKH V! A”ÑXKJ` <E A”ÑXKz (hA”ÑXLœ€\ n(d A”ÑXLº@ +Z)3IA”ÑXLÖ /!A”ÑXM6À l&î!A”ÑXMÕ w#>&ªA”ÑXN` +!(î A”ÑXN•€û¸ +7A”ÑXOjÀ™1:ÿA”ÑXQ`à RéA”ÑXQ5¬  A”ÑXQL¿ŽA +A”ÑXR/À‰"°ÜA”ÑXRD€- #ÙA”ÑXRvÀÄ#Ò&‹,A”ÑXRê` +î.A”ÑXTºy ;A”ÑXTâ@E3r A”ÑXU ð 7nA”ÑXU“`!.åA”ÑXVÏÀl/1' +A”ÑXXÁdüÃA”ÑXZ™€P"4#A”ÑX[ w% . A”ÑX[¦À¿"õ0A”ÑX\(à1!9UA”ÑX\{@ 8*£1ÅA”ÑX]5`Ä2¾è?A”ÑX]ñÀž n+oA”ÑX^Š€µ4b#¦ A”ÑX^ÂÀ +¾3 2A”ÑX^Ø`°2Ã%ÏA”ÑX_h@ ¯& „LA”ÑX_Î@t5ÁA”ÑX`~@Š¥A”ÑX`ˆÐ)Ö!¦A”ÑX`–@ e{*â +A”ÑXbAÀò2)SA”ÑXb`v)Ø1&>#u$A”ÑXo®à £ íA”ÑXpÁýì)ˆA”ÑXtY z!Ó!:A”ÑXu6@ $ÏvA”ÑXu¼àq_A”ÑXvàÿøÚ1A”ÑXw= ‹ Z±ÔA”ÑXwµ Ø'Y$v +A”ÑXx=€ .kA”ÑXylÀ5˜Æ-A”ÑXyø@|YèA”ÑXz`/q$,A”ÑXz À +¿*Î A”ÑXz¡à u%¬dA”ÑXzÍ 5¸ oA”ÑXzúŽT^A”ÑX|c é EA”ÑX|‡€f¤2¿A”ÑX}ä`$3Ê A”ÑX~ k"’#< A”ÑX~ž€ õa,@ZA”ÑX~¼@«,˜³A”ÑX~È ¼ f yA”ÑX~ìÀNd2pA”ÑX"@¯~ ŸA”ÑX€Àà=@ŠA”ÑXàâØ A”ÑXd &™A”ÑX‚À‚ +¯*!A”ÑX‚† œhAA”ÑXƒÇ =x bjA”ÑXƒÕÀtô .A”ÑXƒÛÀ*%{4A”ÑXƒë J#H(ŠA”ÑX„@ *P-ÏA”ÑX„f@ä)â +A”ÑX„Û`ÈŸÖA”ÑX…€%$"FA”ÑX… `Ù A”ÑX… ±9+~A”ÑX†À®2"µA”ÑXˆ†@ ø4‹ [A”ÑX‰o` z2÷ +A”ÑXŠl€í A”ÑX‹@S&vÙA”ÑX‹©)žfA”ÑXŒ B}üA”ÑXŒ+`ÛÌÑ A”ÑXŒlàb?70A”ÑXŒ¼ N4'LŒA”ÑXŽl`Ì3PTA”ÑXŽƒ`*+{A”ÑXŽñ€˜%þ^A”ÑXŽùà +Ú "A”ÑX@ Ã4^" A”ÑX  ~Ù A”ÑX$ ‚Ž*A”ÑX-@÷!”Æ7A”ÑX¦ààºþ,A”ÑX‘ ÇÜ#¦/A”ÑX‘  ? `'b A”ÑX’8à Ñ2ÎA”ÑX’Ú`<.dÜA”ÑX“{àBF)BA”ÑX“ ` a+ò"A”ÑX”½”'FA”ÑX”’à +Š"H A”ÑX”ܶ)K>A”ÑX•)€û +Í +" A”ÑX– š* ÐFA”ÑX– `O &ß A”ÑX–$ ÷x,ð#A”ÑX˜@ûûeOA”ÑXš}àr+þ!|A”ÑXšà S,tO A”ÑX›ø€?3  +A”ÑXÏ€õ-VAA”ÑXžàæ’3IKA”ÑXž( ]"}.C A”ÑXŸX  ;7{ A”ÑXŸr€Š c05,A”ÑX X`<·/Ý +A”ÑX¡€Ê` >BA”ÑX¡— Ë…6u-A”ÑX£AÀ-e— +A”ÑX£[€’ý_KA”ÑX£‚ ‡!Hn1A”ÑX£Š`Üjƒ A”ÑX¥-@/!ÃtXA”ÑX¥I€Ò,•é3A”ÑX¥V@ú ü~A”ÑX¥c€áO“A”ÑX¥† Å%ª%å5A”ÑX¥à€ +R 4ú A”ÑX§ö D*7¸ÎA”ÑX¨µ@\1Õ„A”ÑXª,¹A”ÑX­aÀ-¼YA”ÑX­iµ=- A”ÑX®Ç Èç2z A”ÑX¯#À­"âA”ÑX¯ƒ`Ó+ÅñA”ÑX±"à;b × A”ÑX±H T~ÚA”ÑX´1À>"ä3*A”ÑX´Jàn)­$¸A”ÑX´œ +¿Â‹ A”ÑX´Ä Á¼ +‰ +A”ÑXµƒ ’ô,=4A”ÑXµ£@É Ž€ A”ÑXµÉ ©¹A”ÑX¶ Ä ¥/$A”ÑX¶` *:Û A”ÑXºÚàÖ¸1€A”ÑX»3 ..WsA”ÑX»¬b1è A”ÑX»ïà-u c A”ÑX¼[À Ý¡Ê A”ÑX¼gŒ"&û +A”ÑX¼ôà ýÍ.ÂA”ÑX½@¤£ úA”ÑX½ÂÀŒ'Ž+”àA”ÑXŹ =í=CA”ÑXÇÀ`»èA”ÑXÇø ”&)íA”ÑXÉ&À: Ü73¬A”ÑXÊT€t«*æHA”ÑXʪà uNËA”ÑXÊÊ Q*•"nA”ÑXË`C¢ +A”ÑXÌ8 + +ñÿAA”ÑXÌD@`+"A”ÑX̨`\0$"+A”ÑXÌÜ Ð)þA”ÑXÍ &·WA”ÑXÎî`Ÿ"ç!A”ÑXÏG à$q4'A”ÑXÐ/`å0§.n A”ÑXЪD,±A”ÑXÑâ`A(¾A”ÑXÒ +€ b¡ A”ÑXÔ‡€ '/‰A”ÑXÖ€:*q A”ÑXÖh _5z%?>A”ÑXÖw  èh"A”ÑX×)` "#³'ÃNA”ÑXØ #Ó..A”ÑXØ7 7‹j A”ÑXØ_@'Ð-KA”ÑXØÖ`q'<™A”ÑXØðÀ”)àþA”ÑXÙ-À!@ A”ÑXÙA@O%å-«A”ÑXÚ Lf‡ÏA”ÑXÚaŒ&˜lA”ÑXÚÙq(|<A”ÑXÛ(‘¸&+A”ÑXÛ‹` j6«ÁA”ÑXÛ±€ …ÒA”ÑXܨ ->,A”ÑXÜï@'L$NA”ÑXÜøÀ 6,“.§?A”ÑXÝP`i.Ÿ A”ÑXݵ ä„1äA”ÑXÝñ€1%lA”ÑXÞn`˜ðY A”ÑXÞ¦À)!•#ëA”ÑXßžà ¾¨%>A”ÑXß° Á§ A”ÑXßÓ€’2üA”ÑXßéÀ ì!_A”ÑXàC@Ür€ A”ÑXàf Ö ¥61 A”ÑXá¤À àw"A”ÑXã*`:–‹&A”ÑXãV ¥ 'ÃjA”ÑXã©€ž#_r A”ÑXäà;2&#€ A”ÑXä  #2m A”ÑXä6 ô +ÍA”ÑXä: s +®ìA”ÑXäZ@z ê#A”ÑXä@¤%ÐA”ÑXå#€##9A”ÑXåÁ€a6ýA”ÑXåú`³3¦ A”ÑXç  7=1|A”ÑXè@:Ž$A”ÑXèvà3 Ý"A”ÑXèÉ€(-Û/Ó A”ÑXêoàÀ"CcA”ÑXêÄà#&,3¡A”ÑXêÝà'³2e A”ÑXëÀRy;A”ÑXìnÀa'; A”ÑXí•  —ÅA”ÑXíïà_«3ÙA”ÑXî* è «=A”ÑXïf „,J A”ÑXïÑ€é +]A”ÑXðÀµ†AA”ÑXðµ€´Û$¡A”ÑXñ4@ QA”ÑXó> ûž&A”ÑXó¬`ì +* A”ÑXôÀ —  ‘ A”ÑXöÀó"ƒ7A”ÑXöNÀ… HA”ÑXöi`/6€JZA”ÑXö’`  8Þ?A”ÑX÷a (î!A”ÑX÷Öà2#!‰7A”ÑXù‘À ü)î%A”ÑXùö +¸*"ª A”ÑXûÔ N% A”ÑXþ Ö +&A”ÑXþ6 ü0;'×A”ÑXþP€ép +A”ÑXÿ@õÚ30 A”ÑYB #^)A”ÑY ë! DA”ÑY ‘¸O A”ÑY—@}¨ ¹ A”ÑY× ¿´,{A”ÑY<ൠ+c0A”ÑYL"XA”ÑY D`µQ H +A”ÑY zÀ2}RA”ÑY += k1%6A”ÑY +Ó€ +M\FA”ÑY GÞ]èeA”ÑY è`T(H +A”ÑY n`9ÓA”ÑY Ý × ,/ A”ÑY`Ã+()1A”ÑYà +.&£A”ÑYpð%$'A”ÑY‡ ¾$Û7¼A”ÑY÷@z 'pTA”ÑY–À !#1QA”ÑY9@§+šA”ÑY‰@•“iA”ÑYÅ`ƒ$¿=A”ÑYóà ¨ ÊA”ÑY ô)'3e A”ÑYö@7$Á*AA”ÑY{€2+i&bA”ÑYâ@ +þ%™%A”ÑY= w) +ÞA”ÑY¶ Í$ê!ì8A”ÑYí Ã3A”ÑY[@ù: +?A”ÑYÊàº+ ) A”ÑYG@BEPA”ÑY)`í8A”ÑYFàÕ¢+’A”ÑYª`| 0 0QA”ÑY,€ )1A”ÑYR +4 é,ó +A”ÑYº@0'¯ â A”ÑYÅ ]4 )ûA”ÑYÒ@¨®‘A”ÑY" ª3W +A”ÑY"™`S%¢ A”ÑY#`m‡A”ÑY$:Àu*EA”ÑY$Èà €$»2A”ÑY$Í  9!•A”ÑY%¬ %„ › A”ÑY%Ïà´È75A”ÑY%ç`)zMA”ÑY&=€ÿ!/'èA”ÑY&è ј2—&A”ÑY&õ c)45qA”ÑY' +s ø +A”ÑY' Á$† » +A”ÑY'f t›-°A”ÑY(ÀÇ2˜'A”ÑY)` H%*!w¿A”ÑY)!  W&#A”ÑY)nà ´„]ÏA”ÑY*­ …=aA”ÑY,€€ò11-o A”ÑY-Q@!VÁ+A”ÑY-ÿ@ !( A”ÑY/¤à …+,¿1A”ÑY1f m A”ÑY1  ¹ þ[A”ÑY1Ü`èA”ÑY2“@24¸ A”ÑY3 + 2  A”ÑY3' ”~*A”ÑY3¹  "  A”ÑY4.@Ô©÷A”ÑY4¡À 7¸^ +A”ÑY6œ@ ¯I!½A”ÑY7~ x¨6ÙcA”ÑY7‰wôA”ÑY7­`ó +É,Î A”ÑY8·€Ÿ A”ÑY9¢ .+ôJA”ÑY:»@O![,A”ÑY;`<ÿ'#A”ÑY;xàgÛRA”ÑY;Š÷Î A”ÑY;¬€¹s#‹A”ÑY<¯@ ¼!S·A”ÑY<ÐÀr$™6P A”ÑY=y ) #rA”ÑY=€  Ð8,DA”ÑY=ê Û0v+QA”ÑY>ôà7-)@A”ÑY?B ˆ#ž#A”ÑY?t€¼ î)A”ÑY?ì€lá!¢A”ÑY@þ@ hÁ&8A”ÑYAZ@ À-ðA”ÑYC0Àh+r A”ÑYC@þÊ8A”ÑYC…çŽÛ`A”ÑYD C!f‘-A”ÑYDÁ`,%¥ FA”ÑYEJàâ(Ý1 +A”ÑYF ž(tŽA”ÑYFYÀt`A”ÑYF¹ ¢± ½QA”ÑYF퀛 ä!ÅIA”ÑYG€I’)A”ÑYHh# +,­ A”ÑYHÛ€B1²(ÕA”ÑYI~¾4ÍA”ÑYI`s•#A”ÑYI¯ #,ˆA”ÑYJó`Wï A”ÑYK]€ Ù2A”ÑYLs`N yA”ÑYM„ ðþ,A”ÑYP`Z%·É)A”ÑYQPà:"1,A”ÑYQ“ 7Þ'A”ÑYR·@(/?"- A”ÑYRé  /ëé)A”ÑYS`ðó!¨LA”ÑYSÀ Ý&n= +A”ÑYT°@e;5lË A”ÑY™ O'7A”ÑY™  éµA”ÑY™ì  ÃÍA”ÑYšˆQi+OA”ÑY› %‰y A”ÑY›@Y'-–vA”ÑY›Ú`µ`/dA”ÑYP`XB/A”ÑY^€Í4-A”ÑYž rÜÃ.A”ÑYžøà//-šA”ÑYŸI€±½¸A”ÑYŸ•€ô6ç#Á +A”ÑY úà DêA”ÑY¡Aà‰)×3 A”ÑY¡†àz$Î6ƒ6A”ÑY¡Ý tÞ +A”ÑY¡îaGA”ÑY¢K ÂË&A”ÑY£Ê$ãQA”ÑY£ÿ ¾#ƒA”ÑY¤€ÓA”ÑY¥)ÀžºA”ÑY¥;/‚!ÈA”ÑY¥‰` z¯iwA”ÑY¦y µ.².3 +A”ÑY¦Ÿ@ù.A.øA”ÑY¦¡€–T$v-A”ÑY¦ª@ s²% A”ÑY§  !c  A”ÑY§Àº +j(} +A”ÑY§9  æ&/ A”ÑY§d€ +4é+ª A”ÑY¨®€ú ¼ÂA”ÑY©1`² ("«,A”ÑY©‹ î+Š A”ÑYª;@R&É5OA”ÑYªi€¡%HÝA”ÑY«d€2 óg A”ÑY¬QÀä+øéA”ÑY¬³`— ô%¶HA”ÑY¬ò  P\ E +A”ÑY®`”°+ÆA”ÑY¯´ â©!ÌEA”ÑY¯Þà¢ÔªA”ÑY°¢à}ÃÂ]A”ÑY±þ` +-(A”ÑY²~à B(A”ÑY³u ßË/A”ÑY´ + ps(SA”ÑY´, +“@-Æ>A”ÑY´Ü@3ØM A”ÑYµå€^íŠA”ÑY¶XÀ3)9¿A”ÑY· ‡%ï!A”ÑY·±: Å$Í A”ÑY¸Î` ã3â?A”ÑY¸ûàS/ -RA”ÑY¹  ÷%.5QA”ÑY¹’‰6K(Ë A”ÑY¹ý v$öA”ÑY½` “%A¦5A”ÑY¾"àH A”ÑY¿= ™%!µ A”ÑYÀ 3#D(A”ÑYà ì #ø A”ÑYÃåÀ k*Ú A”ÑYÃó Û Ñ,(A”ÑYÄ5€ñIŽA”ÑYÄâ@r ÎÅ A”ÑYÄëÀè »° A”ÑYÆ) !0 ¼RA”ÑYÆV Z 'A”ÑYÆÆ@ ©-2)A”ÑYÇ`t1ârA”ÑYÇ Á.|àA”ÑYǹÀ ¬Ì7:A”ÑYȳ +! +-A”ÑYÈ÷Ú ú/4A”ÑYÈþ`QîaA”ÑYÉ.@؈A”ÑYÉV¨a6cA”ÑYÊJ 2*ö ¡ A”ÑYÊç§'Ò´A”ÑY˵ ËÓA”ÑYÌ ¿ y*:A”ÑY̱  +! +Å/¯ A”ÑYÌèà? /.A”ÑYÌê þ5 *Ñ:A”ÑYÍm€~)’!kA”ÑY̓â'ràA”ÑYÍ„ «dªA”ÑYÍ»€Û'HiA”ÑYÎK@aø)üLA”ÑYÏ#` q d ^A”ÑYÏe Ú")lA”ÑYω 5î A”ÑYÏ“ êe.'A”ÑY϶àÁ_$œA”ÑYÑs «,ÓA”ÑYÒd ô ,KA”ÑYÓðÙ%m A”ÑYÓaà Q!¶A”ÑYÔPàB&íÌA”ÑYÔ` f$Ú¢A”ÑYÕC@ÒLc A”ÑYÕ²¦4÷A”ÑYÖ[`Æ A”ÑYÖeÀŠ<Ð +A”ÑYÖÞ€Ø+$ Ø A”ÑYÖá }Z8/A”ÑYØù@Ó3;‰0A”ÑYÙ%€).\"à‘A”ÑYÙ{ € A”ÑYÚ  ò +„A”ÑYÚMÀãü2A”ÑYÜ5€û)j A”ÑYÝ<` â;"× A”ÑYÞQà µu,mlA”ÑYÞÕ&‘5»A”ÑYßB€U Bý6A”ÑY߸@Ñ"دA”ÑYà@Ç%$ÚA”ÑYá+€ ›Ä A”ÑYá\ ·"½ß!A”ÑYã: Y%¡A”ÑYä¯ t)ƒò A”ÑYäÀ³Ã#F/A”ÑYäÅÀ >*AA”ÑYç#`o.œ=qA”ÑYç- þ )ÀA”ÑYçz H—³A”ÑYèM&•@-A”ÑYè} „-ð A”ÑYê#à&&] A”ÑYê… ¤%¡ÐA”ÑYê¯àº÷ª +A”ÑYêÅ!Ü)– A”ÑYë  0,¢A”ÑYìàß ý,ŠæA”ÑYì +Þ/0´ A”ÑYì)$ `*g%A”ÑYîÀï8"oA”ÑYîÇ w/&Ù:A”ÑYïs ¬3!x)A”ÑY3*« YA”ÑYï¾`Õ"±,Õ2A”ÑYðÄ@… +øgA”ÑYðüච€ A”ÑYñbà “4A”ÑYñl $&ÆH A”ÑYñ«Õ !¼ A”ÑYñÊ hßA”ÑYñØh ­&¨ +A”ÑYñïà +ì†x"A”ÑYò@A"¨ +â=A”ÑYó瀚£-A”ÑYõÍ@† –A”ÑYö16 á,]UA”ÑYöSÀï$r(îŽA”ÑYøH  ƒ)D A”ÑYø`1î HuA”ÑYù^ %§*N A”ÑYùæ âÍ8 KA”ÑYù÷À A”ÑYúË@—ÄËA”ÑYûz€_u$ A”ÑYû”À sñ A”ÑYü‚àg$Æ A”ÑYýKÏX"¸A”ÑYýTÀ V‡ A”ÑYþˆàX±/)A”ÑYþâÀ×g/… A”ÑYÿƒÀ0)Æ#¦ A”ÑYÿÉ€ —'ôA”ÑYÿÿÀ +ü6*%A”ÑZS€­ ^A”ÑZJ‡ *A”ÑZgÀ +S„ødA”ÑZ`Àˆ*JW A”ÑZÁ@û`xA”ÑZo€óÝA”ÑZUÀU5w!),A”ÑZœ  »3A”ÑZ ?e2ë A”ÑZ›À€á-A”ÑZ W`£æ BA”ÑZ Š€Ú!$UA”ÑZ ¬€ C)õIA”ÑZ +™€ +V°A”ÑZ +Ä@9#Å4¶A”ÑZ `@O 4Ø A”ÑZ i€é 4“A”ÑZ é@›$c2 A”ÑZ ôl&v+‚A”ÑZ ê@‰#VRA”ÑZþ "6™÷ A”ÑZ ´,@á A”ÑZ"tè u4A”ÑZb`n„*dµA”ÑZ˜@ 7+ëƒA”ÑZ¸`¯ù!hA”ÑZc€5 J åA”ÑZ˜À¸!ñA”ÑZ0 í##¶A”ÑZv` Á L%3DA”ÑZ +@ Æ4ï9 +A”ÑZÀš  )NA”ÑZ,À¥!v× A”ÑZ• "9§¬A”ÑZ®ÀY3%SA”ÑZ"` E •èA”ÑZ¸[* « +A”ÑZš·#†#ìA”ÑZø H G&A”ÑZ; i!–)0 A”ÑZ\à –½´äA”ÑZg Kì7îA”ÑZx€(öÍA”ÑZ}€Æ$:.c!A”ÑZÆ­(¤ß}A”ÑZí ó1J.‘ A”ÑZÝÀÜ/Ž2Õ-A”ÑZ€¯7 ™A”ÑZ: /NÇ A”ÑZœàè.® A”ÑZÎ »"ëíA”ÑZO3¶øA”ÑZ®Â+ 4V A”ÑZé`$ÊO!A”ÑZú€Én 0A”ÑZ€ÉIaA”ÑZ +àS s1¨A”ÑZ SÀD$9'I9A”ÑZ"à +y,h+A”ÑZ"ÀÀ)Á.JiA”ÑZ"§@q%û B2A”ÑZ"ÍàÄ'L ’A”ÑZ#Cà HÄA”ÑZ#Ô`÷!#½FA”ÑZ$ m5¶A”ÑZ&Ô ‚CŸ A”ÑZ(äóq39A”ÑZ)yæ* -A”ÑZ)Þ@3•lA”ÑZ*R€C +f!A”ÑZ*º€C î#p7A”ÑZ+` É +[A”ÑZ+{À¼»"l\A”ÑZ+© ÖÖ1ZtA”ÑZ,ý òøA”ÑZ-@Ï*¨— A”ÑZ-g éõ#e A”ÑZ.˜ Š 1)¢A”ÑZ/Z +ÃHÅA”ÑZ1QÀs 7A”ÑZ5| Z*Ÿ1¿ A”ÑZ5øà›&¥ A”ÑZ6àL g |A”ÑZ6‹àIÑ)­A”ÑZ6›À +d0DA”ÑZ7” Ñ +1A”ÑZ7í`& ×!¶A”ÑZ8!Û 89eŠA”ÑZ8OÀþ9A”ÑZ8– ®*¦à1A”ÑZ8è@1 9%²A”ÑZ9` âc+l8A”ÑZ9V@â0Ó¶A”ÑZ9ö(~A”ÑZ:Àc$¢+©A”ÑZ;V 2#¼>FA”ÑZ;’ !“…A”ÑZÀ.Ü+VA”ÑZA  Ñ2K!LA”ÑZAk` ù*ä´%A”ÑZA«€#Ì É A”ÑZB¼à+(. A”ÑZCï@1# A”ÑZDþà !H )«A”ÑZG/`ªÎ\A”ÑZGª@)^|A”ÑZH.`ØÚ)/aA”ÑZH’à ý'éèA”ÑZH•À<2+ÂA”ÑZH÷àG)66{A”ÑZI,à:"ä1õA”ÑZI“ üÅ–A”ÑZK“ E-,ÅA”ÑZKÎ`+8#Ò A”ÑZLF ê'A”ÑZLNàí¿A”ÑZN! ö&O#¤A”ÑZN[@ nÈåA”ÑZN ¦ }7—A”ÑZQF$”+Ö A”ÑZR¥` 4ÁA”ÑZRø€-$3óA”ÑZS_`Å"Ü5UA”ÑZS£ 8/.2ÖƒA”ÑZTl€Þ*/~‚A”ÑZUà +3~¿ A”ÑZV:@u7/sfA”ÑZVFà¬à1O A”ÑZVXà‰&A– A”ÑZWU€7™A”ÑZW»@Ö E#A”ÑZWÃÀ‰Ÿ$ú A”ÑZWä $¥f A”ÑZX `¬ ÕØA”ÑZX3 +9ÅBA”ÑZXÕ€î&ŠA”ÑZY³€ r#1/ð A”ÑZYÁ€_ XA”ÑZYÅ€¹L2[A”ÑZZ* j.2&A”ÑZ[b Þƒ-—8A”ÑZ[k/ÍÏ4A”ÑZ[  ¦-Û +UA”ÑZ\ ä#d A”ÑZ\”À =#^ A”ÑZ\²Àj Ý%j +A”ÑZ]M ã2$LA”ÑZ]xÀ z +œ>A”ÑZ]Ê€ê(&„A”ÑZ]Êà +Ò&Ç;A”ÑZ]Ö Ý!ê+ÿ A”ÑZ^ F'¼(xfA”ÑZ_Þ€ ÖÃ/§ +A”ÑZ`iàY3z*[A”ÑZaf`1/ŒA”ÑZa¡ R¹ Ò­A”ÑZb#@üz ärA”ÑZbÍ@DKWA”ÑZcoà¥4L'ŽA”ÑZcƒ ¤M8™:A”ÑZd'`Ø™ SA”ÑZde@Ê] A”ÑZdh  )A”ÑZdž@þ »(ÊRA”ÑZdÓ {$' +A”ÑZdû ¸#¥œ +A”ÑZe« Q*F*‰ +A”ÑZf)àžÐ,v}A”ÑZfßàI*« A”ÑZh€ó%S¸"A”ÑZh– R S'A”ÑZi ¡4&­ A”ÑZiÇ b!iÄdA”ÑZjtB*P#A”ÑZjC€ y#ùˆA”ÑZjZàø$·8 A”ÑZjÅ€À$C6;+A”ÑZk ¾Î A”ÑZk* Ê(» A”ÑZkHà +ô#œ A”ÑZk¢à ;¹»æA”ÑZl< „" A”ÑZmö eÓ%> A”ÑZo á53˜A”ÑZoÀä01 A”ÑZoâ Øu,áA”ÑZpH€ž& ÈA”ÑZp`€5'f GA”ÑZq9@íPHA”ÑZquà*m4S +A”ÑZr׎3í&A”ÑZsd` +„/áJ A”ÑZt ñËDA”ÑZuxÀV$Q$6A”ÑZv?€›)Ó÷VA”ÑZvKàTÉ¿A”ÑZv_†“#¶A”ÑZvË ½Œ +A”ÑZw7@úž/`A”ÑZxD@¥+Ô;A”ÑZy% Ñ T,cA”ÑZyÊ`B//C A”ÑZyæ â0«+‘A”ÑZz-@Ê!Q*ËA”ÑZ{F 5A4A”ÑZ|I4 +1˜A”ÑZ|\cº+oA”ÑZ|î` •8²!·A”ÑZ}R ˜)N!èA”ÑZ}lÀ Y ICA”ÑZ}v`.sÑA”ÑZ~™ › O, A”ÑZ7` °$`,znA”ÑZ­à$ü¡¡A”ÑZ·ÀÛQ ÃA”ÑZçÀ¤!æd A”ÑZ€SÀöï3 A”ÑZ€§€sŠ¹ A”ÑZ‚ÚàÈhA”ÑZ„k€á5"W?A”ÑZ„Ï AÍ%,A”ÑZ„çÀ Œ*ú/m A”ÑZ…fŸ' A”ÑZ…` 0þ… +A”ÑZ…Â@×$"ÓA”ÑZ†E€ - +Œ%'$A”ÑZ†nÀ [ Aw A”ÑZ‡ #ú#Ž5A”ÑZ‡qà …+Œ'þA”ÑZˆÀ +Ñ wA”ÑZŠî€¨šA”ÑZ‹ð@ó'Ä04A”ÑZŒ ÞÞéA”ÑZŒí@Êì'~A”ÑZ¯@ Ž^#L A”ÑZa€ pà8¼ A”ÑZ¢à*$â A”ÑZÆ`J#(&òA”ÑZNà ÒA”ÑZ”; 3$±+÷A”ÑZ”\ÀSß1ŠA”ÑZ–—`Z9?gA”ÑZ—ZÀ¡/‚%A”ÑZ˜ {›ãA”ÑZ˜]À(Ï(ÔA”ÑZ™·@ È®) +A”ÑZšàD¸¡A”ÑZš™à>"ý0A”ÑZ›ª@_• ¼ A”ÑZœ_À +O¹A”ÑZœ‰/˜+ñ A”ÑZœ¶  +Ø)sA”ÑZœí€ "(œ A”ÑZ†€ % ZA”ÑZÃàš/ç>A”ÑZž*2¬¦A”ÑZŸ® îLVA”ÑZ¡Ë€É½n-A”ÑZ¢ ¹)ø#Ó A”ÑZ¢p€ h&&A”ÑZ¢½  i é)¦9A”ÑZ¢ã Ú' A”ÑZ£U  A-¸A”ÑZ£…À³ß%y A”ÑZ£ù` ß¼bOA”ÑZ¤UÀõ3´P A”ÑZ¤©à‰&Á$œA”ÑZ¥ - 5U A”ÑZ¥´ ™$× +A”ÑZ§‰@,Ë@ A”ÑZ¨F@'*ë +A”ÑZ¨H`E4N,.A”ÑZ¨ƒ@fs&×A”ÑZ¨‘€ ô&ÿA”ÑZ©] ´5Ø# +A”ÑZ©j  ,%0< +A”ÑZª#  +p.b1A”ÑZ«EÀŽ•)ÄA”ÑZ¬ªà ç"â/A”ÑZ¬Ö@Ó%¼0Q A”ÑZ­ !Â!9}A”ÑZ®u@G‹#| +A”ÑZ®Š  y)b%A”ÑZ®£@ ФlA”ÑZ®ñ€Û!7i A”ÑZ°ZS/&)A”ÑZ±  è0=2ó&A”ÑZ²+@ "M g#A”ÑZ²àV'‘ÿA”ÑZ²å€ àÝA”ÑZ³_ठ+A”ÑZ³z€I7A”ÑZ³¤È'î*L A”ÑZµ9@ (‚ _A”ÑZ¶?À^1EA”ÑZ¸Œ 6Šh!A”ÑZ¹Ù`-,ÒÊ=A”ÑZ¹ù Å#ÿ'yA”ÑZº_ +Ø7eëA”ÑZº€"­JA”ÑZº’  '±7?A”ÑZ»cÀ> ¢$¥A”ÑZ»Ë€ —0(ÆA”ÑZ¼ƒ`‡t8ïA”ÑZ½)À¯ èA”ÑZ½²@Î-  A”ÑZ½åÀs™›A”ÑZ¾V€h„A”ÑZ¿tiA”ÑZ¿Ëà•`+vA”ÑZÁ7 ³% þèA”ÑZÁ…à=9;~ A”ÑZÁ“ ”+$ÎA”ÑZÁ¢  ß³!ü“A”ÑZÁð « odA”ÑZ‚ÀÜ!\ A”ÑZÂ…@Â'y,¨A”ÑZ¬àäGaA”ÑZÃïàÑæ*r +A”ÑZÄnÀ î'! A”ÑZÄÍÀï1ºuA”ÑZÄ× ÿ0 Y A”ÑZÆ*` ë3¢EA”ÑZƪ` F A”ÑZÈEà \ No newline at end of file diff --git a/pkg/tbtables/cfitsio/listhead.c b/pkg/tbtables/cfitsio/listhead.c new file mode 100644 index 00000000..a9a62384 --- /dev/null +++ b/pkg/tbtables/cfitsio/listhead.c @@ -0,0 +1,62 @@ +#include +#include +#include "fitsio.h" + +int main(int argc, char *argv[]) +{ + fitsfile *fptr; /* FITS file pointer, defined in fitsio.h */ + char card[FLEN_CARD]; /* Standard string lengths defined in fitsio.h */ + int status = 0, single = 0, hdupos, nkeys, ii; + + if (argc != 2) { + printf("Usage: listhead filename[ext] \n"); + printf("\n"); + printf("List the FITS header keywords in a single extension, or, if \n"); + printf("ext is not given, list the keywords in all the extensions. \n"); + printf("\n"); + printf("Examples: \n"); + printf(" listhead file.fits - list every header in the file \n"); + printf(" listhead file.fits[0] - list primary array header \n"); + printf(" listhead file.fits[2] - list header of 2nd extension \n"); + printf(" listhead file.fits+2 - same as above \n"); + printf(" listhead file.fits[GTI] - list header of GTI extension\n"); + printf("\n"); + printf("Note that it may be necessary to enclose the input file\n"); + printf("name in single quote characters on the Unix command line.\n"); + return(0); + } + + if (!fits_open_file(&fptr, argv[1], READONLY, &status)) + { + fits_get_hdu_num(fptr, &hdupos); /* Get the current HDU position */ + + /* List only a single header if a specific extension was given */ + if (hdupos != 1 || strchr(argv[1], '[')) single = 1; + + for (; !status; hdupos++) /* Main loop through each extension */ + { + fits_get_hdrspace(fptr, &nkeys, NULL, &status); /* get # of keywords */ + + printf("Header listing for HDU #%d:\n", hdupos); + + for (ii = 1; ii <= nkeys; ii++) { /* Read and print each keywords */ + + if (fits_read_record(fptr, ii, card, &status))break; + printf("%s\n", card); + } + printf("END\n\n"); /* terminate listing with END */ + + if (single) break; /* quit if only listing a single header */ + + fits_movrel_hdu(fptr, 1, NULL, &status); /* try to move to next HDU */ + } + + if (status == END_OF_FILE) status = 0; /* Reset after normal error */ + + fits_close_file(fptr, &status); + } + + if (status) fits_report_error(stderr, status); /* print any error message */ + return(status); +} + diff --git a/pkg/tbtables/cfitsio/longnam.h b/pkg/tbtables/cfitsio/longnam.h new file mode 100644 index 00000000..de8c0545 --- /dev/null +++ b/pkg/tbtables/cfitsio/longnam.h @@ -0,0 +1,538 @@ +#ifndef _LONGNAME_H +#define _LONGNAME_H + +#define fits_parse_input_url ffiurl +#define fits_parse_rootname ffrtnm +#define fits_file_exists ffexist +#define fits_parse_output_url ffourl +#define fits_parse_extspec ffexts +#define fits_parse_extnum ffextn +#define fits_parse_binspec ffbins +#define fits_parse_binrange ffbinr +#define fits_parse_range ffrwrg +#define fits_open_memfile ffomem +#define fits_open_file ffopen +#define fits_open_data ffdopn +#define fits_open_table fftopn +#define fits_open_image ffiopn +#define fits_open_diskfile ffdkopn +#define fits_reopen_file ffreopen +#define fits_create_file ffinit +#define fits_create_diskfile ffdkinit +#define fits_create_memfile ffimem +#define fits_create_template fftplt +#define fits_flush_file ffflus +#define fits_flush_buffer ffflsh +#define fits_close_file ffclos +#define fits_delete_file ffdelt +#define fits_file_name ffflnm +#define fits_file_mode ffflmd +#define fits_url_type ffurlt + +#define fits_get_version ffvers +#define fits_uppercase ffupch +#define fits_get_errstatus ffgerr +#define fits_write_errmsg ffpmsg +#define fits_write_errmark ffpmrk +#define fits_read_errmsg ffgmsg +#define fits_clear_errmsg ffcmsg +#define fits_clear_errmark ffcmrk +#define fits_report_error ffrprt +#define fits_compare_str ffcmps +#define fits_test_keyword fftkey +#define fits_test_record fftrec +#define fits_null_check ffnchk +#define fits_make_keyn ffkeyn +#define fits_make_nkey ffnkey +#define fits_get_keyclass ffgkcl +#define fits_get_keytype ffdtyp +#define fits_parse_value ffpsvc +#define fits_get_keyname ffgknm +#define fits_parse_template ffgthd +#define fits_ascii_tform ffasfm +#define fits_binary_tform ffbnfm +#define fits_get_tbcol ffgabc +#define fits_get_rowsize ffgrsz +#define fits_get_col_display_width ffgcdw + +#define fits_write_record ffprec +#define fits_write_key ffpky +#define fits_write_key_unit ffpunt +#define fits_write_comment ffpcom +#define fits_write_history ffphis +#define fits_write_date ffpdat +#define fits_get_system_time ffgstm +#define fits_get_system_date ffgsdt +#define fits_date2str ffdt2s +#define fits_time2str fftm2s +#define fits_str2date ffs2dt +#define fits_str2time ffs2tm +#define fits_write_key_longstr ffpkls +#define fits_write_key_longwarn ffplsw +#define fits_write_key_null ffpkyu +#define fits_write_key_str ffpkys +#define fits_write_key_log ffpkyl +#define fits_write_key_lng ffpkyj +#define fits_write_key_fixflt ffpkyf +#define fits_write_key_flt ffpkye +#define fits_write_key_fixdbl ffpkyg +#define fits_write_key_dbl ffpkyd +#define fits_write_key_fixcmp ffpkfc +#define fits_write_key_cmp ffpkyc +#define fits_write_key_fixdblcmp ffpkfm +#define fits_write_key_dblcmp ffpkym +#define fits_write_key_triple ffpkyt +#define fits_write_tdim ffptdm +#define fits_write_keys_str ffpkns +#define fits_write_keys_log ffpknl +#define fits_write_keys_lng ffpknj +#define fits_write_keys_fixflt ffpknf +#define fits_write_keys_flt ffpkne +#define fits_write_keys_fixdbl ffpkng +#define fits_write_keys_dbl ffpknd +#define fits_copy_key ffcpky +#define fits_write_imghdr ffphps +#define fits_write_grphdr ffphpr +#define fits_write_atblhdr ffphtb +#define fits_write_btblhdr ffphbn +#define fits_write_key_template ffpktp + +#define fits_get_hdrspace ffghsp +#define fits_get_hdrpos ffghps +#define fits_movabs_key ffmaky +#define fits_movrel_key ffmrky +#define fits_find_nextkey ffgnxk + +#define fits_read_record ffgrec +#define fits_read_card ffgcrd +#define fits_read_key_unit ffgunt +#define fits_read_keyn ffgkyn +#define fits_read_key ffgky +#define fits_read_keyword ffgkey +#define fits_read_key_str ffgkys +#define fits_read_key_log ffgkyl +#define fits_read_key_lng ffgkyj +#define fits_read_key_flt ffgkye +#define fits_read_key_dbl ffgkyd +#define fits_read_key_cmp ffgkyc +#define fits_read_key_dblcmp ffgkym +#define fits_read_key_triple ffgkyt +#define fits_read_key_longstr ffgkls +#define fits_read_tdim ffgtdm +#define fits_decode_tdim ffdtdm +#define fits_read_keys_str ffgkns +#define fits_read_keys_log ffgknl +#define fits_read_keys_lng ffgknj +#define fits_read_keys_flt ffgkne +#define fits_read_keys_dbl ffgknd +#define fits_read_imghdr ffghpr +#define fits_read_atblhdr ffghtb +#define fits_read_btblhdr ffghbn +#define fits_hdr2str ffhdr2str + +#define fits_update_card ffucrd +#define fits_update_key ffuky +#define fits_update_key_null ffukyu +#define fits_update_key_str ffukys +#define fits_update_key_longstr ffukls +#define fits_update_key_log ffukyl +#define fits_update_key_lng ffukyj +#define fits_update_key_fixflt ffukyf +#define fits_update_key_flt ffukye +#define fits_update_key_fixdbl ffukyg +#define fits_update_key_dbl ffukyd +#define fits_update_key_fixcmp ffukfc +#define fits_update_key_cmp ffukyc +#define fits_update_key_fixdblcmp ffukfm +#define fits_update_key_dblcmp ffukym + +#define fits_modify_record ffmrec +#define fits_modify_card ffmcrd +#define fits_modify_name ffmnam +#define fits_modify_comment ffmcom +#define fits_modify_key_null ffmkyu +#define fits_modify_key_str ffmkys +#define fits_modify_key_longstr ffmkls +#define fits_modify_key_log ffmkyl +#define fits_modify_key_lng ffmkyj +#define fits_modify_key_fixflt ffmkyf +#define fits_modify_key_flt ffmkye +#define fits_modify_key_fixdbl ffmkyg +#define fits_modify_key_dbl ffmkyd +#define fits_modify_key_fixcmp ffmkfc +#define fits_modify_key_cmp ffmkyc +#define fits_modify_key_fixdblcmp ffmkfm +#define fits_modify_key_dblcmp ffmkym + +#define fits_insert_record ffirec +#define fits_insert_card ffikey +#define fits_insert_key_null ffikyu +#define fits_insert_key_str ffikys +#define fits_insert_key_longstr ffikls +#define fits_insert_key_log ffikyl +#define fits_insert_key_lng ffikyj +#define fits_insert_key_fixflt ffikyf +#define fits_insert_key_flt ffikye +#define fits_insert_key_fixdbl ffikyg +#define fits_insert_key_dbl ffikyd +#define fits_insert_key_fixcmp ffikfc +#define fits_insert_key_cmp ffikyc +#define fits_insert_key_fixdblcmp ffikfm +#define fits_insert_key_dblcmp ffikym + +#define fits_delete_key ffdkey +#define fits_delete_record ffdrec +#define fits_get_hdu_num ffghdn +#define fits_get_hdu_type ffghdt +#define fits_get_hduaddr ffghad +#define fits_get_hduoff ffghof + +#define fits_get_img_param ffgipr +#define fits_get_img_type ffgidt +#define fits_get_img_equivtype ffgiet +#define fits_get_img_dim ffgidm +#define fits_get_img_size ffgisz + +#define fits_movabs_hdu ffmahd +#define fits_movrel_hdu ffmrhd +#define fits_movnam_hdu ffmnhd +#define fits_get_num_hdus ffthdu +#define fits_create_img ffcrim +#define fits_create_tbl ffcrtb +#define fits_create_hdu ffcrhd +#define fits_insert_img ffiimg +#define fits_insert_atbl ffitab +#define fits_insert_btbl ffibin +#define fits_resize_img ffrsim +#define fits_delete_hdu ffdhdu +#define fits_copy_hdu ffcopy +#define fits_copy_file ffcpfl +#define fits_copy_header ffcphd +#define fits_copy_data ffcpdt + +#define fits_set_hdustruc ffrdef +#define fits_set_hdrsize ffhdef +#define fits_write_theap ffpthp + +#define fits_encode_chksum ffesum +#define fits_decode_chksum ffdsum +#define fits_write_chksum ffpcks +#define fits_update_chksum ffupck +#define fits_verify_chksum ffvcks +#define fits_get_chksum ffgcks + +#define fits_set_bscale ffpscl +#define fits_set_tscale fftscl +#define fits_set_imgnull ffpnul +#define fits_set_btblnull fftnul +#define fits_set_atblnull ffsnul + +#define fits_get_colnum ffgcno +#define fits_get_colname ffgcnn +#define fits_get_coltype ffgtcl +#define fits_get_eqcoltype ffeqty +#define fits_get_num_rows ffgnrw +#define fits_get_num_cols ffgncl +#define fits_get_acolparms ffgacl +#define fits_get_bcolparms ffgbcl + +#define fits_iterate_data ffiter + +#define fits_read_grppar_byt ffggpb +#define fits_read_grppar_sbyt ffggpsb +#define fits_read_grppar_usht ffggpui +#define fits_read_grppar_ulng ffggpuj +#define fits_read_grppar_sht ffggpi +#define fits_read_grppar_lng ffggpj +#define fits_read_grppar_lnglng ffggpjj +#define fits_read_grppar_int ffggpk +#define fits_read_grppar_uint ffggpuk +#define fits_read_grppar_flt ffggpe +#define fits_read_grppar_dbl ffggpd + +#define fits_read_pix ffgpxv +#define fits_read_pixnull ffgpxf +#define fits_read_img ffgpv +#define fits_read_imgnull ffgpf +#define fits_read_img_byt ffgpvb +#define fits_read_img_sbyt ffgpvsb +#define fits_read_img_usht ffgpvui +#define fits_read_img_ulng ffgpvuj +#define fits_read_img_sht ffgpvi +#define fits_read_img_lng ffgpvj +#define fits_read_img_lnglng ffgpvjj +#define fits_read_img_uint ffgpvuk +#define fits_read_img_int ffgpvk +#define fits_read_img_flt ffgpve +#define fits_read_img_dbl ffgpvd + +#define fits_read_imgnull_byt ffgpfb +#define fits_read_imgnull_sbyt ffgpfsb +#define fits_read_imgnull_usht ffgpfui +#define fits_read_imgnull_ulng ffgpfuj +#define fits_read_imgnull_sht ffgpfi +#define fits_read_imgnull_lng ffgpfj +#define fits_read_imgnull_lnglng ffgpfjj +#define fits_read_imgnull_uint ffgpfuk +#define fits_read_imgnull_int ffgpfk +#define fits_read_imgnull_flt ffgpfe +#define fits_read_imgnull_dbl ffgpfd + +#define fits_read_2d_byt ffg2db +#define fits_read_2d_sbyt ffg2dsb +#define fits_read_2d_usht ffg2dui +#define fits_read_2d_ulng ffg2duj +#define fits_read_2d_sht ffg2di +#define fits_read_2d_lng ffg2dj +#define fits_read_2d_lnglng ffg2djj +#define fits_read_2d_uint ffg2duk +#define fits_read_2d_int ffg2dk +#define fits_read_2d_flt ffg2de +#define fits_read_2d_dbl ffg2dd + +#define fits_read_3d_byt ffg3db +#define fits_read_3d_sbyt ffg3dsb +#define fits_read_3d_usht ffg3dui +#define fits_read_3d_ulng ffg3duj +#define fits_read_3d_sht ffg3di +#define fits_read_3d_lng ffg3dj +#define fits_read_3d_lnglng ffg3djj +#define fits_read_3d_uint ffg3duk +#define fits_read_3d_int ffg3dk +#define fits_read_3d_flt ffg3de +#define fits_read_3d_dbl ffg3dd + +#define fits_read_subset ffgsv +#define fits_read_subset_byt ffgsvb +#define fits_read_subset_sbyt ffgsvsb +#define fits_read_subset_usht ffgsvui +#define fits_read_subset_ulng ffgsvuj +#define fits_read_subset_sht ffgsvi +#define fits_read_subset_lng ffgsvj +#define fits_read_subset_lnglng ffgsvjj +#define fits_read_subset_uint ffgsvuk +#define fits_read_subset_int ffgsvk +#define fits_read_subset_flt ffgsve +#define fits_read_subset_dbl ffgsvd + +#define fits_read_subsetnull_byt ffgsfb +#define fits_read_subsetnull_sbyt ffgsfsb +#define fits_read_subsetnull_usht ffgsfui +#define fits_read_subsetnull_ulng ffgsfuj +#define fits_read_subsetnull_sht ffgsfi +#define fits_read_subsetnull_lng ffgsfj +#define fits_read_subsetnull_lnglng ffgsfjj +#define fits_read_subsetnull_uint ffgsfuk +#define fits_read_subsetnull_int ffgsfk +#define fits_read_subsetnull_flt ffgsfe +#define fits_read_subsetnull_dbl ffgsfd + +#define fits_compress_img fits_comp_img +#define fits_decompress_img fits_decomp_img + +#define fits_read_col ffgcv +#define fits_read_colnull ffgcf +#define fits_read_col_str ffgcvs +#define fits_read_col_log ffgcvl +#define fits_read_col_byt ffgcvb +#define fits_read_col_sbyt ffgcvsb +#define fits_read_col_usht ffgcvui +#define fits_read_col_ulng ffgcvuj +#define fits_read_col_sht ffgcvi +#define fits_read_col_lng ffgcvj +#define fits_read_col_lnglng ffgcvjj +#define fits_read_col_uint ffgcvuk +#define fits_read_col_int ffgcvk +#define fits_read_col_flt ffgcve +#define fits_read_col_dbl ffgcvd +#define fits_read_col_cmp ffgcvc +#define fits_read_col_dblcmp ffgcvm +#define fits_read_col_bit ffgcx +#define fits_read_col_bit_usht ffgcxui +#define fits_read_col_bit_uint ffgcxuk + +#define fits_read_colnull_str ffgcfs +#define fits_read_colnull_log ffgcfl +#define fits_read_colnull_byt ffgcfb +#define fits_read_colnull_sbyt ffgcfsb +#define fits_read_colnull_usht ffgcfui +#define fits_read_colnull_ulng ffgcfuj +#define fits_read_colnull_sht ffgcfi +#define fits_read_colnull_lng ffgcfj +#define fits_read_colnull_lnglng ffgcfjj +#define fits_read_colnull_uint ffgcfuk +#define fits_read_colnull_int ffgcfk +#define fits_read_colnull_flt ffgcfe +#define fits_read_colnull_dbl ffgcfd +#define fits_read_colnull_cmp ffgcfc +#define fits_read_colnull_dblcmp ffgcfm + +#define fits_read_descript ffgdes +#define fits_read_descripts ffgdess +#define fits_read_tblbytes ffgtbb + +#define fits_write_grppar_byt ffpgpb +#define fits_write_grppar_sbyt ffpgpsb +#define fits_write_grppar_usht ffpgpui +#define fits_write_grppar_ulng ffpgpuj +#define fits_write_grppar_sht ffpgpi +#define fits_write_grppar_lng ffpgpj +#define fits_write_grppar_lnglng ffpgpjj +#define fits_write_grppar_uint ffpgpuk +#define fits_write_grppar_int ffpgpk +#define fits_write_grppar_flt ffpgpe +#define fits_write_grppar_dbl ffpgpd + +#define fits_write_pix ffppx +#define fits_write_pixnull ffppxn +#define fits_write_img ffppr +#define fits_write_img_byt ffpprb +#define fits_write_img_sbyt ffpprsb +#define fits_write_img_usht ffpprui +#define fits_write_img_ulng ffppruj +#define fits_write_img_sht ffppri +#define fits_write_img_lng ffpprj +#define fits_write_img_lnglng ffpprjj +#define fits_write_img_uint ffppruk +#define fits_write_img_int ffpprk +#define fits_write_img_flt ffppre +#define fits_write_img_dbl ffpprd + +#define fits_write_imgnull ffppn +#define fits_write_imgnull_byt ffppnb +#define fits_write_imgnull_sbyt ffppnsb +#define fits_write_imgnull_usht ffppnui +#define fits_write_imgnull_ulng ffppnuj +#define fits_write_imgnull_sht ffppni +#define fits_write_imgnull_lng ffppnj +#define fits_write_imgnull_lnglng ffppnjj +#define fits_write_imgnull_uint ffppnuk +#define fits_write_imgnull_int ffppnk +#define fits_write_imgnull_flt ffppne +#define fits_write_imgnull_dbl ffppnd + +#define fits_write_img_null ffppru +#define fits_write_null_img ffpprn + +#define fits_write_2d_byt ffp2db +#define fits_write_2d_sbyt ffp2dsb +#define fits_write_2d_usht ffp2dui +#define fits_write_2d_ulng ffp2duj +#define fits_write_2d_sht ffp2di +#define fits_write_2d_lng ffp2dj +#define fits_write_2d_lnglng ffp2djj +#define fits_write_2d_uint ffp2duk +#define fits_write_2d_int ffp2dk +#define fits_write_2d_flt ffp2de +#define fits_write_2d_dbl ffp2dd + +#define fits_write_3d_byt ffp3db +#define fits_write_3d_sbyt ffp3dsb +#define fits_write_3d_usht ffp3dui +#define fits_write_3d_ulng ffp3duj +#define fits_write_3d_sht ffp3di +#define fits_write_3d_lng ffp3dj +#define fits_write_3d_lnglng ffp3djj +#define fits_write_3d_uint ffp3duk +#define fits_write_3d_int ffp3dk +#define fits_write_3d_flt ffp3de +#define fits_write_3d_dbl ffp3dd + +#define fits_write_subset ffpss +#define fits_write_subset_byt ffpssb +#define fits_write_subset_sbyt ffpsssb +#define fits_write_subset_usht ffpssui +#define fits_write_subset_ulng ffpssuj +#define fits_write_subset_sht ffpssi +#define fits_write_subset_lng ffpssj +#define fits_write_subset_lnglng ffpssjj +#define fits_write_subset_uint ffpssuk +#define fits_write_subset_int ffpssk +#define fits_write_subset_flt ffpsse +#define fits_write_subset_dbl ffpssd + +#define fits_write_col ffpcl +#define fits_write_col_str ffpcls +#define fits_write_col_log ffpcll +#define fits_write_col_byt ffpclb +#define fits_write_col_sbyt ffpclsb +#define fits_write_col_usht ffpclui +#define fits_write_col_ulng ffpcluj +#define fits_write_col_sht ffpcli +#define fits_write_col_lng ffpclj +#define fits_write_col_lnglng ffpcljj +#define fits_write_col_uint ffpcluk +#define fits_write_col_int ffpclk +#define fits_write_col_flt ffpcle +#define fits_write_col_dbl ffpcld +#define fits_write_col_cmp ffpclc +#define fits_write_col_dblcmp ffpclm +#define fits_write_col_null ffpclu +#define fits_write_col_bit ffpclx + +#define fits_write_colnull ffpcn +#define fits_write_colnull_str ffpcns +#define fits_write_colnull_log ffpcnl +#define fits_write_colnull_byt ffpcnb +#define fits_write_colnull_sbyt ffpcnsb +#define fits_write_colnull_usht ffpcnui +#define fits_write_colnull_ulng ffpcnuj +#define fits_write_colnull_sht ffpcni +#define fits_write_colnull_lng ffpcnj +#define fits_write_colnull_lnglng ffpcnjj +#define fits_write_colnull_uint ffpcnuk +#define fits_write_colnull_int ffpcnk +#define fits_write_colnull_flt ffpcne +#define fits_write_colnull_dbl ffpcnd + +#define fits_write_descript ffpdes +#define fits_compress_heap ffcmph +#define fits_test_heap fftheap + +#define fits_write_tblbytes ffptbb +#define fits_insert_rows ffirow +#define fits_delete_rows ffdrow +#define fits_delete_rowrange ffdrrg +#define fits_delete_rowlist ffdrws +#define fits_insert_col fficol +#define fits_insert_cols fficls +#define fits_delete_col ffdcol +#define fits_copy_col ffcpcl +#define fits_modify_vector_len ffmvec + +#define fits_read_img_coord ffgics +#define fits_read_tbl_coord ffgtcs +#define fits_pix_to_world ffwldp +#define fits_world_to_pix ffxypx + +#define fits_get_image_wcs_keys ffgiwcs +#define fits_get_table_wcs_keys ffgtwcs + +#define fits_find_rows fffrow +#define fits_find_first_row ffffrw +#define fits_find_rows_cmp fffrwc +#define fits_select_rows ffsrow +#define fits_calc_rows ffcrow +#define fits_calculator ffcalc +#define fits_calculator_rng ffcalc_rng +#define fits_test_expr fftexp + +#define fits_create_group ffgtcr +#define fits_insert_group ffgtis +#define fits_change_group ffgtch +#define fits_remove_group ffgtrm +#define fits_copy_group ffgtcp +#define fits_merge_groups ffgtmg +#define fits_compact_group ffgtcm +#define fits_verify_group ffgtvf +#define fits_open_group ffgtop +#define fits_add_group_member ffgtam +#define fits_get_num_members ffgtnm + +#define fits_get_num_groups ffgmng +#define fits_open_member ffgmop +#define fits_copy_member ffgmcp +#define fits_transfer_member ffgmtf +#define fits_remove_member ffgmrm + +#endif diff --git a/pkg/tbtables/cfitsio/make_dfloat.com b/pkg/tbtables/cfitsio/make_dfloat.com new file mode 100644 index 00000000..eb12ce9a --- /dev/null +++ b/pkg/tbtables/cfitsio/make_dfloat.com @@ -0,0 +1,83 @@ +$ ! Command file to build the CFITSIO library on a VMS systems (VAX or Alpha) +$ set verify +$ cc/float=d_float buffers.c +$ cc/float=d_float cfileio.c +$ cc/float=d_float checksum.c +$ cc/float=d_float compress.c +$ cc/float=d_float drvrfile.c +$ cc/float=d_float drvrmem.c +$ ! cc/float=d_float drvrnet.c not currently supported on VMS +$ ! cc/float=d_float drvsmem.c not currently supported on VMS +$ cc/float=d_float editcol.c +$ cc/float=d_float edithdu.c +$ cc/float=d_float eval_f.c +$ cc/float=d_float eval_l.c +$ cc/float=d_float eval_y.c +$ cc/float=d_float fitscore.c +$ cc/float=d_float f77_wrap1.c +$ cc/float=d_float f77_wrap2.c +$ cc/float=d_float getcol.c +$ cc/float=d_float getcolb.c +$ cc/float=d_float getcoli.c +$ cc/float=d_float getcolj.c +$ cc/float=d_float getcolui.c +$ cc/float=d_float getcoluj.c +$ cc/float=d_float getcoluk.c +$ cc/float=d_float getcolk.c +$ cc/float=d_float getcole.c +$ cc/float=d_float getcold.c +$ cc/float=d_float getcoll.c +$ cc/float=d_float getcols.c +$ cc/float=d_float getkey.c +$ cc/float=d_float group.c +$ cc/float=d_float grparser.c +$ cc/float=d_float histo.c +$ cc/float=d_float iraffits.c +$ cc/float=d_float modkey.c +$ cc/float=d_float putcol.c +$ cc/float=d_float putcolb.c +$ cc/float=d_float putcoli.c +$ cc/float=d_float putcolj.c +$ cc/float=d_float putcolk.c +$ cc/float=d_float putcolui.c +$ cc/float=d_float putcoluj.c +$ cc/float=d_float putcoluk.c +$ cc/float=d_float putcole.c +$ cc/float=d_float putcold.c +$ cc/float=d_float putcols.c +$ cc/float=d_float putcoll.c +$ cc/float=d_float putcolu.c +$ cc/float=d_float putkey.c +$ cc/float=d_float region.c +$ cc/float=d_float scalnull.c +$ cc/float=d_float swapproc.c +$ cc/float=d_float wcsutil.c +$ cc/float=d_float wcssub.c +$ cc/float=d_float imcompress.c +$ cc/float=d_float quantize.c +$ cc/float=d_float ricecomp.c +$ cc/float=d_float pliocomp.c +$ lib/create cfitsio buffers,cfileio,checksum,compress,drvrfile,drvrmem +$ lib/insert cfitsio editcol,edithdu,eval_f,eval_l,eval_y,f77_wrap1,f77_wrap2 +$ lib/insert cfitsio fitscore,getcol,getcolb,getcoli,getcolj,getcolk,getcole +$ lib/insert cfitsio getcold,getcoll,getcols,getcolui,getcoluj,getcoluk +$ lib/insert cfitsio getkey,group,grparser,histo,iraffits,modkey,putcol,putcolb +$ lib/insert cfitsio putcoli,putcolj,putcolk,putcole,putcold,putcolui +$ lib/insert cfitsio putcoluj,putcoluk,putcols,putcoll,putcolu,putkey,region +$ lib/insert cfitsio scalnull,swapproc,wcsutil,wcssub +$ lib/insert cfitsio imcompress,quantize,ricecomp,pliocomp +$ ! +$ if (F$GETSYI("ARCH_NAME") .eqs. "VAX") then goto VAX +$ ! add C routine needed on Alpha to do D_FLOAT conversions +$ cc/float=d_float vmsieee.c +$ lib/insert cfitsio vmsieee +$ set noverify +$ exit +$ ! +$ VAX: +$ ! add macro routines not needed on Alpha and only used on VAX +$ macro vmsieeer.mar +$ macro vmsieeed.mar +$ lib/insert cfitsio vmsieeer,vmsieeed +$ set noverify +$ exit diff --git a/pkg/tbtables/cfitsio/make_gfloat.com b/pkg/tbtables/cfitsio/make_gfloat.com new file mode 100644 index 00000000..b0d07bab --- /dev/null +++ b/pkg/tbtables/cfitsio/make_gfloat.com @@ -0,0 +1,81 @@ +$ ! Command file to build the CFITSIO library on a VMS systems (VAX or Alpha) +$ ! This uses the default /float=G_FLOAT option on the Alpha +$ set verify +$ cc buffers.c +$ cc cfileio.c +$ cc checksum.c +$ cc compress.c +$ cc drvrfile.c +$ cc drvrmem.c +$ ! cc drvrnet.c not currently supported on VMS +$ ! cc drvsmem.c not currently supported on VMS +$ cc editcol.c +$ cc edithdu.c +$ cc eval_f.c +$ cc eval_l.c +$ cc eval_y.c +$ cc fitscore.c +$ cc f77_wrap1.c +$ cc f77_wrap2.c +$ cc getcol.c +$ cc getcolb.c +$ cc getcoli.c +$ cc getcolj.c +$ cc getcolui.c +$ cc getcoluj.c +$ cc getcoluk.c +$ cc getcolk.c +$ cc getcole.c +$ cc getcold.c +$ cc getcoll.c +$ cc getcols.c +$ cc getkey.c +$ cc group.c +$ cc grparser.c +$ cc histo.c +$ cc iraffits.c +$ cc modkey.c +$ cc putcol.c +$ cc putcolb.c +$ cc putcoli.c +$ cc putcolj.c +$ cc putcolk.c +$ cc putcolui.c +$ cc putcoluj.c +$ cc putcoluk.c +$ cc putcole.c +$ cc putcold.c +$ cc putcols.c +$ cc putcoll.c +$ cc putcolu.c +$ cc putkey.c +$ cc region.c +$ cc scalnull.c +$ cc swapproc.c +$ cc wcsutil.c +$ cc wcssub.c +$ cc imcompress.c +$ cc quantize.c +$ cc ricecomp.c +$ cc pliocomp.c +$ lib/create cfitsio buffers,cfileio,checksum,compress,drvrfile,drvrmem +$ lib/insert cfitsio editcol,edithdu,eval_f,eval_l,eval_y,f77_wrap1,f77_wrap2 +$ lib/insert cfitsio fitscore,getcol,getcolb,getcoli,getcolj,getcolk,getcole +$ lib/insert cfitsio getcold,getcoll,getcols,getcolui,getcoluj,getcoluk +$ lib/insert cfitsio getkey,group,grparser,histo,iraffits,modkey,putcol,putcolb +$ lib/insert cfitsio putcoli,putcolj,putcolk,putcole,putcold,putcolui +$ lib/insert cfitsio putcoluj,putcoluk,putcols,putcoll,putcolu,putkey,region +$ lib/insert cfitsio scalnull,swapproc,wcsutil,wcssub +$ lib/insert cfitsio imcompress,quantize,ricecomp,pliocomp +$ ! +$ if (F$GETSYI("ARCH_NAME") .eqs. "VAX") then goto VAX +$ set noverify +$ exit +$ ! +$ VAX: +$ ! add macro routines not needed on Alpha and only used on VAX +$ macro vmsieeer.mar +$ macro vmsieeed.mar +$ lib/insert cfitsio vmsieeer,vmsieeed +$ set noverify +$ exit diff --git a/pkg/tbtables/cfitsio/make_ieee.com b/pkg/tbtables/cfitsio/make_ieee.com new file mode 100644 index 00000000..f4c5f1d8 --- /dev/null +++ b/pkg/tbtables/cfitsio/make_ieee.com @@ -0,0 +1,80 @@ +$ ! Command file to build the CFITSIO library on a VMS systems (VAX or Alpha) +$ set verify +$ cc/float=ieee_float buffers.c +$ cc/float=ieee_float cfileio.c +$ cc/float=ieee_float checksum.c +$ cc/float=ieee_float compress.c +$ cc/float=ieee_float drvrfile.c +$ cc/float=ieee_float drvrmem.c +$ ! cc/float=ieee_float drvrnet.c not currently supported on VMS +$ ! cc/float=ieee_float drvsmem.c not currently supported on VMS +$ cc/float=ieee_float editcol.c +$ cc/float=ieee_float edithdu.c +$ cc/float=ieee_float eval_f.c +$ cc/float=ieee_float eval_l.c +$ cc/float=ieee_float eval_y.c +$ cc/float=ieee_float fitscore.c +$ cc/float=ieee_float f77_wrap1.c +$ cc/float=ieee_float f77_wrap2.c +$ cc/float=ieee_float getcol.c +$ cc/float=ieee_float getcolb.c +$ cc/float=ieee_float getcoli.c +$ cc/float=ieee_float getcolj.c +$ cc/float=ieee_float getcolui.c +$ cc/float=ieee_float getcoluj.c +$ cc/float=ieee_float getcoluk.c +$ cc/float=ieee_float getcolk.c +$ cc/float=ieee_float getcole.c +$ cc/float=ieee_float getcold.c +$ cc/float=ieee_float getcoll.c +$ cc/float=ieee_float getcols.c +$ cc/float=ieee_float getkey.c +$ cc/float=ieee_float group.c +$ cc/float=ieee_float grparser.c +$ cc/float=ieee_float histo.c +$ cc/float=ieee_float iraffits.c +$ cc/float=ieee_float modkey.c +$ cc/float=ieee_float putcol.c +$ cc/float=ieee_float putcolb.c +$ cc/float=ieee_float putcoli.c +$ cc/float=ieee_float putcolj.c +$ cc/float=ieee_float putcolk.c +$ cc/float=ieee_float putcolui.c +$ cc/float=ieee_float putcoluj.c +$ cc/float=ieee_float putcoluk.c +$ cc/float=ieee_float putcole.c +$ cc/float=ieee_float putcold.c +$ cc/float=ieee_float putcols.c +$ cc/float=ieee_float putcoll.c +$ cc/float=ieee_float putcolu.c +$ cc/float=ieee_float putkey.c +$ cc/float=ieee_float region.c +$ cc/float=ieee_float scalnull.c +$ cc/float=ieee_float swapproc.c +$ cc/float=ieee_float wcsutil.c +$ cc/float=ieee_float wcssub.c +$ cc/float=ieee_float imcompress.c +$ cc/float=ieee_float quantize.c +$ cc/float=ieee_float ricecomp.c +$ cc/float=ieee_float pliocomp.c +$ lib/create cfitsio buffers,cfileio,checksum,compress,drvrfile,drvrmem +$ lib/insert cfitsio editcol,edithdu,eval_f,eval_l,eval_y,f77_wrap1,f77_wrap2 +$ lib/insert cfitsio fitscore,getcol,getcolb,getcoli,getcolj,getcolk,getcole +$ lib/insert cfitsio getcold,getcoll,getcols,getcolui,getcoluj,getcoluk +$ lib/insert cfitsio getkey,group,grparser,histo,iraffits,modkey,putcol,putcolb +$ lib/insert cfitsio putcoli,putcolj,putcolk,putcole,putcold,putcolui +$ lib/insert cfitsio putcoluj,putcoluk,putcols,putcoll,putcolu,putkey,region +$ lib/insert cfitsio scalnull,swapproc,wcsutil,wcssub +$ lib/insert cfitsio imcompress,quantize,ricecomp,pliocomp +$ ! +$ if (F$GETSYI("ARCH_NAME") .eqs. "VAX") then goto VAX +$ set noverify +$ exit +$ ! +$ VAX: +$ ! add macro routines not needed on Alpha and only used on VAX +$ macro vmsieeer.mar +$ macro vmsieeed.mar +$ lib/insert cfitsio vmsieeer,vmsieeed +$ set noverify +$ exit diff --git a/pkg/tbtables/cfitsio/makefile.bc b/pkg/tbtables/cfitsio/makefile.bc new file mode 100644 index 00000000..d8fa69ec --- /dev/null +++ b/pkg/tbtables/cfitsio/makefile.bc @@ -0,0 +1,496 @@ +# +# Borland C++ IDE generated makefile +# Generated 10/12/99 at 1:24:11 PM +# +.AUTODEPEND + + +# +# Borland C++ tools +# +IMPLIB = Implib +BCC32 = Bcc32 +BccW32.cfg +BCC32I = Bcc32i +BccW32.cfg +TLINK32 = TLink32 +ILINK32 = Ilink32 +TLIB = TLib +BRC32 = Brc32 +TASM32 = Tasm32 +# +# IDE macros +# + + +# +# Options +# +IDE_LinkFLAGS32 = -LD:\BC5\LIB +LinkerLocalOptsAtC32_cfitsiodlib = -Tpd -ap -c +ResLocalOptsAtC32_cfitsiodlib = +BLocalOptsAtC32_cfitsiodlib = +CompInheritOptsAt_cfitsiodlib = -ID:\BC5\INCLUDE -D_RTLDLL -DWIN32; +LinkerInheritOptsAt_cfitsiodlib = -x +LinkerOptsAt_cfitsiodlib = $(LinkerLocalOptsAtC32_cfitsiodlib) +ResOptsAt_cfitsiodlib = $(ResLocalOptsAtC32_cfitsiodlib) +BOptsAt_cfitsiodlib = $(BLocalOptsAtC32_cfitsiodlib) + +# +# Dependency List +# +Dep_cfitsio = \ + cfitsio.lib + +cfitsio : BccW32.cfg $(Dep_cfitsio) + echo MakeNode + +cfitsio.lib : cfitsio.dll + $(IMPLIB) $@ cfitsio.dll + + +Dep_cfitsioddll = \ + listhead.obj\ + imcompress.obj\ + quantize.obj\ + ricecomp.obj\ + pliocomp.obj\ + iraffits.obj\ + wcsutil.obj\ + histo.obj\ + scalnull.obj\ + region.obj\ + putkey.obj\ + putcoluk.obj\ + putcoluj.obj\ + putcolui.obj\ + putcolu.obj\ + putcols.obj\ + putcoll.obj\ + putcolk.obj\ + putcolj.obj\ + putcoli.obj\ + putcole.obj\ + putcold.obj\ + putcolb.obj\ + putcolsb.obj\ + putcol.obj\ + modkey.obj\ + swapproc.obj\ + getcol.obj\ + group.obj\ + getkey.obj\ + getcoluk.obj\ + getcoluj.obj\ + getcolui.obj\ + getcols.obj\ + getcoll.obj\ + getcolk.obj\ + getcolj.obj\ + getcoli.obj\ + getcole.obj\ + getcold.obj\ + getcolb.obj\ + getcolsb.obj\ + grparser.obj\ + fitscore.obj\ + f77_wrap1.obj\ + f77_wrap2.obj\ + f77_wrap3.obj\ + f77_wrap4.obj\ + eval_y.obj\ + eval_l.obj\ + eval_f.obj\ + edithdu.obj\ + editcol.obj\ + drvrmem.obj\ + drvrfile.obj\ + compress.obj\ + checksum.obj\ + cfileio.obj\ + buffers.obj + +cfitsio.dll : $(Dep_cfitsioddll) cfitsio.def + $(ILINK32) @&&| + /v $(IDE_LinkFLAGS32) $(LinkerOptsAt_cfitsiodlib) $(LinkerInheritOptsAt_cfitsiodlib) + +D:\BC5\LIB\c0d32.obj+ +listhead.obj+ +imcompress.obj+ +quantize.obj+ +ricecomp.obj+ +pliocomp.obj+ +iraffits.obj+ +wcsutil.obj+ +histo.obj+ +iraffits.obj+ +scalnull.obj+ +region.obj+ +putkey.obj+ +putcoluk.obj+ +putcoluj.obj+ +putcolui.obj+ +putcolu.obj+ +putcols.obj+ +putcoll.obj+ +putcolk.obj+ +putcolj.obj+ +putcoli.obj+ +putcole.obj+ +putcold.obj+ +putcolb.obj+ +putcolsb.obj+ +putcol.obj+ +modkey.obj+ +swapproc.obj+ +getcol.obj+ +group.obj+ +getkey.obj+ +getcoluk.obj+ +getcoluj.obj+ +getcolui.obj+ +getcols.obj+ +getcoll.obj+ +getcolk.obj+ +getcolj.obj+ +getcoli.obj+ +getcole.obj+ +getcold.obj+ +getcolb.obj+ +getcolsb.obj+ +grparser.obj+ +fitscore.obj+ +f77_wrap1.obj+ +f77_wrap2.obj+ +f77_wrap3.obj+ +f77_wrap4.obj+ +eval_y.obj+ +eval_l.obj+ +eval_f.obj+ +edithdu.obj+ +editcol.obj+ +drvrmem.obj+ +drvrfile.obj+ +compress.obj+ +checksum.obj+ +cfileio.obj+ +buffers.obj +$<,$* +D:\BC5\LIB\import32.lib+ +D:\BC5\LIB\cw32i.lib +cfitsio.def + + +| +wcsutil.obj : wcsutil.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ wcsutil.c +| +iraffits.obj : iraffits.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ iraffits.c +| +histo.obj : histo.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ histo.c +| + +scalnull.obj : scalnull.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ scalnull.c +| + +region.obj : region.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ region.c +| + +putkey.obj : putkey.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putkey.c +| + +putcoluk.obj : putcoluk.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcoluk.c +| + +putcoluj.obj : putcoluj.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcoluj.c +| + +putcolui.obj : putcolui.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcolui.c +| + +putcolu.obj : putcolu.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcolu.c +| + +putcols.obj : putcols.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcols.c +| + +putcoll.obj : putcoll.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcoll.c +| + +putcolk.obj : putcolk.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcolk.c +| + +putcolj.obj : putcolj.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcolj.c +| + +putcoli.obj : putcoli.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcoli.c +| + +putcole.obj : putcole.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcole.c +| + +putcold.obj : putcold.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcold.c +| + +putcolb.obj : putcolb.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcolb.c +| + +putcolsb.obj : putcolsb.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcolsb.c +| + +putcol.obj : putcol.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ putcol.c +| + +modkey.obj : modkey.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ modkey.c +| + +swapproc.obj : swapproc.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ swapproc.c +| + +getcol.obj : getcol.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcol.c +| + +group.obj : group.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ group.c +| + +getkey.obj : getkey.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getkey.c +| + +getcoluk.obj : getcoluk.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcoluk.c +| + +getcoluj.obj : getcoluj.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcoluj.c +| + +getcolui.obj : getcolui.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcolui.c +| + +getcols.obj : getcols.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcols.c +| + +getcoll.obj : getcoll.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcoll.c +| + +getcolk.obj : getcolk.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcolk.c +| + +getcolj.obj : getcolj.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcolj.c +| + +getcoli.obj : getcoli.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcoli.c +| + +getcole.obj : getcole.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcole.c +| + +getcold.obj : getcold.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcold.c +| + +getcolb.obj : getcolb.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcolb.c +| +getcolsb.obj : getcolsb.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ getcolsb.c +| + +grparser.obj : grparser.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ grparser.c +| + +fitscore.obj : fitscore.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ fitscore.c +| + +f77_wrap1.obj : f77_wrap1.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ f77_wrap1.c +| + +f77_wrap2.obj : f77_wrap2.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ f77_wrap2.c +| + +f77_wrap3.obj : f77_wrap3.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ f77_wrap3.c +| + +f77_wrap4.obj : f77_wrap4.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ f77_wrap4.c +| + +eval_y.obj : eval_y.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ eval_y.c +| + +eval_l.obj : eval_l.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ eval_l.c +| + +eval_f.obj : eval_f.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ eval_f.c +| + +edithdu.obj : edithdu.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ edithdu.c +| + +editcol.obj : editcol.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ editcol.c +| + +drvrmem.obj : drvrmem.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ drvrmem.c +| + +drvrfile.obj : drvrfile.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ drvrfile.c +| + +compress.obj : compress.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ compress.c +| + +checksum.obj : checksum.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ checksum.c +| + +cfileio.obj : cfileio.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ cfileio.c +| + +listhead.obj : listhead.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ listhead.c +| + +imcompress.obj : imcompress.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ imcompress.c +| + +quantize.obj : quantize.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ quantize.c +| + +ricecomp.obj : ricecomp.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ ricecomp.c +| + +pliocomp.obj : pliocomp.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ pliocomp.c +| + +buffers.obj : buffers.c + $(BCC32) -P- -c @&&| + $(CompOptsAt_cfitsiodlib) $(CompInheritOptsAt_cfitsiodlib) -o$@ buffers.c +| + +windumpexts.exe : windumpexts.c + bcc32 windumpexts.c + + +cfitsio.def: windumpexts.exe + windumpexts -o cfitsio.def cfitsio.dll @&&| + $(Dep_cfitsioddll) +| + +# Compiler configuration file +BccW32.cfg : + Copy &&| +-w +-R +-v +-WM- +-vi +-H +-H=cfitsio.csm +-WCD +| $@ + + diff --git a/pkg/tbtables/cfitsio/makefile.os2 b/pkg/tbtables/cfitsio/makefile.os2 new file mode 100644 index 00000000..0d795542 --- /dev/null +++ b/pkg/tbtables/cfitsio/makefile.os2 @@ -0,0 +1,22 @@ +# +# To be use with OS/2 and GCC/EMX Compiler. +# Submitted by Andrea Di Paola (dipaola@coma.mporzio.astro.it) +# June 1997 +# +# Makefile for cfitsio library: +# libcfits.a +# + +CFLAGS= -m486 -O3 -c +CC=gcc + +OBJECTS = buffers.o cfileio.o checksum.o compress.o f77_wrap.o drvrfile.o fitscore.o \ + getcol.o getcolb.o getcold.o getcole.o getcoli.o getcolj.o \ + getcolk.o getcoll.o getcols.o getcolui.o getcoluj.o editcol.o \ + edithdu.o getkey.o modkey.o putcol.o putcolb.o putcold.o putcole.o \ + putcoli.o putcolj.o putcolk.o putcoll.o putcols.o putcolui.o \ + putcoluj.o putcolu.o putkey.o scalnull.o swapproc.o wcsutil.o \ + imcompress.o quantize.o ricecomp.o pliocomp.o + +libcfitsio.a: $(OBJECTS) + ar rv libcfitsio.a $(OBJECTS) diff --git a/pkg/tbtables/cfitsio/makefile.vcc b/pkg/tbtables/cfitsio/makefile.vcc new file mode 100644 index 00000000..42df7ffe --- /dev/null +++ b/pkg/tbtables/cfitsio/makefile.vcc @@ -0,0 +1,691 @@ +# Microsoft Developer Studio Generated NMAKE File, Based on cfitsio.dsp +!IF "$(CFG)" == "" +CFG=cfitsio - Win32 Release +!MESSAGE No configuration specified. Defaulting to cfitsio - Win32 Release. +!ENDIF + +!IF "$(CFG)" != "cfitsio - Win32 Release" && "$(CFG)" != "cfitsio - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "cfitsio.mak" CFG="cfitsio - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "cfitsio - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "cfitsio - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF + +CPP=cl.exe +MTL=midl.exe +RSC=rc.exe + +!IF "$(CFG)" == "cfitsio - Win32 Release" + +OUTDIR=. +INTDIR=.\Release +# Begin Custom Macros +OutDir=. +# End Custom Macros + +ALL : "$(OUTDIR)\cfitsio.dll" + + +CLEAN : + -@erase "$(INTDIR)\buffers.obj" + -@erase "$(INTDIR)\cfileio.obj" + -@erase "$(INTDIR)\checksum.obj" + -@erase "$(INTDIR)\compress.obj" + -@erase "$(INTDIR)\drvrfile.obj" + -@erase "$(INTDIR)\drvrmem.obj" + -@erase "$(INTDIR)\editcol.obj" + -@erase "$(INTDIR)\edithdu.obj" + -@erase "$(INTDIR)\eval_f.obj" + -@erase "$(INTDIR)\eval_l.obj" + -@erase "$(INTDIR)\eval_y.obj" + -@erase "$(INTDIR)\fitscore.obj" + -@erase "$(INTDIR)\f77_wrap1.obj" + -@erase "$(INTDIR)\f77_wrap2.obj" + -@erase "$(INTDIR)\f77_wrap3.obj" + -@erase "$(INTDIR)\f77_wrap4.obj" + -@erase "$(INTDIR)\getcol.obj" + -@erase "$(INTDIR)\getcolb.obj" + -@erase "$(INTDIR)\getcolsb.obj" + -@erase "$(INTDIR)\getcold.obj" + -@erase "$(INTDIR)\getcole.obj" + -@erase "$(INTDIR)\getcoli.obj" + -@erase "$(INTDIR)\getcolj.obj" + -@erase "$(INTDIR)\getcolk.obj" + -@erase "$(INTDIR)\getcoll.obj" + -@erase "$(INTDIR)\getcols.obj" + -@erase "$(INTDIR)\getcolui.obj" + -@erase "$(INTDIR)\getcoluj.obj" + -@erase "$(INTDIR)\getcoluk.obj" + -@erase "$(INTDIR)\getkey.obj" + -@erase "$(INTDIR)\group.obj" + -@erase "$(INTDIR)\grparser.obj" + -@erase "$(INTDIR)\histo.obj" + -@erase "$(INTDIR)\iraffits.obj" + -@erase "$(INTDIR)\modkey.obj" + -@erase "$(INTDIR)\putcol.obj" + -@erase "$(INTDIR)\putcolb.obj" + -@erase "$(INTDIR)\putcolsb.obj" + -@erase "$(INTDIR)\putcold.obj" + -@erase "$(INTDIR)\putcole.obj" + -@erase "$(INTDIR)\putcoli.obj" + -@erase "$(INTDIR)\putcolj.obj" + -@erase "$(INTDIR)\putcolk.obj" + -@erase "$(INTDIR)\putcoll.obj" + -@erase "$(INTDIR)\putcols.obj" + -@erase "$(INTDIR)\putcolu.obj" + -@erase "$(INTDIR)\putcolui.obj" + -@erase "$(INTDIR)\putcoluj.obj" + -@erase "$(INTDIR)\putcoluk.obj" + -@erase "$(INTDIR)\putkey.obj" + -@erase "$(INTDIR)\region.obj" + -@erase "$(INTDIR)\scalnull.obj" + -@erase "$(INTDIR)\swapproc.obj" + -@erase "$(INTDIR)\imcompress.obj" + -@erase "$(INTDIR)\ricecomp.obj" + -@erase "$(INTDIR)\quantize.obj" + -@erase "$(INTDIR)\pliocomp.obj" + -@erase "$(INTDIR)\vc60.idb" + -@erase "$(INTDIR)\wcssub.obj" + -@erase "$(INTDIR)\wcsutil.obj" + -@erase "$(OUTDIR)\cfitsio.dll" + -@erase "$(OUTDIR)\cfitsio.exp" + -@erase "$(OUTDIR)\cfitsio.lib" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +"$(INTDIR)" : + if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" + +CPP_PROJ=/nologo /MD /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "CFITSIO_EXPORTS" /Fp"$(INTDIR)\cfitsio.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /c +MTL_PROJ=/nologo /D "NDEBUG" /mktyplib203 /win32 +BSC32=bscmake.exe +BSC32_FLAGS=/nologo /o"$(OUTDIR)\cfitsio.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /incremental:no /pdb:"$(OUTDIR)\cfitsio.pdb" /machine:I386 /def:".\cfitsio.def" /out:"$(OUTDIR)\cfitsio.dll" /implib:"$(OUTDIR)\cfitsio.lib" +DEF_FILE= ".\cfitsio.def" +LINK32_OBJS= \ + "$(INTDIR)\buffers.obj" \ + "$(INTDIR)\cfileio.obj" \ + "$(INTDIR)\checksum.obj" \ + "$(INTDIR)\compress.obj" \ + "$(INTDIR)\drvrfile.obj" \ + "$(INTDIR)\drvrmem.obj" \ + "$(INTDIR)\editcol.obj" \ + "$(INTDIR)\edithdu.obj" \ + "$(INTDIR)\eval_f.obj" \ + "$(INTDIR)\eval_l.obj" \ + "$(INTDIR)\eval_y.obj" \ + "$(INTDIR)\fitscore.obj" \ + "$(INTDIR)\f77_wrap1.obj" \ + "$(INTDIR)\f77_wrap2.obj" \ + "$(INTDIR)\f77_wrap3.obj" \ + "$(INTDIR)\f77_wrap4.obj" \ + "$(INTDIR)\getcol.obj" \ + "$(INTDIR)\getcolb.obj" \ + "$(INTDIR)\getcolsb.obj" \ + "$(INTDIR)\getcold.obj" \ + "$(INTDIR)\getcole.obj" \ + "$(INTDIR)\getcoli.obj" \ + "$(INTDIR)\getcolj.obj" \ + "$(INTDIR)\getcolk.obj" \ + "$(INTDIR)\getcoll.obj" \ + "$(INTDIR)\getcols.obj" \ + "$(INTDIR)\getcolui.obj" \ + "$(INTDIR)\getcoluj.obj" \ + "$(INTDIR)\getcoluk.obj" \ + "$(INTDIR)\getkey.obj" \ + "$(INTDIR)\group.obj" \ + "$(INTDIR)\grparser.obj" \ + "$(INTDIR)\histo.obj" \ + "$(INTDIR)\iraffits.obj" \ + "$(INTDIR)\modkey.obj" \ + "$(INTDIR)\putcol.obj" \ + "$(INTDIR)\putcolb.obj" \ + "$(INTDIR)\putcolsb.obj" \ + "$(INTDIR)\putcold.obj" \ + "$(INTDIR)\putcole.obj" \ + "$(INTDIR)\putcoli.obj" \ + "$(INTDIR)\putcolj.obj" \ + "$(INTDIR)\putcolk.obj" \ + "$(INTDIR)\putcoll.obj" \ + "$(INTDIR)\putcols.obj" \ + "$(INTDIR)\putcolu.obj" \ + "$(INTDIR)\putcolui.obj" \ + "$(INTDIR)\putcoluj.obj" \ + "$(INTDIR)\putcoluk.obj" \ + "$(INTDIR)\putkey.obj" \ + "$(INTDIR)\region.obj" \ + "$(INTDIR)\scalnull.obj" \ + "$(INTDIR)\swapproc.obj" \ + "$(INTDIR)\imcompress.obj" \ + "$(INTDIR)\ricecomp.obj" \ + "$(INTDIR)\quantize.obj" \ + "$(INTDIR)\pliocomp.obj" \ + "$(INTDIR)\wcssub.obj" \ + "$(INTDIR)\wcsutil.obj" + +"$(OUTDIR)\cfitsio.dll" : $(LINK32_OBJS) WINDUMP + windumpexts -o $(DEF_FILE) cfitsio.dll $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "cfitsio - Win32 Debug" + +OUTDIR=. +INTDIR=.\Debug +# Begin Custom Macros +OutDir=. +# End Custom Macros + +ALL : "$(OUTDIR)\cfitsio.dll" + + +CLEAN : + -@erase "$(INTDIR)\buffers.obj" + -@erase "$(INTDIR)\cfileio.obj" + -@erase "$(INTDIR)\checksum.obj" + -@erase "$(INTDIR)\compress.obj" + -@erase "$(INTDIR)\drvrfile.obj" + -@erase "$(INTDIR)\drvrmem.obj" + -@erase "$(INTDIR)\editcol.obj" + -@erase "$(INTDIR)\edithdu.obj" + -@erase "$(INTDIR)\eval_f.obj" + -@erase "$(INTDIR)\eval_l.obj" + -@erase "$(INTDIR)\eval_y.obj" + -@erase "$(INTDIR)\fitscore.obj" + -@erase "$(INTDIR)\f77_wrap1.obj" + -@erase "$(INTDIR)\f77_wrap2.obj" + -@erase "$(INTDIR)\f77_wrap3.obj" + -@erase "$(INTDIR)\f77_wrap4.obj" + -@erase "$(INTDIR)\getcol.obj" + -@erase "$(INTDIR)\getcolb.obj" + -@erase "$(INTDIR)\getcolsb.obj" + -@erase "$(INTDIR)\getcold.obj" + -@erase "$(INTDIR)\getcole.obj" + -@erase "$(INTDIR)\getcoli.obj" + -@erase "$(INTDIR)\getcolj.obj" + -@erase "$(INTDIR)\getcolk.obj" + -@erase "$(INTDIR)\getcoll.obj" + -@erase "$(INTDIR)\getcols.obj" + -@erase "$(INTDIR)\getcolui.obj" + -@erase "$(INTDIR)\getcoluj.obj" + -@erase "$(INTDIR)\getcoluk.obj" + -@erase "$(INTDIR)\getkey.obj" + -@erase "$(INTDIR)\group.obj" + -@erase "$(INTDIR)\grparser.obj" + -@erase "$(INTDIR)\histo.obj" + -@erase "$(INTDIR)\iraffits.obj" + -@erase "$(INTDIR)\modkey.obj" + -@erase "$(INTDIR)\putcol.obj" + -@erase "$(INTDIR)\putcolb.obj" + -@erase "$(INTDIR)\putcolsb.obj" + -@erase "$(INTDIR)\putcold.obj" + -@erase "$(INTDIR)\putcole.obj" + -@erase "$(INTDIR)\putcoli.obj" + -@erase "$(INTDIR)\putcolj.obj" + -@erase "$(INTDIR)\putcolk.obj" + -@erase "$(INTDIR)\putcoll.obj" + -@erase "$(INTDIR)\putcols.obj" + -@erase "$(INTDIR)\putcolu.obj" + -@erase "$(INTDIR)\putcolui.obj" + -@erase "$(INTDIR)\putcoluj.obj" + -@erase "$(INTDIR)\putcoluk.obj" + -@erase "$(INTDIR)\putkey.obj" + -@erase "$(INTDIR)\region.obj" + -@erase "$(INTDIR)\scalnull.obj" + -@erase "$(INTDIR)\swapproc.obj" + -@erase "$(INTDIR)\vc60.idb" + -@erase "$(INTDIR)\vc60.pdb" + -@erase "$(INTDIR)\wcssub.obj" + -@erase "$(INTDIR)\wcsutil.obj" + -@erase "$(INTDIR)\imcompress.obj" + -@erase "$(INTDIR)\ricecomp.obj" + -@erase "$(INTDIR)\quantize.obj" + -@erase "$(INTDIR)\pliocomp.obj" + -@erase "$(OUTDIR)\cfitsio.dll" + -@erase "$(OUTDIR)\cfitsio.exp" + -@erase "$(OUTDIR)\cfitsio.ilk" + -@erase "$(OUTDIR)\cfitsio.lib" + -@erase "$(OUTDIR)\cfitsio.pdb" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +"$(INTDIR)" : + if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" + +CPP_PROJ=/nologo /MD /W3 /Gm /GX /ZI /Od /D "__WIN32__" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "CFITSIO_EXPORTS" /Fp"$(INTDIR)\cfitsio.pch" /YX /Fo"$(INTDIR)\\" /Fd"$(INTDIR)\\" /FD /GZ /c +MTL_PROJ=/nologo /D "_DEBUG" /mktyplib203 /win32 +BSC32=bscmake.exe +BSC32_FLAGS=/nologo /o"$(OUTDIR)\cfitsio.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /incremental:yes /pdb:"$(OUTDIR)\cfitsio.pdb" /debug /machine:I386 /def:".\cfitsio.def" /out:"$(OUTDIR)\cfitsio.dll" /implib:"$(OUTDIR)\cfitsio.lib" /pdbtype:sept +DEF_FILE= ".\cfitsio.def" +LINK32_OBJS= \ + "$(INTDIR)\buffers.obj" \ + "$(INTDIR)\cfileio.obj" \ + "$(INTDIR)\checksum.obj" \ + "$(INTDIR)\compress.obj" \ + "$(INTDIR)\drvrfile.obj" \ + "$(INTDIR)\drvrmem.obj" \ + "$(INTDIR)\editcol.obj" \ + "$(INTDIR)\edithdu.obj" \ + "$(INTDIR)\eval_f.obj" \ + "$(INTDIR)\eval_l.obj" \ + "$(INTDIR)\eval_y.obj" \ + "$(INTDIR)\fitscore.obj" \ + "$(INTDIR)\f77_wrap1.obj" \ + "$(INTDIR)\f77_wrap2.obj" \ + "$(INTDIR)\f77_wrap3.obj" \ + "$(INTDIR)\f77_wrap4.obj" \ + "$(INTDIR)\getcol.obj" \ + "$(INTDIR)\getcolb.obj" \ + "$(INTDIR)\getcolsb.obj" \ + "$(INTDIR)\getcold.obj" \ + "$(INTDIR)\getcole.obj" \ + "$(INTDIR)\getcoli.obj" \ + "$(INTDIR)\getcolj.obj" \ + "$(INTDIR)\getcolk.obj" \ + "$(INTDIR)\getcoll.obj" \ + "$(INTDIR)\getcols.obj" \ + "$(INTDIR)\getcolui.obj" \ + "$(INTDIR)\getcoluj.obj" \ + "$(INTDIR)\getcoluk.obj" \ + "$(INTDIR)\getkey.obj" \ + "$(INTDIR)\group.obj" \ + "$(INTDIR)\grparser.obj" \ + "$(INTDIR)\histo.obj" \ + "$(INTDIR)\iraffits.obj" \ + "$(INTDIR)\modkey.obj" \ + "$(INTDIR)\putcol.obj" \ + "$(INTDIR)\putcolb.obj" \ + "$(INTDIR)\putcolsb.obj" \ + "$(INTDIR)\putcold.obj" \ + "$(INTDIR)\putcole.obj" \ + "$(INTDIR)\putcoli.obj" \ + "$(INTDIR)\putcolj.obj" \ + "$(INTDIR)\putcolk.obj" \ + "$(INTDIR)\putcoll.obj" \ + "$(INTDIR)\putcols.obj" \ + "$(INTDIR)\putcolu.obj" \ + "$(INTDIR)\putcolui.obj" \ + "$(INTDIR)\putcoluj.obj" \ + "$(INTDIR)\putcoluk.obj" \ + "$(INTDIR)\putkey.obj" \ + "$(INTDIR)\region.obj" \ + "$(INTDIR)\scalnull.obj" \ + "$(INTDIR)\swapproc.obj" \ + "$(INTDIR)\wcssub.obj" \ + "$(INTDIR)\wcsutil.obj" \ + "$(INTDIR)\imcompress.obj" \ + "$(INTDIR)\ricecomp.obj" \ + "$(INTDIR)\quantize.obj" \ + "$(INTDIR)\pliocomp.obj" + + +"$(OUTDIR)\cfitsio.dll" : $(LINK32_OBJS) WINDUMP + windumpexts -o $(DEF_FILE) cfitsio.dll $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(INTDIR)}.obj:: + $(CPP) @<< + $(CPP_PROJ) $< +<< + +.cpp{$(INTDIR)}.obj:: + $(CPP) @<< + $(CPP_PROJ) $< +<< + +.cxx{$(INTDIR)}.obj:: + $(CPP) @<< + $(CPP_PROJ) $< +<< + +.c{$(INTDIR)}.sbr:: + $(CPP) @<< + $(CPP_PROJ) $< +<< + +.cpp{$(INTDIR)}.sbr:: + $(CPP) @<< + $(CPP_PROJ) $< +<< + +.cxx{$(INTDIR)}.sbr:: + $(CPP) @<< + $(CPP_PROJ) $< +<< + + +!IF "$(NO_EXTERNAL_DEPS)" != "1" +!IF EXISTS("cfitsio.dep") +!INCLUDE "cfitsio.dep" +!ELSE +!MESSAGE Warning: cannot find "cfitsio.dep" +!ENDIF +!ENDIF + + +!IF "$(CFG)" == "cfitsio - Win32 Release" || "$(CFG)" == "cfitsio - Win32 Debug" +SOURCE=.\buffers.c + +"$(INTDIR)\buffers.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\cfileio.c + +"$(INTDIR)\cfileio.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\checksum.c + +"$(INTDIR)\checksum.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\compress.c + +"$(INTDIR)\compress.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\drvrfile.c + +"$(INTDIR)\drvrfile.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\drvrmem.c + +"$(INTDIR)\drvrmem.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\editcol.c + +"$(INTDIR)\editcol.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\edithdu.c + +"$(INTDIR)\edithdu.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\eval_f.c + +"$(INTDIR)\eval_f.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\eval_l.c + +"$(INTDIR)\eval_l.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\eval_y.c + +"$(INTDIR)\eval_y.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\fitscore.c + +"$(INTDIR)\fitscore.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\f77_wrap1.c + +"$(INTDIR)\f77_wrap1.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\f77_wrap2.c + +"$(INTDIR)\f77_wrap2.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\f77_wrap3.c + +"$(INTDIR)\f77_wrap3.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\f77_wrap4.c + +"$(INTDIR)\f77_wrap4.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcol.c + +"$(INTDIR)\getcol.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcolb.c + +"$(INTDIR)\getcolb.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcolsb.c + +"$(INTDIR)\getcolsb.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcold.c + +"$(INTDIR)\getcold.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcole.c + +"$(INTDIR)\getcole.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcoli.c + +"$(INTDIR)\getcoli.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcolj.c + +"$(INTDIR)\getcolj.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcolk.c + +"$(INTDIR)\getcolk.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcoll.c + +"$(INTDIR)\getcoll.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcols.c + +"$(INTDIR)\getcols.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcolui.c + +"$(INTDIR)\getcolui.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcoluj.c + +"$(INTDIR)\getcoluj.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getcoluk.c + +"$(INTDIR)\getcoluk.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\getkey.c + +"$(INTDIR)\getkey.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\group.c + +"$(INTDIR)\group.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\grparser.c + +"$(INTDIR)\grparser.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\histo.c + +"$(INTDIR)\histo.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\iraffits.c + +"$(INTDIR)\iraffits.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\modkey.c + +"$(INTDIR)\modkey.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcol.c + +"$(INTDIR)\putcol.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcolb.c + +"$(INTDIR)\putcolb.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcolsb.c + +"$(INTDIR)\putcolsb.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcold.c + +"$(INTDIR)\putcold.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcole.c + +"$(INTDIR)\putcole.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcoli.c + +"$(INTDIR)\putcoli.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcolj.c + +"$(INTDIR)\putcolj.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcolk.c + +"$(INTDIR)\putcolk.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcoll.c + +"$(INTDIR)\putcoll.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcols.c + +"$(INTDIR)\putcols.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcolu.c + +"$(INTDIR)\putcolu.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcolui.c + +"$(INTDIR)\putcolui.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcoluj.c + +"$(INTDIR)\putcoluj.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putcoluk.c + +"$(INTDIR)\putcoluk.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\putkey.c + +"$(INTDIR)\putkey.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\region.c + +"$(INTDIR)\region.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\scalnull.c + +"$(INTDIR)\scalnull.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\swapproc.c + +"$(INTDIR)\swapproc.obj" : $(SOURCE) "$(INTDIR)" + + +SOURCE=.\wcssub.c + +"$(INTDIR)\wcssub.obj" : $(SOURCE) "$(INTDIR)" + +SOURCE=.\wcsutil.c + +"$(INTDIR)\wcsutil.obj" : $(SOURCE) "$(INTDIR)" + +SOURCE=imcompress.c + +"$(INTDIR)\imcompress.obj" : $(SOURCE) "$(INTDIR)" + +SOURCE=ricecomp.c + +"$(INTDIR)\ricecomp.obj" : $(SOURCE) "$(INTDIR)" + +SOURCE=quantize.c + +"$(INTDIR)\quantize.obj" : $(SOURCE) "$(INTDIR)" + +SOURCE=pliocomp.c + +"$(INTDIR)\pliocomp.obj" : $(SOURCE) "$(INTDIR)" + +!ENDIF + +$(DEF_FILE): + + + +WINDUMP: + nmake -f winDumpExts.mak diff --git a/pkg/tbtables/cfitsio/makepc.bat b/pkg/tbtables/cfitsio/makepc.bat new file mode 100644 index 00000000..fd461853 --- /dev/null +++ b/pkg/tbtables/cfitsio/makepc.bat @@ -0,0 +1,69 @@ +rem: this batch file builds the cfitsio library +rem: using the Borland C++ v4.5 compiler +rem: +bcc32 -c buffers.c +bcc32 -c cfileio.c +bcc32 -c checksum.c +bcc32 -c compress.c +bcc32 -c drvrfile.c +bcc32 -c drvrmem.c +bcc32 -c editcol.c +bcc32 -c edithdu.c +bcc32 -c eval_l.c +bcc32 -c eval_y.c +bcc32 -c eval_f.c +bcc32 -c fitscore.c +bcc32 -c getcol.c +bcc32 -c getcolb.c +bcc32 -c getcoli.c +bcc32 -c getcolj.c +bcc32 -c getcolui.c +bcc32 -c getcoluj.c +bcc32 -c getcoluk.c +bcc32 -c getcolk.c +bcc32 -c getcole.c +bcc32 -c getcold.c +bcc32 -c getcoll.c +bcc32 -c getcols.c +bcc32 -c getkey.c +bcc32 -c group.c +bcc32 -c grparser.c +bcc32 -c histo.c +bcc32 -c iraffits.c +bcc32 -c modkey.c +bcc32 -c putcol.c +bcc32 -c putcolb.c +bcc32 -c putcoli.c +bcc32 -c putcolj.c +bcc32 -c putcolui.c +bcc32 -c putcoluj.c +bcc32 -c putcoluk.c +bcc32 -c putcolk.c +bcc32 -c putcole.c +bcc32 -c putcold.c +bcc32 -c putcols.c +bcc32 -c putcoll.c +bcc32 -c putcolu.c +bcc32 -c putkey.c +bcc32 -c region.c +bcc32 -c scalnull.c +bcc32 -c swapproc.c +bcc32 -c wcsutil.c +bcc32 -c wcssub.c +bcc32 -c imcompress.c +bcc32 -c quantize.c +bcc32 -c ricecomp.c +bcc32 -c pliocomp.c +del cfitsio.lib +tlib cfitsio +buffers +cfileio +checksum +compress +drvrfile +drvrmem +tlib cfitsio +editcol +edithdu +eval_l +eval_y +eval_f +fitscore +tlib cfitsio +getcol +getcolb +getcoli +getcolj +getcolk +getcoluk +tlib cfitsio +getcolui +getcoluj +getcole +getcold +getcoll +getcols +tlib cfitsio +getkey +group +grparser +histo +iraffits +modkey +putkey +tlib cfitsio +putcol +putcolb +putcoli +putcolj +putcolk +putcole +putcold +tlib cfitsio +putcoll +putcols +putcolu +putcolui +putcoluj +putcoluk +tlib cfitsio +region +scalnull +swapproc +wcsutil +wcssub +tlib cfitsio +imcompress +quantize +ricecomp +pliocomp +bcc32 -f testprog.c cfitsio.lib +bcc32 -f cookbook.c cfitsio.lib + diff --git a/pkg/tbtables/cfitsio/mkpkg b/pkg/tbtables/cfitsio/mkpkg new file mode 100644 index 00000000..2bee177f --- /dev/null +++ b/pkg/tbtables/cfitsio/mkpkg @@ -0,0 +1,66 @@ +# CFITSIO -- This IRAF mkpkg file updates the TBTABLES library to include +# the CFITSIO interface. + +libtbtables.a: + $set XFLAGS = "-Inolibc $(XFLAGS)" + buffers.c fitsio2.h fitsio.h longnam.h drvrsmem.h + cfileio.c fitsio2.h fitsio.h longnam.h drvrsmem.h + checksum.c fitsio2.h fitsio.h longnam.h drvrsmem.h + compress.c + drvrfile.c fitsio2.h fitsio.h longnam.h drvrsmem.h + drvrmem.c fitsio2.h fitsio.h longnam.h drvrsmem.h + editcol.c fitsio2.h fitsio.h longnam.h drvrsmem.h + edithdu.c fitsio2.h fitsio.h longnam.h drvrsmem.h + eval_f.c eval_defs.h fitsio2.h fitsio.h longnam.h drvrsmem.h \ + eval_tab.h region.h + eval_l.c eval_defs.h fitsio2.h fitsio.h longnam.h drvrsmem.h \ + eval_tab.h + eval_y.c eval_defs.h fitsio2.h fitsio.h longnam.h drvrsmem.h \ + region.h + fitscore.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcol.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcolb.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcold.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcole.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcoli.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcolj.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcolk.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcoll.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcols.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcolsb.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcolui.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcoluj.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getcoluk.c fitsio2.h fitsio.h longnam.h drvrsmem.h + getkey.c fitsio2.h fitsio.h longnam.h drvrsmem.h + group.c fitsio2.h fitsio.h longnam.h drvrsmem.h group.h + grparser.c fitsio.h longnam.h grparser.h + histo.c fitsio2.h fitsio.h longnam.h drvrsmem.h + imcompress.c fitsio2.h fitsio.h longnam.h + iraffits.c + modkey.c fitsio2.h fitsio.h longnam.h drvrsmem.h + pliocomp.c + putcol.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcolb.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcold.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcole.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcoli.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcolj.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcolk.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcoll.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcols.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcolsb.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcolu.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcolui.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcoluj.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putcoluk.c fitsio2.h fitsio.h longnam.h drvrsmem.h + putkey.c fitsio2.h fitsio.h longnam.h drvrsmem.h + quantize.c fitsio2.h fitsio.h longnam.h + region.c fitsio2.h fitsio.h longnam.h drvrsmem.h region.h + ricecomp.c ricecomp.h fitsio2.h fitsio.h longnam.h + scalnull.c fitsio2.h fitsio.h longnam.h drvrsmem.h + swapproc.c fitsio2.h fitsio.h longnam.h drvrsmem.h + wcsutil.c fitsio2.h fitsio.h longnam.h drvrsmem.h +$ifeq (MACH, _alpha) + wcssub.c fitsio2.h fitsio.h longnam.h drvrsmem.h +$endif + ; diff --git a/pkg/tbtables/cfitsio/modkey.c b/pkg/tbtables/cfitsio/modkey.c new file mode 100644 index 00000000..b257eb25 --- /dev/null +++ b/pkg/tbtables/cfitsio/modkey.c @@ -0,0 +1,1614 @@ +/* This file, modkey.c, contains routines that modify, insert, or update */ +/* keywords in a FITS header. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +/* stddef.h is apparently needed to define size_t */ +#include +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffuky( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + char *keyname, /* I - name of keyword to write */ + void *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Update the keyword, value and comment in the FITS header. + The datatype is specified by the 2nd argument. +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (datatype == TSTRING) + { + ffukys(fptr, keyname, (char *) value, comm, status); + } + else if (datatype == TBYTE) + { + ffukyj(fptr, keyname, (long) *(unsigned char *) value, comm, status); + } + else if (datatype == TSBYTE) + { + ffukyj(fptr, keyname, (long) *(signed char *) value, comm, status); + } + else if (datatype == TUSHORT) + { + ffukyj(fptr, keyname, (long) *(unsigned short *) value, comm, status); + } + else if (datatype == TSHORT) + { + ffukyj(fptr, keyname, (long) *(short *) value, comm, status); + } + else if (datatype == TINT) + { + ffukyj(fptr, keyname, (long) *(int *) value, comm, status); + } + else if (datatype == TUINT) + { + ffukyg(fptr, keyname, (double) *(unsigned int *) value, 0, + comm, status); + } + else if (datatype == TLOGICAL) + { + ffukyl(fptr, keyname, *(int *) value, comm, status); + } + else if (datatype == TULONG) + { + ffukyg(fptr, keyname, (double) *(unsigned long *) value, 0, + comm, status); + } + else if (datatype == TLONG) + { + ffukyj(fptr, keyname, *(long *) value, comm, status); + } + else if (datatype == TFLOAT) + { + ffukye(fptr, keyname, *(float *) value, -7, comm, status); + } + else if (datatype == TDOUBLE) + { + ffukyd(fptr, keyname, *(double *) value, -15, comm, status); + } + else if (datatype == TCOMPLEX) + { + ffukyc(fptr, keyname, (float *) value, -7, comm, status); + } + else if (datatype == TDBLCOMPLEX) + { + ffukym(fptr, keyname, (double *) value, -15, comm, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukyu(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyu(fptr, keyname, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyu(fptr, keyname, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukys(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkys(fptr, keyname, value, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkys(fptr, keyname, value, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukls(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + /* update a long string keyword */ + + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkls(fptr, keyname, value, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkls(fptr, keyname, value, comm, status); + } + return(*status); +}/*--------------------------------------------------------------------------*/ +int ffukyl(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + int value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyl(fptr, keyname, value, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyl(fptr, keyname, value, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukyj(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + long value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyj(fptr, keyname, value, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyj(fptr, keyname, value, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukyf(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyf(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyf(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukye(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkye(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkye(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukyg(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyg(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyg(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukyd(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyd(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyd(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukfc(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkfc(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkfc(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukyc(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkyc(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkyc(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukfm(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkfm(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkfm(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffukym(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmkym(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffpkym(fptr, keyname, value, decim, comm, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffucrd(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *card, /* I - card string value */ + int *status) /* IO - error status */ +{ + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = *status; + + if (ffmcrd(fptr, keyname, card, status) == KEY_NO_EXIST) + { + *status = tstatus; + ffprec(fptr, card, status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmrec(fitsfile *fptr, /* I - FITS file pointer */ + int nkey, /* I - number of the keyword to modify */ + char *card, /* I - card string value */ + int *status) /* IO - error status */ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffmaky(fptr, nkey+1, status); + ffmkey(fptr, card, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmcrd(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *card, /* I - card string value */ + int *status) /* IO - error status */ +{ + char tcard[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgcrd(fptr, keyname, tcard, status) > 0) + return(*status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmnam(fitsfile *fptr, /* I - FITS file pointer */ + char *oldname, /* I - existing keyword name */ + char *newname, /* I - new name for keyword */ + int *status) /* IO - error status */ +{ + char comm[FLEN_COMMENT]; + char value[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, oldname, value, comm, status) > 0) + return(*status); + + ffmkky(newname, value, comm, card, status); /* construct the card */ + ffmkey(fptr, card, status); /* rewrite with new name */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmcom(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char oldcomm[FLEN_COMMENT]; + char value[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, value, oldcomm, status) > 0) + return(*status); + + ffmkky(keyname, value, comm, card, status); /* construct the card */ + ffmkey(fptr, card, status); /* rewrite with new comment */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpunt(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *unit, /* I - keyword unit string */ + int *status) /* IO - error status */ +/* + Write (put) the units string into the comment field of the existing + keyword. This routine uses a local FITS convention (not defined in the + official FITS standard) in which the units are enclosed in + square brackets following the '/' comment field delimiter, e.g.: + + KEYWORD = 12 / [kpc] comment string goes here +*/ +{ + char oldcomm[FLEN_COMMENT]; + char newcomm[FLEN_COMMENT]; + char value[FLEN_VALUE]; + char card[FLEN_CARD]; + char *loc; + size_t len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, value, oldcomm, status) > 0) + return(*status); + + /* copy the units string to the new comment string if not null */ + if (*unit) + { + strcpy(newcomm, "["); + strncat(newcomm, unit, 45); /* max allowed length is about 45 chars */ + strcat(newcomm, "] "); + len = strlen(newcomm); + len = FLEN_COMMENT - len - 1; /* amount of space left in the field */ + } + else + { + newcomm[0] = '\0'; + len = FLEN_COMMENT - 1; + } + + if (oldcomm[0] == '[') /* check for existing units field */ + { + loc = strchr(oldcomm, ']'); /* look for the closing bracket */ + if (loc) + { + loc++; + while (*loc == ' ') /* skip any blank spaces */ + loc++; + + strncat(newcomm, loc, len); /* concat remainder of comment */ + } + else + { + strncat(newcomm, oldcomm, len); /* append old comment onto new */ + } + } + else + { + strncat(newcomm, oldcomm, len); + } + + ffmkky(keyname, value, newcomm, card, status); /* construct the card */ + ffmkey(fptr, card, status); /* rewrite with new units string */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyu(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + strcpy(valstring," "); /* create a dummy value string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkys(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + /* NOTE: This routine does not support long continued strings */ + /* It will correctly overwrite an existing long continued string, */ + /* but it will not write a new long string. */ + + char oldval[FLEN_VALUE], valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + int len, keypos; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, oldval, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffs2c(value, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); /* overwrite the previous keyword */ + + keypos = ((((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])) / 80) + 1; + + /* check if old string value was continued over multiple keywords */ + ffc2s(oldval, valstring, status); /* remove quotes and trailing spaces */ + len = strlen(valstring); + + while (len && valstring[len - 1] == '&') /* ampersand is continuation char */ + { + ffgcnt(fptr, valstring, status); + if (*valstring) + { + ffdrec(fptr, keypos, status); /* delete the continuation */ + len = strlen(valstring); + } + else /* a null valstring indicates no continuation */ + len = 0; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkls( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + char *value, /* I - keyword value */ + char *incomm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Modify the value and optionally the comment of a long string keyword. + This routine supports the + HEASARC long string convention and can modify arbitrarily long string + keyword values. The value is continued over multiple keywords that + have the name COMTINUE without an equal sign in column 9 of the card. + This routine also supports simple string keywords which are less than + 69 characters in length. + + This routine is not very efficient, so it should be used sparingly. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + char comm[FLEN_COMMENT]; + char tstring[FLEN_VALUE], *cptr; + char *longval; + int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1; + int nkeys, keypos; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (!incomm || incomm[0] == '&') /* preserve the old comment string */ + { + ffghps(fptr, &nkeys, &keypos, status); /* save current position */ + + if (ffgkls(fptr, keyname, &longval, comm, status) > 0) + return(*status); /* keyword doesn't exist */ + + free(longval); /* don't need the old value */ + + /* move back to previous position to ensure that we delete */ + /* the right keyword in case there are more than one keyword */ + /* with this same name. */ + ffgrec(fptr, keypos - 1, card, status); + } + else + strcpy(comm, incomm); /* copy the input comment string */ + + /* delete the old keyword */ + if (ffdkey(fptr, keyname, status) > 0) + return(*status); /* keyword doesn't exist */ + + ffghps(fptr, &nkeys, &keypos, status); /* save current position */ + + /* now construct the new keyword, and insert into header */ + remain = strlen(value); /* number of characters to write out */ + next = 0; /* pointer to next character to write */ + + /* count the number of single quote characters in the string */ + nquote = 0; + cptr = strchr(value, '\''); /* search for quote character */ + + while (cptr) /* search for quote character */ + { + nquote++; /* increment no. of quote characters */ + cptr++; /* increment pointer to next character */ + cptr = strchr(cptr, '\''); /* search for another quote char */ + } + + cptr = keyname; + while(*cptr == ' ') /* skip over leading spaces in name */ + cptr++; + + /* determine the number of characters that will fit on the line */ + /* Note: each quote character is expanded to 2 quotes */ + + namelen = strlen(cptr); + if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) ) + { + /* This a normal 8-character FITS keyword */ + nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */ + } + else + { + /* This a HIERARCH keyword */ + if (FSTRNCMP(cptr, "HIERARCH ", 9) && + FSTRNCMP(cptr, "hierarch ", 9)) + nchar = 66 - nquote - namelen; + else + nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */ + + } + + contin = 0; + while (remain > 0) + { + strncpy(tstring, &value[next], nchar); /* copy string to temp buff */ + tstring[nchar] = '\0'; + ffs2c(tstring, valstring, status); /* put quotes around the string */ + + if (remain > nchar) /* if string is continued, put & as last char */ + { + vlen = strlen(valstring); + nchar -= 1; /* outputting one less character now */ + + if (valstring[vlen-2] != '\'') + valstring[vlen-2] = '&'; /* over write last char with & */ + else + { /* last char was a pair of single quotes, so over write both */ + valstring[vlen-3] = '&'; + valstring[vlen-1] = '\0'; + } + } + + if (contin) /* This is a CONTINUEd keyword */ + { + ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */ + strncpy(&card[8], " ", 2); /* overwrite the '=' */ + } + else + { + ffmkky(keyname, valstring, comm, card, status); /* make keyword */ + } + + ffirec(fptr, keypos, card, status); /* insert the keyword */ + + keypos++; /* next insert position */ + contin = 1; + remain -= nchar; + next += nchar; + nchar = 68 - nquote; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyl(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + int value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffl2c(value, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyj(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + long value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffi2c(value, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyf(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffr2f(value, decim, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkye(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffr2e(value, decim, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyg(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffd2f(value, decim, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyd(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + ffd2e(value, decim, valstring, status); /* convert value to a string */ + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkfc(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + strcpy(valstring, "(" ); + ffr2f(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2f(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkyc(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + strcpy(valstring, "(" ); + ffr2e(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2e(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkfm(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + strcpy(valstring, "(" ); + ffd2f(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2f(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkym(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char oldcomm[FLEN_COMMENT]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0) + return(*status); /* get old comment */ + + strcpy(valstring, "(" ); + ffd2e(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2e(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + if (!comm || comm[0] == '&') /* preserve the current comment string */ + ffmkky(keyname, valstring, oldcomm, card, status); + else + ffmkky(keyname, valstring, comm, card, status); + + ffmkey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyu(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Insert a null-valued keyword and comment into the FITS header. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring," "); /* create a dummy value string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikys(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffs2c(value, valstring, status); /* put quotes around the string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikls( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Insert a long string keyword. This routine supports the + HEASARC long string convention and can insert arbitrarily long string + keyword values. The value is continued over multiple keywords that + have the name COMTINUE without an equal sign in column 9 of the card. + This routine also supports simple string keywords which are less than + 69 characters in length. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + char tstring[FLEN_VALUE], *cptr; + int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* construct the new keyword, and insert into header */ + remain = strlen(value); /* number of characters to write out */ + next = 0; /* pointer to next character to write */ + + /* count the number of single quote characters in the string */ + nquote = 0; + cptr = strchr(value, '\''); /* search for quote character */ + + while (cptr) /* search for quote character */ + { + nquote++; /* increment no. of quote characters */ + cptr++; /* increment pointer to next character */ + cptr = strchr(cptr, '\''); /* search for another quote char */ + } + + cptr = keyname; + while(*cptr == ' ') /* skip over leading spaces in name */ + cptr++; + + /* determine the number of characters that will fit on the line */ + /* Note: each quote character is expanded to 2 quotes */ + + namelen = strlen(cptr); + if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) ) + { + /* This a normal 8-character FITS keyword */ + nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */ + } + else + { + /* This a HIERARCH keyword */ + if (FSTRNCMP(cptr, "HIERARCH ", 9) && + FSTRNCMP(cptr, "hierarch ", 9)) + nchar = 66 - nquote - namelen; + else + nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */ + + } + + contin = 0; + while (remain > 0) + { + strncpy(tstring, &value[next], nchar); /* copy string to temp buff */ + tstring[nchar] = '\0'; + ffs2c(tstring, valstring, status); /* put quotes around the string */ + + if (remain > nchar) /* if string is continued, put & as last char */ + { + vlen = strlen(valstring); + nchar -= 1; /* outputting one less character now */ + + if (valstring[vlen-2] != '\'') + valstring[vlen-2] = '&'; /* over write last char with & */ + else + { /* last char was a pair of single quotes, so over write both */ + valstring[vlen-3] = '&'; + valstring[vlen-1] = '\0'; + } + } + + if (contin) /* This is a CONTINUEd keyword */ + { + ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */ + strncpy(&card[8], " ", 2); /* overwrite the '=' */ + } + else + { + ffmkky(keyname, valstring, comm, card, status); /* make keyword */ + } + + ffikey(fptr, card, status); /* insert the keyword */ + + contin = 1; + remain -= nchar; + next += nchar; + nchar = 68 - nquote; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyl(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + int value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffl2c(value, valstring, status); /* convert logical to 'T' or 'F' */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyj(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + long value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffi2c(value, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyf(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffr2f(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikye(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffr2e(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyg(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffd2f(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyd(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffd2e(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikfc(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffr2f(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2f(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikyc(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + float *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffr2e(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2e(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikfm(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + + strcpy(valstring, "(" ); + ffd2f(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2f(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikym(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + double *value, /* I - keyword value */ + int decim, /* I - no of decimals */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffd2e(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2e(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffikey(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffirec(fitsfile *fptr, /* I - FITS file pointer */ + int nkey, /* I - position to insert new keyword */ + char *card, /* I - card string value */ + int *status) /* IO - error status */ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffmaky(fptr, nkey, status); /* move to insert position */ + ffikey(fptr, card, status); /* insert the keyword card */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffikey(fitsfile *fptr, /* I - FITS file pointer */ + char *card, /* I - card string value */ + int *status) /* IO - error status */ +/* + insert a keyword at the position of (fptr->Fptr)->nextkey +*/ +{ + int ii, len, nshift; + long nblocks; + OFF_T bytepos; + char *inbuff, *outbuff, *tmpbuff, buff1[FLEN_CARD], buff2[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ( ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) == 80) /* only room for END card */ + { + nblocks = 1; + if (ffiblk(fptr, nblocks, 0, status) > 0) /* add new 2880-byte block*/ + return(*status); + } + + nshift=( (fptr->Fptr)->headend - (fptr->Fptr)->nextkey ) / 80; /* no. keywords to shift */ + + strncpy(buff2, card, 80); /* copy card to output buffer */ + buff2[80] = '\0'; + + len = strlen(buff2); + for (ii=len; ii < 80; ii++) /* fill buffer with spaces if necessary */ + buff2[ii] = ' '; + + for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */ + buff2[ii] = toupper(buff2[ii]); + + fftkey(buff2, status); /* test keyword name contains legal chars */ + fftrec(buff2, status); /* test rest of keyword for legal chars */ + + inbuff = buff1; + outbuff = buff2; + + bytepos = (fptr->Fptr)->nextkey; /* pointer to next keyword in header */ + ffmbyt(fptr, bytepos, REPORT_EOF, status); + + for (ii = 0; ii < nshift; ii++) /* shift each keyword down one position */ + { + ffgbyt(fptr, 80, inbuff, status); /* read the current keyword */ + + ffmbyt(fptr, bytepos, REPORT_EOF, status); /* move back */ + ffpbyt(fptr, 80, outbuff, status); /* overwrite with other buffer */ + + tmpbuff = inbuff; /* swap input and output buffers */ + inbuff = outbuff; + outbuff = tmpbuff; + + bytepos += 80; + } + + ffpbyt(fptr, 80, outbuff, status); /* write the final keyword */ + + (fptr->Fptr)->headend += 80; /* increment the position of the END keyword */ + (fptr->Fptr)->nextkey += 80; /* increment the pointer to next keyword */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdkey(fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - keyword name */ + int *status) /* IO - error status */ +/* + delete a specified header keyword +*/ +{ + int keypos, len; + char valstring[FLEN_VALUE], comm[FLEN_COMMENT], value[FLEN_VALUE]; + char message[FLEN_ERRMSG]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, comm, status) > 0) /* read keyword */ + { + sprintf(message, "Could not find the %s keyword to delete (ffdkey)", + keyname); + ffpmsg(message); + return(*status); + } + + /* calc position of keyword in header */ + keypos = (((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])) / 80; + + ffdrec(fptr, keypos, status); /* delete the keyword */ + + /* check for string value which may be continued over multiple keywords */ + ffc2s(valstring, value, status); /* remove quotes and trailing spaces */ + len = strlen(value); + + while (len && value[len - 1] == '&') /* ampersand used as continuation char */ + { + ffgcnt(fptr, value, status); + if (*value) + { + ffdrec(fptr, keypos, status); /* delete the keyword */ + len = strlen(value); + } + else /* a null valstring indicates no continuation */ + len = 0; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdrec(fitsfile *fptr, /* I - FITS file pointer */ + int keypos, /* I - position in header of keyword to delete */ + int *status) /* IO - error status */ +/* + Delete a header keyword at position keypos. The 1st keyword is at keypos=1. +*/ +{ + int ii, nshift; + OFF_T bytepos; + char *inbuff, *outbuff, *tmpbuff, buff1[81], buff2[81]; + char message[FLEN_ERRMSG]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if (keypos < 1 || + keypos > (fptr->Fptr)->headend - (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] / 80 ) + return(*status = KEY_OUT_BOUNDS); + + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] + (keypos - 1) * 80; + + nshift=( (fptr->Fptr)->headend - (fptr->Fptr)->nextkey ) / 80; /* no. keywords to shift */ + + if (nshift <= 0) + { + sprintf(message, "Cannot delete keyword number %d. It does not exist.", + keypos); + ffpmsg(message); + return(*status = KEY_OUT_BOUNDS); + } + + bytepos = (fptr->Fptr)->headend - 80; /* last keyword in header */ + + /* construct a blank keyword */ + strcpy(buff2, " "); + strcat(buff2, " "); + inbuff = buff1; + outbuff = buff2; + for (ii = 0; ii < nshift; ii++) /* shift each keyword up one position */ + { + + ffmbyt(fptr, bytepos, REPORT_EOF, status); + ffgbyt(fptr, 80, inbuff, status); /* read the current keyword */ + + ffmbyt(fptr, bytepos, REPORT_EOF, status); + ffpbyt(fptr, 80, outbuff, status); /* overwrite with next keyword */ + + tmpbuff = inbuff; /* swap input and output buffers */ + inbuff = outbuff; + outbuff = tmpbuff; + + bytepos -= 80; + } + + (fptr->Fptr)->headend -= 80; /* decrement the position of the END keyword */ + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/pctype.h b/pkg/tbtables/cfitsio/pctype.h new file mode 100644 index 00000000..2ef4a675 --- /dev/null +++ b/pkg/tbtables/cfitsio/pctype.h @@ -0,0 +1,155 @@ +/* + * These ones are necessary to override the behaviour of + * PINT_cfB, which puts the & on before getting to the + * TYPE specific PCINT_cfPP... + * The only way to do this is to introduce PCDOUBLE_cfINT, + * which means we use PCINT for alot of the generic macros. + */ + +#define PCINT_cfAA PINT_cfAA +#define PCINT_cfN PINT_cfN +#define PCINT_cfV PINT_cfV +#define PCINT_cfZ(T,I,A) (__cfztringv[I]= (int ) *A), +#define PCINT_cfSEP INT_cfSEP +#define PCINT_cfCC PINT_cfCC +#define PCINT_cfB(T,A) _(T,_cfPP) A +#define PCINT_cfU PINT_cfU + +/* These are the real TYPE specific ones, and will need to be + * duplicated for FLOAT,... + */ +#define PCINT_cfINT PCDOUBLE_cfINT +#define PCINT_cfAAP(A, B) A +#define PCINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCINT_cfTYPE int +#define PCINT_cfVP(A,B) int B = (int) *A; /* For ZSTRINGV_ARGS */ +#define PCINT_cfPP +#define PCINT_cfCCC(A,B) A + +#define PCFLOAT_cfINT PCDOUBLE_cfINT +#define PCFLOAT_cfAAP(A, B) A +#define PCFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCFLOAT_cfTYPE float +#define PCFLOAT_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */ +#define PCFLOAT_cfPP +#define PCFLOAT_cfCCC(A,B) A + +#define PCDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PCINT,B,X,Y,Z,0) +#define PCDOUBLE_cfAAP(A, B) A +#define PCDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCDOUBLE_cfTYPE double +#define PCDOUBLE_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */ +#define PCDOUBLE_cfPP +#define PCDOUBLE_cfCCC(A,B) A + +#define PCLOGICAL_cfINT PCDOUBLE_cfINT +#define PCLOGICAL_cfA(M,I,A,B) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfAAP(A,B) B = A +#define PCLOGICAL_cfC(A,B,C) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfH(S,U,B) +#define PCLOGICAL_cfJ(B) +#define PCLOGICAL_cfW(A,B) PLOGICAL_cfW(A,B) +#define PCLOGICAL_cfS(M,I,A) +#define PCLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PCLOGICAL,A,B,C,D,E) +#define PCLOGICAL_cfTYPE int +#define PCLOGICAL_cfVP PLOGICAL_cfVP /* For ZSTRINGV_ARGS */ +#define PCLOGICAL_cfPP +#define PCLOGICAL_cfKK PLOGICAL_cfKK +#define PCLOGICAL_cfCCC(A,B) B = A + +/* + * I can't find where the following three defines are used... + * So they may well be wrong. + */ + +#define PCLOGICAL_cfQ(B) +#define PCLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) + +/* This is to get PZTRINGS to work for dynamically allocated + * Contiguous arrays... The problem was that the array is massaged + * coming in with the call: c2fstrv( A[0], A[0],... ) + * and coming out with: f2cstrv( (char *) A, (char *) A,... ) + * + * If you dynamically allocate an array with the trick: + * + * char ** A; + * A = (char **) malloc ( nelements * sizeof(char *) ); + * A[0] = (char *) malloc (nelements * elemSize * sizeof (char) ); + * for ( i = 1; i < nelements; i++) A[i] = A[0] + i * elemSize; + * + * Then the coming in call will kill you if you pass in A, and the + * coming out call will kill you if you pass in A[0]... + * So, I change the coming in call to (char *)A, and you must then + * pass in A[0]. + * + */ + + +#undef PZTRINGV_cfA +#define PZTRINGV_cfA(M,I,A,B) APAZTRINGV_cfA(M,I,A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) +#ifdef vmsFortran +#define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + initfstr(B,malloc((sA)-(filA)),(filA),(silA)-1), \ c2fstrv((char *) A,B.dsc$a_pointer,(silA),(sA)); +#define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + initfstr(B,(char *) A,(filA),(silA)-1),c2fstrv((char *) A,(char *)A,(silA),(sA)); +#else +#define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + (B.s=malloc((sA)-(filA)),B.fs=c2fstrv((char *)A,B.s,(B.flen=(silA)-1)+1,(sA))); +#define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + B.fs=c2fstrv((char *) A,(char *) A,(B.flen=(silA)-1)+1,B.sizeofA=(sA)); +#endif + + +/* + * This allows for character arrays longer than an unsigned short... + */ + +#ifndef vmsFortran +#undef STRING_cfV +#undef PSTRINGV_cfV +#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B; +#define PSTRINGV_cfV(T,A,B,F) struct {char *fs; unsigned int sizeofA, flen;} B; +#endif + +/* + * This is to introduce a PZTRING ( NO V ) type + */ + + +#ifdef vmsFortran +#define PZTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; +#define APATRING_cfA(M,I,A,B,silA) \ + (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ + B.dsc$w_length >= silA?0:(memset((A)+B.dsc$w_length,' ',silA-B.dsc$w_length-1), \ + A[B.dsc$w_length=silA-1]='\0')); +#define PZTRING_cfC(A,B,C) \ + (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ + B.dsc$w_length >= C?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \ + A[B.dsc$w_length=C-1]='\0')); +#else +#define PZTRING_cfV(T,A,B,F) int B; +#define APATRING_cfA(M,I,A,B,silA) \ + (B=strlen(A),B >= silA?0:(memset((A)+B,' ',silA-B-1)),A[B = silA - 1]='\0'); +#define PZTRING_cfC(A,B,C) \ + (B=strlen(A),B > C?0:(memset((A)+B,' ',(C - 1)-B-1)),A[B = C - 1]='\0'); +#endif + +#define PZTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRING,A,B,C,D,E) +#define PZTRING_cfINT PVOID_cfINT +#define PZTRING_cfA(M,I,A,B) APATRING_cfA(M,I,A,B,(_3(M,_ELEMLEN_,I))+1) +#define PZTRING_cfAA PSTRING_cfCC +#define PZTRING_cfB PSTRING_cfB + +#define PZTRING_cfCC PSTRING_cfCC +#define PZTRING_cfJ PSTRING_cfJ +#define PZTRING_cfH STRING_cfH +#define PZTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PZTRING_cfS(M,I,A) ,( _3(M,_ELEMLEN_,I) + 1 ) +#define PZTRING_cfU(T,A) char *A +#define PZTRING_cfW(A,B) kill_trailing(A,' '); +#define PZTRING_cfZ(T,I,A) +#define PZTRING_cfSEP INT_cfSEP +#define PZTRING_cfKK STRING_cfKK diff --git a/pkg/tbtables/cfitsio/pliocomp.c b/pkg/tbtables/cfitsio/pliocomp.c new file mode 100644 index 00000000..7550ed67 --- /dev/null +++ b/pkg/tbtables/cfitsio/pliocomp.c @@ -0,0 +1,331 @@ +/* stdlib is needed for the abs function */ +#include +/* + The following prototype code was provided by Doug Tody, NRAO, for + performing conversion between pixel arrays and line lists. The + compression technique is used in IRAF. +*/ +int pl_p2li (int *pxsrc, int xs, short *lldst, int npix); +int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix); + + +/* + * PL_P2L -- Convert a pixel array to a line list. The length of the list is + * returned as the function value. + * + * Translated from the SPP version using xc -f, f2c. 8Sep99 DCT. + */ + +#ifndef min +#define min(a,b) (((a)<(b))?(a):(b)) +#endif +#ifndef max +#define max(a,b) (((a)>(b))?(a):(b)) +#endif + +int pl_p2li (int *pxsrc, int xs, short *lldst, int npix) +/* int *pxsrc; input pixel array */ +/* int xs; starting index in pxsrc (?) */ +/* short *lldst; encoded line list */ +/* int npix; number of pixels to convert */ +{ + /* System generated locals */ + int ret_val, i__1, i__2, i__3; + + /* Local variables */ + static int zero, v, x1, hi, ip, dv, xe, np, op, iz, nv, pv, nz; + + /* Parameter adjustments */ + --lldst; + --pxsrc; + + /* Function Body */ + if (! (npix <= 0)) { + goto L110; + } + ret_val = 0; + goto L100; +L110: + lldst[3] = -100; + lldst[2] = 7; + lldst[1] = 0; + lldst[6] = 0; + lldst[7] = 0; + xe = xs + npix - 1; + op = 8; + zero = 0; +/* Computing MAX */ + i__1 = zero, i__2 = pxsrc[xs]; + pv = max(i__1,i__2); + x1 = xs; + iz = xs; + hi = 1; + i__1 = xe; + for (ip = xs; ip <= i__1; ++ip) { + if (! (ip < xe)) { + goto L130; + } +/* Computing MAX */ + i__2 = zero, i__3 = pxsrc[ip + 1]; + nv = max(i__2,i__3); + if (! (nv == pv)) { + goto L140; + } + goto L120; +L140: + if (! (pv == 0)) { + goto L150; + } + pv = nv; + x1 = ip + 1; + goto L120; +L150: + goto L131; +L130: + if (! (pv == 0)) { + goto L160; + } + x1 = xe + 1; +L160: +L131: + np = ip - x1 + 1; + nz = x1 - iz; + if (! (pv > 0)) { + goto L170; + } + dv = pv - hi; + if (! (dv != 0)) { + goto L180; + } + hi = pv; + if (! (abs(dv) > 4095)) { + goto L190; + } + lldst[op] = (short) ((pv & 4095) + 4096); + ++op; + lldst[op] = (short) (pv / 4096); + ++op; + goto L191; +L190: + if (! (dv < 0)) { + goto L200; + } + lldst[op] = (short) (-dv + 12288); + goto L201; +L200: + lldst[op] = (short) (dv + 8192); +L201: + ++op; + if (! (np == 1 && nz == 0)) { + goto L210; + } + v = lldst[op - 1]; + lldst[op - 1] = (short) (v | 16384); + goto L91; +L210: +L191: +L180: +L170: + if (! (nz > 0)) { + goto L220; + } +L230: + if (! (nz > 0)) { + goto L232; + } + lldst[op] = (short) min(4095,nz); + ++op; +/* L231: */ + nz += -4095; + goto L230; +L232: + if (! (np == 1 && pv > 0)) { + goto L240; + } + lldst[op - 1] = (short) (lldst[op - 1] + 20481); + goto L91; +L240: +L220: +L250: + if (! (np > 0)) { + goto L252; + } + lldst[op] = (short) (min(4095,np) + 16384); + ++op; +/* L251: */ + np += -4095; + goto L250; +L252: +L91: + x1 = ip + 1; + iz = x1; + pv = nv; +L120: + ; + } +/* L121: */ + lldst[4] = (short) ((op - 1) % 32768); + lldst[5] = (short) ((op - 1) / 32768); + ret_val = op - 1; + goto L100; +L100: + return ret_val; +} /* plp2li_ */ + +/* + * PL_L2PI -- Translate a PLIO line list into an integer pixel array. + * The number of pixels output (always npix) is returned as the function + * value. + * + * Translated from the SPP version using xc -f, f2c. 8Sep99 DCT. + */ + +int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix) +/* short *ll_src; encoded line list */ +/* int xs; starting index in ll_src */ +/* int *px_dst; output pixel array */ +/* int npix; number of pixels to convert */ +{ + /* System generated locals */ + int ret_val, i__1, i__2; + + /* Local variables */ + static int data, sw0001, otop, i__, lllen, i1, i2, x1, x2, ip, xe, np, + op, pv, opcode, llfirt; + static int skipwd; + + /* Parameter adjustments */ + --px_dst; + --ll_src; + + /* Function Body */ + if (! (ll_src[3] > 0)) { + goto L110; + } + lllen = ll_src[3]; + llfirt = 4; + goto L111; +L110: + lllen = (ll_src[5] << 15) + ll_src[4]; + llfirt = ll_src[2] + 1; +L111: + if (! (npix <= 0 || lllen <= 0)) { + goto L120; + } + ret_val = 0; + goto L100; +L120: + xe = xs + npix - 1; + skipwd = 0; + op = 1; + x1 = 1; + pv = 1; + i__1 = lllen; + for (ip = llfirt; ip <= i__1; ++ip) { + if (! skipwd) { + goto L140; + } + skipwd = 0; + goto L130; +L140: + opcode = ll_src[ip] / 4096; + data = ll_src[ip] & 4095; + sw0001 = opcode; + goto L150; +L160: + x2 = x1 + data - 1; + i1 = max(x1,xs); + i2 = min(x2,xe); + np = i2 - i1 + 1; + if (! (np > 0)) { + goto L170; + } + otop = op + np - 1; + if (! (opcode == 4)) { + goto L180; + } + i__2 = otop; + for (i__ = op; i__ <= i__2; ++i__) { + px_dst[i__] = pv; +/* L190: */ + } +/* L191: */ + goto L181; +L180: + i__2 = otop; + for (i__ = op; i__ <= i__2; ++i__) { + px_dst[i__] = 0; +/* L200: */ + } +/* L201: */ + if (! (opcode == 5 && i2 == x2)) { + goto L210; + } + px_dst[otop] = pv; +L210: +L181: + op = otop + 1; +L170: + x1 = x2 + 1; + goto L151; +L220: + pv = (ll_src[ip + 1] << 12) + data; + skipwd = 1; + goto L151; +L230: + pv += data; + goto L151; +L240: + pv -= data; + goto L151; +L250: + pv += data; + goto L91; +L260: + pv -= data; +L91: + if (! (x1 >= xs && x1 <= xe)) { + goto L270; + } + px_dst[op] = pv; + ++op; +L270: + ++x1; + goto L151; +L150: + ++sw0001; + if (sw0001 < 1 || sw0001 > 8) { + goto L151; + } + switch ((int)sw0001) { + case 1: goto L160; + case 2: goto L220; + case 3: goto L230; + case 4: goto L240; + case 5: goto L160; + case 6: goto L160; + case 7: goto L250; + case 8: goto L260; + } +L151: + if (! (x1 > xe)) { + goto L280; + } + goto L131; +L280: +L130: + ; + } +L131: + i__1 = npix; + for (i__ = op; i__ <= i__1; ++i__) { + px_dst[i__] = 0; +/* L290: */ + } +/* L291: */ + ret_val = npix; + goto L100; +L100: + return ret_val; +} /* pll2pi_ */ + diff --git a/pkg/tbtables/cfitsio/putcol.c b/pkg/tbtables/cfitsio/putcol.c new file mode 100644 index 00000000..348d0930 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcol.c @@ -0,0 +1,1714 @@ +/* This file, putcol.c, contains routines that write data elements to */ +/* a FITS image or table. These are the generic routines. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +OFF_T large_first_elem_val = 0; /* used to pass large firstelem values */ + +/*--------------------------------------------------------------------------*/ +int ffppx( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long *firstpix, /* I - coord of first pixel to write(1 based) */ + long nelem, /* I - number of values to write */ + void *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of pixels to the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). This routine + is simillar to ffppr, except it supports writing large images with + more than 2.1E9 pixels. +*/ +{ + int naxis, ii; + long naxes[9], firstelem, group = 1; + OFF_T dimsize = 1; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* get the size of the image */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, 9, naxes, status); + + /* store the actual first element value in a external variable */ + /* because we can't pass the value directly to the lower routine */ + /* because the parameter is declared as 'long' instead of 'off_t'. */ + + large_first_elem_val = 0; + for (ii=0; ii < naxis; ii++) + { + large_first_elem_val += ((firstpix[ii] - 1) * dimsize); + dimsize *= naxes[ii]; + } + large_first_elem_val++; + + firstelem = USE_LARGE_VALUE; /* special flag value */ + + if (datatype == TBYTE) + { + ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status); + } + else if (datatype == TSBYTE) + { + ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status); + } + else if (datatype == TUSHORT) + { + ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array, + status); + } + else if (datatype == TSHORT) + { + ffppri(fptr, group, firstelem, nelem, (short *) array, status); + } + else if (datatype == TUINT) + { + ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status); + } + else if (datatype == TINT) + { + ffpprk(fptr, group, firstelem, nelem, (int *) array, status); + } + else if (datatype == TULONG) + { + ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status); + } + else if (datatype == TLONG) + { + ffpprj(fptr, group, firstelem, nelem, (long *) array, status); + } + else if (datatype == TLONGLONG) + { + ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status); + } + else if (datatype == TFLOAT) + { + ffppre(fptr, group, firstelem, nelem, (float *) array, status); + } + else if (datatype == TDOUBLE) + { + ffpprd(fptr, group, firstelem, nelem, (double *) array, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppxn( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long *firstpix, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + void *array, /* I - array of values that are written */ + void *nulval, /* I - pointer to the null value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + int naxis, ii; + long naxes[9], firstelem, group = 1; + OFF_T dimsize = 1; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (nulval == NULL) /* null value not defined? */ + { + ffppx(fptr, datatype, firstpix, nelem, array, status); + return(*status); + } + + /* get the size of the image */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, 9, naxes, status); + + /* store the actual first element value in a external variable */ + /* because we can't pass the value directly to the lower routine */ + /* because the parameter is declared as 'long' instead of 'off_t'. */ + + large_first_elem_val = 0; + for (ii=0; ii < naxis; ii++) + { + large_first_elem_val += ((firstpix[ii] - 1) * dimsize); + dimsize *= naxes[ii]; + } + large_first_elem_val++; + + firstelem = USE_LARGE_VALUE; /* special flag value */ + + if (datatype == TBYTE) + { + ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array, + *(unsigned char *) nulval, status); + } + else if (datatype == TSBYTE) + { + ffppnsb(fptr, group, firstelem, nelem, (signed char *) array, + *(signed char *) nulval, status); + } + else if (datatype == TUSHORT) + { + ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array, + *(unsigned short *) nulval,status); + } + else if (datatype == TSHORT) + { + ffppni(fptr, group, firstelem, nelem, (short *) array, + *(short *) nulval, status); + } + else if (datatype == TUINT) + { + ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array, + *(unsigned int *) nulval, status); + } + else if (datatype == TINT) + { + ffppnk(fptr, group, firstelem, nelem, (int *) array, + *(int *) nulval, status); + } + else if (datatype == TULONG) + { + ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array, + *(unsigned long *) nulval,status); + } + else if (datatype == TLONG) + { + ffppnj(fptr, group, firstelem, nelem, (long *) array, + *(long *) nulval, status); + } + else if (datatype == TLONGLONG) + { + ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array, + *(LONGLONG *) nulval, status); + } + else if (datatype == TFLOAT) + { + ffppne(fptr, group, firstelem, nelem, (float *) array, + *(float *) nulval, status); + } + else if (datatype == TDOUBLE) + { + ffppnd(fptr, group, firstelem, nelem, (double *) array, + *(double *) nulval, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppr( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + void *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long group = 1; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (datatype == TBYTE) + { + ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status); + } + else if (datatype == TSBYTE) + { + ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status); + } + else if (datatype == TUSHORT) + { + ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array, + status); + } + else if (datatype == TSHORT) + { + ffppri(fptr, group, firstelem, nelem, (short *) array, status); + } + else if (datatype == TUINT) + { + ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status); + } + else if (datatype == TINT) + { + ffpprk(fptr, group, firstelem, nelem, (int *) array, status); + } + else if (datatype == TULONG) + { + ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status); + } + else if (datatype == TLONG) + { + ffpprj(fptr, group, firstelem, nelem, (long *) array, status); + } + else if (datatype == TLONGLONG) + { + ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status); + } + else if (datatype == TFLOAT) + { + ffppre(fptr, group, firstelem, nelem, (float *) array, status); + } + else if (datatype == TDOUBLE) + { + ffpprd(fptr, group, firstelem, nelem, (double *) array, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppn( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + void *array, /* I - array of values that are written */ + void *nulval, /* I - pointer to the null value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long group = 1; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (nulval == NULL) /* null value not defined? */ + { + ffppr(fptr, datatype, firstelem, nelem, array, status); + return(*status); + } + + if (datatype == TBYTE) + { + ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array, + *(unsigned char *) nulval, status); + } + else if (datatype == TSBYTE) + { + ffppnsb(fptr, group, firstelem, nelem, (signed char *) array, + *(signed char *) nulval, status); + } + else if (datatype == TUSHORT) + { + ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array, + *(unsigned short *) nulval,status); + } + else if (datatype == TSHORT) + { + ffppni(fptr, group, firstelem, nelem, (short *) array, + *(short *) nulval, status); + } + else if (datatype == TUINT) + { + ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array, + *(unsigned int *) nulval, status); + } + else if (datatype == TINT) + { + ffppnk(fptr, group, firstelem, nelem, (int *) array, + *(int *) nulval, status); + } + else if (datatype == TULONG) + { + ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array, + *(unsigned long *) nulval,status); + } + else if (datatype == TLONG) + { + ffppnj(fptr, group, firstelem, nelem, (long *) array, + *(long *) nulval, status); + } + else if (datatype == TLONGLONG) + { + ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array, + *(LONGLONG *) nulval, status); + } + else if (datatype == TFLOAT) + { + ffppne(fptr, group, firstelem, nelem, (float *) array, + *(float *) nulval, status); + } + else if (datatype == TDOUBLE) + { + ffppnd(fptr, group, firstelem, nelem, (double *) array, + *(double *) nulval, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpss( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + long *blc, /* I - 'bottom left corner' of the subsection */ + long *trc , /* I - 'top right corner' of the subsection */ + void *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write a section of values to the primary array. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + int naxis; + long naxes[9]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* get the size of the image */ + ffgidm(fptr, &naxis, status); + ffgisz(fptr, 9, naxes, status); + + if (datatype == TBYTE) + { + ffpssb(fptr, 1, naxis, naxes, blc, trc, + (unsigned char *) array, status); + } + else if (datatype == TSBYTE) + { + ffpsssb(fptr, 1, naxis, naxes, blc, trc, + (signed char *) array, status); + } + else if (datatype == TUSHORT) + { + ffpssui(fptr, 1, naxis, naxes, blc, trc, + (unsigned short *) array, status); + } + else if (datatype == TSHORT) + { + ffpssi(fptr, 1, naxis, naxes, blc, trc, + (short *) array, status); + } + else if (datatype == TUINT) + { + ffpssuk(fptr, 1, naxis, naxes, blc, trc, + (unsigned int *) array, status); + } + else if (datatype == TINT) + { + ffpssk(fptr, 1, naxis, naxes, blc, trc, + (int *) array, status); + } + else if (datatype == TULONG) + { + ffpssuj(fptr, 1, naxis, naxes, blc, trc, + (unsigned long *) array, status); + } + else if (datatype == TLONG) + { + ffpssj(fptr, 1, naxis, naxes, blc, trc, + (long *) array, status); + } + else if (datatype == TLONGLONG) + { + ffpssjj(fptr, 1, naxis, naxes, blc, trc, + (LONGLONG *) array, status); + } else if (datatype == TFLOAT) + { + ffpsse(fptr, 1, naxis, naxes, blc, trc, + (float *) array, status); + } + else if (datatype == TDOUBLE) + { + ffpssd(fptr, 1, naxis, naxes, blc, trc, + (double *) array, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcl( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of elements to write */ + void *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to a table column. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS column is not the same as the array being written). +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (datatype == TBIT) + { + ffpclx(fptr, colnum, firstrow, firstelem, nelem, (char *) array, + status); + } + else if (datatype == TBYTE) + { + ffpclb(fptr, colnum, firstrow, firstelem, nelem, (unsigned char *) array, + status); + } + else if (datatype == TSBYTE) + { + ffpclsb(fptr, colnum, firstrow, firstelem, nelem, (signed char *) array, + status); + } + else if (datatype == TUSHORT) + { + ffpclui(fptr, colnum, firstrow, firstelem, nelem, + (unsigned short *) array, status); + } + else if (datatype == TSHORT) + { + ffpcli(fptr, colnum, firstrow, firstelem, nelem, (short *) array, + status); + } + else if (datatype == TUINT) + { + ffpcluk(fptr, colnum, firstrow, firstelem, nelem, (unsigned int *) array, + status); + } + else if (datatype == TINT) + { + ffpclk(fptr, colnum, firstrow, firstelem, nelem, (int *) array, + status); + } + else if (datatype == TULONG) + { + ffpcluj(fptr, colnum, firstrow, firstelem, nelem, (unsigned long *) array, + status); + } + else if (datatype == TLONG) + { + ffpclj(fptr, colnum, firstrow, firstelem, nelem, (long *) array, + status); + } + else if (datatype == TLONGLONG) + { + ffpcljj(fptr, colnum, firstrow, firstelem, nelem, (LONGLONG *) array, + status); + } + else if (datatype == TFLOAT) + { + ffpcle(fptr, colnum, firstrow, firstelem, nelem, (float *) array, + status); + } + else if (datatype == TDOUBLE) + { + ffpcld(fptr, colnum, firstrow, firstelem, nelem, (double *) array, + status); + } + else if (datatype == TCOMPLEX) + { + ffpcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + (float *) array, status); + } + else if (datatype == TDBLCOMPLEX) + { + ffpcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + (double *) array, status); + } + else if (datatype == TLOGICAL) + { + ffpcll(fptr, colnum, firstrow, firstelem, nelem, (char *) array, + status); + } + else if (datatype == TSTRING) + { + ffpcls(fptr, colnum, firstrow, firstelem, nelem, (char **) array, + status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcn( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of elements to write */ + void *array, /* I - array of values that are written */ + void *nulval, /* I - pointer to the null value */ + int *status) /* IO - error status */ +/* + Write an array of values to a table column. The datatype of the + input array is defined by the 2nd argument. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS column is not the same as the array being written). +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (nulval == NULL) /* null value not defined? */ + { + ffpcl(fptr, datatype, colnum, firstrow, firstelem, nelem, array, + status); + return(*status); + } + + if (datatype == TBYTE) + { + ffpcnb(fptr, colnum, firstrow, firstelem, nelem, (unsigned char *) array, + *(unsigned char *) nulval, status); + } + else if (datatype == TSBYTE) + { + ffpcnsb(fptr, colnum, firstrow, firstelem, nelem, (signed char *) array, + *(signed char *) nulval, status); + } + else if (datatype == TUSHORT) + { + ffpcnui(fptr, colnum, firstrow, firstelem, nelem, (unsigned short *) array, + *(unsigned short *) nulval, status); + } + else if (datatype == TSHORT) + { + ffpcni(fptr, colnum, firstrow, firstelem, nelem, (short *) array, + *(unsigned short *) nulval, status); + } + else if (datatype == TUINT) + { + ffpcnuk(fptr, colnum, firstrow, firstelem, nelem, (unsigned int *) array, + *(unsigned int *) nulval, status); + } + else if (datatype == TINT) + { + ffpcnk(fptr, colnum, firstrow, firstelem, nelem, (int *) array, + *(int *) nulval, status); + } + else if (datatype == TULONG) + { + ffpcnuj(fptr, colnum, firstrow, firstelem, nelem, (unsigned long *) array, + *(unsigned long *) nulval, status); + } + else if (datatype == TLONG) + { + ffpcnj(fptr, colnum, firstrow, firstelem, nelem, (long *) array, + *(long *) nulval, status); + } + else if (datatype == TLONGLONG) + { + ffpcnjj(fptr, colnum, firstrow, firstelem, nelem, (LONGLONG *) array, + *(LONGLONG *) nulval, status); + } + else if (datatype == TFLOAT) + { + ffpcne(fptr, colnum, firstrow, firstelem, nelem, (float *) array, + *(float *) nulval, status); + } + else if (datatype == TDOUBLE) + { + ffpcnd(fptr, colnum, firstrow, firstelem, nelem, (double *) array, + *(double *) nulval, status); + } + else if (datatype == TCOMPLEX) + { + ffpcne(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + (float *) array, *(float *) nulval, status); + } + else if (datatype == TDBLCOMPLEX) + { + ffpcnd(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2, + (double *) array, *(double *) nulval, status); + } + else if (datatype == TLOGICAL) + { + ffpcnl(fptr, colnum, firstrow, firstelem, nelem, (char *) array, + *(char *) nulval, status); + } + else if (datatype == TSTRING) + { + ffpcns(fptr, colnum, firstrow, firstelem, nelem, (char **) array, + (char *) nulval, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_by_name(iteratorCol *col, /* I - iterator col structure */ + fitsfile *fptr, /* I - FITS file pointer */ + char *colname, /* I - column name */ + int datatype, /* I - column datatype */ + int iotype) /* I - InputCol, InputOutputCol, or OutputCol */ +/* + set all the parameters for an iterator column, by column name +*/ +{ + col->fptr = fptr; + strcpy(col->colname, colname); + col->colnum = 0; /* set column number undefined since name is given */ + col->datatype = datatype; + col->iotype = iotype; + return(0); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_by_num(iteratorCol *col, /* I - iterator column structure */ + fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number */ + int datatype, /* I - column datatype */ + int iotype) /* I - InputCol, InputOutputCol, or OutputCol */ +/* + set all the parameters for an iterator column, by column number +*/ +{ + col->fptr = fptr; + col->colnum = colnum; + col->datatype = datatype; + col->iotype = iotype; + return(0); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_file(iteratorCol *col, /* I - iterator column structure */ + fitsfile *fptr) /* I - FITS file pointer */ +/* + set iterator column parameter +*/ +{ + col->fptr = fptr; + return(0); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_colname(iteratorCol *col, /* I - iterator col structure */ + char *colname) /* I - column name */ +/* + set iterator column parameter +*/ +{ + strcpy(col->colname, colname); + col->colnum = 0; /* set column number undefined since name is given */ + return(0); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_colnum(iteratorCol *col, /* I - iterator column structure */ + int colnum) /* I - column number */ +/* + set iterator column parameter +*/ +{ + col->colnum = colnum; + return(0); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_datatype(iteratorCol *col, /* I - iterator col structure */ + int datatype) /* I - column datatype */ +/* + set iterator column parameter +*/ +{ + col->datatype = datatype; + return(0); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_set_iotype(iteratorCol *col, /* I - iterator column structure */ + int iotype) /* I - InputCol, InputOutputCol, or OutputCol */ +/* + set iterator column parameter +*/ +{ + col->iotype = iotype; + return(0); +} +/*--------------------------------------------------------------------------*/ +fitsfile * fits_iter_get_file(iteratorCol *col) /* I -iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->fptr); +} +/*--------------------------------------------------------------------------*/ +char * fits_iter_get_colname(iteratorCol *col) /* I -iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->colname); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_get_colnum(iteratorCol *col) /* I - iterator column structure */ +/* + get iterator column parameter +*/ +{ + return(col->colnum); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_get_datatype(iteratorCol *col) /* I - iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->datatype); +} +/*--------------------------------------------------------------------------*/ +int fits_iter_get_iotype(iteratorCol *col) /* I - iterator column structure */ +/* + get iterator column parameter +*/ +{ + return(col->iotype); +} +/*--------------------------------------------------------------------------*/ +void * fits_iter_get_array(iteratorCol *col) /* I - iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->array); +} +/*--------------------------------------------------------------------------*/ +long fits_iter_get_tlmin(iteratorCol *col) /* I - iterator column structure */ +/* + get iterator column parameter +*/ +{ + return(col->tlmin); +} +/*--------------------------------------------------------------------------*/ +long fits_iter_get_tlmax(iteratorCol *col) /* I - iterator column structure */ +/* + get iterator column parameter +*/ +{ + return(col->tlmax); +} +/*--------------------------------------------------------------------------*/ +long fits_iter_get_repeat(iteratorCol *col) /* I - iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->repeat); +} +/*--------------------------------------------------------------------------*/ +char * fits_iter_get_tunit(iteratorCol *col) /* I - iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->tunit); +} +/*--------------------------------------------------------------------------*/ +char * fits_iter_get_tdisp(iteratorCol *col) /* I -iterator col structure */ +/* + get iterator column parameter +*/ +{ + return(col->tdisp); +} +/*--------------------------------------------------------------------------*/ +int ffiter(int n_cols, + iteratorCol *cols, + long offset, + long n_per_loop, + int (*work_fn)(long total_n, + long offset, + long first_n, + long n_values, + int n_cols, + iteratorCol *cols, + void *userPointer), + void *userPointer, + int *status) +/* + The iterator function. This function will pass the specified + columns from a FITS table or pixels from a FITS image to the + user-supplied function. Depending on the size of the table + or image, only a subset of the rows or pixels may be passed to the + function on each call, in which case the function will be called + multiple times until all the rows or pixels have been processed. +*/ +{ + typedef struct /* structure to store the column null value */ + { + int nullsize; /* length of the null value, in bytes */ + union { /* default null value for the column */ + char *stringnull; + unsigned char charnull; + signed char scharnull; + int intnull; + short shortnull; + long longnull; + unsigned int uintnull; + unsigned short ushortnull; + unsigned long ulongnull; + float floatnull; + double doublenull; + } null; + } colNulls; + + void *dataptr, *defaultnull; + colNulls *col; + int ii, jj, tstatus, naxis, bitpix; + int typecode, hdutype, jtype, type, anynul, nfiles, nbytes; + long totaln, nleft, frow, felement, n_optimum, i_optimum, ntodo; + long rept, rowrept, width, tnull, naxes[9] = {1,1,1,1,1,1,1,1,1}, groups; + double zeros = 0.; + char message[FLEN_ERRMSG], keyname[FLEN_KEYWORD], nullstr[FLEN_VALUE]; + char **stringptr, *nullptr, *cptr; + + if (*status > 0) + return(*status); + + if (n_cols < 0 || n_cols > 999 ) + { + ffpmsg("Illegal number of columms (ffiter)"); + return(*status = BAD_COL_NUM); /* negative number of columns */ + } + + col = calloc(n_cols, sizeof(colNulls) ); /* memory for the null values */ + + /*------------------------------------------------------------*/ + /* Make sure column numbers and datatypes are in legal range */ + /* and column numbers and datatypes are legal. */ + /* Also fill in other parameters in the column structure. */ + /*------------------------------------------------------------*/ + + ffghdt(cols[0].fptr, &hdutype, status); /* type of first HDU */ + + for (jj = 0; jj < n_cols; jj++) + { + /* check that output datatype code value is legal */ + type = cols[jj].datatype; + + /* Allow variable length arrays for InputCol and InputOutputCol columns, + but not for OutputCol columns. Variable length arrays have a + negative type code value. */ + + if ((cols[jj].iotype != OutputCol) && (type<0)) { + type*=-1; + } + + if (type != 0 && type != TBYTE && + type != TSBYTE && type != TLOGICAL && type != TSTRING && + type != TSHORT && type != TINT && type != TLONG && + type != TFLOAT && type != TDOUBLE && type != TCOMPLEX && + type != TULONG && type != TUSHORT && type != TDBLCOMPLEX) + { + if (type < 0) { + sprintf(message, + "Variable length array not allowed for output column number %d (ffiter)", + jj + 1); + } else { + sprintf(message, + "Illegal datatype for column number %d: %d (ffiter)", + jj + 1, cols[jj].datatype); + } + + ffpmsg(message); + return(*status = BAD_DATATYPE); + } + + /* initialize TLMINn, TLMAXn, column name, and display format */ + cols[jj].tlmin = 0; + cols[jj].tlmax = 0; + cols[jj].tunit[0] = '\0'; + cols[jj].tdisp[0] = '\0'; + + ffghdt(cols[jj].fptr, &jtype, status); /* get HDU type */ + + if (hdutype == IMAGE_HDU) + { + if (jtype != IMAGE_HDU) + { + sprintf(message, + "File %d not positioned to an image extension (ffiter)", + jj + 1); + return(*status = NOT_IMAGE); + } + + /* since this is an image, set a dummy column number = 0 */ + cols[jj].colnum = 0; + strcpy(cols[jj].colname, "IMAGE"); /* dummy name for images */ + + tstatus = 0; + ffgkys(cols[jj].fptr, "BUNIT", cols[jj].tunit, 0, &tstatus); + } + else + { + if (jtype == IMAGE_HDU) + { + sprintf(message, + "File %d not positioned to a table extension (ffiter)", + jj + 1); + return(*status = NOT_TABLE); + } + + if (cols[jj].colnum < 1) + { + /* find the column number for the named column */ + if (ffgcno(cols[jj].fptr, CASEINSEN, cols[jj].colname, + &cols[jj].colnum, status) ) + { + sprintf(message, + "Column '%s' not found for column number %d (ffiter)", + cols[jj].colname, jj + 1); + ffpmsg(message); + return(*status); + } + } + + if (cols[jj].colnum < 1 || + cols[jj].colnum > ((cols[jj].fptr)->Fptr)->tfield) + { + sprintf(message, + "Column %d has illegal table position number: %d (ffiter)", + jj + 1, cols[jj].colnum); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + + /* look for column description keywords and update structure */ + tstatus = 0; + ffkeyn("TLMIN", cols[jj].colnum, keyname, &tstatus); + ffgkyj(cols[jj].fptr, keyname, &cols[jj].tlmin, 0, &tstatus); + + tstatus = 0; + ffkeyn("TLMAX", cols[jj].colnum, keyname, &tstatus); + ffgkyj(cols[jj].fptr, keyname, &cols[jj].tlmax, 0, &tstatus); + + tstatus = 0; + ffkeyn("TTYPE", cols[jj].colnum, keyname, &tstatus); + ffgkys(cols[jj].fptr, keyname, cols[jj].colname, 0, &tstatus); + if (tstatus) + cols[jj].colname[0] = '\0'; + + tstatus = 0; + ffkeyn("TUNIT", cols[jj].colnum, keyname, &tstatus); + ffgkys(cols[jj].fptr, keyname, cols[jj].tunit, 0, &tstatus); + + tstatus = 0; + ffkeyn("TDISP", cols[jj].colnum, keyname, &tstatus); + ffgkys(cols[jj].fptr, keyname, cols[jj].tdisp, 0, &tstatus); + } + } + + /*-----------------------------------------------------------------*/ + /* use the first file to set the total number of values to process */ + /*-----------------------------------------------------------------*/ + + offset = maxvalue(offset, 0L); /* make sure offset is legal */ + + if (hdutype == IMAGE_HDU) /* get total number of pixels in the image */ + { + fits_get_img_dim(cols[0].fptr, &naxis, status); + fits_get_img_size(cols[0].fptr, 9, naxes, status); + + tstatus = 0; + ffgkyj(cols[0].fptr, "GROUPS", &groups, NULL, &tstatus); + if (!tstatus && groups && (naxis > 1) && (naxes[0] == 0) ) + { + /* this is a random groups file, with NAXIS1 = 0 */ + /* Use GCOUNT, the number of groups, as the first multiplier */ + /* to calculate the total number of pixels in all the groups. */ + ffgkyj(cols[0].fptr, "GCOUNT", &totaln, NULL, status); + + } else { + totaln = naxes[0]; + } + + for (ii = 1; ii < naxis; ii++) + totaln *= naxes[ii]; + + frow = 1; + felement = 1 + offset; + } + else /* get total number or rows in the table */ + { + ffgkyj(cols[0].fptr, "NAXIS2", &totaln, 0, status); + frow = 1 + offset; + felement = 1; + } + + /* adjust total by the input starting offset value */ + totaln -= offset; + totaln = maxvalue(totaln, 0L); /* don't allow negative number */ + + /*------------------------------------------------------------------*/ + /* Determine number of values to pass to work function on each loop */ + /*------------------------------------------------------------------*/ + + if (n_per_loop == 0) + { + /* Determine optimum number of values for each iteration. */ + /* Look at all the fitsfile pointers to determine the number */ + /* of unique files. */ + + nfiles = 1; + ffgrsz(cols[0].fptr, &n_optimum, status); + + for (jj = 1; jj < n_cols; jj++) + { + for (ii = 0; ii < jj; ii++) + { + if (cols[ii].fptr == cols[jj].fptr) + break; + } + + if (ii == jj) /* this is a new file */ + { + nfiles++; + ffgrsz(cols[jj].fptr, &i_optimum, status); + n_optimum = minvalue(n_optimum, i_optimum); + } + } + + n_optimum = n_optimum / nfiles; + n_optimum = maxvalue(n_optimum, 1); + } + else if (n_per_loop < 0) /* must pass all the values at one time */ + { + n_optimum = totaln; + } + else /* calling routine specified how many values to pass at a time */ + { + n_optimum = minvalue(n_per_loop, totaln); + } + + /*--------------------------------------*/ + /* allocate work arrays for each column */ + /* and determine the null pixel value */ + /*--------------------------------------*/ + + for (jj = 0; jj < n_cols; jj++) + { + /* get image or column datatype and vector length */ + if (hdutype == IMAGE_HDU) /* get total number of pixels in the image */ + { + fits_get_img_type(cols[jj].fptr, &bitpix, status); + switch(bitpix) { + case BYTE_IMG: + typecode = TBYTE; + break; + case SHORT_IMG: + typecode = TSHORT; + break; + case LONG_IMG: + typecode = TLONG; + break; + case FLOAT_IMG: + typecode = TFLOAT; + break; + case DOUBLE_IMG: + typecode = TDOUBLE; + break; + } + } + else + { + if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept, + &width, status) > 0) + goto cleanup; + + if (typecode < 0) { /* if any variable length arrays, then the */ + n_optimum = 1; /* must process the table 1 row at a time */ + + /* Allow variable length arrays for InputCol and InputOutputCol columns, + but not for OutputCol columns. Variable length arrays have a + negative type code value. */ + + if (cols[jj].iotype == OutputCol) { + sprintf(message, + "Variable length array not allowed for output column number %d (ffiter)", + jj + 1); + ffpmsg(message); + return(*status = BAD_DATATYPE); + } + } + } + + /* special case where sizeof(long) = 8: use TINT instead of TLONG */ + if (abs(typecode) == TLONG && sizeof(long) == 8 && sizeof(int) == 4) { + if(typecode<0) { + typecode = -TINT; + } else { + typecode = TINT; + } + } + + /* Special case: interprete 'X' column as 'B' */ + if (abs(typecode) == TBIT) + { + typecode = typecode / TBIT * TBYTE; + rept = (rept + 7) / 8; + } + + if (cols[jj].datatype == 0) /* output datatype not specified? */ + { + /* special case if sizeof(long) = 8: use TINT instead of TLONG */ + if (abs(typecode) == TLONG && sizeof(long) == 8 && sizeof(int) == 4) + cols[jj].datatype = TINT; + else + cols[jj].datatype = abs(typecode); + } + + /* calc total number of elements to do on each iteration */ + if (hdutype == IMAGE_HDU || cols[jj].datatype == TSTRING) + { + ntodo = n_optimum; + cols[jj].repeat = 1; + + /* get the BLANK keyword value, if it exists */ + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tstatus = 0; + ffgkyj(cols[jj].fptr, "BLANK", &tnull, 0, &tstatus); + if (tstatus) + { + tnull = 0L; /* no null values */ + } + } + } + else + { + if (typecode < 0) + { + /* get max size of the variable length vector; dont't trust the value + given by the TFORM keyword */ + rept = 1; + for (ii = 0; ii < totaln; ii++) { + ffgdes(cols[jj].fptr, cols[jj].colnum, frow + ii, &rowrept, NULL, status); + + rept = maxvalue(rept, rowrept); + } + } + + ntodo = n_optimum * rept; /* vector columns */ + cols[jj].repeat = rept; + + /* get the TNULL keyword value, if it exists */ + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tstatus = 0; + if (hdutype == ASCII_TBL) /* TNULLn value is a string */ + { + ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus); + ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus); + if (tstatus) + { + tnull = 0L; /* keyword doesn't exist; no null values */ + } + else + { + cptr = nullstr; + while (*cptr == ' ') /* skip over leading blanks */ + cptr++; + + if (*cptr == '\0') /* TNULLn is all blanks? */ + tnull = LONG_MIN; + else + { + /* attempt to read TNULLn string as an integer */ + ffc2ii(nullstr, &tnull, &tstatus); + + if (tstatus) + tnull = LONG_MIN; /* choose smallest value */ + } /* to represent nulls */ + } + } + else /* Binary table; TNULLn value is an integer */ + { + ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus); + ffgkyj(cols[jj].fptr, keyname, &tnull, 0, &tstatus); + if (tstatus) + { + tnull = 0L; /* keyword doesn't exist; no null values */ + } + else if (tnull == 0) + { + /* worst possible case: a value of 0 is used to */ + /* represent nulls in the FITS file. We have to */ + /* use a non-zero null value here (zero is used to */ + /* mean there are no null values in the array) so we */ + /* will use the smallest possible integer instead. */ + + tnull = LONG_MIN; /* choose smallest possible value */ + } + } + } + } + + /* Note that the data array starts with 2nd element; */ + /* 1st element of the array gives the null data value */ + + switch (cols[jj].datatype) + { + case TBYTE: + cols[jj].array = calloc(ntodo + 1, sizeof(char)); + col[jj].nullsize = sizeof(char); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tnull = minvalue(tnull, 255); + tnull = maxvalue(tnull, 0); + col[jj].null.charnull = (unsigned char) tnull; + } + else + { + col[jj].null.charnull = (unsigned char) 255; /* use 255 as null */ + } + break; + + case TSBYTE: + cols[jj].array = calloc(ntodo + 1, sizeof(char)); + col[jj].nullsize = sizeof(char); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tnull = minvalue(tnull, 127); + tnull = maxvalue(tnull, -128); + col[jj].null.scharnull = (signed char) tnull; + } + else + { + col[jj].null.scharnull = (signed char) -128; /* use -128 null */ + } + break; + + case TSHORT: + cols[jj].array = calloc(ntodo + 1, sizeof(short)); + col[jj].nullsize = sizeof(short); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tnull = minvalue(tnull, SHRT_MAX); + tnull = maxvalue(tnull, SHRT_MIN); + col[jj].null.shortnull = (short) tnull; + } + else + { + col[jj].null.shortnull = SHRT_MIN; /* use minimum as null */ + } + break; + + case TUSHORT: + cols[jj].array = calloc(ntodo + 1, sizeof(unsigned short)); + col[jj].nullsize = sizeof(unsigned short); /* bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tnull = minvalue(tnull, USHRT_MAX); + tnull = maxvalue(tnull, 0); /* don't allow negative value */ + col[jj].null.ushortnull = (unsigned short) tnull; + } + else + { + col[jj].null.ushortnull = USHRT_MAX; /* use maximum null */ + } + break; + + case TINT: + cols[jj].array = calloc(sizeof(int), ntodo + 1); + col[jj].nullsize = sizeof(int); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tnull = minvalue(tnull, INT_MAX); + tnull = maxvalue(tnull, INT_MIN); + col[jj].null.intnull = (int) tnull; + } + else + { + col[jj].null.intnull = INT_MIN; /* use minimum as null */ + } + break; + + case TUINT: + cols[jj].array = calloc(ntodo + 1, sizeof(unsigned int)); + col[jj].nullsize = sizeof(unsigned int); /* bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + tnull = minvalue(tnull, INT32_MAX); + tnull = maxvalue(tnull, 0); + col[jj].null.uintnull = (unsigned int) tnull; + } + else + { + col[jj].null.intnull = UINT_MAX; /* use maximum as null */ + } + break; + + case TLONG: + cols[jj].array = calloc(ntodo + 1, sizeof(long)); + col[jj].nullsize = sizeof(long); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + col[jj].null.longnull = tnull; + } + else + { + col[jj].null.longnull = LONG_MIN; /* use minimum as null */ + } + break; + + case TULONG: + cols[jj].array = calloc(ntodo + 1, sizeof(unsigned long)); + col[jj].nullsize = sizeof(unsigned long); /* bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + if (tnull < 0) /* can't use a negative null value */ + col[jj].null.ulongnull = LONG_MAX; + else + col[jj].null.ulongnull = (unsigned long) tnull; + } + else + { + col[jj].null.ulongnull = LONG_MAX; /* use maximum as null */ + } + break; + + case TFLOAT: + cols[jj].array = calloc(ntodo + 1, sizeof(float)); + col[jj].nullsize = sizeof(float); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + col[jj].null.floatnull = (float) tnull; + } + else + { + col[jj].null.floatnull = FLOATNULLVALUE; /* special value */ + } + break; + + case TCOMPLEX: + cols[jj].array = calloc((ntodo * 2) + 1, sizeof(float)); + col[jj].nullsize = sizeof(float); /* number of bytes per value */ + col[jj].null.floatnull = FLOATNULLVALUE; /* special value */ + break; + + case TDOUBLE: + cols[jj].array = calloc(ntodo + 1, sizeof(double)); + col[jj].nullsize = sizeof(double); /* number of bytes per value */ + + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG) + { + col[jj].null.doublenull = (double) tnull; + } + else + { + col[jj].null.doublenull = DOUBLENULLVALUE; /* special value */ + } + break; + + case TDBLCOMPLEX: + cols[jj].array = calloc((ntodo * 2) + 1, sizeof(double)); + col[jj].nullsize = sizeof(double); /* number of bytes per value */ + col[jj].null.doublenull = DOUBLENULLVALUE; /* special value */ + break; + + case TSTRING: + /* allocate array of pointers to all the strings */ + if( hdutype==ASCII_TBL ) rept = width; + stringptr = calloc((ntodo + 1) , sizeof(stringptr)); + cols[jj].array = stringptr; + col[jj].nullsize = rept + 1; /* number of bytes per value */ + + if (stringptr) + { + /* allocate string to store the null string value */ + col[jj].null.stringnull = calloc(rept + 1, sizeof(char) ); + col[jj].null.stringnull[1] = 1; /* to make sure string != 0 */ + + /* allocate big block for the array of table column strings */ + stringptr[0] = calloc((ntodo + 1) * (rept + 1), sizeof(char) ); + + if (stringptr[0]) + { + for (ii = 1; ii <= ntodo; ii++) + { /* pointer to each string */ + stringptr[ii] = stringptr[ii - 1] + (rept + 1); + } + + /* get the TNULL keyword value, if it exists */ + tstatus = 0; + ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus); + ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus); + if (!tstatus) + strncat(col[jj].null.stringnull, nullstr, rept); + } + else + { + ffpmsg("ffiter failed to allocate memory arrays"); + *status = MEMORY_ALLOCATION; /* memory allocation failed */ + goto cleanup; + } + } + break; + + case TLOGICAL: + + cols[jj].array = calloc(ntodo + 1, sizeof(char)); + col[jj].nullsize = sizeof(char); /* number of bytes per value */ + + /* use value = 2 to flag null values in logical columns */ + col[jj].null.charnull = 2; + break; + + default: + sprintf(message, + "Column %d datatype currently not supported: %d: (ffiter)", + jj + 1, cols[jj].datatype); + ffpmsg(message); + *status = BAD_DATATYPE; + goto cleanup; + + } /* end of switch block */ + + /* check that all the arrays were allocated successfully */ + if (!cols[jj].array) + { + ffpmsg("ffiter failed to allocate memory arrays"); + *status = MEMORY_ALLOCATION; /* memory allocation failed */ + goto cleanup; + } + } + + /*--------------------------------------------------*/ + /* main loop while there are values left to process */ + /*--------------------------------------------------*/ + + nleft = totaln; + + while (nleft) + { + ntodo = minvalue(nleft, n_optimum); /* no. of values for this loop */ + + /* read input columns from FITS file(s) */ + for (jj = 0; jj < n_cols; jj++) + { + if (cols[jj].iotype != OutputCol) + { + if (cols[jj].datatype == TSTRING) + { + stringptr = cols[jj].array; + dataptr = stringptr + 1; + defaultnull = col[jj].null.stringnull; /* ptr to the null value */ + } + else + { + dataptr = (char *) cols[jj].array + col[jj].nullsize; + defaultnull = &col[jj].null.charnull; /* ptr to the null value */ + } + + if (hdutype == IMAGE_HDU) + { + if (ffgpv(cols[jj].fptr, cols[jj].datatype, + felement, cols[jj].repeat * ntodo, defaultnull, + dataptr, &anynul, status) > 0) + { + break; + } + } + else + { + if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0) + goto cleanup; + + if (typecode<0) + { + /* get size of the variable length vector */ + ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status); + } + + if (ffgcv(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, + frow, felement, cols[jj].repeat * ntodo, defaultnull, + dataptr, &anynul, status) > 0) + { + break; + } + } + + /* copy the appropriate null value into first array element */ + + if (anynul) /* are there any nulls in the data? */ + { + if (cols[jj].datatype == TSTRING) + { + stringptr = cols[jj].array; + memcpy(*stringptr, col[jj].null.stringnull, col[jj].nullsize); + } + else + { + memcpy(cols[jj].array, defaultnull, col[jj].nullsize); + } + } + else /* no null values so copy zero into first element */ + { + if (cols[jj].datatype == TSTRING) + { + stringptr = cols[jj].array; + memset(*stringptr, 0, col[jj].nullsize); + } + else + { + memset(cols[jj].array, 0, col[jj].nullsize); + } + } + } + } + + if (*status > 0) + break; /* looks like an error occurred; quit immediately */ + + /* call work function */ + + if (hdutype == IMAGE_HDU) + *status = work_fn(totaln, offset, felement, ntodo, n_cols, cols, + userPointer); + else + *status = work_fn(totaln, offset, frow, ntodo, n_cols, cols, + userPointer); + + if (*status > 0 || *status < -1 ) + break; /* looks like an error occurred; quit immediately */ + + /* write output columns before quiting if status = -1 */ + tstatus = 0; + for (jj = 0; jj < n_cols; jj++) + { + if (cols[jj].iotype != InputCol) + { + if (cols[jj].datatype == TSTRING) + { + stringptr = cols[jj].array; + dataptr = stringptr + 1; + nullptr = *stringptr; + nbytes = 2; + } + else + { + dataptr = (char *) cols[jj].array + col[jj].nullsize; + nullptr = (char *) cols[jj].array; + nbytes = col[jj].nullsize; + } + + if (memcmp(nullptr, &zeros, nbytes) ) + { + /* null value flag not zero; must check for and write nulls */ + if (hdutype == IMAGE_HDU) + { + if (ffppn(cols[jj].fptr, cols[jj].datatype, + felement, cols[jj].repeat * ntodo, dataptr, + nullptr, &tstatus) > 0) + break; + } + else + { + if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0) + goto cleanup; + + if (typecode<0) /* variable length array colum */ + { + ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status); + } + + if (ffpcn(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow, + felement, cols[jj].repeat * ntodo, dataptr, + nullptr, &tstatus) > 0) + break; + } + } + else + { + /* no null values; just write the array */ + if (hdutype == IMAGE_HDU) + { + if (ffppr(cols[jj].fptr, cols[jj].datatype, + felement, cols[jj].repeat * ntodo, dataptr, + &tstatus) > 0) + break; + } + else + { + if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0) + goto cleanup; + + if (typecode<0) /* variable length array column */ + { + ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status); + } + + if (ffpcl(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow, + felement, cols[jj].repeat * ntodo, dataptr, + &tstatus) > 0) + break; + } + } + } + } + + if (*status == 0) + *status = tstatus; /* propagate any error status from the writes */ + + if (*status) + break; /* exit on any error */ + + nleft -= ntodo; + + if (hdutype == IMAGE_HDU) + felement += ntodo; + else + frow += ntodo; + } + +cleanup: + + /*----------------------------------*/ + /* free work arrays for the columns */ + /*----------------------------------*/ + + for (jj = 0; jj < n_cols; jj++) + { + if (cols[jj].datatype == TSTRING) + { + if (cols[jj].array) + { + stringptr = cols[jj].array; + free(*stringptr); /* free the block of strings */ + free(col[jj].null.stringnull); /* free the null string */ + } + } + free(cols[jj].array); /* memory for the array of values from the col */ + } + free(col); /* the structure containing the null values */ + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/putcolb.c b/pkg/tbtables/cfitsio/putcolb.c new file mode 100644 index 00000000..8f926b2d --- /dev/null +++ b/pkg/tbtables/cfitsio/putcolb.c @@ -0,0 +1,1031 @@ +/* This file, putcolb.c, contains routines that write data elements to */ +/* a FITS image or table with char (byte) datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffpprb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned char *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + unsigned char nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TBYTE, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpclb(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned char *array, /* I - array of values that are written */ + unsigned char nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + unsigned char nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TBYTE, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnb(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2db(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned char *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3db(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3db(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned char *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TBYTE, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpclb(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpclb(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + unsigned char *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TBYTE, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpclb(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned char *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpclb(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclb( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned char *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table with + 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise, + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && tcode == TBYTE) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TBYTE): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpi1b(fptr, ntodo, incre, &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffi1fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + } + + break; + + case (TLONGLONG): + + ffi1fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TSHORT): + + ffi1fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TLONG): + + ffi1fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TFLOAT): + + ffi1fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffi1fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (strchr(tform,'A')) + { + /* write raw input bytes without conversion */ + /* This case is a hack to let users write a stream */ + /* of bytes directly to the 'A' format column */ + + if (incre == twidth) + ffpbyt(fptr, ntodo, &array[next], status); + else + ffpbytoff(fptr, twidth, ntodo/twidth, incre - twidth, + &array[next], status); + break; + } + else if (cform[1] != 's') /* "%s" format is a string */ + { + ffi1fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpclb).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnb( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned char *array, /* I - array of values to write */ + unsigned char nulvalue, /* I - flag for undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood + 1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclb(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad + 1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclb(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fi1(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + memcpy(output, input, ntodo); /* just copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ( ((double) input[ii]) - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fi2(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; /* just copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (((double) input[ii]) - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fi4(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (INT32BIT) input[ii]; /* copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (((double) input[ii]) - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fi8(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + output[jj] = 0; + output[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fr4(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( ( (double) input[ii] ) - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fr8(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( ( (double) input[ii] ) - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi1fstr(unsigned char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ((double) input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcold.c b/pkg/tbtables/cfitsio/putcold.c new file mode 100644 index 00000000..6a79b49f --- /dev/null +++ b/pkg/tbtables/cfitsio/putcold.c @@ -0,0 +1,1147 @@ +/* This file, putcold.c, contains routines that write data elements to */ +/* a FITS image or table, with double datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffpprd( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + double *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + double nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TDOUBLE, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcld(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnd( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + double *array, /* I - array of values that are written */ + double nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + double nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TDOUBLE, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnd(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2dd(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + double *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3dd(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3dd(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + double *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TDOUBLE, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpcld(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpcld(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssd(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + double *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TDOUBLE, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpcld(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpd( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + double *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpcld(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcld( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + double *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling and the native machine format is not byteswapped, + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise, + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && + MACHINE == NATIVE && tcode == TDOUBLE) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TDOUBLE): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpr8b(fptr, ntodo, incre, &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffr8fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + } + + break; + + case (TLONGLONG): + + ffr8fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffr8fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffr8fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TLONG): + + ffr8fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TFLOAT): + ffr8fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffr8fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpcld).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclm( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + double *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of double complex values to a column in the current FITS HDU. + Each complex number if interpreted as a pair of float values. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + if necessary, but normally complex values should only be written to a binary + table with TFORMn = 'rM' where r is an optional repeat count. The TSCALn and + TZERO keywords should not be used with complex numbers because mathmatically + the scaling should only be applied to the real (first) component of the + complex value. +*/ +{ + /* simply multiply the number of elements by 2, and call ffpcld */ + + ffpcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, + nelem * 2, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnd( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + double *array, /* I - array of values to write */ + double nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + int tcode, overflow = 0; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + fits_get_coltype(fptr, colnum, &tcode, NULL, NULL, status); + + if (tcode >= TCOMPLEX) + { /* treat complex columns as pairs of numbers */ + repeat *= 2; + } + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + /* call ffpcluc, not ffpclu, in case we are writing to a + complex ('C') binary table column */ + if (ffpcluc(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpcld(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], + status) > 0) { + if (*status == NUM_OVERFLOW) + { + overflow = 1; + *status = 0; + } else { + return(*status); + } + } + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpcld(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + ffpcluc(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fi1(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fi2(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fi4(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (input[ii] > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + output[ii] = (INT32BIT) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fi8(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (input[ii] < 0) + { + temp = (input[ii] + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (input[ii] - (double) (temp + 1) * 4294967296.); + } + else + { + temp = input[ii] / 4294967296.; + output[jj] = temp; + uoutput[kk] = input[ii] - (double) temp * 4294967296.; + } + } + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (LONGLONG) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fr4(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fr8(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + memcpy(output, input, ntodo * sizeof(double) ); /* copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr8fstr(double *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcole.c b/pkg/tbtables/cfitsio/putcole.c new file mode 100644 index 00000000..5857b772 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcole.c @@ -0,0 +1,1154 @@ +/* This file, putcole.c, contains routines that write data elements to */ +/* a FITS image or table, with float datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffppre( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + float *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + float nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TFLOAT, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcle(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppne( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + float *array, /* I - array of values that are written */ + float nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + float nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TFLOAT, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcne(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2de(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + float *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3de(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3de(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + float *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TFLOAT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpcle(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpcle(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpsse(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + float *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TFLOAT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpcle(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpe( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + float *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpcle(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcle( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + float *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling and the native machine format is not byteswapped + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise, + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && + MACHINE == NATIVE && tcode == TFLOAT) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TFLOAT): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpr4b(fptr, ntodo, incre, &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffr4fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + } + + break; + + case (TLONGLONG): + + ffr4fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffr4fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffr4fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TLONG): + + ffr4fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TDOUBLE): + ffr4fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffr4fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpcle).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclc( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + float *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of complex values to a column in the current FITS HDU. + Each complex number if interpreted as a pair of float values. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + if necessary, but normally complex values should only be written to a binary + table with TFORMn = 'rC' where r is an optional repeat count. The TSCALn and + TZERO keywords should not be used with complex numbers because mathmatically + the scaling should only be applied to the real (first) component of the + complex value. +*/ +{ + /* simply multiply the number of elements by 2, and call ffpcle */ + + ffpcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, + nelem * 2, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcne( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + float *array, /* I - array of values to write */ + float nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + int tcode, overflow = 0; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + fits_get_coltype(fptr, colnum, &tcode, NULL, NULL, status); + + if (tcode >= TCOMPLEX) + { /* treat complex columns as pairs of numbers */ + repeat *= 2; + } + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + /* call ffpcluc, not ffpclu, in case we are writing to a + complex ('C') binary table column */ + if (ffpcluc(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpcle(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], + status) > 0) { + if (*status == NUM_OVERFLOW) + { + overflow = 1; + *status = 0; + } else { + return(*status); + } + } + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpcle(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + ffpcluc(fptr, colnum, fstrow, firstelem, nbad, status); + } + + if (*status <= 0) { + if (overflow) { + *status = NUM_OVERFLOW; + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fi1(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fi2(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = (short) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fi4(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (input[ii] > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + output[ii] = (INT32BIT) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fi8(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (input[ii] < 0) + { + temp = (input[ii] + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (input[ii] - (double) (temp + 1) * 4294967296.); + } + else + { + temp = input[ii] / 4294967296.; + output[jj] = temp; + uoutput[kk] = input[ii] - (double) temp * 4294967296.; + } + } + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + output[ii] = (long) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fr4(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + memcpy(output, input, ntodo * sizeof(float) ); /* copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fr8(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr4fstr(float *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcoli.c b/pkg/tbtables/cfitsio/putcoli.c new file mode 100644 index 00000000..a413f952 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcoli.c @@ -0,0 +1,1039 @@ +/* This file, putcoli.c, contains routines that write data elements to */ +/* a FITS image or table, with short datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffppri( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write (1 = 1st group) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + short *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + short nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TSHORT, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcli(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppni( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + short *array, /* I - array of values that are written */ + short nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + short nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TSHORT, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcni(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2di(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + short *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3di(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3di(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + short *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TSHORT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpcli(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpcli(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssi(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + short *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TSHORT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpcli(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpi( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + short *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpcli(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcli( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + short *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table with + 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling and the native machine format is not byteswapped, + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise, + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && + MACHINE == NATIVE && tcode == TSHORT) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TSHORT): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpi2b(fptr, ntodo, incre, &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffi2fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + } + + break; + + case (TLONGLONG): + + ffi2fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffi2fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TLONG): + + ffi2fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TFLOAT): + + ffi2fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffi2fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffi2fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpcli).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcni( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + short *array, /* I - array of values to write */ + short nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpcli(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpcli(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fi1(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fi2(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + memcpy(output, input, ntodo * sizeof(short) ); + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fi4(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (INT32BIT) input[ii]; /* just copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fi8(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (input[ii] < 0) + output[jj] = -1; + else + output[jj] = 0; + + output[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fr4(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fr8(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2fstr(short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcolj.c b/pkg/tbtables/cfitsio/putcolj.c new file mode 100644 index 00000000..8cfee07c --- /dev/null +++ b/pkg/tbtables/cfitsio/putcolj.c @@ -0,0 +1,2018 @@ +/* This file, putcolj.c, contains routines that write data elements to */ +/* a FITS image or table, with long datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffpprj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + long *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + long nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TLONG, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpclj(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + long *array, /* I - array of values that are written */ + long nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + long nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TLONG, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnj(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2dj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3dj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3dj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + long *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TLONG, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpclj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpclj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + long *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TLONG, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpclj(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + long *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpclj(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclj( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + long *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling and the native machine format is not byteswapped + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && + MACHINE == NATIVE && tcode == TLONG && LONGSIZE == 32) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TLONG): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpi4b(fptr, ntodo, incre, (INT32BIT *) &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffi4fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + } + + break; + + case (TLONGLONG): + + fflongfi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffi4fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffi4fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TFLOAT): + + ffi4fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffi4fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffi4fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpclj).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnj( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + long *array, /* I - array of values to write */ + long nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclj(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclj(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi4fi1(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi4fi2(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi4fi4(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (INT32BIT) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fflongfi8(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (input[ii] < 0) + output[jj] = -1; + else + output[jj] = 0; + + output[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi4fr4(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi4fr8(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi4fstr(long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} + +/* ======================================================================== */ +/* the following routines support the 'long long' data type */ +/* ======================================================================== */ + +/*--------------------------------------------------------------------------*/ +int ffpprjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + LONGLONG *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + ffpmsg("writing to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + row=maxvalue(1,group); + + ffpcljj(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + LONGLONG *array, /* I - array of values that are written */ + long nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + ffpmsg("writing to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + row=maxvalue(1,group); + + ffpcnjj(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2djj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + LONGLONG *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3djj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3djj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + LONGLONG *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + ffpmsg("writing to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpcljj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpcljj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + LONGLONG *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + ffpmsg("writing to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpcljj(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpjj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + LONGLONG *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpcljj(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcljj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + LONGLONG *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling and the native machine format is not byteswapped + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && + MACHINE == NATIVE && tcode == TLONGLONG) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TLONGLONG): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpi8b(fptr, ntodo, incre, (long *) &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffi8fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + } + + break; + + case (TLONG): + + ffi8fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TBYTE): + + ffi8fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffi8fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TFLOAT): + + ffi8fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffi8fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffi8fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpclj).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnjj(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + LONGLONG *array, /* I - array of values to write */ + LONGLONG nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpcljj(fptr, colnum, fstrow,firstelem, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpcljj(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fi1(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fi2(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fi4(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < INT32_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (input[ii] > INT32_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + output[ii] = (INT32BIT) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fi8(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fr4(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fr8(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi8fstr(LONGLONG *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcolk.c b/pkg/tbtables/cfitsio/putcolk.c new file mode 100644 index 00000000..16bf4c93 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcolk.c @@ -0,0 +1,1067 @@ +/* This file, putcolk.c, contains routines that write data elements to */ +/* a FITS image or table, with 'int' datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffpprk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + int *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + int nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TINT, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpclk(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + int *array, /* I - array of values that are written */ + int nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + int nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TINT, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnk(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2dk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + int *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3dk(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3dk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + int *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TINT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpclk(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpclk(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + int *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + fits_write_compressed_img(fptr, TINT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpclk(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpk( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + int *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpclk(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclk( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + int *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype, writeraw; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* call the 'short' or 'long' version of this routine, if possible */ + if (sizeof(int) == sizeof(short)) + ffpcli(fptr, colnum, firstrow, firstelem, nelem, + (short *) array, status); + else if (sizeof(int) == sizeof(long)) + ffpclj(fptr, colnum, firstrow, firstelem, nelem, + (long *) array, status); + else + { + /* + This is a special case: sizeof(int) is not equal to sizeof(short) or + sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes, + int = 4 bytes, and long = 8 bytes. + */ + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /* + if there is no scaling and the native machine format is not byteswapped + then we can simply write the raw data bytes into the FITS file if the + datatype of the FITS column is the same as the input values. Otherwise + we must convert the raw values into the scaled and/or machine dependent + format in a temporary buffer that has been allocated for this purpose. + */ + if (scale == 1. && zero == 0. && + MACHINE == NATIVE && tcode == TLONG) + { + writeraw = 1; + maxelem = nelem; /* we can write the entire array at one time */ + } + else + writeraw = 0; + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TLONG): + if (writeraw) + { + /* write raw input bytes without conversion */ + ffpi4b(fptr, ntodo, incre, (INT32BIT *) &array[next], status); + } + else + { + /* convert the raw data before writing to FITS file */ + ffintfi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + } + + break; + + case (TLONGLONG): + + ffintfi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffintfi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffintfi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TFLOAT): + + ffintfr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffintfr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffintfstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpclk).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + } /* end of Dec ALPHA special case */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnk( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + int *array, /* I - array of values to write */ + int nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclk(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclk(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfi1(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfi2(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < SHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfi4(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + memcpy(output, input, ntodo * sizeof(int) ); + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfi8(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (input[ii] < 0) + output[jj] = -1; + else + output[jj] = 0; + + output[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfr4(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfr8(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffintfstr(int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcoll.c b/pkg/tbtables/cfitsio/putcoll.c new file mode 100644 index 00000000..0c5de8a1 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcoll.c @@ -0,0 +1,355 @@ +/* This file, putcoll.c, contains routines that write data elements to */ +/* a FITS image or table, with logical datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffpcll( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + char *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of logical values to a column in the current FITS HDU. +*/ +{ + int tcode, maxelem, hdutype; + long twidth, incre, rownum, remain, next; + long tnull; + OFF_T repeat, startpos, elemnum, wrtptr, rowlen; + double scale, zero; + char tform[20], ctrue = 'T', cfalse = 'F'; + char message[FLEN_ERRMSG]; + char snull[20]; /* the FITS null value */ + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode != TLOGICAL) + return(*status = NOT_LOGICAL_COL); + + /*---------------------------------------------------------------------*/ + /* Now write the logical values one at a time to the FITS column. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + wrtptr = startpos + (rowlen * rownum) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + if (array[next]) + ffpbyt(fptr, 1, &ctrue, status); + else + ffpbyt(fptr, 1, &cfalse, status); + + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing element %ld of input array of logicals (ffpcll).", + next+1); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain--; + if (remain) + { + next++; + elemnum++; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + + } /* End of main while Loop */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnl( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + char *array, /* I - array of values to write */ + char nulvalue, /* I - array flagging undefined pixels if true */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels flagged as null will be replaced by the appropriate + null value in the output FITS file. +*/ +{ + tcolumn *colptr; + long repeat, first, ngood = 0, nbad = 0, ii, fstelm, fstrow; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + firstelem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + if (ffpcll(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + ffpcll(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + ffpclu(fptr, colnum, fstrow, fstelm, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclx( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long frow, /* I - first row to write (1 = 1st row) */ + long fbit, /* I - first bit to write (1 = 1st) */ + long nbit, /* I - number of bits to write */ + char *larray, /* I - array of logicals corresponding to bits */ + int *status) /* IO - error status */ +/* + write an array of logical values to a specified bit or byte + column of the binary table. If larray is TRUE, then the corresponding + bit is set to 1, otherwise it is set to 0. + The binary table column being written to must have datatype 'B' or 'X'. +*/ +{ + OFF_T bstart, repeat, rowlen, elemnum; + long offset, fbyte, lbyte, nbyte, bitloc, ndone; + long ii, rstart, estart, twidth, incre, tnull; + int tcode, descrp, maxelem, hdutype; + double dummyd; + char tform[12], snull[12]; + unsigned char cbuff; + static unsigned char onbit[8] = {128, 64, 32, 16, 8, 4, 2, 1}; + static unsigned char offbit[8] = {127, 191, 223, 239, 247, 251, 253, 254}; + tcolumn *colptr; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check input parameters */ + if (nbit < 1) + return(*status); + else if (frow < 1) + return(*status = BAD_ROW_NUM); + else if (fbit < 1) + return(*status = BAD_ELEM_NUM); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* rescan header if data structure is undefined */ + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) + return(*status); + + fbyte = (fbit + 7) / 8; + lbyte = (fbit + nbit + 6) / 8; + nbyte = lbyte - fbyte +1; + + /* Save the current heapsize; ffgcpr will increment the value if */ + /* we are writing to a variable length column. */ + offset = (fptr->Fptr)->heapsize; + + /* call ffgcpr in case we are writing beyond the current end of */ + /* the table; it will allocate more space and shift any following */ + /* HDU's. Otherwise, we have little use for most of the returned */ + /* parameters, therefore just use dummy parameters. */ + + if (ffgcpr( fptr, colnum, frow, fbyte, nbyte, 1, &dummyd, &dummyd, + tform, &twidth, &tcode, &maxelem, &bstart, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + bitloc = fbit - 1 - ((fbit - 1) / 8 * 8); + ndone = 0; + rstart = frow - 1; + estart = fbyte - 1; + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + tcode = colptr->tdatatype; + + if (abs(tcode) > TBYTE) + return(*status = NOT_LOGICAL_COL); /* not correct datatype column */ + + if (tcode > 0) + { + descrp = FALSE; /* not a variable length descriptor column */ + repeat = colptr->trepeat; + + if (tcode == TBIT) + repeat = (repeat + 7) / 8; /* convert from bits to bytes */ + + if (fbyte > repeat) + return(*status = BAD_ELEM_NUM); + + /* calc the i/o pointer location to start of sequence of pixels */ + bstart = (fptr->Fptr)->datastart + ((fptr->Fptr)->rowlength * rstart) + + colptr->tbcol + estart; + } + else + { + descrp = TRUE; /* a variable length descriptor column */ + /* only bit arrays (tform = 'X') are supported for variable */ + /* length arrays. REPEAT is the number of BITS in the array. */ + + repeat = fbit + nbit -1; + + /* write the number of elements and the starting offset. */ + /* Note: ffgcpr previous wrote the descripter, but with the */ + /* wrong repeat value (gave bytes instead of bits). */ + + if (tcode == -TBIT) + ffpdes(fptr, colnum, frow, (long) repeat, offset, status); + + /* Calc the i/o pointer location to start of sequence of pixels. */ + /* ffgcpr has already calculated a value for bstart that */ + /* points to the first element of the vector; we just have to */ + /* increment it to point to the first element we want to write to. */ + /* Note: ffgcpr also already updated the size of the heap, so we */ + /* don't have to do that again here. */ + + bstart += estart; + } + + /* move the i/o pointer to the start of the pixel sequence */ + ffmbyt(fptr, bstart, IGNORE_EOF, status); + + /* read the next byte (we may only be modifying some of the bits) */ + while (1) + { + if (ffgbyt(fptr, 1, &cbuff, status) == END_OF_FILE) + { + /* hit end of file trying to read the byte, so just set byte = 0 */ + *status = 0; + cbuff = 0; + } + + /* move back, to be able to overwrite the byte */ + ffmbyt(fptr, bstart, IGNORE_EOF, status); + + for (ii = bitloc; (ii < 8) && (ndone < nbit); ii++, ndone++) + { + if(larray[ndone]) + cbuff = cbuff | onbit[ii]; + else + cbuff = cbuff & offbit[ii]; + } + + ffpbyt(fptr, 1, &cbuff, status); /* write the modified byte */ + + if (ndone == nbit) /* finished all the bits */ + return(*status); + + /* not done, so get the next byte */ + bstart++; + if (!descrp) + { + estart++; + if (estart == repeat) + { + /* move the i/o pointer to the next row of pixels */ + estart = 0; + rstart = rstart + 1; + bstart = (fptr->Fptr)->datastart + ((fptr->Fptr)->rowlength * rstart) + + colptr->tbcol; + + ffmbyt(fptr, bstart, IGNORE_EOF, status); + } + } + bitloc = 0; + } +} + diff --git a/pkg/tbtables/cfitsio/putcols.c b/pkg/tbtables/cfitsio/putcols.c new file mode 100644 index 00000000..7e27a29c --- /dev/null +++ b/pkg/tbtables/cfitsio/putcols.c @@ -0,0 +1,284 @@ +/* This file, putcols.c, contains routines that write data elements to */ +/* a FITS image or table, of type character string. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffpcls( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of strings to write */ + char **array, /* I - array of pointers to strings */ + int *status) /* IO - error status */ +/* + Write an array of string values to a column in the current FITS HDU. +*/ +{ + int tcode, maxelem, hdutype, nchar; + long twidth, incre, rownum, remain, next; + long ii, jj, ntodo, tnull; + OFF_T repeat, startpos, elemnum, wrtptr, rowlen; + double scale, zero; + char tform[20], *blanks; + char message[FLEN_ERRMSG]; + char snull[20]; /* the FITS null value */ + tcolumn *colptr; + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + char *buffer, *arrayptr; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (colnum < 1 || colnum > (fptr->Fptr)->tfield) + { + sprintf(message, "Specified column number is out of range: %d", + colnum); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + tcode = colptr->tdatatype; + + if (tcode == -TSTRING) /* variable length column in a binary table? */ + { + /* only write a single string; ignore value of firstelem */ + nchar = maxvalue(1,strlen(array[0])); /* will write at least 1 char */ + /* even if input string is null */ + + if (ffgcpr( fptr, colnum, firstrow, 1, nchar, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + remain = 1; + twidth = nchar; + blanks = 0; /* initialize null pointer */ + } + else if (tcode == TSTRING) + { + if (ffgcpr( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + blanks = (char *) malloc(twidth); /* string for blank fill values */ + if (!blanks) + { + ffpmsg("Could not allocate memory for string (ffpcls)"); + return(*status = ARRAY_TOO_BIG); + } + + for (ii = 0; ii < twidth; ii++) + blanks[ii] = ' '; /* fill string with blanks */ + + remain = nelem; /* remaining number of values to write */ + } + else + return(*status = NOT_ASCII_COL); + + /*-------------------------------------------------------*/ + /* Now write the strings to the FITS column. */ + /*-------------------------------------------------------*/ + + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process at one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + buffer = (char *) cbuff; + + /* copy the user's strings into the buffer */ + for (ii = 0; ii < ntodo; ii++) + { + arrayptr = array[next]; + + for (jj = 0; jj < twidth; jj++) /* copy the string, char by char */ + { + if (*arrayptr) + { + *buffer = *arrayptr; + buffer++; + arrayptr++; + } + else + break; + } + + for (;jj < twidth; jj++) /* fill field with blanks, if needed */ + { + *buffer = ' '; + buffer++; + } + + next++; + } + + /* write the buffer full of strings to the FITS file */ + if (incre == twidth) + ffpbyt(fptr, ntodo * twidth, cbuff, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, cbuff, status); + + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpcls).", + next+1, next+ntodo); + ffpmsg(message); + + if (blanks) + free(blanks); + + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + if (blanks) + free(blanks); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcns( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + char **array, /* I - array of values to write */ + char *nulvalue, /* I - string representing a null value */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels flagged as null will be replaced by the appropriate + null value in the output FITS file. +*/ +{ + long repeat, width, first, ngood = 0, nbad = 0, ii, fstelm, fstrow; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + /* get the vector repeat length of the column */ + ffgtcl(fptr, colnum, NULL, &repeat, &width, status); + + if ((fptr->Fptr)->hdutype == BINARY_TBL) + repeat = repeat / width; /* convert from chars to unit strings */ + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + firstelem; + + for (ii = 0; ii < nelem; ii++) + { + if (strcmp(nulvalue, array[ii])) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0) + return(*status); + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + if (ffpcls(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + ffpcls(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + + ffpclu(fptr, colnum, fstrow, fstelm, nbad, status); + } + + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcolsb.c b/pkg/tbtables/cfitsio/putcolsb.c new file mode 100644 index 00000000..2a0e95a4 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcolsb.c @@ -0,0 +1,1030 @@ +/* This file, putcolsb.c, contains routines that write data elements to */ +/* a FITS image or table with signed char (signed byte) datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffpprsb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + signed char *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + signed char nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TSBYTE, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpclsb(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnsb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + signed char *array, /* I - array of values that are written */ + signed char nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + signed char nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TSBYTE, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnsb(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2dsb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + signed char *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3dsb(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3dsb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + signed char *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TSBYTE, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpclsb(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpclsb(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpsssb(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + signed char *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TSBYTE, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpclsb(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpsb( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + signed char *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpclsb(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclsb( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + signed char *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table with + 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TBYTE): + + /* convert the raw data before writing to FITS file */ + ffs1fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + + break; + + case (TLONGLONG): + + ffs1fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TSHORT): + + ffs1fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TLONG): + + ffs1fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TFLOAT): + + ffs1fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffs1fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (strchr(tform,'A')) + { + /* write raw input bytes without conversion */ + /* This case is a hack to let users write a stream */ + /* of bytes directly to the 'A' format column */ + + if (incre == twidth) + ffpbyt(fptr, ntodo, &array[next], status); + else + ffpbytoff(fptr, twidth, ntodo/twidth, incre - twidth, + &array[next], status); + break; + } + else if (cform[1] != 's') /* "%s" format is a string */ + { + ffs1fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpclsb).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnsb( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + signed char *array, /* I - array of values to write */ + signed char nulvalue, /* I - flag for undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood + 1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclsb(fptr, colnum, fstrow, firstelem,ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad + 1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclsb(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fi1(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == -128.) + { + /* Instead of adding 128, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(unsigned char *) &input[ii] ) ^ 0x80; + } + else if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ( ((double) input[ii]) - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fi2(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; /* just copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (((double) input[ii]) - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fi4(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (INT32BIT) input[ii]; /* copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (((double) input[ii]) - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fi8(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + if (input[ii] < 0) + output[jj] = -1; + else + output[jj] = 0; + + output[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fr4(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( ( (double) input[ii] ) - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fr8(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( ( (double) input[ii] ) - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs1fstr(signed char *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ((double) input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcolu.c b/pkg/tbtables/cfitsio/putcolu.c new file mode 100644 index 00000000..46814440 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcolu.c @@ -0,0 +1,587 @@ +/* This file, putcolu.c, contains routines that write data elements to */ +/* a FITS image or table. Writes null values. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffppru( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + int *status) /* IO - error status */ +/* + Write null values to the primary array. +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + ffpmsg("writing to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + row=maxvalue(1,group); + + ffpclu(fptr, 2, row, firstelem, nelem, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpprn( fitsfile *fptr, /* I - FITS file pointer */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + int *status) /* IO - error status */ +/* + Write null values to the primary array. (Doesn't support groups). +*/ +{ + long row = 1; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + ffpmsg("writing to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + ffpclu(fptr, 2, row, firstelem, nelem, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclu( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelempar, /* I - number of values to write */ + int *status) /* IO - error status */ +/* + Set elements of a table column to the appropriate null value for the column + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + This routine support COMPLEX and DOUBLE COMPLEX binary table columns, and + sets both the real and imaginary components of the element to a NaN. +*/ +{ + int tcode, maxelem, hdutype, writemode = 2, leng; + short i2null; + INT32BIT i4null, i8null[2]; + long twidth, incre, rownum, remain, next, ntodo; + long tnull, ii, nelem; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + unsigned char i1null, lognul = 0; + char tform[20], *cstring = 0; + char message[FLEN_ERRMSG]; + char snull[20]; /* the FITS null value */ + long jbuff[2] = { -1, -1}; /* all bits set is equivalent to a NaN */ + size_t buffsize; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + nelem = nelempar; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + + /* note that writemode = 2 by default (not 1), so that the returned */ + /* repeat and incre values will be the actual values for this column. */ + + /* If writing nulls to a variable length column then dummy data values */ + /* must have already been written to the heap. */ + /* We just have to overwrite the previous values with null values. */ + /* Set writemode = 0 in this case, to test that values have been written */ + + fits_get_coltype(fptr, colnum, &tcode, NULL, NULL, status); + if (tcode < 0) + writemode = 0; /* this is a variable length column */ + + if (abs(tcode) >= TCOMPLEX) + { /* treat complex columns as pairs of numbers */ + large_elem = (large_elem - 1) * 2 + 1; + nelem *= 2; + } + + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, writemode, &scale, + &zero, tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + { + if (snull[0] == ASCII_NULL_UNDEFINED) + { + ffpmsg( + "Null value string for ASCII table column is not defined (FTPCLU)."); + return(*status = NO_NULL); + } + + /* allocate buffer to hold the null string. Must write the entire */ + /* width of the column (twidth bytes) to avoid possible problems */ + /* with uninitialized FITS blocks, in case the field spans blocks */ + + buffsize = maxvalue(20, twidth); + cstring = (char *) malloc(buffsize); + if (!cstring) + return(*status = MEMORY_ALLOCATION); + + memset(cstring, ' ', buffsize); /* initialize with blanks */ + + leng = strlen(snull); + if (hdutype == BINARY_TBL) + leng++; /* copy the terminator too in binary tables */ + + strncpy(cstring, snull, leng); /* copy null string to temp buffer */ + + } + else if ( tcode == TBYTE || + tcode == TSHORT || + tcode == TLONG || + tcode == TLONGLONG) + { + if (tnull == NULL_UNDEFINED) + { + ffpmsg( + "Null value for integer table column is not defined (FTPCLU)."); + return(*status = NO_NULL); + } + + if (tcode == TBYTE) + i1null = tnull; + else if (tcode == TSHORT) + { + i2null = tnull; +#if BYTESWAPPED + ffswap2(&i2null, 1); /* reverse order of bytes */ +#endif + } + else if (tcode == TLONG) + { + i4null = tnull; +#if BYTESWAPPED + ffswap4(&i4null, 1); /* reverse order of bytes */ +#endif + } + else + { + if (tnull < 0) + i8null[0] = -1; + else + i8null[0] = 0; + + i8null[1] = tnull; +#if BYTESWAPPED + ffswap8( (double *) i8null, 1); /* reverse order of bytes */ +#endif + } + } + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + ntodo = remain; /* number of elements to write at one time */ + + while (ntodo) + { + /* limit the number of pixels to process at one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(ntodo, (repeat - elemnum)); + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TBYTE): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 1, &i1null, status); + break; + + case (TSHORT): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 2, &i2null, status); + break; + + case (TLONG): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 4, &i4null, status); + break; + + case (TLONGLONG): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 8, i8null, status); + break; + + case (TFLOAT): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 4, jbuff, status); + break; + + case (TDOUBLE): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 8, jbuff, status); + break; + + case (TLOGICAL): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 1, &lognul, status); + break; + + case (TSTRING): /* an ASCII table column */ + /* repeat always = 1, so ntodo is also guaranteed to = 1 */ + ffpbyt(fptr, twidth, cstring, status); + break; + + default: /* error trap */ + sprintf(message, + "Cannot write null value to column %d which has format %s", + colnum,tform); + ffpmsg(message); + return(*status); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing %ld thru %ld of null values (ffpclu).", + next+1, next+ntodo); + ffpmsg(message); + + if (cstring) + free(cstring); + + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + ntodo = remain; /* this is the maximum number to do in next loop */ + + } /* End of main while Loop */ + + if (cstring) + free(cstring); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcluc( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + int *status) /* IO - error status */ +/* + Set elements of a table column to the appropriate null value for the column + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + This routine does not do anything special in the case of COMPLEX table columns + (unlike the similar ffpclu routine). This routine is mainly for use by + ffpcne which already compensates for the effective doubling of the number of + elements in a complex column. +*/ +{ + int tcode, maxelem, hdutype, writemode = 2, leng; + short i2null; + INT32BIT i4null, i8null[2]; + long twidth, incre, rownum, remain, next, ntodo; + long tnull, ii; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + unsigned char i1null, lognul = 0; + char tform[20], *cstring = 0; + char message[FLEN_ERRMSG]; + char snull[20]; /* the FITS null value */ + long jbuff[2] = { -1, -1}; /* all bits set is equivalent to a NaN */ + size_t buffsize; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + + /* note that writemode = 2 by default (not 1), so that the returned */ + /* repeat and incre values will be the actual values for this column. */ + + /* If writing nulls to a variable length column then dummy data values */ + /* must have already been written to the heap. */ + /* We just have to overwrite the previous values with null values. */ + /* Set writemode = 0 in this case, to test that values have been written */ + + fits_get_coltype(fptr, colnum, &tcode, NULL, NULL, status); + if (tcode < 0) + writemode = 0; /* this is a variable length column */ + + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, writemode, &scale, + &zero, tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + { + if (snull[0] == ASCII_NULL_UNDEFINED) + { + ffpmsg( + "Null value string for ASCII table column is not defined (FTPCLU)."); + return(*status = NO_NULL); + } + + /* allocate buffer to hold the null string. Must write the entire */ + /* width of the column (twidth bytes) to avoid possible problems */ + /* with uninitialized FITS blocks, in case the field spans blocks */ + + buffsize = maxvalue(20, twidth); + cstring = (char *) malloc(buffsize); + if (!cstring) + return(*status = MEMORY_ALLOCATION); + + memset(cstring, ' ', buffsize); /* initialize with blanks */ + + leng = strlen(snull); + if (hdutype == BINARY_TBL) + leng++; /* copy the terminator too in binary tables */ + + strncpy(cstring, snull, leng); /* copy null string to temp buffer */ + + } + else if ( tcode == TBYTE || + tcode == TSHORT || + tcode == TLONG || + tcode == TLONGLONG) + { + if (tnull == NULL_UNDEFINED) + { + ffpmsg( + "Null value for integer table column is not defined (FTPCLU)."); + return(*status = NO_NULL); + } + + if (tcode == TBYTE) + i1null = tnull; + else if (tcode == TSHORT) + { + i2null = tnull; +#if BYTESWAPPED + ffswap2(&i2null, 1); /* reverse order of bytes */ +#endif + } + else if (tcode == TLONG) + { + i4null = tnull; +#if BYTESWAPPED + ffswap4(&i4null, 1); /* reverse order of bytes */ +#endif + } + else + { + if (tnull < 0) + i8null[0] = -1; + else + i8null[0] = 0; + + i8null[1] = tnull; +#if BYTESWAPPED + ffswap8( (double *) i8null, 1); /* reverse order of bytes */ +#endif + } + } + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + ntodo = remain; /* number of elements to write at one time */ + + while (ntodo) + { + /* limit the number of pixels to process at one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(ntodo, (repeat - elemnum)); + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TBYTE): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 1, &i1null, status); + break; + + case (TSHORT): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 2, &i2null, status); + break; + + case (TLONG): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 4, &i4null, status); + break; + + case (TLONGLONG): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 8, i8null, status); + break; + + case (TFLOAT): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 4, jbuff, status); + break; + + case (TDOUBLE): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 8, jbuff, status); + break; + + case (TLOGICAL): + + for (ii = 0; ii < ntodo; ii++) + ffpbyt(fptr, 1, &lognul, status); + break; + + case (TSTRING): /* an ASCII table column */ + /* repeat always = 1, so ntodo is also guaranteed to = 1 */ + ffpbyt(fptr, twidth, cstring, status); + break; + + default: /* error trap */ + sprintf(message, + "Cannot write null value to column %d which has format %s", + colnum,tform); + ffpmsg(message); + return(*status); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing %ld thru %ld of null values (ffpclu).", + next+1, next+ntodo); + ffpmsg(message); + + if (cstring) + free(cstring); + + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + ntodo = remain; /* this is the maximum number to do in next loop */ + + } /* End of main while Loop */ + + if (cstring) + free(cstring); + + return(*status); +} + + diff --git a/pkg/tbtables/cfitsio/putcolui.c b/pkg/tbtables/cfitsio/putcolui.c new file mode 100644 index 00000000..3406edf4 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcolui.c @@ -0,0 +1,1022 @@ +/* This file, putcolui.c, contains routines that write data elements to */ +/* a FITS image or table, with unsigned short datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffpprui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write (1 = 1st group) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned short *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + unsigned short nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TUSHORT, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpclui(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned short *array, /* I - array of values that are written */ + unsigned short nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + unsigned short nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TUSHORT, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnui(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2dui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned short *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3dui(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3dui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned short *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TUSHORT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpclui(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpclui(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssui(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + unsigned short *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TUSHORT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpclui(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpui( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned short *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpclui(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclui( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned short *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table with + 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TSHORT): + + ffu2fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TLONGLONG): + + ffu2fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffu2fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TLONG): + + ffu2fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TFLOAT): + + ffu2fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffu2fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffu2fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpclui).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnui(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned short *array, /* I - array of values to write */ + unsigned short nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclui(fptr, colnum, fstrow, firstelem,ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclui(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fi1(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ((double) input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fi2(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 32768.) + { + /* Instead of subtracting 32768, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(short *) &input[ii] ) ^ 0x8000; + } + else if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ((double) input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fi4(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (INT32BIT) input[ii]; /* copy input to output */ + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ((double) input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fi8(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + output[jj] = 0; + output[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fr4(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = ((double) input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fr8(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = ((double) input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu2fstr(unsigned short *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = ((double) input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcoluj.c b/pkg/tbtables/cfitsio/putcoluj.c new file mode 100644 index 00000000..af4c7fd4 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcoluj.c @@ -0,0 +1,1029 @@ +/* This file, putcoluj.c, contains routines that write data elements to */ +/* a FITS image or table, with unsigned long datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffppruj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned long *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + unsigned long nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TULONG, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcluj(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnuj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned long *array, /* I - array of values that are written */ + unsigned long nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + unsigned long nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TULONG, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnuj(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2duj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned long *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3duj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3duj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned long *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TULONG, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpcluj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpcluj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssuj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + unsigned long *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TULONG, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpcluj(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpuj( fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned long *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpcluj(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcluj( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned long *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TLONG): + + ffu4fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TLONGLONG): + + ffu4fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffu4fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffu4fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TFLOAT): + + ffu4fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffu4fr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffu4fstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpcluj).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnuj( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned long *array, /* I - array of values to write */ + unsigned long nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpcluj(fptr, colnum, fstrow, firstelem,ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpcluj(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fi1(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fi2(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fi4(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 2147483648. && sizeof(long) == 4) + { + /* Instead of subtracting 2147483648, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(long *) &input[ii] ) ^ 0x80000000; + } + else if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > INT32_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fi8(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + output[jj] = 0; + uoutput[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fr4(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fr8(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffu4fstr(unsigned long *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putcoluk.c b/pkg/tbtables/cfitsio/putcoluk.c new file mode 100644 index 00000000..4d1c5239 --- /dev/null +++ b/pkg/tbtables/cfitsio/putcoluk.c @@ -0,0 +1,1046 @@ +/* This file, putcolk.c, contains routines that write data elements to */ +/* a FITS image or table, with 'unsigned int' datatype. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include "fitsio2.h" + +/* declare variable for passing large firstelem values between routines */ +extern OFF_T large_first_elem_val; + +/*--------------------------------------------------------------------------*/ +int ffppruk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned int *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + unsigned int nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + fits_write_compressed_pixels(fptr, TUINT, large_first_elem_val, nelem, + 0, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcluk(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnuk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned int *array, /* I - array of values that are written */ + unsigned int nulval, /* I - undefined pixel value */ + int *status) /* IO - error status */ +/* + Write an array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). Any array values + that are equal to the value of nulval will be replaced with the null + pixel value that is appropriate for this column. +*/ +{ + long row; + unsigned int nullvalue; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + /* use the OFF_T variable to pass the first element value */ + if (firstelem != USE_LARGE_VALUE) + large_first_elem_val = firstelem; + + nullvalue = nulval; /* set local variable */ + fits_write_compressed_pixels(fptr, TUINT, large_first_elem_val, nelem, + 1, array, &nullvalue, status); + return(*status); + } + + row=maxvalue(1,group); + + ffpcnuk(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2duk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + unsigned int *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 2-D array of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + /* call the 3D writing routine, with the 3rd dimension = 1 */ + + ffp3duk(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3duk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long ncols, /* I - number of pixels in each row of array */ + long nrows, /* I - number of rows in each plane of array */ + long naxis1, /* I - FITS image NAXIS1 value */ + long naxis2, /* I - FITS image NAXIS2 value */ + long naxis3, /* I - FITS image NAXIS3 value */ + unsigned int *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write an entire 3-D cube of values to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of the + FITS array is not the same as the array being written). +*/ +{ + long tablerow, nfits, narray, ii, jj; + long fpixel[3]= {1,1,1}, lpixel[3]; + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + lpixel[0] = ncols; + lpixel[1] = nrows; + lpixel[2] = naxis3; + + fits_write_compressed_img(fptr, TUINT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + tablerow=maxvalue(1,group); + + if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */ + { + /* all the image pixels are contiguous, so write all at once */ + ffpcluk(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status); + return(*status); + } + + if (ncols < naxis1 || nrows < naxis2) + return(*status = BAD_DIMEN); + + nfits = 1; /* next pixel in FITS image to write to */ + narray = 0; /* next pixel in input array to be written */ + + /* loop over naxis3 planes in the data cube */ + for (jj = 0; jj < naxis3; jj++) + { + /* loop over the naxis2 rows in the FITS image, */ + /* writing naxis1 pixels to each row */ + + for (ii = 0; ii < naxis2; ii++) + { + if (ffpcluk(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssuk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long naxis, /* I - number of data axes in array */ + long *naxes, /* I - size of each FITS axis */ + long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */ + long *lpixel, /* I - last pixel in each axis to write */ + unsigned int *array, /* I - array to be written */ + int *status) /* IO - error status */ +/* + Write a subsection of pixels to the primary array or image. + A subsection is defined to be any contiguous rectangular + array of pixels within the n-dimensional FITS data file. + Data conversion and scaling will be performed if necessary + (e.g, if the datatype of the FITS array is not the same as + the array being written). +*/ +{ + long tablerow; + long fpix[7], irange[7], dimen[7], astart, pstart; + long off2, off3, off4, off5, off6, off7; + long st10, st20, st30, st40, st50, st60, st70; + long st1, st2, st3, st4, st5, st6, st7; + long ii, i1, i2, i3, i4, i5, i6, i7; + + if (*status > 0) + return(*status); + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_write_compressed_img(fptr, TUINT, fpixel, lpixel, + 0, array, NULL, status); + + return(*status); + } + + if (naxis < 1 || naxis > 7) + return(*status = BAD_DIMEN); + + tablerow=maxvalue(1,group); + + /* calculate the size and number of loops to perform in each dimension */ + for (ii = 0; ii < 7; ii++) + { + fpix[ii]=1; + irange[ii]=1; + dimen[ii]=1; + } + + for (ii = 0; ii < naxis; ii++) + { + fpix[ii]=fpixel[ii]; + irange[ii]=lpixel[ii]-fpixel[ii]+1; + dimen[ii]=naxes[ii]; + } + + i1=irange[0]; + + /* compute the pixel offset between each dimension */ + off2 = dimen[0]; + off3 = off2 * dimen[1]; + off4 = off3 * dimen[2]; + off5 = off4 * dimen[3]; + off6 = off5 * dimen[4]; + off7 = off6 * dimen[5]; + + st10 = fpix[0]; + st20 = (fpix[1] - 1) * off2; + st30 = (fpix[2] - 1) * off3; + st40 = (fpix[3] - 1) * off4; + st50 = (fpix[4] - 1) * off5; + st60 = (fpix[5] - 1) * off6; + st70 = (fpix[6] - 1) * off7; + + /* store the initial offset in each dimension */ + st1 = st10; + st2 = st20; + st3 = st30; + st4 = st40; + st5 = st50; + st6 = st60; + st7 = st70; + + astart = 0; + + for (i7 = 0; i7 < irange[6]; i7++) + { + for (i6 = 0; i6 < irange[5]; i6++) + { + for (i5 = 0; i5 < irange[4]; i5++) + { + for (i4 = 0; i4 < irange[3]; i4++) + { + for (i3 = 0; i3 < irange[2]; i3++) + { + pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7; + for (i2 = 0; i2 < irange[1]; i2++) + { + if (ffpcluk(fptr, 2, tablerow, pstart, i1, &array[astart], + status) > 0) + return(*status); + + astart += i1; + pstart += off2; + } + st2 = st20; + st3 = st3+off3; + } + st3 = st30; + st4 = st4+off4; + } + st4 = st40; + st5 = st5+off5; + } + st5 = st50; + st6 = st6+off6; + } + st6 = st60; + st7 = st7+off7; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpgpuk(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to write(1 = 1st group) */ + long firstelem, /* I - first vector element to write(1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned int *array, /* I - array of values that are written */ + int *status) /* IO - error status */ +/* + Write an array of group parameters to the primary array. Data conversion + and scaling will be performed if necessary (e.g, if the datatype of + the FITS array is not the same as the array being written). +*/ +{ + long row; + + /* + the primary array is represented as a binary table: + each group of the primary array is a row in the table, + where the first column contains the group parameters + and the second column contains the image itself. + */ + + row=maxvalue(1,group); + + ffpcluk(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcluk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned int *array, /* I - array of values to write */ + int *status) /* IO - error status */ +/* + Write an array of values to a column in the current FITS HDU. + The column number may refer to a real column in an ASCII or binary table, + or it may refer to a virtual column in a 1 or more grouped FITS primary + array. FITSIO treats a primary array as a binary table + with 2 vector columns: the first column contains the group parameters (often + with length = 0) and the second column contains the array of image pixels. + Each row of the table represents a group in the case of multigroup FITS + images. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary. +*/ +{ + int tcode, maxelem, hdutype; + long twidth, incre, rownum, remain, next, ntodo; + long tnull; + OFF_T repeat, startpos, elemnum, large_elem, wrtptr, rowlen; + double scale, zero; + char tform[20], cform[20]; + char message[FLEN_ERRMSG]; + + char snull[20]; /* the FITS null value */ + + double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */ + void *buffer; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* call the 'short' or 'long' version of this routine, if possible */ + if (sizeof(int) == sizeof(short)) + ffpclui(fptr, colnum, firstrow, firstelem, nelem, + (unsigned short *) array, status); + else if (sizeof(int) == sizeof(long)) + ffpcluj(fptr, colnum, firstrow, firstelem, nelem, + (unsigned long *) array, status); + else + { + /* + This is a special case: sizeof(int) is not equal to sizeof(short) or + sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes, + int = 4 bytes, and long = 8 bytes. + */ + + buffer = cbuff; + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /*---------------------------------------------------*/ + /* Check input and get parameters about the column: */ + /*---------------------------------------------------*/ + if (ffgcpr( fptr, colnum, firstrow, large_elem, nelem, 1, &scale, &zero, + tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + + if (tcode == TSTRING) + ffcfmt(tform, cform); /* derive C format for writing strings */ + + /*---------------------------------------------------------------------*/ + /* Now write the pixels to the FITS column. */ + /* First call the ffXXfYY routine to (1) convert the datatype */ + /* if necessary, and (2) scale the values by the FITS TSCALn and */ + /* TZEROn linear scaling parameters into a temporary buffer. */ + /*---------------------------------------------------------------------*/ + remain = nelem; /* remaining number of values to write */ + next = 0; /* next element in array to be written */ + rownum = 0; /* row number, relative to firstrow */ + + while (remain) + { + /* limit the number of pixels to process a one time to the number that + will fit in the buffer space or to the number of pixels that remain + in the current vector, which ever is smaller. + */ + ntodo = minvalue(remain, maxelem); + ntodo = minvalue(ntodo, (repeat - elemnum)); + + wrtptr = startpos + ((OFF_T)rownum * rowlen) + (elemnum * incre); + + ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */ + + switch (tcode) + { + case (TLONG): + /* convert the raw data before writing to FITS file */ + ffuintfi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TLONGLONG): + + ffuintfi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TBYTE): + + ffuintfi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffuintfi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TFLOAT): + + ffuintfr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffuintfr8(&array[next], ntodo, scale, zero, + (double *) buffer, status); + ffpr8b(fptr, ntodo, incre, (double *) buffer, status); + break; + + case (TSTRING): /* numerical column in an ASCII table */ + + if (cform[1] != 's') /* "%s" format is a string */ + { + ffuintfstr(&array[next], ntodo, scale, zero, cform, + twidth, (char *) buffer, status); + + if (incre == twidth) /* contiguous bytes */ + ffpbyt(fptr, ntodo * twidth, buffer, status); + else + ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer, + status); + + break; + } + /* can't write to string column, so fall thru to default: */ + + default: /* error trap */ + sprintf(message, + "Cannot write numbers to column %d which has format %s", + colnum,tform); + ffpmsg(message); + if (hdutype == ASCII_TBL) + return(*status = BAD_ATABLE_FORMAT); + else + return(*status = BAD_BTABLE_FORMAT); + + } /* End of switch block */ + + /*-------------------------*/ + /* Check for fatal error */ + /*-------------------------*/ + if (*status > 0) /* test for error during previous write operation */ + { + sprintf(message, + "Error writing elements %ld thru %ld of input data array (ffpcluk).", + next+1, next+ntodo); + ffpmsg(message); + return(*status); + } + + /*--------------------------------------------*/ + /* increment the counters for the next loop */ + /*--------------------------------------------*/ + remain -= ntodo; + if (remain) + { + next += ntodo; + elemnum += ntodo; + if (elemnum == repeat) /* completed a row; start on next row */ + { + elemnum = 0; + rownum++; + } + } + } /* End of main while Loop */ + + + /*--------------------------------*/ + /* check for numerical overflow */ + /*--------------------------------*/ + if (*status == OVERFLOW_ERR) + { + ffpmsg( + "Numerical overflow during type conversion while writing FITS data."); + *status = NUM_OVERFLOW; + } + + } /* end of Dec ALPHA special case */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpcnuk(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - number of column to write (1 = 1st col) */ + long firstrow, /* I - first row to write (1 = 1st row) */ + long firstelem, /* I - first vector element to write (1 = 1st) */ + long nelem, /* I - number of values to write */ + unsigned int *array, /* I - array of values to write */ + unsigned int nulvalue, /* I - value used to flag undefined pixels */ + int *status) /* IO - error status */ +/* + Write an array of elements to the specified column of a table. Any input + pixels equal to the value of nulvalue will be replaced by the appropriate + null value in the output FITS file. + + The input array of values will be converted to the datatype of the column + and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary +*/ +{ + tcolumn *colptr; + long ngood = 0, nbad = 0, ii, fstrow; + OFF_T large_elem, repeat, first, fstelm; + + if (*status > 0) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + { + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + } + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + { + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + + repeat = colptr->trepeat; /* repeat count for this column */ + + if (firstelem == USE_LARGE_VALUE) + large_elem = large_first_elem_val; + else + large_elem = firstelem; + + /* hereafter, pass first element parameter via global variable */ + firstelem = USE_LARGE_VALUE; + + /* absolute element number in the column */ + first = (firstrow - 1) * repeat + large_elem; + + for (ii = 0; ii < nelem; ii++) + { + if (array[ii] != nulvalue) /* is this a good pixel? */ + { + if (nbad) /* write previous string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpclu(fptr, colnum, fstrow, firstelem, nbad, status) > 0) + return(*status); + + nbad=0; + } + + ngood = ngood +1; /* the consecutive number of good pixels */ + } + else + { + if (ngood) /* write previous string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + if (ffpcluk(fptr, colnum, fstrow, firstelem,ngood, &array[ii-ngood], + status) > 0) + return(*status); + + ngood=0; + } + + nbad = nbad +1; /* the consecutive number of bad pixels */ + } + } + + /* finished loop; now just write the last set of pixels */ + + if (ngood) /* write last string of good pixels */ + { + fstelm = ii - ngood + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpcluk(fptr, colnum, fstrow, firstelem, ngood, &array[ii-ngood], status); + } + else if (nbad) /* write last string of bad pixels */ + { + fstelm = ii - nbad + first; /* absolute element number */ + fstrow = (fstelm - 1) / repeat + 1; /* starting row number */ + fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */ + large_first_elem_val = fstelm; + + ffpclu(fptr, colnum, fstrow, firstelem, nbad, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfi1(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + unsigned char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DUCHAR_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DUCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) (dvalue + .5); + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfi2(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + short *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DSHRT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MIN; + } + else if (dvalue > DSHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (short) (dvalue + .5); + else + output[ii] = (short) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfi4(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + INT32BIT *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 2147483648.) + { + /* Instead of subtracting 2147483648, it is more efficient */ + /* to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) + output[ii] = ( *(int *) &input[ii] ) ^ 0x80000000; + } + else if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + if (input[ii] > INT32_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + output[ii] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DINT_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MIN; + } + else if (dvalue > DINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT32_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (INT32BIT) (dvalue + .5); + else + output[ii] = (INT32BIT) (dvalue - .5); + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfi8(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + LONGLONG *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required +*/ +{ +#if (LONGSIZE == 32) && (! defined HAVE_LONGLONG) + +/* don't have a native 8-byte integer, so have to construct the */ +/* 2 equivalent 4-byte integers have the same bit pattern */ + + unsigned long *uoutput; + long ii, jj, kk, temp; + double dvalue; + + uoutput = (unsigned long *) output; + +#if BYTESWAPPED /* jj points to the most significant part of the 8-byte int */ + jj = 1; + kk = 0; +#else + jj = 0; + kk = 1; +#endif + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + output[jj] = 0; + uoutput[kk] = input[ii]; + } + } + else + { + for (ii = 0; ii < ntodo; ii++, jj += 2, kk += 2) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MIN; + output[kk] = 0; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[jj] = LONG_MAX; + output[kk] = -1; + } + else + { + if (dvalue < 0) + { + temp = (dvalue + 1.) / 4294967296. - 1.; + output[jj] = temp; + uoutput[kk] = 4294967296. + + (dvalue - (double) (temp + 1) * 4294967296.); + } + else + { + temp = dvalue / 4294967296.; + output[jj] = temp; + uoutput[kk] = dvalue - (double) temp * 4294967296.; + } + } + } + } + +#else + +/* this is the much simpler case where the native 8-byte integer exists */ + + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + + if (dvalue < DLONGLONG_MIN) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (dvalue > DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + if (dvalue >= 0) + output[ii] = (LONGLONG) (dvalue + .5); + else + output[ii] = (LONGLONG) (dvalue - .5); + } + } + } + +#endif + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfr4(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + float *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (float) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfr8(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + double *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do datatype conversion and scaling if required. +*/ +{ + long ii; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (double) input[ii]; + } + else + { + for (ii = 0; ii < ntodo; ii++) + output[ii] = (input[ii] - zero) / scale; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffuintfstr(unsigned int *input, /* I - array of values to be converted */ + long ntodo, /* I - number of elements in the array */ + double scale, /* I - FITS TSCALn or BSCALE value */ + double zero, /* I - FITS TZEROn or BZERO value */ + char *cform, /* I - format for output string values */ + long twidth, /* I - width of each field, in chars */ + char *output, /* O - output array of converted values */ + int *status) /* IO - error status */ +/* + Copy input to output prior to writing output to a FITS file. + Do scaling if required. +*/ +{ + long ii; + double dvalue; + + if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) + { + sprintf(output, cform, (double) input[ii]); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + else + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = (input[ii] - zero) / scale; + sprintf(output, cform, dvalue); + output += twidth; + + if (*output) /* if this char != \0, then overflow occurred */ + *status = OVERFLOW_ERR; + } + } + return(*status); +} diff --git a/pkg/tbtables/cfitsio/putkey.c b/pkg/tbtables/cfitsio/putkey.c new file mode 100644 index 00000000..f240df0a --- /dev/null +++ b/pkg/tbtables/cfitsio/putkey.c @@ -0,0 +1,2706 @@ +/* This file, putkey.c, contains routines that write keywords to */ +/* a FITS header. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include +#include +/* stddef.h is apparently needed to define size_t */ +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffcrim(fitsfile *fptr, /* I - FITS file pointer */ + int bitpix, /* I - bits per pixel */ + int naxis, /* I - number of axes in the array */ + long *naxes, /* I - size of each axis */ + int *status) /* IO - error status */ +/* + create an IMAGE extension following the current HDU. If the + current HDU is empty (contains no header keywords), then simply + write the required image (or primary array) keywords to the current + HDU. +*/ +{ + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* create new extension if current header is not empty */ + if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + ffcrhd(fptr, status); + + /* write the required header keywords */ + ffphpr(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcrtb(fitsfile *fptr, /* I - FITS file pointer */ + int tbltype, /* I - type of table to create */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + int *status) /* IO - error status */ +/* + Create a table extension in a FITS file. +*/ +{ + long naxis1 = 0, *tbcol = 0; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + /* create new extension if current header is not empty */ + if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + ffcrhd(fptr, status); + + if ((fptr->Fptr)->curhdu == 0) /* have to create dummy primary array */ + { + ffcrim(fptr, 16, 0, tbcol, status); + ffcrhd(fptr, status); + } + + if (tbltype == BINARY_TBL) + { + /* write the required header keywords. This will write PCOUNT = 0 */ + /* so variable length array columns are not supported */ + ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, 0, status); + } + else if (tbltype == ASCII_TBL) + { + /* write the required header keywords */ + /* default values for naxis1 and tbcol will be calculated */ + ffphtb(fptr, naxis1, naxis2, tfields, ttype, tbcol, tform, tunit, + extnm, status); + } + else + *status = NOT_TABLE; + + return(*status); +} +/*-------------------------------------------------------------------------*/ +int ffpktp(fitsfile *fptr, /* I - FITS file pointer */ + const char *filename, /* I - name of template file */ + int *status) /* IO - error status */ +/* + read keywords from template file and append to the FITS file +*/ +{ + FILE *diskfile; + char card[FLEN_CARD], template[161]; + char keyname[FLEN_KEYWORD], newname[FLEN_KEYWORD]; + int keytype; + size_t slen; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + diskfile = fopen(filename,"r"); + if (!diskfile) /* couldn't open file */ + { + ffpmsg("ffpktp could not open the following template file:"); + ffpmsg(filename); + return(*status = FILE_NOT_OPENED); + } + + while (fgets(template, 160, diskfile) ) /* get next template line */ + { + template[160] = '\0'; /* make sure string is terminated */ + slen = strlen(template); /* get string length */ + template[slen - 1] = '\0'; /* over write the 'newline' char */ + + if (ffgthd(template, card, &keytype, status) > 0) /* parse template */ + break; + + strncpy(keyname, card, 8); + keyname[8] = '\0'; + + if (keytype == -2) /* rename the card */ + { + strncpy(newname, &card[40], 8); + newname[8] = '\0'; + + ffmnam(fptr, keyname, newname, status); + } + else if (keytype == -1) /* delete the card */ + { + ffdkey(fptr, keyname, status); + } + else if (keytype == 0) /* update the card */ + { + ffucrd(fptr, keyname, card, status); + } + else if (keytype == 1) /* append the card */ + { + ffprec(fptr, card, status); + } + else /* END card; stop here */ + { + break; + } + } + + fclose(diskfile); /* close the template file */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpky( fitsfile *fptr, /* I - FITS file pointer */ + int datatype, /* I - datatype of the value */ + char *keyname, /* I - name of keyword to write */ + void *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes a keyword value with the datatype specified by the 2nd argument. +*/ +{ + char errmsg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (datatype == TSTRING) + { + ffpkys(fptr, keyname, (char *) value, comm, status); + } + else if (datatype == TBYTE) + { + ffpkyj(fptr, keyname, (long) *(unsigned char *) value, comm, status); + } + else if (datatype == TSBYTE) + { + ffpkyj(fptr, keyname, (long) *(signed char *) value, comm, status); + } + else if (datatype == TUSHORT) + { + ffpkyj(fptr, keyname, (long) *(unsigned short *) value, comm, status); + } + else if (datatype == TSHORT) + { + ffpkyj(fptr, keyname, (long) *(short *) value, comm, status); + } + else if (datatype == TUINT) + { + ffpkyg(fptr, keyname, (double) *(unsigned int *) value, 0, + comm, status); + } + else if (datatype == TINT) + { + ffpkyj(fptr, keyname, (long) *(int *) value, comm, status); + } + else if (datatype == TLOGICAL) + { + ffpkyl(fptr, keyname, *(int *) value, comm, status); + } + else if (datatype == TULONG) + { + ffpkyg(fptr, keyname, (double) *(unsigned long *) value, 0, + comm, status); + } + else if (datatype == TLONG) + { + ffpkyj(fptr, keyname, *(long *) value, comm, status); + } + else if (datatype == TFLOAT) + { + ffpkye(fptr, keyname, *(float *) value, -7, comm, status); + } + else if (datatype == TDOUBLE) + { + ffpkyd(fptr, keyname, *(double *) value, -15, comm, status); + } + else if (datatype == TCOMPLEX) + { + ffpkyc(fptr, keyname, (float *) value, -7, comm, status); + } + else if (datatype == TDBLCOMPLEX) + { + ffpkym(fptr, keyname, (double *) value, -15, comm, status); + } + else + { + sprintf(errmsg, "Bad keyword datatype code: %d (ffpky)", datatype); + ffpmsg(errmsg); + *status = BAD_DATATYPE; + } + + return(*status); +} +/*-------------------------------------------------------------------------*/ +int ffprec(fitsfile *fptr, /* I - FITS file pointer */ + const char *card, /* I - string to be written */ + int *status) /* IO - error status */ +/* + write a keyword record (80 bytes long) to the end of the header +*/ +{ + char tcard[FLEN_CARD]; + size_t len, ii; + long nblocks; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ( ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) == 80) /* no room */ + { + nblocks = 1; + if (ffiblk(fptr, nblocks, 0, status) > 0) /* insert 2880-byte block */ + return(*status); + } + + strncpy(tcard,card,80); + tcard[80] = '\0'; + + len = strlen(tcard); + for (ii=len; ii < 80; ii++) /* fill card with spaces if necessary */ + tcard[ii] = ' '; + + for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */ + tcard[ii] = toupper(tcard[ii]); + + fftkey(tcard, status); /* test keyword name contains legal chars */ + + fftrec(tcard, status); /* test rest of keyword for legal chars */ + + ffmbyt(fptr, (fptr->Fptr)->headend, IGNORE_EOF, status); /* move to end */ + + ffpbyt(fptr, 80, tcard, status); /* write the 80 byte card */ + + if (*status <= 0) + (fptr->Fptr)->headend += 80; /* update end-of-header position */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyu( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) a null-valued keyword and comment into the FITS header. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring," "); /* create a dummy value string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword */ + ffprec(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkys( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + The value string will be truncated at 68 characters which is the + maximum length that will fit on a single FITS keyword. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffs2c(value, valstring, status); /* put quotes around the string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword */ + ffprec(fptr, card, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkls( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + char *value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + This routine is a modified version of ffpkys which supports the + HEASARC long string convention and can write arbitrarily long string + keyword values. The value is continued over multiple keywords that + have the name COMTINUE without an equal sign in column 9 of the card. + This routine also supports simple string keywords which are less than + 69 characters in length. +*/ +{ + char valstring[FLEN_CARD]; + char card[FLEN_CARD]; + char tstring[FLEN_CARD], *cptr; + int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + remain = maxvalue(strlen(value), 1); /* no. of chars to write (at least 1) */ + /* count the number of single quote characters are in the string */ + tstring[0] = '\0'; + strncat(tstring, value, 68); /* copy 1st part of string to temp buff */ + nquote = 0; + cptr = strchr(tstring, '\''); /* search for quote character */ + while (cptr) /* search for quote character */ + { + nquote++; /* increment no. of quote characters */ + cptr++; /* increment pointer to next character */ + cptr = strchr(cptr, '\''); /* search for another quote char */ + } + + cptr = keyname; + while(*cptr == ' ') /* skip over leading spaces in name */ + cptr++; + + /* determine the number of characters that will fit on the line */ + /* Note: each quote character is expanded to 2 quotes */ + + namelen = strlen(cptr); + if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) ) + { + /* This a normal 8-character FITS keyword */ + nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */ + } + else + { + /* This a HIERARCH keyword */ + if (FSTRNCMP(cptr, "HIERARCH ", 9) && + FSTRNCMP(cptr, "hierarch ", 9)) + nchar = 66 - nquote - namelen; + else + nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */ + + } + + contin = 0; + next = 0; /* pointer to next character to write */ + + while (remain > 0) + { + tstring[0] = '\0'; + strncat(tstring, &value[next], nchar); /* copy string to temp buff */ + ffs2c(tstring, valstring, status); /* put quotes around the string */ + + if (remain > nchar) /* if string is continued, put & as last char */ + { + vlen = strlen(valstring); + nchar -= 1; /* outputting one less character now */ + + if (valstring[vlen-2] != '\'') + valstring[vlen-2] = '&'; /* over write last char with & */ + else + { /* last char was a pair of single quotes, so over write both */ + valstring[vlen-3] = '&'; + valstring[vlen-1] = '\0'; + } + } + + if (contin) /* This is a CONTINUEd keyword */ + { + ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */ + strncpy(&card[8], " ", 2); /* overwrite the '=' */ + } + else + { + ffmkky(keyname, valstring, comm, card, status); /* make keyword */ + } + + ffprec(fptr, card, status); /* write the keyword */ + + contin = 1; + remain -= nchar; + next += nchar; + + if (remain > 0) + { + /* count the number of single quote characters in next section */ + tstring[0] = '\0'; + strncat(tstring, &value[next], 68); /* copy next part of string */ + nquote = 0; + cptr = strchr(tstring, '\''); /* search for quote character */ + while (cptr) /* search for quote character */ + { + nquote++; /* increment no. of quote characters */ + cptr++; /* increment pointer to next character */ + cptr = strchr(cptr, '\''); /* search for another quote char */ + } + nchar = 68 - nquote; /* max number of chars to write this time */ + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffplsw( fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Write the LONGSTRN keyword and a series of related COMMENT keywords + which document that this FITS header may contain long string keyword + values which are continued over multiple keywords using the HEASARC + long string keyword convention. If the LONGSTRN keyword already exists + then this routine simple returns without doing anything. +*/ +{ + char valstring[FLEN_VALUE], comm[FLEN_COMMENT]; + int tstatus; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + tstatus = 0; + if (ffgkys(fptr, "LONGSTRN", valstring, comm, &tstatus) == 0) + return(*status); /* keyword already exists, so just return */ + + ffpkys(fptr, "LONGSTRN", "OGIP 1.0", + "The HEASARC Long String Convention may be used.", status); + + ffpcom(fptr, + " This FITS file may contain long string keyword values that are", status); + + ffpcom(fptr, + " continued over multiple keywords. The HEASARC convention uses the &", + status); + + ffpcom(fptr, + " character at the end of each substring which is then continued", status); + + ffpcom(fptr, + " on the next keyword which has the name CONTINUE.", status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyl( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + int value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Values equal to 0 will result in a False FITS keyword; any other + non-zero value will result in a True FITS keyword. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffl2c(value, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyj( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + long value, /* I - keyword value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an integer keyword value. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffi2c(value, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyf( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + float value, /* I - keyword value */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes a fixed float keyword value. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffr2f(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkye( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + float value, /* I - keyword value */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an exponential float keyword value. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffr2e(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyg( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + double value, /* I - keyword value */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes a fixed double keyword value.*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffd2f(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyd( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + double value, /* I - keyword value */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an exponential double keyword value.*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffd2e(value, decim, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyc( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + float *value, /* I - keyword value (real, imaginary) */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an complex float keyword value. Format = (realvalue, imagvalue) +*/ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffr2e(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2e(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkym( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + double *value, /* I - keyword value (real, imaginary) */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an complex double keyword value. Format = (realvalue, imagvalue) +*/ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffd2e(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2e(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkfc( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + float *value, /* I - keyword value (real, imaginary) */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an complex float keyword value. Format = (realvalue, imagvalue) +*/ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffr2f(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2f(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkfm( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + double *value, /* I - keyword value (real, imaginary) */ + int decim, /* I - number of decimal places to display */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) the keyword, value and comment into the FITS header. + Writes an complex double keyword value. Format = (realvalue, imagvalue) +*/ +{ + char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE]; + char card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + strcpy(valstring, "(" ); + ffd2f(value[0], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2f(value[1], decim, tmpstring, status); /* convert to string */ + strcat(valstring, tmpstring); + strcat(valstring, ")"); + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkyt( fitsfile *fptr, /* I - FITS file pointer */ + char *keyname, /* I - name of keyword to write */ + long intval, /* I - integer part of value */ + double fraction, /* I - fractional part of value */ + char *comm, /* I - keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) a 'triple' precision keyword where the integer and + fractional parts of the value are passed in separate parameters to + increase the total amount of numerical precision. +*/ +{ + char valstring[FLEN_VALUE]; + char card[FLEN_CARD]; + char fstring[20], *cptr; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (fraction > 1. || fraction < 0.) + { + ffpmsg("fraction must be between 0. and 1. (ffpkyt)"); + return(*status = BAD_F2C); + } + + ffi2c(intval, valstring, status); /* convert integer to string */ + ffd2f(fraction, 16, fstring, status); /* convert to 16 decimal string */ + + cptr = strchr(fstring, '.'); /* find the decimal point */ + strcat(valstring, cptr); /* append the fraction to the integer */ + + ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/ + ffprec(fptr, card, status); /* write the keyword*/ + + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffpcom( fitsfile *fptr, /* I - FITS file pointer */ + const char *comm, /* I - comment string */ + int *status) /* IO - error status */ +/* + Write 1 or more COMMENT keywords. If the comment string is too + long to fit on a single keyword (72 chars) then it will automatically + be continued on multiple CONTINUE keywords. +*/ +{ + char card[FLEN_CARD]; + int len, ii; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + len = strlen(comm); + ii = 0; + + for (; len > 0; len -= 72) + { + strcpy(card, "COMMENT "); + strncat(card, &comm[ii], 72); + ffprec(fptr, card, status); + ii += 72; + } + + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffphis( fitsfile *fptr, /* I - FITS file pointer */ + const char *history, /* I - history string */ + int *status) /* IO - error status */ +/* + Write 1 or more HISTORY keywords. If the history string is too + long to fit on a single keyword (72 chars) then it will automatically + be continued on multiple HISTORY keywords. +*/ +{ + char card[FLEN_CARD]; + int len, ii; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + len = strlen(history); + ii = 0; + + for (; len > 0; len -= 72) + { + strcpy(card, "HISTORY "); + strncat(card, &history[ii], 72); + ffprec(fptr, card, status); + ii += 72; + } + + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffpdat( fitsfile *fptr, /* I - FITS file pointer */ + int *status) /* IO - error status */ +/* + Write the DATE keyword into the FITS header. If the keyword already + exists then the date will simply be updated in the existing keyword. +*/ +{ + int timeref; + char date[30], tmzone[10], card[FLEN_CARD]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + ffgstm(date, &timeref, status); + + if (timeref) /* GMT not available on this machine */ + strcpy(tmzone, " Local"); + else + strcpy(tmzone, " UT"); + + strcpy(card, "DATE = '"); + strcat(card, date); + strcat(card, "' / file creation date (YYYY-MM-DDThh:mm:ss"); + strcat(card, tmzone); + strcat(card, ")"); + + ffucrd(fptr, "DATE", card, status); + + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffgstm( char *timestr, /* O - returned system date and time string */ + int *timeref, /* O - GMT = 0, Local time = 1 */ + int *status) /* IO - error status */ +/* + Returns the current date and time in format 'yyyy-mm-ddThh:mm:ss'. +*/ +{ + time_t tp; + struct tm *ptr; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + time(&tp); + ptr = gmtime(&tp); /* get GMT (= UTC) time */ + + if (timeref) + { + if (ptr) + *timeref = 0; /* returning GMT */ + else + *timeref = 1; /* returning local time */ + } + + if (!ptr) /* GMT not available on this machine */ + ptr = localtime(&tp); + + strftime(timestr, 25, "%Y-%m-%dT%H:%M:%S", ptr); + + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffdt2s(int year, /* I - year (0 - 9999) */ + int month, /* I - month (1 - 12) */ + int day, /* I - day (1 - 31) */ + char *datestr, /* O - date string: "YYYY-MM-DD" */ + int *status) /* IO - error status */ +/* + Construct a date character string +*/ +{ + char errmsg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (year < 0 || year > 9999) + { + sprintf(errmsg, + "input year value is out of range 0 - 9999: %d (ffdt2s)", year); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (month < 1 || month > 12) + { + sprintf(errmsg, + "input month value is out of range 1 - 12: %d (ffdt2s)", month); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (day < 1 || day > 31) + { + sprintf(errmsg, + "input day value is out of range 1 - 31: %d (ffdt2s)", day); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + if (year >= 1900 && year <= 1998) /* use old 'dd/mm/yy' format */ + sprintf(datestr, "%.2d/%.2d/%.2d", day, month, year - 1900); + + else /* use the new 'YYYY-MM-DD' format */ + sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day); + + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffs2dt(char *datestr, /* I - date string: "YYYY-MM-DD" or "dd/mm/yy" */ + int *year, /* O - year (0 - 9999) */ + int *month, /* O - month (1 - 12) */ + int *day, /* O - day (1 - 31) */ + int *status) /* IO - error status */ +/* + Parse a date character string into year, month, and date values +*/ +{ + int slen; + char errmsg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (!datestr) + { + ffpmsg("error: null input date string (ffs2dt)"); + return(*status = BAD_DATE); /* Null datestr pointer ??? */ + } + + slen = strlen(datestr); + + if (slen == 8 && datestr[2] == '/' && datestr[5] == '/') + { + if (isdigit((int) datestr[0]) && isdigit((int) datestr[1]) + && isdigit((int) datestr[3]) && isdigit((int) datestr[4]) + && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) ) + { + /* this is an old format string: "dd/mm/yy" */ + if (year) + *year = atoi(&datestr[6]) + 1900; + + if (month) + *month = atoi(&datestr[3]); + if (day) + *day = atoi(datestr); + } + else + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + } + else if (slen >= 10 && datestr[4] == '-' && datestr[7] == '-') + { + if (isdigit((int) datestr[0]) && isdigit((int) datestr[1]) + && isdigit((int) datestr[2]) && isdigit((int) datestr[3]) + && isdigit((int) datestr[5]) && isdigit((int) datestr[6]) + && isdigit((int) datestr[8]) && isdigit((int) datestr[9]) ) + { + if (slen > 10 && datestr[10] != 'T') + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + /* this is a new format string: "yyyy-mm-dd" */ + if (year) + *year = atoi(datestr); + + if (month) + *month = atoi(&datestr[5]); + + if (day) + *day = atoi(&datestr[8]); + } + else + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + } + else + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + + if (year) + if (*year < 0 || *year > 9999) + { + sprintf(errmsg, + "year value is out of range 0 - 9999: %d (ffs2dt)", *year); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + if (month) + if (*month < 1 || *month > 12) + { + sprintf(errmsg, + "month value is out of range 1 - 12: %d (ffs2dt)", *month); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + + if (day) + if (*day < 1 || *day > 31) + { + sprintf(errmsg, + "day value is out of range 1 - 31: %d (ffs2dt)", *day); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + return(*status); +} +/*-----------------------------------------------------------------*/ +int fftm2s(int year, /* I - year (0 - 9999) */ + int month, /* I - month (1 - 12) */ + int day, /* I - day (1 - 31) */ + int hour, /* I - hour (0 - 23) */ + int minute, /* I - minute (0 - 59) */ + double second, /* I - second (0. - 60.9999999) */ + int decimals, /* I - number of decimal points to write */ + char *datestr, /* O - date string: "YYYY-MM-DDThh:mm:ss.ddd" */ + /* or "hh:mm:ss.ddd" if year, month day = 0 */ + int *status) /* IO - error status */ +/* + Construct a date and time character string +*/ +{ + int width; + char errmsg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (year < 0 || year > 9999) + { + sprintf(errmsg, + "input year value is out of range 0 - 9999: %d (fftm2s)", year); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (month < 0 || month > 12) + { + sprintf(errmsg, + "input month value is out of range 0 - 12: %d (fftm2s)", month); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (day < 0 || day > 31) + { + sprintf(errmsg, + "input day value is out of range 0 - 31: %d (fftm2s)", day); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (hour < 0 || hour > 23) + { + sprintf(errmsg, + "input hour value is out of range 0 - 23: %d (fftm2s)", hour); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (minute < 0 || minute > 59) + { + sprintf(errmsg, + "input minute value is out of range 0 - 59: %d (fftm2s)", minute); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (second < 0. || second >= 61) + { + sprintf(errmsg, + "input second value is out of range 0 - 60.999: %f (fftm2s)", second); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (decimals > 25) + { + sprintf(errmsg, + "input decimals value is out of range 0 - 25: %d (fftm2s)", decimals); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + if (decimals == 0) + width = 2; + else + width = decimals + 3; + + if (decimals < 0) + { + /* a negative decimals value means return only the date, not time */ + sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day); + } + else if (year == 0 && month == 0 && day == 0) + { + /* return only the time, not the date */ + sprintf(datestr, "%.2d:%.2d:%0*.*f", + hour, minute, width, decimals, second); + } + else + { + /* return both the time and date */ + sprintf(datestr, "%.4d-%.2d-%.2dT%.2d:%.2d:%0*.*f", + year, month, day, hour, minute, width, decimals, second); + } + return(*status); +} +/*-----------------------------------------------------------------*/ +int ffs2tm(char *datestr, /* I - date string: "YYYY-MM-DD" */ + /* or "YYYY-MM-DDThh:mm:ss.ddd" */ + /* or "dd/mm/yy" */ + int *year, /* O - year (0 - 9999) */ + int *month, /* O - month (1 - 12) */ + int *day, /* O - day (1 - 31) */ + int *hour, /* I - hour (0 - 23) */ + int *minute, /* I - minute (0 - 59) */ + double *second, /* I - second (0. - 60.9999999) */ + int *status) /* IO - error status */ +/* + Parse a date character string into date and time values +*/ +{ + int slen; + char errmsg[81]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (!datestr) + { + ffpmsg("error: null input date string (ffs2tm)"); + return(*status = BAD_DATE); /* Null datestr pointer ??? */ + } + + if (hour) + *hour = 0; + + if (minute) + *minute = 0; + + if (second) + *second = 0.; + + if (datestr[2] == '/' || datestr[4] == '-') + { + /* Parse the year, month, and date */ + if (ffs2dt(datestr, year, month, day, status) > 0) + return(*status); + + slen = strlen(datestr); + if (slen == 8 || slen == 10) + return(*status); /* OK, no time fields */ + else if (slen < 19) + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + else if (datestr[10] == 'T' && datestr[13] == ':' && datestr[16] == ':') + { + if (isdigit((int) datestr[11]) && isdigit((int) datestr[12]) + && isdigit((int) datestr[14]) && isdigit((int) datestr[15]) + && isdigit((int) datestr[17]) && isdigit((int) datestr[18]) ) + { + if (slen > 19 && datestr[19] != '.') + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + /* this is a new format string: "yyyy-mm-ddThh:mm:ss.dddd" */ + if (hour) + *hour = atoi(&datestr[11]); + + if (minute) + *minute = atoi(&datestr[14]); + + if (second) + *second = atof(&datestr[17]); + } + else + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + } + } + else /* no date fields */ + { + if (year) + *year = 0; + + if (month) + *month = 0; + + if (day) + *day = 0; + + if (datestr[2] == ':' && datestr[5] == ':') /* time string */ + { + if (isdigit((int) datestr[0]) && isdigit((int) datestr[1]) + && isdigit((int) datestr[3]) && isdigit((int) datestr[4]) + && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) ) + { + /* this is a time string: "hh:mm:ss.dddd" */ + if (hour) + *hour = atoi(&datestr[0]); + + if (minute) + *minute = atoi(&datestr[3]); + + if (second) + *second = atof(&datestr[6]); + } + else + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + } + else + { + ffpmsg("input date string has illegal format:"); + ffpmsg(datestr); + return(*status = BAD_DATE); + } + + } + + if (hour) + if (*hour < 0 || *hour > 23) + { + sprintf(errmsg, + "hour value is out of range 0 - 23: %d (ffs2tm)", *hour); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + if (minute) + if (*minute < 0 || *minute > 59) + { + sprintf(errmsg, + "minute value is out of range 0 - 59: %d (ffs2tm)", *minute); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + if (second) + if (*second < 0 || *second >= 61.) + { + sprintf(errmsg, + "second value is out of range 0 - 60.9999: %f (ffs2tm)", *second); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsdt( int *day, int *month, int *year, int *status ) +{ +/* + This routine is included for backward compatibility + with the Fortran FITSIO library. + + ffgsdt : Get current System DaTe (GMT if available) + + Return integer values of the day, month, and year + + Function parameters: + day Day of the month + month Numerical month (1=Jan, etc.) + year Year (1999, 2000, etc.) + status output error status + +*/ + time_t now; + struct tm *date; + + now = time( NULL ); + date = gmtime(&now); /* get GMT (= UTC) time */ + + if (!date) /* GMT not available on this machine */ + { + date = localtime(&now); + } + + *day = date->tm_mday; + *month = date->tm_mon + 1; + *year = date->tm_year + 1900; /* tm_year is defined as years since 1900 */ + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int ffpkns( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + char *value[], /* I - array of pointers to keyword values */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Writes string keywords. + The value strings will be truncated at 68 characters, and the HEASARC + long string keyword convention is not supported by this routine. +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + if (repeat) + ffpkys(fptr, keyname, value[ii], tcomment, status); + else + ffpkys(fptr, keyname, value[ii], comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpknl( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + int *value, /* I - array of keyword values */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Writes logical keywords + Values equal to zero will be written as a False FITS keyword value; any + other non-zero value will result in a True FITS keyword. +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + + if (repeat) + ffpkyl(fptr, keyname, value[ii], tcomment, status); + else + ffpkyl(fptr, keyname, value[ii], comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpknj( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + long *value, /* I - array of keyword values */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Write integer keywords +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + if (repeat) + ffpkyj(fptr, keyname, value[ii], tcomment, status); + else + ffpkyj(fptr, keyname, value[ii], comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpknf( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + float *value, /* I - array of keyword values */ + int decim, /* I - number of decimals to display */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Writes fixed float values. +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + if (repeat) + ffpkyf(fptr, keyname, value[ii], decim, tcomment, status); + else + ffpkyf(fptr, keyname, value[ii], decim, comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkne( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + float *value, /* I - array of keyword values */ + int decim, /* I - number of decimals to display */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Writes exponential float values. +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + if (repeat) + ffpkye(fptr, keyname, value[ii], decim, tcomment, status); + else + ffpkye(fptr, keyname, value[ii], decim, comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpkng( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + double *value, /* I - array of keyword values */ + int decim, /* I - number of decimals to display */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Writes fixed double values. +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + if (repeat) + ffpkyg(fptr, keyname, value[ii], decim, tcomment, status); + else + ffpkyg(fptr, keyname, value[ii], decim, comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpknd( fitsfile *fptr, /* I - FITS file pointer */ + char *keyroot, /* I - root name of keywords to write */ + int nstart, /* I - starting index number */ + int nkey, /* I - number of keywords to write */ + double *value, /* I - array of keyword values */ + int decim, /* I - number of decimals to display */ + char *comm[], /* I - array of pointers to keyword comment */ + int *status) /* IO - error status */ +/* + Write (put) an indexed array of keywords with index numbers between + NSTART and (NSTART + NKEY -1) inclusive. Writes exponential double values. +*/ +{ + char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT]; + int ii, jj, repeat, len; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check if first comment string is to be repeated for all the keywords */ + /* by looking to see if the last non-blank character is a '&' char */ + + repeat = 0; + + if (comm) + { + len = strlen(comm[0]); + + while (len > 0 && comm[0][len - 1] == ' ') + len--; /* ignore trailing blanks */ + + if (comm[0][len - 1] == '&') + { + len = minvalue(len, FLEN_COMMENT); + tcomment[0] = '\0'; + strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */ + repeat = 1; + } + } + else + { + repeat = 1; + tcomment[0] = '\0'; + } + + for (ii=0, jj=nstart; ii < nkey; ii++, jj++) + { + ffkeyn(keyroot, jj, keyname, status); + if (repeat) + ffpkyd(fptr, keyname, value[ii], decim, tcomment, status); + else + ffpkyd(fptr, keyname, value[ii], decim, comm[ii], status); + + if (*status > 0) + return(*status); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffptdm( fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number */ + int naxis, /* I - number of axes in the data array */ + long naxes[], /* I - length of each data axis */ + int *status) /* IO - error status */ +/* + write the TDIMnnn keyword describing the dimensionality of a column +*/ +{ + char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT]; + char value[80], message[81]; + int ii; + long totalpix = 1, repeat; + tcolumn *colptr; + + if (*status > 0) + return(*status); + + if (colnum < 1 || colnum > 999) + { + ffpmsg("column number is out of range 1 - 999 (ffptdm)"); + return(*status = BAD_COL_NUM); + } + + if (naxis < 1) + { + ffpmsg("naxis is less than 1 (ffptdm)"); + return(*status = BAD_DIMEN); + } + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) + if ( ffrdef(fptr, status) > 0) /* rescan header */ + return(*status); + + if ( (fptr->Fptr)->hdutype != BINARY_TBL) + { + ffpmsg( + "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)"); + return(*status = NOT_BTABLE); + } + + strcpy(tdimstr, "("); /* start constructing the TDIM value */ + + for (ii = 0; ii < naxis; ii++) + { + if (ii > 0) + strcat(tdimstr, ","); /* append the comma separator */ + + if (naxes[ii] < 0) + { + ffpmsg("one or more TDIM values are less than 0 (ffptdm)"); + return(*status = BAD_TDIM); + } + + sprintf(value, "%ld", naxes[ii]); + strcat(tdimstr, value); /* append the axis size */ + + totalpix *= naxes[ii]; + } + + colptr = (fptr->Fptr)->tableptr; /* point to first column structure */ + colptr += (colnum - 1); /* point to the specified column number */ + + if ((long) colptr->trepeat != totalpix) + { + /* There is an apparent inconsistency between TDIMn and TFORMn. */ + /* The colptr->trepeat value may be out of date, so re-read */ + /* the TFORMn keyword to be sure. */ + + ffkeyn("TFORM", colnum, keyname, status); /* construct TFORMn name */ + ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword */ + ffbnfm(value, NULL, &repeat, NULL, status); /* parse the repeat count */ + + if (*status > 0 || repeat != totalpix) + { + sprintf(message, + "column vector length, %ld, does not equal TDIMn array size, %ld", + (long) colptr->trepeat, totalpix); + ffpmsg(message); + return(*status = BAD_TDIM); + } + } + + strcat(tdimstr, ")" ); /* append the closing parenthesis */ + + strcpy(comm, "size of the multidimensional array"); + ffkeyn("TDIM", colnum, keyname, status); /* construct TDIMn name */ + ffpkys(fptr, keyname, tdimstr, comm, status); /* write the keyword */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffphps( fitsfile *fptr, /* I - FITS file pointer */ + int bitpix, /* I - number of bits per data value pixel */ + int naxis, /* I - number of axes in the data array */ + long naxes[], /* I - length of each data axis */ + int *status) /* IO - error status */ +/* + write STANDARD set of required primary header keywords +*/ +{ + int simple = 1; /* does file conform to FITS standard? 1/0 */ + long pcount = 0; /* number of group parameters (usually 0) */ + long gcount = 1; /* number of random groups (usually 1 or 0) */ + int extend = 1; /* may FITS file have extensions? */ + + ffphpr(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffphpr( fitsfile *fptr, /* I - FITS file pointer */ + int simple, /* I - does file conform to FITS standard? 1/0 */ + int bitpix, /* I - number of bits per data value pixel */ + int naxis, /* I - number of axes in the data array */ + long naxes[], /* I - length of each data axis */ + long pcount, /* I - number of group parameters (usually 0) */ + long gcount, /* I - number of random groups (usually 1 or 0) */ + int extend, /* I - may FITS file have extensions? */ + int *status) /* IO - error status */ +/* + write required primary header keywords +*/ +{ + int ii; + long longbitpix; + char name[FLEN_KEYWORD], comm[FLEN_COMMENT], message[FLEN_ERRMSG]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + return(*status = HEADER_NOT_EMPTY); + + if (naxis != 0) /* never try to compress a null image */ + { + if ( (fptr->Fptr)->request_compress_type ) + { + /* write header for a compressed image */ + imcomp_init_table(fptr, (fptr->Fptr)->request_compress_type, + bitpix, naxis, naxes, (fptr->Fptr)->request_tilesize, 32, + (fptr->Fptr)->request_rice_nbits, status); + return(*status); + } + } + + if ((fptr->Fptr)->curhdu == 0) + { /* write primary array header */ + if (simple) + strcpy(comm, "file does conform to FITS standard"); + else + strcpy(comm, "file does not conform to FITS standard"); + + ffpkyl(fptr, "SIMPLE", simple, comm, status); + } + else + { /* write IMAGE extension header */ + strcpy(comm, "IMAGE extension"); + ffpkys(fptr, "XTENSION", "IMAGE", comm, status); + } + + longbitpix = bitpix; + + /* test for the 2 special cases that represent unsigned integers */ + if (longbitpix == USHORT_IMG) + longbitpix = SHORT_IMG; + else if (longbitpix == ULONG_IMG) + longbitpix = LONG_IMG; + + if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG && + longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG && + longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG) + { + sprintf(message, + "Illegal value for BITPIX keyword: %d", bitpix); + ffpmsg(message); + return(*status = BAD_BITPIX); + } + + strcpy(comm, "number of bits per data pixel"); + if (ffpkyj(fptr, "BITPIX", longbitpix, comm, status) > 0) + return(*status); + + if (naxis < 0 || naxis > 999) + { + sprintf(message, + "Illegal value for NAXIS keyword: %d", naxis); + ffpmsg(message); + return(*status = BAD_NAXIS); + } + + strcpy(comm, "number of data axes"); + ffpkyj(fptr, "NAXIS", naxis, comm, status); + + strcpy(comm, "length of data axis "); + for (ii = 0; ii < naxis; ii++) + { + if (naxes[ii] < 0) + { + sprintf(message, + "Illegal value for NAXIS%d keyword: %ld", ii + 1, naxes[ii]); + ffpmsg(message); + return(*status = BAD_NAXES); + } + + sprintf(&comm[20], "%d", ii + 1); + ffkeyn("NAXIS", ii + 1, name, status); + ffpkyj(fptr, name, naxes[ii], comm, status); + } + + if ((fptr->Fptr)->curhdu == 0) /* the primary array */ + { + if (extend) + { + /* only write EXTEND keyword if value = true */ + strcpy(comm, "FITS dataset may contain extensions"); + ffpkyl(fptr, "EXTEND", extend, comm, status); + } + + if (pcount < 0) + { + ffpmsg("pcount value is less than 0"); + return(*status = BAD_PCOUNT); + } + + else if (gcount < 1) + { + ffpmsg("gcount value is less than 1"); + return(*status = BAD_GCOUNT); + } + + else if (pcount > 0 || gcount > 1) + { + /* only write these keyword if non-standard values */ + strcpy(comm, "random group records are present"); + ffpkyl(fptr, "GROUPS", 1, comm, status); + + strcpy(comm, "number of random group parameters"); + ffpkyj(fptr, "PCOUNT", pcount, comm, status); + + strcpy(comm, "number of random groups"); + ffpkyj(fptr, "GCOUNT", gcount, comm, status); + } + + /* write standard block of self-documentating comments */ + ffprec(fptr, + "COMMENT FITS (Flexible Image Transport System) format is defined in 'Astronomy", + status); + ffprec(fptr, + "COMMENT and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H", + status); + } + + else /* an IMAGE extension */ + + { /* image extension; cannot have random groups */ + if (pcount != 0) + { + ffpmsg("image extensions must have pcount = 0"); + *status = BAD_PCOUNT; + } + + else if (gcount != 1) + { + ffpmsg("image extensions must have gcount = 1"); + *status = BAD_GCOUNT; + } + + else + { + strcpy(comm, "required keyword; must = 0"); + ffpkyj(fptr, "PCOUNT", pcount, comm, status); + + strcpy(comm, "required keyword; must = 1"); + ffpkyj(fptr, "GCOUNT", gcount, comm, status); + } + } + + /* Write the BSCALE and BZERO keywords, if an unsigned integer image */ + if (bitpix == USHORT_IMG) + { + strcpy(comm, "offset data range to that of unsigned short"); + ffpkyg(fptr, "BZERO", 32768., 0, comm, status); + strcpy(comm, "default scaling factor"); + ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status); + } + else if (bitpix == ULONG_IMG) + { + strcpy(comm, "offset data range to that of unsigned long"); + ffpkyg(fptr, "BZERO", 2147483648., 0, comm, status); + strcpy(comm, "default scaling factor"); + ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffphtb(fitsfile *fptr, /* I - FITS file pointer */ + long naxis1, /* I - width of row in the table */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + long *tbcol, /* I - byte offset in row to each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + int *status) /* IO - error status */ +/* + Put required Header keywords into the ASCII TaBle: +*/ +{ + int ii, ncols, gotmem = 0; + long rowlen; + char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT]; + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if (*status > 0) + return(*status); + else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + return(*status = HEADER_NOT_EMPTY); + else if (naxis1 < 0) + return(*status = NEG_WIDTH); + else if (naxis2 < 0) + return(*status = NEG_ROWS); + else if (tfields < 0 || tfields > 999) + return(*status = BAD_TFIELDS); + + rowlen = naxis1; + + if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */ + { + /* allocate mem for tbcol; malloc can have problems allocating small */ + /* arrays, so allocate at least 20 bytes */ + + ncols = maxvalue(5, tfields); + tbcol = (long *) calloc(ncols, sizeof(long)); + + if (tbcol) + { + gotmem = 1; + + /* calculate width of a row and starting position of each column. */ + /* Each column will be separated by 1 blank space */ + ffgabc(tfields, tform, 1, &rowlen, tbcol, status); + } + } + ffpkys(fptr, "XTENSION", "TABLE", "ASCII table extension", status); + ffpkyj(fptr, "BITPIX", 8, "8-bit ASCII characters", status); + ffpkyj(fptr, "NAXIS", 2, "2-dimensional ASCII table", status); + ffpkyj(fptr, "NAXIS1", rowlen, "width of table in characters", status); + ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status); + ffpkyj(fptr, "PCOUNT", 0, "no group parameters (required keyword)", status); + ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status); + ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status); + + for (ii = 0; ii < tfields; ii++) /* loop over every column */ + { + if ( *(ttype[ii]) ) /* optional TTYPEn keyword */ + { + sprintf(comm, "label for field %3d", ii + 1); + ffkeyn("TTYPE", ii + 1, name, status); + ffpkys(fptr, name, ttype[ii], comm, status); + } + + if (tbcol[ii] < 1 || tbcol[ii] > rowlen) + *status = BAD_TBCOL; + + sprintf(comm, "beginning column of field %3d", ii + 1); + ffkeyn("TBCOL", ii + 1, name, status); + ffpkyj(fptr, name, tbcol[ii], comm, status); + + strcpy(tfmt, tform[ii]); /* required TFORMn keyword */ + ffupch(tfmt); + ffkeyn("TFORM", ii + 1, name, status); + ffpkys(fptr, name, tfmt, "Fortran-77 format of field", status); + + if (tunit) + { + if (*tunit && *(tunit[ii]) ) /* optional TUNITn keyword */ + { + ffkeyn("TUNIT", ii + 1, name, status); + ffpkys(fptr, name, tunit[ii], "physical unit of field", status) ; + } + } + + if (*status > 0) + break; /* abort loop on error */ + } + + if (extnm) + { + if (extnm[0]) /* optional EXTNAME keyword */ + ffpkys(fptr, "EXTNAME", extnm, + "name of this ASCII table extension", status); + } + + if (*status > 0) + ffpmsg("Failed to write ASCII table header keywords (ffphtb)"); + + if (gotmem) + free(tbcol); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffphbn(fitsfile *fptr, /* I - FITS file pointer */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + long pcount, /* I - size of the variable length heap area */ + int *status) /* IO - error status */ +/* + Put required Header keywords into the Binary Table: +*/ +{ + int ii, datatype, iread = 0; + long repeat, width, naxis1; + + char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT]; + char *cptr; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + return(*status = HEADER_NOT_EMPTY); + else if (naxis2 < 0) + return(*status = NEG_ROWS); + else if (pcount < 0) + return(*status = BAD_PCOUNT); + else if (tfields < 0 || tfields > 999) + return(*status = BAD_TFIELDS); + + ffpkys(fptr, "XTENSION", "BINTABLE", "binary table extension", status); + ffpkyj(fptr, "BITPIX", 8, "8-bit bytes", status); + ffpkyj(fptr, "NAXIS", 2, "2-dimensional binary table", status); + + naxis1 = 0; + for (ii = 0; ii < tfields; ii++) /* sum the width of each field */ + { + ffbnfm(tform[ii], &datatype, &repeat, &width, status); + + if (datatype == TSTRING) + naxis1 += repeat; /* one byte per char */ + else if (datatype == TBIT) + naxis1 += (repeat + 7) / 8; + else if (datatype > 0) + naxis1 += repeat * (datatype / 10); + else /* this is a variable length descriptor (neg. datatype) */ + naxis1 += 8; + + if (*status > 0) + break; /* abort loop on error */ + } + + ffpkyj(fptr, "NAXIS1", naxis1, "width of table in bytes", status); + ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status); + + /* + the initial value of PCOUNT (= size of the variable length array heap) + should always be zero. If any variable length data is written, then + the value of PCOUNT will be updated when the HDU is closed + */ + ffpkyj(fptr, "PCOUNT", 0, "size of special data area", status); + ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status); + ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status); + + for (ii = 0; ii < tfields; ii++) /* loop over every column */ + { + if ( *(ttype[ii]) ) /* optional TTYPEn keyword */ + { + sprintf(comm, "label for field %3d", ii + 1); + ffkeyn("TTYPE", ii + 1, name, status); + ffpkys(fptr, name, ttype[ii], comm, status); + } + + strcpy(tfmt, tform[ii]); /* required TFORMn keyword */ + ffupch(tfmt); + + ffkeyn("TFORM", ii + 1, name, status); + strcpy(comm, "data format of field"); + + ffbnfm(tfmt, &datatype, &repeat, &width, status); + + if (datatype == TSTRING) + { + strcat(comm, ": ASCII Character"); + + /* Do sanity check to see if an ASCII table format was used, */ + /* e.g., 'A8' instead of '8A', or a bad unit width eg '8A9'. */ + /* Don't want to return an error status, so write error into */ + /* the keyword comment. */ + + cptr = strchr(tfmt,'A'); + cptr++; + + if (cptr) + iread = sscanf(cptr,"%ld", &width); + + if (iread == 1 && (width > repeat)) + { + if (repeat == 1) + strcpy(comm, "ERROR?? USING ASCII TABLE SYNTAX BY MISTAKE??"); + else + strcpy(comm, "rAw FORMAT ERROR! UNIT WIDTH w > COLUMN WIDTH r"); + } + } + else if (datatype == TBIT) + strcat(comm, ": BIT"); + else if (datatype == TBYTE) + strcat(comm, ": BYTE"); + else if (datatype == TLOGICAL) + strcat(comm, ": 1-byte LOGICAL"); + else if (datatype == TSHORT) + strcat(comm, ": 2-byte INTEGER"); + else if (datatype == TUSHORT) + strcat(comm, ": 2-byte INTEGER"); + else if (datatype == TLONG) + strcat(comm, ": 4-byte INTEGER"); + else if (datatype == TLONGLONG) + strcat(comm, ": 8-byte INTEGER"); + else if (datatype == TULONG) + strcat(comm, ": 4-byte INTEGER"); + else if (datatype == TFLOAT) + strcat(comm, ": 4-byte REAL"); + else if (datatype == TDOUBLE) + strcat(comm, ": 8-byte DOUBLE"); + else if (datatype == TCOMPLEX) + strcat(comm, ": COMPLEX"); + else if (datatype == TDBLCOMPLEX) + strcat(comm, ": DOUBLE COMPLEX"); + else if (datatype < 0) + strcat(comm, ": variable length array"); + + if (abs(datatype) == TSBYTE) /* signed bytes */ + { + /* Replace the 'S' with an 'B' in the TFORMn code */ + cptr = tfmt; + while (*cptr != 'S') + cptr++; + + *cptr = 'B'; + ffpkys(fptr, name, tfmt, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", ii + 1, name, status); + strcpy(comm, "offset for signed bytes"); + + ffpkyg(fptr, name, -128., 0, comm, status); + + ffkeyn("TSCAL", ii + 1, name, status); + strcpy(comm, "data are not scaled"); + ffpkyg(fptr, name, 1., 0, comm, status); + } + else if (abs(datatype) == TUSHORT) + { + /* Replace the 'U' with an 'I' in the TFORMn code */ + cptr = tfmt; + while (*cptr != 'U') + cptr++; + + *cptr = 'I'; + ffpkys(fptr, name, tfmt, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", ii + 1, name, status); + strcpy(comm, "offset for unsigned integers"); + + ffpkyg(fptr, name, 32768., 0, comm, status); + + ffkeyn("TSCAL", ii + 1, name, status); + strcpy(comm, "data are not scaled"); + ffpkyg(fptr, name, 1., 0, comm, status); + } + else if (abs(datatype) == TULONG) + { + /* Replace the 'V' with an 'J' in the TFORMn code */ + cptr = tfmt; + while (*cptr != 'V') + cptr++; + + *cptr = 'J'; + ffpkys(fptr, name, tfmt, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", ii + 1, name, status); + strcpy(comm, "offset for unsigned integers"); + + ffpkyg(fptr, name, 2147483648., 0, comm, status); + + ffkeyn("TSCAL", ii + 1, name, status); + strcpy(comm, "data are not scaled"); + ffpkyg(fptr, name, 1., 0, comm, status); + } + else + { + ffpkys(fptr, name, tfmt, comm, status); + } + + if (tunit) + { + if (*tunit && *(tunit[ii]) ) /* optional TUNITn keyword */ + { + ffkeyn("TUNIT", ii + 1, name, status); + ffpkys(fptr, name, tunit[ii], + "physical unit of field", status); + } + } + + if (*status > 0) + break; /* abort loop on error */ + } + + if (extnm) + { + if (extnm[0]) /* optional EXTNAME keyword */ + ffpkys(fptr, "EXTNAME", extnm, + "name of this binary table extension", status); + } + + if (*status > 0) + ffpmsg("Failed to write binary table header keywords (ffphbn)"); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffi2c(long ival, /* I - value to be converted to a string */ + char *cval, /* O - character string representation of the value */ + int *status) /* IO - error status */ +/* + convert value to a null-terminated formatted string. +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + cval[0] = '\0'; + + if (sprintf(cval, "%ld", ival) < 0) + { + ffpmsg("Error in ffi2c converting integer to string"); + *status = BAD_I2C; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffl2c(int lval, /* I - value to be converted to a string */ + char *cval, /* O - character string representation of the value */ + int *status) /* IO - error status ) */ +/* + convert logical value to a null-terminated formatted string. If the + input value == 0, then the output character is the letter F, else + the output character is the letter T. The output string is null terminated. +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (lval) + strcpy(cval,"T"); + else + strcpy(cval,"F"); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffs2c(char *instr, /* I - null terminated input string */ + char *outstr, /* O - null terminated quoted output string */ + int *status) /* IO - error status */ +/* + convert an input string to a quoted string. Leading spaces + are significant. FITS string keyword values must be at least + 8 chars long so pad out string with spaces if necessary. + Example: km/s ==> 'km/s ' + Single quote characters in the input string will be replace by + two single quote characters. e.g., o'brian ==> 'o''brian' +*/ +{ + size_t len, ii, jj; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (!instr) /* a null input pointer?? */ + { + strcpy(outstr, "''"); /* a null FITS string */ + return(*status); + } + + outstr[0] = '\''; /* start output string with a quote */ + + len = strlen(instr); + if (len > 68) + len = 68; /* limit input string to 68 chars */ + + for (ii=0, jj=1; ii < len && jj < 69; ii++, jj++) + { + outstr[jj] = instr[ii]; /* copy each char from input to output */ + if (instr[ii] == '\'') + { + jj++; + outstr[jj]='\''; /* duplicate any apostrophies in the input */ + } + } + + for (; jj < 9; jj++) /* pad string so it is at least 8 chars long */ + outstr[jj] = ' '; + + if (jj == 70) /* only occurs if the last char of string was a quote */ + outstr[69] = '\0'; + else + { + outstr[jj] = '\''; /* append closing quote character */ + outstr[jj+1] = '\0'; /* terminate the string */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr2f(float fval, /* I - value to be converted to a string */ + int decim, /* I - number of decimal places to display */ + char *cval, /* O - character string representation of the value */ + int *status) /* IO - error status */ +/* + convert float value to a null-terminated F format string +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + cval[0] = '\0'; + + if (decim < 0) + { + ffpmsg("Error in ffr2f: no. of decimal places < 0"); + return(*status = BAD_DECIM); + } + + if (sprintf(cval, "%.*f", decim, fval) < 0) + { + ffpmsg("Error in ffr2f converting float to string"); + *status = BAD_F2C; + } + + /* test if output string is 'NaN', 'INDEF', or 'INF' */ + if (strchr(cval, 'N')) + { + ffpmsg("Error in ffr2f: float value is a NaN or INDEF"); + *status = BAD_F2C; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffr2e(float fval, /* I - value to be converted to a string */ + int decim, /* I - number of decimal places to display */ + char *cval, /* O - character string representation of the value */ + int *status) /* IO - error status */ +/* + convert float value to a null-terminated exponential format string +*/ +{ + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + cval[0] = '\0'; + + if (decim < 0) + { /* use G format if decim is negative */ + if ( sprintf(cval, "%.*G", -decim, fval) < 0) + { + ffpmsg("Error in ffr2e converting float to string"); + *status = BAD_F2C; + } + else + { + /* test if E format was used, and there is no displayed decimal */ + if ( !strchr(cval, '.') && strchr(cval,'E') ) + { + /* reformat value with a decimal point and single zero */ + if ( sprintf(cval, "%.1E", fval) < 0) + { + ffpmsg("Error in ffr2e converting float to string"); + *status = BAD_F2C; + } + + return(*status); + } + } + } + else + { + if ( sprintf(cval, "%.*E", decim, fval) < 0) + { + ffpmsg("Error in ffr2e converting float to string"); + *status = BAD_F2C; + } + } + + if (*status <= 0) + { + /* test if output string is 'NaN', 'INDEF', or 'INF' */ + if (strchr(cval, 'N')) + { + ffpmsg("Error in ffr2e: float value is a NaN or INDEF"); + *status = BAD_F2C; + } + else if ( !strchr(cval, '.') && !strchr(cval,'E') ) + { + /* add decimal point if necessary to distinquish from integer */ + strcat(cval, "."); + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffd2f(double dval, /* I - value to be converted to a string */ + int decim, /* I - number of decimal places to display */ + char *cval, /* O - character string representation of the value */ + int *status) /* IO - error status */ +/* + convert double value to a null-terminated F format string +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + cval[0] = '\0'; + + if (decim < 0) + { + ffpmsg("Error in ffd2f: no. of decimal places < 0"); + return(*status = BAD_DECIM); + } + + if (sprintf(cval, "%.*f", decim, dval) < 0) + { + ffpmsg("Error in ffd2f converting double to string"); + *status = BAD_F2C; + } + + /* test if output string is 'NaN', 'INDEF', or 'INF' */ + if (strchr(cval, 'N')) + { + ffpmsg("Error in ffd2f: double value is a NaN or INDEF"); + *status = BAD_F2C; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffd2e(double dval, /* I - value to be converted to a string */ + int decim, /* I - number of decimal places to display */ + char *cval, /* O - character string representation of the value */ + int *status) /* IO - error status */ +/* + convert double value to a null-terminated exponential format string. +*/ +{ + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + cval[0] = '\0'; + + if (decim < 0) + { /* use G format if decim is negative */ + if ( sprintf(cval, "%.*G", -decim, dval) < 0) + { + ffpmsg("Error in ffd2e converting float to string"); + *status = BAD_F2C; + } + else + { + /* test if E format was used, and there is no displayed decimal */ + if ( !strchr(cval, '.') && strchr(cval,'E') ) + { + /* reformat value with a decimal point and single zero */ + if ( sprintf(cval, "%.1E", dval) < 0) + { + ffpmsg("Error in ffd2e converting float to string"); + *status = BAD_F2C; + } + + return(*status); + } + } + } + else + { + if ( sprintf(cval, "%.*E", decim, dval) < 0) + { + ffpmsg("Error in ffd2e converting float to string"); + *status = BAD_F2C; + } + } + + if (*status <= 0) + { + /* test if output string is 'NaN', 'INDEF', or 'INF' */ + if (strchr(cval, 'N')) + { + ffpmsg("Error in ffd2e: double value is a NaN or INDEF"); + *status = BAD_F2C; + } + else if ( !strchr(cval, '.') && !strchr(cval,'E') ) + { + /* add decimal point if necessary to distinquish from integer */ + strcat(cval, "."); + } + } + + return(*status); +} + diff --git a/pkg/tbtables/cfitsio/quantize.c b/pkg/tbtables/cfitsio/quantize.c new file mode 100644 index 00000000..a9c06e76 --- /dev/null +++ b/pkg/tbtables/cfitsio/quantize.c @@ -0,0 +1,613 @@ +/* + The following code was written by Richard White at STScI and made + available for use in CFITSIO in July 1999. +*/ + +# include +# include +# include + +#include "fitsio2.h" + +/* nearest integer function */ +# define NINT(x) ((x >= 0.) ? (int) (x + 0.5) : (int) (x - 0.5)) +# define SORT_CUTOFF 100 /* used by xMedian */ +# define NELEM 5 /* used by xMedian */ + +#define NULL_VALUE -2147483647 /* value used to represent undefined pixels */ +#define N_RESERVED_VALUES 1 /* number of reserved values, starting with */ + /* and including NULL_VALUE. These values */ + /* may not be used to represent the quantized */ + /* and scaled floating point pixel values */ + +/* factor to convert from median deviation to rms */ +# define MEDIAN_TO_RMS 1.4826 + +/* more than this many standard deviations from the mean is an outlier */ +# define SIGMA_CLIP 5. + +# define NITER 3 /* number of sigma-clipping iterations */ + +static float xMedian (float [], int); +static void InsertionSort (float x[], int); +static int FqCompare (const void *, const void *); +static void FqMean (float [], int, double *, double *); + + +/*---------------------------------------------------------------------------*/ +/* this routine used to be called 'quantize' (WDP) */ + +int fits_quantize_float (float fdata[], int nx, float in_null_value, + int noise_bits, int idata[], double *bscale, + double *bzero, int *iminval, int *imaxval) { + +/* arguments: +float fdata[] i: array of image pixels to be compressed +int nx i: length of fdata array +float in_null_value i: value used to represent undefined pixels in fdata +int noise_bits i: quantization level (number of bits) +int idata[] o: values of fdata after applying bzero and bscale +double bscale o: scale factor +double bzero o: zero offset +int iminval o: minimum quantized value that is returned +int imaxval o: maximum quantized value that is returned + +The function value will be one if the input fdata were copied to idata; +in this case the parameters bscale and bzero can be used to convert back to +nearly the original floating point values: fdata ~= idata * bscale + bzero. +If the function value is zero, the data were not copied to idata. +*/ + + float *diff; /* difference array */ + int ndiff; /* size of diff array */ + int intflag; /* true if data are really integer */ + int i, j, iter; /* loop indices */ + int anynulls = 0; /* set if fdata contains any null values */ + int nshift; + int first_nonnull = 0; + double mean, stdev; /* mean and RMS of differences */ + double minval = 0., maxval = 0.; /* min & max of fdata */ + double delta; /* bscale, 1 in idata = delta in fdata */ + double zeropt; /* bzero */ + double median; /* median of diff array */ + double temp; + + if (nx <= 1) { + *bscale = 1.; + *bzero = 0.; + return (0); + } + + *iminval = INT32_MAX; + *imaxval = INT32_MIN; + + /* Check to see if data are "floating point integer." */ + /* This also catches the case where all the pixels are null */ + intflag = 1; /* initial value */ + for (i = 0; i < nx; i++) { + if (fdata[i] == in_null_value) { + idata[i] = NULL_VALUE; + anynulls = 1; + } + else if (fdata[i] > INT32_MAX || + fdata[i] < NULL_VALUE + N_RESERVED_VALUES) { + intflag = 0; /* not integer */ + break; + } + else { + idata[i] = (int)(fdata[i] + 0.5); + *iminval = minvalue(idata[i], *iminval); + *imaxval = maxvalue(idata[i], *imaxval); + + if (idata[i] != fdata[i]) { + intflag = 0; /* not integer */ + break; + } + } + } + if (intflag) { /* data are "floating point integer" */ + if (anynulls) { + /* Shift the range of values so they lie close to NULL_VALUE. */ + /* This will make the compression more efficient. */ + nshift = *iminval - NULL_VALUE - N_RESERVED_VALUES; + for (i = 0; i < nx; i++) { + if (idata[i] != NULL_VALUE) { + idata[i] -= nshift; + } + } + *iminval = *iminval - nshift; + *imaxval = *imaxval - nshift; + *bscale = 1.; + *bzero = (double) nshift; + } + else { + /* there were no null values, so no need to shift the range */ + *bscale = 1.; + *bzero = 0.; + } + return (1); + } + + /* data are not "floating point integer"; need to quantize them */ + + /* find first non-null pixel, and initialize min and max values */ + for (i = 0; i < nx; i++) { + if (fdata[i] != in_null_value) { + minval = fdata[i]; + maxval = fdata[i]; + first_nonnull = i; + break; + } + } + + /* allocate temporary buffer for differences */ + ndiff = nx - first_nonnull - 1; + if ((diff = malloc (ndiff * sizeof (float))) == NULL) { + ffpmsg("Out of memory in 'fits_quantize_float'."); + return (0); + } + + /* calc ABS difference between successive non-null pixels */ + j = first_nonnull; + ndiff = 0; + for (i = j + 1 ; i < nx; i++) { + if (fdata[i] != in_null_value) { + diff[ndiff] = fabs (fdata[i] - fdata[j]); + j = i; + ndiff++; + minval = minvalue(minval, fdata[i]); + maxval = maxvalue(maxval, fdata[i]); + } + } + + /* check if there were any null values */ + if (ndiff + 1 == nx) + anynulls = 0; + else + anynulls = 1; + + /* use median of absolute deviations */ + + median = xMedian (diff, ndiff); + stdev = median * MEDIAN_TO_RMS; + /* substitute sigma-clipping if median is zero */ + if (stdev == 0.0) { + + /* calculate differences between non-null pixels */ + j = first_nonnull; + ndiff = 0; + for (i = j + 1 ; i < nx; i++) { + if (fdata[i] != in_null_value) { + diff[ndiff] = fdata[i] - fdata[j]; + j = i; + ndiff++; + } + } + + FqMean (diff, ndiff, &mean, &stdev); + + for (iter = 0; iter < NITER; iter++) { + j = 0; + for (i = 0; i < ndiff; i++) { + if (fabs (diff[i] - mean) < SIGMA_CLIP * stdev) { + if (j < i) + diff[j] = diff[i]; + j++; + } + } + if (j == ndiff) + break; + ndiff = j; + FqMean (diff, ndiff, &mean, &stdev); + } + } + free (diff); + + delta = stdev / pow (2., (double)noise_bits); + if (delta == 0. && ndiff > 0) + return (0); /* Zero variance in differences! Don't quantize. */ + + /* check that the range of quantized levels is not > range of int */ + if ((maxval - minval) / delta > 2. * 2147483647. - N_RESERVED_VALUES ) + return (0); /* don't quantize */ + + if (!anynulls) { /* don't have to check for nulls */ + /* return all positive values, if possible since some */ + /* compression algorithms either only work for positive integers, */ + /* or are more efficient. */ + if ((maxval - minval) / delta < 2147483647. - N_RESERVED_VALUES ) + { + zeropt = minval; + } + else + { + /* center the quantized levels around zero */ + zeropt = (minval + maxval) / 2.; + } + + for (i = 0; i < nx; i++) { + temp = (fdata[i] - zeropt) / delta; + idata[i] = NINT (temp); + } + } + else { + /* data contains null values; shift the range to be */ + /* close to the value used to represent null values */ + zeropt = minval - delta * (NULL_VALUE + N_RESERVED_VALUES); + for (i = 0; i < nx; i++) { + if (fdata[i] != in_null_value) { + temp = (fdata[i] - zeropt) / delta; + idata[i] = NINT (temp); + } + else + idata[i] = NULL_VALUE; + } + } + + /* calc min and max values */ + temp = (minval - zeropt) / delta; + *iminval = NINT (temp); + temp = (maxval - zeropt) / delta; + *imaxval = NINT (temp); + + *bscale = delta; + *bzero = zeropt; + + return (1); /* yes, data have been quantized */ +} + +/*---------------------------------------------------------------------------*/ +int fits_quantize_double (double fdata[], int nx, double in_null_value, + int noise_bits, int idata[], double *bscale, + double *bzero, int *iminval, int *imaxval) { + +/* arguments: +double fdata[] i: array of image pixels to be compressed +int nx i: length of fdata array +double in_null_value i: value used to represent undefined pixels in fdata +int noise_bits i: quantization level (number of bits) +int idata[] o: values of fdata after applying bzero and bscale +double bscale o: scale factor +double bzero o: zero offset +int imaxval o: maximum quantized value that is returned +int iminval o: minimum quantized value that is returned + +The function value will be one if the input fdata were copied to idata; +in this case the parameters bscale and bzero can be used to convert back to +nearly the original floating point values: fdata ~= idata * bscale + bzero. +If the function value is zero, the data were not copied to idata. +*/ + + float *diff; /* difference array */ + int ndiff; /* size of diff array */ + int intflag; /* true if data are really integer */ + int i, j, iter; /* loop indices */ + int anynulls = 0; /* set if fdata contains any null values */ + int nshift; + int first_nonnull = 0; + double mean, stdev; /* mean and RMS of differences */ + double minval = 0., maxval = 0.; /* min & max of fdata */ + double delta; /* bscale, 1 in idata = delta in fdata */ + double zeropt; /* bzero */ + double median; /* median of diff array */ + double temp; + + if (nx <= 1) { + *bscale = 1.; + *bzero = 0.; + return (0); + } + + *iminval = INT32_MAX; + *imaxval = INT32_MIN; + + /* Check to see if data are "floating point integer." */ + /* This also catches the case where all the pixels are null */ + intflag = 1; /* initial value */ + for (i = 0; i < nx; i++) { + if (fdata[i] == in_null_value) { + idata[i] = NULL_VALUE; + anynulls = 1; + } + else if (fdata[i] > INT32_MAX || + fdata[i] < NULL_VALUE + N_RESERVED_VALUES) { + intflag = 0; /* not integer */ + break; + } + else { + idata[i] = (int)(fdata[i] + 0.5); + *iminval = minvalue(idata[i], *iminval); + *imaxval = maxvalue(idata[i], *imaxval); + + if (idata[i] != fdata[i]) { + intflag = 0; /* not integer */ + break; + } + } + } + if (intflag) { /* data are "floating point integer" */ + if (anynulls) { + /* Shift the range of values so they lie close to NULL_VALUE. */ + /* This will make the compression more efficient. */ + nshift = *iminval - NULL_VALUE - N_RESERVED_VALUES; + for (i = 0; i < nx; i++) { + if (idata[i] != NULL_VALUE) { + idata[i] -= nshift; + } + } + *iminval = *iminval - nshift; + *imaxval = *imaxval - nshift; + *bscale = 1.; + *bzero = (double) nshift; + } + else { + /* there were no null values, so no need to shift the range */ + *bscale = 1.; + *bzero = 0.; + } + return (1); + } + + /* data are not "floating point integer"; need to quantize them */ + + /* find first non-null pixel, and initialize min and max values */ + for (i = 0; i < nx; i++) { + if (fdata[i] != in_null_value) { + minval = fdata[i]; + maxval = fdata[i]; + first_nonnull = i; + break; + } + } + + /* allocate temporary buffer for differences */ + ndiff = nx - first_nonnull - 1; + if ((diff = malloc (ndiff * sizeof (float))) == NULL) { + ffpmsg("Out of memory in 'fits_quantize_double'."); + return (0); + } + + /* calc ABS difference between successive non-null pixels */ + j = first_nonnull; + ndiff = 0; + for (i = j + 1 ; i < nx; i++) { + if (fdata[i] != in_null_value) { + diff[ndiff] = fabs (fdata[i] - fdata[j]); + j = i; + ndiff++; + minval = minvalue(minval, fdata[i]); + maxval = maxvalue(maxval, fdata[i]); + } + } + + /* check if there were any null values */ + if (ndiff + 1 == nx) + anynulls = 0; + else + anynulls = 1; + + /* use median of absolute deviations */ + + median = xMedian (diff, ndiff); + stdev = median * MEDIAN_TO_RMS; + /* substitute sigma-clipping if median is zero */ + if (stdev == 0.0) { + + /* calculate differences between non-null pixels */ + j = first_nonnull; + ndiff = 0; + for (i = j + 1 ; i < nx; i++) { + if (fdata[i] != in_null_value) { + diff[ndiff] = fdata[i] - fdata[j]; + j = i; + ndiff++; + } + } + + FqMean (diff, ndiff, &mean, &stdev); + + for (iter = 0; iter < NITER; iter++) { + j = 0; + for (i = 0; i < ndiff; i++) { + if (fabs (diff[i] - mean) < SIGMA_CLIP * stdev) { + if (j < i) + diff[j] = diff[i]; + j++; + } + } + if (j == ndiff) + break; + ndiff = j; + FqMean (diff, ndiff, &mean, &stdev); + } + } + free (diff); + + delta = stdev / pow (2., (double)noise_bits); + if (delta == 0. && ndiff > 0) + return (0); /* Zero variance in differences! Don't quantize. */ + + /* check that the range of quantized levels is not > range of int */ + if ((maxval - minval) / delta > 2. * 2147483647 - N_RESERVED_VALUES ) + return (0); /* don't quantize */ + if (!anynulls) { /* don't have to check for nulls */ + /* center the quantized levels around zero */ + zeropt = (minval + maxval) / 2.; + for (i = 0; i < nx; i++) { + temp = (fdata[i] - zeropt) / delta; + idata[i] = NINT (temp); + } + } + else { + /* data contains null values; shift the range to be */ + /* close to the value used to represent null values */ + zeropt = minval - delta * (NULL_VALUE + N_RESERVED_VALUES); + for (i = 0; i < nx; i++) { + if (fdata[i] != in_null_value) { + temp = (fdata[i] - zeropt) / delta; + idata[i] = NINT (temp); + } + else + idata[i] = NULL_VALUE; + } + } + + /* calc min and max values */ + temp = (minval - zeropt) / delta; + *iminval = NINT (temp); + temp = (maxval - zeropt) / delta; + *imaxval = NINT (temp); + + *bscale = delta; + *bzero = zeropt; + + return (1); /* yes, data have been quantized */ +} +/*---------------------------------------------------------------------------*/ +/* This computes the mean and standard deviation. */ + +static void FqMean (float diff[], int ndiff, double *mean, double *stdev) { + + int i; + double sum, sumsq; + double m; /* mean */ + double xn; /* = ndiff */ + double temp; + + if (ndiff < 2) { + if (ndiff < 1) + *mean = 0.; + else + *mean = diff[0]; + *stdev = 0.; + return; + } + + xn = (double)ndiff; + + sum = 0.; + sumsq = 0.; + for (i = 0; i < ndiff; i++) { + sum += diff[i]; + sumsq += (diff[i] * diff[i]); + } + + m = sum / xn; + *mean = m; + temp = (sumsq / xn - m*m) * xn; + if (temp <= 0) + *stdev = 0.; + else + *stdev = sqrt (temp / (xn-1.)); +} + +/*---------------------------------------------------------------------------*/ +/* This returns an approximation to the median. + The input array will be clobbered. +*/ + +static float xMedian (float x[], int n) { + +/* arguments: +float x[] io: the array (will be scrambled and possibly modified) +int n i: number of elements in x (modified locally) +*/ + + int i, j; + int next_n; + int npix; + int done; + float median = 0.; + + if (n < 1) { + ffpmsg("xMedian: no data"); + return (0.); + } + if (n == 1) + return (x[0]); + if (n == 2) + return ((x[0] + x[1]) / 2.); + + done = 0; + while (!done) { + + if (n < SORT_CUTOFF) { + qsort (x, n, sizeof (float), FqCompare); + if (n / 2 * 2 == n) + median = (x[n/2-1] + x[n/2]) / 2.; + else + median = x[n/2]; + return (median); + } + + /* ignore trailing groups of less than three elements */ + next_n = (n + NELEM-3) / NELEM; + + for (j = 0; j < next_n; j++) { + + i = j * NELEM; + npix = minvalue (NELEM, n - j*NELEM); + + InsertionSort (&x[i], npix); + + switch (npix) { + case 1: + median = x[i]; + break; + case 2: + median = (x[i] + x[i+1]) / 2.; + break; + case 3: + median = x[i+1]; + break; + case 4: + median = (x[i+1] + x[i+2]) / 2.; + break; + case 5: /* NELEM = 5 */ + median = x[i+2]; + break; + default: + ffpmsg("npix should be 1..5"); + } + + x[j] = median; + } + + if (next_n <= 1) + done = 1; + else + n = next_n; + } + + return (x[0]); +} +/*---------------------------------------------------------------------------*/ +static void InsertionSort (float x[], int n) { + + float a; + int i, j; + + for (j = 1; j < n; j++) { + + a = x[j]; + i = j - 1; + while (i >= 0 && x[i] > a) { + x[i+1] = x[i]; + i--; + } + x[i+1] = a; + } +} +/*---------------------------------------------------------------------------*/ +static int FqCompare (const void *vp, const void *vq) { + + const float *p = vp; + const float *q = vq; + + if (*p > *q) + return (1); + else if (*p < *q) + return (-1); + else + return (0); +} diff --git a/pkg/tbtables/cfitsio/quick.ps b/pkg/tbtables/cfitsio/quick.ps new file mode 100644 index 00000000..7503d841 --- /dev/null +++ b/pkg/tbtables/cfitsio/quick.ps @@ -0,0 +1,3850 @@ +%!PS-Adobe-2.0 +%%Creator: dvips(k) 5.86 Copyright 1999 Radical Eye Software +%%Title: quick.dvi +%%Pages: 41 +%%PageOrder: Ascend +%%BoundingBox: 0 0 596 842 +%%EndComments +%DVIPSWebPage: (www.radicaleye.com) +%DVIPSCommandLine: dvips -N0 quick +%DVIPSParameters: dpi=600, compressed +%DVIPSSource: TeX output 2003.06.23:1300 +%%BeginProcSet: texc.pro +%! +/TeXDict 300 dict def TeXDict begin/N{def}def/B{bind def}N/S{exch}N/X{S +N}B/A{dup}B/TR{translate}N/isls false N/vsize 11 72 mul N/hsize 8.5 72 +mul N/landplus90{false}def/@rigin{isls{[0 landplus90{1 -1}{-1 1}ifelse 0 +0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{ +landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize +mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[ +matrix currentmatrix{A A round sub abs 0.00001 lt{round}if}forall round +exch round exch]setmatrix}N/@landscape{/isls true N}B/@manualfeed{ +statusdict/manualfeed true put}B/@copies{/#copies X}B/FMat[1 0 0 -1 0 0] +N/FBB[0 0 0 0]N/nn 0 N/IEn 0 N/ctr 0 N/df-tail{/nn 8 dict N nn begin +/FontType 3 N/FontMatrix fntrx N/FontBBox FBB N string/base X array +/BitMaps X/BuildChar{CharBuilder}N/Encoding IEn N end A{/foo setfont}2 +array copy cvx N load 0 nn put/ctr 0 N[}B/sf 0 N/df{/sf 1 N/fntrx FMat N +df-tail}B/dfs{div/sf X/fntrx[sf 0 0 sf neg 0 0]N df-tail}B/E{pop nn A +definefont setfont}B/Cw{Cd A length 5 sub get}B/Ch{Cd A length 4 sub get +}B/Cx{128 Cd A length 3 sub get sub}B/Cy{Cd A length 2 sub get 127 sub} +B/Cdx{Cd A length 1 sub get}B/Ci{Cd A type/stringtype ne{ctr get/ctr ctr +1 add N}if}B/id 0 N/rw 0 N/rc 0 N/gp 0 N/cp 0 N/G 0 N/CharBuilder{save 3 +1 roll S A/base get 2 index get S/BitMaps get S get/Cd X pop/ctr 0 N Cdx +0 Cx Cy Ch sub Cx Cw add Cy setcachedevice Cw Ch true[1 0 0 -1 -.1 Cx +sub Cy .1 sub]/id Ci N/rw Cw 7 add 8 idiv string N/rc 0 N/gp 0 N/cp 0 N{ +rc 0 ne{rc 1 sub/rc X rw}{G}ifelse}imagemask restore}B/G{{id gp get/gp +gp 1 add N A 18 mod S 18 idiv pl S get exec}loop}B/adv{cp add/cp X}B +/chg{rw cp id gp 4 index getinterval putinterval A gp add/gp X adv}B/nd{ +/cp 0 N rw exit}B/lsh{rw cp 2 copy get A 0 eq{pop 1}{A 255 eq{pop 254}{ +A A add 255 and S 1 and or}ifelse}ifelse put 1 adv}B/rsh{rw cp 2 copy +get A 0 eq{pop 128}{A 255 eq{pop 127}{A 2 idiv S 128 and or}ifelse} +ifelse put 1 adv}B/clr{rw cp 2 index string putinterval adv}B/set{rw cp +fillstr 0 4 index getinterval putinterval adv}B/fillstr 18 string 0 1 17 +{2 copy 255 put pop}for N/pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add +chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{ +1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]A{bind pop} +forall N/D{/cc X A type/stringtype ne{]}if nn/base get cc ctr put nn +/BitMaps get S ctr S sf 1 ne{A A length 1 sub A 2 index S get sf div put +}if put/ctr ctr 1 add N}B/I{cc 1 add D}B/bop{userdict/bop-hook known{ +bop-hook}if/SI save N @rigin 0 0 moveto/V matrix currentmatrix A 1 get A +mul exch 0 get A mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N/eop{ +SI restore userdict/eop-hook known{eop-hook}if showpage}N/@start{ +userdict/start-hook known{start-hook}if pop/VResolution X/Resolution X +1000 div/DVImag X/IEn 256 array N 2 string 0 1 255{IEn S A 360 add 36 4 +index cvrs cvn put}for pop 65781.76 div/vsize X 65781.76 div/hsize X}N +/p{show}N/RMat[1 0 0 -1 0 0]N/BDot 260 string N/Rx 0 N/Ry 0 N/V{}B/RV/v{ +/Ry X/Rx X V}B statusdict begin/product where{pop false[(Display)(NeXT) +(LaserWriter 16/600)]{A length product length le{A length product exch 0 +exch getinterval eq{pop true exit}if}{pop}ifelse}forall}{false}ifelse +end{{gsave TR -.1 .1 TR 1 1 scale Rx Ry false RMat{BDot}imagemask +grestore}}{{gsave TR -.1 .1 TR Rx Ry scale 1 1 false RMat{BDot} +imagemask grestore}}ifelse B/QV{gsave newpath transform round exch round +exch itransform moveto Rx 0 rlineto 0 Ry neg rlineto Rx neg 0 rlineto +fill grestore}B/a{moveto}B/delta 0 N/tail{A/delta X 0 rmoveto}B/M{S p +delta add tail}B/b{S p tail}B/c{-4 M}B/d{-3 M}B/e{-2 M}B/f{-1 M}B/g{0 M} +B/h{1 M}B/i{2 M}B/j{3 M}B/k{4 M}B/w{0 rmoveto}B/l{p -4 w}B/m{p -3 w}B/n{ +p -2 w}B/o{p -1 w}B/q{p 1 w}B/r{p 2 w}B/s{p 3 w}B/t{p 4 w}B/x{0 S +rmoveto}B/y{3 2 roll p a}B/bos{/SS save N}B/eos{SS restore}B end + +%%EndProcSet +TeXDict begin 39158280 55380996 1000 600 600 (quick.dvi) +@start +%DVIPSBitmapFont: Fa cmsy10 10.95 4 +/Fa 4 107 df15 +D<153FEC03FFEC0FE0EC3F80EC7E00495A5C495AA2495AB3AA130F5C131F495A91C7FC13 +FEEA03F8EA7FE048C8FCEA7FE0EA03F8EA00FE133F806D7E130F801307B3AA6D7EA26D7E +80EB007EEC3F80EC0FE0EC03FFEC003F205B7AC32D>102 D<12FCEAFFC0EA07F0EA01FC +EA007E6D7E131F6D7EA26D7EB3AA801303806D7E1300147FEC1FC0EC07FEEC00FFEC07FE +EC1FC0EC7F0014FC1301495A5C13075CB3AA495AA2495A133F017EC7FC485AEA07F0EAFF +C000FCC8FC205B7AC32D>I<126012F0B3B3B3B3B11260045B76C319>106 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fb cmbx12 12 41 +/Fb 41 122 df45 DII49 +DII<163FA25E5E5D5DA25D5D5D5D +A25D92B5FCEC01F7EC03E7140715C7EC0F87EC1F07143E147E147C14F8EB01F0EB03E013 +0714C0EB0F80EB1F00133E5BA25B485A485A485A120F5B48C7FC123E5A12FCB91280A5C8 +000F90C7FCAC027FB61280A531417DC038>I<0007150301E0143F01FFEB07FF91B6FC5E +5E5E5E5E16804BC7FC5D15E092C8FC01C0C9FCAAEC3FF001C1B5FC01C714C001DF14F090 +39FFE03FFC9138000FFE01FC6D7E01F06D13804915C0497F6C4815E0C8FC6F13F0A317F8 +A4EA0F80EA3FE0487E12FF7FA317F05B5D6C4815E05B007EC74813C0123E003F4A1380D8 +1FC0491300D80FF0495AD807FEEBFFFC6CB612F0C65D013F1480010F01FCC7FC010113C0 +2D427BC038>I<4AB47E021F13F0027F13FC49B6FC01079038807F8090390FFC001FD93F +F014C04948137F4948EBFFE048495A5A1400485A120FA248486D13C0EE7F80EE1E00003F +92C7FCA25B127FA2EC07FC91381FFF8000FF017F13E091B512F89039F9F01FFC9039FBC0 +07FE9039FF8003FF17804A6C13C05B6F13E0A24915F0A317F85BA4127FA5123FA217F07F +121FA2000F4A13E0A26C6C15C06D4913806C018014006C6D485A6C9038E01FFC6DB55A01 +1F5C010714C0010191C7FC9038003FF02D427BC038>I<121E121F13FC90B712FEA45A17 +FC17F817F017E017C0A2481680007EC8EA3F00007C157E5E00785D15014B5A00F84A5A48 +4A5A5E151FC848C7FC157E5DA24A5A14035D14074A5AA2141F5D143FA2147F5D14FFA25B +A35B92C8FCA35BA55BAA6D5A6D5A6D5A2F447AC238>I67 DIII72 DI< +B76C0103B512F8A526003FFEC93807E0004F5A4F5A077EC7FC614E5A4E5A4E5AF01F804E +C8FC187E604D5AEF07F0EF0FC04D5A4DC9FC177E4C5AEE03F04C5A4C5A4C7EEE7FF04C7E +5D4B7F4B7F4B7FED3F3FDB7E1F7F03FC806E486C7F4B7E4B6C7F0380804B6C7F4A7F717E +84717F83717F85717F83717F85717F187F727E86727F84727F86727F84B76C90B612FCA5 +4E447CC358>75 D +78 D<923807FFC092B512FE0207ECFFC0021F15F091267FFE0013FC902601FFF0EB1FFF +01070180010313C04990C76C7FD91FFC6E6C7E49486F7E49486F7E01FF8348496F7E4849 +6F1380A248496F13C0A24890C96C13E0A24819F04982003F19F8A3007F19FC49177FA400 +FF19FEAD007F19FC6D17FFA3003F19F8A26D5E6C19F0A26E5D6C19E0A26C6D4B13C06C19 +806E5D6C6D4B13006C6D4B5A6D6C4B5A6D6C4B5A6D6C4A5B6D01C001075B6D01F0011F5B +010101FE90B5C7FC6D90B65A023F15F8020715C002004AC8FC030713C047467AC454>I< +B812F8EFFFC018F818FE727ED8001F90C7003F13E005037F05007F727E727E727EA28684 +A286A762A24E90C7FCA24E5A61187F943801FFF005075B053F138092B7C8FC18F818E018 +F892C77FEF3FFF050F7F717F717FA2717FA2717FA785A61B0F85A2187F73131F72141EB7 +00E06DEB803E72EBE0FC72EBFFF8060114F0726C13E0CC0007138050457DC354>82 +D<003FBA12E0A59026FE000FEB8003D87FE09338003FF049171F90C71607A2007E180300 +7C1801A300781800A400F819F8481978A5C81700B3B3A20107B8FCA545437CC24E>84 +DI<903801FFE0011F13 +FE017F6D7E48B612E03A03FE007FF84848EB1FFC6D6D7E486C6D7EA26F7FA36F7F6C5A6C +5AEA00F090C7FCA40203B5FC91B6FC1307013F13F19038FFFC01000313E0000F1380381F +FE00485A5B127F5B12FF5BA35DA26D5B6C6C5B4B13F0D83FFE013EEBFFC03A1FFF80FC7F +0007EBFFF86CECE01FC66CEB8007D90FFCC9FC322F7DAD36>97 DI +100 DI< +DAFFE0137E010F9039FE03FF80013FEBFF8F90B812C048D9C07F133F489038001FF84848 +EB0FFC4848903907FE1F80001F9238FF0F00496D90C7FCA2003F82A8001F93C7FCA26D5B +000F5D6C6C495A6C6C495A6C9038C07FF04890B55A1680D8078F49C8FC018013E0000F90 +CAFCA47F7F7F90B612C016FC6CEDFF8017E06C826C16FC7E000382000F82D81FF0C77ED8 +3FC014074848020113808248C9FC177FA46D15FF007F17006D5C6C6C4A5A6C6C4A5AD80F +FEEC3FF83B07FFC001FFF0000190B612C06C6C92C7FC010F14F8D9007F90C8FC32427DAC +38>103 D<137C48B4FC4813804813C0A24813E0A56C13C0A26C13806C1300EA007C90C7 +FCAAEB7FC0EA7FFFA512037EB3AFB6FCA518467CC520>105 D108 D<90277F8007FEEC0FFCB590263FFFC090387FFF80 +92B5D8F001B512E002816E4880913D87F01FFC0FE03FF8913D8FC00FFE1F801FFC0003D9 +9F009026FF3E007F6C019E6D013C130F02BC5D02F86D496D7EA24A5D4A5DA34A5DB3A7B6 +0081B60003B512FEA5572D7CAC5E>I<90397F8007FEB590383FFF8092B512E0028114F8 +913987F03FFC91388F801F000390399F000FFE6C139E14BC02F86D7E5CA25CA35CB3A7B6 +0083B512FEA5372D7CAC3E>II<90397FC00FF8B590B57E02C314E002CF14F89139DFC03FFC9139FF001FFE000301FC +EB07FF6C496D13804A15C04A6D13E05C7013F0A2EF7FF8A4EF3FFCACEF7FF8A318F017FF +A24C13E06E15C06E5B6E4913806E4913006E495A9139DFC07FFC02CFB512F002C314C002 +C091C7FCED1FF092C9FCADB67EA536407DAC3E>I<90387F807FB53881FFE0028313F002 +8F13F8ED8FFC91389F1FFE000313BE6C13BC14F8A214F0ED0FFC9138E007F8ED01E092C7 +FCA35CB3A5B612E0A5272D7DAC2E>114 D<90391FFC038090B51287000314FF120F381F +F003383FC00049133F48C7121F127E00FE140FA215077EA27F01E090C7FC13FE387FFFF0 +14FF6C14C015F06C14FC6C800003806C15806C7E010F14C0EB003F020313E0140000F014 +3FA26C141F150FA27EA26C15C06C141FA26DEB3F8001E0EB7F009038F803FE90B55A00FC +5CD8F03F13E026E007FEC7FC232F7CAD2C>IIIIIII +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fc cmtt10 10.95 94 +/Fc 94 127 df<121C127FEAFF80B3EA7F00B2123EC7FCA8121C127FA2EAFF80A3EA7F00 +A2121C09396DB830>33 D<00101304007C131F00FEEB3F80A26C137FA248133FB2007E14 +00007C7F003C131E00101304191C75B830>I<903907C007C0A2496C487EA8011F131FA2 +02C05BA3007FB7FCA2B81280A36C16006C5D3A007F807F80A2020090C7FCA9495BA2003F +90B512FE4881B81280A36C1600A22701FC01FCC7FCA300031303A201F85BA76C486C5AA2 +29387DB730>I<1438147C14FCA4EB03FF011F13E090B512FC4880000780481580261FFE +FD13C09039F0FC3FE0D83FC0131FD87F80EB0FF001001307007E15F800FE14035A1507A3 +6CEC03F0A2007F91C7FC138013C0EA3FF0EA1FFE13FF6C13FF6C14E0000114F86C6C7F01 +1F7F01037F0100148002FD13C09138FC7FE0151FED0FF015070018EC03F8127E1501B4FC +A35AA26CEC03F07E01801307ED0FE0D83FC0131F01F0EB7FC0D81FFEB512806CB612006C +5C6C5CC614F0013F13C0D907FEC7FCEB00FCA5147C143825477BBE30>II +II<141E147F14FF5BEB03 +FEEB07FCEB0FF0EB1FE0EB3FC0EB7F80EBFF00485A5B12035B485A120F5BA2485AA2123F +5BA2127F90C7FCA412FEAD127FA47F123FA27F121FA26C7EA27F12076C7E7F12017F6C7E +EB7F80EB3FC0EB1FE0EB0FF0EB07FCEB03FEEB01FF7F147F141E184771BE30>I<127812 +FE7E7F6C7E6C7EEA0FF06C7E6C7E6C7E6C7EEB7F80133F14C0131FEB0FE014F01307A2EB +03F8A214FC1301A214FE1300A4147FAD14FEA4130114FCA2130314F8A2EB07F0A2130F14 +E0EB1FC0133F1480137FEBFF00485A485A485A485AEA3FE0485A485A90C7FC5A12781847 +78BE30>I<14E0497E497EA60038EC0380007EEC0FC0D8FF83EB3FE001C3137F9038F3F9 +FF267FFBFB13C06CB61280000FECFE00000314F86C5C6C6C13C0011F90C7FC017F13C048 +B512F04880000F14FE003FECFF80267FFBFB13C026FFF3F913E09038C3F87F0183133FD8 +7E03EB0FC00038EC0380000091C7FCA66D5A6D5A23277AAE30>I<143EA2147FAF007FB7 +FCA2B81280A36C1600A2C76CC8FCAF143EA229297DAF30>II<007FB612F0A2B712F8A36C15F0A225077B9E30>I<120F +EA3FC0EA7FE0A2EAFFF0A4EA7FE0A2EA3FC0EA0F000C0C6E8B30>I<16F01501ED03F8A2 +1507A2ED0FF0A2ED1FE0A2ED3FC0A2ED7F80A2EDFF00A24A5AA25D1403A24A5AA24A5AA2 +4A5AA24A5AA24A5AA24AC7FCA2495AA25C1303A2495AA2495AA2495AA2495AA2495AA249 +C8FCA2485AA25B1203A2485AA2485AA2485AA2485AA2485AA248C9FCA25AA2127CA22547 +7BBE30>I<14FE903807FFC0497F013F13F8497F90B57E48EB83FF4848C6138049137F48 +48EB3FC04848EB1FE049130F001F15F0491307A24848EB03F8A290C712014815FCA400FE +EC00FEAD6C14016C15FCA36D1303003F15F8A26D1307001F15F0A26D130F6C6CEB1FE0A2 +6C6CEB3FC06C6CEB7F806D13FF2601FF8313006CEBFFFE6D5B6D5B010F13E06D5BD900FE +C7FC273A7CB830>IIIII<000FB6128048 +15C05AA316800180C8FCAEEB83FF019F13C090B512F015FC8181D9FE0313809039F0007F +C049133F0180EB1FE06CC7120F000E15F0C81207A216F81503A31218127EA2B4FC150716 +F048140F6C15E06C141F6DEB3FC06D137F3A3FE001FF80261FFC0F13006CB55A6C5C6C5C +6C14E06C6C1380D90FFCC7FC25397BB730>II<127CB712FC16FEA416FC48C7EA +0FF816F0ED1FE0007CEC3FC0C8EA7F80EDFF00A24A5A4A5A5D14075D140F5D4A5AA24A5A +A24AC7FCA25C5C13015CA213035CA213075CA4495AA6131F5CA96D5A6DC8FC273A7CB830 +>I<49B4FC011F13F0017F13FC90B57E0003ECFF804815C048010113E03A1FF8003FF049 +131FD83FC0EB07F8A24848EB03FC90C71201A56D1303003F15F86D13076C6CEB0FF06C6C +EB1FE0D807FCEB7FC03A03FF83FF806C90B512006C6C13FC011F13F0497F90B512FE4880 +2607FE0013C0D80FF8EB3FE0D81FE0EB0FF04848EB07F8491303007F15FC90C712014815 +FE481400A66C14016C15FC6D1303003F15F86D1307D81FF0EB1FF06D133F3A0FFF01FFE0 +6C90B512C06C1580C6ECFE006D5B011F13F0010190C7FC273A7CB830>I<49B4FC010F13 +E0013F13F890B57E4880488048010113803A0FFC007FC0D81FF0EB3FE04848131F49EB0F +F048481307A290C7EA03F85A4815FC1501A416FEA37E7E6D1303A26C6C13076C6C130F6D +133FD80FFC13FF6CB6FC7E6C14FE6C14F9013FEBE1FC010F138190380060011400ED03F8 +A2150716F0150F000F15E0486C131F486CEB3FC0157FEDFF804A1300EC07FE391FF01FFC +90B55A6C5C6C5C6C1480C649C7FCEB3FF0273A7CB830>I<120FEA3FC0EA7FE0A2EAFFF0 +A4EA7FE0A2EA3FC0EA0F00C7FCAF120FEA3FC0EA7FE0A2EAFFF0A4EA7FE0A2EA3FC0EA0F +000C276EA630>II<16F01503ED07F8151F157FEDFFF0 +14034A13C0021F138091383FFE00ECFFF8495B010713C0495BD93FFEC7FC495A3801FFF0 +485B000F13804890C8FCEA7FFC5BEAFFE05B7FEA7FF87FEA1FFF6C7F000313E06C7F3800 +7FFC6D7E90380FFF806D7F010113F06D7FEC3FFE91381FFF80020713C06E13F01400ED7F +F8151F1507ED03F01500252F7BB230>I<007FB7FCA2B81280A36C16006C5DCBFCA7003F +B612FE4881B81280A36C1600A229157DA530>I<1278127EB4FC13C07FEA7FF813FEEA1F +FF6C13C000037F6C13F86C6C7EEB1FFF6D7F010313E06D7F9038007FFC6E7E91380FFF80 +6E13C0020113F080ED3FF8151F153FEDFFF05C020713C04A138091383FFE004A5A903801 +FFF0495B010F13804990C7FCEB7FFC48485A4813E0000F5B4890C8FCEA7FFE13F8EAFFE0 +5B90C9FC127E1278252F7BB230>III<147F4A7EA2497FA4497F14F7A401077F14E3A301 +0F7FA314C1A2011F7FA490383F80FEA590387F007FA4498049133F90B6FCA34881A39038 +FC001F00038149130FA4000781491307A2D87FFFEB7FFFB56CB51280A46C496C13002939 +7DB830>I<007FB512F0B612FE6F7E82826C813A03F8001FF815076F7E1501A26F7EA615 +015EA24B5A1507ED1FF0ED7FE090B65A5E4BC7FC6F7E16E0829039F8000FF8ED03FC6F7E +1500167FA3EE3F80A6167F1700A25E4B5A1503ED1FFC007FB6FCB75A5E16C05E6C02FCC7 +FC29387EB730>I<91387F803C903903FFF03E49EBFC7E011F13FE49EBFFFE5B9038FFE0 +7F48EB801F3903FE000F484813075B48481303A2484813015B123F491300A2127F90C8FC +167C16005A5AAC7E7EA2167C6D14FE123FA27F121F6D13016C6C14FCA26C6CEB03F86D13 +076C6CEB0FF03901FF801F6C9038E07FE06DB512C06D14806D1400010713FC6D13F09038 +007FC0273A7CB830>I<003FB512E04814FCB67E6F7E6C816C813A03F8007FF0ED1FF815 +0F6F7E6F7E15016F7EA2EE7F80A2163F17C0161FA4EE0FE0AC161F17C0A3163F1780A216 +7F17005E4B5A15034B5A150F4B5AED7FF0003FB65A485DB75A93C7FC6C14FC6C14E02B38 +7FB730>I<007FB7FCB81280A47ED803F8C7123FA8EE1F0093C7FCA4157C15FEA490B5FC +A6EBF800A4157C92C8FCA5EE07C0EE0FE0A9007FB7FCB8FCA46C16C02B387EB730>I<00 +3FB712804816C0B8FCA27E7ED801FCC7121FA8EE0F8093C7FCA5153E157FA490B6FCA690 +38FC007FA4153E92C8FCAE383FFFF8487FB5FCA27E6C5B2A387EB730>I<02FF13F00103 +EBC0F8010F13F1013F13FD4913FF90B6FC4813C1EC007F4848133F4848131F49130F485A +491307121F5B123F491303A2127F90C7FC6F5A92C8FC5A5AA892B5FC4A14805CA26C7F6C +6D1400ED03F8A27F003F1407A27F121F6D130F120F7F6C6C131FA2D803FE133F6C6C137F +ECC1FF6C90B5FC7F6D13FB010F13F30103EBC1F0010090C8FC293A7DB830>I<3B3FFF80 +0FFFE0486D4813F0B56C4813F8A26C496C13F06C496C13E0D803F8C7EAFE00B290B6FCA6 +01F8C7FCB3A23B3FFF800FFFE0486D4813F0B56C4813F8A26C496C13F06C496C13E02D38 +7FB730>I<007FB6FCB71280A46C1500260007F0C7FCB3B3A8007FB6FCB71280A46C1500 +213879B730>I<49B512F04914F85BA27F6D14F090C7EAFE00B3B3123C127EB4FCA24A5A +1403EB8007397FF01FF86CB55A5D6C5C00075C000149C7FC38003FF025397AB730>II<383FFFF8487FB57EA26C5B6C5BD801FCC9FCB3B0EE0F80EE1FC0A9003FB7FC5AB8 +FCA27E6C16802A387EB730>III<90383FFFE048B512FC000714FF4815804815C04815 +E0EBF80001E0133FD87F80EB0FF0A290C71207A44815F8481403B3A96C1407A26C15F0A3 +6D130FA26D131F6C6CEB3FE001F813FF90B6FC6C15C06C15806C1500000114FCD8003F13 +E0253A7BB830>I<007FB512F0B612FE6F7E16E0826C813903F8003FED0FFCED03FE1501 +6F7EA2821780163FA6167F17005EA24B5A1503ED0FFCED3FF890B6FC5E5E16804BC7FC15 +F001F8C9FCB0387FFFC0B57EA46C5B29387EB730>I<90383FFFE048B512FC000714FF48 +15804815C04815E0EBF80001E0133F4848EB1FF049130F90C71207A44815F8481403B3A8 +147E14FE6CEBFF076C15F0EC7F87A2EC3FC7018013CF9038C01FFFD83FE014E0EBF80F90 +B6FC6C15C06C15806C1500000114FCD8003F7FEB00016E7EA21680157F16C0153F16E015 +1F16F0150FED07E025467BB830>I<003FB57E4814F0B612FC15FF6C816C812603F8017F +9138003FF0151F6F7E15071503821501A515035E1507150F4B5A153F4AB45A90B65A5E93 +C7FC5D8182D9F8007FED3FE0151F150F821507A817F8EEF1FCA53A3FFF8003FB4801C0EB +FFF8B56C7E17F06C496C13E06C49EB7FC0C9EA1F002E397FB730>I<90390FF803C0D97F +FF13E048B512C74814F74814FF5A381FF80F383FE001497E4848137F90C7123F5A48141F +A2150FA37EED07C06C91C7FC7F7FEA3FF0EA1FFEEBFFF06C13FF6C14E0000114F86C8001 +1F13FF01031480D9003F13C014019138007FE0151FED0FF0A2ED07F8A2007C140312FEA5 +6C140716F07F6DEB0FE06D131F01F8EB3FC001FF13FF91B51280160000FD5CD8FC7F13F8 +D8F81F5BD878011380253A7BB830>I<003FB712C04816E0B8FCA43AFE003F800FA8007C +ED07C0C791C7FCB3B1011FB5FC4980A46D91C7FC2B387EB730>I<3B7FFFC007FFFCB56C +4813FEA46C496C13FCD803F8C7EA3F80B3B16D147F00011600A36C6C14FE6D13016D5CEC +800390393FE00FF890391FF83FF06DB55A6D5C6D5C6D91C7FC9038007FFCEC1FF02F3980 +B730>III<3A3FFF01FF +F84801837F02C77FA202835B6C01015B3A01FC007F806D91C7FC00005C6D5BEB7F01EC81 +FCEB3F8314C3011F5B14E7010F5B14FF6D5BA26D5BA26D5BA26D90C8FCA4497FA2497FA2 +815B81EB0FE781EB1FC381EB3F8181EB7F0081497F49800001143F49800003141F498000 +07140FD87FFEEB7FFFB590B5128080A25C6C486D130029387DB730>II<001FB612 +FC4815FE5AA490C7EA03FCED07F816F0150FED1FE016C0153FED7F80003E1500C85A4A5A +5D14034A5A5D140F4A5A5D143F4A5A92C7FC5C495A5C1303495A5C130F495A5C133F495A +91C8FC5B4848147C4914FE1203485A5B120F485A5B123F485A90B6FCB7FCA46C15FC2738 +7CB730>I<007FB5FCB61280A4150048C8FCB3B3B3A5B6FC1580A46C140019476DBE30>I< +127CA212FEA27EA26C7EA26C7EA26C7EA26C7EA26C7EA26C7EA212017FA26C7EA26D7EA2 +6D7EA26D7EA26D7EA26D7EA26D7EA2130180A26D7EA26E7EA26E7EA26E7EA26E7EA26E7E +A26E7EA2140181A26E7EA2ED7F80A2ED3FC0A2ED1FE0A2ED0FF0A2ED07F8A21503A2ED01 +F0150025477BBE30>I<007FB5FCB61280A47EC7123FB3B3B3A5007FB5FCB6FCA46C1400 +19477DBE30>I<1307EB1FC0EB7FF0497E000313FE000FEBFF80003F14E0D87FFD13F039 +FFF07FF8EBC01FEB800F38FE0003007CEB01F00010EB00401D0E77B730>I<007FB612F0 +A2B712F8A36C15F0A225077B7D30>I<1338137CEA01FE12031207EA0FFC13F0EA1FE013 +C0EA3F8013005A127EA212FE5AA5EAFFC013E013F0127FA2123FA2EA1FE0EA07C00F1D70 +BE30>IIII<913801FFE04A7F5CA28080EC0007AAEB03FE90381FFF874913E790B6FC5A +5A481303380FFC00D81FF0133F49131F485A150F4848130790C7FCA25AA25AA87E6C140F +A27F003F141F6D133F6C7E6D137F390FF801FF2607FE07EBFFC06CB712E06C16F06C14F7 +6D01C713E0011F010313C0D907FCC8FC2C397DB730>I<49B4FC010713E0011F13F8017F +7F90B57E488048018113803A07FC007FC04848133FD81FE0EB1FE0150F484814F0491307 +127F90C7FCED03F85A5AB7FCA516F048C9FC7E7EA27F003FEC01F06DEB03F86C7E6C7E6D +1307D807FEEB1FF03A03FFC07FE06C90B5FC6C15C0013F14806DEBFE00010713F8010013 +C0252A7CA830>IIII<14E0EB03F8A2497EA36D5AA2EB00E091C8FCA9381FFF +F8487F5AA27E7EEA0001B3A9003FB612C04815E0B7FCA27E6C15C023397AB830>III<387FFFF8B57EA47EEA0001B3B3A8007F +B612F0B712F8A46C15F025387BB730>I<02FC137E3B7FC3FF01FF80D8FFEF01877F90B5 +00CF7F15DF92B57E6C010F13872607FE07EB03F801FC13FE9039F803FC01A201F013F8A3 +01E013F0B3A23C7FFE0FFF07FF80B548018F13C0A46C486C01071380322881A730>II<49B4FC010F13E0013F13F8497F90B57E0003ECFF8014 +013A07FC007FC04848EB3FE0D81FE0EB0FF0A24848EB07F8491303007F15FC90C71201A3 +00FEEC00FEA86C14016C15FCA26D1303003F15F86D13076D130F6C6CEB1FF06C6CEB3FE0 +6D137F3A07FF01FFC06C90B512806C15006C6C13FC6D5B010F13E0010190C7FC272A7CA8 +30>II<49B413F8010FEBC1 +FC013F13F14913FD48B6FC5A481381390FFC007F49131F4848130F491307485A49130312 +7F90C7FC15015A5AA77E7E15037FA26C6C1307150F6C6C131F6C6C133F01FC137F3907FF +01FF6C90B5FC6C14FD6C14F9013F13F1010F13C1903803FE0190C7FCAD92B512F84A14FC +A46E14F82E3C7DA730>II<90381FFC1E48B5129F000714FF5A5A5A387FF0 +07EB800100FEC7FC4880A46C143E007F91C7FC13E06CB4FC6C13FC6CEBFF806C14E00001 +14F86C6C7F01037F9038000FFF02001380007C147F00FEEC1FC0A2150F7EA27F151F6DEB +3F806D137F9039FC03FF0090B6FC5D5D00FC14F0D8F83F13C026780FFEC7FC222A79A830 +>III<3B3FFFC07FFF80486DB512C0B515E0A26C16C06C496C1380 +3B01F80003F000A26D130700005DA26D130F017E5CA2017F131F6D5CA2EC803F011F91C7 +FCA26E5A010F137EA2ECE0FE01075BA214F101035BA3903801FBF0A314FF6D5BA36E5A6E +5A2B277EA630>I<3B3FFFC01FFFE0486D4813F0B515F8A26C16F06C496C13E0D807E0C7 +EA3F00A26D5C0003157EA56D14FE00015DEC0F80EC1FC0EC3FE0A33A00FC7FF1F8A2147D +A2ECFDF9017C5C14F8A3017E13FBA290393FF07FE0A3ECE03FA2011F5C90390F800F802D +277FA630>I<3A3FFF81FFFC4801C37FB580A26C5D6C01815BC648C66CC7FC137FEC80FE +90383F81FC90381FC3F8EB0FE3ECE7F06DB45A6D5B7F6D5B92C8FC147E147F5C497F8190 +3803F7E0EB07E790380FE3F0ECC1F890381F81FC90383F80FE90387F007E017E137F01FE +6D7E48486D7E267FFF80B5FCB500C1148014E3A214C16C0180140029277DA630>I<3B3F +FFC07FFF80486DB512C0B515E0A26C16C06C496C13803B01FC0003F000A2000014076D5C +137E150F017F5C7F151FD91F805BA214C0010F49C7FCA214E00107137EA2EB03F0157C15 +FCEB01F85DA2EB00F9ECFDF0147D147FA26E5AA36E5AA35DA2143F92C8FCA25C147EA200 +0F13FE486C5AEA3FC1EBC3F81387EB8FF0EBFFE06C5B5C6C90C9FC6C5AEA01F02B3C7EA6 +30>I<001FB612FC4815FE5AA316FC90C7EA0FF8ED1FF0ED3FE0ED7FC0EDFF80003E4913 +00C7485A4A5A4A5A4A5A4A5A4A5A4A5A4990C7FC495A495A495A495A495A495A4948133E +4890C7127F485A485A485A485A485A48B7FCB8FCA46C15FE28277DA630>II<127CA212FEB3B3B3AD127CA207476CBE30>II<017C133848B4137C48EB80FE4813C14813C348EBEFFC397FEFFF +F0D8FF8713E0010713C0486C1380D87C0113003838007C1F0C78B730>I +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fd cmti9 9 16 +/Fd 16 119 df<121C127F12FFA412FE12380808778718>46 D64 D<0107B612C04915F017FC903A003F8001FEEE007FEF1F80 +92C7EA0FC0EF07E05CEF03F0147E170102FE15F8A25CA21301A25CA2130317035CA21307 +18F04A1407A2130F18E04A140F18C0011F151F18805CEF3F00133F177E91C85AA2494A5A +4C5A017E4A5A4C5A01FE4A5A047EC7FC49495A0001EC0FF8007FB612E0B7C8FC15F83533 +7BB23A>68 D<0107B612C04915F883903A003F8001FEEE003FEF1F8092C713C0170F5C18 +E0147EA214FEEF1FC05CA201011680173F4A1500177E010315FE5F4AEB03F8EE07E00107 +EC3FC091B6C7FC16F802E0C9FC130FA25CA2131FA25CA2133FA291CAFCA25BA2137EA213 +FEA25B1201387FFFF0B5FCA233337CB234>80 D87 +D97 D<14FCEB07FF90381F078090383E03C0EBFC013801F8033803F0073807E0 +0F13C0120F391F80070091C7FC48C8FCA35A127EA312FE5AA4007C14C0EC01E0A2EC03C0 +6CEB0F80EC1F006C137C380F81F03803FFC0C648C7FC1B2278A023>99 +D101 +D<143FECFF80903803E1E6903807C0FF90380F807FEB1F00133E017E133F49133EA24848 +137EA24848137CA215FC12074913F8A21401A2D80FC013F0A21403120715E01407140F14 +1F3903E03FC00001137FEBF0FF38007FCF90381F0F801300141FA21500A25C143E123800 +7E137E5C00FE5B48485A387803E0387C0F80D81FFFC7FCEA07F820317CA023>103 +D105 +D<133FEA07FF5A13FEEA007EA3137CA213FCA213F8A21201A213F0A21203A213E0A21207 +A213C0A2120FA21380A2121FA21300A25AA2123EA2127EA2127C1318EAFC1C133CEAF838 +A21378137012F013F0EAF8E01279EA3FC0EA0F00103579B314>108 +D<2703C003F8137F3C0FF00FFE01FFC03C1E783C1F07C1E03C1C7CF00F8F01F03B3C3DE0 +079E0026383FC001FC7FD97F805B007001005B5E137ED8F0FC90380FC00100E05FD860F8 +148012000001021F130360491400A200034A13076049013E130FF081800007027EEC83C0 +051F138049017C1403A2000F02FC1407053E130049495CEF1E0E001F01015D183C010049 +EB0FF0000E6D48EB03E03A227AA03F>I<3903C007F0390FF01FFC391E787C1E391C7CF0 +1F393C3DE00F26383FC01380EB7F8000781300EA707EA2D8F0FC131F00E01500EA60F812 +0000015C153E5BA20003147E157C4913FCEDF8180007153C0201133801C013F0A2000F15 +78EDE070018014F016E0001FECE1C015E390C7EAFF00000E143E26227AA02B>I<14FCEB +07FF90381F07C090383E03E09038FC01F0EA01F83903F000F8485A5B120F484813FCA248 +C7FCA214014814F8127EA2140300FE14F05AA2EC07E0A2007CEB0FC01580141FEC3F006C +137E5C381F01F0380F83E03803FF80D800FCC7FC1E2278A027>I115 D<01F01338D803FC13FCEA0F1E120E121C123C +0038147CEA783E0070143CA2137ED8F07C1338EA60FCC65A1578000114705BA215F00003 +14E05BA2EC01C0A2EBC003158014071500EBE00EA26C6C5A3800F878EB7FE0EB1F801E22 +7AA023>118 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fe cmr9 9 23 +/Fe 23 117 df<123C127EB4FCA21380A2127F123D1201A412031300A25A1206120E120C +121C5A5A126009177A8715>44 D<15E0A34A7EA24A7EA34A7EA3EC0DFE140CA2EC187FA3 +4A6C7EA202707FEC601FA202E07FECC00FA2D901807F1507A249486C7EA301066D7EA201 +0E80010FB5FCA249800118C77EA24981163FA2496E7EA3496E7EA20001821607487ED81F +F04A7ED8FFFE49B512E0A333367DB53A>65 D67 +D69 DIII78 D82 D<90381FE00390387FFC0748 +B5FC3907F01FCF390F8003FF48C7FC003E80814880A200788000F880A46C80A27E92C7FC +127F13C0EA3FF013FF6C13F06C13FF6C14C06C14F0C680013F7F01037F9038003FFF1403 +02001380157F153FED1FC0150F12C0A21507A37EA26CEC0F80A26C15006C5C6C143E6C14 +7E01C05B39F1FC03F800E0B512E0011F138026C003FEC7FC22377CB42B>I97 D99 D<153FEC0FFFA3EC007F81AEEB07F0EB3FFCEBFC0F3901F003 +BF3907E001FF48487E48487F8148C7FCA25A127E12FEAA127E127FA27E6C6C5BA26C6C5B +6C6C4813803A03F007BFFC3900F81E3FEB3FFCD90FE0130026357DB32B>II<151F90391FC07F809039FFF8E3C039 +01F07FC73907E03F033A0FC01F83809039800F8000001F80EB00074880A66C5CEB800F00 +0F5CEBC01F6C6C48C7FCEBF07C380EFFF8380C1FC0001CC9FCA3121EA2121F380FFFFEEC +FFC06C14F06C14FC4880381F0001003EEB007F4880ED1F8048140FA56C141F007C15006C +143E6C5C390FC001F83903F007E0C6B51280D91FFCC7FC22337EA126>103 +DII108 D<3903F01FC000FFEB7FF09038 +F1E0FC9038F3807C3907F7007EEA03FE497FA25BA25BB3486CEB7F80B538C7FFFCA32621 +7EA02B>110 DI<3903F03F +8000FFEBFFE09038F3C0F89038F7007ED807FE7F6C48EB1F804914C049130F16E0ED07F0 +A3ED03F8A9150716F0A216E0150F16C06D131F6DEB3F80160001FF13FC9038F381F89038 +F1FFE0D9F07FC7FC91C8FCAA487EB512C0A325307EA02B>I<3803E07C38FFE1FF9038E3 +8F809038E71FC0EA07EEEA03ECA29038FC0F8049C7FCA35BB2487EB512E0A31A217FA01E +>114 D<1330A51370A313F0A21201A212031207381FFFFEB5FCA23803F000AF1403A814 +073801F806A23800FC0EEB7E1CEB1FF8EB07E0182F7FAD1E>116 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Ff cmsy6 6 1 +/Ff 1 4 df<136013701360A20040132000E0137038F861F0387E67E0381FFF803807FE +00EA00F0EA07FE381FFF80387E67E038F861F038E060700040132000001300A213701360 +14157B9620>3 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fg cmr10 10.95 89 +/Fg 89 124 df<4AB4EB0FE0021F9038E03FFC913A7F00F8FC1ED901FC90383FF03FD907 +F090397FE07F80494801FF13FF4948485BD93F805C137F0200ED7F00EF003E01FE6D91C7 +FC82ADB97EA3C648C76CC8FCB3AE486C4A7E007FD9FC3FEBFF80A339407FBF35>11 +DIII<121EEA7F80EAFFC0A9EA7F80ACEA3F00AC +121EAB120CC7FCA8121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A4179C019>33 +D<001E130F397F803FC000FF137F01C013E0A201E013F0A3007F133F391E600F30000013 +00A401E01370491360A3000114E04913C00003130101001380481303000EEB070048130E +0018130C0038131C003013181C1C7DBE2D>I<4B6C130C4B6C131EA20307143EA24C133C +A2030F147CA293C71278A24B14F8A2031E5CA2033E1301A2033C5CA3037C1303A203785C +A203F81307A24B5CA20201140F007FBAFCBB1280A26C1900C72707C0003EC8FC4B133CA3 +020F147CA292C71278A24A14F8A2021E5CA3023E1301007FBAFCBB1280A26C1900C727F8 +0007C0C8FC4A5CA20101140FA24A91C9FCA301035CA24A131EA20107143EA24A133CA201 +0F147CA291C71278A34914F8A2011E5CA2013E1301A2013C5CA201186D5A41517BBE4C> +I<14E0A4EB07FC90383FFF8090B512E03901F8E3F03903E0E0FCD807C0133CD80F807FD8 +1F007F003E80003C1580007C140316C00078141F00F8143F157FA47EED3F806CEC0E0092 +C7FC127F138013C0EA3FF013FEEA1FFF6C13FC6C13FF6C14C06C806C6C13F8011F7F1303 +01007FECE7FF14E102E01380157F153FED1FC0A2003E140F127FD8FF801307A5130000FC +158000F0140F1270007815005D6C141E153E6C5C6C5C3907C0E1F03903F8EFE0C6B51280 +D93FFEC7FCEB0FF8EB00E0A422497BC32D>I38 +D<121EEA7F8012FF13C0A213E0A3127FEA1E601200A413E013C0A312011380120313005A +120E5A1218123812300B1C79BE19>I<1430147014E0EB01C0EB03801307EB0F00131E13 +3E133C5B13F85B12015B1203A2485AA2120F5BA2121F90C7FCA25AA3123E127EA6127C12 +FCB2127C127EA6123E123FA37EA27F120FA27F1207A26C7EA212017F12007F13787F133E +131E7FEB07801303EB01C0EB00E014701430145A77C323>I<12C07E12707E7E121E7E6C +7E7F12036C7E7F12007F1378137CA27FA2133F7FA21480130FA214C0A3130714E0A61303 +14F0B214E01307A614C0130FA31480A2131F1400A25B133EA25BA2137813F85B12015B48 +5A12075B48C7FC121E121C5A5A5A5A145A7BC323>II<1506150FB3A9007FB912E0BA12F0 +A26C18E0C8000FC9FCB3A915063C3C7BB447>I<121EEA7F8012FF13C0A213E0A3127FEA +1E601200A413E013C0A312011380120313005A120E5A1218123812300B1C798919>II<121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A0A798919>II< +EB01FE90380FFFC090383F03F090387C00F849137C48487F48487F4848EB0F80A2000F15 +C04848EB07E0A3003F15F0A290C712034815F8A64815FCB3A26C15F8A56C6CEB07F0A300 +1F15E0A36C6CEB0FC0A26C6CEB1F80000315006C6C133E6C6C5B017C5B90383F03F09038 +0FFFC0D901FEC7FC263F7DBC2D>IIII<150E151E153EA2157EA215FE1401A21403EC077E1406140E14 +1CA214381470A214E0EB01C0A2EB0380EB0700A2130E5BA25B5BA25B5B1201485A90C7FC +5A120E120C121C5AA25A5AB8FCA3C8EAFE00AC4A7E49B6FCA3283E7EBD2D>I<00061403 +D80780131F01F813FE90B5FC5D5D5D15C092C7FC14FCEB3FE090C9FCACEB01FE90380FFF +8090383E03E090387001F8496C7E49137E497F90C713800006141FC813C0A216E0150FA3 +16F0A3120C127F7F12FFA416E090C7121F12FC007015C012780038EC3F80123C6CEC7F00 +001F14FE6C6C485A6C6C485A3903F80FE0C6B55A013F90C7FCEB07F8243F7CBC2D>II<1238123C123F90B612FCA316F85A16 +F016E00078C712010070EC03C0ED078016005D48141E151C153C5DC8127015F04A5A5D14 +034A5A92C7FC5C141EA25CA2147C147814F8A213015C1303A31307A3130F5CA2131FA613 +3FAA6D5A0107C8FC26407BBD2D>III<121EEA7F80A2EAFF +C0A4EA7F80A2EA1E00C7FCB3121EEA7F80A2EAFFC0A4EA7F80A2EA1E000A2779A619>I< +121EEA7F80A2EAFFC0A4EA7F80A2EA1E00C7FCB3121E127FEAFF80A213C0A4127F121E12 +00A412011380A3120313005A1206120E120C121C5A1230A20A3979A619>I<007FB912E0 +BA12F0A26C18E0CDFCAE007FB912E0BA12F0A26C18E03C167BA147>61 +D63 DI<15074B7EA34B7EA34B7EA34B7EA34B7E15E7A2913801C7FC15C3A291380381 +FEA34AC67EA3020E6D7EA34A6D7EA34A6D7EA34A6D7EA34A6D7EA349486D7E91B6FCA249 +819138800001A249C87EA24982010E157FA2011E82011C153FA2013C820138151FA20178 +82170F13FC00034C7ED80FFF4B7EB500F0010FB512F8A33D417DC044>IIIIIIIII<011FB512FCA3D9000713006E5A1401B3B3A6123FEA7F80EAFFC0A44A5A +1380D87F005B007C130700385C003C495A6C495A6C495A2603E07EC7FC3800FFF8EB3FC0 +26407CBD2F>IIIIIII82 DI<003F +B91280A3903AF0007FE001018090393FC0003F48C7ED1FC0007E1707127C00781703A300 +701701A548EF00E0A5C81600B3B14B7E4B7E0107B612FEA33B3D7DBC42>IIII<007FB5D8C003B512E0A3C649C7EBFC00D93FF8EC3FE06D48EC1F806D6C92C7 +FC171E6D6C141C6D6C143C5F6D6C14706D6D13F04C5ADA7FC05B023F13036F485ADA1FF0 +90C8FC020F5BEDF81E913807FC1C163C6E6C5A913801FF7016F06E5B6F5AA26F7E6F7EA2 +8282153FED3BFEED71FF15F103E07F913801C07F0203804B6C7EEC07004A6D7E020E6D7E +5C023C6D7E02386D7E14784A6D7E4A6D7F130149486E7E4A6E7E130749C86C7E496F7E49 +7ED9FFC04A7E00076DEC7FFFB500FC0103B512FEA33F3E7EBD44>II<003FB712F8A391C7EA1FF013F801E0EC3FE00180EC7F +C090C8FC003EEDFF80A2003C4A1300007C4A5A12784B5A4B5AA200704A5AA24B5A4B5AA2 +C8485A4A90C7FCA24A5A4A5AA24A5AA24A5A4A5AA24A5A4A5AA24990C8FCA2495A494814 +1CA2495A495AA2495A495A173C495AA24890C8FC485A1778485A484815F8A24848140116 +034848140F4848143FED01FFB8FCA32E3E7BBD38>II<486C13C00003130101001380481303000EEB070048130E0018130C +0038131C003013180070133800601330A300E01370481360A400CFEB678039FFC07FE001 +E013F0A3007F133FA2003F131F01C013E0390F0007801C1C73BE2D>II96 +DII< +49B4FC010F13E090383F00F8017C131E4848131F4848137F0007ECFF80485A5B121FA248 +48EB7F00151C007F91C7FCA290C9FC5AAB6C7EA3003FEC01C07F001F140316806C6C1307 +6C6C14000003140E6C6C131E6C6C137890383F01F090380FFFC0D901FEC7FC222A7DA828 +>IIII<167C903903F801FF903A1FFF078F8090397E0FDE1F9038 +F803F83803F001A23B07E000FC0600000F6EC7FC49137E001F147FA8000F147E6D13FE00 +075C6C6C485AA23901F803E03903FE0FC026071FFFC8FCEB03F80006CAFC120EA3120FA2 +7F7F6CB512E015FE6C6E7E6C15E06C810003813A0FC0001FFC48C7EA01FE003E14004815 +7E825A82A46C5D007C153E007E157E6C5D6C6C495A6C6C495AD803F0EB0FC0D800FE017F +C7FC90383FFFFC010313C0293D7EA82D>III<1478EB01FEA2EB +03FFA4EB01FEA2EB00781400AC147FEB7FFFA313017F147FB3B3A5123E127F38FF807E14 +FEA214FCEB81F8EA7F01387C03F0381E07C0380FFF803801FC00185185BD1C>III<2701F801FE14FF00FF902707FFC0 +0313E0913B1E07E00F03F0913B7803F03C01F80007903BE001F87000FC2603F9C06D487F +000101805C01FBD900FF147F91C75B13FF4992C7FCA2495CB3A6486C496CECFF80B5D8F8 +7FD9FC3F13FEA347287DA74C>I<3901F801FE00FF903807FFC091381E07E091387803F0 +00079038E001F82603F9C07F0001138001FB6D7E91C7FC13FF5BA25BB3A6486C497EB5D8 +F87F13FCA32E287DA733>I<14FF010713E090381F81F890387E007E01F8131F4848EB0F +804848EB07C04848EB03E0000F15F04848EB01F8A2003F15FCA248C812FEA44815FFA96C +15FEA36C6CEB01FCA3001F15F86C6CEB03F0A26C6CEB07E06C6CEB0FC06C6CEB1F80D800 +7EEB7E0090383F81FC90380FFFF0010090C7FC282A7EA82D>I<3901FC03FC00FF90381F +FF8091387C0FE09039FDE003F03A07FFC001FC6C496C7E6C90C7127F49EC3F805BEE1FC0 +17E0A2EE0FF0A3EE07F8AAEE0FF0A4EE1FE0A2EE3FC06D1580EE7F007F6E13FE9138C001 +F89039FDE007F09039FC780FC0DA3FFFC7FCEC07F891C9FCAD487EB512F8A32D3A7EA733 +>I<02FF131C0107EBC03C90381F80F090397F00387C01FC131CD803F8130E4848EB0FFC +150748481303121F485A1501485AA448C7FCAA6C7EA36C7EA2001F14036C7E15076C6C13 +0F6C7E6C6C133DD8007E137990383F81F190380FFFC1903801FE0190C7FCAD4B7E92B512 +F8A32D3A7DA730>I<3901F807E000FFEB1FF8EC787CECE1FE3807F9C100031381EA01FB +1401EC00FC01FF1330491300A35BB3A5487EB512FEA31F287EA724>I<90383FC0603901 +FFF8E03807C03F381F000F003E1307003C1303127C0078130112F81400A27E7E7E6D1300 +EA7FF8EBFFC06C13F86C13FE6C7F6C1480000114C0D8003F13E0010313F0EB001FEC0FF8 +00E01303A214017E1400A27E15F07E14016C14E06CEB03C0903880078039F3E01F0038E0 +FFFC38C01FE01D2A7DA824>I<131CA6133CA4137CA213FCA2120112031207001FB512C0 +B6FCA2D801FCC7FCB3A215E0A912009038FE01C0A2EB7F03013F138090381F8700EB07FE +EB01F81B397EB723>IIIIII<001FB61280 +A2EBE0000180140049485A001E495A121C4A5A003C495A141F00385C4A5A147F5D4AC7FC +C6485AA2495A495A130F5C495A90393FC00380A2EB7F80EBFF005A5B4848130712074914 +00485A48485BA248485B4848137F00FF495A90B6FCA221277EA628>II E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fh cmbx10 10.95 43 +/Fh 43 122 df46 D<140F143F5C495A130F48B5FCB6FCA313F7EAFE071200B3B3A8007FB612 +F0A5243C78BB34>49 D<903803FF80013F13F890B512FE00036E7E4881260FF80F7F261F +C0037F4848C67F486C6D7E6D6D7E487E6D6D7EA26F1380A46C5A6C5A6C5A0007C7FCC8FC +4B1300A25E153F5E4B5AA24B5A5E4A5B4A5B4A48C7FC5D4A5AEC1FE04A5A4A5A9139FF00 +0F80EB01FC495A4948EB1F00495AEB1F8049C7FC017E5C5B48B7FC485D5A5A5A5A5AB7FC +5EA4293C7BBB34>I<903801FFE0010F13FE013F6D7E90B612E04801817F3A03FC007FF8 +D807F06D7E82D80FFC131F6D80121F7FA56C5A5E6C48133FD801F05CC8FC4B5A5E4B5A4A +5B020F5B902607FFFEC7FC15F815FEEDFFC0D9000113F06E6C7E6F7E6F7E6F7E1780A26F +13C0A217E0EA0FC0487E487E487E487EA317C0A25D491580127F49491300D83FC0495A6C +6C495A3A0FFE01FFF86CB65A6C5DC61580013F49C7FC010313E02B3D7CBB34>II<00071538D80FE0EB01F801FE13 +3F90B6FC5E5E5E5E93C7FC5D15F85D15C04AC8FC0180C9FCA9ECFFC0018713FC019F13FF +90B67E020113E09039F8007FF0496D7E01C06D7E5B6CC77FC8120F82A31780A21207EA1F +C0487E487E12FF7FA21700A25B4B5A6C5A01805C6CC7123F6D495AD81FE0495A260FFC07 +5B6CB65A6C92C7FCC614FC013F13F0010790C8FC293D7BBB34>II56 +D66 +D<922607FFC0130E92B500FC131E020702FF133E023FEDC07E91B7EAE1FE01039138803F +FB499039F80003FF4901C01300013F90C8127F4948151FD9FFF8150F48491507485B4A15 +03481701485B18004890CAFC197E5A5B193E127FA349170012FFAC127F7F193EA2123FA2 +7F6C187E197C6C7F19FC6C6D16F86C6D150119F06C6D15036C6DED07E0D97FFEED0FC06D +6CED3F80010F01C0ECFF006D01F8EB03FE6D9039FF801FFC010091B55A023F15E0020715 +80020002FCC7FC030713C03F407ABE4C>I69 DI<922607FFC0130E92B500FC +131E020702FF133E023FEDC07E91B7EAE1FE01039138803FFB499039F80003FF4901C013 +00013F90C8127F4948151FD9FFF8150F48491507485B4A1503481701485B18004890CAFC +197E5A5B193E127FA34994C7FC12FFAB0407B612FC127F7FA3003F92C7383FFE00A27F7E +A26C7FA26C7F6C7FA26C7F6C7FD97FFE157F6D6C7E010F01E014FF6D01F813036D9038FF +801F010091B512F3023F15C00207ED803E02009138FE000E030701E090C7FC46407ABE52 +>I73 D75 D78 DII82 D<903A03FFC001C0011FEBF803017FEBFE0748B6128F4815DF +48010013FFD80FF8130F48481303497F4848EB007F127F49143F161F12FF160FA27F1607 +A27F7F01FC91C7FCEBFF806C13F8ECFFC06C14FCEDFF806C15E016F86C816C816C816C16 +806C6C15C07F010715E0EB007F020714F0EC003F1503030013F8167F163F127800F8151F +A2160FA27EA217F07E161F6C16E06D143F01E015C001F8EC7F8001FEEB01FF9026FFE007 +13004890B55A486C14F8D8F81F5CD8F00314C027E0003FFEC7FC2D407ABE3A>I<003FB9 +12FCA5903BFE003FFE003FD87FF0EE0FFE01C0160349160190C71500197E127EA2007C18 +3EA400FC183F48181FA5C81600B3AF010FB712F8A5403D7CBC49>II<903807FFC0013F13F848B6FC48812607FE037F26 +0FF8007F6DEB3FF0486C806F7EA36F7EA26C5A6C5AEA01E0C8FC153F91B5FC130F137F39 +01FFFE0F4813E0000F1380381FFE00485A5B485A12FF5BA4151F7F007F143F6D90387BFF +806C6C01FB13FE391FFF07F36CEBFFE100031480C6EC003FD91FF890C7FC2F2B7DA933> +97 D<13FFB5FCA512077EAFEDFFE0020713FC021FEBFF80027F80DAFF8113F09139FC00 +3FF802F06D7E4A6D7E4A13074A80701380A218C082A318E0AA18C0A25E1880A218005E6E +5C6E495A6E495A02FCEB7FF0903AFCFF01FFE0496CB55AD9F01F91C7FCD9E00713FCC700 +0113C033407DBE3A>IIIII<903A03FF80 +07F0013F9038F83FF8499038FCFFFC48B712FE48018313F93A07FC007FC34848EB3FE100 +1FEDF1FC4990381FF0F81700003F81A7001F5DA26D133F000F5D6C6C495A3A03FF83FF80 +91B5C7FC4814FC01BF5BD80F03138090CAFCA2487EA27F13F06CB6FC16F016FC6C15FF17 +806C16C06C16E01207001F16F0393FE000034848EB003F49EC1FF800FF150F90C81207A5 +6C6CEC0FF06D141F003F16E001F0147FD81FFC903801FFC02707FF800F13006C90B55AC6 +15F8013F14E0010101FCC7FC2F3D7DA834>I105 +D<13FFB5FCA512077EB3B3AFB512FCA5163F7CBE1D>108 D<01FFD91FF8ECFFC0B590B5 +010713F80203DAC01F13FE4A6E487FDA0FE09026F07F077F91261F003FEBF8010007013E +DAF9F0806C0178ECFBC04A6DB4486C7FA24A92C7FC4A5CA34A5CB3A4B5D8FE07B5D8F03F +EBFF80A551297CA858>I<01FFEB1FF8B5EBFFFE02036D7E4A80DA0FE07F91381F007F00 +07013C806C5B4A6D7E5CA25CA35CB3A4B5D8FE0FB512E0A533297CA83A>II<01FFEBFFE0B5000713FC021FEBFF80027F80DA +FF8113F09139FC007FF8000701F06D7E6C496D7E4A130F4A6D7E1880A27013C0A38218E0 +AA4C13C0A318805E18005E6E5C6E495A6E495A02FCEBFFF0DAFF035B92B55A029F91C7FC +028713FC028113C00280C9FCACB512FEA5333B7DA83A>I<3901FE01FE00FF903807FF80 +4A13E04A13F0EC3F1F91387C3FF8000713F8000313F0EBFFE0A29138C01FF0ED0FE09138 +8007C092C7FCA391C8FCB3A2B6FCA525297DA82B>114 D<90383FFC1E48B512BE000714 +FE5A381FF00F383F800148C7FC007E147EA200FE143EA27E7F6D90C7FC13F8EBFFE06C13 +FF15C06C14F06C806C806C806C80C61580131F1300020713C014000078147F00F8143F15 +1F7EA27E16806C143F6D140001E013FF9038F803FE90B55A15F0D8F87F13C026E00FFEC7 +FC222B7DA929>IIIIIII E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fi cmbx12 14.4 33 +/Fi 33 121 df<157815FC14031407141F14FF130F0007B5FCB6FCA2147F13F0EAF800C7 +FCB3B3B3A6007FB712FEA52F4E76CD43>49 DI<9138 +0FFFC091B512FC0107ECFF80011F15E090263FF8077F9026FF800113FC4848C76C7ED803 +F86E7E491680D807FC8048B416C080486D15E0A4805CA36C17C06C5B6C90C75AD801FC16 +80C9FC4C13005FA24C5A4B5B4B5B4B13C04B5BDBFFFEC7FC91B512F816E016FCEEFF80DA +000713E0030113F89238007FFE707E7013807013C018E07013F0A218F8A27013FCA218FE +A2EA03E0EA0FF8487E487E487EB57EA318FCA25E18F891C7FC6C17F0495C6C4816E001F0 +4A13C06C484A1380D80FF84A13006CB44A5A6CD9F0075BC690B612F06D5D011F15800103 +02FCC7FCD9001F1380374F7ACD43>I<177C17FEA2160116031607160FA2161F163F167F +A216FF5D5DA25D5DED1FBFED3F3F153E157C15FCEC01F815F0EC03E01407EC0FC01580EC +1F005C147E147C5C1301495A495A5C495A131F49C7FC133E5B13FC485A5B485A1207485A +485A90C8FC123E127E5ABA12C0A5C96C48C7FCAF020FB712C0A53A4F7CCE43>III<932601FFFCEC01C0047FD9FFC013030307B600F8130703 +3F03FE131F92B8EA803F0203DAE003EBC07F020F01FCC7383FF0FF023F01E0EC0FF94A01 +800203B5FC494848C9FC4901F8824949824949824949824949824990CA7E494883A24849 +83485B1B7F485B481A3FA24849181FA3485B1B0FA25AA298C7FC5CA2B5FCAE7EA280A2F3 +07C07EA36C7FA21B0F6C6D1980A26C1A1F6C7F1C006C6D606C6D187EA26D6C606D6D4C5A +6D6D16036D6D4C5A6D6D4C5A6D01FC4C5A6D6DEE7F806D6C6C6C4BC7FC6E01E0EC07FE02 +0F01FEEC1FF80203903AFFE001FFF0020091B612C0033F93C8FC030715FCDB007F14E004 +0101FCC9FC525479D261>67 D69 DI73 D78 D<93380FFFC00303B6FC031F15E092B712FC0203D9FC0013 +FF020F01C0010F13C0023F90C7000313F0DA7FFC02007F494848ED7FFE4901E0ED1FFF49 +496F7F49496F7F4990C96C7F49854948707F4948707FA24849717E48864A83481B804A83 +481BC0A2481BE04A83A2481BF0A348497113F8A5B51AFCAF6C1BF86E5FA46C1BF0A26E5F +6C1BE0A36C6D4D13C0A26C6D4D1380A26C1B006C6D4D5A6E5E6C626D6C4C5B6D6D4B5B6D +6D4B5B6D6D4B5B6D6D4B5B6D6D4B90C7FC6D6D4B5A6D01FF02035B023F01E0011F13F002 +0F01FC90B512C0020390B7C8FC020016FC031F15E0030392C9FCDB001F13E0565479D265 +>II< +B912F0F0FF8019F819FF1AC0D8000701F0C714F0060F7F060113FE727F737F737F85737F +87A2737FA387A863A2616363A24F5B4F5B4F90C8FC4F5A06035B060F13F095B512C092B8 +C9FC19F819E019F89226F0000313FE9439007FFF80727F727F727F727F727F8684A28684 +A787A71D1C75133EA38575137E73157C7513FC731401B86C6D9038F803F807039038FE07 +F07390B512E0736C14C0080F1400CEEA7FFC5F537CD164>82 D<91260FFF80130791B500 +F85B010702FF5B011FEDC03F49EDF07F9026FFFC006D5A4801E0EB0FFD4801800101B5FC +4848C87E48488149150F001F824981123F4981007F82A28412FF84A27FA26D82A27F7F6D +93C7FC14C06C13F014FF15F86CECFF8016FC6CEDFFC017F06C16FC6C16FF6C17C06C836C +836D826D82010F821303010082021F16801400030F15C0ED007F040714E01600173F050F +13F08383A200788200F882A3187FA27EA219E07EA26CEFFFC0A27F6D4B13806D17006D5D +01FC4B5A01FF4B5A02C04A5A02F8EC7FF0903B1FFFC003FFE0486C90B65AD8FC0393C7FC +48C66C14FC48010F14F048D9007F90C8FC3C5479D24B>I<003FBC1280A59126C0003F90 +38C0007F49C71607D87FF8060113C001E08449197F49193F90C8171FA2007E1A0FA3007C +1A07A500FC1BE0481A03A6C994C7FCB3B3AC91B912F0A553517BD05E>II97 +D<913801FFF8021FEBFF8091B612F0010315FC010F9038C00FFE903A1FFE0001FFD97FFC +491380D9FFF05B4817C048495B5C5A485BA2486F138091C7FC486F1300705A4892C8FC5B +A312FFAD127F7FA27EA2EF03E06C7F17076C6D15C07E6E140F6CEE1F806C6DEC3F006C6D +147ED97FFE5C6D6CEB03F8010F9038E01FF0010390B55A01001580023F49C7FC020113E0 +33387CB63C>99 D<4DB47E0407B5FCA5EE001F1707B3A4913801FFE0021F13FC91B6FC01 +0315C7010F9038E03FE74990380007F7D97FFC0101B5FC49487F4849143F484980485B83 +485B5A91C8FC5AA3485AA412FFAC127FA36C7EA37EA26C7F5F6C6D5C7E6C6D5C6C6D49B5 +FC6D6C4914E0D93FFED90FEFEBFF80903A0FFFC07FCF6D90B5128F0101ECFE0FD9003F13 +F8020301C049C7FC41547CD24B>I<913803FFC0023F13FC49B6FC010715C04901817F90 +3A3FFC007FF849486D7E49486D7E4849130F48496D7E48178048497F18C0488191C7FC48 +17E0A248815B18F0A212FFA490B8FCA318E049CAFCA6127FA27F7EA218E06CEE01F06E14 +037E6C6DEC07E0A26C6DEC0FC06C6D141F6C6DEC3F806D6CECFF00D91FFEEB03FE903A0F +FFC03FF8010390B55A010015C0021F49C7FC020113F034387CB63D>I103 D<137F497E000313E0487FA2487FA76C5BA26C5BC613806DC7FC90C8FCAD +EB3FF0B5FCA512017EB3B3A6B612E0A51B547BD325>105 D108 DII<913801FFE0021F13FE91B612C0010315F0010F9038807FFC903A1FFC000FFED97F +F86D6C7E49486D7F48496D7F48496D7F4A147F48834890C86C7EA24883A248486F7EA300 +7F1880A400FF18C0AC007F1880A3003F18006D5DA26C5FA26C5F6E147F6C5F6C6D4A5A6C +6D495B6C6D495B6D6C495BD93FFE011F90C7FC903A0FFF807FFC6D90B55A010015C0023F +91C8FC020113E03A387CB643>I<903A3FF001FFE0B5010F13FE033FEBFFC092B612F002 +F301017F913AF7F8007FFE0003D9FFE0EB1FFFC602806D7F92C76C7F4A824A6E7F4A6E7F +A2717FA285187F85A4721380AC1A0060A36118FFA2615F616E4A5BA26E4A5B6E4A5B6F49 +5B6F4990C7FC03F0EBFFFC9126FBFE075B02F8B612E06F1480031F01FCC8FC030313C092 +CBFCB1B612F8A5414D7BB54B>I<90397FE003FEB590380FFF80033F13E04B13F09238FE +1FF89139E1F83FFC0003D9E3E013FEC6ECC07FECE78014EF150014EE02FEEB3FFC5CEE1F +F8EE0FF04A90C7FCA55CB3AAB612FCA52F367CB537>114 D<903903FFF00F013FEBFE1F +90B7FC120348EB003FD80FF81307D81FE0130148487F4980127F90C87EA24881A27FA27F +01F091C7FC13FCEBFFC06C13FF15F86C14FF16C06C15F06C816C816C81C681013F158001 +0F15C01300020714E0EC003F030713F015010078EC007F00F8153F161F7E160FA27E17E0 +7E6D141F17C07F6DEC3F8001F8EC7F0001FEEB01FE9039FFC00FFC6DB55AD8FC1F14E0D8 +F807148048C601F8C7FC2C387CB635>I<143EA6147EA414FEA21301A313031307A2130F +131F133F13FF5A000F90B6FCB8FCA426003FFEC8FCB3A9EE07C0AB011FEC0F8080A26DEC +1F0015806DEBC03E6DEBF0FC6DEBFFF86D6C5B021F5B020313802A4D7ECB34>II<007FB500F090387FFFFEA5C66C48C7000F90C7FC6D6CEC07F8 +6D6D5C6D6D495A6D4B5A6F495A6D6D91C8FC6D6D137E6D6D5B91387FFE014C5A6E6C485A +6EEB8FE06EEBCFC06EEBFF806E91C9FCA26E5B6E5B6F7E6F7EA26F7F834B7F4B7F92B5FC +DA01FD7F03F87F4A486C7E4A486C7E020F7FDA1FC0804A486C7F4A486C7F02FE6D7F4A6D +7F495A49486D7F01076F7E49486E7E49486E7FEBFFF0B500FE49B612C0A542357EB447> +120 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fj cmsy8 8 1 +/Fj 1 4 df<130C131EA50060EB01800078130739FC0C0FC0007FEB3F80393F8C7F0038 +07CCF83801FFE038007F80011EC7FCEB7F803801FFE03807CCF8383F8C7F397F0C3F8000 +FCEB0FC039781E078000601301000090C7FCA5130C1A1D7C9E23>3 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fk cmr12 12 16 +/Fk 16 122 df<14FF010713E090381F81F890383E007C01FC133F4848EB1F8049130F48 +48EB07C04848EB03E0A2000F15F0491301001F15F8A2003F15FCA390C8FC4815FEA54815 +FFB3A46C15FEA56D1301003F15FCA3001F15F8A26C6CEB03F0A36C6CEB07E0000315C06D +130F6C6CEB1F806C6CEB3F00013E137C90381F81F8903807FFE0010090C7FC28447CC131 +>48 D50 D<49B4FC010F13E0013F13FC +9038FE01FE3A01F0007F80D803C0EB3FC048C7EA1FE0120EED0FF0EA0FE0486C14F8A215 +077F5BA26C48130FEA03C0C813F0A3ED1FE0A2ED3FC01680ED7F0015FE4A5AEC03F0EC1F +C0D90FFFC7FC15F090380001FCEC007FED3F80ED1FC0ED0FE016F0ED07F816FC150316FE +A2150116FFA3121EEA7F80487EA416FE491303A2007EC713FC00701407003015F8003814 +0F6C15F06CEC1FE06C6CEB3FC0D803E0EB7F803A01FE01FE0039007FFFF8010F13E00101 +90C7FC28447CC131>I<010FB512FEA3D9000313806E130080B3B3AB123F487E487EA44A +5A13801300006C495A00705C6C13076C5C6C495A6CEB1F802603E07FC7FC3800FFFCEB1F +E027467BC332>74 D80 D87 D97 D99 +D101 D105 +D108 +DI<39 +01FC01FE00FF903807FFC091381E07F091383801F8000701707F0003EBE0002601FDC07F +5C01FF147F91C7FCA25BA35BB3A8486CECFF80B5D8F83F13FEA32F2C7DAB36>I<3903F8 +03F000FFEB1FFCEC3C3EEC707F0007EBE0FF3803F9C000015B13FBEC007E153C01FF1300 +5BA45BB3A748B4FCB512FEA3202C7DAB26>114 D117 D121 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fl cmr17 17.28 17 +/Fl 17 118 df67 D70 DI73 D<933801FFE0043F13FF4BB612E0 +03079038003FF8DB1FF0EB03FEDB7FC0903800FF804A48C8EA3FE0DA03FCED0FF0DA0FF0 +ED03FC4A486F7E4A486F7E4A48707E4ACA6C7E4948717E4948717E4948717E4948717E49 +48717E013F854A83017F864948727EA24890CC6C7EA24848737EA24848737EA2000F8749 +1907001F87A34848737EA4007F1C80A24985A400FF1CC0AF6C6C4F1380A5003F1C006D61 +A3001F63A26D190F000F63A26C6C4F5AA36C6C4F5AA26C6D4E5A6C636E18FF017F626D6C +4D90C7FC6E5F011F616D6C4D5A6D6C4D5A0103616E171F6D6C4D5A6D6D4C5ADA3FC04CC8 +FCDA1FF0ED03FE6E6C4B5A6E6C4B5ADA01FFED3FE09126007FC0ECFF80DB1FF0D903FEC9 +FCDB07FFEB3FF8030190B512E0DB003F91CAFC040113E05A667AE367>79 +D<933801FFE0043F13FF4BB612E003079038003FF8DB1FF0EB03FEDB7FC0903800FF804A +48C8EA3FE0DA03FCED0FF0DA0FF8ED07FCDA1FE0ED01FE4A486F7E4A48707E4ACA6C7E49 +48717E4948717E4948717E010F854948717E4948717EA24948717F01FF864A187F4890CC +6C7EA2488749191F00078749190F000F87A2001F87491907A2003F87A24985A2007F1C80 +A44985A200FF1CC0AF007F1C806D61A4003F1C00A36D61001F63A36C6C4F5AA20007636D +191FA26C6C4F5AA26C636C6DDA3F804A5AEFFFE06D6C010301F84A5A6D6C902607C07C49 +90C7FC93380F001E6D6C011E6D495A6D6C6F495A0107021CD903805B6D6C013C6D6C485A +6E0138151F6D6C0300495A6D01806F485ADA3FC04CC8FCDA1FE0ED71FE91260FF83CEC77 +FC912607FC1CEC7FF8912601FF1EEC3FE09126007FDEECFF80DB1FFFD903FEC9FC030790 +38C03FF8030190B56C1560DB003F143C0401EBE01C93C8121EA21DE0191FA3736C13011D +C0741303A274130774130F736CEB1F8074133F9738FF01FF7390B51200A264856485745B +745B745B08071380E001FEC7FC5B807AE367>81 D83 D<003FBC12F8A49126C000 +039038C0000301FCC76C49EB007F01F0190F01C019074848F103FC90C81701007E1A0000 +7C1B7CA300781B3CA400701B1CA600F01B1E481B0EA7C91800B3B3B3A54C7FA2041F13F8 +4AB87EA457627CE160>I97 D<4AB47E020F13F8023F13FE9139FF007F80D903FCEB07E0D907F0EB01F0D91FE0 +EB007849488049488049C87E48485D4915FF00034B138048485CA2485AA2485AA2003F6F +130049EC007C94C7FC127FA35B12FFAD127F7FA4123F7FA2001FEE01C07F000F16036D16 +8012076C6C15076D160000015E6C6C151E6D6C5C6D6C5C6D6C5CD90FF8495AD903FCEB07 +C0903A00FF803F8091263FFFFEC7FC020F13F80201138032417CBF3A>99 +D<181EEF3FFEEE07FFA4EE000F1703A21701B3AAEDFF80020F13F8023F13FE9139FF803F +81903A03FC0007C14948EB01E1D91FE0EB00F94948147D4948143D49C8121F4848150F49 +1507120348481503491501120F121F5BA2123F5B127FA45B12FFAD127F7FA3123FA27F12 +1FA26C6C1503A26C6C150712036D150F6C6C151F0000163D137F6D6CECF9FF6D6CEB01F1 +D90FF0D903C113C06D6CD90F81EBFF80D901FFEB7F019039007FFFFC021F13E002010100 +91C7FC41657CE349>II<133C13FF487F487FA66C5B6C90C7FC133C90C8FCB3A2EB03C0EA07FF127FA4 +1201EA007FA2133FB3B3AC497E497EB612E0A41B5F7DDE23>105 +D107 D<9039078003F8D807FFEB0FFFB501 +3F13C092387C0FE0913881F01F9238E03FF00001EB838039007F8700148FEB3F8E029CEB +1FE0EE0FC00298EB030002B890C7FCA214B014F0A25CA55CB3B0497EEBFFF8B612FCA42C +3F7CBE33>114 D<1438A71478A414F8A31301A31303A21307130F131FA2137F13FF1203 +000F90B6FCB8FCA3260007F8C8FCB3AE17E0AE6D6CEB01C0A316036D6C148016076D6C14 +006E6C5A91383FC01E91381FF07C6EB45A020313E09138007F802B597FD733>116 +DI +E +%EndDVIPSBitmapFont +end +%%EndProlog +%%BeginSetup +%%Feature: *Resolution 600dpi +TeXDict begin +%%PaperSize: A4 + +%%EndSetup +%%Page: 1 1 +1 0 bop 1125 937 a Fl(CFITSIO)44 b(Quic)l(k)h(Start)d(Guide)1625 +1190 y Fk(William)28 b(P)m(ence)2277 1154 y Fj(\003)1666 +1394 y Fk(Jan)m(uary)33 b(2003)120 1916 y Fi(Con)l(ten)l(ts)120 +2120 y Fh(1)84 b(In)m(tro)s(duction)2897 b(2)120 2324 +y(2)84 b(Installing)35 b(and)g(Using)h(CFITSIO)2080 b(3)120 +2528 y(3)84 b(Example)34 b(Programs)2600 b(4)120 2731 +y(4)84 b(CFITSIO)33 b(Routines)2603 b(6)256 2844 y Fg(4.1)94 +b(Error)30 b(Rep)s(orting)24 b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)174 b(6)256 2957 y(4.2)94 +b(File)30 b(Op)s(en/Close)f(Routines)57 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)174 b(6)256 3070 y(4.3)94 b(HDU-lev)m(el)32 +b(Routines)85 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)174 b(7)256 3183 y(4.4)94 b(Image)32 b(I/O)e(Routines)79 +b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)174 +b(9)256 3296 y(4.5)94 b(T)-8 b(able)30 b(I/O)h(Routines)d(.)46 +b(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 +b(12)256 3409 y(4.6)94 b(Header)31 b(Keyw)m(ord)f(I/O)h(Routines)78 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 b(19)256 3522 +y(4.7)94 b(Utilit)m(y)30 b(Routines)c(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.) +f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 b(22)120 3726 +y Fh(5)84 b(CFITSIO)33 b(File)i(Names)f(and)g(Filters)1907 +b(23)256 3839 y Fg(5.1)94 b(Creating)30 b(New)h(Files)43 +b(.)j(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 +b(23)256 3951 y(5.2)94 b(Op)s(ening)29 b(Existing)f(Files)39 +b(.)46 b(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 +b(24)256 4064 y(5.3)94 b(Image)32 b(Filtering)53 b(.)45 +b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f +(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 +b(26)465 4177 y(5.3.1)106 b(Extracting)31 b(a)g(subsection)e(of)i(an)f +(image)76 b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)129 b(26)465 4290 y(5.3.2)106 b(Create)32 +b(an)e(Image)h(b)m(y)f(Binning)e(T)-8 b(able)30 b(Columns)i(.)45 +b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 +b(26)256 4403 y(5.4)94 b(T)-8 b(able)30 b(Filtering)74 +b(.)45 b(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)129 b(28)465 4516 y(5.4.1)106 b(Column)29 b(and)h(Keyw)m(ord)g +(Filtering)47 b(.)e(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 b(28)465 4629 y(5.4.2)106 +b(Ro)m(w)31 b(Filtering)39 b(.)45 b(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.) +g(.)f(.)h(.)g(.)129 b(29)465 4742 y(5.4.3)106 b(Go)s(o)s(d)30 +b(Time)g(In)m(terv)-5 b(al)30 b(Filtering)59 b(.)46 b(.)f(.)h(.)g(.)g +(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.) +129 b(32)465 4855 y(5.4.4)106 b(Spatial)29 b(Region)i(Filtering)56 +b(.)46 b(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.) +h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 b(32)465 4968 +y(5.4.5)106 b(Example)30 b(Ro)m(w)h(Filters)f(.)45 b(.)h(.)g(.)f(.)h(.) +g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g +(.)g(.)f(.)h(.)g(.)129 b(34)256 5081 y(5.5)94 b(Com)m(bined)29 +b(Filtering)g(Examples)44 b(.)i(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h +(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)f(.)h(.)g(.)g(.)f(.)h(.)g(.)129 +b(36)120 5284 y Fh(6)84 b(CFITSIO)33 b(Error)i(Status)f(Co)s(des)2069 +b(38)p 120 5346 1465 4 v 222 5400 a Ff(\003)258 5431 +y Fe(HEASAR)n(C,)25 b(NASA)f(Go)r(ddard)i(Space)f(Fligh)n(t)h(Cen)n +(ter,)g Fd(Wil)t(liam.D.Penc)l(e@nasa.gov)1928 5809 y +Fg(1)p eop +%%Page: 2 2 +2 1 bop 120 573 a Fi(1)135 b(In)l(tro)t(duction)120 776 +y Fg(This)33 b(do)s(cumen)m(t)h(is)f(in)m(tended)g(to)i(help)e(y)m(ou)i +(quic)m(kly)e(start)i(writing)d(C)i(programs)g(to)h(read)f(and)g(write) +120 889 y(FITS)45 b(\014les)f(using)g(the)h(CFITSIO)f(library)-8 +b(.)84 b(It)45 b(co)m(v)m(ers)i(the)f(most)f(imp)s(ortan)m(t)g(CFITSIO) +e(routines)120 1002 y(that)i(are)f(needed)g(to)h(p)s(erform)d(most)i(t) +m(yp)s(es)h(of)f(op)s(erations)f(on)h(FITS)f(\014les.)81 +b(F)-8 b(or)45 b(more)f(complete)120 1115 y(information)39 +b(ab)s(out)g(these)i(and)f(all)f(the)h(other)h(a)m(v)-5 +b(ailable)39 b(routines)g(in)g(the)i(library)d(please)i(refer)g(to)120 +1227 y(the)c(\\CFITSIO)e(User's)i(Reference)g(Guide",)h(whic)m(h)d(is)g +(a)m(v)-5 b(ailable)35 b(from)g(the)h(CFITSIO)e(W)-8 +b(eb)36 b(site)g(at)120 1340 y Fc(http://heasarc.gsfc.nasa)o(.gov)o +(/fit)o(sio)o Fg(.)261 1453 y(F)-8 b(or)41 b(more)f(general)f +(information)f(ab)s(out)i(the)g(FITS)f(data)h(format,)j(refer)d(to)g +(the)g(follo)m(wing)e(w)m(eb)120 1566 y(page:)j(h)m +(ttp://heasarc.gsfc.nasa.go)m(v/do)s(cs/heasa)q(rc/\014ts.h)m(t)q(ml) +261 1679 y(FITS)27 b(stands)h(for)g(Flexible)e(Image)j(T)-8 +b(ransp)s(ort)27 b(System)h(and)f(is)g(the)i(standard)e(\014le)g +(format)h(used)g(to)120 1792 y(store)j(most)g(astronomical)f(data)i +(\014les.)40 b(There)30 b(are)h(2)g(basic)f(t)m(yp)s(es)g(of)h(FITS)f +(\014les:)40 b(images)30 b(and)g(tables.)120 1905 y(FITS)j(images)h +(often)g(con)m(tain)g(a)g(2-dimensional)d(arra)m(y)k(of)e(pixels)f +(represen)m(ting)h(an)h(image)g(of)f(a)h(piece)120 2018 +y(of)f(the)f(sky)-8 b(,)34 b(but)e(FITS)g(images)g(can)h(also)g(con)m +(tain)g(1-D)g(arra)m(ys)g(\(i.e,)h(a)f(sp)s(ectrum)e(or)i(ligh)m(t)e +(curv)m(e\),)j(or)120 2131 y(3-D)40 b(arra)m(ys)f(\(a)g(data)g(cub)s +(e\),)i(or)d(ev)m(en)i(higher)d(dimensional)f(arra)m(ys)i(of)h(data.)66 +b(An)38 b(image)h(ma)m(y)g(also)120 2244 y(ha)m(v)m(e)30 +b(zero)g(dimensions,)c(in)i(whic)m(h)f(case)j(it)e(is)g(referred)g(to)i +(as)f(a)g(n)m(ull)e(or)i(empt)m(y)g(arra)m(y)-8 b(.)41 +b(The)28 b(supp)s(orted)120 2357 y(datat)m(yp)s(es)f(for)f(the)h(image) +g(arra)m(ys)f(are)h(8,)h(16,)g(and)e(32-bit)h(in)m(tegers,)h(and)d(32)j +(and)d(64-bit)i(\015oating)f(p)s(oin)m(t)120 2469 y(real)k(n)m(um)m(b)s +(ers.)39 b(Both)31 b(signed)f(and)f(unsigned)g(in)m(tegers)h(are)h +(supp)s(orted.)261 2582 y(FITS)j(tables)g(con)m(tain)g(ro)m(ws)g(and)g +(columns)f(of)h(data,)i(similar)c(to)j(a)g(spreadsheet.)52 +b(All)33 b(the)h(v)-5 b(alues)120 2695 y(in)30 b(a)h(particular)e +(column)h(m)m(ust)g(ha)m(v)m(e)j(the)e(same)g(datat)m(yp)s(e.)43 +b(A)31 b(cell)f(of)h(a)g(column)f(is)g(not)h(restricted)g(to)120 +2808 y(a)h(single)d(n)m(um)m(b)s(er,)i(and)f(instead)h(can)g(con)m +(tain)h(an)f(arra)m(y)g(or)h(v)m(ector)g(of)g(n)m(um)m(b)s(ers.)41 +b(There)31 b(are)h(actually)120 2921 y(2)43 b(subt)m(yp)s(es)f(of)h +(FITS)f(tables:)65 b(ASCI)s(I)41 b(and)i(binary)-8 b(.)76 +b(As)43 b(the)g(names)g(imply)-8 b(,)44 b(ASCI)s(I)d(tables)i(store)120 +3034 y(the)37 b(data)h(v)-5 b(alues)36 b(in)g(an)g(ASCI)s(I)g(represen) +m(tation)h(whereas)f(binary)g(tables)g(store)i(the)f(data)g(v)-5 +b(alues)37 b(in)120 3147 y(a)c(more)f(e\016cien)m(t)h(mac)m +(hine-readable)e(binary)g(format.)46 b(Binary)32 b(tables)g(are)g +(generally)g(more)g(compact)120 3260 y(and)25 b(supp)s(ort)e(more)j +(features)f(\(e.g.,)j(a)e(wider)e(range)h(of)h(datat)m(yp)s(es,)h(and)e +(v)m(ector)i(columns\))d(than)h(ASCI)s(I)120 3373 y(tables.)261 +3486 y(A)31 b(single)e(FITS)h(\014le)g(man)m(y)h(con)m(tain)g(m)m +(ultiple)d(images)j(or)g(tables.)41 b(Eac)m(h)31 b(table)g(or)f(image)h +(is)f(called)120 3599 y(a)k(Header-Data)j(Unit,)d(or)g(HDU.)h(The)f +(\014rst)f(HDU)i(in)d(a)j(FITS)e(\014le)g(m)m(ust)h(b)s(e)f(an)h(image) +h(\(but)e(it)h(ma)m(y)120 3711 y(ha)m(v)m(e)c(zero)f(axes\))h(and)e(is) +g(called)g(the)h(Primary)e(Arra)m(y)-8 b(.)41 b(An)m(y)28 +b(additional)f(HDUs)i(in)f(the)g(\014le)g(\(whic)m(h)g(are)120 +3824 y(also)i(referred)g(to)h(as)g(`extensions'\))f(ma)m(y)h(con)m +(tain)g(either)f(an)g(image)h(or)f(a)h(table.)261 3937 +y(Ev)m(ery)38 b(HDU)g(con)m(tains)g(a)g(header)g(con)m(taining)f(k)m +(eyw)m(ord)h(records.)62 b(Eac)m(h)38 b(k)m(eyw)m(ord)g(record)g(is)f +(80)120 4050 y(ASCI)s(I)29 b(c)m(haracters)j(long)e(and)f(has)i(the)f +(follo)m(wing)f(format:)120 4263 y Fc(KEYWORD)46 b(=)h(value)g(/)g +(comment)f(string)261 4475 y Fg(The)23 b(k)m(eyw)m(ord)i(name)f(can)g +(b)s(e)f(up)g(to)h(8)g(c)m(haracters)i(long)d(\(all)g(upp)s(ercase\).) +38 b(The)23 b(v)-5 b(alue)24 b(can)g(b)s(e)f(either)120 +4588 y(an)k(in)m(teger)g(or)f(\015oating)h(p)s(oin)m(t)e(n)m(um)m(b)s +(er,)i(a)g(logical)f(v)-5 b(alue)26 b(\(T)h(or)f(F\),)i(or)e(a)h(c)m +(haracter)i(string)c(enclosed)i(in)120 4701 y(single)d(quotes.)40 +b(Eac)m(h)26 b(header)f(b)s(egins)f(with)g(a)i(series)f(of)h(required)e +(k)m(eyw)m(ords)h(to)i(describ)s(e)d(the)h(datat)m(yp)s(e)120 +4814 y(and)35 b(format)h(of)f(the)h(follo)m(wing)e(data)i(unit,)f(if)f +(an)m(y)-8 b(.)57 b(An)m(y)35 b(n)m(um)m(b)s(er)g(of)g(other)h +(optional)e(k)m(eyw)m(ords)i(can)120 4927 y(b)s(e)d(included)e(in)h +(the)h(header)h(to)g(pro)m(vide)e(other)i(descriptiv)m(e)f(information) +e(ab)s(out)j(the)f(data.)51 b(F)-8 b(or)34 b(the)120 +5040 y(most)g(part,)g(the)g(CFITSIO)d(routines)i(automatically)g(write) +f(the)i(required)e(FITS)g(k)m(eyw)m(ords)i(for)f(eac)m(h)120 +5153 y(HDU,)e(so)g(y)m(ou,)g(the)g(programmer,)f(usually)e(do)i(not)h +(need)f(to)h(w)m(orry)f(ab)s(out)g(them.)1928 5809 y(2)p +eop +%%Page: 3 3 +3 2 bop 120 573 a Fi(2)135 b(Installing)46 b(and)f(Using)g(CFITSIO)120 +776 y Fg(First,)32 b(y)m(ou)g(should)d(do)m(wnload)i(the)h(CFITSIO)e +(soft)m(w)m(are)j(and)e(the)h(set)g(of)g(example)g(FITS)f(utilit)m(y)f +(pro-)120 889 y(grams)h(from)f(the)g(w)m(eb)h(site)f(at)i(h)m +(ttp://heasarc.gsfc.nasa.go)m(v/\014tsio.)46 b(The)30 +b(example)g(programs)g(illus-)120 1002 y(trate)g(ho)m(w)e(to)h(p)s +(erform)f(man)m(y)g(common)h(t)m(yp)s(es)f(of)h(op)s(erations)f(on)g +(FITS)g(\014les)g(using)f(CFITSIO.)g(They)120 1115 y(are)h(also)g +(useful)d(when)i(writing)f(a)i(new)f(program)g(b)s(ecause)h(it)f(is)g +(often)h(easier)f(to)i(tak)m(e)g(a)f(cop)m(y)g(of)g(one)g(of)120 +1227 y(these)k(utilit)m(y)e(programs)h(as)g(a)h(template)g(and)f(then)g +(mo)s(dify)e(it)i(for)g(y)m(our)h(o)m(wn)f(purp)s(oses,)f(rather)i +(than)120 1340 y(writing)c(the)j(new)f(program)g(completely)g(from)g +(scratc)m(h.)261 1453 y(T)-8 b(o)28 b(build)c(the)k(CFITSIO)d(library)g +(on)i(Unix)f(platforms,)i(`un)m(tar')f(the)h(source)f(co)s(de)h +(distribution)23 b(\014le)120 1566 y(and)30 b(then)g(execute)i(the)e +(follo)m(wing)f(commands)h(in)f(the)i(directory)e(con)m(taining)h(the)h +(source)g(co)s(de:)120 1779 y Fc(>)95 b(./configure)45 +b([--prefix=/target/instal)o(lati)o(on/)o(path)o(])120 +1892 y(>)95 b(make)524 b(\(or)47 b('make)f(shared'\))120 +2005 y(>)95 b(make)47 b(install)141 b(\(this)46 b(step)h(is)g +(optional\))261 2217 y Fg(The)40 b(optional)g('pre\014x')g(argumen)m(t) +h(to)g(con\014gure)f(giv)m(es)h(the)g(path)f(to)h(the)g(directory)f +(where)g(the)120 2330 y(CFITSIO)30 b(library)g(and)h(include)f(\014les) +h(should)f(b)s(e)h(installed)f(via)i(the)g(later)g('mak)m(e)h(install') +d(command.)120 2443 y(F)-8 b(or)31 b(example,)120 2655 +y Fc(>)95 b(./configure)45 b(--prefix=/usr1/local)261 +2868 y Fg(will)18 b(cause)j(the)g('mak)m(e)h(install')d(command)h(to)h +(cop)m(y)h(the)e(CFITSIO)f(lib)s(c\014tsio)f(\014le)i(to)h(/usr1/lo)s +(cal/lib)120 2981 y(and)35 b(the)h(necessary)g(include)e(\014les)h(to)h +(/usr1/lo)s(cal/include)e(\(assuming)h(of)g(course)h(that)h(the)f(pro)s +(cess)120 3094 y(has)30 b(p)s(ermission)d(to)32 b(write)d(to)i(these)g +(directories\).)261 3207 y(Pre-compiled)d(v)m(ersions)h(of)h(the)g +(CFITSIO)e(DLL)i(library)d(are)j(a)m(v)-5 b(ailable)29 +b(for)g(PCs.)40 b(On)29 b(Macin)m(tosh)120 3320 y(mac)m(hines,)45 +b(refer)d(to)g(the)h(README.MacOS)g(\014le)e(for)h(instructions)e(on)i +(building)c(CFITSIO)j(using)120 3432 y(Co)s(deW)-8 b(arrior.)261 +3545 y(An)m(y)40 b(programs)g(that)h(use)f(CFITSIO)f(m)m(ust)h(of)g +(course)h(b)s(e)e(link)m(ed)g(with)g(the)h(CFITSIO)f(library)120 +3658 y(when)e(creating)h(the)g(executable)h(\014le.)63 +b(The)37 b(exact)j(pro)s(cedure)c(for)i(linking)d(a)k(program)e(dep)s +(ends)f(on)120 3771 y(y)m(our)31 b(soft)m(w)m(are)i(en)m(vironmen)m(t,) +e(but)g(on)g(Unix)f(platforms,)h(the)g(command)g(line)f(to)i(compile)e +(and)h(link)e(a)120 3884 y(program)h(will)e(lo)s(ok)i(something)g(lik)m +(e)f(this:)120 4097 y Fc(gcc)47 b(-o)g(myprog)f(myprog.c)g(-L.)h +(-lcfitsio)e(-lm)i(-lnsl)f(-lsocket)261 4309 y Fg(Y)-8 +b(ou)37 b(ma)m(y)g(not)f(need)g(to)h(include)e(all)g(of)h(the)h('m',)h +('nsl',)f(and)f('so)s(c)m(k)m(et')i(system)f(libraries)c(on)j(y)m(our) +120 4422 y(particular)j(mac)m(hine.)72 b(T)-8 b(o)42 +b(\014nd)d(out)i(what)g(libraries)d(are)j(required)e(on)i(y)m(our)g +(\(Unix\))f(system,)k(t)m(yp)s(e)120 4535 y Fc('make)i(testprog')28 +b Fg(and)i(see)h(what)f(libraries)e(are)i(then)h(included)c(on)j(the)h +(resulting)e(link)f(line.)1928 5809 y(3)p eop +%%Page: 4 4 +4 3 bop 120 573 a Fi(3)135 b(Example)46 b(Programs)120 +776 y Fg(Before)32 b(describing)d(the)j(individual)27 +b(CFITSIO)i(routines)i(in)f(detail,)h(it)f(is)h(instructiv)m(e)f(to)i +(\014rst)f(lo)s(ok)g(at)120 889 y(an)c(actual)g(program.)40 +b(The)26 b(names)h(of)g(the)g(CFITSIO)f(routines)g(are)h(fairly)e +(descriptiv)m(e)h(\(they)i(all)e(b)s(egin)120 1002 y(with)j +Fc(fits)p 525 1002 29 4 v 33 w Fg(,)i(so)g(it)e(should)g(b)s(e)h +(reasonably)f(clear)i(what)f(this)f(program)h(do)s(es:)120 +1202 y Fc(------------------------)o(----)o(----)o(---)o(----)o(----)o +(---)o(----)o(----)o(---)o(----)o(---)311 1315 y(#include)45 +b()311 1428 y(#include)g()120 1541 +y(1:)95 b(#include)45 b("fitsio.h")311 1767 y(int)i(main\(int)e(argc,)i +(char)f(*argv[]\))311 1879 y({)120 1992 y(2:)286 b(fitsfile)45 +b(*fptr;)502 2105 y(char)h(card[FLEN_CARD];)120 2218 +y(3:)286 b(int)47 b(status)f(=)h(0,)95 b(nkeys,)46 b(ii;)95 +b(/*)47 b(MUST)g(initialize)e(status)h(*/)120 2444 y(4:)286 +b(fits_open_file\(&fptr,)42 b(argv[1],)j(READONLY,)h(&status\);)502 +2557 y(fits_get_hdrspace\(fptr,)41 b(&nkeys,)46 b(NULL,)g(&status\);) +502 2783 y(for)h(\(ii)g(=)g(1;)g(ii)g(<=)h(nkeys;)e(ii++\))94 +b({)597 2896 y(fits_read_record\(fptr,)42 b(ii,)47 b(card,)f +(&status\);)g(/*)h(read)f(keyword)g(*/)597 3009 y(printf\("\045s\\n",)e +(card\);)502 3121 y(})502 3234 y(printf\("END\\n\\n"\);)90 +b(/*)48 b(terminate)d(listing)h(with)g(END)h(*/)502 3347 +y(fits_close_file\(fptr,)42 b(&status\);)502 3573 y(if)47 +b(\(status\))475 b(/*)47 b(print)g(any)g(error)f(messages)f(*/)120 +3686 y(5:)477 b(fits_report_error\(stder)o(r,)42 b(status\);)502 +3799 y(return\(status\);)311 3912 y(})120 4025 y +(------------------------)o(----)o(----)o(---)o(----)o(----)o(---)o +(----)o(----)o(---)o(----)o(---)261 4225 y Fg(This)28 +b(program)h(op)s(ens)f(the)h(sp)s(eci\014ed)f(FITS)g(\014le)h(and)f +(prin)m(ts)g(out)h(all)f(the)i(header)f(k)m(eyw)m(ords)g(in)f(the)120 +4338 y(curren)m(t)i(HDU.)i(Some)e(other)h(p)s(oin)m(ts)e(to)i(notice)g +(ab)s(out)f(the)g(program)g(are:)231 4516 y(1.)46 b(The)30 +b Fc(fitsio.h)e Fg(header)i(\014le)f(m)m(ust)i(b)s(e)e(included)f(to)j +(de\014ne)e(the)i(v)-5 b(arious)29 b(routines)g(and)h(sym)m(b)s(ols)347 +4629 y(used)g(in)f(CFITSIO.)231 4812 y(2.)46 b(The)37 +b Fc(fitsfile)e Fg(parameter)i(is)f(the)h(\014rst)g(argumen)m(t)g(in)f +(almost)h(ev)m(ery)h(CFITSIO)d(routine.)60 b(It)347 4925 +y(is)40 b(a)i(p)s(oin)m(ter)e(to)i(a)g(structure)e(\(de\014ned)g(in)g +Fc(fitsio.h)p Fg(\))g(that)h(stores)h(information)d(ab)s(out)i(the)347 +5038 y(particular)g(FITS)g(\014le)g(that)i(the)g(routine)e(will)e(op)s +(erate)k(on.)76 b(Memory)43 b(for)f(this)f(structure)g(is)347 +5151 y(automatically)33 b(allo)s(cated)f(when)g(the)h(\014le)f(is)f +(\014rst)h(op)s(ened)g(or)h(created,)h(and)e(is)g(freed)g(when)g(the) +347 5264 y(\014le)e(is)f(closed.)231 5447 y(3.)46 b(Almost)40 +b(ev)m(ery)g(CFITSIO)e(routine)g(has)i(a)g Fc(status)d +Fg(parameter)j(as)g(the)g(last)f(argumen)m(t.)69 b(The)347 +5560 y(status)28 b(v)-5 b(alue)27 b(is)g(also)h(usually)d(returned)i +(as)h(the)g(v)-5 b(alue)27 b(of)h(the)f(function)g(itself.)38 +b(Normally)27 b(status)1928 5809 y(4)p eop +%%Page: 5 5 +5 4 bop 347 573 a Fg(=)22 b(0,)i(and)d(a)h(p)s(ositiv)m(e)f(status)h(v) +-5 b(alue)21 b(indicates)g(an)h(error)f(of)h(some)g(sort.)38 +b(The)22 b(status)g(v)-5 b(ariable)20 b(m)m(ust)347 686 +y(alw)m(a)m(ys)32 b(b)s(e)e(initialized)e(to)k(zero)g(b)s(efore)f(use,) +g(b)s(ecause)g(if)f(status)h(is)f(greater)j(than)d(zero)i(on)f(input) +347 799 y(then)e(the)g(CFITSIO)f(routines)g(will)e(simply)g(return)i +(without)g(doing)g(an)m(ything.)40 b(This)27 b(`inherited)347 +912 y(status')46 b(feature,)j(where)44 b(eac)m(h)i(CFITSIO)e(routine)g +(inherits)e(the)j(status)g(from)g(the)g(previous)347 +1024 y(routine,)e(mak)m(es)e(it)f(unnecessary)g(to)i(c)m(hec)m(k)g(the) +f(status)g(v)-5 b(alue)40 b(after)h(ev)m(ery)h(single)d(CFITSIO)347 +1137 y(routine)f(call.)64 b(Generally)38 b(y)m(ou)h(should)e(c)m(hec)m +(k)j(the)e(status)h(after)g(an)g(esp)s(ecially)e(imp)s(ortan)m(t)g(or) +347 1250 y(complicated)31 b(routine)f(has)h(b)s(een)g(called,)g(or)g +(after)h(a)f(blo)s(c)m(k)g(of)g(closely)g(related)g(CFITSIO)f(calls.) +347 1363 y(This)25 b(example)h(program)h(has)f(tak)m(en)i(this)e +(feature)h(to)g(the)g(extreme)g(and)f(only)g(c)m(hec)m(ks)i(the)f +(status)347 1476 y(v)-5 b(alue)30 b(at)h(the)g(v)m(ery)g(end)e(of)i +(the)f(program.)231 1664 y(4.)46 b(In)37 b(this)e(example)i(program)g +(the)g(\014le)f(name)h(to)h(b)s(e)e(op)s(ened)h(is)f(giv)m(en)h(as)g +(an)g(argumen)m(t)g(on)g(the)347 1777 y(command)e(line)f(\()p +Fc(arg[1])p Fg(\).)53 b(If)35 b(the)g(\014le)g(con)m(tains)g(more)g +(than)g(1)g(HDU)h(or)f(extension,)i(y)m(ou)e(can)347 +1890 y(sp)s(ecify)19 b(whic)m(h)g(particular)g(HDU)i(to)g(b)s(e)f(op)s +(ened)f(b)m(y)h(enclosing)g(the)g(name)g(or)h(n)m(um)m(b)s(er)e(of)h +(the)h(HDU)347 2002 y(in)j(square)i(brac)m(k)m(ets)h(follo)m(wing)d +(the)h(ro)s(ot)h(name)g(of)f(the)h(\014le.)38 b(F)-8 +b(or)26 b(example,)h Fc(file.fts[0])22 b Fg(op)s(ens)347 +2115 y(the)31 b(primary)d(arra)m(y)-8 b(,)32 b(while)d +Fc(file.fts[2])e Fg(will)h(mo)m(v)m(e)k(to)f(and)f(op)s(en)f(the)i(2nd) +f(extension)g(in)f(the)347 2228 y(\014le,)36 b(and)e +Fc(file.fit[EVENTS])d Fg(will)h(op)s(en)j(the)g(extension)f(that)i(has) +f(a)g Fc(EXTNAME)46 b(=)i('EVENTS')347 2341 y Fg(k)m(eyw)m(ord)31 +b(in)e(the)h(header.)41 b(Note)31 b(that)g(on)f(the)h(Unix)e(command)h +(line)f(y)m(ou)h(m)m(ust)g(enclose)h(the)f(\014le)347 +2454 y(name)h(in)e(single)g(or)i(double)e(quote)j(c)m(haracters)g(if)d +(the)i(name)g(con)m(tains)f(sp)s(ecial)g(c)m(haracters)i(suc)m(h)347 +2567 y(as)f(`[')g(or)f(`]'.)347 2717 y(All)42 b(of)h(the)h(CFITSIO)d +(routines)h(whic)m(h)g(read)h(or)g(write)g(header)g(k)m(eyw)m(ords,)k +(image)c(data,)k(or)347 2830 y(table)31 b(data)g(op)s(erate)g(only)f +(within)e(the)j(curren)m(tly)f(op)s(ened)g(HDU)h(in)e(the)i(\014le.)41 +b(T)-8 b(o)31 b(read)g(or)f(write)347 2943 y(information)36 +b(in)g(a)i(di\013eren)m(t)f(HDU)h(y)m(ou)g(m)m(ust)f(\014rst)g +(explicitly)e(mo)m(v)m(e)j(to)h(that)f(HDU)g(\(see)g(the)347 +3056 y Fc(fits)p 545 3056 29 4 v 34 w(movabs)p 867 3056 +V 32 w(hdu)30 b Fg(and)g Fc(fits)p 1442 3056 V 33 w(movrel)p +1763 3056 V 33 w(hdu)f Fg(routines)g(in)g(section)i(4.3\).)231 +3244 y(5.)46 b(The)25 b Fc(fits)p 727 3244 V 33 w(report)p +1048 3244 V 33 w(error)e Fg(routine)h(pro)m(vides)g(a)h(con)m(v)m +(enien)m(t)h(w)m(a)m(y)g(to)g(prin)m(t)e(out)h(diagnostic)f(mes-)347 +3357 y(sages)32 b(ab)s(out)e(an)m(y)g(error)g(that)h(ma)m(y)g(ha)m(v)m +(e)h(o)s(ccurred.)261 3544 y(A)f(set)g(of)f(example)g(FITS)g(utilit)m +(y)f(programs)h(are)g(a)m(v)-5 b(ailable)30 b(from)g(the)g(CFITSIO)f(w) +m(eb)i(site)f(at)120 3657 y(h)m(ttp://heasarc.gsfc.nasa.go)m(v/do)s +(cs/soft)n(w)m(are/)q(\014tsio/cexa)q(mples.h)m(tml.)87 +b(These)45 b(are)g(real)f(w)m(orking)120 3770 y(programs)e(whic)m(h)e +(illustrate)g(ho)m(w)i(to)h(read,)i(write,)f(and)d(mo)s(dify)f(FITS)i +(\014les)e(using)h(the)h(CFITSIO)120 3883 y(library)-8 +b(.)36 b(Most)24 b(of)g(these)f(programs)g(are)h(v)m(ery)f(short,)i +(con)m(taining)e(only)f(a)i(few)f(10s)h(of)f(lines)e(of)j(executable) +120 3996 y(co)s(de)32 b(or)g(less,)g(y)m(et)h(they)f(p)s(erform)e +(quite)h(useful)f(op)s(erations)h(on)h(FITS)f(\014les.)44 +b(Running)30 b(eac)m(h)j(program)120 4109 y(without)40 +b(an)m(y)h(command)f(line)f(argumen)m(ts)i(will)d(pro)s(duce)h(a)i +(short)f(description)f(of)i(ho)m(w)g(to)g(use)f(the)120 +4222 y(program.)g(The)30 b(curren)m(tly)g(a)m(v)-5 b(ailable)29 +b(programs)h(are:)347 4409 y(\014tscop)m(y)h(-)g(cop)m(y)g(a)g(\014le) +347 4522 y(listhead)e(-)i(list)e(header)h(k)m(eyw)m(ords)347 +4635 y(liststruc)f(-)i(sho)m(w)f(the)g(structure)g(of)h(a)g(FITS)e +(\014le.)347 4748 y(mo)s(dhead)h(-)g(write)g(or)g(mo)s(dify)f(a)i +(header)f(k)m(eyw)m(ord)347 4861 y(imarith)f(-)h(add,)g(subtract,)h(m)m +(ultiply)-8 b(,)28 b(or)j(divide)d(2)j(images)347 4974 +y(imlist)d(-)j(list)e(pixel)g(v)-5 b(alues)29 b(in)g(an)i(image)347 +5087 y(imstat)g(-)f(compute)h(mean,)g(min,)e(and)g(max)i(pixel)e(v)-5 +b(alues)29 b(in)g(an)i(image)347 5200 y(tablist)f(-)g(displa)m(y)f(the) +h(con)m(ten)m(ts)i(of)f(a)g(FITS)e(table)347 5313 y(tab)s(calc)i(-)g +(general)f(table)g(calculator)1928 5809 y(5)p eop +%%Page: 6 6 +6 5 bop 120 573 a Fi(4)135 b(CFITSIO)44 b(Routines)120 +776 y Fg(This)36 b(c)m(hapter)i(describ)s(es)e(the)h(main)g(CFITSIO)f +(routines)g(that)i(can)g(b)s(e)f(used)g(to)h(p)s(erform)e(the)i(most) +120 889 y(common)31 b(t)m(yp)s(es)f(of)h(op)s(erations)e(on)i(FITS)e +(\014les.)120 1136 y Fb(4.1)112 b(Error)37 b(Rep)s(orting)120 +1310 y Fc(void)47 b(fits_report_error\(FILE)41 b(*stream,)46 +b(int)h(status\))120 1423 y(void)g(fits_get_errstatus\(int)41 +b(status,)46 b(char)h(*err_text\))120 1536 y(float)f +(fits_get_version\(float)c(*version\))261 1748 y Fg(The)24 +b(\014rst)g(routine)f(prin)m(ts)g(out)i(information)e(ab)s(out)h(an)m +(y)h(error)f(that)h(has)g(o)s(ccurred.)38 b(Whenev)m(er)25 +b(an)m(y)120 1861 y(CFITSIO)f(routine)h(encoun)m(ters)i(an)f(error)f +(it)h(usually)d(writes)i(a)i(message)g(describing)c(the)j(nature)g(of)g +(the)120 1974 y(error)g(to)i(an)e(in)m(ternal)f(error)i(message)g(stac) +m(k)h(and)e(then)h(returns)e(with)g(a)i(p)s(ositiv)m(e)f(in)m(teger)h +(status)g(v)-5 b(alue.)120 2087 y(P)m(assing)27 b(the)h(error)f(status) +h(v)-5 b(alue)27 b(to)h(this)f(routine)f(will)f(cause)j(a)g(generic)g +(description)d(of)j(the)g(error)f(and)120 2200 y(all)e(the)i(messages)h +(from)e(the)h(in)m(ternal)e(CFITSIO)g(error)h(stac)m(k)i(to)g(b)s(e)e +(prin)m(ted)f(to)i(the)g(sp)s(eci\014ed)e(stream.)120 +2313 y(The)30 b Fc(stream)f Fg(parameter)h(is)g(usually)e(set)j(equal)f +(to)h Fc("stdout")d Fg(or)i Fc("stderr")p Fg(.)261 2426 +y(The)25 b(second)g(routine)f(simply)e(returns)i(a)h(30-c)m(haracter)j +(descriptiv)m(e)c(error)g(message)i(corresp)s(onding)120 +2538 y(to)31 b(the)g(input)d(status)j(v)-5 b(alue.)261 +2651 y(The)30 b(last)g(routine)g(returns)f(the)h(curren)m(t)g(CFITSIO)f +(library)f(v)m(ersion)i(n)m(um)m(b)s(er.)120 2899 y Fb(4.2)112 +b(File)37 b(Op)s(en/Close)g(Routines)120 3072 y Fc(int)47 +b(fits_open_file\()d(fitsfile)h(**fptr,)h(char)h(*filename,)e(int)h +(mode,)h(int)g(*status\))120 3185 y(int)g(fits_open_data\()d(fitsfile)h +(**fptr,)h(char)h(*filename,)e(int)h(mode,)h(int)g(*status\))120 +3298 y(int)g(fits_open_table\(fitsfile)41 b(**fptr,)46 +b(char)h(*filename,)e(int)h(mode,)h(int)g(*status\))120 +3411 y(int)g(fits_open_image\(fitsfile)41 b(**fptr,)46 +b(char)h(*filename,)e(int)h(mode,)h(int)g(*status\))120 +3637 y(int)g(fits_create_file\(fitsfil)o(e)42 b(**fptr,)k(char)g +(*filename,)f(int)i(*status\))120 3750 y(int)g +(fits_close_file\(fitsfile)41 b(*fptr,)46 b(int)h(*status\))261 +3962 y Fg(These)38 b(routines)e(op)s(en)i(or)f(close)i(a)f(\014le.)62 +b(The)37 b(\014rst)g Fc(fitsfile)f Fg(parameter)i(in)f(these)h(and)f +(nearly)120 4075 y(ev)m(ery)28 b(other)g(CFITSIO)f(routine)f(is)h(a)h +(p)s(oin)m(ter)f(to)h(a)g(structure)g(that)g(CFITSIO)e(uses)h(to)i +(store)f(relev)-5 b(an)m(t)120 4188 y(parameters)31 b(ab)s(out)f(eac)m +(h)i(op)s(ened)e(\014le.)41 b(Y)-8 b(ou)31 b(should)e(nev)m(er)i +(directly)e(read)i(or)f(write)g(an)m(y)h(information)120 +4301 y(in)23 b(this)h(structure.)38 b(Memory)26 b(for)e(this)g +(structure)g(is)g(allo)s(cated)g(automatically)h(when)f(the)h(\014le)e +(is)h(op)s(ened)120 4414 y(or)30 b(created,)i(and)e(is)f(freed)h(when)g +(the)g(\014le)g(is)f(closed.)261 4527 y(The)f Fc(mode)e +Fg(parameter)j(in)d(the)i Fc(fits)p 1552 4527 29 4 v +34 w(open)p 1778 4527 V 33 w(xxxx)f Fg(set)h(of)g(routines)f(can)h(b)s +(e)f(set)i(to)f(either)g Fc(READONLY)120 4640 y Fg(or)i +Fc(READWRITE)d Fg(to)j(select)g(the)g(t)m(yp)s(e)f(of)h(\014le)f +(access)i(that)f(will)d(b)s(e)i(allo)m(w)m(ed.)40 b(These)29 +b(sym)m(b)s(olic)f(constan)m(ts)120 4753 y(are)j(de\014ned)e(in)g +Fc(fitsio.h)p Fg(.)261 4866 y(The)k Fc(fits)p 649 4866 +V 33 w(open)p 874 4866 V 34 w(file)f Fg(routine)h(op)s(ens)f(the)i +(\014le)f(and)f(p)s(ositions)g(the)i(in)m(ternal)e(\014le)g(p)s(oin)m +(ter)h(to)h(the)120 4979 y(b)s(eginning)21 b(of)j(the)g(\014le,)g(or)g +(to)h(the)f(sp)s(eci\014ed)e(extension)h(if)g(an)h(extension)f(name)h +(or)g(n)m(um)m(b)s(er)e(is)h(app)s(ended)120 5092 y(to)k(the)f(\014le)g +(name)g(\(see)h(the)g(later)f(section)h(on)f(\\CFITSIO)f(File)g(Names)i +(and)f(Filters")g(for)g(a)g(description)120 5204 y(of)32 +b(the)f(syn)m(tax\).)45 b Fc(fits)p 945 5204 V 33 w(open)p +1170 5204 V 33 w(data)31 b Fg(b)s(eha)m(v)m(es)g(similarly)d(except)33 +b(that)f(it)f(will)d(mo)m(v)m(e)33 b(to)f(the)g(\014rst)f(HDU)120 +5317 y(con)m(taining)k(signi\014can)m(t)f(data)i(if)e(a)i(HDU)g(name)g +(or)f(n)m(um)m(b)s(er)f(to)i(op)s(en)f(is)f(not)i(explicitly)c(sp)s +(eci\014ed)i(as)120 5430 y(part)23 b(of)h(the)g(\014lename.)38 +b(It)23 b(will)e(mo)m(v)m(e)k(to)g(the)e(\014rst)g(IMA)m(GE)i(HDU)f +(with)e(NAXIS)i(greater)h(than)e(0,)j(or)d(the)1928 5809 +y(6)p eop +%%Page: 7 7 +7 6 bop 120 573 a Fg(\014rst)29 b(table)g(that)i(do)s(es)e(not)h(con)m +(tain)g(the)g(strings)e(`GTI')i(\(a)g(Go)s(o)s(d)g(Time)e(In)m(terv)-5 +b(al)30 b(extension\))f(or)h(`OB-)120 686 y(ST)-8 b(ABLE')37 +b(in)f(the)h(EXTNAME)h(k)m(eyw)m(ord)f(v)-5 b(alue.)61 +b(The)36 b Fc(fits)p 2380 686 29 4 v 34 w(open)p 2606 +686 V 33 w(table)g Fg(and)g Fc(fits)p 3290 686 V 34 w(open)p +3516 686 V 33 w(image)120 799 y Fg(routines)e(are)i(similar)c(except)37 +b(that)f(they)f(will)e(mo)m(v)m(e)j(to)g(the)g(\014rst)e(signi\014can)m +(t)h(table)g(HDU)h(or)f(image)120 912 y(HDU,)c(resp)s(ectiv)m(ely)f(if) +f(a)i(HDU)g(name)g(of)f(n)m(um)m(b)s(er)f(is)h(not)g(sp)s(eci\014ed)f +(as)i(part)f(of)g(the)h(input)d(\014le)i(name.)261 1024 +y(When)e(op)s(ening)f(an)h(existing)f(\014le,)h(the)h +Fc(filename)d Fg(can)i(include)e(optional)i(argumen)m(ts,)h(enclosed)f +(in)120 1137 y(square)h(brac)m(k)m(ets)i(that)f(sp)s(ecify)e +(\014ltering)g(op)s(erations)g(that)i(should)e(b)s(e)h(applied)e(to)j +(the)g(input)d(\014le.)40 b(F)-8 b(or)120 1250 y(example,)263 +1428 y Fc(myfile.fit[EVENTS][counts)41 b(>)48 b(0])120 +1605 y Fg(op)s(ens)27 b(the)i(table)f(in)f(the)i(EVENTS)e(extension)h +(and)g(creates)i(a)e(virtual)f(table)h(b)m(y)g(selecting)g(only)g +(those)120 1718 y(ro)m(ws)g(where)f(the)i(COUNTS)d(column)h(v)-5 +b(alue)28 b(is)f(greater)i(than)f(0.)40 b(See)28 b(section)g(5)h(for)f +(more)g(examples)f(of)120 1831 y(these)k(p)s(o)m(w)m(erful)e +(\014ltering)f(capabilities.)261 1944 y(In)38 b Fc(fits)p +581 1944 V 33 w(create)p 902 1944 V 33 w(file)p Fg(,)h(the)g +Fc(filename)d Fg(is)i(simply)e(the)i(ro)s(ot)h(name)f(of)h(the)g +(\014le)e(to)i(b)s(e)f(created.)120 2057 y(Y)-8 b(ou)36 +b(can)g(o)m(v)m(erwrite)g(an)g(existing)e(\014le)h(b)m(y)g(pre\014xing) +f(the)i(name)g(with)e(a)i(`!')57 b(c)m(haracter)37 b(\(on)f(the)f(Unix) +120 2170 y(command)30 b(line)e(this)h(m)m(ust)g(b)s(e)g(pre\014xed)g +(with)g(a)h(bac)m(kslash,)g(as)g(in)e Fc(`\\!file.fit')p +Fg(\).)38 b(If)29 b(the)h(\014le)f(name)120 2282 y(ends)f(with)f +Fc(.gz)h Fg(the)h(\014le)f(will)e(b)s(e)i(compressed)g(using)f(the)i +(gzip)f(algorithm.)39 b(If)29 b(the)f(\014lename)g(is)g +Fc(stdout)120 2395 y Fg(or)h Fc("-")e Fg(\(a)j(single)d(dash)h(c)m +(haracter\))j(then)d(the)h(output)f(\014le)g(will)e(b)s(e)i(pip)s(ed)e +(to)k(the)f(stdout)f(stream.)41 b(Y)-8 b(ou)120 2508 +y(can)27 b(c)m(hain)f(sev)m(eral)g(tasks)h(together)h(b)m(y)f(writing)d +(the)j(output)f(from)g(the)g(\014rst)g(task)h(to)g Fc(stdout)e +Fg(and)h(then)120 2621 y(reading)j(the)i(input)d(\014le)i(in)f(the)i +(2nd)e(task)i(from)f Fc(stdin)f Fg(or)h Fc("-")p Fg(.)120 +2867 y Fb(4.3)112 b(HDU-lev)m(el)36 b(Routines)261 3040 +y Fg(The)30 b(routines)f(listed)g(in)g(this)h(section)g(op)s(erate)h +(on)f(Header-Data)j(Units)d(\(HDUs\))h(in)e(a)i(\014le.)120 +3153 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(__)120 3266 y(int)47 +b(fits_get_num_hdus\(fitsfi)o(le)42 b(*fptr,)k(int)h(*hdunum,)e(int)i +(*status\))120 3379 y(int)g(fits_get_hdu_num\(fitsfil)o(e)42 +b(*fptr,)94 b(int)47 b(*hdunum\))261 3579 y Fg(The)39 +b(\014rst)f(routines)g(returns)g(the)h(total)h(n)m(um)m(b)s(er)e(of)h +(HDUs)h(in)d(the)j(FITS)e(\014le,)j(and)d(the)h(second)120 +3692 y(routine)32 b(returns)f(the)i(p)s(osition)e(of)i(the)g(curren)m +(tly)e(op)s(ened)h(HDU)i(in)d(the)i(FITS)f(\014le)g(\(starting)g(with)g +(1,)120 3805 y(not)f(0\).)120 4005 y Fc(________________________)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o +(____)o(___)o(____)o(__)120 4118 y(int)47 b(fits_movabs_hdu\(fitsfile) +41 b(*fptr,)46 b(int)h(hdunum,)f(int)h(*hdutype,)e(int)i(*status\))120 +4231 y(int)g(fits_movrel_hdu\(fitsfile)41 b(*fptr,)46 +b(int)h(nmove,)94 b(int)47 b(*hdutype,)e(int)i(*status\))120 +4344 y(int)g(fits_movnam_hdu\(fitsfile)41 b(*fptr,)46 +b(int)h(hdutype,)f(char)g(*extname,)1075 4457 y(int)g(extver,)g(int)h +(*status\))261 4657 y Fg(These)31 b(routines)f(enable)h(y)m(ou)g(to)h +(mo)m(v)m(e)g(to)g(a)g(di\013eren)m(t)e(HDU)i(in)e(the)h(\014le.)42 +b(Most)32 b(of)g(the)f(CFITSIO)120 4770 y(functions)g(whic)m(h)h(read)h +(or)g(write)f(k)m(eyw)m(ords)h(or)g(data)h(op)s(erate)f(only)g(on)f +(the)h(curren)m(tly)f(op)s(ened)h(HDU)120 4883 y(in)h(the)h(\014le.)53 +b(The)34 b(\014rst)g(routine)g(mo)m(v)m(es)i(to)g(the)f(sp)s(eci\014ed) +e(absolute)i(HDU)g(n)m(um)m(b)s(er)f(in)f(the)i(FITS)f(\014le)120 +4996 y(\(the)e(\014rst)f(HDU)i(=)e(1\),)i(whereas)f(the)g(second)f +(routine)g(mo)m(v)m(es)i(a)f(relativ)m(e)g(n)m(um)m(b)s(er)f(of)h(HDUs) +g(forw)m(ard)120 5109 y(or)f(bac)m(kw)m(ard)h(from)e(the)i(curren)m +(tly)e(op)s(en)g(HDU.)i(The)f Fc(hdutype)e Fg(parameter)i(returns)f +(the)i(t)m(yp)s(e)f(of)g(the)120 5222 y(newly)d(op)s(ened)h(HDU,)i(and) +e(will)e(b)s(e)i(equal)g(to)h(one)g(of)g(these)g(sym)m(b)s(olic)e +(constan)m(t)j(v)-5 b(alues:)40 b Fc(IMAGE)p 3564 5222 +V 33 w(HDU,)120 5334 y(ASCII)p 366 5334 V 33 w(TBL,)47 +b(or)g(BINARY)p 1069 5334 V 33 w(TBL)p Fg(.)37 b Fc(hdutype)g +Fg(ma)m(y)h(b)s(e)g(set)h(to)g(NULL)f(if)f(it)h(is)g(not)g(needed.)64 +b(The)38 b(third)120 5447 y(routine)30 b(mo)m(v)m(es)j(to)f(the)f +(\(\014rst\))h(HDU)g(that)f(matc)m(hes)i(the)e(input)f(extension)h(t)m +(yp)s(e,)g(name,)h(and)f(v)m(ersion)120 5560 y(n)m(um)m(b)s(er,)23 +b(as)f(giv)m(en)h(b)m(y)f(the)g Fc(XTENSION,)46 b(EXTNAME)20 +b Fg(\(or)j Fc(HDUNAME)p Fg(\))d(and)i Fc(EXTVER)f Fg(k)m(eyw)m(ords.) +38 b(If)22 b(the)g(input)1928 5809 y(7)p eop +%%Page: 8 8 +8 7 bop 120 573 a Fg(v)-5 b(alue)33 b(of)g Fc(extver)e +Fg(=)i(0,)i(then)e(the)g(v)m(ersion)g(n)m(um)m(b)s(er)e(will)g(b)s(e)h +(ignored)h(when)f(lo)s(oking)g(for)h(a)g(matc)m(hing)120 +686 y(HDU.)120 898 y Fc(________________________)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)120 +1011 y(int)47 b(fits_get_hdu_type\(fitsfi)o(le)42 b(*fptr,)93 +b(int)47 b(*hdutype,)f(int)g(*status\))261 1224 y Fg(Get)21 +b(the)g(t)m(yp)s(e)f(of)h(the)f(curren)m(t)g(HDU)h(in)e(the)i(FITS)e +(\014le:)35 b Fc(IMAGE)p 2435 1224 29 4 v 33 w(HDU,)47 +b(ASCII)p 2947 1224 V 33 w(TBL,)f(or)h(BINARY)p 3649 +1224 V 33 w(TBL)p Fg(.)120 1436 y Fc(________________________)o(____)o +(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o +(___)120 1549 y(int)g(fits_copy_hdu\(fitsfile)42 b(*infptr,)j(fitsfile) +h(*outfptr,)f(int)i(morekeys,)979 1662 y(int)g(*status\))120 +1775 y(int)g(fits_copy_file\(fitsfile)41 b(*infptr,)46 +b(fitsfile)f(*outfptr,)h(int)h(previous,)979 1888 y(int)g(current,)f +(int)g(following,)f(>)j(int)f(*status\))261 2100 y Fg(The)34 +b(\014rst)g(routine)f(copies)i(the)f(curren)m(t)g(HDU)i(from)e(the)g +(FITS)g(\014le)g(asso)s(ciated)g(with)g(infptr)e(and)120 +2213 y(app)s(ends)i(it)i(to)h(the)f(end)f(of)h(the)g(FITS)g(\014le)f +(asso)s(ciated)h(with)f(outfptr.)57 b(Space)36 b(ma)m(y)h(b)s(e)e +(reserv)m(ed)i(for)120 2326 y Fc(morekeys)32 b Fg(additional)h(k)m(eyw) +m(ords)i(in)f(the)g(output)h(header.)53 b(The)35 b(second)f(routine)g +(copies)h(an)m(y)g(HDUs)120 2439 y(previous)41 b(to)j(the)e(curren)m(t) +h(HDU,)h(and/or)e(the)h(curren)m(t)f(HDU,)i(and/or)f(an)m(y)g(HDUs)g +(follo)m(wing)e(the)120 2552 y(curren)m(t)22 b(HDU,)h(dep)s(ending)c +(on)j(the)g(v)-5 b(alue)22 b(\(T)-8 b(rue)22 b(or)g(F)-8 +b(alse\))23 b(of)f Fc(previous,)45 b(current)p Fg(,)22 +b(and)g Fc(following)p Fg(,)120 2665 y(resp)s(ectiv)m(ely)-8 +b(.)40 b(F)-8 b(or)32 b(example,)215 2853 y Fc(fits_copy_file\(infptr,) +42 b(outfptr,)k(0,)h(1,)g(1,)g(&status\);)120 3040 y +Fg(will)32 b(cop)m(y)k(the)f(curren)m(t)g(HDU)g(and)g(an)m(y)g(HDUs)g +(that)h(follo)m(w)e(it)g(from)h(the)g(input)e(to)i(the)h(output)e +(\014le,)120 3153 y(but)c(it)g(will)d(not)k(cop)m(y)g(an)m(y)g(HDUs)g +(preceding)e(the)i(curren)m(t)f(HDU.)1928 5809 y(8)p +eop +%%Page: 9 9 +9 8 bop 120 573 a Fb(4.4)112 b(Image)37 b(I/O)h(Routines)120 +744 y Fg(This)29 b(section)h(lists)f(the)i(more)f(imp)s(ortan)m(t)g +(CFITSIO)e(routines)i(whic)m(h)f(op)s(erate)i(on)f(FITS)g(images.)120 +956 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(__)120 1069 y(int)47 +b(fits_get_img_type\(fitsfi)o(le)42 b(*fptr,)k(int)h(*bitpix,)e(int)i +(*status\))120 1181 y(int)g(fits_get_img_dim\()c(fitsfile)j(*fptr,)g +(int)h(*naxis,)93 b(int)47 b(*status\))120 1294 y(int)g +(fits_get_img_size\(fitsfi)o(le)42 b(*fptr,)k(int)h(maxdim,)93 +b(long)47 b(*naxes,)1170 1407 y(int)g(*status\))120 1520 +y(int)g(fits_get_img_param\(fitsf)o(ile)41 b(*fptr,)46 +b(int)h(maxdim,)94 b(int)47 b(*bitpix,)1218 1633 y(int)g(*naxis,)e +(long)i(*naxes,)f(int)h(*status\))261 1844 y Fg(Get)38 +b(information)e(ab)s(out)h(the)g(curren)m(tly)f(op)s(ened)h(image)g +(HDU.)h(The)f(\014rst)f(routine)g(returns)g(the)120 1957 +y(datat)m(yp)s(e)41 b(of)e(the)h(image)g(as)g(\(de\014ned)f(b)m(y)g +(the)h Fc(BITPIX)e Fg(k)m(eyw)m(ord\),)43 b(whic)m(h)38 +b(can)i(ha)m(v)m(e)h(the)f(follo)m(wing)120 2070 y(sym)m(b)s(olic)29 +b(constan)m(t)i(v)-5 b(alues:)311 2256 y Fc(BYTE_IMG)141 +b(=)i(8)g(\()47 b(8-bit)g(byte)f(pixels,)g(0)h(-)h(255\))311 +2369 y(SHORT_IMG)93 b(=)i(16)143 b(\(16)47 b(bit)g(integer)e(pixels\)) +311 2482 y(LONG_IMG)141 b(=)95 b(32)143 b(\(32-bit)46 +b(integer)f(pixels\))311 2595 y(FLOAT_IMG)93 b(=)47 b(-32)143 +b(\(32-bit)46 b(floating)f(point)h(pixels\))311 2708 +y(DOUBLE_IMG)f(=)i(-64)143 b(\(64-bit)46 b(floating)f(point)h(pixels\)) +261 2895 y Fg(The)34 b(second)g(and)f(third)f(routines)h(return)g(the)h +(n)m(um)m(b)s(er)e(of)i(dimensions)d(in)i(the)h(image)g(\(from)g(the) +120 3007 y Fc(NAXIS)25 b Fg(k)m(eyw)m(ord\),)j(and)e(the)h(sizes)f(of)g +(eac)m(h)i(dimension)c(\(from)i(the)g Fc(NAXIS1,)46 b(NAXIS2)p +Fg(,)26 b(etc.)40 b(k)m(eyw)m(ords\).)120 3120 y(The)g(last)h(routine)f +(simply)f(com)m(bines)h(the)i(function)d(of)i(the)h(\014rst)e(3)h +(routines.)72 b(The)40 b(input)f Fc(maxdim)120 3233 y +Fg(parameter)28 b(in)f(this)f(routine)h(giv)m(es)h(the)g(maxim)m(um)f +(n)m(um)m(b)s(er)f(dimensions)f(that)k(ma)m(y)f(b)s(e)f(returned)g +(\(i.e.,)120 3346 y(the)k(dimension)c(of)k(the)f Fc(naxes)f +Fg(arra)m(y\))120 3557 y Fc(________________________)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(___)o(_)120 +3670 y(int)47 b(fits_create_img\(fitsfile)41 b(*fptr,)46 +b(int)h(bitpix,)f(int)h(naxis,)1075 3783 y(long)f(*naxes,)g(int)h +(*status\))261 3994 y Fg(Create)28 b(an)f(image)h(HDU)g(b)m(y)f +(writing)e(the)i(required)f(k)m(eyw)m(ords)h(whic)m(h)f(de\014ne)h(the) +g(structure)g(of)g(the)120 4107 y(image.)50 b(The)33 +b(2nd)f(through)h(4th)h(parameters)f(sp)s(eci\014ed)f(the)h(datat)m(yp) +s(e,)j(the)d(n)m(um)m(b)s(er)f(of)i(dimensions,)120 4220 +y(and)26 b(the)h(sizes)f(of)g(the)h(dimensions.)37 b(The)26 +b(allo)m(w)m(ed)g(v)-5 b(alues)26 b(of)h(the)f Fc(bitpix)f +Fg(parameter)i(are)g(listed)e(ab)s(o)m(v)m(e)120 4333 +y(in)32 b(the)h(description)e(of)i(the)g Fc(fits)p 1319 +4333 29 4 v 33 w(get)p 1496 4333 V 33 w(img)p 1673 4333 +V 34 w(type)f Fg(routine.)47 b(If)32 b(the)h(FITS)f(\014le)g(p)s(oin)m +(ted)g(to)i(b)m(y)f Fc(fptr)e Fg(is)120 4446 y(empt)m(y)c(\(previously) +d(created)j(with)e Fc(fits)p 1575 4446 V 33 w(create)p +1896 4446 V 33 w(file)p Fg(\))g(then)h(this)f(routine)g(creates)j(a)f +(primary)d(arra)m(y)120 4559 y(in)36 b(the)h(\014le,)h(otherwise)f(a)g +(new)g(IMA)m(GE)h(extension)f(is)f(app)s(ended)f(to)j(end)f(of)g(the)g +(\014le)g(follo)m(wing)e(the)120 4672 y(other)c(HDUs)g(in)e(the)h +(\014le.)120 4883 y Fc(________________________)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(_)120 +4996 y(int)47 b(fits_write_pix\(fitsfile)41 b(*fptr,)46 +b(int)h(datatype,)f(long)g(*fpixel,)836 5109 y(long)h(nelements,)e +(void)h(*array,)g(int)h(*status\);)120 5334 y(int)g +(fits_write_pixnull\(fitsf)o(ile)41 b(*fptr,)46 b(int)h(datatype,)f +(long)g(*fpixel,)836 5447 y(long)h(nelements,)e(void)h(*array,)g(void)h +(*nulval,)e(int)i(*status\);)1928 5809 y Fg(9)p eop +%%Page: 10 10 +10 9 bop 120 573 a Fc(int)47 b(fits_read_pix\(fitsfile)42 +b(*fptr,)k(int)94 b(datatype,)46 b(long)g(*fpixel,)979 +686 y(long)h(nelements,)e(void)h(*nulval,)g(void)h(*array,)979 +799 y(int)g(*anynul,)f(int)g(*status\))261 1007 y Fg(Read)32 +b(or)f(write)f(all)g(or)h(part)h(of)f(the)g(FITS)g(image.)43 +b(There)31 b(are)h(2)f(di\013eren)m(t)g('write')g(pixel)e(routines:)120 +1120 y(The)23 b(\014rst)g(simply)e(writes)i(the)h(input)e(arra)m(y)i +(of)g(pixels)e(to)i(the)g(FITS)f(\014le.)38 b(The)23 +b(second)h(is)f(similar,)f(except)120 1233 y(that)30 +b(it)e(substitutes)g(the)h(appropriate)f(n)m(ull)f(pixel)g(v)-5 +b(alue)29 b(in)f(the)h(FITS)f(\014le)g(for)h(an)m(y)g(pixels)e(whic)m +(h)h(ha)m(v)m(e)120 1346 y(a)j(v)-5 b(alue)29 b(equal)h(to)h +Fc(*nulval)d Fg(\(note)j(that)g(this)e(parameter)h(giv)m(es)h(the)f +(address)f(of)i(the)f(n)m(ull)e(pixel)h(v)-5 b(alue,)120 +1459 y(not)35 b(the)g(v)-5 b(alue)34 b(itself)7 b(\).)52 +b(Similarly)-8 b(,)33 b(when)g(reading)h(an)h(image,)h(CFITSIO)d(will)f +(substitute)h(the)i(v)-5 b(alue)120 1572 y(giv)m(en)29 +b(b)m(y)f Fc(nulval)f Fg(for)i(an)m(y)g(unde\014ned)d(pixels)h(in)h +(the)h(image,)g(unless)e Fc(nulval)46 b(=)i(NULL)p Fg(,)27 +b(in)h(whic)m(h)f(case)120 1685 y(no)j(c)m(hec)m(ks)i(will)c(b)s(e)i +(made)g(for)g(unde\014ned)e(pixels)h(when)g(reading)h(the)g(FITS)g +(image.)261 1798 y(The)35 b Fc(fpixel)f Fg(parameter)i(in)e(these)i +(routines)e(is)h(an)g(arra)m(y)h(whic)m(h)e(giv)m(es)i(the)g(co)s +(ordinate)f(in)f(eac)m(h)120 1910 y(dimension)22 b(of)k(the)f(\014rst)f +(pixel)g(to)h(b)s(e)g(read)g(or)g(written,)g(and)g Fc(nelements)d +Fg(is)i(the)h(total)h(n)m(um)m(b)s(er)e(of)h(pixels)120 +2023 y(to)i(read)g(or)f(write.)39 b Fc(array)25 b Fg(is)h(the)g +(address)g(of)h(an)f(arra)m(y)h(whic)m(h)e(either)h(con)m(tains)h(the)g +(pixel)e(v)-5 b(alues)26 b(to)h(b)s(e)120 2136 y(written,)k(or)g(will)e +(hold)g(the)j(v)-5 b(alues)30 b(of)i(the)f(pixels)f(that)i(are)f(read.) +43 b(When)31 b(reading,)g Fc(array)f Fg(m)m(ust)h(ha)m(v)m(e)120 +2249 y(b)s(een)k(allo)s(cated)h(large)g(enough)f(to)i(hold)d(all)h(the) +h(returned)f(pixel)f(v)-5 b(alues.)56 b(These)36 b(routines)e(starts)j +(at)120 2362 y(the)e Fc(fpixel)d Fg(lo)s(cation)i(and)g(then)g(read)h +(or)f(write)g(the)g Fc(nelements)e Fg(pixels,)i(con)m(tin)m(uing)g(on)g +(successiv)m(e)120 2475 y(ro)m(ws)f(of)g(the)g(image)g(if)f(necessary) +-8 b(.)49 b(F)-8 b(or)34 b(example,)g(to)f(write)f(an)h(en)m(tire)g(2D) +h(image,)g(set)f Fc(fpixel[0])46 b(=)120 2588 y(fpixel[1])f(=)j(1)p +Fg(,)35 b(and)f Fc(nelements)46 b(=)h(NAXIS1)f(*)i(NAXIS2)p +Fg(.)j(Or)34 b(to)i(read)e(just)g(the)h(10th)h(ro)m(w)e(of)h(the)120 +2701 y(image,)49 b(set)c Fc(fpixel[0])g(=)j(1,)f(fpixel[1])e(=)j(10)p +Fg(,)g(and)c Fc(nelements)h(=)i(NAXIS1)p Fg(.)82 b(The)45 +b Fc(datatype)120 2814 y Fg(parameter)28 b(sp)s(eci\014es)d(the)j +(datat)m(yp)s(e)g(of)f(the)g(C)g Fc(array)e Fg(in)h(the)h(program,)h +(whic)m(h)e(need)h(not)g(b)s(e)g(the)g(same)120 2927 +y(as)32 b(the)f(datat)m(yp)s(e)i(of)e(the)h(FITS)f(image)g(itself.)43 +b(If)31 b(the)h(datat)m(yp)s(es)g(di\013er)e(then)h(CFITSIO)f(will)f +(con)m(v)m(ert)120 3040 y(the)i(data)h(as)f(it)g(is)f(read)h(or)g +(written.)41 b(The)31 b(follo)m(wing)e(sym)m(b)s(olic)h(constan)m(ts)i +(are)f(allo)m(w)m(ed)g(for)g(the)g(v)-5 b(alue)120 3152 +y(of)31 b Fc(datatype)p Fg(:)215 3337 y Fc(TBYTE)238 +b(unsigned)45 b(char)215 3450 y(TSBYTE)190 b(signed)46 +b(char)215 3563 y(TSHORT)190 b(signed)46 b(short)215 +3675 y(TUSHORT)142 b(unsigned)45 b(short)215 3788 y(TINT)286 +b(signed)46 b(int)215 3901 y(TUINT)238 b(unsigned)45 +b(int)215 4014 y(TLONG)238 b(signed)46 b(long)215 4127 +y(TULONG)190 b(unsigned)45 b(long)215 4240 y(TFLOAT)190 +b(float)215 4353 y(TDOUBLE)142 b(double)120 4561 y +(________________________)o(____)o(____)o(___)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)120 4674 y(int)47 b +(fits_write_subset\(fitsfi)o(le)42 b(*fptr,)k(int)h(datatype,)e(long)h +(*fpixel,)740 4787 y(long)h(*lpixel,)f(DTYPE)g(*array,)g(>)h(int)g +(*status\))120 5013 y(int)g(fits_read_subset\(fitsfil)o(e)42 +b(*fptr,)k(int)95 b(datatype,)45 b(long)h(*fpixel,)740 +5126 y(long)h(*lpixel,)f(long)g(*inc,)h(void)f(*nulval,)94 +b(void)46 b(*array,)740 5239 y(int)h(*anynul,)f(int)h(*status\))261 +5447 y Fg(Read)i(or)g(write)e(a)i(rectangular)g(section)g(of)g(the)f +(FITS)g(image.)96 b(These)49 b(are)g(v)m(ery)g(similar)d(to)120 +5560 y Fc(fits)p 318 5560 29 4 v 33 w(write)p 591 5560 +V 33 w(pix)37 b Fg(and)f Fc(fits)p 1180 5560 V 34 w(read)p +1406 5560 V 33 w(pix)g Fg(except)j(that)f(y)m(ou)f(sp)s(ecify)f(the)i +(last)f(pixel)f(co)s(ordinate)h(\(the)1905 5809 y(10)p +eop +%%Page: 11 11 +11 10 bop 120 573 a Fg(upp)s(er)22 b(righ)m(t)h(corner)h(of)g(the)h +(section\))f(instead)f(of)h(the)h(n)m(um)m(b)s(er)d(of)i(pixels)f(to)h +(b)s(e)g(read.)38 b(The)23 b(read)h(routine)120 686 y(also)38 +b(has)f(an)h Fc(inc)f Fg(parameter)h(whic)m(h)e(can)j(b)s(e)e(used)g +(to)h(read)g(only)f(ev)m(ery)h Fc(inc-th)e Fg(pixel)g(along)i(eac)m(h) +120 799 y(dimension)26 b(of)j(the)g(image.)40 b(Normally)28 +b Fc(inc[0])46 b(=)h(inc[1])f(=)i(1)28 b Fg(to)i(read)e(ev)m(ery)i +(pixel)d(in)g(a)i(2D)h(image.)120 912 y(T)-8 b(o)31 b(read)f(ev)m(ery)h +(other)g(pixel)e(in)g(the)h(en)m(tire)h(2D)g(image,)g(set)311 +1099 y Fc(fpixel[0])45 b(=)j(fpixel[1])d(=)i(1)311 1212 +y(lpixel[0])e(=)j({NAXIS1})311 1325 y(lpixel[1])d(=)j({NAXIS2})311 +1438 y(inc[0])e(=)h(inc[1])g(=)g(2)261 1626 y Fg(Or,)30 +b(to)h(read)f(the)h(8th)g(ro)m(w)f(of)h(a)f(2D)i(image,)e(set)311 +1813 y Fc(fpixel[0])45 b(=)j(1)311 1926 y(fpixel[1])d(=)j(8)311 +2039 y(lpixel[0])d(=)j({NAXIS1})311 2152 y(lpixel[1])d(=)j(8)311 +2265 y(inc[0])e(=)h(inc[1])g(=)g(1)1905 5809 y Fg(11)p +eop +%%Page: 12 12 +12 11 bop 120 573 a Fb(4.5)112 b(T)-9 b(able)37 b(I/O)h(Routines)120 +744 y Fg(This)29 b(section)h(lists)f(the)i(most)f(imp)s(ortan)m(t)g +(CFITSIO)f(routines)g(whic)m(h)g(op)s(erate)i(on)f(FITS)g(tables.)120 +957 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(__)120 +1070 y(int)47 b(fits_create_tbl\(fitsfile)41 b(*fptr,)46 +b(int)h(tbltype,)f(long)g(nrows,)g(int)h(tfields,)311 +1183 y(char)g(*ttype[],char)d(*tform[],)h(char)i(*tunit[],)e(char)i +(*extname,)e(int)i(*status\))261 1395 y Fg(Create)e(a)f(new)f(table)h +(extension)f(b)m(y)h(writing)e(the)i(required)e(k)m(eyw)m(ords)i(that)g +(de\014ne)f(the)h(table)120 1508 y(structure.)38 b(The)22 +b(required)e(n)m(ull)h(primary)f(arra)m(y)j(will)d(b)s(e)i(created)i +(\014rst)d(if)h(the)h(\014le)e(is)h(initially)d(completely)120 +1621 y(empt)m(y)-8 b(.)41 b Fc(tbltype)26 b Fg(de\014nes)i(the)g(t)m +(yp)s(e)h(of)g(table)f(and)g(can)g(ha)m(v)m(e)i(v)-5 +b(alues)28 b(of)g Fc(ASCII)p 2931 1621 29 4 v 33 w(TBL)47 +b(or)g(BINARY)p 3586 1621 V 33 w(TBL)p Fg(.)120 1734 +y(Binary)33 b(tables)h(are)h(generally)e(preferred)g(b)s(ecause)h(they) +h(are)f(more)h(e\016cien)m(t)f(and)g(supp)s(ort)f(a)h(greater)120 +1847 y(range)d(of)f(column)f(datat)m(yp)s(es)j(than)e(ASCI)s(I)f +(tables.)261 1960 y(The)c Fc(nrows)f Fg(parameter)i(giv)m(es)g(the)f +(initial)e(n)m(um)m(b)s(er)h(of)i(empt)m(y)g(ro)m(ws)f(to)h(b)s(e)f +(allo)s(cated)g(for)h(the)f(table;)120 2073 y(this)g(should)g(normally) +f(b)s(e)i(set)h(to)g(0.)40 b(The)26 b Fc(tfields)f Fg(parameter)i(giv)m +(es)f(the)h(n)m(um)m(b)s(er)e(of)i(columns)e(in)g(the)120 +2186 y(table)e(\(maxim)m(um)f(=)g(999\).)40 b(The)22 +b Fc(ttype,)46 b(tform)p Fg(,)24 b(and)e Fc(tunit)f Fg(parameters)i +(giv)m(e)h(the)f(name,)h(datat)m(yp)s(e,)120 2299 y(and)34 +b(ph)m(ysical)f(units)h(of)g(eac)m(h)i(column,)f(and)f +Fc(extname)f Fg(giv)m(es)i(the)g(name)g(for)f(the)h(table)g(\(the)g(v) +-5 b(alue)34 b(of)120 2412 y(the)j Fc(EXTNAME)e Fg(k)m(eyw)m(ord\).)61 +b(The)36 b(FITS)g(Standard)g(recommends)g(that)i(only)e(letters,)j +(digits,)e(and)f(the)120 2524 y(underscore)27 b(c)m(haracter)h(b)s(e)f +(used)g(in)f(column)g(names)h(with)f(no)h(em)m(b)s(edded)g(spaces.)40 +b(It)27 b(is)g(recommended)120 2637 y(that)k(all)e(the)i(column)e +(names)h(in)f(a)i(giv)m(en)f(table)h(b)s(e)e(unique)g(within)f(the)i +(\014rst)g(8)h(c)m(haracters.)261 2750 y(The)g(follo)m(wing)f(table)i +(sho)m(ws)f(the)h(TF)m(ORM)g(column)e(format)i(v)-5 b(alues)31 +b(that)h(are)g(allo)m(w)m(ed)g(in)e(ASCI)s(I)120 2863 +y(tables)g(and)g(in)f(binary)g(tables:)502 3051 y Fc(ASCII)46 +b(Table)h(Column)f(Format)g(Codes)502 3164 y(------------------------)o +(---)o(----)502 3277 y(\(w)h(=)g(column)g(width,)f(d)h(=)h(no.)e(of)i +(decimal)d(places)i(to)g(display\))693 3390 y(Aw)142 +b(-)48 b(character)d(string)693 3502 y(Iw)142 b(-)48 +b(integer)693 3615 y(Fw.d)e(-)i(fixed)e(floating)g(point)693 +3728 y(Ew.d)g(-)i(exponential)d(floating)g(point)693 +3841 y(Dw.d)h(-)i(exponential)d(floating)g(point)502 +4067 y(Binary)h(Table)g(Column)g(Format)g(Codes)502 4180 +y(------------------------)o(---)o(----)o(-)502 4293 +y(\(r)h(=)g(vector)g(length,)e(default)h(=)i(1\))693 +4406 y(rA)95 b(-)47 b(character)e(string)693 4519 y(rAw)i(-)g(array)f +(of)i(strings,)d(each)i(of)g(length)f(w)693 4632 y(rL)95 +b(-)47 b(logical)693 4744 y(rX)95 b(-)47 b(bit)693 4857 +y(rB)95 b(-)47 b(unsigned)f(byte)693 4970 y(rS)95 b(-)47 +b(signed)f(byte)h(**)693 5083 y(rI)95 b(-)47 b(signed)f(16-bit)g +(integer)693 5196 y(rU)95 b(-)47 b(unsigned)f(16-bit)g(integer)g(**)693 +5309 y(rJ)95 b(-)47 b(signed)f(32-bit)g(integer)693 5422 +y(rV)95 b(-)47 b(unsigned)f(32-bit)g(integer)g(**)693 +5535 y(rK)95 b(-)47 b(64-bit)f(integer)g(***)1905 5809 +y Fg(12)p eop +%%Page: 13 13 +13 12 bop 693 573 a Fc(rE)95 b(-)47 b(32-bit)f(floating)g(point)693 +686 y(rD)95 b(-)47 b(64-bit)f(floating)g(point)693 799 +y(rC)95 b(-)47 b(32-bit)f(complex)g(pair)693 912 y(rM)95 +b(-)47 b(64-bit)f(complex)g(pair)359 1137 y(**)h(The)g(S,)g(U)g(and)g +(V)h(format)e(codes)g(are)h(not)g(actual)f(legal)g(TFORMn)h(values.)502 +1250 y(CFITSIO)f(substitutes)e(the)j(somewhat)f(more)g(complicated)f +(set)i(of)502 1363 y(keywords)e(that)i(are)g(used)g(to)g(represent)e +(unsigned)h(integers)f(or)502 1476 y(signed)h(bytes.)311 +1702 y(***)h(The)g(64-bit)f(integer)g(format)g(is)h(experimental)d(and) +j(is)g(not)502 1815 y(officially)e(recognized)g(in)i(the)g(FITS)g +(Standard.)261 2002 y Fg(The)27 b Fc(tunit)e Fg(and)h +Fc(extname)f Fg(parameters)j(are)f(optional)f(and)h(ma)m(y)g(b)s(e)g +(set)g(to)h(NULL)f(if)f(they)h(are)g(not)120 2115 y(needed.)261 +2228 y(Note)41 b(that)f(it)e(ma)m(y)i(b)s(e)f(easier)g(to)h(create)h(a) +f(new)e(table)h(b)m(y)h(cop)m(ying)f(the)g(header)g(from)g(another)120 +2341 y(existing)29 b(table)i(with)e Fc(fits)p 1089 2341 +29 4 v 33 w(copy)p 1314 2341 V 33 w(header)g Fg(rather)h(than)g +(calling)f(this)g(routine.)120 2554 y Fc(________________________)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(__) +120 2667 y(int)47 b(fits_get_num_rows\(fitsfi)o(le)42 +b(*fptr,)k(long)g(*nrows,)g(int)h(*status\))120 2780 +y(int)g(fits_get_num_cols\(fitsfi)o(le)42 b(*fptr,)k(int)94 +b(*ncols,)46 b(int)h(*status\))261 2992 y Fg(Get)37 b(the)g(n)m(um)m(b) +s(er)d(of)j(ro)m(ws)f(or)g(columns)f(in)f(the)j(curren)m(t)e(FITS)h +(table.)58 b(The)35 b(n)m(um)m(b)s(er)g(of)h(ro)m(ws)g(is)120 +3105 y(giv)m(en)d(b)m(y)g(the)g Fc(NAXIS2)e Fg(k)m(eyw)m(ord)j(and)e +(the)h(n)m(um)m(b)s(er)f(of)h(columns)f(is)g(giv)m(en)h(b)m(y)g(the)g +Fc(TFIELDS)e Fg(k)m(eyw)m(ord)120 3218 y(in)e(the)i(header)f(of)g(the)h +(table.)120 3430 y Fc(________________________)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(__)120 +3543 y(int)47 b(fits_get_colnum\(fitsfile)41 b(*fptr,)46 +b(int)h(casesen,)f(char)g(*template,)1075 3656 y(int)g(*colnum,)g(int)h +(*status\))120 3769 y(int)g(fits_get_colname\(fitsfil)o(e)42 +b(*fptr,)k(int)h(casesen,)e(char)i(*template,)1075 3882 +y(char)f(*colname,)f(int)i(*colnum,)f(int)h(*status\))261 +4095 y Fg(Get)33 b(the)e(column)f(n)m(um)m(b)s(er)g(\(starting)i(with)e +(1,)i(not)g(0\))g(of)f(the)h(column)e(whose)h(name)h(matc)m(hes)g(the) +120 4208 y(sp)s(eci\014ed)37 b(template)i(name.)66 b(The)38 +b(only)g(di\013erence)g(in)f(these)i(2)g(routines)f(is)f(that)j(the)e +(2nd)g(one)h(also)120 4320 y(returns)29 b(the)i(name)f(of)h(the)f +(column)f(that)i(matc)m(hed)h(the)e(template)h(string.)261 +4433 y(Normally)-8 b(,)27 b Fc(casesen)d Fg(should)g(b)s(e)i(set)h(to)g +Fc(CASEINSEN)p Fg(,)d(but)i(it)f(ma)m(y)i(b)s(e)f(set)h(to)g +Fc(CASESEN)d Fg(to)j(force)g(the)120 4546 y(name)j(matc)m(hing)h(to)g +(b)s(e)f(case-sensitiv)m(e.)261 4659 y(The)22 b(input)e +Fc(template)g Fg(string)h(giv)m(es)i(the)f(name)h(of)f(the)h(desired)d +(column)h(and)h(ma)m(y)h(include)d(wildcard)120 4772 +y(c)m(haracters:)41 b(a)30 b(`*')g(matc)m(hes)g(an)m(y)f(sequence)g(of) +h(c)m(haracters)g(\(including)c(zero)k(c)m(haracters\),)h(`?')40 +b(matc)m(hes)120 4885 y(an)m(y)45 b(single)e(c)m(haracter,)50 +b(and)44 b(`#')h(matc)m(hes)g(an)m(y)g(consecutiv)m(e)h(string)d(of)i +(decimal)f(digits)f(\(0-9\).)85 b(If)120 4998 y(more)27 +b(than)g(one)g(column)f(name)h(in)f(the)h(table)g(matc)m(hes)h(the)f +(template)g(string,)g(then)g(the)g(\014rst)f(matc)m(h)i(is)120 +5111 y(returned)22 b(and)h(the)h(status)f(v)-5 b(alue)23 +b(will)e(b)s(e)i(set)h(to)g Fc(COL)p 1962 5111 V 33 w(NOT)p +2139 5111 V 34 w(UNIQUE)e Fg(as)h(a)h(w)m(arning)e(that)i(a)g(unique)d +(matc)m(h)120 5224 y(w)m(as)34 b(not)g(found.)50 b(T)-8 +b(o)35 b(\014nd)d(the)i(next)g(column)f(that)i(matc)m(hes)g(the)f +(template,)h(call)f(this)e(routine)h(again)120 5337 y(lea)m(ving)d(the) +h(input)d(status)j(v)-5 b(alue)30 b(equal)g(to)h Fc(COL)p +1832 5337 V 33 w(NOT)p 2009 5337 V 34 w(UNIQUE)p Fg(.)e(Rep)s(eat)i +(this)e(pro)s(cess)h(un)m(til)f Fc(status)46 b(=)120 +5450 y(COL)p 270 5450 V 34 w(NOT)p 448 5450 V 33 w(FOUND)29 +b Fg(is)g(returned.)1905 5809 y(13)p eop +%%Page: 14 14 +14 13 bop 120 573 a Fc(________________________)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(__)120 +686 y(int)47 b(fits_get_coltype\(fitsfil)o(e)42 b(*fptr,)k(int)h +(colnum,)f(int)h(*typecode,)1122 799 y(long)g(*repeat,)e(long)i +(*width,)f(int)h(*status\))261 1011 y Fg(Return)41 b(the)h(datat)m(yp)s +(e,)k(v)m(ector)d(rep)s(eat)f(coun)m(t,)j(and)c(the)h(width)e(in)g(b)m +(ytes)i(of)g(a)g(single)f(column)120 1124 y(elemen)m(t)i(for)e(column)g +(n)m(um)m(b)s(er)g Fc(colnum)p Fg(.)74 b(Allo)m(w)m(ed)42 +b(v)-5 b(alues)41 b(for)h(the)g(returned)f(datat)m(yp)s(e)i(in)e(ASCI)s +(I)120 1237 y(tables)30 b(are:)42 b Fc(TSTRING,)j(TSHORT,)h(TLONG,)g +(TFLOAT,)g(and)h(TDOUBLE)p Fg(.)29 b(Binary)h(tables)g(supp)s(ort)f +(these)120 1350 y(additional)19 b(t)m(yp)s(es:)36 b Fc(TLOGICAL,)45 +b(TBIT,)h(TBYTE,)g(TINT32BIT,)f(TCOMPLEX)h(and)h(TDBLCOMPLEX)p +Fg(.)18 b(The)120 1463 y(negativ)m(e)34 b(of)f(the)h(datat)m(yp)s(e)g +(co)s(de)f(v)-5 b(alue)32 b(is)h(returned)e(if)h(it)h(is)f(a)h(v)-5 +b(ariable)32 b(length)h(arra)m(y)g(column.)48 b(The)120 +1576 y(rep)s(eat)31 b(coun)m(t)g(is)e(alw)m(a)m(ys)i(1)g(in)e(ASCI)s(I) +g(tables.)261 1689 y(The)39 b('rep)s(eat')g(parameter)h(returns)e(the)h +(v)m(ector)h(rep)s(eat)g(coun)m(t)f(on)g(the)g(binary)f(table)g(TF)m +(ORMn)120 1802 y(k)m(eyw)m(ord)44 b(v)-5 b(alue.)78 b(\(ASCI)s(I)42 +b(table)h(columns)f(alw)m(a)m(ys)i(ha)m(v)m(e)g(rep)s(eat)g(=)e(1\).)80 +b(The)43 b('width')f(parameter)120 1914 y(returns)d(the)i(width)e(in)h +(b)m(ytes)h(of)g(a)g(single)e(column)h(elemen)m(t)h(\(e.g.,)k(a)c +('10D')i(binary)c(table)i(column)120 2027 y(will)c(ha)m(v)m(e)42 +b(width)c(=)i(8,)j(an)d(ASCI)s(I)e(table)i('F12.2')j(column)c(will)e +(ha)m(v)m(e)42 b(width)c(=)i(12,)j(and)d(a)g(binary)120 +2140 y(table'60A')26 b(c)m(haracter)h(string)c(column)h(will)e(ha)m(v)m +(e)k(width)d(=)h(60\);)k(Note)f(that)e(this)f(routine)f(supp)s(orts)g +(the)120 2253 y(lo)s(cal)31 b(con)m(v)m(en)m(tion)j(for)e(sp)s +(ecifying)e(arra)m(ys)i(of)h(\014xed)e(length)h(strings)f(within)f(a)i +(binary)f(table)h(c)m(haracter)120 2366 y(column)37 b(using)f(the)j +(syn)m(tax)f(TF)m(ORM)h(=)e('rAw')h(where)g('r')g(is)f(the)h(total)h(n) +m(um)m(b)s(er)e(of)h(c)m(haracters)h(\(=)120 2479 y(the)d(width)d(of)j +(the)f(column\))g(and)f('w')i(is)e(the)i(width)d(of)j(a)f(unit)f +(string)g(within)f(the)j(column.)54 b(Th)m(us)34 b(if)120 +2592 y(the)i(column)f(has)h(TF)m(ORM)g(=)g('60A12')j(then)c(this)g +(means)h(that)h(eac)m(h)g(ro)m(w)f(of)h(the)f(table)g(con)m(tains)g(5) +120 2705 y(12-c)m(haracter)h(substrings)31 b(within)h(the)i(60-c)m +(haracter)j(\014eld,)d(and)f(th)m(us)h(in)e(this)h(case)i(this)e +(routine)g(will)120 2818 y(return)25 b(t)m(yp)s(eco)s(de)i(=)f +(TSTRING,)f(rep)s(eat)i(=)e(60,)k(and)c(width)g(=)h(12.)40 +b(The)25 b(n)m(um)m(b)s(er)g(of)i(substings)d(in)h(an)m(y)120 +2931 y(binary)31 b(table)h(c)m(haracter)i(string)e(\014eld)f(can)i(b)s +(e)f(calculated)h(b)m(y)f(\(rep)s(eat/width\).)47 b(A)33 +b(n)m(ull)d(p)s(oin)m(ter)i(ma)m(y)120 3044 y(b)s(e)e(giv)m(en)g(for)g +(an)m(y)h(of)g(the)f(output)g(parameters)h(that)g(are)f(not)h(needed.) +120 3256 y Fc(________________________)o(____)o(____)o(___)o(____)o +(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)120 +3369 y(int)47 b(fits_insert_rows\(fitsfil)o(e)42 b(*fptr,)k(long)h +(firstrow,)e(long)h(nrows,)h(int)f(*status\))120 3482 +y(int)h(fits_delete_rows\(fitsfil)o(e)42 b(*fptr,)k(long)h(firstrow,)e +(long)h(nrows,)h(int)f(*status\))120 3595 y(int)h +(fits_delete_rowrange\(fit)o(sfil)o(e)42 b(*fptr,)k(char)g(*rangelist,) +f(int)i(*status\))120 3708 y(int)g(fits_delete_rowlist\(fits)o(file)41 +b(*fptr,)46 b(long)h(*rowlist,)e(long)i(nrows,)f(int)h(*stat\))261 +3920 y Fg(Insert)33 b(or)g(delete)g(ro)m(ws)g(in)e(a)j(table.)48 +b(The)33 b(blank)e(ro)m(ws)i(are)h(inserted)d(immediately)h(follo)m +(wing)f(ro)m(w)120 4033 y Fc(frow)p Fg(.)54 b(Set)35 +b Fc(frow)f Fg(=)g(0)i(to)f(insert)f(ro)m(ws)h(at)h(the)f(b)s(eginning) +e(of)i(the)g(table.)55 b(The)34 b(\014rst)h('delete')g(routine)120 +4146 y(deletes)k Fc(nrows)e Fg(ro)m(ws)i(b)s(eginning)d(with)i(ro)m(w)h +Fc(firstrow)p Fg(.)64 b(The)38 b(2nd)g(delete)h(routine)f(tak)m(es)j +(an)d(input)120 4259 y(string)26 b(listing)f(the)i(ro)m(ws)f(or)h(ro)m +(w)g(ranges)g(to)h(b)s(e)e(deleted)h(\(e.g.,)i('2,4-7,)h(9-12'\).)42 +b(The)26 b(last)h(delete)g(routine)120 4372 y(tak)m(es)35 +b(an)f(input)d(long)i(in)m(teger)h(arra)m(y)h(that)f(sp)s(eci\014es)e +(eac)m(h)j(individual)29 b(ro)m(w)34 b(to)g(b)s(e)f(deleted.)50 +b(The)33 b(ro)m(w)120 4485 y(lists)h(m)m(ust)h(b)s(e)f(sorted)i(in)e +(ascending)g(order.)55 b(All)34 b(these)i(routines)e(up)s(date)g(the)i +(v)-5 b(alue)34 b(of)i(the)f Fc(NAXIS2)120 4598 y Fg(k)m(eyw)m(ord)c +(to)g(re\015ect)g(the)f(new)g(n)m(um)m(b)s(er)f(of)i(ro)m(ws)f(in)f +(the)i(table.)120 4810 y Fc(________________________)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o +(____)o(_)120 4923 y(int)47 b(fits_insert_col\(fitsfile)41 +b(*fptr,)46 b(int)h(colnum,)f(char)h(*ttype,)e(char)i(*tform,)1075 +5036 y(int)f(*status\))120 5149 y(int)h(fits_insert_cols\(fitsfil)o(e) +42 b(*fptr,)k(int)h(colnum,)f(int)h(ncols,)f(char)g(**ttype,)1122 +5262 y(char)h(**tform,)e(int)i(*status\))120 5488 y(int)g +(fits_delete_col\(fitsfile)41 b(*fptr,)46 b(int)h(colnum,)f(int)h +(*status\))1905 5809 y Fg(14)p eop +%%Page: 15 15 +15 14 bop 261 573 a Fg(Insert)25 b(or)g(delete)g(columns)f(in)f(a)j +(table.)38 b Fc(colnum)24 b Fg(giv)m(es)h(the)g(p)s(osition)e(of)i(the) +h(column)d(to)j(b)s(e)f(inserted)120 686 y(or)34 b(deleted)f(\(where)h +(the)g(\014rst)f(column)g(of)h(the)g(table)g(is)e(at)j(p)s(osition)d +(1\).)52 b Fc(ttype)32 b Fg(and)h Fc(tform)g Fg(giv)m(e)h(the)120 +799 y(column)j(name)i(and)f(column)f(format,)k(where)d(the)h(allo)m(w)m +(ed)g(format)f(co)s(des)h(are)g(listed)e(ab)s(o)m(v)m(e)j(in)d(the)120 +912 y(description)43 b(of)i(the)h Fc(fits)p 1088 912 +29 4 v 33 w(create)p 1409 912 V 33 w(table)d Fg(routine.)84 +b(The)45 b(2nd)f('insert')h(routine)f(inserts)g(m)m(ultiple)120 +1024 y(columns,)32 b(where)h Fc(ncols)e Fg(is)h(the)h(n)m(um)m(b)s(er)e +(of)i(columns)f(to)h(insert,)g(and)f Fc(ttype)f Fg(and)h +Fc(tform)g Fg(are)h(arra)m(ys)120 1137 y(of)e(string)e(p)s(oin)m(ters)g +(in)g(this)g(case.)120 1312 y Fc(________________________)o(____)o +(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o +(___)120 1425 y(int)47 b(fits_copy_col\(fitsfile)42 b(*infptr,)j +(fitsfile)h(*outfptr,)f(int)i(incolnum,)502 1537 y(int)g(outcolnum,)e +(int)i(create_col,)d(int)j(*status\);)261 1712 y Fg(Cop)m(y)31 +b(a)g(column)f(from)g(one)i(table)e(HDU)i(to)g(another.)42 +b(If)31 b Fc(create)p 2609 1712 V 32 w(col)f Fg(=)h(TR)m(UE)g(\(i.e.,)h +(not)f(equal)120 1825 y(to)42 b(zero\),)k(then)41 b(a)h(new)f(column)f +(will)f(b)s(e)i(inserted)f(in)h(the)g(output)g(table)h(at)g(p)s +(osition)e Fc(outcolumn)p Fg(,)120 1937 y(otherwise)30 +b(the)g(v)-5 b(alues)30 b(in)f(the)i(existing)e(output)h(column)f(will) +f(b)s(e)i(o)m(v)m(erwritten.)120 2112 y Fc(________________________)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o +(____)o(___)o(____)o(__)120 2225 y(int)47 b(fits_write_col\(fitsfile)41 +b(*fptr,)46 b(int)h(datatype,)f(int)h(colnum,)e(long)i(firstrow,)979 +2337 y(long)g(firstelem,)e(long)h(nelements,)f(void)i(*array,)f(int)h +(*status\))120 2450 y(int)g(fits_write_colnull\(fitsf)o(ile)41 +b(*fptr,)46 b(int)h(datatype,)f(int)g(colnum,)979 2563 +y(long)h(firstrow,)e(long)i(firstelem,)e(long)h(nelements,)979 +2676 y(void)h(*array,)f(void)g(*nulval,)g(int)h(*status\))120 +2789 y(int)g(fits_write_col_null\(fits)o(file)41 b(*fptr,)46 +b(int)h(colnum,)f(long)g(firstrow,)979 2902 y(long)h(firstelem,)e(long) +h(nelements,)f(int)i(*status\))120 3128 y(int)g +(fits_read_col\(fitsfile)42 b(*fptr,)k(int)h(datatype,)e(int)i(colnum,) +f(long)g(firstrow,)454 3241 y(long)h(firstelem,)e(long)h(nelements,)f +(void)i(*nulval,)f(void)g(*array,)454 3354 y(int)h(*anynul,)f(int)g +(*status\))261 3641 y Fg(W)-8 b(rite)44 b(or)f(read)g(elemen)m(ts)h(in) +e(column)g(n)m(um)m(b)s(er)g Fc(colnum)p Fg(,)j(starting)e(with)f(ro)m +(w)h Fc(firstsrow)e Fg(and)120 3754 y(elemen)m(t)33 b +Fc(firstelem)d Fg(\(if)i(it)g(is)g(a)h(v)m(ector)h(column\).)46 +b Fc(firstelem)30 b Fg(is)i(ignored)g(if)f(it)h(is)g(a)h(scalar)f +(column.)120 3867 y(The)d Fc(nelements)f Fg(n)m(um)m(b)s(er)g(of)i +(elemen)m(ts)h(are)f(read)g(or)f(written)g(con)m(tin)m(uing)g(on)h +(successiv)m(e)g(ro)m(ws)g(of)g(the)120 3980 y(table)36 +b(if)f(necessary)-8 b(.)59 b Fc(array)35 b Fg(is)g(the)i(address)e(of)h +(an)g(arra)m(y)h(whic)m(h)e(either)h(con)m(tains)g(the)h(v)-5 +b(alues)35 b(to)i(b)s(e)120 4092 y(written,)27 b(or)f(will)e(hold)i +(the)g(returned)g(v)-5 b(alues)26 b(that)h(are)g(read.)39 +b(When)27 b(reading,)g Fc(array)e Fg(m)m(ust)h(ha)m(v)m(e)i(b)s(een)120 +4205 y(allo)s(cated)i(large)h(enough)f(to)h(hold)e(all)g(the)i +(returned)e(v)-5 b(alues.)261 4318 y(There)40 b(are)h(3)h(di\013eren)m +(t)e('write')g(column)g(routines:)60 b(The)40 b(\014rst)g(simply)e +(writes)i(the)h(input)e(arra)m(y)120 4431 y(in)m(to)32 +b(the)g(column.)43 b(The)31 b(second)h(is)f(similar,)e(except)k(that)f +(it)f(substitutes)g(the)h(appropriate)e(n)m(ull)g(pixel)120 +4544 y(v)-5 b(alue)35 b(in)e(the)j(column)d(for)i(an)m(y)h(input)d +(arra)m(y)i(v)-5 b(alues)35 b(whic)m(h)f(are)h(equal)g(to)h +Fc(*nulval)d Fg(\(note)j(that)f(this)120 4657 y(parameter)k(giv)m(es)f +(the)h(address)e(of)i(the)f(n)m(ull)e(pixel)h(v)-5 b(alue,)40 +b(not)e(the)h(v)-5 b(alue)37 b(itself)7 b(\).)64 b(The)38 +b(third)e(write)120 4770 y(routine)27 b(sets)h(the)g(sp)s(eci\014ed)e +(table)i(elemen)m(ts)g(to)h(a)f(n)m(ull)e(v)-5 b(alue.)39 +b(New)28 b(ro)m(ws)g(will)d(b)s(e)j(automatical)g(added)120 +4883 y(to)j(the)g(table)f(if)f(the)i(write)e(op)s(eration)h(extends)h +(b)s(ey)m(ond)e(the)i(curren)m(t)f(size)g(of)h(the)f(table.)261 +4996 y(When)42 b(reading)f(a)i(column,)h(CFITSIO)c(will)g(substitute)h +(the)h(v)-5 b(alue)42 b(giv)m(en)g(b)m(y)g Fc(nulval)e +Fg(for)i(an)m(y)120 5109 y(unde\014ned)25 b(elemen)m(ts)i(in)f(the)h +(FITS)f(column,)h(unless)e Fc(nulval)g Fg(or)i Fc(*nulval)46 +b(=)h(NULL)p Fg(,)26 b(in)g(whic)m(h)f(case)j(no)120 +5222 y(c)m(hec)m(ks)k(will)c(b)s(e)h(made)i(for)f(unde\014ned)e(v)-5 +b(alues)30 b(when)f(reading)h(the)g(column.)261 5334 +y Fc(datatype)i Fg(sp)s(eci\014es)h(the)h(datat)m(yp)s(e)h(of)g(the)f +(C)g Fc(array)e Fg(in)h(the)h(program,)i(whic)m(h)c(need)i(not)h(b)s(e) +e(the)120 5447 y(same)42 b(as)f(the)g(in)m(trinsic)e(datat)m(yp)s(e)j +(of)f(the)h(column)e(in)g(the)h(FITS)g(table.)73 b(The)40 +b(follo)m(wing)g(sym)m(b)s(olic)120 5560 y(constan)m(ts)32 +b(are)e(allo)m(w)m(ed)h(for)f(the)g(v)-5 b(alue)30 b(of)h +Fc(datatype)p Fg(:)1905 5809 y(15)p eop +%%Page: 16 16 +16 15 bop 215 573 a Fc(TSTRING)142 b(array)46 b(of)h(character)f +(string)g(pointers)215 686 y(TBYTE)238 b(unsigned)45 +b(char)215 799 y(TSHORT)190 b(signed)46 b(short)215 912 +y(TUSHORT)142 b(unsigned)45 b(short)215 1024 y(TINT)286 +b(signed)46 b(int)215 1137 y(TUINT)238 b(unsigned)45 +b(int)215 1250 y(TLONG)238 b(signed)46 b(long)215 1363 +y(TULONG)190 b(unsigned)45 b(long)215 1476 y(TFLOAT)190 +b(float)215 1589 y(TDOUBLE)142 b(double)261 1791 y Fg(Note)35 +b(that)e Fc(TSTRING)f Fg(corresp)s(onds)g(to)h(the)h(C)f +Fc(char**)e Fg(datat)m(yp)s(e,)k(i.e.,)g(a)e(p)s(oin)m(ter)f(to)i(an)f +(arra)m(y)h(of)120 1904 y(p)s(oin)m(ters)29 b(to)i(an)g(arra)m(y)f(of)h +(c)m(haracters.)261 2017 y(An)m(y)38 b(column,)i(regardless)d(of)i +(it's)f(in)m(trinsic)d(datat)m(yp)s(e,)42 b(ma)m(y)d(b)s(e)e(read)h(as) +h(a)f Fc(TSTRING)f Fg(c)m(haracter)120 2130 y(string.)h(The)24 +b(displa)m(y)g(format)h(of)g(the)h(returned)e(strings)f(will)g(b)s(e)h +(determined)g(b)m(y)h(the)g Fc(TDISPn)f Fg(k)m(eyw)m(ord,)120 +2243 y(if)i(it)h(exists,)h(otherwise)f(a)g(default)g(format)h(will)c(b) +s(e)j(used)f(dep)s(ending)f(on)j(the)f(datat)m(yp)s(e)h(of)g(the)f +(column.)120 2356 y(The)22 b Fc(tablist)e Fg(example)i(utilit)m(y)f +(program)h(\(a)m(v)-5 b(ailable)22 b(from)g(the)h(CFITSIO)e(w)m(eb)h +(site\))h(uses)f(this)f(feature)120 2469 y(to)31 b(displa)m(y)e(all)g +(the)i(v)-5 b(alues)29 b(in)g(a)i(FITS)f(table.)120 2671 +y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(___)o(_)120 2784 y(int)47 +b(fits_select_rows\(fitsfil)o(e)42 b(*infptr,)j(fitsfile)h(*outfptr,)f +(char)i(*expr,)1122 2897 y(int)g(*status\))120 3010 y(int)g +(fits_calculator\(fitsfile)41 b(*infptr,)46 b(char)g(*expr,)g(fitsfile) +g(*outfptr,)1075 3123 y(char)g(*colname,)f(char)i(*tform,)f(int)h +(*status\))261 3325 y Fg(These)26 b(are)h(2)g(of)g(the)f(most)h(p)s(o)m +(w)m(erful)e(routines)h(in)f(the)i(CFITSIO)d(library)-8 +b(.)38 b(\(See)27 b(the)g(full)d(CFITSIO)120 3438 y(Reference)37 +b(Guide)e(for)h(a)h(description)d(of)i(sev)m(eral)h(related)f +(routines\).)57 b(These)36 b(routines)f(can)i(p)s(erform)120 +3551 y(complicated)45 b(transformations)g(on)g(tables)g(based)g(on)g +(an)g(input)f(arithmetic)g(expression)g(whic)m(h)g(is)120 +3664 y(ev)-5 b(aluated)37 b(for)f(eac)m(h)h(ro)m(w)g(of)g(the)f(table.) +59 b(The)36 b(\014rst)g(routine)f(will)f(select)j(or)g(cop)m(y)g(ro)m +(ws)f(of)h(the)f(table)120 3777 y(for)i(whic)m(h)f(the)h(expression)f +(ev)-5 b(aluates)39 b(to)g(TR)m(UE)g(\(i.e.,)h(not)f(equal)f(to)h +(zero\).)65 b(The)38 b(second)g(routine)120 3890 y(writes)c(the)h(v)-5 +b(alue)34 b(of)h(the)g(expression)f(to)i(a)f(column)f(in)f(the)i +(output)g(table.)54 b(Rather)35 b(than)g(supplying)120 +4003 y(the)j(expression)e(directly)g(to)i(these)g(routines,)h(the)e +(expression)g(ma)m(y)h(also)f(b)s(e)g(written)g(to)h(a)g(text)g(\014le) +120 4116 y(\(con)m(tin)m(ued)e(o)m(v)m(er)g(m)m(ultiple)e(lines)f(if)i +(necessary\))h(and)f(the)h(name)f(of)h(the)g(\014le,)g(prep)s(ended)d +(with)h(a)i('@')120 4229 y(c)m(haracter,)c(ma)m(y)f(b)s(e)f(supplied)d +(as)k(the)f(v)-5 b(alue)30 b(of)h(the)f('expr')g(parameter)h(\(e.g.)42 +b('@\014lename.txt'\).)261 4342 y(The)26 b(arithmetic)f(expression)g +(ma)m(y)i(b)s(e)f(a)g(function)f(of)h(an)m(y)h(column)e(or)h(k)m(eyw)m +(ord)h(in)e(the)h(input)e(table)120 4455 y(as)31 b(sho)m(wn)e(in)g +(these)i(examples:)120 4657 y Fc(Row)47 b(Selection)e(Expressions:)263 +4770 y(counts)h(>)i(0)1240 b(uses)47 b(COUNTS)f(column)g(value)263 +4883 y(sqrt\()h(X**2)f(+)i(Y**2\))e(<)h(10.)572 b(uses)47 +b(X)g(and)g(Y)h(column)e(values)263 4996 y(\(X)h(>)h(10\))f(||)g(\(X)g +(<)h(-10\))e(&&)h(\(Y)h(==)f(0\))142 b(used)47 b('or')g(and)g('and')f +(operators)263 5109 y(gtifilter\(\))1190 b(filter)46 +b(on)i(Good)e(Time)h(Intervals)263 5222 y(regfilter\("myregion.reg"\)) +518 b(filter)46 b(using)h(a)g(region)f(file)263 5334 +y(@select.txt)1190 b(reads)47 b(expression)e(from)h(a)i(text)e(file)120 +5447 y(Calculator)f(Expressions:)263 5560 y(#row)i(\045)g(10)1145 +b(modulus)46 b(of)h(the)g(row)g(number)1905 5809 y Fg(16)p +eop +%%Page: 17 17 +17 16 bop 263 573 a Fc(counts/#exposure)807 b(Fn)47 b(of)h(COUNTS)e +(column)g(and)h(EXPOSURE)e(keyword)263 686 y(dec)i(<)h(85)f(?)g +(cos\(dec)f(*)h(#deg\))g(:)g(0)143 b(Conditional)45 b(expression:)g +(evaluates)g(to)1934 799 y(cos\(dec\))g(if)i(dec)g(<)h(85,)f(else)f(0) +263 912 y(\(count{-1}+count+count{+1)o(}\)/3)o(.)137 +b(running)46 b(mean)h(of)g(the)g(count)f(values)g(in)h(the)1934 +1024 y(previous,)e(current,)g(and)i(next)g(rows)263 1137 +y(max\(0,)f(min\(X,)g(1000\)\))619 b(returns)46 b(a)h(value)g(between)f +(0)h(-)h(1000)263 1250 y(@calc.txt)1143 b(reads)47 b(expression)e(from) +h(a)i(text)e(file)261 1463 y Fg(Most)40 b(standard)d(mathematical)i(op) +s(erators)g(and)f(functions)f(are)i(supp)s(orted.)64 +b(If)38 b(the)h(expression)120 1576 y(includes)32 b(the)j(name)f(of)h +(a)f(column,)h(than)f(the)h(v)-5 b(alue)34 b(in)f(the)h(curren)m(t)h +(ro)m(w)f(of)h(the)f(table)h(will)c(b)s(e)j(used)120 +1689 y(when)f(ev)-5 b(aluating)33 b(the)h(expression)f(on)h(eac)m(h)h +(ro)m(w.)51 b(An)34 b(o\013set)h(to)g(an)e(adjacen)m(t)j(ro)m(w)e(can)g +(b)s(e)f(sp)s(eci\014ed)120 1802 y(b)m(y)d(including)d(the)j(o\013set)h +(v)-5 b(alue)29 b(in)g(curly)g(brac)m(k)m(ets)i(after)g(the)f(column)f +(name)h(as)g(sho)m(wn)g(in)f(one)h(of)g(the)120 1914 +y(examples.)39 b(Keyw)m(ord)27 b(v)-5 b(alues)27 b(can)g(b)s(e)g +(included)d(in)i(the)i(expression)e(b)m(y)h(preceding)f(the)i(k)m(eyw)m +(ord)f(name)120 2027 y(with)g(a)i(`#')f(sign.)39 b(See)28 +b(Section)h(5)f(of)h(this)e(do)s(cumen)m(t)h(for)g(more)g(discussion)e +(of)i(the)h(expression)e(syn)m(tax.)261 2140 y Fc(gtifilter)i +Fg(is)h(a)i(sp)s(ecial)e(function)g(whic)m(h)g(tests)i(whether)f(the)h +Fc(TIME)e Fg(column)g(v)-5 b(alue)31 b(in)f(the)h(input)120 +2253 y(table)38 b(falls)f(within)f(one)j(or)f(more)h(Go)s(o)s(d)f(Time) +f(In)m(terv)-5 b(als.)65 b(By)39 b(default,)g(this)f(function)f(lo)s +(oks)h(for)g(a)120 2366 y('GTI')27 b(extension)f(in)f(the)i(same)g +(\014le)e(as)i(the)g(input)d(table.)40 b(The)26 b('GTI')g(table)h(con)m +(tains)g Fc(START)e Fg(and)h Fc(STOP)120 2479 y Fg(columns)f(whic)m(h)h +(de\014ne)g(the)g(range)h(of)g(eac)m(h)h(go)s(o)s(d)f(time)f(in)m(terv) +-5 b(al.)39 b(See)27 b(section)f(5.4.3)j(for)d(more)h(details.)261 +2592 y Fc(regfilter)35 b Fg(is)h(another)h(sp)s(ecial)f(function)g +(whic)m(h)g(selects)h(ro)m(ws)h(based)e(on)h(whether)g(the)g(spatial) +120 2705 y(p)s(osition)21 b(asso)s(ciated)j(with)e(eac)m(h)j(ro)m(w)e +(is)f(lo)s(cated)i(within)d(in)h(a)h(sp)s(eci\014ed)f(region)h(of)g +(the)h(sky)-8 b(.)38 b(By)24 b(default,)120 2818 y(the)35 +b Fc(X)g Fg(and)f Fc(Y)h Fg(columns)f(in)g(the)h(input)e(table)i(are)g +(assumed)g(to)h(giv)m(e)f(the)g(p)s(osition)e(of)j(eac)m(h)g(ro)m(w.)55 +b(The)120 2931 y(spatial)35 b(region)g(is)f(de\014ned)h(in)f(an)h(ASCI) +s(I)f(text)j(\014le)d(whose)i(name)f(is)g(giv)m(en)g(as)h(the)g +(argumen)m(t)g(to)g(the)120 3044 y Fc(regfilter)28 b +Fg(function.)39 b(See)31 b(section)f(5.4.4)j(for)d(more)g(details.)261 +3156 y(The)e Fc(infptr)e Fg(and)i Fc(outfptr)e Fg(parameters)j(in)e +(these)h(routines)f(ma)m(y)i(p)s(oin)m(t)e(to)i(the)g(same)f(table)g +(or)h(to)120 3269 y(di\013eren)m(t)h(tables.)42 b(In)31 +b Fc(fits)p 1092 3269 29 4 v 33 w(select)p 1413 3269 +V 33 w(rows)p Fg(,)f(if)f(the)j(input)c(and)j(output)f(tables)h(are)g +(the)g(same)h(then)e(the)120 3382 y(ro)m(ws)e(that)h(do)f(not)g +(satisfy)g(the)g(selection)g(expression)f(will)e(b)s(e)i(deleted)h +(from)g(the)g(table.)40 b(Otherwise,)27 b(if)120 3495 +y(the)k(output)g(table)g(is)f(di\013eren)m(t)h(from)g(the)g(input)e +(table)i(then)g(the)g(selected)h(ro)m(ws)f(will)e(b)s(e)h(copied)h +(from)120 3608 y(the)g(input)d(table)i(to)h(the)g(output)f(table.)261 +3721 y(The)i(output)g(column)f(in)g Fc(fits)p 1376 3721 +V 33 w(calculator)f Fg(ma)m(y)i(or)h(ma)m(y)g(not)f(already)g(exist.)46 +b(If)32 b(it)g(exists)g(then)120 3834 y(the)44 b(calculated)f(v)-5 +b(alues)43 b(will)e(b)s(e)i(written)g(to)h(that)h(column,)h(o)m(v)m +(erwriting)d(the)g(existing)g(v)-5 b(alues.)80 b(If)120 +3947 y(the)36 b(column)f(do)s(esn't)h(exist)f(then)h(the)g(new)g +(column)e(will)g(b)s(e)h(app)s(ended)f(to)j(the)f(output)g(table.)57 +b(The)120 4060 y Fc(tform)37 b Fg(parameter)i(can)f(b)s(e)g(used)g(to)h +(sp)s(ecify)e(the)h(datat)m(yp)s(e)i(of)e(the)h(new)f(column)f(\(e.g.,) +42 b(the)d Fc(TFORM)120 4173 y Fg(k)m(eyw)m(ord)26 b(v)-5 +b(alue)25 b(as)h(in)f Fc('1E',)46 b(or)h('1J')p Fg(\).)25 +b(If)h Fc(tform)e Fg(=)h(NULL)h(then)f(a)h(default)f(datat)m(yp)s(e)i +(will)c(b)s(e)i(used,)120 4286 y(dep)s(ending)j(on)i(the)h(expression.) +120 4498 y Fc(________________________)o(____)o(____)o(___)o(____)o +(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(_)120 +4611 y(int)47 b(fits_read_tblbytes\(fitsf)o(ile)41 b(*fptr,)46 +b(long)h(firstrow,)e(long)i(firstchar,)1122 4724 y(long)g(nchars,)f +(unsigned)f(char)i(*array,)f(int)h(*status\))120 4837 +y(int)g(fits_write_tblbytes)42 b(\(fitsfile)k(*fptr,)g(long)g +(firstrow,)g(long)g(firstchar,)1122 4950 y(long)h(nchars,)f(unsigned)f +(char)i(*array,)f(int)h(*status\))261 5162 y Fg(These)35 +b(2)g(routines)e(pro)m(vide)h(lo)m(w-lev)m(el)h(access)h(to)f(tables)g +(and)f(are)h(mainly)e(useful)g(as)i(an)g(e\016cien)m(t)120 +5275 y(w)m(a)m(y)i(to)g(cop)m(y)g(ro)m(ws)f(of)g(a)h(table)f(from)g +(one)g(\014le)f(to)i(another.)58 b(These)36 b(routines)f(simply)f(read) +i(or)g(write)120 5388 y(the)30 b(sp)s(eci\014ed)f(n)m(um)m(b)s(er)g(of) +h(consecutiv)m(e)i(c)m(haracters)f(\(b)m(ytes\))h(in)d(a)i(table,)f +(without)f(regard)h(for)h(column)120 5501 y(b)s(oundaries.)83 +b(F)-8 b(or)47 b(example,)i(to)d(read)f(or)h(write)e(the)i(\014rst)f +(ro)m(w)g(of)h(a)g(table,)j(set)d Fc(firstrow)g(=)h(1,)1905 +5809 y Fg(17)p eop +%%Page: 18 18 +18 17 bop 120 573 a Fc(firstchar)45 b(=)j(1)p Fg(,)38 +b(and)e Fc(nchars)46 b(=)i(NAXIS1)35 b Fg(where)h(the)h(length)f(of)h +(a)h(ro)m(w)f(is)e(giv)m(en)i(b)m(y)g(the)g(v)-5 b(alue)36 +b(of)120 686 y(the)31 b Fc(NAXIS1)f Fg(header)h(k)m(eyw)m(ord.)43 +b(When)31 b(reading)g(a)g(table,)h Fc(array)e Fg(m)m(ust)h(ha)m(v)m(e)h +(b)s(een)f(declared)f(at)i(least)120 799 y Fc(nchars)d +Fg(b)m(ytes)i(long)f(to)h(hold)e(the)h(returned)f(string)h(of)g(b)m +(ytes.)1905 5809 y(18)p eop +%%Page: 19 19 +19 18 bop 120 573 a Fb(4.6)112 b(Header)38 b(Keyw)m(ord)f(I/O)h +(Routines)120 744 y Fg(The)30 b(follo)m(wing)f(routines)g(read)h(and)g +(write)g(header)g(k)m(eyw)m(ords)g(in)g(the)g(curren)m(t)g(HDU.)120 +957 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(___)120 1070 +y(int)47 b(fits_get_hdrspace\(fitsfi)o(le)42 b(*fptr,)k(int)h +(*keysexist,)d(int)j(*morekeys,)1170 1183 y(int)g(*status\))120 +1395 y Fg(Return)36 b(the)g(n)m(um)m(b)s(er)f(of)i(existing)e(k)m(eyw)m +(ords)i(\(not)g(coun)m(ting)f(the)h(mandatory)f(END)h(k)m(eyw)m(ord\))g +(and)120 1508 y(the)29 b(amoun)m(t)h(of)f(empt)m(y)h(space)g(curren)m +(tly)e(a)m(v)-5 b(ailable)28 b(for)h(more)h(k)m(eyw)m(ords.)40 +b(The)29 b Fc(morekeys)e Fg(parameter)120 1621 y(ma)m(y)k(b)s(e)f(set)h +(to)g(NULL)f(if)f(it's)h(v)-5 b(alue)30 b(is)g(not)g(needed.)120 +1834 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(___)120 +1947 y(int)47 b(fits_read_record\(fitsfil)o(e)42 b(*fptr,)k(int)h +(keynum,)f(char)g(*record,)g(int)h(*status\))120 2060 +y(int)g(fits_read_card\(fitsfile)41 b(*fptr,)46 b(char)h(*keyname,)e +(char)i(*record,)f(int)g(*status\))120 2172 y(int)h +(fits_read_key\(fitsfile)42 b(*fptr,)k(int)h(datatype,)e(char)i +(*keyname,)979 2285 y(void)g(*value,)f(char)g(*comment,)f(int)i +(*status\))120 2511 y(int)g(fits_find_nextkey\(fitsfi)o(le)42 +b(*fptr,)k(char)g(**inclist,)f(int)i(ninc,)1170 2624 +y(char)g(**exclist,)e(int)i(nexc,)f(char)h(*card,)f(int)h(*status\))120 +2850 y(int)g(fits_read_key_unit\(fitsf)o(ile)41 b(*fptr,)46 +b(char)h(*keyname,)e(char)i(*unit,)1218 2963 y(int)g(*status\))261 +3175 y Fg(These)d(routines)g(all)f(read)h(a)h(header)f(record)g(in)f +(the)i(curren)m(t)f(HDU.)i(The)e(\014rst)f(routine)h(reads)120 +3288 y(k)m(eyw)m(ord)c(n)m(um)m(b)s(er)f Fc(keynum)f +Fg(\(where)i(the)g(\014rst)f(k)m(eyw)m(ord)i(is)e(at)i(p)s(osition)d +(1\).)70 b(This)38 b(routine)h(is)g(most)120 3401 y(commonly)28 +b(used)g(when)f(sequen)m(tially)g(reading)g(ev)m(ery)j(record)e(in)f +(the)i(header)f(from)g(b)s(eginning)e(to)j(end.)120 3514 +y(The)22 b(2nd)f(and)h(3rd)f(routines)g(read)h(the)g(named)g(k)m(eyw)m +(ord)h(and)e(return)g(either)h(the)g(whole)f(80-b)m(yte)j(record,)120 +3627 y(or)30 b(the)h(k)m(eyw)m(ord)g(v)-5 b(alue)30 b(and)f(commen)m(t) +j(string.)261 3740 y(Wild)25 b(card)g(c)m(haracters)j(\(*,)g(?,)f(and)e +(#\))h(ma)m(y)h(b)s(e)e(used)g(when)g(sp)s(ecifying)f(the)i(name)h(of)f +(the)g(k)m(eyw)m(ord)120 3853 y(to)31 b(b)s(e)f(read,)g(in)f(whic)m(h)h +(case)h(the)g(\014rst)e(matc)m(hing)i(k)m(eyw)m(ord)f(is)g(returned.) +261 3966 y(The)41 b Fc(datatype)e Fg(parameter)j(sp)s(eci\014es)e(the)h +(C)g(datat)m(yp)s(e)h(of)g(the)f(returned)f(k)m(eyw)m(ord)i(v)-5 +b(alue)41 b(and)120 4079 y(can)48 b(ha)m(v)m(e)h(one)f(of)g(the)f +(follo)m(wing)f(sym)m(b)s(olic)g(constan)m(t)j(v)-5 b(alues:)75 +b Fc(TSTRING,)46 b(TLOGICAL)f Fg(\(==)i(in)m(t\),)120 +4192 y Fc(TBYTE)p Fg(,)d Fc(TSHORT)p Fg(,)f Fc(TUSHORT)p +Fg(,)g Fc(TINT)p Fg(,)h Fc(TUINT)p Fg(,)f Fc(TLONG)p +Fg(,)h Fc(TULONG)p Fg(,)f Fc(TFLOAT)p Fg(,)g Fc(TDOUBLE)p +Fg(,)g Fc(TCOMPLEX)p Fg(,)g(and)120 4304 y Fc(TDBLCOMPLEX)p +Fg(.)e(Data)k(t)m(yp)s(e)f(con)m(v)m(ersion)g(will)d(b)s(e)i(p)s +(erformed)f(for)i(n)m(umeric)e(v)-5 b(alues)43 b(if)g(the)h(in)m +(trinsic)120 4417 y(FITS)32 b(k)m(eyw)m(ord)h(v)-5 b(alue)32 +b(do)s(es)g(not)g(ha)m(v)m(e)i(the)f(same)g(datat)m(yp)s(e.)48 +b(The)32 b Fc(comment)e Fg(parameter)j(ma)m(y)g(b)s(e)f(set)120 +4530 y(equal)e(to)h(NULL)f(if)g(the)g(commen)m(t)i(string)d(is)g(not)i +(needed.)261 4643 y(The)21 b(4th)h(routine)f(pro)m(vides)g(an)h(easy)g +(w)m(a)m(y)h(to)f(\014nd)e(all)h(the)h(k)m(eyw)m(ords)g(in)f(the)g +(header)h(that)g(matc)m(h)h(one)120 4756 y(of)29 b(the)h(name)f +(templates)g(in)f Fc(inclist)f Fg(and)h(do)h(not)h(matc)m(h)g(an)m(y)f +(of)g(the)h(name)f(templates)g(in)f Fc(exclist)p Fg(.)120 +4869 y Fc(ninc)37 b Fg(and)h Fc(nexc)f Fg(are)i(the)g(n)m(um)m(b)s(er)e +(of)h(template)h(strings)e(in)g Fc(inclist)g Fg(and)h +Fc(exclist)p Fg(,)g(resp)s(ectiv)m(ely)-8 b(.)120 4982 +y(Wild)33 b(cards)h(\(*,)i(?,)f(and)f(#\))g(ma)m(y)h(b)s(e)f(used)f(in) +g(the)h(templates)h(to)g(matc)m(h)g(m)m(ultiple)d(k)m(eyw)m(ords.)53 +b(Eac)m(h)120 5095 y(time)35 b(this)f(routine)g(is)g(called)g(it)g +(returns)g(the)h(next)h(matc)m(hing)f(80-b)m(yte)h(k)m(eyw)m(ord)g +(record.)54 b(It)36 b(returns)120 5208 y(status)31 b(=)f +Fc(KEY)p 640 5208 29 4 v 33 w(NO)p 769 5208 V 34 w(EXIST)f +Fg(if)g(there)i(are)g(no)f(more)g(matc)m(hes.)261 5321 +y(The)f(5th)g(routine)f(returns)g(the)i(k)m(eyw)m(ord)g(v)-5 +b(alue)28 b(units)g(string,)g(if)h(an)m(y)-8 b(.)41 b(The)28 +b(units)g(are)i(recorded)f(at)120 5434 y(the)i(b)s(eginning)c(of)k(the) +f(k)m(eyw)m(ord)h(commen)m(t)h(\014eld)d(enclosed)h(in)f(square)h(brac) +m(k)m(ets.)1905 5809 y(19)p eop +%%Page: 20 20 +20 19 bop 120 573 a Fc(________________________)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(___)o(____)o(__)120 +686 y(int)47 b(fits_write_key\(fitsfile)41 b(*fptr,)46 +b(int)h(datatype,)f(char)g(*keyname,)502 799 y(void)g(*value,)g(char)h +(*comment,)e(int)i(*status\))120 912 y(int)g(fits_update_key\(fitsfile) +41 b(*fptr,)46 b(int)h(datatype,)e(char)i(*keyname,)502 +1024 y(void)f(*value,)g(char)h(*comment,)e(int)i(*status\))120 +1137 y(int)g(fits_write_record\(fitsfi)o(le)42 b(*fptr,)k(char)g +(*card,)g(int)h(*status\))120 1363 y(int)g(fits_modify_comment\(fits)o +(file)41 b(*fptr,)46 b(char)h(*keyname,)e(char)i(*comment,)502 +1476 y(int)g(*status\))120 1589 y(int)g(fits_write_key_unit\(fits)o +(file)41 b(*fptr,)46 b(char)h(*keyname,)e(char)i(*unit,)502 +1702 y(int)g(*status\))261 1975 y Fg(W)-8 b(rite)31 b(or)g(mo)s(dify)f +(a)h(k)m(eyw)m(ord)g(in)f(the)h(header)g(of)g(the)g(curren)m(t)g(HDU.)h +(The)e(\014rst)g(routine)g(app)s(ends)120 2087 y(the)g(new)g(k)m(eyw)m +(ord)g(to)h(the)f(end)g(of)g(the)g(header,)h(whereas)e(the)i(second)f +(routine)f(will)e(up)s(date)j(the)g(v)-5 b(alue)120 2200 +y(and)40 b(commen)m(t)h(\014elds)e(of)i(the)g(k)m(eyw)m(ord)g(if)e(it)h +(already)h(exists,)h(otherwise)e(it)h(b)s(eha)m(v)m(es)g(lik)m(e)e(the) +i(\014rst)120 2313 y(routine)32 b(and)g(app)s(ends)f(the)h(new)h(k)m +(eyw)m(ord.)48 b(Note)34 b(that)f Fc(value)e Fg(giv)m(es)i(the)g +(address)f(to)h(the)g(v)-5 b(alue)32 b(and)120 2426 y(not)f(the)g(v)-5 +b(alue)31 b(itself.)41 b(The)31 b Fc(datatype)d Fg(parameter)k(sp)s +(eci\014es)d(the)j(C)e(datat)m(yp)s(e)i(of)f(the)g(k)m(eyw)m(ord)h(v)-5 +b(alue)120 2539 y(and)38 b(ma)m(y)g(ha)m(v)m(e)i(an)m(y)f(of)f(the)g(v) +-5 b(alues)38 b(listed)f(in)g(the)h(description)e(of)j(the)f(k)m(eyw)m +(ord)h(reading)e(routines,)120 2652 y(ab)s(o)m(v)m(e.)71 +b(A)40 b(NULL)g(ma)m(y)h(b)s(e)e(en)m(tered)i(for)f(the)g(commen)m(t)h +(parameter,)i(in)c(whic)m(h)g(case)i(the)f(k)m(eyw)m(ord)120 +2765 y(commen)m(t)31 b(\014eld)e(will)f(b)s(e)i(unmo)s(di\014ed)d(or)j +(left)h(blank.)261 2878 y(The)25 b(third)f(routine)h(is)g(more)h +(primitiv)m(e)e(and)h(simply)e(writes)i(the)h(80-c)m(haracter)j +Fc(card)c Fg(record)h(to)g(the)120 2991 y(header.)40 +b(It)30 b(is)f(the)h(programmer's)f(resp)s(onsibilit)m(y)d(in)i(this)h +(case)h(to)h(ensure)e(that)h(the)g(record)g(conforms)120 +3104 y(to)h(all)e(the)i(FITS)f(format)g(requiremen)m(ts)g(for)g(a)h +(header)f(record.)261 3217 y(The)42 b(fourth)f(routine)g(mo)s(di\014es) +f(the)i(commen)m(t)h(string)e(in)g(an)g(existing)g(k)m(eyw)m(ord,)46 +b(and)41 b(the)h(last)120 3329 y(routine)33 b(writes)g(or)h(up)s(dates) +f(the)h(k)m(eyw)m(ord)h(units)d(string)h(for)h(an)g(existing)f(k)m(eyw) +m(ord.)52 b(\(The)34 b(units)e(are)120 3442 y(recorded)e(at)h(the)g(b)s +(eginning)d(of)i(the)h(k)m(eyw)m(ord)f(commen)m(t)i(\014eld)d(enclosed) +h(in)f(square)h(brac)m(k)m(ets\).)120 3621 y Fc +(________________________)o(____)o(____)o(___)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(__)120 3734 y(int)47 +b(fits_write_comment\(fitsf)o(ile)41 b(*fptr,)46 b(char)h(*comment,)93 +b(int)47 b(*status\))120 3847 y(int)g(fits_write_history\(fitsf)o(ile) +41 b(*fptr,)46 b(char)h(*history,)93 b(int)47 b(*status\))120 +3960 y(int)g(fits_write_date\(fitsfile)41 b(*fptr,)94 +b(int)47 b(*status\))261 4139 y Fg(W)-8 b(rite)21 b(a)g +Fc(COMMENT,)46 b(HISTORY)p Fg(,)18 b(or)j Fc(DATE)e Fg(k)m(eyw)m(ord)i +(to)h(the)f(curren)m(t)f(header.)37 b(The)20 b Fc(COMMENT)f +Fg(k)m(eyw)m(ord)120 4252 y(is)37 b(t)m(ypically)g(used)g(to)h(write)g +(a)g(commen)m(t)h(ab)s(out)e(the)i(\014le)e(or)g(the)i(data.)64 +b(The)37 b Fc(HISTORY)f Fg(k)m(eyw)m(ord)i(is)120 4365 +y(t)m(ypically)22 b(used)f(to)j(pro)m(vide)e(information)f(ab)s(out)h +(the)h(history)e(of)i(the)g(pro)s(cessing)e(pro)s(cedures)h(that)h(ha)m +(v)m(e)120 4478 y(b)s(een)36 b(applied)f(to)i(the)g(data.)61 +b(The)36 b Fc(comment)f Fg(or)i Fc(history)e Fg(string)h(will)e(b)s(e)i +(con)m(tin)m(ued)h(o)m(v)m(er)h(m)m(ultiple)120 4591 +y(k)m(eyw)m(ords)31 b(if)e(it)h(is)f(more)i(than)f(70)h(c)m(haracters)h +(long.)261 4704 y(The)k Fc(DATE)f Fg(k)m(eyw)m(ord)i(is)e(used)h(to)h +(record)f(the)h(date)g(and)f(time)g(that)h(the)f(FITS)g(\014le)f(w)m +(as)i(created.)120 4817 y(Note)f(that)f(this)e(\014le)h(creation)h +(date)g(is)f(usually)e(di\013eren)m(t)i(from)g(the)h(date)g(of)g(the)f +(observ)-5 b(ation)35 b(whic)m(h)120 4930 y(obtained)e(the)h(data)h(in) +d(the)j(FITS)e(\014le.)50 b(The)33 b Fc(DATE)g Fg(k)m(eyw)m(ord)h(v)-5 +b(alue)34 b(is)f(a)h(c)m(haracter)i(string)c(in)h('yyyy-)120 +5042 y(mm-ddThh:mm:ss')27 b(format.)40 b(If)29 b(a)g +Fc(DATE)f Fg(k)m(eyw)m(ord)i(already)e(exists)h(in)f(the)h(header,)h +(then)e(this)g(routine)120 5155 y(will)g(up)s(date)h(the)i(v)-5 +b(alue)30 b(with)f(the)h(curren)m(t)g(system)h(date.)120 +5334 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(__)120 5447 +y(int)47 b(fits_delete_record\(fitsf)o(ile)41 b(*fptr,)46 +b(int)h(keynum,)94 b(int)47 b(*status\))120 5560 y(int)g +(fits_delete_key\(fitsfile)41 b(*fptr,)46 b(char)h(*keyname,)93 +b(int)47 b(*status\))1905 5809 y Fg(20)p eop +%%Page: 21 21 +21 20 bop 261 573 a Fg(Delete)32 b(a)f(k)m(eyw)m(ord)h(record.)42 +b(The)30 b(\014rst)g(routine)g(deletes)h(a)g(k)m(eyw)m(ord)h(at)f(a)h +(sp)s(eci\014ed)d(p)s(osition)g(\(the)120 686 y(\014rst)e(k)m(eyw)m +(ord)h(is)e(at)i(p)s(osition)e(1,)j(not)e(0\),)i(whereas)f(the)f +(second)h(routine)e(deletes)i(the)g(named)f(k)m(eyw)m(ord.)120 +898 y Fc(________________________)o(____)o(____)o(___)o(____)o(____)o +(___)o(____)o(____)o(___)o(____)o(____)o(___)o(___)120 +1011 y(int)47 b(fits_copy_header\(fitsfil)o(e)42 b(*infptr,)j(fitsfile) +h(*outfptr,)93 b(int)47 b(*status\))261 1224 y Fg(Cop)m(y)26 +b(all)f(the)h(header)g(k)m(eyw)m(ords)h(from)e(the)i(curren)m(t)e(HDU)i +(asso)s(ciated)g(with)d(infptr)g(to)j(the)g(curren)m(t)120 +1337 y(HDU)h(asso)s(ciated)f(with)e(outfptr.)39 b(If)27 +b(the)g(curren)m(t)f(output)h(HDU)g(is)f(not)h(empt)m(y)-8 +b(,)29 b(then)d(a)h(new)f(HDU)i(will)120 1450 y(b)s(e)34 +b(app)s(ended)f(to)j(the)f(output)f(\014le.)53 b(The)35 +b(output)f(HDU)i(will)c(then)i(ha)m(v)m(e)i(the)f(iden)m(tical)f +(structure)g(as)120 1562 y(the)d(input)d(HDU,)j(but)f(will)e(con)m +(tain)i(no)h(data.)1905 5809 y(21)p eop +%%Page: 22 22 +22 21 bop 120 573 a Fb(4.7)112 b(Utilit)m(y)34 b(Routines)120 +744 y Fg(This)29 b(section)h(lists)f(the)i(most)f(imp)s(ortan)m(t)g +(CFITSIO)f(general)h(utilit)m(y)f(routines.)120 957 y +Fc(________________________)o(____)o(____)o(___)o(____)o(____)o(___)o +(____)o(____)o(___)o(____)o(____)o(__)120 1070 y(int)47 +b(fits_write_chksum\()c(fitsfile)i(*fptr,)h(int)h(*status\))120 +1183 y(int)g(fits_verify_chksum\(fitsf)o(ile)41 b(*fptr,)46 +b(int)h(*dataok,)f(int)h(*hduok,)f(int)g(*status\))261 +1395 y Fg(These)35 b(routines)f(compute)h(or)g(v)-5 b(alidate)34 +b(the)i(c)m(hec)m(ksums)f(for)g(the)g(currenrt)f(HDU.)i(The)e +Fc(DATASUM)120 1508 y Fg(k)m(eyw)m(ord)d(is)e(used)g(to)i(store)g(the)f +(n)m(umerical)f(v)-5 b(alue)29 b(of)i(the)f(32-bit,)h(1's)f(complemen)m +(t)g(c)m(hec)m(ksum)h(for)f(the)120 1621 y(data)25 b(unit)e(alone.)39 +b(The)24 b Fc(CHECKSUM)f Fg(k)m(eyw)m(ord)i(is)f(used)f(to)j(store)f +(the)g(ASCI)s(I)e(enco)s(ded)h(COMPLEMENT)120 1734 y(of)32 +b(the)f(c)m(hec)m(ksum)h(for)f(the)h(en)m(tire)f(HDU.)i(Storing)d(the)i +(complemen)m(t,)g(rather)f(than)g(the)h(actual)f(c)m(hec)m(k-)120 +1847 y(sum,)26 b(forces)g(the)g(c)m(hec)m(ksum)g(for)f(the)h(whole)f +(HDU)h(to)g(equal)f(zero.)40 b(If)25 b(the)h(\014le)f(has)g(b)s(een)g +(mo)s(di\014ed)e(since)120 1960 y(the)31 b(c)m(hec)m(ksums)f(w)m(ere)h +(computed,)g(then)f(the)g(HDU)i(c)m(hec)m(ksum)f(will)c(usually)h(not)j +(equal)f(zero.)261 2073 y(The)g(returned)g Fc(dataok)f +Fg(and)h Fc(hduok)g Fg(parameters)h(will)d(ha)m(v)m(e)k(a)f(v)-5 +b(alue)30 b(=)h(1)g(if)f(the)h(data)g(or)g(HDU)g(is)120 +2186 y(v)m(eri\014ed)c(correctly)-8 b(,)30 b(a)e(v)-5 +b(alue)28 b(=)g(0)g(if)f(the)i Fc(DATASUM)d Fg(or)i Fc(CHECKSUM)e +Fg(k)m(eyw)m(ord)j(is)e(not)h(presen)m(t,)h(or)f(v)-5 +b(alue)28 b(=)120 2299 y(-1)j(if)e(the)i(computed)f(c)m(hec)m(ksum)h +(is)f(not)g(correct.)120 2511 y Fc(________________________)o(____)o +(____)o(___)o(____)o(____)o(___)o(____)o(____)o(___)o(____)o(____)o(__) +120 2624 y(int)47 b(fits_parse_value\(char)42 b(*card,)k(char)h +(*value,)e(char)i(*comment,)e(int)i(*status\))120 2737 +y(int)g(fits_get_keytype\(char)42 b(*value,)k(char)g(*dtype,)g(int)h +(*status\))120 2850 y(int)g(fits_get_keyclass\(char)42 +b(*card\))120 2963 y(int)47 b(fits_parse_template\(char)41 +b(*template,)k(char)i(*card,)f(int)h(*keytype,)e(int)i(*status\))261 +3288 y(fits)p 459 3288 29 4 v 33 w(parse)p 732 3288 V +33 w(value)29 b Fg(parses)h(the)h(input)d(80-c)m(hararacter)33 +b(header)d(k)m(eyw)m(ord)h(record,)g(returning)d(the)120 +3401 y(v)-5 b(alue)20 b(\(as)i(a)f(literal)e(c)m(haracter)k(string\))d +(and)g(commen)m(t)i(strings.)37 b(If)20 b(the)h(k)m(eyw)m(ord)h(has)e +(no)h(v)-5 b(alue)20 b(\(columns)120 3514 y(9-10)38 b(not)e(equal)g(to) +h('=)f('\),)j(then)d(a)g(n)m(ull)f(v)-5 b(alue)35 b(string)h(is)f +(returned)g(and)h(the)g(commen)m(t)h(string)f(is)f(set)120 +3627 y(equal)30 b(to)h(column)e(9)i(-)g(80)g(of)f(the)h(input)d +(string.)261 3740 y Fc(fits)p 459 3740 V 33 w(get)p 636 +3740 V 34 w(keytype)41 b Fg(parses)i(the)g(k)m(eyw)m(ord)h(v)-5 +b(alue)42 b(string)g(to)i(determine)e(its)h(datat)m(yp)s(e.)80 +b Fc(dtype)120 3853 y Fg(returns)34 b(with)f(a)i(v)-5 +b(alue)35 b(of)g('C',)g('L',)g('I',)h('F')f(or)g('X',)h(for)f(c)m +(haracter)h(string,)f(logical,)h(in)m(teger,)g(\015oating)120 +3966 y(p)s(oin)m(t,)30 b(or)g(complex,)g(resp)s(ectiv)m(ely)-8 +b(.)261 4079 y Fc(fits)p 459 4079 V 33 w(get)p 636 4079 +V 34 w(keyclass)31 b Fg(returns)i(a)h(classi\014cation)e(co)s(de)i +(that)g(indicates)f(the)h(classi\014cation)e(t)m(yp)s(e)i(of)120 +4192 y(the)41 b(input)d(k)m(eyw)m(ord)j(record)f(\(e.g.,)45 +b(a)40 b(required)f(structural)g(k)m(eyw)m(ord,)44 b(a)d(TDIM)f(k)m +(eyw)m(ord,)k(a)c(W)m(CS)120 4304 y(k)m(eyw)m(ord,)49 +b(a)d(commen)m(t)g(k)m(eyw)m(ord,)j(etc.)85 b(See)45 +b(the)h(CFITSIO)d(Reference)j(Guide)d(for)i(a)g(list)f(of)h(the)120 +4417 y(di\013eren)m(t)30 b(classi\014cation)f(co)s(des.)261 +4530 y Fc(fits)p 459 4530 V 33 w(parse)p 732 4530 V 33 +w(template)37 b Fg(tak)m(es)j(an)e(input)f(free)h(format)h(k)m(eyw)m +(ord)g(template)g(string)f(and)g(returns)120 4643 y(a)i(formatted)g +(80*c)m(har)h(record)e(that)h(satis\014es)f(all)g(the)g(FITS)g +(requiremen)m(ts)g(for)g(a)h(header)f(k)m(eyw)m(ord)120 +4756 y(record.)65 b(The)38 b(template)h(should)d(generally)i(con)m +(tain)h(3)g(tok)m(ens:)58 b(the)38 b(k)m(eyw)m(ord)h(name,)i(the)e(k)m +(eyw)m(ord)120 4869 y(v)-5 b(alue,)28 b(and)f(the)g(k)m(eyw)m(ord)h +(commen)m(t)h(string.)39 b(The)27 b(returned)f Fc(keytype)g +Fg(parameter)i(indicates)e(whether)120 4982 y(the)33 +b(k)m(eyw)m(ord)g(is)f(a)h(COMMENT)g(k)m(eyw)m(ord)g(or)g(not.)48 +b(See)33 b(the)g(CFITSIO)e(Reference)j(Guide)e(for)g(more)120 +5095 y(details.)1905 5809 y(22)p eop +%%Page: 23 23 +23 22 bop 120 573 a Fi(5)135 b(CFITSIO)44 b(File)h(Names)h(and)f +(Filters)120 779 y Fb(5.1)112 b(Creating)37 b(New)g(Files)120 +951 y Fg(When)43 b(creating)g(a)g(new)g(output)f(\014le)g(on)h +(magnetic)h(disk)d(with)h Fc(fits)p 2677 951 29 4 v 33 +w(create)p 2998 951 V 33 w(file)g Fg(the)h(follo)m(wing)120 +1064 y(features)31 b(are)f(supp)s(orted.)256 1251 y Fa(\017)46 +b Fg(Ov)m(erwriting,)29 b(or)h('Clobb)s(ering')e(an)j(Existing)d(File) +347 1402 y(If)f(the)h(\014lename)f(is)g(preceded)g(b)m(y)g(an)h +(exclamation)g(p)s(oin)m(t)e(\(!\))41 b(then)27 b(if)g(that)h(\014le)e +(already)i(exists)f(it)347 1514 y(will)f(b)s(e)h(deleted)h(prior)e(to)j +(creating)f(the)g(new)g(FITS)f(\014le.)39 b(Otherwise)26 +b(if)h(there)h(is)f(an)h(existing)f(\014le)347 1627 y(with)35 +b(the)g(same)h(name,)i(CFITSIO)c(will)f(not)j(o)m(v)m(erwrite)g(the)g +(existing)e(\014le)h(and)g(will)e(return)h(an)347 1740 +y(error)28 b(status)h(co)s(de.)40 b(Note)30 b(that)f(the)f(exclamation) +h(p)s(oin)m(t)e(is)g(a)i(sp)s(ecial)e(UNIX)h(c)m(haracter,)j(so)e(if)e +(it)347 1853 y(is)f(used)g(on)g(the)h(command)g(line)e(rather)h(than)g +(en)m(tered)i(at)f(a)g(task)g(prompt,)g(it)f(m)m(ust)h(b)s(e)f +(preceded)347 1966 y(b)m(y)j(a)h(bac)m(kslash)f(to)h(force)g(the)f +(UNIX)h(shell)d(to)k(pass)d(it)h(v)m(erbatim)g(to)h(the)g(application)d +(program.)256 2154 y Fa(\017)46 b Fg(Compressed)30 b(Output)f(Files)347 +2304 y(If)g(the)g(output)f(disk)g(\014le)g(name)h(ends)f(with)f(the)i +(su\016x)f('.gz',)j(then)e(CFITSIO)e(will)f(compress)j(the)347 +2417 y(\014le)38 b(using)g(the)h(gzip)g(compression)f(algorithm)g(b)s +(efore)g(writing)f(it)i(to)h(disk.)65 b(This)37 b(can)j(reduce)347 +2530 y(the)h(amoun)m(t)g(of)g(disk)e(space)i(used)f(b)m(y)g(the)h +(\014le.)70 b(Note)42 b(that)f(this)f(feature)h(requires)e(that)i(the) +347 2643 y(uncompressed)e(\014le)h(b)s(e)g(constructed)h(in)e(memory)h +(b)s(efore)g(it)g(is)g(compressed)g(and)g(written)g(to)347 +2756 y(disk,)29 b(so)i(it)f(can)h(fail)e(if)g(there)i(is)e +(insu\016cien)m(t)g(a)m(v)-5 b(ailable)29 b(memory)-8 +b(.)347 2906 y(One)32 b(can)h(also)g(sp)s(ecify)e(that)i(an)m(y)g +(images)g(written)f(to)h(the)g(output)f(\014le)g(should)f(b)s(e)h +(compressed)347 3019 y(using)22 b(the)h(newly)f(dev)m(elop)s(ed)h +(`tile-compression')f(algorithm)g(b)m(y)h(app)s(ending)e(`[compress]')j +(to)g(the)347 3132 y(name)36 b(of)h(the)f(disk)f(\014le)g(\(as)i(in)e +Fc(myfile.fits[compress])p Fg(\).)52 b(Refer)36 b(to)h(the)g(CFITSIO)d +(User's)347 3245 y(Reference)d(Guide)f(for)g(more)g(information)f(ab)s +(out)h(this)f(new)h(image)h(compression)e(format.)256 +3432 y Fa(\017)46 b Fg(Using)30 b(a)h(T)-8 b(emplate)30 +b(to)h(Create)g(a)g(New)g(FITS)e(File)347 3583 y(The)k(structure)g(of)g +(an)m(y)h(new)f(FITS)f(\014le)h(that)h(is)e(to)i(b)s(e)f(created)h(ma)m +(y)g(b)s(e)f(de\014ned)f(in)g(an)h(ASCI)s(I)347 3695 +y(template)c(\014le.)39 b(If)29 b(the)f(name)h(of)g(the)f(template)h +(\014le)f(is)g(app)s(ended)e(to)k(the)e(name)h(of)g(the)f(FITS)g +(\014le)347 3808 y(itself,)36 b(enclosed)f(in)f(paren)m(thesis)g +(\(e.g.,)k Fc('newfile.fits\(template.tx)o(t\)')p Fg(\))29 +b(then)35 b(CFITSIO)347 3921 y(will)28 b(create)33 b(a)e(FITS)f(\014le) +g(with)f(that)j(structure)e(b)s(efore)h(op)s(ening)e(it)h(for)h(the)g +(application)e(to)i(use.)347 4034 y(The)h(template)h(\014le)f +(basically)e(de\014nes)i(the)h(dimensions)c(and)j(data)h(t)m(yp)s(e)g +(of)g(the)f(primary)f(arra)m(y)347 4147 y(and)23 b(an)m(y)h(IMA)m(GE)g +(extensions,)h(and)e(the)g(names)g(and)g(data)h(t)m(yp)s(es)g(of)f(the) +h(columns)e(in)g(an)m(y)i(ASCI)s(I)347 4260 y(or)35 b(binary)f(table)h +(extensions.)54 b(The)35 b(template)g(\014le)f(can)i(also)f(b)s(e)f +(used)h(to)g(de\014ne)g(an)m(y)g(optional)347 4373 y(k)m(eyw)m(ords)g +(that)g(should)d(b)s(e)i(written)f(in)h(an)m(y)g(of)h(the)f(HDU)h +(headers.)53 b(The)34 b(image)g(pixel)f(v)-5 b(alues)347 +4486 y(and)38 b(table)h(en)m(try)f(v)-5 b(alues)38 b(are)h(all)e +(initialized)f(to)j(zero.)66 b(The)38 b(application)f(program)h(can)h +(then)347 4599 y(write)27 b(actual)g(data)h(in)m(to)g(the)f(HDUs.)40 +b(See)28 b(the)f(CFITSIO)f(Reference)i(Guide)e(for)h(for)g(a)h +(complete)347 4712 y(description)h(of)h(the)h(template)g(\014le)e(syn)m +(tax.)256 4899 y Fa(\017)46 b Fg(Creating)30 b(a)h(T)-8 +b(emp)s(orary)30 b(Scratc)m(h)h(File)e(in)g(Memory)347 +5050 y(It)38 b(is)f(sometimes)h(useful)e(to)j(create)g(a)f(temp)s +(orary)g(output)f(\014le)g(when)g(testing)h(an)g(application)347 +5162 y(program.)45 b(If)31 b(the)h(name)g(of)g(the)g(\014le)f(to)i(b)s +(e)e(created)i(is)e(sp)s(eci\014ed)f(as)i Fc(mem:)42 +b Fg(then)32 b(CFITSIO)e(will)347 5275 y(create)39 b(the)e(\014le)g(in) +f(memory)h(where)f(it)h(will)e(p)s(ersist)g(only)h(un)m(til)g(the)h +(program)g(closes)h(the)f(\014le.)347 5388 y(Use)e(of)g(this)f +Fc(mem:)48 b Fg(output)34 b(\014le)g(usually)e(enables)i(the)h(program) +f(to)i(run)d(faster,)j(and)e(of)h(course)347 5501 y(the)c(output)f +(\014le)f(do)s(es)h(not)h(use)f(up)f(an)m(y)i(disk)e(space.)1905 +5809 y(23)p eop +%%Page: 24 24 +24 23 bop 120 573 a Fb(5.2)112 b(Op)s(ening)38 b(Existing)d(Files)120 +744 y Fg(When)j(op)s(ening)e(a)j(\014le)e(with)g Fc(fits)p +1392 744 29 4 v 33 w(open)p 1617 744 V 33 w(file)p Fg(,)i(CFITSIO)e +(can)h(read)g(a)g(v)-5 b(ariet)m(y)39 b(of)f(di\013eren)m(t)f(input)120 +857 y(\014le)30 b(formats)h(and)g(is)f(not)h(restricted)g(to)h(only)e +(reading)g(FITS)h(format)g(\014les)f(from)h(magnetic)g(disk.)42 +b(The)120 970 y(follo)m(wing)29 b(t)m(yp)s(es)h(of)h(input)d(\014les)i +(are)g(all)g(supp)s(orted:)256 1183 y Fa(\017)46 b Fg(FITS)30 +b(\014les)f(compressed)h(with)f Fc(zip,)47 b(gzip)29 +b Fg(or)i Fc(compress)347 1333 y Fg(If)36 b(CFITSIO)f(cannot)i(\014nd)e +(the)i(sp)s(eci\014ed)e(\014le)g(to)i(op)s(en)f(it)g(will)e +(automatically)i(lo)s(ok)g(for)g(a)h(\014le)347 1446 +y(with)j(the)g(same)h(ro)s(otname)h(but)d(with)h(a)h +Fc(.gz,)46 b(.zip)p Fg(,)d(or)d Fc(.Z)g Fg(extension.)71 +b(If)41 b(it)f(\014nds)f(suc)m(h)h(a)347 1559 y(compressed)d(\014le,)g +(it)g(will)d(allo)s(cate)j(a)g(blo)s(c)m(k)f(of)h(memory)g(and)f +(uncompress)f(the)i(\014le)f(in)m(to)h(that)347 1672 +y(memory)25 b(space.)39 b(The)25 b(application)e(program)h(will)f(then) +h(transparen)m(tly)g(op)s(en)g(this)g(virtual)f(FITS)347 +1785 y(\014le)35 b(in)f(memory)-8 b(.)56 b(Compressed)35 +b(\014les)f(can)i(only)f(b)s(e)f(op)s(ened)h(with)f('readonly',)j(not)f +('readwrite')347 1898 y(\014le)30 b(access.)256 2085 +y Fa(\017)46 b Fg(FITS)30 b(\014les)f(on)h(the)h(in)m(ternet,)f(using)f +Fc(ftp)h Fg(or)g Fc(http)f Fg(URLs)347 2236 y(Simply)20 +b(pro)m(vide)i(the)i(full)c(URL)j(as)g(the)g(name)g(of)h(the)f(\014le)f +(that)h(y)m(ou)h(w)m(an)m(t)f(to)h(op)s(en.)38 b(F)-8 +b(or)23 b(example,)347 2348 y Fc(ftp://legacy.gsfc.nasa.go)o(v/so)o +(ftwa)o(re/)o(fits)o(io/c)o(/te)o(stpr)o(og.s)o(td)347 +2461 y Fg(will)34 b(op)s(en)h(the)h(CFITSIO)e(test)j(FITS)e(\014le)g +(that)i(is)d(lo)s(cated)j(on)e(the)h Fc(legacy)f Fg(mac)m(hine.)57 +b(These)347 2574 y(\014les)30 b(can)g(only)g(b)s(e)f(op)s(ened)h(with)f +('readonly')h(\014le)g(access.)256 2762 y Fa(\017)46 +b Fg(FITS)30 b(\014les)f(on)h Fc(stdin)f Fg(or)i Fc(stdout)d +Fg(\014le)i(streams)347 2912 y(If)k(the)g(name)h(of)f(the)h(\014le)e +(to)i(b)s(e)f(op)s(ened)f(is)g Fc('stdin')g Fg(or)h Fc('-')f +Fg(\(a)i(single)e(dash)g(c)m(haracter\))k(then)347 3025 +y(CFITSIO)f(will)f(read)j(the)f(\014le)g(from)g(the)h(standard)f(input) +e(stream.)63 b(Similarly)-8 b(,)36 b(if)h(the)h(output)347 +3138 y(\014le)k(name)h(is)f Fc('stdout')f Fg(or)i Fc('-')p +Fg(,)j(then)c(the)i(\014le)e(will)e(b)s(e)j(written)f(to)h(the)h +(standard)e(output)347 3251 y(stream.)54 b(In)34 b(addition,)g(if)f +(the)i(output)f(\014lename)g(is)g Fc('stdout.gz')d Fg(or)k +Fc('-.gz')e Fg(then)h(it)g(will)e(b)s(e)347 3364 y(gzip)h(compressed)g +(b)s(efore)g(b)s(eing)e(written)h(to)i(stdout.)49 b(This)32 +b(mec)m(hanism)g(can)i(b)s(e)e(used)g(to)i(pip)s(e)347 +3477 y(FITS)c(\014les)f(from)h(one)h(task)g(to)g(another)f(without)g +(ha)m(ving)g(to)h(write)e(an)i(in)m(termediary)e(FITS)g(\014le)347 +3590 y(on)i(magnetic)f(disk.)256 3777 y Fa(\017)46 b +Fg(FITS)30 b(\014les)f(that)i(exist)f(only)g(in)f(memory)-8 +b(,)31 b(or)f(shared)g(memory)-8 b(.)347 3928 y(In)38 +b(some)i(applications,)f(suc)m(h)g(as)g(real)f(time)h(data)g +(acquisition,)h(y)m(ou)f(ma)m(y)h(w)m(an)m(t)f(to)h(ha)m(v)m(e)g(one) +347 4040 y(pro)s(cess)31 b(write)f(a)i(FITS)e(\014le)g(in)m(to)h(a)h +(certain)f(section)g(of)g(computer)g(memory)-8 b(,)32 +b(and)f(then)f(b)s(e)h(able)347 4153 y(to)26 b(op)s(en)f(that)g(\014le) +f(in)g(memory)h(with)f(another)h(pro)s(cess.)39 b(There)25 +b(is)f(a)h(sp)s(ecialized)e(CFITSIO)h(op)s(en)347 4266 +y(routine)e(called)h Fc(fits)p 1102 4266 V 33 w(open)p +1327 4266 V 33 w(memfile)f Fg(that)h(can)h(b)s(e)e(used)h(for)g(this)f +(purp)s(ose.)37 b(See)23 b(the)g(\\CFITSIO)347 4379 y(User's)31 +b(Reference)g(Guide")f(for)g(more)g(details.)256 4567 +y Fa(\017)46 b Fg(IRAF)31 b(format)g(images)f(\(with)f +Fc(.imh)h Fg(\014le)f(extensions\))347 4717 y(CFITSIO)38 +b(supp)s(orts)g(reading)h(IRAF)h(format)g(images)g(b)m(y)g(con)m(v)m +(erting)g(them)g(on)f(the)h(\015y)f(in)m(to)347 4830 +y(FITS)27 b(images)h(in)e(memory)-8 b(.)40 b(The)28 b(application)d +(program)j(then)f(reads)h(this)e(virtual)g(FITS)h(format)347 +4943 y(image)35 b(in)f(memory)-8 b(.)55 b(There)34 b(is)g(curren)m(tly) +g(no)h(supp)s(ort)e(for)i(writing)e(IRAF)i(format)g(images,)h(or)347 +5056 y(for)30 b(reading)g(or)g(writing)f(IRAF)h(tables.)256 +5243 y Fa(\017)46 b Fg(Image)31 b(arra)m(ys)g(in)e(ra)m(w)i(binary)d +(format)347 5394 y(If)23 b(the)h(input)d(\014le)i(is)f(a)i(ra)m(w)f +(binary)f(data)i(arra)m(y)-8 b(,)26 b(then)d(CFITSIO)f(will)e(con)m(v)m +(ert)25 b(it)e(on)g(the)h(\015y)f(in)m(to)g(a)347 5507 +y(virtual)f(FITS)g(image)i(with)e(the)i(basic)e(set)i(of)g(required)d +(header)i(k)m(eyw)m(ords)h(b)s(efore)f(it)g(is)f(op)s(ened)g(b)m(y)1905 +5809 y(24)p eop +%%Page: 25 25 +25 24 bop 347 573 a Fg(the)31 b(application)d(program.)40 +b(In)30 b(this)f(case)i(the)f(data)h(t)m(yp)s(e)g(and)e(dimensions)e +(of)k(the)f(image)g(m)m(ust)347 686 y(b)s(e)d(sp)s(eci\014ed)e(in)h +(square)h(brac)m(k)m(ets)h(follo)m(wing)e(the)h(\014lename)g(\(e.g.)41 +b Fc(rawfile.dat[ib512,512])p Fg(\).)347 799 y(The)30 +b(\014rst)g(c)m(haracter)i(inside)c(the)i(brac)m(k)m(ets)i(de\014nes)e +(the)g(datat)m(yp)s(e)i(of)e(the)h(arra)m(y:)586 1049 +y Fc(b)429 b(8-bit)47 b(unsigned)e(byte)586 1161 y(i)381 +b(16-bit)47 b(signed)f(integer)586 1274 y(u)381 b(16-bit)47 +b(unsigned)e(integer)586 1387 y(j)381 b(32-bit)47 b(signed)f(integer) +586 1500 y(r)h(or)h(f)142 b(32-bit)47 b(floating)e(point)586 +1613 y(d)381 b(64-bit)47 b(floating)e(point)347 1863 +y Fg(An)32 b(optional)e(second)i(c)m(haracter)h(sp)s(eci\014es)d(the)i +(b)m(yte)h(order)e(of)g(the)h(arra)m(y)g(v)-5 b(alues:)43 +b(b)31 b(or)h(B)g(indi-)347 1976 y(cates)27 b(big)d(endian)f(\(as)j(in) +e(FITS)g(\014les)g(and)g(the)i(nativ)m(e)f(format)g(of)h(SUN)e(UNIX)i +(w)m(orkstations)f(and)347 2089 y(Mac)35 b(PCs\))d(and)h(l)f(or)h(L)g +(indicates)f(little)g(endian)g(\(nativ)m(e)i(format)f(of)g(DEC)h(OSF)e +(w)m(orkstations)347 2202 y(and)41 b(IBM)g(PCs\).)73 +b(If)41 b(this)f(c)m(haracter)i(is)f(omitted)g(then)f(the)i(arra)m(y)f +(is)g(assumed)f(to)i(ha)m(v)m(e)g(the)347 2315 y(nativ)m(e)29 +b(b)m(yte)g(order)e(of)h(the)h(lo)s(cal)e(mac)m(hine.)40 +b(These)28 b(datat)m(yp)s(e)h(c)m(haracters)g(are)g(then)f(follo)m(w)m +(ed)f(b)m(y)347 2428 y(a)f(series)f(of)g(one)h(or)f(more)h(in)m(teger)f +(v)-5 b(alues)25 b(separated)h(b)m(y)f(commas)h(whic)m(h)e(de\014ne)h +(the)g(size)h(of)f(eac)m(h)347 2540 y(dimension)j(of)j(the)f(ra)m(w)h +(arra)m(y)-8 b(.)41 b(Arra)m(ys)31 b(with)e(up)g(to)i(5)g(dimensions)d +(are)i(curren)m(tly)g(supp)s(orted.)347 2691 y(Finally)-8 +b(,)32 b(a)h(b)m(yte)g(o\013set)g(to)g(the)g(p)s(osition)d(of)i(the)h +(\014rst)f(pixel)e(in)h(the)i(data)g(\014le)e(ma)m(y)i(b)s(e)f(sp)s +(eci\014ed)347 2804 y(b)m(y)c(separating)g(it)g(with)e(a)j(':')40 +b(from)27 b(the)i(last)e(dimension)f(v)-5 b(alue.)39 +b(If)28 b(omitted,)h(it)e(is)g(assumed)h(that)347 2917 +y(the)h(o\013set)g(=)f(0.)41 b(This)26 b(parameter)j(ma)m(y)g(b)s(e)f +(used)f(to)i(skip)e(o)m(v)m(er)j(an)m(y)e(header)g(information)f(in)g +(the)347 3029 y(\014le)j(that)h(precedes)f(the)h(binary)d(data.)42 +b(F)-8 b(urther)30 b(examples:)443 3279 y Fc(raw.dat[b10000])473 +b(1-dimensional)44 b(10000)i(pixel)h(byte)f(array)443 +3392 y(raw.dat[rb400,400,12])185 b(3-dimensional)44 b(floating)i(point) +g(big-endian)f(array)443 3505 y(img.fits[ib512,512:2880)o(])d(reads)k +(the)h(512)g(x)h(512)e(short)h(integer)f(array)g(in)h(a)1636 +3618 y(FITS)g(file,)f(skipping)f(over)i(the)g(2880)g(byte)f(header)1905 +5809 y Fg(25)p eop +%%Page: 26 26 +26 25 bop 120 573 a Fb(5.3)112 b(Image)37 b(Filtering)120 +744 y Fh(5.3.1)105 b(Extracting)35 b(a)g(subsection)h(of)f(an)g(image) +120 916 y Fg(When)21 b(sp)s(ecifying)e(the)j(name)f(of)g(an)g(image)h +(to)g(b)s(e)f(op)s(ened,)h(y)m(ou)g(can)f(select)h(a)g(rectangular)f +(subsection)f(of)120 1029 y(the)29 b(image)f(to)h(b)s(e)f(extracted)i +(and)e(op)s(ened)f(b)m(y)i(the)f(application)f(program.)40 +b(The)28 b(application)f(program)120 1142 y(then)k(op)s(ens)f(a)i +(virtual)e(image)h(that)h(only)e(con)m(tains)i(the)f(pixels)f(within)e +(the)k(sp)s(eci\014ed)d(subsection.)43 b(T)-8 b(o)120 +1255 y(do)33 b(this,)g(sp)s(ecify)f(the)i(the)f(range)h(of)f(pixels)e +(\(start:end\))k(along)e(eac)m(h)h(axis)f(to)h(b)s(e)f(extracted)h +(from)f(the)120 1368 y(original)28 b(image)j(enclosed)f(in)f(square)h +(brac)m(k)m(ets.)42 b(Y)-8 b(ou)31 b(can)f(also)h(sp)s(ecify)e(an)h +(optional)f(pixel)g(incremen)m(t)120 1481 y(\(start:end:step\))37 +b(for)f(eac)m(h)g(axis)g(of)f(the)h(input)e(image.)57 +b(A)36 b(pixel)e(step)i(=)f(1)h(will)d(b)s(e)i(assumed)g(if)g(it)g(is) +120 1594 y(not)29 b(sp)s(eci\014ed.)38 b(If)28 b(the)h(starting)f +(pixel)f(is)g(larger)i(then)f(the)h(end)e(pixel,)h(then)g(the)h(image)g +(will)c(b)s(e)j(\015ipp)s(ed)120 1706 y(\(pro)s(ducing)33 +b(a)i(mirror)d(image\))j(along)g(that)g(dimension.)51 +b(An)34 b(asterisk,)i('*',)h(ma)m(y)e(b)s(e)f(used)f(to)j(sp)s(ecify) +120 1819 y(the)25 b(en)m(tire)g(range)g(of)g(an)g(axis,)h(and)e('-*')i +(will)d(\015ip)g(the)i(en)m(tire)g(axis.)38 b(In)24 b(the)h(follo)m +(wing)f(examples,)i(assume)120 1932 y(that)31 b Fc(myfile.fits)c +Fg(con)m(tains)k(a)g(512)g(x)g(512)g(pixel)e(2D)i(image.)215 +2130 y Fc(myfile.fits[201:210,)43 b(251:260])i(-)j(opens)e(a)i(10)f(x)g +(10)g(pixel)g(subimage.)215 2356 y(myfile.fits[*,)d(512:257])i(-)h +(opens)g(a)g(512)g(x)h(256)e(image)h(consisting)e(of)406 +2469 y(all)i(the)g(columns)f(in)h(the)g(input)f(image,)h(but)f(only)h +(rows)g(257)406 2582 y(through)f(512.)95 b(The)46 b(image)h(will)f(be)i +(flipped)d(along)i(the)g(Y)g(axis)406 2695 y(since)g(the)g(starting)e +(row)i(is)g(greater)f(than)h(the)g(ending)406 2808 y(row.)215 +3033 y(myfile.fits[*:2,)d(512:257:2])h(-)i(creates)f(a)i(256)e(x)i(128) +f(pixel)f(image.)406 3146 y(Similar)g(to)h(the)g(previous)f(example,)f +(but)i(only)g(every)f(other)h(row)406 3259 y(and)g(column)f(is)i(read)e +(from)h(the)g(input)f(image.)215 3485 y(myfile.fits[-*,)e(*])j(-)h +(creates)e(an)h(image)f(containing)f(all)i(the)g(rows)g(and)406 +3598 y(columns)f(in)h(the)g(input)g(image,)f(but)h(flips)f(it)h(along)g +(the)f(X)406 3711 y(axis.)261 3909 y Fg(If)33 b(the)g(arra)m(y)h(to)g +(b)s(e)f(op)s(ened)f(is)h(in)f(an)h(Image)h(extension,)g(and)f(not)g +(in)f(the)i(primary)d(arra)m(y)j(of)f(the)120 4022 y(\014le,)c(then)g +(y)m(ou)g(need)g(to)h(sp)s(ecify)d(the)j(extension)f(name)g(or)g(n)m +(um)m(b)s(er)f(in)f(square)i(brac)m(k)m(ets)i(b)s(efore)e(giving)120 +4135 y(the)h(subsection)e(range,)i(as)g(in)e Fc(myfile.fits[1][-*,)42 +b(*])29 b Fg(to)h(read)f(the)h(image)g(in)e(the)h(\014rst)g(extension) +120 4248 y(in)g(the)i(\014le.)120 4485 y Fh(5.3.2)105 +b(Create)34 b(an)h(Image)f(b)m(y)h(Binning)h(T)-9 b(able)34 +b(Columns)120 4657 y Fg(Y)-8 b(ou)40 b(can)f(also)g(create)i(and)d(op)s +(en)h(a)g(virtual)f(image)h(b)m(y)g(binning)d(the)k(v)-5 +b(alues)38 b(in)g(a)h(pair)f(of)i(columns)120 4770 y(of)f(a)h(FITS)f +(table)g(\(in)f(other)i(w)m(ords,)h(create)g(a)e(2-D)i(histogram)e(of)g +(the)g(v)-5 b(alues)39 b(in)f(the)h(2)h(columns\).)120 +4883 y(This)33 b(tec)m(hnique)h(is)g(often)h(used)f(in)g(X-ra)m(y)i +(astronom)m(y)f(where)f(eac)m(h)i(detected)g(X-ra)m(y)g(photon)f +(during)120 4996 y(an)29 b(observ)-5 b(ation)28 b(is)g(recorded)h(in)e +(a)i(FITS)f(table.)40 b(There)29 b(are)g(t)m(ypically)e(2)j(columns)d +(in)g(the)i(table)g(called)120 5109 y Fc(X)35 b Fg(and)h +Fc(Y)f Fg(whic)m(h)g(record)g(the)i(pixel)d(lo)s(cation)h(of)h(that)h +(ev)m(en)m(t)g(in)d(a)j(virtual)d(2D)i(image.)58 b(T)-8 +b(o)36 b(create)h(an)120 5222 y(image)27 b(from)f(this)g(table,)i(one)f +(just)f(scans)h(the)g(X)g(and)f(Y)h(columns)f(and)g(coun)m(ts)h(up)f +(ho)m(w)h(man)m(y)g(photons)120 5334 y(w)m(ere)k(recorded)g(in)f(eac)m +(h)i(pixel)d(of)i(the)g(image.)43 b(When)30 b(table)h(binning)d(is)i +(sp)s(eci\014ed,)g(CFITSIO)f(creates)120 5447 y(a)38 +b(temp)s(orary)e(FITS)h(primary)e(arra)m(y)j(in)e(memory)h(b)m(y)g +(computing)g(the)g(histogram)g(of)h(the)f(v)-5 b(alues)37 +b(in)120 5560 y(the)29 b(sp)s(eci\014ed)e(columns.)39 +b(After)29 b(the)g(histogram)f(is)g(computed)h(the)g(original)e(FITS)h +(\014le)g(con)m(taining)g(the)1905 5809 y(26)p eop +%%Page: 27 27 +27 26 bop 120 573 a Fg(table)24 b(is)e(closed)i(and)f(the)g(temp)s +(orary)h(FITS)e(primary)g(arra)m(y)i(is)f(op)s(ened)g(and)g(passed)g +(to)h(the)g(application)120 686 y(program.)39 b(Th)m(us,)27 +b(the)g(application)e(program)i(nev)m(er)g(sees)h(the)f(original)e +(FITS)h(table)h(and)f(only)g(sees)h(the)120 799 y(image)k(in)e(the)h +(new)g(temp)s(orary)g(\014le)g(\(whic)m(h)f(has)h(no)g(extensions\).) +261 912 y(The)f(table)g(binning)d(sp)s(eci\014er)i(is)h(enclosed)g(in)f +(square)h(brac)m(k)m(ets)h(follo)m(wing)e(the)i(ro)s(ot)f(\014lename)g +(and)120 1024 y(table)h(extension)g(name)h(or)f(n)m(um)m(b)s(er)f(and)h +(b)s(egins)f(with)g(the)h(k)m(eyw)m(ord)h('bin',)f(as)g(in:)120 +1137 y Fc('myfile.fits[events][bin)41 b(\(X,Y\)]')p Fg(.)20 +b(In)h(this)g(case,)k(the)d(X)g(and)f(Y)h(columns)f(in)g(the)h('ev)m +(en)m(ts')h(table)120 1250 y(extension)29 b(are)h(binned)e(up)g(to)j +(create)g(the)f(image.)41 b(The)29 b(size)g(of)h(the)g(image)g(is)f +(usually)e(determined)h(b)m(y)120 1363 y(the)22 b Fc(TLMINn)d +Fg(and)i Fc(TLMAXn)f Fg(header)h(k)m(eyw)m(ords)h(whic)m(h)e(giv)m(e)i +(the)f(minim)m(um)e(and)i(maxim)m(um)f(allo)m(w)m(ed)h(pixel)120 +1476 y(v)-5 b(alues)37 b(in)f(the)i(columns.)61 b(F)-8 +b(or)38 b(instance)f(if)g Fc(TLMINn)46 b(=)h(1)37 b Fg(and)g +Fc(TLMAXn)46 b(=)i(4096)36 b Fg(for)i(b)s(oth)e(columns,)120 +1589 y(this)e(w)m(ould)g(generate)i(a)f(4096)i(x)e(4096)h(pixel)e +(image)h(b)m(y)g(default.)53 b(This)33 b(is)h(rather)h(large,)i(so)e(y) +m(ou)g(can)120 1702 y(also)d(sp)s(ecify)f(a)i(pixel)d(binning)f(factor) +34 b(to)f(reduce)f(the)g(image)h(size.)46 b(F)-8 b(or)33 +b(example)f(sp)s(ecifying)e(,)j Fc('[bin)120 1815 y(\(X,Y\))46 +b(=)i(16]')29 b Fg(will)e(use)i(a)i(binning)26 b(factor)31 +b(of)f(16,)h(whic)m(h)e(will)e(pro)s(duce)i(a)h(256)h(x)f(256)h(pixel)e +(image)h(in)120 1928 y(the)h(previous)d(example.)261 +2041 y(If)35 b(the)g(TLMIN)g(and)g(TLMAX)g(k)m(eyw)m(ords)g(don't)g +(exist,)i(or)e(y)m(ou)g(w)m(an)m(t)h(to)g(o)m(v)m(erride)g(their)e(v)-5 +b(alues,)120 2154 y(y)m(ou)36 b(can)h(sp)s(ecify)d(the)i(image)h(range) +f(and)f(binning)e(factor)k(directly)-8 b(,)37 b(as)f(in)f +Fc('[bin)46 b(X)i(=)f(1:4096:16,)120 2267 y(Y=1:4096:16]')p +Fg(.)36 b(Y)-8 b(ou)28 b(can)g(also)f(sp)s(ecify)f(the)i(datat)m(yp)s +(e)g(of)g(the)g(created)g(image)g(b)m(y)f(app)s(ending)e(a)j(b,)g(i,) +120 2379 y(j,)f(r,)g(or)f(d)f(\(for)h(8-bit)g(b)m(yte,)i(16-bit)f(in)m +(tegers,)g(32-bit)f(in)m(teger,)i(32-bit)e(\015oating)g(p)s(oin)m(ts,)g +(or)g(64-bit)h(double)120 2492 y(precision)34 b(\015oating)h(p)s(oin)m +(t,)h(resp)s(ectiv)m(ely\))f(to)h(the)g('bin')e(k)m(eyw)m(ord)h(\(e.g.) +58 b Fc('[binr)46 b(\(X,Y\)]')33 b Fg(creates)k(a)120 +2605 y(\015oating)i(p)s(oin)m(t)e(image\).)66 b(If)38 +b(the)h(datat)m(yp)s(e)h(is)d(not)i(sp)s(eci\014ed)e(then)h(a)h(32-bit) +g(in)m(teger)g(image)g(will)d(b)s(e)120 2718 y(created)31 +b(b)m(y)g(default.)261 2831 y(If)39 b(the)h(column)e(name)h(is)g(not)g +(sp)s(eci\014ed,)h(then)f(CFITSIO)f(will)f(\014rst)h(try)i(to)g(use)f +(the)g('preferred)120 2944 y(column')34 b(as)h(sp)s(eci\014ed)e(b)m(y)i +(the)g(CPREF)g(k)m(eyw)m(ord)g(if)f(it)h(exists)f(\(e.g.,)k('CPREF)d(=) +g('DETX,DETY'\),)120 3057 y(otherwise)30 b(column)f(names)h('X',)i('Y') +e(will)e(b)s(e)i(assumed)g(for)g(the)g(2)h(axes.)261 +3170 y(Note)37 b(that)f(this)e(binning)e(sp)s(eci\014er)i(is)g(not)h +(restricted)g(to)h(only)f(2D)h(images)f(and)g(can)g(b)s(e)g(used)g(to) +120 3283 y(create)f(1D,)f(3D,)g(or)g(4D)g(images)f(as)g(w)m(ell.)46 +b(It)32 b(is)f(also)h(p)s(ossible)e(to)j(sp)s(ecify)e(a)h(w)m(eigh)m +(ting)g(factor)i(that)e(is)120 3396 y(applied)27 b(during)h(the)h +(binning.)38 b(Please)29 b(refer)h(to)g(the)g(\\CFITSIO)e(User's)i +(Reference)g(Guide")f(for)g(more)120 3509 y(details)g(on)i(these)f(adv) +-5 b(anced)31 b(features.)1905 5809 y(27)p eop +%%Page: 28 28 +28 27 bop 120 573 a Fb(5.4)112 b(T)-9 b(able)37 b(Filtering)120 +744 y Fh(5.4.1)105 b(Column)34 b(and)h(Keyw)m(ord)g(Filtering)120 +916 y Fg(The)29 b(column)f(or)h(k)m(eyw)m(ord)h(\014ltering)e(sp)s +(eci\014er)g(is)g(used)h(to)h(mo)s(dify)d(the)j(column)e(structure)h +(and/or)g(the)120 1029 y(header)h(k)m(eyw)m(ords)h(in)e(the)i(HDU)g +(that)g(w)m(as)g(selected)g(with)e(the)i(previous)e(HDU)i(lo)s(cation)f +(sp)s(eci\014er.)39 b(It)120 1142 y(can)31 b(b)s(e)e(used)h(to)h(p)s +(erform)e(the)i(follo)m(wing)d(t)m(yp)s(es)j(of)f(op)s(erations.)256 +1354 y Fa(\017)46 b Fg(App)s(end)35 b(a)h(new)g(column)f(to)i(a)f +(table)g(b)m(y)h(giving)e(the)h(column)f(name,)j(optionally)d(follo)m +(w)m(ed)g(b)m(y)347 1467 y(the)e(datat)m(yp)s(e)h(in)d(paren)m(theses,) +j(follo)m(w)m(ed)e(b)m(y)h(an)g(equals)f(sign)g(and)g(the)h(arithmetic) +f(expression)347 1580 y(to)e(b)s(e)e(used)g(to)i(compute)f(the)g(v)-5 +b(alue.)40 b(The)28 b(datat)m(yp)s(e)i(is)e(sp)s(eci\014ed)f(using)h +(the)h(same)g(syn)m(tax)h(that)347 1693 y(is)j(allo)m(w)m(ed)g(for)g +(the)g(v)-5 b(alue)33 b(of)h(the)f(FITS)g(TF)m(ORMn)g(k)m(eyw)m(ord)h +(\(e.g.,)i('I',)e('J',)g('E',)f('D',)i(etc.)51 b(for)347 +1806 y(binary)31 b(tables,)h(and)g('I8',)h(F12.3',)i('E20.12',)g(etc.) +47 b(for)32 b(ASCI)s(I)f(tables\).)46 b(If)32 b(the)g(datat)m(yp)s(e)h +(is)e(not)347 1919 y(sp)s(eci\014ed)e(then)h(a)h(default)e(datat)m(yp)s +(e)j(will)27 b(b)s(e)j(c)m(hosen)h(dep)s(ending)d(on)i(the)h +(expression.)256 2107 y Fa(\017)46 b Fg(Create)33 b(a)g(new)f(header)g +(k)m(eyw)m(ord)h(b)m(y)f(giving)f(the)i(k)m(eyw)m(ord)g(name,)g +(preceded)f(b)m(y)g(a)h(p)s(ound)d(sign)347 2220 y('#',)24 +b(follo)m(w)m(ed)c(b)m(y)h(an)g(equals)f(sign)g(and)g(an)h(arithmetic)f +(expression)g(for)h(the)g(v)-5 b(alue)20 b(of)h(the)h(k)m(eyw)m(ord.) +347 2332 y(The)k(expression)f(ma)m(y)i(b)s(e)f(a)h(function)e(of)i +(other)f(header)g(k)m(eyw)m(ord)h(v)-5 b(alues.)39 b(The)26 +b(commen)m(t)h(string)347 2445 y(for)40 b(the)h(k)m(eyw)m(ord)g(ma)m(y) +g(b)s(e)f(sp)s(eci\014ed)f(in)g(paren)m(theses)i(immediately)d(follo)m +(wing)h(the)i(k)m(eyw)m(ord)347 2558 y(name.)256 2746 +y Fa(\017)46 b Fg(Ov)m(erwrite)29 b(the)g(v)-5 b(alues)29 +b(in)e(an)i(existing)g(column)e(or)j(k)m(eyw)m(ord)f(b)m(y)g(giving)f +(the)i(name)f(follo)m(w)m(ed)f(b)m(y)347 2859 y(an)j(equals)e(sign)h +(and)f(an)i(arithmetic)e(expression.)256 3046 y Fa(\017)46 +b Fg(Select)35 b(a)f(set)g(of)h(columns)d(to)j(b)s(e)e(included)f(in)g +(the)j(\014ltered)e(\014le)g(b)m(y)h(listing)d(the)k(column)d(names)347 +3159 y(separated)d(with)e(semi-colons.)39 b(Wild)27 b(card)h(c)m +(haracters)i(ma)m(y)e(b)s(e)g(used)f(in)g(the)i(column)e(names)h(to)347 +3272 y(matc)m(h)33 b(m)m(ultiple)d(columns.)45 b(An)m(y)32 +b(other)h(columns)d(in)h(the)i(input)d(table)i(will)d(not)k(app)s(ear)e +(in)g(the)347 3385 y(\014ltered)f(\014le.)256 3573 y +Fa(\017)46 b Fg(Delete)31 b(a)f(column)f(or)g(k)m(eyw)m(ord)h(b)m(y)g +(listing)d(the)j(name)g(preceded)f(b)m(y)h(a)g(min)m(us)e(sign)g(or)i +(an)g(excla-)347 3686 y(mation)g(mark)g(\(!\))256 3873 +y Fa(\017)46 b Fg(Rename)31 b(an)f(existing)g(column)f(or)h(k)m(eyw)m +(ord)h(with)e(the)i(syn)m(tax)g('NewName)g(==)f(OldName'.)261 +4086 y(The)20 b(column)f(\014ltering)g(sp)s(eci\014er)f(is)i(enclosed)g +(in)f(square)h(brac)m(k)m(ets)h(and)f(b)s(egins)f(with)g(the)h(string)g +('col'.)120 4199 y(Multiple)29 b(op)s(erations)h(can)h(b)s(e)f(p)s +(erformed)f(b)m(y)i(separating)f(them)h(with)e(semi-colons.)41 +b(F)-8 b(or)32 b(complex)e(or)120 4312 y(commonly)g(used)h(op)s +(erations,)f(y)m(ou)i(can)f(write)f(the)h(column)f(\014lter)g(to)i(a)f +(text)h(\014le,)e(and)h(then)f(use)h(it)f(b)m(y)120 4425 +y(giving)f(the)i(name)f(of)h(the)f(text)i(\014le,)d(preceded)h(b)m(y)h +(a)f('@')h(c)m(haracter.)261 4538 y(Some)g(examples:)215 +4750 y Fc([col)47 b(PI=PHA)f(*)i(1.1)f(+)g(0.2])285 b(-)48 +b(creates)e(new)g(PI)i(column)e(from)g(PHA)h(values)215 +4976 y([col)g(rate)g(=)g(counts/exposure])91 b(-)48 b(creates)e(or)h +(overwrites)e(the)i(rate)f(column)g(by)1743 5089 y(dividing)f(the)i +(counts)f(column)g(by)i(the)1743 5202 y(EXPOSURE)d(keyword)h(value.)215 +5428 y([col)h(TIME;)f(X;)i(Y])667 b(-)48 b(only)e(the)h(listed)f +(columns)g(will)h(appear)1743 5540 y(in)g(the)g(filtered)e(file)1905 +5809 y Fg(28)p eop +%%Page: 29 29 +29 28 bop 215 686 a Fc([col)47 b(Time;*raw])713 b(-)48 +b(include)e(the)g(Time)h(column)f(and)h(any)g(other)1743 +799 y(columns)f(whose)g(name)h(ends)f(with)h('raw'.)215 +1024 y([col)g(-TIME;)f(Good)h(==)g(STATUS])141 b(-)48 +b(deletes)e(the)g(TIME)h(column)f(and)1743 1137 y(renames)g(the)g +(STATUS)h(column)f(to)h(GOOD)215 1363 y([col)g(@colfilt.txt])569 +b(-)48 b(uses)e(the)h(filtering)f(expression)f(in)1743 +1476 y(the)i(colfilt.txt)d(text)j(file)261 1689 y Fg(The)30 +b(original)f(\014le)h(is)g(not)h(c)m(hanged)g(b)m(y)g(this)f +(\014ltering)f(op)s(eration,)h(and)g(instead)g(the)h(mo)s +(di\014cations)120 1802 y(are)36 b(made)f(on)h(a)f(temp)s(orary)h(cop)m +(y)g(of)f(the)h(input)d(FITS)i(\014le)g(\(usually)e(in)h(memory\),)k +(whic)m(h)c(includes)120 1914 y(a)42 b(cop)m(y)g(of)g(all)e(the)i +(other)g(HDUs)g(in)e(the)i(input)e(\014le.)73 b(The)41 +b(original)f(input)g(\014le)g(is)h(closed)g(and)g(the)120 +2027 y(application)29 b(program)h(op)s(ens)f(the)i(\014ltered)e(cop)m +(y)i(of)g(the)g(\014le.)120 2268 y Fh(5.4.2)105 b(Ro)m(w)36 +b(Filtering)120 2439 y Fg(The)22 b(ro)m(w)h(\014lter)f(is)g(used)g(to)h +(select)g(a)h(subset)e(of)h(the)g(ro)m(ws)f(from)h(a)g(table)f(based)h +(on)f(a)i(b)s(o)s(olean)d(expression.)120 2552 y(A)37 +b(temp)s(orary)g(new)f(FITS)g(\014le)h(is)f(created)i(on)f(the)g(\015y) +f(\(usually)f(in)h(memory\))h(whic)m(h)f(con)m(tains)h(only)120 +2665 y(those)30 b(ro)m(ws)g(for)g(whic)m(h)f(the)h(ro)m(w)g(\014lter)f +(expression)f(ev)-5 b(aluates)31 b(to)f(true)g(\(i.e.,)h(not)f(equal)f +(to)i(zero\).)42 b(The)120 2778 y(primary)24 b(arra)m(y)j(and)e(an)m(y) +h(other)h(extensions)e(in)g(the)h(input)e(\014le)h(are)i(also)f(copied) +f(to)i(the)f(temp)s(orary)g(\014le.)120 2891 y(The)h(original)f(FITS)h +(\014le)g(is)g(closed)g(and)h(the)g(new)f(temp)s(orary)g(\014le)g(is)g +(then)g(op)s(ened)g(b)m(y)h(the)g(application)120 3004 +y(program.)261 3117 y(The)f(ro)m(w)g(\014lter)f(expression)g(is)g +(enclosed)g(in)g(square)h(brac)m(k)m(ets)h(follo)m(wing)e(the)h(\014le) +f(name)h(and)f(exten-)120 3230 y(sion)31 b(name.)48 b(F)-8 +b(or)33 b(example,)g Fc('file.fits[events][GRAD)o(E==5)o(0]')26 +b Fg(selects)33 b(only)f(those)h(ro)m(ws)f(in)f(the)120 +3342 y(EVENTS)f(table)g(where)g(the)g(GRADE)h(column)f(v)-5 +b(alue)29 b(is)h(equal)g(to)h(50\).)261 3455 y(The)d(ro)m(w)h +(\014ltering)d(expression)i(can)g(b)s(e)g(an)h(arbitrarily)c(complex)k +(series)e(of)i(op)s(erations)f(p)s(erformed)120 3568 +y(on)e(constan)m(ts,)i(k)m(eyw)m(ord)e(v)-5 b(alues,)26 +b(and)f(column)g(data)h(tak)m(en)h(from)e(the)h(sp)s(eci\014ed)e(FITS)h +(T)-8 b(ABLE)26 b(exten-)120 3681 y(sion.)39 b(The)27 +b(expression)f(also)i(can)f(b)s(e)g(written)g(in)m(to)h(a)f(text)i +(\014le)e(and)g(then)g(used)g(b)m(y)g(giving)f(the)i(\014lename)120 +3794 y(preceded)i(b)m(y)g(a)h('@')g(c)m(haracter,)h(as)e(in)f +Fc('[@rowfilt.txt]')p Fg(.)261 3907 y(Keyw)m(ord)40 b(and)f(column)g +(data)h(are)h(referenced)f(b)m(y)f(name.)70 b(An)m(y)40 +b(string)f(of)h(c)m(haracters)h(not)f(sur-)120 4020 y(rounded)30 +b(b)m(y)i(quotes)g(\(ie,)g(a)h(constan)m(t)g(string\))e(or)g(follo)m(w) +m(ed)h(b)m(y)f(an)h(op)s(en)f(paren)m(theses)h(\(ie,)h(a)f(function)120 +4133 y(name\))e(will)c(b)s(e)j(initially)c(in)m(terpreted)k(as)g(a)h +(column)e(name)h(and)g(its)g(con)m(ten)m(ts)i(for)e(the)g(curren)m(t)g +(ro)m(w)g(in-)120 4246 y(serted)e(in)m(to)g(the)h(expression.)38 +b(If)27 b(no)g(suc)m(h)g(column)f(exists,)i(a)f(k)m(eyw)m(ord)h(of)g +(that)f(name)h(will)c(b)s(e)j(searc)m(hed)120 4359 y(for)34 +b(and)f(its)g(v)-5 b(alue)34 b(used,)g(if)f(found.)50 +b(T)-8 b(o)35 b(force)f(the)g(name)g(to)h(b)s(e)e(in)m(terpreted)g(as)i +(a)f(k)m(eyw)m(ord)g(\(in)f(case)120 4472 y(there)28 +b(is)f(b)s(oth)g(a)h(column)f(and)g(k)m(eyw)m(ord)h(with)f(the)h(same)g +(name\),)h(precede)f(the)g(k)m(eyw)m(ord)h(name)e(with)g(a)120 +4584 y(single)j(p)s(ound)f(sign,)i('#',)h(as)g(in)e Fc(#NAXIS2)p +Fg(.)41 b(Due)32 b(to)g(the)f(generalities)g(of)g(FITS)g(column)f(and)h +(k)m(eyw)m(ord)120 4697 y(names,)c(if)d(the)i(column)f(or)g(k)m(eyw)m +(ord)h(name)g(con)m(tains)g(a)g(space)g(or)g(a)g(c)m(haracter)h(whic)m +(h)e(migh)m(t)g(app)s(ear)g(as)120 4810 y(an)32 b(arithmetic)f(term)h +(then)g(inclose)f(the)h(name)g(in)e('$')j(c)m(haracters)h(as)e(in)f +Fc($MAX)46 b(PHA$)31 b Fg(or)h Fc(#$MAX-PHA$)p Fg(.)120 +4923 y(The)e(names)g(are)h(case)g(insensitiv)m(e.)261 +5036 y(T)-8 b(o)37 b(access)g(a)g(table)f(en)m(try)h(in)e(a)h(ro)m(w)h +(other)f(than)g(the)h(curren)m(t)f(one,)i(follo)m(w)e(the)g(column's)f +(name)120 5149 y(with)j(a)h(ro)m(w)g(o\013set)g(within)e(curly)g +(braces.)66 b(F)-8 b(or)40 b(example,)h Fc('PHA)p Fa(f)p +Fc(-3)p Fa(g)p Fc(')d Fg(will)e(ev)-5 b(aluate)39 b(to)h(the)f(v)-5 +b(alue)120 5262 y(of)40 b(column)e(PHA,)i(3)g(ro)m(ws)f(ab)s(o)m(v)m(e) +i(the)f(ro)m(w)g(curren)m(tly)e(b)s(eing)g(pro)s(cessed.)68 +b(One)39 b(cannot)h(sp)s(ecify)e(an)120 5375 y(absolute)32 +b(ro)m(w)g(n)m(um)m(b)s(er,)f(only)g(a)i(relativ)m(e)f(o\013set.)47 +b(Ro)m(ws)32 b(that)h(fall)d(outside)h(the)i(table)f(will)d(b)s(e)i +(treated)120 5488 y(as)g(unde\014ned,)d(or)i(NULLs.)1905 +5809 y(29)p eop +%%Page: 30 30 +30 29 bop 261 573 a Fg(Bo)s(olean)31 b(op)s(erators)g(can)g(b)s(e)g +(used)f(in)f(the)i(expression)f(in)f(either)i(their)f(F)-8 +b(ortran)31 b(or)g(C)f(forms.)42 b(The)120 686 y(follo)m(wing)29 +b(b)s(o)s(olean)g(op)s(erators)i(are)g(a)m(v)-5 b(ailable:)311 +886 y Fc("equal")428 b(.eq.)46 b(.EQ.)h(==)95 b("not)46 +b(equal")476 b(.ne.)94 b(.NE.)h(!=)311 999 y("less)46 +b(than")238 b(.lt.)46 b(.LT.)h(<)143 b("less)46 b(than/equal")188 +b(.le.)94 b(.LE.)h(<=)47 b(=<)311 1112 y("greater)e(than")95 +b(.gt.)46 b(.GT.)h(>)143 b("greater)45 b(than/equal")g(.ge.)94 +b(.GE.)h(>=)47 b(=>)311 1225 y("or")572 b(.or.)46 b(.OR.)h(||)95 +b("and")762 b(.and.)46 b(.AND.)h(&&)311 1337 y("negation")236 +b(.not.)46 b(.NOT.)h(!)95 b("approx.)45 b(equal\(1e-7\)")92 +b(~)261 1537 y Fg(Note)34 b(that)g(the)f(exclamation)g(p)s(oin)m(t,)g +(')10 b(!',)34 b(is)e(a)i(sp)s(ecial)d(UNIX)i(c)m(haracter,)j(so)d(if)f +(it)g(is)g(used)g(on)h(the)120 1650 y(command)f(line)f(rather)h(than)g +(en)m(tered)h(at)g(a)g(task)g(prompt,)f(it)g(m)m(ust)g(b)s(e)g +(preceded)g(b)m(y)g(a)h(bac)m(kslash)f(to)120 1763 y(force)f(the)g +(UNIX)f(shell)f(to)i(ignore)f(it.)261 1876 y(The)d(expression)e(ma)m(y) +j(also)f(include)e(arithmetic)h(op)s(erators)h(and)f(functions.)38 +b(T)-8 b(rigonometric)27 b(func-)120 1989 y(tions)g(use)h(radians,)g +(not)g(degrees.)40 b(The)28 b(follo)m(wing)f(arithmetic)g(op)s(erators) +h(and)g(functions)e(can)j(b)s(e)e(used)120 2102 y(in)i(the)i +(expression)e(\(function)g(names)h(are)h(case)h(insensitiv)m(e\):)311 +2302 y Fc("addition")522 b(+)477 b("subtraction")d(-)311 +2415 y("multiplication")234 b(*)477 b("division")618 +b(/)311 2528 y("negation")522 b(-)477 b("exponentiation")330 +b(**)143 b(^)311 2641 y("absolute)45 b(value")237 b(abs\(x\))g +("cosine")714 b(cos\(x\))311 2754 y("sine")g(sin\(x\))237 +b("tangent")666 b(tan\(x\))311 2867 y("arc)47 b(cosine")427 +b(arccos\(x\))93 b("arc)47 b(sine")619 b(arcsin\(x\))311 +2979 y("arc)47 b(tangent")379 b(arctan\(x\))93 b("arc)47 +b(tangent")475 b(arctan2\(x,y\))311 3092 y("exponential")378 +b(exp\(x\))237 b("square)46 b(root")476 b(sqrt\(x\))311 +3205 y("natural)45 b(log")381 b(log\(x\))237 b("common)46 +b(log")524 b(log10\(x\))311 3318 y("modulus")570 b(i)48 +b(\045)f(j)286 b("random)46 b(#)h([0.0,1.0\)")141 b(random\(\))311 +3431 y("minimum")570 b(min\(x,y\))141 b("maximum")666 +b(max\(x,y\))311 3544 y("if-then-else")330 b(b?x:y)261 +3744 y Fg(The)37 b(follo)m(wing)f(t)m(yp)s(e)i(casting)f(op)s(erators)h +(are)g(a)m(v)-5 b(ailable,)38 b(where)f(the)h(inclosing)d(paren)m +(theses)j(are)120 3857 y(required)22 b(and)i(tak)m(en)h(from)f(the)h(C) +f(language)g(usage.)40 b(Also,)25 b(the)f(in)m(teger)h(to)g(real)f +(casts)h(v)-5 b(alues)24 b(to)h(double)120 3970 y(precision:)884 +4170 y Fc("real)46 b(to)h(integer")189 b(\(int\))46 b(x)239 +b(\(INT\))46 b(x)884 4283 y("integer)f(to)i(real")190 +b(\(float\))46 b(i)143 b(\(FLOAT\))45 b(i)261 4483 y +Fg(Sev)m(eral)31 b(constan)m(ts)g(are)g(built)d(in)h(for)h(use)g(in)f +(n)m(umerical)g(expressions:)502 4683 y Fc(#pi)667 b(3.1415...)284 +b(#e)620 b(2.7182...)502 4796 y(#deg)f(#pi/180)380 b(#row)524 +b(current)46 b(row)h(number)502 4909 y(#null)428 b(undefined)45 +b(value)142 b(#snull)428 b(undefined)45 b(string)261 +5109 y Fg(A)d(string)f(constan)m(t)i(m)m(ust)f(b)s(e)f(enclosed)h(in)f +(quotes)h(as)g(in)f('Crab'.)75 b(The)41 b("n)m(ull")g(constan)m(ts)i +(are)120 5222 y(useful)36 b(for)h(conditionally)e(setting)j(table)f(v) +-5 b(alues)37 b(to)h(a)g(NULL,)g(or)f(unde\014ned,)h(v)-5 +b(alue)37 b(\(F)-8 b(or)38 b(example,)120 5334 y Fc("col1==-99)45 +b(?)95 b(#NULL)47 b(:)g(col1")p Fg(\).)261 5447 y(There)33 +b(is)g(also)g(a)h(function)f(for)g(testing)h(if)e(t)m(w)m(o)j(v)-5 +b(alues)33 b(are)h(close)g(to)g(eac)m(h)h(other,)g(i.e.,)g(if)d(they)i +(are)120 5560 y("near")29 b(eac)m(h)g(other)f(to)g(within)e(a)i(user)f +(sp)s(eci\014ed)f(tolerance.)41 b(The)27 b(argumen)m(ts,)i +Fc(value)p 3184 5560 29 4 v 33 w(1)e Fg(and)h Fc(value)p +3707 5560 V 33 w(2)1905 5809 y Fg(30)p eop +%%Page: 31 31 +31 30 bop 120 573 a Fg(can)39 b(b)s(e)g(in)m(teger)g(or)g(real)f(and)h +(represen)m(t)g(the)g(t)m(w)m(o)h(v)-5 b(alues)38 b(who's)h(pro)m +(ximit)m(y)f(is)g(b)s(eing)g(tested)h(to)h(b)s(e)120 +686 y(within)28 b(the)i(sp)s(eci\014ed)f(tolerance,)i(also)g(an)f(in)m +(teger)h(or)f(real:)1075 880 y Fc(near\(value_1,)44 b(value_2,)h +(tolerance\))261 1074 y Fg(When)30 b(a)h(NULL,)f(or)h(unde\014ned,)d(v) +-5 b(alue)30 b(is)f(encoun)m(tered)i(in)e(the)h(FITS)g(table,)g(the)h +(expression)e(will)120 1186 y(ev)-5 b(aluate)42 b(to)g(NULL)g(unless)d +(the)j(unde\014ned)d(v)-5 b(alue)41 b(is)g(not)g(actually)g(required)f +(for)h(ev)-5 b(aluation,)44 b(e.g.)120 1299 y("TR)m(UE)e(.or.)76 +b(NULL")42 b(ev)-5 b(aluates)43 b(to)g(TR)m(UE.)f(The)f(follo)m(wing)g +(t)m(w)m(o)i(functions)e(allo)m(w)g(some)h(NULL)120 1412 +y(detection)31 b(and)f(handling:)1027 1606 y Fc(ISNULL\(x\))1027 +1719 y(DEFNULL\(x,y\))261 1913 y Fg(The)43 b(former)g(returns)f(a)i(b)s +(o)s(olean)e(v)-5 b(alue)43 b(of)g(TR)m(UE)h(if)e(the)i(argumen)m(t)f +(x)h(is)e(NULL.)i(The)e(later)120 2026 y("de\014nes")e(a)g(v)-5 +b(alue)39 b(to)h(b)s(e)g(substituted)e(for)h(NULL)h(v)-5 +b(alues;)44 b(it)39 b(returns)f(the)i(v)-5 b(alue)40 +b(of)f(x)h(if)f(x)g(is)g(not)120 2139 y(NULL,)31 b(otherwise)e(it)h +(returns)f(the)i(v)-5 b(alue)30 b(of)g(y)-8 b(.)261 2252 +y(Bit)31 b(masks)g(can)g(b)s(e)f(used)g(to)h(select)h(out)f(ro)m(ws)g +(from)f(bit)g(columns)f(\()p Fc(TFORMn)47 b(=)g(#X)p +Fg(\))31 b(in)e(FITS)h(\014les.)120 2365 y(T)-8 b(o)31 +b(represen)m(t)f(the)h(mask,)f(binary)-8 b(,)30 b(o)s(ctal,)h(and)e +(hex)i(formats)f(are)h(allo)m(w)m(ed:)931 2558 y Fc(binary:)142 +b(b0110xx1010000101xxxx00)o(01)931 2671 y(octal:)190 +b(o720x1)46 b(->)h(\(b111010000xxx001\))931 2784 y(hex:)286 +b(h0FxD)94 b(->)47 b(\(b00001111xxxx1101\))261 2978 y +Fg(In)28 b(all)g(the)i(represen)m(tations,)f(an)g(x)g(or)g(X)g(is)f +(allo)m(w)m(ed)h(in)f(the)h(mask)g(as)h(a)f(wild)e(card.)40 +b(Note)30 b(that)g(the)120 3091 y(x)i(represen)m(ts)f(a)h(di\013eren)m +(t)f(n)m(um)m(b)s(er)g(of)h(wild)d(card)j(bits)e(in)g(eac)m(h)j +(represen)m(tation.)45 b(All)30 b(represen)m(tations)120 +3204 y(are)h(case)g(insensitiv)m(e.)261 3317 y(T)-8 b(o)38 +b(construct)f(the)h(b)s(o)s(olean)e(expression)g(using)g(the)h(mask)h +(as)f(the)h(b)s(o)s(olean)e(equal)h(op)s(erator)g(de-)120 +3430 y(scrib)s(ed)29 b(ab)s(o)m(v)m(e)i(on)g(a)g(bit)f(table)g(column.) +40 b(F)-8 b(or)32 b(example,)e(if)g(y)m(ou)h(had)f(a)h(7)g(bit)e +(column)h(named)g(\015ags)h(in)120 3543 y(a)36 b(FITS)e(table)i(and)f +(w)m(an)m(ted)h(all)e(ro)m(ws)h(ha)m(ving)g(the)h(bit)e(pattern)i +(0010011,)k(the)35 b(selection)h(expression)120 3656 +y(w)m(ould)29 b(b)s(e:)1456 3850 y Fc(flags)47 b(==)g(b0010011)311 +3962 y(or)1456 4075 y(flags)g(.eq.)f(b10011)261 4269 +y Fg(It)32 b(is)e(also)i(p)s(ossible)d(to)j(test)g(if)f(a)h(range)f(of) +h(bits)e(is)h(less)g(than,)g(less)g(than)h(equal,)f(greater)i(than)e +(and)120 4382 y(greater)h(than)e(equal)g(to)h(a)f(particular)f(b)s(o)s +(olean)h(v)-5 b(alue:)1456 4576 y Fc(flags)47 b(<=)g(bxxx010xx)1456 +4689 y(flags)g(.gt.)f(bxxx100xx)1456 4802 y(flags)h(.le.)f(b1xxxxxxx) +261 4996 y Fg(Notice)31 b(the)g(use)f(of)h(the)f(x)h(bit)e(v)-5 +b(alue)30 b(to)h(limit)d(the)j(range)f(of)h(bits)e(b)s(eing)g +(compared.)261 5109 y(It)k(is)f(not)h(necessary)g(to)g(sp)s(ecify)f +(the)g(leading)g(\(most)h(signi\014can)m(t\))f(zero)i(\(0\))g(bits)d +(in)h(the)h(mask,)g(as)120 5222 y(sho)m(wn)d(in)f(the)h(second)h +(expression)e(ab)s(o)m(v)m(e.)261 5334 y(Bit)h(wise)f(AND,)h(OR)g(and)f +(NOT)g(op)s(erations)g(are)h(also)g(p)s(ossible)d(on)i(t)m(w)m(o)i(or)f +(more)g(bit)f(\014elds)f(using)120 5447 y(the)38 b('&'\(AND\),)h(')p +Fa(j)p Fg('\(OR\),)g(and)e(the)h(')10 b(!'\(NOT\))38 +b(op)s(erators.)63 b(All)36 b(of)i(these)g(op)s(erators)g(result)e(in)g +(a)i(bit)120 5560 y(\014eld)29 b(whic)m(h)g(can)i(then)f(b)s(e)g(used)f +(with)g(the)i(equal)f(op)s(erator.)41 b(F)-8 b(or)31 +b(example:)1905 5809 y(31)p eop +%%Page: 32 32 +32 31 bop 1361 573 a Fc(\(!flags\))45 b(==)j(b1101100)1361 +686 y(\(flags)e(&)h(b1000001\))f(==)h(bx000001)261 887 +y Fg(Bit)35 b(\014elds)e(can)h(b)s(e)g(app)s(ended)f(as)i(w)m(ell)e +(using)g(the)i('+')g(op)s(erator.)53 b(Strings)33 b(can)i(b)s(e)f +(concatenated)120 1000 y(this)29 b(w)m(a)m(y)-8 b(,)32 +b(to)s(o.)120 1238 y Fh(5.4.3)105 b(Go)s(o)s(d)36 b(Time)e(In)m(terv)-6 +b(al)34 b(Filtering)120 1410 y Fg(A)27 b(common)g(\014ltering)e(metho)s +(d)i(in)m(v)m(olv)m(es)g(selecting)g(ro)m(ws)f(whic)m(h)g(ha)m(v)m(e)i +(a)g(time)e(v)-5 b(alue)27 b(whic)m(h)e(lies)h(within)120 +1523 y(what)38 b(is)e(called)h(a)h(Go)s(o)s(d)g(Time)e(In)m(terv)-5 +b(al)38 b(or)f(GTI.)h(The)f(time)h(in)m(terv)-5 b(als)36 +b(are)i(de\014ned)f(in)f(a)i(separate)120 1636 y(FITS)31 +b(table)h(extension)f(whic)m(h)g(con)m(tains)h(2)g(columns)e(giving)h +(the)h(start)g(and)f(stop)h(time)g(of)g(eac)m(h)g(go)s(o)s(d)120 +1749 y(in)m(terv)-5 b(al.)59 b(The)37 b(\014ltering)e(op)s(eration)h +(accepts)i(only)e(those)h(ro)m(ws)g(of)g(the)g(input)e(table)i(whic)m +(h)e(ha)m(v)m(e)j(an)120 1861 y(asso)s(ciated)31 b(time)g(whic)m(h)f +(falls)f(within)f(one)k(of)f(the)g(time)f(in)m(terv)-5 +b(als)30 b(de\014ned)g(in)g(the)h(GTI)f(extension.)42 +b(A)120 1974 y(high)28 b(lev)m(el)i(function,)f +(gti\014lter\(a,b,c,d\),)i(is)d(a)m(v)-5 b(ailable)30 +b(whic)m(h)e(ev)-5 b(aluates)31 b(eac)m(h)g(ro)m(w)f(of)g(the)g(input)d +(table)120 2087 y(and)j(returns)g(TR)m(UE)g(or)h(F)-10 +b(ALSE)30 b(dep)s(ending)f(whether)h(the)g(ro)m(w)h(is)f(inside)e(or)j +(outside)f(the)h(go)s(o)s(d)g(time)120 2200 y(in)m(terv)-5 +b(al.)40 b(The)30 b(syn)m(tax)h(is)406 2401 y Fc(gtifilter\()45 +b([)j("gtifile")d([,)i(expr)g([,)g("STARTCOL",)e("STOPCOL")g(])j(])f(]) +g(\))120 2603 y Fg(where)35 b(eac)m(h)i("[]")g(demarks)e(optional)f +(parameters.)57 b(Note)37 b(that)f(the)g(quotes)g(around)e(the)i +(gti\014le)f(and)120 2716 y(ST)-8 b(AR)g(T/STOP)31 b(column)h(are)h +(required.)45 b(Either)32 b(single)f(or)h(double)g(quote)h(c)m +(haracters)h(ma)m(y)f(b)s(e)f(used.)120 2828 y(The)c(gti\014le,)g(if)f +(sp)s(eci\014ed,)h(can)g(b)s(e)g(blank)f(\(""\))j(whic)m(h)d(will)f +(mean)j(to)g(use)f(the)g(\014rst)g(extension)g(with)f(the)120 +2941 y(name)c("*GTI*")i(in)d(the)h(curren)m(t)g(\014le,)h(a)f(plain)e +(extension)i(sp)s(eci\014er)f(\(eg,)k("+2",)f("[2]",)i(or)c +("[STDGTI]"\))120 3054 y(whic)m(h)f(will)f(b)s(e)i(used)g(to)i(select)f +(an)g(extension)f(in)f(the)i(curren)m(t)g(\014le,)g(or)g(a)g(regular)e +(\014lename)h(with)g(or)g(with-)120 3167 y(out)j(an)g(extension)g(sp)s +(eci\014er)e(whic)m(h)h(in)f(the)j(latter)f(case)h(will)c(mean)j(to)h +(use)f(the)g(\014rst)f(extension)h(with)e(an)120 3280 +y(extension)29 b(name)h("*GTI*".)42 b(Expr)28 b(can)i(b)s(e)f(an)m(y)g +(arithmetic)g(expression,)g(including)d(simply)h(the)j(time)120 +3393 y(column)j(name.)52 b(A)34 b(v)m(ector)i(time)e(expression)f(will) +e(pro)s(duce)i(a)i(v)m(ector)g(b)s(o)s(olean)f(result.)50 +b(ST)-8 b(AR)g(TCOL)120 3506 y(and)33 b(STOPCOL)f(are)j(the)f(names)g +(of)g(the)g(ST)-8 b(AR)g(T/STOP)33 b(columns)g(in)f(the)j(GTI)e +(extension.)52 b(If)33 b(one)120 3619 y(of)e(them)f(is)f(sp)s +(eci\014ed,)g(they)i(b)s(oth)e(m)m(ust)i(b)s(e.)261 3732 +y(In)37 b(its)h(simplest)e(form,)k(no)e(parameters)g(need)g(to)h(b)s(e) +e(pro)m(vided)g({)h(default)g(v)-5 b(alues)37 b(will)e(b)s(e)j(used.) +120 3845 y(The)30 b(expression)f Fc("gtifilter\(\)")e +Fg(is)i(equiv)-5 b(alen)m(t)30 b(to)454 4046 y Fc(gtifilter\()45 +b("",)i(TIME,)f("*START*",)f("*STOP*")h(\))120 4247 y +Fg(This)30 b(will)g(searc)m(h)j(the)f(curren)m(t)g(\014le)g(for)g(a)g +(GTI)g(extension,)h(\014lter)e(the)h(TIME)g(column)f(in)g(the)i(curren) +m(t)120 4360 y(table,)47 b(using)c(ST)-8 b(AR)g(T/STOP)43 +b(times)g(tak)m(en)i(from)e(columns)g(in)g(the)h(GTI)f(extension)h +(with)e(names)120 4473 y(con)m(taining)30 b(the)h(strings)e("ST)-8 +b(AR)g(T")31 b(and)f("STOP".)41 b(The)30 b(wildcards)e(\('*'\))k(allo)m +(w)e(sligh)m(t)f(v)-5 b(ariations)30 b(in)120 4586 y(naming)h(con)m(v)m +(en)m(tions)h(suc)m(h)g(as)g("TST)-8 b(AR)g(T")32 b(or)g("ST)-8 +b(AR)g(TTIME".)45 b(The)31 b(same)i(default)e(v)-5 b(alues)31 +b(apply)120 4699 y(for)g(unsp)s(eci\014ed)e(parameters)j(when)e(the)i +(\014rst)e(one)i(or)f(t)m(w)m(o)i(parameters)f(are)g(sp)s(eci\014ed.)42 +b(The)31 b(function)120 4812 y(automatically)41 b(searc)m(hes)g(for)g +(TIMEZER)m(O/I/F)g(k)m(eyw)m(ords)g(in)e(the)i(curren)m(t)g(and)f(GTI)h +(extensions,)120 4924 y(applying)28 b(a)j(relativ)m(e)f(time)h +(o\013set,)g(if)f(necessary)-8 b(.)120 5163 y Fh(5.4.4)105 +b(Spatial)35 b(Region)h(Filtering)120 5334 y Fg(Another)f(common)h +(\014ltering)e(metho)s(d)h(selects)g(ro)m(ws)h(based)f(on)g(whether)g +(the)h(spatial)e(p)s(osition)f(asso-)120 5447 y(ciated)40 +b(with)f(eac)m(h)j(ro)m(w)e(is)f(lo)s(cated)h(within)e(a)i(giv)m(en)h +(2-dimensional)d(region.)69 b(The)40 b(syn)m(tax)h(for)e(this)120 +5560 y(high-lev)m(el)29 b(\014lter)h(is)1905 5809 y(32)p +eop +%%Page: 33 33 +33 32 bop 454 573 a Fc(regfilter\()45 b("regfilename")f([)k(,)f(Xexpr,) +f(Yexpr)h([)g(,)h("wcs)e(cols")h(])g(])g(\))120 757 y +Fg(where)28 b(eac)m(h)i("[)g(]")f(demarks)g(optional)f(parameters.)40 +b(The)29 b(region)f(\014le)g(name)h(is)f(required)f(and)h(m)m(ust)h(b)s +(e)120 870 y(enclosed)g(in)f(quotes.)41 b(The)29 b(remaining)e +(parameters)j(are)f(optional.)40 b(The)29 b(region)g(\014le)f(is)g(an)i +(ASCI)s(I)d(text)120 983 y(\014le)36 b(whic)m(h)f(con)m(tains)i(a)g +(list)f(of)g(one)h(or)g(more)g(geometric)h(shap)s(es)d(\(circle,)k +(ellipse,)d(b)s(o)m(x,)i(etc.\))62 b(whic)m(h)120 1096 +y(de\014nes)30 b(a)i(region)f(on)g(the)h(celestial)f(sphere)g(or)g(an)g +(area)h(within)d(a)j(particular)e(2D)i(image.)44 b(The)31 +b(region)120 1209 y(\014le)37 b(is)g(t)m(ypically)g(generated)i(using)e +(an)h(image)g(displa)m(y)f(program)h(suc)m(h)f(as)i(fv/PO)m(W)f +(\(distribute)e(b)m(y)120 1322 y(the)c(HEASAR)m(C\),)g(or)g(ds9)g +(\(distributed)d(b)m(y)i(the)h(Smithsonian)e(Astroph)m(ysical)g(Observ) +-5 b(atory\).)46 b(Users)120 1435 y(should)40 b(refer)i(to)h(the)f(do)s +(cumen)m(tation)g(pro)m(vided)f(with)g(these)h(programs)g(for)g(more)g +(details)f(on)h(the)120 1548 y(syn)m(tax)31 b(used)e(in)h(the)g(region) +g(\014les.)261 1661 y(In)35 b(its)g(simpliest)e(form,)k(\(e.g.,)i +Fc(regfilter\("region.reg"\))30 b Fg(\))36 b(the)f(co)s(ordinates)h(in) +e(the)i(default)120 1774 y('X')24 b(and)e('Y')i(columns)d(will)g(b)s(e) +h(used)g(to)i(determine)e(if)g(eac)m(h)i(ro)m(w)f(is)f(inside)f(or)i +(outside)f(the)h(area)h(sp)s(eci\014ed)120 1886 y(in)g(the)i(region)f +(\014le.)38 b(Alternate)26 b(p)s(osition)d(column)h(names,)j(or)e +(expressions,)g(ma)m(y)h(b)s(e)f(en)m(tered)h(if)e(needed,)120 +1999 y(as)31 b(in)502 2184 y Fc(regfilter\("region.reg",)41 +b(XPOS,)47 b(YPOS\))120 2368 y Fg(Region)38 b(\014ltering)f(can)h(b)s +(e)g(applied)e(most)i(unam)m(biguously)e(if)h(the)h(p)s(ositions)f(in)f +(the)j(region)f(\014le)f(and)120 2481 y(in)e(the)i(table)g(to)h(b)s(e)e +(\014ltered)g(are)h(b)s(oth)f(giv)m(e)h(in)f(terms)g(of)h(absolute)g +(celestial)f(co)s(ordinate)h(units.)58 b(In)120 2594 +y(this)37 b(case)i(the)g(lo)s(cations)f(and)f(sizes)h(of)h(the)f +(geometric)h(shap)s(es)f(in)f(the)h(region)g(\014le)f(are)i(sp)s +(eci\014ed)e(in)120 2707 y(angular)d(units)f(on)h(the)h(sky)f(\(e.g.,)j +(p)s(ositions)c(giv)m(en)i(in)e(R.A.)i(and)f(Dec.)54 +b(and)34 b(sizes)g(in)f(arcseconds)i(or)120 2820 y(arcmin)m(utes\).)j +(Similarly)-8 b(,)20 b(eac)m(h)j(ro)m(w)g(of)f(the)g(\014ltered)f +(table)h(will)d(ha)m(v)m(e)k(a)g(celestial)e(co)s(ordinate)h(asso)s +(ciated)120 2933 y(with)32 b(it.)50 b(This)32 b(asso)s(ciation)h(is)g +(usually)e(implemen)m(ted)h(using)h(a)g(set)i(of)e(so-called)h('W)-8 +b(orld)33 b(Co)s(ordinate)120 3046 y(System')j(\(or)h(W)m(CS\))f(FITS)f +(k)m(eyw)m(ords)i(that)f(de\014ne)g(the)g(co)s(ordinate)g +(transformation)f(that)i(m)m(ust)f(b)s(e)120 3159 y(applied)28 +b(to)j(the)g(v)-5 b(alues)30 b(in)f(the)h('X')h(and)f('Y')h(columns)e +(to)i(calculate)g(the)f(co)s(ordinate.)261 3272 y(Alternativ)m(ely)-8 +b(,)37 b(one)f(can)f(p)s(erform)f(spatial)h(\014ltering)e(using)h +(unitless)g('pixel')g(co)s(ordinates)h(for)g(the)120 +3385 y(regions)30 b(and)g(ro)m(w)h(p)s(ositions.)40 b(In)30 +b(this)f(case)j(the)f(user)f(m)m(ust)h(b)s(e)f(careful)g(to)h(ensure)f +(that)h(the)g(p)s(ositions)120 3498 y(in)h(the)h(2)h(\014les)e(are)i +(self-consisten)m(t.)49 b(A)34 b(t)m(ypical)e(problem)g(is)g(that)i +(the)g(region)f(\014le)f(ma)m(y)i(b)s(e)e(generated)120 +3610 y(using)22 b(a)i(binned)e(image,)j(but)e(the)h(un)m(binned)d(co)s +(ordinates)i(are)i(giv)m(en)e(in)g(the)h(ev)m(en)m(t)h(table.)38 +b(The)24 b(R)m(OSA)-8 b(T)120 3723 y(ev)m(en)m(ts)34 +b(\014les,)f(for)g(example,)h(ha)m(v)m(e)g(X)f(and)g(Y)g(pixel)e(co)s +(ordinates)i(that)h(range)f(from)g(1)g(-)h(15360.)51 +b(These)120 3836 y(co)s(ordinates)32 b(are)h(t)m(ypically)f(binned)e(b) +m(y)j(a)g(factor)g(of)g(32)h(to)f(pro)s(duce)f(a)h(480x480)i(pixel)c +(image.)48 b(If)32 b(one)120 3949 y(then)f(uses)g(a)g(region)g(\014le)f +(generated)j(from)d(this)g(image)i(\(in)e(image)h(pixel)f(units\))g(to) +i(\014lter)e(the)i(R)m(OSA)-8 b(T)120 4062 y(ev)m(en)m(ts)33 +b(\014le,)e(then)g(the)g(X)g(and)g(Y)h(column)e(v)-5 +b(alues)30 b(m)m(ust)i(b)s(e)e(con)m(v)m(erted)j(to)f(corresp)s(onding) +d(pixel)h(units)120 4175 y(as)h(in:)502 4360 y Fc +(regfilter\("rosat.reg",)42 b(X/32.+.5,)j(Y/32.+.5\))120 +4544 y Fg(Note)30 b(that)f(this)e(binning)f(con)m(v)m(ersion)i(is)g +(not)h(necessary)g(if)e(the)i(region)f(\014le)f(is)h(sp)s(eci\014ed)f +(using)g(celestial)120 4657 y(co)s(ordinate)g(units)f(instead)g(of)h +(pixel)f(units)f(b)s(ecause)i(CFITSIO)f(is)g(then)h(able)g(to)h +(directly)d(compare)j(the)120 4770 y(celestial)34 b(co)s(ordinate)g(of) +g(eac)m(h)h(ro)m(w)f(in)f(the)h(table)g(with)f(the)h(celestial)g(co)s +(ordinates)g(in)e(the)j(region)e(\014le)120 4883 y(without)c(ha)m(ving) +h(to)h(kno)m(w)g(an)m(ything)f(ab)s(out)g(ho)m(w)g(the)h(image)f(ma)m +(y)h(ha)m(v)m(e)h(b)s(een)d(binned.)261 4996 y(The)k(last)g("w)m(cs)g +(cols")h(parameter)f(should)e(rarely)h(b)s(e)h(needed.)48 +b(If)33 b(supplied,)d(this)i(string)g(con)m(tains)120 +5109 y(the)39 b(names)g(of)h(the)f(2)g(columns)f(\(space)i(or)f(comma)h +(separated\))g(whic)m(h)e(ha)m(v)m(e)i(the)g(asso)s(ciated)f(W)m(CS)120 +5222 y(k)m(eyw)m(ords.)k(If)30 b(not)h(supplied,)d(the)j(\014lter)f +(will)e(scan)j(the)g(X)g(and)g(Y)g(expressions)e(for)i(column)f(names.) +42 b(If)120 5334 y(only)32 b(one)g(is)g(found)f(in)g(eac)m(h)j +(expression,)e(those)h(columns)e(will)f(b)s(e)i(used,)h(otherwise)f(an) +g(error)g(will)e(b)s(e)120 5447 y(returned.)261 5560 +y(These)g(region)g(shap)s(es)g(are)g(supp)s(orted)f(\(names)i(are)f +(case)i(insensitiv)m(e\):)1905 5809 y(33)p eop +%%Page: 34 34 +34 33 bop 454 573 a Fc(Point)428 b(\()48 b(X1,)f(Y1)g(\))715 +b(<-)48 b(One)f(pixel)f(square)g(region)454 686 y(Line)476 +b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2)i(\))333 b(<-)48 b(One)f(pixel)f(wide)h +(region)454 799 y(Polygon)332 b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2,)h(...)g +(\))95 b(<-)48 b(Rest)e(are)h(interiors)e(with)454 912 +y(Rectangle)236 b(\()48 b(X1,)f(Y1,)g(X2,)f(Y2,)h(A)h(\))334 +b(|)47 b(boundaries)e(considered)454 1024 y(Box)524 b(\()48 +b(Xc,)f(Yc,)g(Wdth,)f(Hght,)g(A)i(\))143 b(V)47 b(within)f(the)h +(region)454 1137 y(Diamond)332 b(\()48 b(Xc,)f(Yc,)g(Wdth,)f(Hght,)g(A) +i(\))454 1250 y(Circle)380 b(\()48 b(Xc,)f(Yc,)g(R)g(\))454 +1363 y(Annulus)332 b(\()48 b(Xc,)f(Yc,)g(Rin,)f(Rout)h(\))454 +1476 y(Ellipse)332 b(\()48 b(Xc,)f(Yc,)g(Rx,)f(Ry,)h(A)h(\))454 +1589 y(Elliptannulus)c(\()k(Xc,)f(Yc,)g(Rinx,)f(Riny,)g(Routx,)g +(Routy,)g(Ain,)h(Aout)g(\))454 1702 y(Sector)380 b(\()48 +b(Xc,)f(Yc,)g(Amin,)f(Amax)h(\))120 1914 y Fg(where)33 +b(\(Xc,Yc\))j(is)d(the)i(co)s(ordinate)e(of)i(the)f(shap)s(e's)f(cen)m +(ter;)k(\(X#,Y#\))e(are)f(the)g(co)s(ordinates)g(of)g(the)120 +2027 y(shap)s(e's)22 b(edges;)k(Rxxx)d(are)g(the)h(shap)s(es')e(v)-5 +b(arious)22 b(Radii)f(or)i(semima)5 b(jor/minor)21 b(axes;)27 +b(and)22 b(Axxx)h(are)g(the)120 2140 y(angles)i(of)g(rotation)g(\(or)g +(b)s(ounding)d(angles)j(for)g(Sector\))h(in)d(degrees.)40 +b(F)-8 b(or)26 b(rotated)g(shap)s(es,)f(the)g(rotation)120 +2253 y(angle)36 b(can)h(b)s(e)e(left)h(o\013,)i(indicating)c(no)i +(rotation.)59 b(Common)35 b(alternate)i(names)f(for)g(the)g(regions)g +(can)120 2366 y(also)27 b(b)s(e)f(used:)39 b(rotb)s(o)m(x)27 +b(=)f(b)s(o)m(x;)j(rotrectangle)f(=)f(rectangle;)i(\(rot\)rhom)m(bus)d +(=)h(\(rot\)diamond;)h(and)e(pie)120 2479 y(=)h(sector.)41 +b(When)28 b(a)g(shap)s(e's)f(name)g(is)g(preceded)g(b)m(y)h(a)g(min)m +(us)e(sign,)i('-',)h(the)f(de\014ned)e(region)h(is)g(instead)120 +2592 y(the)36 b(area)g(*outside*)g(its)f(b)s(oundary)e(\(ie,)k(the)f +(region)f(is)g(in)m(v)m(erted\).)56 b(All)34 b(the)i(shap)s(es)f +(within)e(a)j(single)120 2705 y(region)e(\014le)g(are)h(OR'd)g +(together)h(to)f(create)i(the)e(region,)g(and)g(the)g(order)f(is)g +(signi\014can)m(t.)53 b(The)34 b(o)m(v)m(erall)120 2818 +y(w)m(a)m(y)g(of)g(lo)s(oking)e(at)i(region)f(\014les)f(is)g(that)i(if) +e(the)i(\014rst)e(region)h(is)g(an)g(excluded)f(region)h(then)g(a)g +(dumm)m(y)120 2931 y(included)27 b(region)j(of)g(the)g(whole)f +(detector)j(is)d(inserted)f(in)h(the)h(fron)m(t.)41 b(Then)29 +b(eac)m(h)i(region)f(sp)s(eci\014cation)120 3044 y(as)h(it)g(is)f(pro)s +(cessed)h(o)m(v)m(errides)g(an)m(y)g(selections)g(inside)e(of)i(that)h +(region)f(sp)s(eci\014ed)e(b)m(y)i(previous)f(regions.)120 +3156 y(Another)f(w)m(a)m(y)i(of)e(thinking)e(ab)s(out)i(this)f(is)h +(that)g(if)g(a)g(previous)f(excluded)g(region)h(is)g(completely)g +(inside)120 3269 y(of)i(a)f(subsequen)m(t)g(included)e(region)i(the)g +(excluded)f(region)h(is)g(ignored.)261 3382 y(The)20 +b(p)s(ositional)e(co)s(ordinates)i(ma)m(y)h(b)s(e)e(giv)m(en)i(either)e +(in)g(pixel)g(units,)i(decimal)e(degrees)i(or)f(hh:mm:ss.s,)120 +3495 y(dd:mm:ss.s)25 b(units.)37 b(The)26 b(shap)s(e)f(sizes)g(ma)m(y)i +(b)s(e)e(giv)m(en)h(in)e(pixels,)i(degrees,)h(arcmin)m(utes,)g(or)f +(arcseconds.)120 3608 y(Lo)s(ok)k(at)i(examples)d(of)i(region)f(\014le) +f(pro)s(duced)g(b)m(y)h(fv/PO)m(W)h(or)f(ds9)g(for)g(further)f(details) +h(of)g(the)h(region)120 3721 y(\014le)e(format.)120 3961 +y Fh(5.4.5)105 b(Example)34 b(Ro)m(w)h(Filters)311 4133 +y Fc([double)46 b(&&)h(mag)g(<=)g(5.0])381 b(-)95 b(Extract)46 +b(all)h(double)f(stars)g(brighter)1886 4246 y(than)94 +b(fifth)47 b(magnitude)311 4472 y([#row)f(>=)h(125)g(&&)h(#row)e(<=)h +(175])142 b(-)48 b(Extract)e(row)h(numbers)e(125)i(through)f(175)311 +4697 y([abs\(sin\(theta)e(*)j(#deg\)\))f(<)i(0.5])e(-)i(Extract)e(all)h +(rows)f(having)g(the)1886 4810 y(absolute)f(value)i(of)g(the)g(sine)g +(of)g(theta)1886 4923 y(less)94 b(than)47 b(a)g(half)g(where)f(the)h +(angles)1886 5036 y(are)g(tabulated)e(in)i(degrees)311 +5262 y([@rowFilter.txt])711 b(-)48 b(Extract)e(rows)g(using)h(the)g +(expression)1886 5375 y(contained)e(within)h(the)h(text)g(file)1886 +5488 y(rowFilter.txt)1905 5809 y Fg(34)p eop +%%Page: 35 35 +35 34 bop 311 686 a Fc([gtifilter\(\)])855 b(-)48 b(Search)e(the)h +(current)f(file)g(for)h(a)h(GTI)359 799 y(extension,)92 +b(filter)i(the)47 b(TIME)359 912 y(column)f(in)h(the)g(current)f +(table,)g(using)359 1024 y(START/STOP)f(times)h(taken)g(from)359 +1137 y(columns)f(in)j(the)f(GTI)94 b(extension)311 1363 +y([regfilter\("pow.reg"\)])423 b(-)48 b(Extract)e(rows)g(which)h(have)f +(a)i(coordinate)1886 1476 y(\(as)f(given)f(in)h(the)g(X)h(and)f(Y)g +(columns\))1886 1589 y(within)f(the)h(spatial)f(region)g(specified)1886 +1702 y(in)h(the)g(pow.reg)f(region)g(file.)1905 5809 +y Fg(35)p eop +%%Page: 36 36 +36 35 bop 120 573 a Fb(5.5)112 b(Com)m(bined)37 b(Filtering)e(Examples) +120 744 y Fg(The)29 b(previous)g(sections)g(describ)s(ed)f(all)h(the)h +(individual)25 b(t)m(yp)s(es)30 b(of)g(\014lters)e(that)j(ma)m(y)f(b)s +(e)f(applied)f(to)i(the)120 857 y(input)i(\014le.)49 +b(In)33 b(this)f(section)i(w)m(e)g(sho)m(w)g(examples)f(whic)m(h)f(com) +m(bine)i(sev)m(eral)f(di\013eren)m(t)h(\014lters)e(at)i(once.)120 +970 y(These)h(examples)f(all)g(use)h(the)g Fc(fitscopy)e +Fg(program)i(that)g(is)f(distributed)e(with)i(the)h(CFITSIO)f(co)s(de.) +120 1083 y(It)c(simply)e(copies)j(the)f(input)f(\014le)g(to)i(the)g +(output)f(\014le.)120 1268 y Fc(fitscopy)46 b(rosat.fit)f(out.fit)261 +1453 y Fg(This)25 b(trivial)g(example)h(simply)f(mak)m(es)i(an)g(iden)m +(tical)f(cop)m(y)h(of)g(the)g(input)e(rosat.\014t)i(\014le)f(without)g +(an)m(y)120 1566 y(\014ltering.)120 1751 y Fc(fitscopy)46 +b('rosat.fit[events][col)41 b(Time;X;Y][#row)j(<)k(1000]')e(out.fit)261 +1936 y Fg(The)34 b(output)g(\014le)g(con)m(tains)h(only)e(the)i(Time,)g +(X,)g(and)e(Y)i(columns,)g(and)e(only)h(the)h(\014rst)f(999)h(ro)m(ws) +120 2049 y(from)g(the)g('EVENTS')f(table)h(extension)g(of)g(the)g +(input)e(\014le.)54 b(All)33 b(the)j(other)f(HDUs)g(in)f(the)h(input)e +(\014le)120 2162 y(are)e(copied)f(to)h(the)f(output)g(\014le)g(without) +f(an)m(y)i(mo)s(di\014cation.)120 2346 y Fc(fitscopy)46 +b('rosat.fit[events][PI)c(<)47 b(50][bin)f(\(Xdet,Ydet\))f(=)i(16]')g +(image.fit)261 2531 y Fg(This)29 b(creates)i(an)f(output)g(image)h(b)m +(y)f(binning)d(the)j(Xdet)h(and)f(Ydet)g(columns)f(of)h(the)h(ev)m(en)m +(ts)g(table)120 2644 y(with)25 b(a)i(pixel)e(binning)e(factor)k(of)g +(16.)40 b(Only)25 b(the)i(ro)m(ws)f(whic)m(h)f(ha)m(v)m(e)j(a)e(PI)h +(energy)f(less)g(than)g(50)h(are)g(used)120 2757 y(to)33 +b(construct)f(this)e(image.)45 b(The)32 b(output)f(image)h(\014le)f +(con)m(tains)h(a)g(primary)e(arra)m(y)i(image)g(without)f(an)m(y)120 +2870 y(extensions.)120 3055 y Fc(fitscopy)46 b('rosat.fit[events][gtif) +o(ilt)o(er\(\))41 b(&&)47 b(regfilter\("pow.reg"\)]')42 +b(out.fit)261 3240 y Fg(The)29 b(\014ltering)f(expression)g(in)g(this)h +(example)g(uses)g(the)h Fc(gtifilter)d Fg(function)h(to)i(test)g +(whether)f(the)120 3353 y(TIME)e(column)f(v)-5 b(alue)26 +b(in)g(eac)m(h)j(ro)m(w)e(is)f(within)f(one)i(of)g(the)h(Go)s(o)s(d)f +(Time)f(In)m(terv)-5 b(als)26 b(de\014ned)g(in)g(the)i(GTI)120 +3466 y(extension)h(in)f(the)i(same)g(input)d(\014le,)i(and)g(also)h +(uses)f(the)g Fc(regfilter)e Fg(function)i(to)h(test)g(if)f(the)g(p)s +(osition)120 3579 y(asso)s(ciated)i(with)d(eac)m(h)j(ro)m(w)g(\(deriv)m +(ed)e(b)m(y)h(default)f(from)h(the)g(v)-5 b(alues)29 +b(in)g(the)h(X)h(and)e(Y)h(columns)f(of)h(the)120 3692 +y(ev)m(en)m(ts)38 b(table\))e(is)g(lo)s(cated)h(within)c(the)k(area)g +(de\014ned)e(in)h(the)g Fc(pow.reg)f Fg(text)i(region)f(\014le)f +(\(whic)m(h)h(w)m(as)120 3804 y(previously)g(created)k(with)e(the)g +Fc(fv/POW)f Fg(image)i(displa)m(y)e(program\).)66 b(Only)37 +b(the)i(ro)m(ws)f(whic)m(h)g(satisfy)120 3917 y(b)s(oth)30 +b(tests)h(are)g(copied)e(to)i(the)g(output)f(table.)120 +4102 y Fc(fitscopy)46 b('r.fit[evt][PI<50]')c(stdout)k(|)i(fitscopy)d +(stdin[evt][col)f(X,Y])j(out.fit)261 4287 y Fg(In)25 +b(this)f(somewhat)i(con)m(v)m(oluted)f(example,)i(\014tscop)m(y)e(is)g +(used)f(to)i(\014rst)f(select)h(the)f(ro)m(ws)g(from)g(the)h(evt)120 +4400 y(extension)j(whic)m(h)g(ha)m(v)m(e)i(PI)e(less)g(than)h(50)g(and) +f(write)g(the)h(resulting)e(table)i(out)g(to)g(the)g(stdout)g(stream.) +120 4513 y(This)36 b(is)g(pip)s(ed)f(to)j(a)g(2nd)f(instance)g(of)h +(\014tscop)m(y)g(\(with)e(the)i(Unix)e(`)p Fa(j)p Fg(')i(pip)s(e)e +(command\))h(whic)m(h)g(reads)120 4626 y(that)31 b(\014ltered)f(FITS)f +(\014le)h(from)g(the)h(stdin)e(stream)i(and)f(copies)g(only)g(the)h(X)f +(and)g(Y)h(columns)e(from)h(the)120 4739 y(evt)h(table)f(to)h(the)g +(output)f(\014le.)120 4924 y Fc(fitscopy)46 b('r.fit[evt][col)d +(RAD=sqrt\(\(X-#XCEN\)**2+\(Y-)o(#YCE)o(N\)*)o(*2\)])o([rad)o(<10)o +(0]')e(out.fit)261 5109 y Fg(This)23 b(example)i(\014rst)f(creates)i(a) +f(new)f(column)g(called)g(RAD)h(whic)m(h)e(giv)m(es)i(the)g(distance)g +(b)s(et)m(w)m(een)g(the)120 5222 y(X,Y)k(co)s(ordinate)f(of)g(eac)m(h)i +(ev)m(en)m(t)g(and)d(the)i(co)s(ordinate)f(de\014ned)f(b)m(y)h(the)h(X) +m(CEN)f(and)g(YCEN)g(k)m(eyw)m(ords)120 5334 y(in)j(the)i(header.)47 +b(Then,)32 b(only)g(those)h(ro)m(ws)g(whic)m(h)e(ha)m(v)m(e)j(a)f +(distance)f(less)g(than)g(100)i(are)f(copied)f(to)h(the)120 +5447 y(output)e(table.)45 b(In)31 b(other)h(w)m(ords,)f(only)g(the)h +(ev)m(en)m(ts)h(whic)m(h)e(are)h(lo)s(cated)g(within)d(100)k(pixel)d +(units)g(from)120 5560 y(the)h(\(X)m(CEN,)g(YCEN\))f(co)s(ordinate)h +(are)f(copied)g(to)h(the)g(output)f(table.)1905 5809 +y(36)p eop +%%Page: 37 37 +37 36 bop 120 573 a Fc(fitscopy)46 b('ftp://heasarc.gsfc.nas)o(a.g)o +(ov/r)o(osat)o(.fi)o(t[ev)o(ents)o(][b)o(in)c(\(X,Y\)=16]')j(img.fit) +261 785 y Fg(This)22 b(example)h(bins)e(the)i(X)h(and)f(Y)g(columns)f +(of)h(the)h(h)m(yp)s(othetical)e(R)m(OSA)-8 b(T)24 b(\014le)e(at)i(the) +f(HEASAR)m(C)120 898 y(ftp)30 b(site)g(to)h(create)h(the)f(output)f +(image.)120 1111 y Fc(fitscopy)46 b('raw.fit[i512,512][101:)o(110)o +(,51:)o(60]')41 b(image.fit)261 1323 y Fg(This)28 b(example)h(con)m(v)m +(erts)i(the)e(512)i(x)e(512)i(pixel)d(ra)m(w)h(binary)f(16-bit)h(in)m +(teger)h(image)g(to)g(a)g(FITS)e(\014le)120 1436 y(and)i(copies)g(a)h +(10)g(x)f(10)h(pixel)e(subimage)h(from)g(it)f(to)j(the)e(output)g(FITS) +g(image.)1905 5809 y(37)p eop +%%Page: 38 38 +38 37 bop 120 573 a Fi(6)135 b(CFITSIO)44 b(Error)h(Status)g(Co)t(des) +120 776 y Fg(The)34 b(follo)m(wing)e(table)i(lists)f(all)g(the)h(error) +g(status)g(co)s(des)h(used)e(b)m(y)h(CFITSIO.)f(Programmers)h(are)g +(en-)120 889 y(couraged)f(to)g(use)g(the)f(sym)m(b)s(olic)f(mnemonics)h +(\(de\014ned)f(in)g(the)i(\014le)f(\014tsio.h\))g(rather)g(than)g(the)h +(actual)120 1002 y(in)m(teger)e(status)f(v)-5 b(alues)30 +b(to)h(impro)m(v)m(e)f(the)h(readabilit)m(y)e(of)h(their)g(co)s(de.)168 +1214 y Fc(Symbolic)45 b(Const)190 b(Value)237 b(Meaning)168 +1327 y(--------------)187 b(-----)94 b(------------------------)o(----) +o(---)o(----)o(----)o(--)1122 1440 y(0)191 b(OK,)47 b(no)g(error)168 +1553 y(SAME_FILE)427 b(101)190 b(input)46 b(and)h(output)f(files)h(are) +g(the)f(same)168 1666 y(TOO_MANY_FILES)187 b(103)j(tried)46 +b(to)h(open)g(too)g(many)g(FITS)f(files)h(at)g(once)168 +1779 y(FILE_NOT_OPENED)139 b(104)190 b(could)46 b(not)h(open)g(the)g +(named)f(file)168 1892 y(FILE_NOT_CREATED)91 b(105)190 +b(could)46 b(not)h(create)f(the)h(named)g(file)168 2005 +y(WRITE_ERROR)331 b(106)190 b(error)46 b(writing)g(to)h(FITS)g(file)168 +2117 y(END_OF_FILE)331 b(107)190 b(tried)46 b(to)h(move)g(past)g(end)g +(of)g(file)168 2230 y(READ_ERROR)379 b(108)190 b(error)46 +b(reading)g(from)h(FITS)f(file)168 2343 y(FILE_NOT_CLOSED)139 +b(110)190 b(could)46 b(not)h(close)g(the)f(file)168 2456 +y(ARRAY_TOO_BIG)235 b(111)190 b(array)46 b(dimensions)f(exceed)h +(internal)g(limit)168 2569 y(READONLY_FILE)235 b(112)190 +b(Cannot)46 b(write)g(to)i(readonly)d(file)168 2682 y +(MEMORY_ALLOCATION)e(113)190 b(Could)46 b(not)h(allocate)f(memory)168 +2795 y(BAD_FILEPTR)331 b(114)190 b(invalid)46 b(fitsfile)f(pointer)168 +2908 y(NULL_INPUT_PTR)187 b(115)j(NULL)47 b(input)f(pointer)g(to)h +(routine)168 3021 y(SEEK_ERROR)379 b(116)190 b(error)46 +b(seeking)g(position)g(in)h(file)168 3247 y(BAD_URL_PREFIX)235 +b(121)142 b(invalid)46 b(URL)h(prefix)f(on)h(file)g(name)168 +3359 y(TOO_MANY_DRIVERS)139 b(122)j(tried)46 b(to)h(register)f(too)h +(many)g(IO)g(drivers)168 3472 y(DRIVER_INIT_FAILED)c(123)142 +b(driver)46 b(initialization)e(failed)168 3585 y(NO_MATCHING_DRIVER)f +(124)142 b(matching)45 b(driver)i(is)g(not)g(registered)168 +3698 y(URL_PARSE_ERROR)187 b(125)142 b(failed)46 b(to)h(parse)g(input)f +(file)h(URL)168 3924 y(SHARED_BADARG)235 b(151)190 b(bad)47 +b(argument)e(in)j(shared)e(memory)g(driver)168 4037 y(SHARED_NULPTR)235 +b(152)190 b(null)47 b(pointer)e(passed)h(as)i(an)f(argument)168 +4150 y(SHARED_TABFULL)187 b(153)j(no)47 b(more)g(free)f(shared)g +(memory)h(handles)168 4263 y(SHARED_NOTINIT)187 b(154)j(shared)46 +b(memory)g(driver)g(is)h(not)g(initialized)168 4376 y(SHARED_IPCERR)235 +b(155)190 b(IPC)47 b(error)f(returned)g(by)h(a)g(system)f(call)168 +4489 y(SHARED_NOMEM)283 b(156)190 b(no)47 b(memory)f(in)h(shared)f +(memory)h(driver)168 4601 y(SHARED_AGAIN)283 b(157)190 +b(resource)45 b(deadlock)h(would)g(occur)168 4714 y(SHARED_NOFILE)235 +b(158)190 b(attempt)46 b(to)h(open/create)e(lock)h(file)h(failed)168 +4827 y(SHARED_NORESIZE)139 b(159)190 b(shared)46 b(memory)g(block)g +(cannot)h(be)g(resized)f(at)h(the)g(moment)168 5053 y(HEADER_NOT_EMPTY) +91 b(201)190 b(header)46 b(already)g(contains)f(keywords)168 +5166 y(KEY_NO_EXIST)283 b(202)190 b(keyword)46 b(not)h(found)f(in)h +(header)168 5279 y(KEY_OUT_BOUNDS)187 b(203)j(keyword)46 +b(record)g(number)g(is)h(out)g(of)g(bounds)168 5392 y(VALUE_UNDEFINED) +139 b(204)190 b(keyword)46 b(value)g(field)g(is)i(blank)168 +5505 y(NO_QUOTE)475 b(205)190 b(string)46 b(is)h(missing)f(the)h +(closing)f(quote)1905 5809 y Fg(38)p eop +%%Page: 39 39 +39 38 bop 168 573 a Fc(BAD_KEYCHAR)331 b(207)190 b(illegal)46 +b(character)f(in)i(keyword)f(name)h(or)g(card)168 686 +y(BAD_ORDER)427 b(208)190 b(required)45 b(keywords)h(out)h(of)g(order) +168 799 y(NOT_POS_INT)331 b(209)190 b(keyword)46 b(value)g(is)h(not)g +(a)h(positive)d(integer)168 912 y(NO_END)571 b(210)190 +b(couldn't)45 b(find)i(END)g(keyword)168 1024 y(BAD_BITPIX)379 +b(211)190 b(illegal)46 b(BITPIX)g(keyword)g(value)168 +1137 y(BAD_NAXIS)427 b(212)190 b(illegal)46 b(NAXIS)g(keyword)g(value) +168 1250 y(BAD_NAXES)427 b(213)190 b(illegal)46 b(NAXISn)g(keyword)g +(value)168 1363 y(BAD_PCOUNT)379 b(214)190 b(illegal)46 +b(PCOUNT)g(keyword)g(value)168 1476 y(BAD_GCOUNT)379 +b(215)190 b(illegal)46 b(GCOUNT)g(keyword)g(value)168 +1589 y(BAD_TFIELDS)331 b(216)190 b(illegal)46 b(TFIELDS)g(keyword)f +(value)168 1702 y(NEG_WIDTH)427 b(217)190 b(negative)45 +b(table)i(row)g(size)168 1815 y(NEG_ROWS)475 b(218)190 +b(negative)45 b(number)i(of)g(rows)f(in)i(table)168 1928 +y(COL_NOT_FOUND)235 b(219)190 b(column)46 b(with)h(this)f(name)h(not)g +(found)f(in)h(table)168 2041 y(BAD_SIMPLE)379 b(220)190 +b(illegal)46 b(value)g(of)h(SIMPLE)f(keyword)168 2154 +y(NO_SIMPLE)427 b(221)190 b(Primary)46 b(array)g(doesn't)g(start)g +(with)h(SIMPLE)168 2267 y(NO_BITPIX)427 b(222)190 b(Second)46 +b(keyword)g(not)h(BITPIX)168 2379 y(NO_NAXIS)475 b(223)190 +b(Third)46 b(keyword)g(not)h(NAXIS)168 2492 y(NO_NAXES)475 +b(224)190 b(Couldn't)45 b(find)i(all)g(the)g(NAXISn)f(keywords)168 +2605 y(NO_XTENSION)331 b(225)190 b(HDU)47 b(doesn't)f(start)g(with)h +(XTENSION)e(keyword)168 2718 y(NOT_ATABLE)379 b(226)190 +b(the)47 b(CHDU)f(is)i(not)f(an)g(ASCII)f(table)g(extension)168 +2831 y(NOT_BTABLE)379 b(227)190 b(the)47 b(CHDU)f(is)i(not)f(a)g +(binary)f(table)g(extension)168 2944 y(NO_PCOUNT)427 +b(228)190 b(couldn't)45 b(find)i(PCOUNT)f(keyword)168 +3057 y(NO_GCOUNT)427 b(229)190 b(couldn't)45 b(find)i(GCOUNT)f(keyword) +168 3170 y(NO_TFIELDS)379 b(230)190 b(couldn't)45 b(find)i(TFIELDS)f +(keyword)168 3283 y(NO_TBCOL)475 b(231)190 b(couldn't)45 +b(find)i(TBCOLn)f(keyword)168 3396 y(NO_TFORM)475 b(232)190 +b(couldn't)45 b(find)i(TFORMn)f(keyword)168 3509 y(NOT_IMAGE)427 +b(233)190 b(the)47 b(CHDU)f(is)i(not)f(an)g(IMAGE)f(extension)168 +3621 y(BAD_TBCOL)427 b(234)190 b(TBCOLn)46 b(keyword)g(value)g(<)i(0)f +(or)g(>)h(rowlength)168 3734 y(NOT_TABLE)427 b(235)190 +b(the)47 b(CHDU)f(is)i(not)f(a)g(table)168 3847 y(COL_TOO_WIDE)283 +b(236)190 b(column)46 b(is)h(too)g(wide)g(to)g(fit)g(in)g(table)168 +3960 y(COL_NOT_UNIQUE)187 b(237)j(more)47 b(than)f(1)i(column)e(name)g +(matches)g(template)168 4073 y(BAD_ROW_WIDTH)235 b(241)190 +b(sum)47 b(of)g(column)f(widths)g(not)h(=)h(NAXIS1)168 +4186 y(UNKNOWN_EXT)331 b(251)190 b(unrecognizable)44 +b(FITS)i(extension)g(type)168 4299 y(UNKNOWN_REC)331 +b(252)190 b(unknown)46 b(record;)g(1st)g(keyword)g(not)h(SIMPLE)f(or)h +(XTENSION)168 4412 y(END_JUNK)475 b(253)190 b(END)47 +b(keyword)f(is)h(not)g(blank)168 4525 y(BAD_HEADER_FILL)139 +b(254)190 b(Header)46 b(fill)h(area)f(contains)g(non-blank)f(chars)168 +4638 y(BAD_DATA_FILL)235 b(255)190 b(Illegal)46 b(data)g(fill)h(bytes)f +(\(not)h(zero)g(or)g(blank\))168 4751 y(BAD_TFORM)427 +b(261)190 b(illegal)46 b(TFORM)g(format)g(code)168 4863 +y(BAD_TFORM_DTYPE)139 b(262)190 b(unrecognizable)44 b(TFORM)i(datatype) +g(code)168 4976 y(BAD_TDIM)475 b(263)190 b(illegal)46 +b(TDIMn)g(keyword)g(value)168 5089 y(BAD_HEAP_PTR)283 +b(264)190 b(invalid)46 b(BINTABLE)f(heap)i(pointer)f(is)h(out)g(of)g +(range)168 5315 y(BAD_HDU_NUM)331 b(301)190 b(HDU)47 +b(number)f(<)h(1)h(or)f(>)g(MAXHDU)168 5428 y(BAD_COL_NUM)331 +b(302)190 b(column)46 b(number)g(<)i(1)f(or)g(>)h(tfields)168 +5541 y(NEG_FILE_POS)283 b(304)190 b(tried)46 b(to)h(move)g(to)g +(negative)f(byte)g(location)g(in)h(file)1905 5809 y Fg(39)p +eop +%%Page: 40 40 +40 39 bop 168 573 a Fc(NEG_BYTES)427 b(306)190 b(tried)46 +b(to)h(read)g(or)g(write)g(negative)e(number)h(of)h(bytes)168 +686 y(BAD_ROW_NUM)331 b(307)190 b(illegal)46 b(starting)f(row)i(number) +f(in)h(table)168 799 y(BAD_ELEM_NUM)283 b(308)190 b(illegal)46 +b(starting)f(element)h(number)g(in)h(vector)168 912 y(NOT_ASCII_COL)235 +b(309)190 b(this)47 b(is)g(not)g(an)g(ASCII)f(string)g(column)168 +1024 y(NOT_LOGICAL_COL)139 b(310)190 b(this)47 b(is)g(not)g(a)g +(logical)f(datatype)f(column)168 1137 y(BAD_ATABLE_FORMAT)e(311)190 +b(ASCII)46 b(table)h(column)f(has)h(wrong)f(format)168 +1250 y(BAD_BTABLE_FORMAT)d(312)190 b(Binary)46 b(table)g(column)g(has)h +(wrong)g(format)168 1363 y(NO_NULL)523 b(314)190 b(null)47 +b(value)f(has)h(not)g(been)f(defined)168 1476 y(NOT_VARI_LEN)283 +b(317)190 b(this)47 b(is)g(not)g(a)g(variable)f(length)g(column)168 +1589 y(BAD_DIMEN)427 b(320)190 b(illegal)46 b(number)g(of)h(dimensions) +e(in)i(array)168 1702 y(BAD_PIX_NUM)331 b(321)190 b(first)46 +b(pixel)h(number)f(greater)g(than)g(last)h(pixel)168 +1815 y(ZERO_SCALE)379 b(322)190 b(illegal)46 b(BSCALE)g(or)h(TSCALn)f +(keyword)g(=)h(0)168 1928 y(NEG_AXIS)475 b(323)190 b(illegal)46 +b(axis)g(length)g(<)i(1)168 2154 y(NOT_GROUP_TABLE)330 +b(340)142 b(Grouping)46 b(function)f(error)168 2267 y +(HDU_ALREADY_MEMBER)186 b(341)168 2379 y(MEMBER_NOT_FOUND)282 +b(342)168 2492 y(GROUP_NOT_FOUND)330 b(343)168 2605 y(BAD_GROUP_ID)474 +b(344)168 2718 y(TOO_MANY_HDUS_TRACKED)42 b(345)168 2831 +y(HDU_ALREADY_TRACKED)138 b(346)168 2944 y(BAD_OPTION)570 +b(347)168 3057 y(IDENTICAL_POINTERS)186 b(348)168 3170 +y(BAD_GROUP_ATTACH)282 b(349)168 3283 y(BAD_GROUP_DETACH)g(350)168 +3509 y(NGP_NO_MEMORY)426 b(360)238 b(malloc)46 b(failed)168 +3621 y(NGP_READ_ERR)474 b(361)238 b(read)46 b(error)h(from)f(file)168 +3734 y(NGP_NUL_PTR)522 b(362)238 b(null)46 b(pointer)g(passed)g(as)h +(an)g(argument.)1695 3847 y(Passing)f(null)g(pointer)g(as)h(a)h(name)f +(of)1695 3960 y(template)f(file)g(raises)g(this)h(error)168 +4073 y(NGP_EMPTY_CURLINE)234 b(363)k(line)46 b(read)h(seems)f(to)h(be)h +(empty)e(\(used)1695 4186 y(internally\))168 4299 y +(NGP_UNREAD_QUEUE_FULL)c(364)238 b(cannot)46 b(unread)g(more)g(then)h +(1)g(line)g(\(or)g(single)1695 4412 y(line)g(twice\))168 +4525 y(NGP_INC_NESTING)330 b(365)238 b(too)46 b(deep)h(include)f(file)h +(nesting)e(\(infinite)1695 4638 y(loop,)h(template)g(includes)f(itself) +i(?\))168 4751 y(NGP_ERR_FOPEN)426 b(366)238 b(fopen\(\))45 +b(failed,)h(cannot)g(open)h(template)e(file)168 4863 +y(NGP_EOF)714 b(367)238 b(end)46 b(of)i(file)e(encountered)f(and)i(not) +g(expected)168 4976 y(NGP_BAD_ARG)522 b(368)238 b(bad)46 +b(arguments)g(passed.)g(Usually)f(means)1695 5089 y(internal)h(parser)g +(error.)g(Should)g(not)h(happen)168 5202 y(NGP_TOKEN_NOT_EXPECT)90 +b(369)238 b(token)46 b(not)h(expected)e(here)168 5428 +y(BAD_I2C)523 b(401)190 b(bad)47 b(int)g(to)g(formatted)e(string)h +(conversion)168 5541 y(BAD_F2C)523 b(402)190 b(bad)47 +b(float)f(to)h(formatted)f(string)g(conversion)1905 5809 +y Fg(40)p eop +%%Page: 41 41 +41 40 bop 168 573 a Fc(BAD_INTKEY)379 b(403)190 b(can't)46 +b(interpret)g(keyword)f(value)i(as)g(integer)168 686 +y(BAD_LOGICALKEY)187 b(404)j(can't)46 b(interpret)g(keyword)f(value)i +(as)g(logical)168 799 y(BAD_FLOATKEY)283 b(405)190 b(can't)46 +b(interpret)g(keyword)f(value)i(as)g(float)168 912 y(BAD_DOUBLEKEY)235 +b(406)190 b(can't)46 b(interpret)g(keyword)f(value)i(as)g(double)168 +1024 y(BAD_C2I)523 b(407)190 b(bad)47 b(formatted)e(string)h(to)h(int)g +(conversion)168 1137 y(BAD_C2F)523 b(408)190 b(bad)47 +b(formatted)e(string)h(to)h(float)g(conversion)168 1250 +y(BAD_C2D)523 b(409)190 b(bad)47 b(formatted)e(string)h(to)h(double)f +(conversion)168 1363 y(BAD_DATATYPE)283 b(410)190 b(illegal)46 +b(datatype)f(code)i(value)168 1476 y(BAD_DECIM)427 b(411)190 +b(bad)47 b(number)f(of)h(decimal)f(places)g(specified)168 +1589 y(NUM_OVERFLOW)283 b(412)190 b(overflow)45 b(during)i(datatype)e +(conversion)168 1702 y(DATA_COMPRESSION_ERR)137 b(413)95 +b(error)46 b(compressing)f(image)168 1815 y(DATA_DECOMPRESSION_ERR)c +(414)95 b(error)46 b(uncompressing)f(image)168 2041 y(BAD_DATE)475 +b(420)190 b(error)46 b(in)h(date)g(or)g(time)g(conversion)168 +2267 y(PARSE_SYNTAX_ERR)91 b(431)190 b(syntax)46 b(error)g(in)i(parser) +e(expression)168 2379 y(PARSE_BAD_TYPE)187 b(432)j(expression)45 +b(did)i(not)g(evaluate)e(to)i(desired)f(type)168 2492 +y(PARSE_LRG_VECTOR)91 b(433)190 b(vector)46 b(result)g(too)h(large)f +(to)i(return)e(in)h(array)168 2605 y(PARSE_NO_OUTPUT)139 +b(434)190 b(data)47 b(parser)f(failed)g(not)h(sent)f(an)h(out)g(column) +168 2718 y(PARSE_BAD_COL)235 b(435)190 b(bad)47 b(data)f(encounter)g +(while)g(parsing)g(column)168 2831 y(PARSE_BAD_OUTPUT)91 +b(436)190 b(Output)46 b(file)h(not)g(of)g(proper)f(type)168 +3057 y(ANGLE_TOO_BIG)235 b(501)190 b(celestial)45 b(angle)i(too)f +(large)h(for)g(projection)168 3170 y(BAD_WCS_VAL)331 +b(502)190 b(bad)47 b(celestial)e(coordinate)g(or)i(pixel)g(value)168 +3283 y(WCS_ERROR)427 b(503)190 b(error)46 b(in)h(celestial)f +(coordinate)f(calculation)168 3396 y(BAD_WCS_PROJ)283 +b(504)190 b(unsupported)45 b(type)h(of)h(celestial)f(projection)168 +3509 y(NO_WCS_KEY)379 b(505)190 b(celestial)45 b(coordinate)g(keywords) +h(not)h(found)168 3621 y(APPROX_WCS_KEY)187 b(506)j(approximate)45 +b(wcs)i(keyword)e(values)h(were)h(returned)1905 5809 +y Fg(41)p eop +%%Trailer +end +userdict /end-hook known{end-hook}if +%%EOF diff --git a/pkg/tbtables/cfitsio/quick.tex b/pkg/tbtables/cfitsio/quick.tex new file mode 100644 index 00000000..28bd97ce --- /dev/null +++ b/pkg/tbtables/cfitsio/quick.tex @@ -0,0 +1,2156 @@ +\documentclass[11pt]{article} +\input{html.sty} +\htmladdtonavigation + {\begin{rawhtml} + FITSIO Home + \end{rawhtml}} + +\oddsidemargin=0.20in +\evensidemargin=0.20in +\textwidth=15.5truecm +\textheight=21.5truecm + +\title{CFITSIO Quick Start Guide} +\author{William Pence \thanks{HEASARC, NASA Goddard Space Flight Center, +{\it William.D.Pence@nasa.gov}}} + +\date{January 2003} + +\begin{document} + +\maketitle +\tableofcontents + +% =================================================================== +\section{Introduction} + +This document is intended to help you quickly start writing C programs +to read and write FITS files using the CFITSIO library. It covers the +most important CFITSIO routines that are needed to perform most types +of operations on FITS files. For more complete information about these +and all the other available routines in the library please refer to +the ``CFITSIO User's Reference Guide'', which is available from the +CFITSIO Web site at {\tt http://heasarc.gsfc.nasa.gov/fitsio}. + +For more general information about the FITS data format, refer to the +following web page: +http://heasarc.gsfc.nasa.gov/docs/heasarc/fits.html + +FITS stands for Flexible Image Transport System and is the standard +file format used to store most astronomical data files. There are 2 +basic types of FITS files: images and tables. FITS images often +contain a 2-dimensional array of pixels representing an image of a +piece of the sky, but FITS images can also contain 1-D arrays (i.e, +a spectrum or light curve), or 3-D arrays (a data cube), or +even higher dimensional arrays of data. An image may also have zero +dimensions, in which case it is referred to as a null or empty array. +The supported datatypes for the image arrays are 8, 16, and 32-bit +integers, and 32 and 64-bit floating point real numbers. Both signed +and unsigned integers are supported. + +FITS tables contain rows and columns of data, similar to a +spreadsheet. All the values in a particular column must have the same +datatype. A cell of a column is not restricted to a single number, and +instead can contain an array or vector of numbers. There are actually +2 subtypes of FITS tables: ASCII and binary. As the names imply, ASCII +tables store the data values in an ASCII representation whereas binary +tables store the data values in a more efficient machine-readable +binary format. Binary tables are generally more compact and support +more features (e.g., a wider range of datatypes, and vector columns) +than ASCII tables. + +A single FITS file many contain multiple images or tables. Each table +or image is called a Header-Data Unit, or HDU. The first HDU in a FITS +file must be an image (but it may have zero axes) and is called the +Primary Array. Any additional HDUs in the file (which are also +referred to as `extensions') may contain either an image or a table. + +Every HDU contains a header containing keyword records. Each keyword +record is 80 ASCII characters long and has the following format: + +\begin{verbatim} +KEYWORD = value / comment string +\end{verbatim} + +The keyword name can be up to 8 characters long (all uppercase). The +value can be either an integer or floating point number, a logical +value (T or F), or a character string enclosed in single quotes. Each +header begins with a series of required keywords to describe the +datatype and format of the following data unit, if any. Any number of +other optional keywords can be included in the header to provide other +descriptive information about the data. For the most part, the CFITSIO +routines automatically write the required FITS keywords for each HDU, +so you, the programmer, usually do not need to worry about them. + +% =================================================================== +\section{Installing and Using CFITSIO} + +First, you should download the CFITSIO software and the set of example +FITS utility programs from the web site at +http://heasarc.gsfc.nasa.gov/fitsio. The example programs illustrate +how to perform many common types of operations on FITS files using +CFITSIO. They are also useful when writing a new program because it is +often easier to take a copy of one of these utility programs as a +template and then modify it for your own purposes, rather than writing +the new program completely from scratch. + +To build the CFITSIO library on Unix platforms, `untar' the source code +distribution file and then execute the following commands in the +directory containing the source code: + +\begin{verbatim} +> ./configure [--prefix=/target/installation/path] +> make (or 'make shared') +> make install (this step is optional) +\end{verbatim} + +The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, + +\begin{verbatim} +> ./configure --prefix=/usr1/local +\end{verbatim} + +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include files to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +Pre-compiled versions of the CFITSIO DLL library are available for +PCs. On Macintosh machines, refer to the README.MacOS file for +instructions on building CFITSIO using CodeWarrior. + +Any programs that use CFITSIO must of course be linked with the CFITSIO +library when creating the executable file. The exact procedure for +linking a program depends on your software environment, but on Unix +platforms, the command line to compile and link a program will look +something like this: + +\begin{verbatim} +gcc -o myprog myprog.c -L. -lcfitsio -lm -lnsl -lsocket +\end{verbatim} + +You may not need to include all of the 'm', 'nsl', and 'socket' system +libraries on your particular machine. To find out what libraries are +required on your (Unix) system, type {\tt'make testprog'} and see what +libraries are then included on the resulting link line. + +\newpage +% =================================================================== +\section{Example Programs} + +Before describing the individual CFITSIO routines in detail, it is +instructive to first look at an actual program. The names of the +CFITSIO routines are fairly descriptive (they all begin with {\tt +fits\_}, so it should be reasonably clear what this program does: + +\begin{verbatim} +---------------------------------------------------------------- + #include + #include +1: #include "fitsio.h" + + int main(int argc, char *argv[]) + { +2: fitsfile *fptr; + char card[FLEN_CARD]; +3: int status = 0, nkeys, ii; /* MUST initialize status */ + +4: fits_open_file(&fptr, argv[1], READONLY, &status); + fits_get_hdrspace(fptr, &nkeys, NULL, &status); + + for (ii = 1; ii <= nkeys; ii++) { + fits_read_record(fptr, ii, card, &status); /* read keyword */ + printf("%s\n", card); + } + printf("END\n\n"); /* terminate listing with END */ + fits_close_file(fptr, &status); + + if (status) /* print any error messages */ +5: fits_report_error(stderr, status); + return(status); + } +---------------------------------------------------------------- +\end{verbatim} + +This program opens the specified FITS file and prints +out all the header keywords in the current HDU. +Some other points to notice about the program are: +\begin{enumerate} + +\item +The {\tt fitsio.h} header file must be included to define the +various routines and symbols used in CFITSIO. + +\item + +The {\tt fitsfile} parameter is the first argument in almost every +CFITSIO routine. It is a pointer to a structure (defined in {\tt +fitsio.h}) that stores information about the particular FITS file that +the routine will operate on. Memory for this structure is +automatically allocated when the file is first opened or created, and +is freed when the file is closed. + +\item +Almost every CFITSIO routine has a {\tt status} parameter as the last +argument. The status value is also usually returned as the value of the +function itself. Normally status = 0, and a positive status value +indicates an error of some sort. The status variable must always be +initialized to zero before use, because if status is greater than zero +on input then the CFITSIO routines will simply return without doing +anything. This `inherited status' feature, where each CFITSIO routine +inherits the status from the previous routine, makes it unnecessary to +check the status value after every single CFITSIO routine call. +Generally you should check the status after an especially important or +complicated routine has been called, or after a block of +closely related CFITSIO calls. This example program has taken this +feature to the extreme and only checks the status value at the +very end of the program. + +\item + +In this example program the file name to be opened is given as an +argument on the command line ({\tt arg[1]}). If the file contains more +than 1 HDU or extension, you can specify which particular HDU to be +opened by enclosing the name or number of the HDU in square brackets +following the root name of the file. For example, {\tt file.fts[0]} +opens the primary array, while {\tt file.fts[2]} will move to and open +the 2nd extension in the file, and {\tt file.fit[EVENTS]} will open the +extension that has a {\tt EXTNAME = 'EVENTS'} keyword in the header. +Note that on the Unix command line you must enclose the file name in +single or double quote characters if the name contains special +characters such as `[' or `]'. + +All of the CFITSIO routines which read or write header keywords, +image data, or table data operate only within the currently opened +HDU in the file. To read or write information in a different HDU you must +first explicitly move to that HDU (see the {\tt fits\_movabs\_hdu} and +{\tt fits\_movrel\_hdu} routines in section 4.3). + +\item + +The {\tt fits\_report\_error} routine provides a convenient way to print out +diagnostic messages about any error that may have occurred. + +\end{enumerate} + +A set of example FITS utility programs are available from the CFITSIO +web site at \newline +http://heasarc.gsfc.nasa.gov/docs/software/fitsio/cexamples.html. +These are real working programs which illustrate how to read, write, +and modify FITS files using the CFITSIO library. Most of these +programs are very short, containing only a few 10s of lines of +executable code or less, yet they perform quite useful operations on +FITS files. Running each program without any command line arguments +will produce a short description of how to use the program. +The currently available programs are: +\begin{quote} +fitscopy - copy a file +\newline +listhead - list header keywords +\newline +liststruc - show the structure of a FITS file. +\newline +modhead - write or modify a header keyword +\newline +imarith - add, subtract, multiply, or divide 2 images +\newline +imlist - list pixel values in an image +\newline +imstat - compute mean, min, and max pixel values in an image +\newline +tablist - display the contents of a FITS table +\newline +tabcalc - general table calculator +\end{quote} + +\newpage + +% =================================================================== +\section{CFITSIO Routines} + +This chapter describes the main CFITSIO routines that can be used to +perform the most common types of operations on FITS files. + +% =================================================================== +{\bf \subsection{Error Reporting}} + +\begin{verbatim} +void fits_report_error(FILE *stream, int status) +void fits_get_errstatus(int status, char *err_text) +float fits_get_version(float *version) +\end{verbatim} + +The first routine prints out information about any error that +has occurred. Whenever any CFITSIO routine encounters an error it +usually writes a message describing the nature of the error to an +internal error message stack and then returns with a positive integer +status value. Passing the error status value to this routine will +cause a generic description of the error and all the messages +from the internal CFITSIO error stack to be printed to the specified +stream. The {\tt stream} parameter is usually set equal to +{\tt "stdout"} or {\tt "stderr"}. + +The second routine simply returns a 30-character descriptive +error message corresponding to the input status value. + +The last routine returns the current CFITSIO library version number. + +% =================================================================== +{\bf \subsection{File Open/Close Routines}} + +\begin{verbatim} +int fits_open_file( fitsfile **fptr, char *filename, int mode, int *status) +int fits_open_data( fitsfile **fptr, char *filename, int mode, int *status) +int fits_open_table(fitsfile **fptr, char *filename, int mode, int *status) +int fits_open_image(fitsfile **fptr, char *filename, int mode, int *status) + +int fits_create_file(fitsfile **fptr, char *filename, int *status) +int fits_close_file(fitsfile *fptr, int *status) +\end{verbatim} + +These routines open or close a file. The first {\tt fitsfile} +parameter in these and nearly every other CFITSIO routine is a pointer +to a structure that CFITSIO uses to store relevant parameters about +each opened file. You should never directly read or write any +information in this structure. Memory for this structure is allocated +automatically when the file is opened or created, and is freed when the +file is closed. + +The {\tt mode} parameter in the {\tt fits\_open\_xxxx} set of routines +can be set to either {\tt READONLY} or {\tt READWRITE} to select the +type of file access that will be allowed. These symbolic constants are +defined in {\tt fitsio.h}. + +The {\tt fits\_open\_file} routine opens the file and positions the internal +file pointer to the beginning of the file, or to the specified +extension if an extension name or number is appended to the file name +(see the later section on ``CFITSIO File Names and Filters'' for a +description of the syntax). {\tt fits\_open\_data} behaves similarly except +that it will move to the first HDU containing significant data if a HDU +name or number to open is not explicitly specified as part of the +filename. It will move to the first IMAGE HDU with NAXIS greater than +0, or the first table that does not contain the strings `GTI' (a Good +Time Interval extension) or `OBSTABLE' in the EXTNAME keyword value. +The {\tt fits\_open\_table} and {\tt fits\_open\_image} routines are similar +except that they will move to the first significant table HDU or image +HDU, respectively if a HDU name of number is not specified as part of +the input file name. + +When opening an existing file, the {\tt filename} can include optional +arguments, enclosed in square brackets that specify filtering +operations that should be applied to the input file. For example, +\begin{verbatim} + myfile.fit[EVENTS][counts > 0] +\end{verbatim} +opens the table in the EVENTS extension and creates a virtual table by +selecting only those rows where the COUNTS column value is greater than +0. See section 5 for more examples of these powerful filtering +capabilities. + +In {\tt fits\_create\_file}, the {\tt filename} is simply the root name of +the file to be created. You can overwrite an existing file by +prefixing the name with a `!' character (on the Unix command line this +must be prefixed with a backslash, as in \verb+`\!file.fit'+). +If the file name ends with {\tt .gz} the file will be compressed +using the gzip algorithm. If the +filename is {\tt stdout} or {\tt "-"} (a single dash character) +then the output file will be piped to the stdout stream. You can +chain several tasks together by writing the output from the first task +to {\tt stdout} and then reading the input file in the 2nd task from +{\tt stdin} or {\tt "-"}. + + +% =================================================================== +{\bf \subsection{HDU-level Routines}} + +The routines listed in this section operate on Header-Data Units (HDUs) in a file. + +\begin{verbatim} +_______________________________________________________________ +int fits_get_num_hdus(fitsfile *fptr, int *hdunum, int *status) +int fits_get_hdu_num(fitsfile *fptr, int *hdunum) +\end{verbatim} + +The first routines returns the total number of HDUs in the FITS file, +and the second routine returns the position of the currently opened HDU in +the FITS file (starting with 1, not 0). + +\begin{verbatim} +__________________________________________________________________________ +int fits_movabs_hdu(fitsfile *fptr, int hdunum, int *hdutype, int *status) +int fits_movrel_hdu(fitsfile *fptr, int nmove, int *hdutype, int *status) +int fits_movnam_hdu(fitsfile *fptr, int hdutype, char *extname, + int extver, int *status) +\end{verbatim} + +These routines enable you to move to a different HDU in the file. +Most of the CFITSIO functions which read or write keywords or data +operate only on the currently opened HDU in the file. The first +routine moves to the specified absolute HDU number in the FITS +file (the first HDU = 1), whereas the second routine moves a relative +number of HDUs forward or backward from the currently open HDU. The +{\tt hdutype} parameter returns the type of the newly opened HDU, and will +be equal to one of these symbolic constant values: {\tt IMAGE\_HDU, +ASCII\_TBL, or BINARY\_TBL}. {\tt hdutype} may be set to NULL +if it is not needed. The third routine moves to the (first) HDU +that matches the input extension type, name, and version number, +as given by the {\tt XTENSION, EXTNAME} (or {\tt HDUNAME}) and {\tt EXTVER} keywords. +If the input value of {\tt extver} = 0, then the version number will +be ignored when looking for a matching HDU. + +\begin{verbatim} +_________________________________________________________________ +int fits_get_hdu_type(fitsfile *fptr, int *hdutype, int *status) +\end{verbatim} + +Get the type of the current HDU in the FITS file: {\tt IMAGE\_HDU, +ASCII\_TBL, or BINARY\_TBL}. + +\begin{verbatim} +____________________________________________________________________ +int fits_copy_hdu(fitsfile *infptr, fitsfile *outfptr, int morekeys, + int *status) +int fits_copy_file(fitsfile *infptr, fitsfile *outfptr, int previous, + int current, int following, > int *status) +\end{verbatim} + +The first routine copies the current HDU from the FITS file associated +with infptr and appends it to the end of the FITS file associated with +outfptr. Space may be reserved for {\tt morekeys} additional keywords +in the output header. The second routine copies any HDUs previous +to the current HDU, and/or the current HDU, and/or any HDUs following the +current HDU, depending on the value (True or False) of {\tt previous, +current}, and {\tt following}, respectively. For example, +\begin{verbatim} + fits_copy_file(infptr, outfptr, 0, 1, 1, &status); +\end{verbatim} +will copy the current HDU and any HDUs that follow it from the input +to the output file, but it will not copy any HDUs preceding the +current HDU. + + +\newpage +% =================================================================== +\subsection{Image I/O Routines} + +This section lists the more important CFITSIO routines which operate on +FITS images. + +\begin{verbatim} +_______________________________________________________________ +int fits_get_img_type(fitsfile *fptr, int *bitpix, int *status) +int fits_get_img_dim( fitsfile *fptr, int *naxis, int *status) +int fits_get_img_size(fitsfile *fptr, int maxdim, long *naxes, + int *status) +int fits_get_img_param(fitsfile *fptr, int maxdim, int *bitpix, + int *naxis, long *naxes, int *status) +\end{verbatim} + +Get information about the currently opened image HDU. The first routine +returns the datatype of the image as (defined by the {\tt BITPIX} +keyword), which can have the following symbolic constant values: +\begin{verbatim} + BYTE_IMG = 8 ( 8-bit byte pixels, 0 - 255) + SHORT_IMG = 16 (16 bit integer pixels) + LONG_IMG = 32 (32-bit integer pixels) + FLOAT_IMG = -32 (32-bit floating point pixels) + DOUBLE_IMG = -64 (64-bit floating point pixels) +\end{verbatim} + +The second and third routines return the number of dimensions in the +image (from the {\tt NAXIS} keyword), and the sizes of each dimension +(from the {\tt NAXIS1, NAXIS2}, etc. keywords). The last routine +simply combines the function of the first 3 routines. The input {\tt +maxdim} parameter in this routine gives the maximum number dimensions +that may be returned (i.e., the dimension of the {\tt naxes} +array) + +\begin{verbatim} +__________________________________________________________ +int fits_create_img(fitsfile *fptr, int bitpix, int naxis, + long *naxes, int *status) +\end{verbatim} + +Create an image HDU by writing the required keywords which define the +structure of the image. The 2nd through 4th parameters specified the +datatype, the number of dimensions, and the sizes of the dimensions. +The allowed values of the {\tt bitpix} parameter are listed above in +the description of the {\tt fits\_get\_img\_type} routine. If the FITS +file pointed to by {\tt fptr} is empty (previously created with +{\tt fits\_create\_file}) then this routine creates a primary array in +the file, otherwise a new IMAGE extension is appended to end of the +file following the other HDUs in the file. + +\begin{verbatim} +______________________________________________________________ +int fits_write_pix(fitsfile *fptr, int datatype, long *fpixel, + long nelements, void *array, int *status); + +int fits_write_pixnull(fitsfile *fptr, int datatype, long *fpixel, + long nelements, void *array, void *nulval, int *status); + +int fits_read_pix(fitsfile *fptr, int datatype, long *fpixel, + long nelements, void *nulval, void *array, + int *anynul, int *status) +\end{verbatim} + +Read or write all or part of the FITS image. There are 2 different +'write' pixel routines: The first simply writes the input array of pixels +to the FITS file. The second is similar, except that it substitutes +the appropriate null pixel value in the FITS file for any pixels +which have a value equal to {\tt *nulval} (note that this parameter +gives the address of the null pixel value, not the value itself). +Similarly, when reading an image, CFITSIO will substitute the value +given by {\tt nulval} for any undefined pixels in the image, unless +{\tt nulval = NULL}, in which case no checks will be made for undefined +pixels when reading the FITS image. + +The {\tt fpixel} parameter in these routines is an array which gives +the coordinate in each dimension of the first pixel to be read or +written, and {\tt nelements} is the total number of pixels to read or +write. {\tt array} is the address of an array which either contains +the pixel values to be written, or will hold the values of the pixels +that are read. When reading, {\tt array} must have been allocated +large enough to hold all the returned pixel values. These routines +starts at the {\tt fpixel} location and then read or write the {\tt +nelements} pixels, continuing on successive rows of the image if +necessary. For example, to write an entire 2D image, set {\tt +fpixel[0] = fpixel[1] = 1}, and {\tt nelements = NAXIS1 * NAXIS2}. Or +to read just the 10th row of the image, set {\tt fpixel[0] = 1, +fpixel[1] = 10}, and {\tt nelements = NAXIS1}. The {\tt datatype} +parameter specifies the datatype of the C {\tt array} in the program, +which need not be the same as the datatype of the FITS image itself. +If the datatypes differ then CFITSIO will convert the data as it is +read or written. The following symbolic constants are allowed for the +value of {\tt datatype}: +\begin{verbatim} + TBYTE unsigned char + TSBYTE signed char + TSHORT signed short + TUSHORT unsigned short + TINT signed int + TUINT unsigned int + TLONG signed long + TULONG unsigned long + TFLOAT float + TDOUBLE double +\end{verbatim} + + +\begin{verbatim} +_________________________________________________________________ +int fits_write_subset(fitsfile *fptr, int datatype, long *fpixel, + long *lpixel, DTYPE *array, > int *status) + +int fits_read_subset(fitsfile *fptr, int datatype, long *fpixel, + long *lpixel, long *inc, void *nulval, void *array, + int *anynul, int *status) +\end{verbatim} + +Read or write a rectangular section of the FITS image. These are very +similar to {\tt fits\_write\_pix} and {\tt fits\_read\_pix} except that +you specify the last pixel coordinate (the upper right corner of the +section) instead of the number of pixels to be read. The read routine +also has an {\tt inc} parameter which can be used to read only every +{\tt inc-th} pixel along each dimension of the image. Normally {\tt +inc[0] = inc[1] = 1} to read every pixel in a 2D image. To read every +other pixel in the entire 2D image, set +\begin{verbatim} + fpixel[0] = fpixel[1] = 1 + lpixel[0] = {NAXIS1} + lpixel[1] = {NAXIS2} + inc[0] = inc[1] = 2 +\end{verbatim} + +Or, to read the 8th row of a 2D image, set +\begin{verbatim} + fpixel[0] = 1 + fpixel[1] = 8 + lpixel[0] = {NAXIS1} + lpixel[1] = 8 + inc[0] = inc[1] = 1 +\end{verbatim} + +\newpage +% =================================================================== +\subsection{Table I/O Routines} + +This section lists the most important CFITSIO routines which operate on +FITS tables. + +\begin{verbatim} +__________________________________________________________________________ +int fits_create_tbl(fitsfile *fptr, int tbltype, long nrows, int tfields, + char *ttype[],char *tform[], char *tunit[], char *extname, int *status) +\end{verbatim} + +Create a new table extension by writing the required keywords that +define the table structure. The required null primary array +will be created first if the file is initially completely empty. {\tt +tbltype} defines the type of table and can have values of {\tt +ASCII\_TBL or BINARY\_TBL}. Binary tables are generally preferred +because they are more efficient and support a greater range of column +datatypes than ASCII tables. + +The {\tt nrows} parameter gives the initial number of empty rows to be +allocated for the table; this should normally be set to 0. The {\tt tfields} +parameter gives the number of columns in the table (maximum = 999). +The {\tt +ttype, tform}, and {\tt tunit} parameters give the name, datatype, and +physical units of each column, and {\tt extname} gives the name for the +table (the value of the {\tt EXTNAME} keyword). +The FITS Standard recommends that only +letters, digits, and the underscore character be used in column names +with no embedded spaces. It is recommended that all the column names +in a given table be unique within the first 8 characters. + +The following table +shows the TFORM column format values that are allowed in ASCII tables +and in binary tables: +\begin{verbatim} + ASCII Table Column Format Codes + ------------------------------- + (w = column width, d = no. of decimal places to display) + Aw - character string + Iw - integer + Fw.d - fixed floating point + Ew.d - exponential floating point + Dw.d - exponential floating point + + Binary Table Column Format Codes + -------------------------------- + (r = vector length, default = 1) + rA - character string + rAw - array of strings, each of length w + rL - logical + rX - bit + rB - unsigned byte + rS - signed byte ** + rI - signed 16-bit integer + rU - unsigned 16-bit integer ** + rJ - signed 32-bit integer + rV - unsigned 32-bit integer ** + rK - 64-bit integer *** + rE - 32-bit floating point + rD - 64-bit floating point + rC - 32-bit complex pair + rM - 64-bit complex pair + + ** The S, U and V format codes are not actual legal TFORMn values. + CFITSIO substitutes the somewhat more complicated set of + keywords that are used to represent unsigned integers or + signed bytes. + + *** The 64-bit integer format is experimental and is not + officially recognized in the FITS Standard. +\end{verbatim} + +The {\tt tunit} and {\tt extname} parameters are optional and +may be set to NULL +if they are not needed. + +Note that it may be easier to create a new table by copying the +header from another existing table with {\tt fits\_copy\_header} rather +than calling this routine. + +\begin{verbatim} +_______________________________________________________________ +int fits_get_num_rows(fitsfile *fptr, long *nrows, int *status) +int fits_get_num_cols(fitsfile *fptr, int *ncols, int *status) +\end{verbatim} + +Get the number of rows or columns in the current FITS table. The +number of rows is given by the {\tt NAXIS2} keyword and the number of columns +is given by the {\tt TFIELDS} keyword in the header of the table. + +\begin{verbatim} +_______________________________________________________________ +int fits_get_colnum(fitsfile *fptr, int casesen, char *template, + int *colnum, int *status) +int fits_get_colname(fitsfile *fptr, int casesen, char *template, + char *colname, int *colnum, int *status) +\end{verbatim} + +Get the column number (starting with 1, not 0) of the column whose +name matches the specified template name. The only difference in +these 2 routines is that the 2nd one also returns the name of the +column that matched the template string. + +Normally, {\tt casesen} should +be set to {\tt CASEINSEN}, but it may be set to {\tt CASESEN} to force +the name matching to be case-sensitive. + +The input {\tt template} string gives the name of the desired column and +may include wildcard characters: a `*' matches any sequence of +characters (including zero characters), `?' matches any single +character, and `\#' matches any consecutive string of decimal digits +(0-9). If more than one column name in the table matches the template +string, then the first match is returned and the status value will be +set to {\tt COL\_NOT\_UNIQUE} as a warning that a unique match was not +found. To find the next column that matches the template, call this +routine again leaving the input status value equal to {\tt +COL\_NOT\_UNIQUE}. Repeat this process until {\tt status = +COL\_NOT\_FOUND} is returned. + +\begin{verbatim} +_______________________________________________________________ +int fits_get_coltype(fitsfile *fptr, int colnum, int *typecode, + long *repeat, long *width, int *status) + +int fits_get_eqcoltype(fitsfile *fptr, int colnum, int *typecode, + long *repeat, long *width, int *status) +\end{verbatim} + +Return the datatype, vector repeat count, and the width in bytes of a +single column element for column number {\tt colnum}. Allowed values +for the returned datatype in ASCII tables are: {\tt TSTRING, TSHORT, +TLONG, TFLOAT, and TDOUBLE}. Binary tables support these additional +types: {\tt TLOGICAL, TBIT, TBYTE, TINT32BIT, TCOMPLEX and TDBLCOMPLEX}. The +negative of the datatype code value is returned if it is a variable +length array column. + +These 2 routines are similar, except that in the case of scaled +integer columns the 2nd routine, fit\_get\_eqcoltype, returns the +'equivalent' datatype that is needed to store the scaled values, which +is not necessarily the same as the physical datatype of the unscaled values +as stored in the FITS table. For example if a '1I' column in a binary +table has TSCALn = 1 and TZEROn = 32768, then this column effectively +contains unsigned short integer values, and thus the returned value of +typecode will be TUSHORT, not TSHORT. Or, if TSCALn or TZEROn are not +integers, then the equivalent datatype will be returned as TFLOAT or +TDOUBLE, depending on the size of the integer. + +The repeat count is always 1 in ASCII tables. +The 'repeat' parameter returns the vector repeat count on the binary +table TFORMn keyword value. (ASCII table columns always have repeat += 1). The 'width' parameter returns the width in bytes of a single +column element (e.g., a '10D' binary table column will have width = +8, an ASCII table 'F12.2' column will have width = 12, and a binary +table'60A' character string column will have width = 60); Note that +this routine supports the local convention for specifying arrays of +fixed length strings within a binary table character column using +the syntax TFORM = 'rAw' where 'r' is the total number of +characters (= the width of the column) and 'w' is the width of a +unit string within the column. Thus if the column has TFORM = +'60A12' then this means that each row of the table contains +5 12-character substrings within the 60-character field, and thus +in this case this routine will return typecode = TSTRING, repeat = +60, and width = 12. The number of substings in any binary table +character string field can be calculated by (repeat/width). +A null pointer may be given for any of the output parameters that + are not needed. + +\begin{verbatim} +____________________________________________________________________________ +int fits_insert_rows(fitsfile *fptr, long firstrow, long nrows, int *status) +int fits_delete_rows(fitsfile *fptr, long firstrow, long nrows, int *status) +int fits_delete_rowrange(fitsfile *fptr, char *rangelist, int *status) +int fits_delete_rowlist(fitsfile *fptr, long *rowlist, long nrows, int *stat) +\end{verbatim} + +Insert or delete rows in a table. The blank rows are inserted +immediately following row {\tt frow}. Set {\tt frow} = 0 to insert rows +at the beginning of the table. The first 'delete' routine deletes {\tt +nrows} rows beginning with row {\tt firstrow}. The 2nd delete routine +takes an input string listing the rows or row ranges to be deleted +(e.g., '2,4-7, 9-12'). The last delete routine takes an input long +integer array that specifies each individual row to be deleted. The +row lists must be sorted in ascending order. All these routines update +the value of the {\tt NAXIS2} keyword to reflect the new number of rows +in the table. + +\begin{verbatim} +_________________________________________________________________________ +int fits_insert_col(fitsfile *fptr, int colnum, char *ttype, char *tform, + int *status) +int fits_insert_cols(fitsfile *fptr, int colnum, int ncols, char **ttype, + char **tform, int *status) + +int fits_delete_col(fitsfile *fptr, int colnum, int *status) +\end{verbatim} + +Insert or delete columns in a table. {\tt colnum} gives the position +of the column to be inserted or deleted (where the first column of the +table is at position 1). {\tt ttype} and {\tt tform} give the column +name and column format, where the allowed format codes are listed above +in the description of the {\tt fits\_create\_table} routine. The 2nd +'insert' routine inserts multiple columns, where {\tt ncols} is the +number of columns to insert, and {\tt ttype} and {\tt tform} are +arrays of string pointers in this case. + +\begin{verbatim} +____________________________________________________________________ +int fits_copy_col(fitsfile *infptr, fitsfile *outfptr, int incolnum, + int outcolnum, int create_col, int *status); +\end{verbatim} + +Copy a column from one table HDU to another. If {\tt create\_col} = TRUE (i.e., not equal to zero), +then a new column will be inserted in the output table at position +{\tt outcolumn}, otherwise the values in the existing output column will be +overwritten. + +\begin{verbatim} +__________________________________________________________________________ +int fits_write_col(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelements, void *array, int *status) +int fits_write_colnull(fitsfile *fptr, int datatype, int colnum, + long firstrow, long firstelem, long nelements, + void *array, void *nulval, int *status) +int fits_write_col_null(fitsfile *fptr, int colnum, long firstrow, + long firstelem, long nelements, int *status) + +int fits_read_col(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelements, void *nulval, void *array, + int *anynul, int *status) + +\end{verbatim} + +Write or read elements in column number {\tt colnum}, starting with row +{\tt firstsrow} and element {\tt firstelem} (if it is a vector +column). {\tt firstelem} is ignored if it is a scalar column. The {\tt +nelements} number of elements are read or written continuing on +successive rows of the table if necessary. {\tt array} is the address +of an array which either contains the values to be written, or will +hold the returned values that are read. When reading, {\tt array} must +have been allocated large enough to hold all the returned values. + +There are 3 different 'write' column routines: The first simply writes +the input array into the column. The second is similar, except that it +substitutes the appropriate null pixel value in the column for any +input array values which are equal to {\tt *nulval} (note that this +parameter gives the address of the null pixel value, not the value +itself). The third write routine sets the specified table elements +to a null value. New rows will be automatical added to the table +if the write operation extends beyond the current size of the table. + +When reading a column, CFITSIO will substitute the value given by {\tt +nulval} for any undefined elements in the FITS column, unless {\tt +nulval} or {\tt *nulval = NULL}, in which case no checks will be made +for undefined values when reading the column. + +{\tt datatype} specifies the datatype of the C {\tt array} in the program, +which need not be the same as the intrinsic datatype of the column in +the FITS table. The following symbolic constants are allowed for the +value of {\tt datatype}: + +\begin{verbatim} + TSTRING array of character string pointers + TBYTE unsigned char + TSHORT signed short + TUSHORT unsigned short + TINT signed int + TUINT unsigned int + TLONG signed long + TULONG unsigned long + TFLOAT float + TDOUBLE double +\end{verbatim} + +Note that {\tt TSTRING} corresponds to the C {\tt +char**} datatype, i.e., a pointer to an array of pointers to an array +of characters. + +Any column, regardless of it's intrinsic datatype, may be read as a +{\tt TSTRING} character string. The display format of the returned +strings will be determined by the {\tt TDISPn} keyword, if it exists, +otherwise a default format will be used depending on the datatype of +the column. The {\tt tablist} example utility program (available from +the CFITSIO web site) uses this feature to display all the values in a +FITS table. + +\begin{verbatim} +_____________________________________________________________________ +int fits_select_rows(fitsfile *infptr, fitsfile *outfptr, char *expr, + int *status) +int fits_calculator(fitsfile *infptr, char *expr, fitsfile *outfptr, + char *colname, char *tform, int *status) +\end{verbatim} + +These are 2 of the most powerful routines in the CFITSIO library. (See +the full CFITSIO Reference Guide for a description of several related +routines). These routines can perform complicated transformations on +tables based on an input arithmetic expression which is evaluated for +each row of the table. The first routine will select or copy rows of +the table for which the expression evaluates to TRUE (i.e., not equal +to zero). The second routine writes the value of the expression to a +column in the output table. Rather than supplying the expression +directly to these routines, the expression may also be written to a +text file (continued over multiple lines if necessary) and the name of +the file, prepended with a '@' character, may be supplied as the value +of the 'expr' parameter (e.g. '@filename.txt'). + +The arithmetic expression may be a function of any column or keyword in +the input table as shown in these examples: + +\begin{verbatim} +Row Selection Expressions: + counts > 0 uses COUNTS column value + sqrt( X**2 + Y**2) < 10. uses X and Y column values + (X > 10) || (X < -10) && (Y == 0) used 'or' and 'and' operators + gtifilter() filter on Good Time Intervals + regfilter("myregion.reg") filter using a region file + @select.txt reads expression from a text file +Calculator Expressions: + #row % 10 modulus of the row number + counts/#exposure Fn of COUNTS column and EXPOSURE keyword + dec < 85 ? cos(dec * #deg) : 0 Conditional expression: evaluates to + cos(dec) if dec < 85, else 0 + (count{-1}+count+count{+1})/3. running mean of the count values in the + previous, current, and next rows + max(0, min(X, 1000)) returns a value between 0 - 1000 + @calc.txt reads expression from a text file +\end{verbatim} + +Most standard mathematical operators and functions are supported. If +the expression includes the name of a column, than the value in the +current row of the table will be used when evaluating the expression on +each row. An offset to an adjacent row can be specified by including +the offset value in curly brackets after the column name as shown in +one of the examples. Keyword values can be included in the expression +by preceding the keyword name with a `\#' sign. See Section 5 of this +document for more discussion of the expression syntax. + +{\tt gtifilter} is a special function which tests whether the {\tt +TIME} column value in the input table falls within one or more Good +Time Intervals. By default, this function looks for a 'GTI' extension +in the same file as the input table. The 'GTI' table contains {\tt START} +and {\tt STOP} columns which define the range of +each good time interval. See section 5.4.3 for more details. + +{\tt regfilter} is another special function which selects rows based on +whether the spatial position associated with each row is located within +in a specified region of the sky. By default, the {\tt X} and {\tt Y} +columns in the input table are assumed to give the position of each row. +The spatial region is defined in an ASCII text file whose name is given +as the argument to the {\tt regfilter} function. See section 5.4.4 for +more details. + +The {\tt infptr} and {\tt outfptr} parameters in these routines may +point to the same table or to different tables. In {\tt +fits\_select\_rows}, if the input and output tables are the same then +the rows that do not satisfy the selection expression will be deleted +from the table. Otherwise, if the output table is different from the +input table then the selected rows will be copied from the input table +to the output table. + +The output column in {\tt fits\_calculator} may or may not already +exist. If it exists then the calculated values will be written to that +column, overwriting the existing values. If the column doesn't exist +then the new column will be appended to the output table. The {\tt tform} +parameter can be used to specify the datatype of the new column (e.g., +the {\tt TFORM} keyword value as in {\tt '1E', or '1J'}). If {\tt +tform} = NULL then a default datatype will be used, depending on the +expression. + +\begin{verbatim} +_____________________________________________________________________ +int fits_read_tblbytes(fitsfile *fptr, long firstrow, long firstchar, + long nchars, unsigned char *array, int *status) +int fits_write_tblbytes (fitsfile *fptr, long firstrow, long firstchar, + long nchars, unsigned char *array, int *status) +\end{verbatim} + +These 2 routines provide low-level access to tables and are mainly +useful as an efficient way to copy rows of a table from one file to +another. These routines simply read or write the specified number of +consecutive characters (bytes) in a table, without regard for column +boundaries. For example, to read or write the first row of a table, +set {\tt firstrow = 1, firstchar = 1}, and {\tt nchars = NAXIS1} where +the length of a row is given by the value of the {\tt NAXIS1} header +keyword. When reading a table, {\tt array} must have been declared at +least {\tt nchars} bytes long to hold the returned string of bytes. + +\newpage +% =================================================================== +\subsection{Header Keyword I/O Routines} +\nopagebreak +The following routines read and write header keywords in the current HDU. +\nopagebreak + +\begin{verbatim} +____________________________________________________________________ +int fits_get_hdrspace(fitsfile *fptr, int *keysexist, int *morekeys, + int *status) +\end{verbatim} +\nopagebreak +Return the number of existing keywords (not counting the mandatory END +keyword) and the amount of empty space currently available for more +keywords. The {\tt morekeys} parameter may be set to NULL if it's value is +not needed. + +\begin{verbatim} +___________________________________________________________________________ +int fits_read_record(fitsfile *fptr, int keynum, char *record, int *status) +int fits_read_card(fitsfile *fptr, char *keyname, char *record, int *status) +int fits_read_key(fitsfile *fptr, int datatype, char *keyname, + void *value, char *comment, int *status) + +int fits_find_nextkey(fitsfile *fptr, char **inclist, int ninc, + char **exclist, int nexc, char *card, int *status) + +int fits_read_key_unit(fitsfile *fptr, char *keyname, char *unit, + int *status) +\end{verbatim} + +These routines all read a header record in the current HDU. The first +routine reads keyword number {\tt keynum} (where the first keyword is +at position 1). This routine is most commonly used when sequentially +reading every record in the header from beginning to end. The 2nd and +3rd routines read the named keyword and return either the whole +80-byte record, or the keyword value and comment string. + +Wild card characters (*, ?, and \#) may be used when specifying the name +of the keyword to be read, in which case the first matching keyword is +returned. + +The {\tt datatype} parameter specifies the C datatype of the returned +keyword value and can have one of the following symbolic constant +values: {\tt TSTRING, TLOGICAL} (== int), {\tt TBYTE}, {\tt TSHORT}, +{\tt TUSHORT}, {\tt TINT}, {\tt TUINT}, {\tt TLONG}, {\tt TULONG}, {\tt +TFLOAT}, {\tt TDOUBLE}, {\tt TCOMPLEX}, and {\tt TDBLCOMPLEX}. Data +type conversion will be performed for numeric values if the intrinsic +FITS keyword value does not have the same datatype. The {\tt comment} +parameter may be set equal to NULL if the comment string is not +needed. + +The 4th routine provides an easy way to find all the keywords in the +header that match one of the name templates in {\tt inclist} and do not +match any of the name templates in {\tt exclist}. {\tt ninc} and {\tt +nexc} are the number of template strings in {\tt inclist} and {\tt +exclist}, respectively. Wild cards (*, ?, and \#) may be used in the +templates to match multiple keywords. Each time this routine is called +it returns the next matching 80-byte keyword record. It returns status += {\tt KEY\_NO\_EXIST} if there are no more matches. + +The 5th routine returns the keyword value units string, if any. +The units are recorded at the beginning of the keyword comment field +enclosed in square brackets. +\begin{verbatim} +_______________________________________________________________ +int fits_write_key(fitsfile *fptr, int datatype, char *keyname, + void *value, char *comment, int *status) +int fits_update_key(fitsfile *fptr, int datatype, char *keyname, + void *value, char *comment, int *status) +int fits_write_record(fitsfile *fptr, char *card, int *status) + +int fits_modify_comment(fitsfile *fptr, char *keyname, char *comment, + int *status) +int fits_write_key_unit(fitsfile *fptr, char *keyname, char *unit, + int *status) + +\end{verbatim} + +Write or modify a keyword in the header of the current HDU. The +first routine appends the new keyword to the end of the header, whereas +the second routine will update the value and comment fields of the +keyword if it already exists, otherwise it behaves like the first +routine and appends the new keyword. Note that {\tt value} gives the +address to the value and not the value itself. The {\tt datatype} +parameter specifies the C datatype of the keyword value and may have +any of the values listed in the description of the keyword reading +routines, above. A NULL may be entered for the comment parameter, in +which case the keyword comment field will be unmodified or left +blank. + +The third routine is more primitive and simply writes the 80-character +{\tt card} record to the header. It is the programmer's responsibility +in this case to ensure that the record conforms to all the FITS format +requirements for a header record. + +The fourth routine modifies the comment string in an existing keyword, +and the last routine writes or updates the keyword units string for an +existing keyword. (The units are recorded at the beginning of the +keyword comment field enclosed in square brackets). + +\begin{verbatim} +___________________________________________________________________ +int fits_write_comment(fitsfile *fptr, char *comment, int *status) +int fits_write_history(fitsfile *fptr, char *history, int *status) +int fits_write_date(fitsfile *fptr, int *status) +\end{verbatim} + +Write a {\tt COMMENT, HISTORY}, or {\tt DATE} keyword to the current +header. The {\tt COMMENT} keyword is typically used to write a comment +about the file or the data. The {\tt HISTORY} keyword is typically +used to provide information about the history of the processing +procedures that have been applied to the data. The {\tt comment} or +{\tt history} string will be continued over multiple keywords if it is +more than 70 characters long. + +The {\tt DATE} keyword is used to record the date and time that the +FITS file was created. Note that this file creation date is usually +different from the date of the observation which obtained the data in +the FITS file. The {\tt DATE} keyword value is a character string in +'yyyy-mm-ddThh:mm:ss' format. If a {\tt DATE} keyword already exists in +the header, then this routine will update the value with the current +system date. + +\begin{verbatim} +___________________________________________________________________ +int fits_delete_record(fitsfile *fptr, int keynum, int *status) +int fits_delete_key(fitsfile *fptr, char *keyname, int *status) +\end{verbatim} + +Delete a keyword record. The first routine deletes a keyword at a +specified position (the first keyword is at position 1, not 0), +whereas the second routine deletes the named keyword. + +\begin{verbatim} +_______________________________________________________________________ +int fits_copy_header(fitsfile *infptr, fitsfile *outfptr, int *status) +\end{verbatim} + +Copy all the header keywords from the current HDU associated with +infptr to the current HDU associated with outfptr. If the current +output HDU is not empty, then a new HDU will be appended to the output +file. The output HDU will then have the identical structure as the +input HDU, but will contain no data. + +\newpage +% =================================================================== +\subsection{Utility Routines} + +This section lists the most important CFITSIO general utility routines. + +\begin{verbatim} +___________________________________________________________________ +int fits_write_chksum( fitsfile *fptr, int *status) +int fits_verify_chksum(fitsfile *fptr, int *dataok, int *hduok, int *status) +\end{verbatim} + +These routines compute or validate the checksums for the currenrt +HDU. The {\tt DATASUM} keyword is used to store the numerical value of +the 32-bit, 1's complement checksum for the data unit alone. The {\tt +CHECKSUM} keyword is used to store the ASCII encoded COMPLEMENT of the +checksum for the entire HDU. Storing the complement, rather than the +actual checksum, forces the checksum for the whole HDU to equal zero. +If the file has been modified since the checksums were computed, then +the HDU checksum will usually not equal zero. + +The returned {\tt dataok} and {\tt hduok} parameters will have a value += 1 if the data or HDU is verified correctly, a value = 0 if the +{\tt DATASUM} or {\tt CHECKSUM} keyword is not present, or value = -1 if the +computed checksum is not correct. + + +\begin{verbatim} +___________________________________________________________________ +int fits_parse_value(char *card, char *value, char *comment, int *status) +int fits_get_keytype(char *value, char *dtype, int *status) +int fits_get_keyclass(char *card) +int fits_parse_template(char *template, char *card, int *keytype, int *status) + +\end{verbatim} + +{\tt fits\_parse\_value} parses the input 80-chararacter header keyword record, returning +the value (as a literal character string) and comment strings. If the +keyword has no value (columns 9-10 not equal to '= '), then a null +value string is returned and the comment string is set equal to column +9 - 80 of the input string. + +{\tt fits\_get\_keytype} parses the keyword value string to determine its +datatype. {\tt dtype} returns with a value of 'C', 'L', 'I', 'F' or +'X', for character string, logical, integer, floating point, or +complex, respectively. + +{\tt fits\_get\_keyclass} returns a classification code that indicates +the classification type of the input keyword record (e.g., a required +structural keyword, a TDIM keyword, a WCS keyword, a comment keyword, +etc. See the CFITSIO Reference Guide for a list of the different +classification codes. + +{\tt fits\_parse\_template} takes an input free format keyword template +string and returns a formatted 80*char record that satisfies all the +FITS requirements for a header keyword record. The template should +generally contain 3 tokens: the keyword name, the keyword value, and +the keyword comment string. The returned {\tt keytype} parameter +indicates whether the keyword is a COMMENT keyword or not. See the +CFITSIO Reference Guide for more details. + +\newpage +% =================================================================== +\section{CFITSIO File Names and Filters} + +\subsection{Creating New Files} + +When creating a new output file on magnetic disk with {\tt +fits\_create\_file} the following features are supported. +\begin{itemize} +\item Overwriting, or 'Clobbering' an Existing File + +If the filename is preceded by an exclamation +point (!) then if that file already exists it will be deleted prior to +creating the new FITS file. Otherwise if there is an existing file +with the same name, CFITSIO will not overwrite the existing file and +will return an error status code. Note that the exclamation point is +a special UNIX character, so if it is used on the command line rather +than entered at a task prompt, it must be preceded by a backslash to +force the UNIX shell to pass it verbatim to the application program. + +\item Compressed Output Files + +If the output disk file name ends with the suffix '.gz', then CFITSIO +will compress the file using the gzip compression algorithm before +writing it to disk. This can reduce the amount of disk space used by +the file. Note that this feature requires that the uncompressed file +be constructed in memory before it is compressed and written to disk, +so it can fail if there is insufficient available memory. + +One can also specify that any images written to the output file should +be compressed using the newly developed `tile-compression' algorithm by +appending `[compress]' to the name of the disk file (as in +{\tt myfile.fits[compress]}). Refer to the CFITSIO User's Reference Guide +for more information about this new image compression format. + +\item Using a Template to Create a New FITS File + +The structure of any new FITS file that is to be created may be defined +in an ASCII template file. If the name of the template file is +appended to the name of the FITS file itself, enclosed in parenthesis +(e.g., {\tt 'newfile.fits(template.txt)'}) then CFITSIO will create a +FITS file with that structure before opening it for the application to +use. The template file basically defines the dimensions and data type +of the primary array and any IMAGE extensions, and the names and data +types of the columns in any ASCII or binary table extensions. The +template file can also be used to define any optional keywords that +should be written in any of the HDU headers. The image pixel values +and table entry values are all initialized to zero. The application +program can then write actual data into the HDUs. See the CFITSIO +Reference Guide for for a complete description of the template file +syntax. + +\item Creating a Temporary Scratch File in Memory + +It is sometimes useful to create a temporary output file when testing +an application program. If the name of the file to be created is +specified as {\tt mem:} then CFITSIO will create the file in +memory where it will persist only until the program closes the file. +Use of this {\tt mem:} output file usually enables the program to run +faster, and of course the output file does not use up any disk space. + + +\end{itemize} + +\subsection{Opening Existing Files} + +When opening a file with {\tt fits\_open\_file}, CFITSIO can read a +variety of different input file formats and is not restricted to only +reading FITS format files from magnetic disk. The following types of +input files are all supported: + +\begin{itemize} +\item FITS files compressed with {\tt zip, gzip} or {\tt compress} + +If CFITSIO cannot find the specified file to open it will automatically +look for a file with the same rootname but with a {\tt .gz, .zip}, or +{\tt .Z} extension. If it finds such a compressed file, it will +allocate a block of memory and uncompress the file into that memory +space. The application program will then transparently open this +virtual FITS file in memory. Compressed +files can only be opened with 'readonly', not 'readwrite' file access. + +\item FITS files on the internet, using {\tt ftp} or {\tt http} URLs + +Simply provide the full URL as the name of the file that you want to +open. For example,\linebreak {\tt +ftp://legacy.gsfc.nasa.gov/software/fitsio/c/testprog.std}\linebreak +will open the CFITSIO test FITS file that is located on the {\tt +legacy} machine. These files can only be opened with 'readonly' file +access. + +\item FITS files on {\tt stdin} or {\tt stdout} file streams + +If the name of the file to be opened is {\tt 'stdin'} or {\tt '-'} (a +single dash character) then CFITSIO will read the file from the +standard input stream. Similarly, if the output file name is {\tt +'stdout'} or {\tt '-'}, then the file will be written to the standard +output stream. In addition, if the output filename is {\tt +'stdout.gz'} or {\tt '-.gz'} then it will be gzip compressed before +being written to stdout. This mechanism can be used to pipe FITS files +from one task to another without having to write an intermediary FITS +file on magnetic disk. + +\item FITS files that exist only in memory, or shared memory. + +In some applications, such as real time data acquisition, you may want +to have one process write a FITS file into a certain section of +computer memory, and then be able to open that file in memory with +another process. There is a specialized CFITSIO open routine called +{\tt fits\_open\_memfile} that can be used for this purpose. See the +``CFITSIO User's Reference Guide'' for more details. + +\item IRAF format images (with {\tt .imh} file extensions) + +CFITSIO supports reading IRAF format images by converting them on the +fly into FITS images in memory. The application program then reads +this virtual FITS format image in memory. There is currently no +support for writing IRAF format images, or for reading or writing IRAF +tables. + +\item Image arrays in raw binary format + +If the input file is a raw binary data array, then CFITSIO will convert +it on the fly into a virtual FITS image with the basic set of required +header keywords before it is opened by the application program. In +this case the data type and dimensions of the image must be specified +in square brackets following the filename (e.g. {\tt +rawfile.dat[ib512,512]}). The first character inside the brackets +defines the datatype of the array: + +\begin{verbatim} + b 8-bit unsigned byte + i 16-bit signed integer + u 16-bit unsigned integer + j 32-bit signed integer + r or f 32-bit floating point + d 64-bit floating point +\end{verbatim} +An optional second character specifies the byte order of the array +values: b or B indicates big endian (as in FITS files and the native +format of SUN UNIX workstations and Mac PCs) and l or L indicates +little endian (native format of DEC OSF workstations and IBM PCs). If +this character is omitted then the array is assumed to have the native +byte order of the local machine. These datatype characters are then +followed by a series of one or more integer values separated by commas +which define the size of each dimension of the raw array. Arrays with +up to 5 dimensions are currently supported. + +Finally, a byte offset to the position of the first pixel in the data +file may be specified by separating it with a ':' from the last +dimension value. If omitted, it is assumed that the offset = 0. This +parameter may be used to skip over any header information in the file +that precedes the binary data. Further examples: + +\begin{verbatim} + raw.dat[b10000] 1-dimensional 10000 pixel byte array + raw.dat[rb400,400,12] 3-dimensional floating point big-endian array + img.fits[ib512,512:2880] reads the 512 x 512 short integer array in a + FITS file, skipping over the 2880 byte header +\end{verbatim} + +\end{itemize} +\newpage + +\subsection{Image Filtering} + +\subsubsection{Extracting a subsection of an image} + +When specifying the name of an image to be opened, you can select a +rectangular subsection of the image to be extracted and opened by the +application program. The application program then opens a virtual +image that only contains the pixels within the specified subsection. +To do this, specify the the range of pixels (start:end) along each axis +to be extracted from the original image enclosed in square brackets. +You can also specify an optional pixel increment (start:end:step) for +each axis of the input image. A pixel step = 1 will be assumed if it +is not specified. If the starting pixel is larger then the end pixel, +then the image will be flipped (producing a mirror image) along that +dimension. An asterisk, '*', may be used to specify the entire range +of an axis, and '-*' will flip the entire axis. In the following +examples, assume that {\tt myfile.fits} contains a 512 x 512 pixel 2D +image. + +\begin{verbatim} + myfile.fits[201:210, 251:260] - opens a 10 x 10 pixel subimage. + + myfile.fits[*, 512:257] - opens a 512 x 256 image consisting of + all the columns in the input image, but only rows 257 + through 512. The image will be flipped along the Y axis + since the starting row is greater than the ending + row. + + myfile.fits[*:2, 512:257:2] - creates a 256 x 128 pixel image. + Similar to the previous example, but only every other row + and column is read from the input image. + + myfile.fits[-*, *] - creates an image containing all the rows and + columns in the input image, but flips it along the X + axis. +\end{verbatim} + +If the array to be opened is in an Image extension, and not in the +primary array of the file, then you need to specify the extension +name or number in square brackets before giving the subsection range, +as in {\tt myfile.fits[1][-*, *]} to read the image in the +first extension in the file. + +\subsubsection{Create an Image by Binning Table Columns} + +You can also create and open a virtual image by binning the values in a +pair of columns of a FITS table (in other words, create a 2-D histogram +of the values in the 2 columns). This technique is often used in X-ray +astronomy where each detected X-ray photon during an observation is +recorded in a FITS table. There are typically 2 columns in the table +called {\tt X} and {\tt Y} which record the pixel location of that +event in a virtual 2D image. To create an image from this table, one +just scans the X and Y columns and counts up how many photons were +recorded in each pixel of the image. When table binning is specified, +CFITSIO creates a temporary FITS primary array in memory by computing +the histogram of the values in the specified columns. After the +histogram is computed the original FITS file containing the table is +closed and the temporary FITS primary array is opened and passed to the +application program. Thus, the application program never sees the +original FITS table and only sees the image in the new temporary file +(which has no extensions). + +The table binning specifier is enclosed in square brackets following +the root filename and table extension name or number and begins with +the keyword 'bin', as in: \newline +{\tt 'myfile.fits[events][bin (X,Y)]'}. In +this case, the X and Y columns in the 'events' table extension are +binned up to create the image. The size of the image is usually +determined by the {\tt TLMINn} and {\tt TLMAXn} header keywords which +give the minimum and maximum allowed pixel values in the columns. For +instance if {\tt TLMINn = 1} and {\tt TLMAXn = 4096} for both columns, this would +generate a 4096 x 4096 pixel image by default. This is rather large, +so you can also specify a pixel binning factor to reduce the image +size. For example specifying , {\tt '[bin (X,Y) = 16]'} will use a +binning factor of 16, which will produce a 256 x 256 pixel image in the +previous example. + +If the TLMIN and TLMAX keywords don't exist, or you want to override +their values, you can specify the image range and binning factor +directly, as in {\tt '[bin X = 1:4096:16, Y=1:4096:16]'}. You can also +specify the datatype of the created image by appending a b, i, j, r, or +d (for 8-bit byte, 16-bit integers, 32-bit integer, 32-bit floating +points, or 64-bit double precision floating point, respectively) to +the 'bin' keyword (e.g. {\tt '[binr (X,Y)]'} creates a floating point +image). If the datatype is not specified then a 32-bit integer image +will be created by default. + +If the column name is not specified, then CFITSIO will first try to use +the 'preferred column' as specified by the CPREF keyword if it exists +(e.g., 'CPREF = 'DETX,DETY'), otherwise column names 'X', 'Y' will be +assumed for the 2 axes. + +Note that this binning specifier is not restricted to only 2D images +and can be used to create 1D, 3D, or 4D images as well. It is also +possible to specify a weighting factor that is applied during the +binning. Please refer to the ``CFITSIO User's Reference Guide'' for +more details on these advanced features. +\newpage + +\subsection{Table Filtering} + +\subsubsection{Column and Keyword Filtering} + +The column or keyword filtering specifier is used to modify the +column structure and/or the header keywords in the HDU that was +selected with the previous HDU location specifier. It can +be used to perform the following types of operations. + +\begin{itemize} +\item +Append a new column to a table by giving the column name, optionally +followed by the datatype in parentheses, followed by an equals sign and +the arithmetic expression to be used to compute the value. The +datatype is specified using the same syntax that is allowed for the +value of the FITS TFORMn keyword (e.g., 'I', 'J', 'E', 'D', etc. for +binary tables, and 'I8', F12.3', 'E20.12', etc. for ASCII tables). If +the datatype is not specified then a default datatype will be chosen +depending on the expression. + +\item +Create a new header keyword by giving the keyword name, preceded by a +pound sign '\#', followed by an equals sign and an arithmetic +expression for the value of the keyword. The expression may be a +function of other header keyword values. The comment string for the +keyword may be specified in parentheses immediately following the +keyword name. + +\item +Overwrite the values in an existing column or keyword by giving the +name followed by an equals sign and an arithmetic expression. + +\item +Select a set of columns to be included in the filtered file by listing +the column names separated with semi-colons. Wild card characters may +be used in the column names to match multiple columns. Any other +columns in the input table will not appear in the filtered file. + +\item +Delete a column or keyword by listing the name preceded by a minus sign +or an exclamation mark (!) + +\item +Rename an existing column or keyword with the syntax 'NewName == +OldName'. + +\end{itemize} + +The column filtering specifier is enclosed in square brackets and +begins with the string 'col'. Multiple operations can be performed +by separating them with semi-colons. For complex or commonly used +operations, you can write the column filter to a text file, and then +use it by giving the name of the text file, preceded by a '@' +character. + +Some examples: + +\begin{verbatim} + [col PI=PHA * 1.1 + 0.2] - creates new PI column from PHA values + + [col rate = counts/exposure] - creates or overwrites the rate column by + dividing the counts column by the + EXPOSURE keyword value. + + [col TIME; X; Y] - only the listed columns will appear + in the filtered file + + [col Time;*raw] - include the Time column and any other + columns whose name ends with 'raw'. + + [col -TIME; Good == STATUS] - deletes the TIME column and + renames the STATUS column to GOOD + + [col @colfilt.txt] - uses the filtering expression in + the colfilt.txt text file +\end{verbatim} + +The original file is not changed by this filtering operation, and +instead the modifications are made on a temporary copy of the input +FITS file (usually in memory), which includes a copy of all the other +HDUs in the input file. The original input file is closed and the +application program opens the filtered copy of the file. + +\subsubsection{Row Filtering} + +The row filter is used to select a subset of the rows from a table +based on a boolean expression. A temporary new FITS file is created on +the fly (usually in memory) which contains only those rows for which +the row filter expression evaluates to true (i.e., not equal to zero). +The primary array and any other extensions in the input file are also +copied to the temporary file. The original FITS file is closed and the +new temporary file is then opened by the application program. + +The row filter expression is enclosed in square brackets following the +file name and extension name. For example, {\tt +'file.fits[events][GRADE==50]'} selects only those rows in the EVENTS +table where the GRADE column value is equal to 50). + +The row filtering expression can be an arbitrarily complex series of +operations performed on constants, keyword values, and column data +taken from the specified FITS TABLE extension. The expression +also can be written into a text file and then used by giving the +filename preceded by a '@' character, as in +{\tt '[@rowfilt.txt]'}. + +Keyword and column data are referenced by name. Any string of +characters not surrounded by quotes (ie, a constant string) or +followed by an open parentheses (ie, a function name) will be +initially interpreted as a column name and its contents for the +current row inserted into the expression. If no such column exists, +a keyword of that name will be searched for and its value used, if +found. To force the name to be interpreted as a keyword (in case +there is both a column and keyword with the same name), precede the +keyword name with a single pound sign, '\#', as in {\tt \#NAXIS2}. Due to +the generalities of FITS column and keyword names, if the column or +keyword name contains a space or a character which might appear as +an arithmetic term then inclose the name in '\$' characters as in +{\tt \$MAX PHA\$} or {\tt \#\$MAX-PHA\$}. The names are case insensitive. + +To access a table entry in a row other than the current one, follow +the column's name with a row offset within curly braces. For +example, {\tt'PHA\{-3\}'} will evaluate to the value of column PHA, 3 rows +above the row currently being processed. One cannot specify an +absolute row number, only a relative offset. Rows that fall outside +the table will be treated as undefined, or NULLs. + +Boolean operators can be used in the expression in either their +Fortran or C forms. The following boolean operators are available: + +\begin{verbatim} + "equal" .eq. .EQ. == "not equal" .ne. .NE. != + "less than" .lt. .LT. < "less than/equal" .le. .LE. <= =< + "greater than" .gt. .GT. > "greater than/equal" .ge. .GE. >= => + "or" .or. .OR. || "and" .and. .AND. && + "negation" .not. .NOT. ! "approx. equal(1e-7)" ~ +\end{verbatim} + +Note that the exclamation point, '!', is a special UNIX character, so +if it is used on the command line rather than entered at a task +prompt, it must be preceded by a backslash to force the UNIX shell to +ignore it. + +The expression may also include arithmetic operators and functions. +Trigonometric functions use radians, not degrees. The following +arithmetic operators and functions can be used in the expression +(function names are case insensitive): + + +\begin{verbatim} + "addition" + "subtraction" - + "multiplication" * "division" / + "negation" - "exponentiation" ** ^ + "absolute value" abs(x) "cosine" cos(x) + "sine" sin(x) "tangent" tan(x) + "arc cosine" arccos(x) "arc sine" arcsin(x) + "arc tangent" arctan(x) "arc tangent" arctan2(x,y) + "exponential" exp(x) "square root" sqrt(x) + "natural log" log(x) "common log" log10(x) + "modulus" i % j "random # [0.0,1.0)" random() + "minimum" min(x,y) "maximum" max(x,y) + "if-then-else" b?x:y +\end{verbatim} + + +The following type casting operators are available, where the +inclosing parentheses are required and taken from the C language +usage. Also, the integer to real casts values to double precision: + +\begin{verbatim} + "real to integer" (int) x (INT) x + "integer to real" (float) i (FLOAT) i +\end{verbatim} + + +Several constants are built in for use in numerical +expressions: + + +\begin{verbatim} + #pi 3.1415... #e 2.7182... + #deg #pi/180 #row current row number + #null undefined value #snull undefined string +\end{verbatim} + +A string constant must be enclosed in quotes as in 'Crab'. The +"null" constants are useful for conditionally setting table values to +a NULL, or undefined, value (For example, {\tt "col1==-99 ? \#NULL : +col1"}). + +There is also a function for testing if two values are close to +each other, i.e., if they are "near" each other to within a user +specified tolerance. The arguments, {\tt value\_1} and {\tt value\_2} can be +integer or real and represent the two values who's proximity is +being tested to be within the specified tolerance, also an integer +or real: + +\begin{verbatim} + near(value_1, value_2, tolerance) +\end{verbatim} + +When a NULL, or undefined, value is encountered in the FITS table, +the expression will evaluate to NULL unless the undefined value is +not actually required for evaluation, e.g. "TRUE .or. NULL" +evaluates to TRUE. The following two functions allow some NULL +detection and handling: + +\begin{verbatim} + ISNULL(x) + DEFNULL(x,y) +\end{verbatim} + +The former returns a boolean value of TRUE if the argument x is +NULL. The later "defines" a value to be substituted for NULL +values; it returns the value of x if x is not NULL, otherwise it +returns the value of y. + +Bit masks can be used to select out rows from bit columns ({\tt TFORMn = +\#X}) in FITS files. To represent the mask, binary, octal, and hex +formats are allowed: + +\begin{verbatim} + binary: b0110xx1010000101xxxx0001 + octal: o720x1 -> (b111010000xxx001) + hex: h0FxD -> (b00001111xxxx1101) +\end{verbatim} + +In all the representations, an x or X is allowed in the mask as a +wild card. Note that the x represents a different number of wild +card bits in each representation. All representations are case +insensitive. + +To construct the boolean expression using the mask as the boolean +equal operator described above on a bit table column. For example, +if you had a 7 bit column named flags in a FITS table and wanted +all rows having the bit pattern 0010011, the selection expression +would be: + + +\begin{verbatim} + flags == b0010011 + or + flags .eq. b10011 +\end{verbatim} + +It is also possible to test if a range of bits is less than, less +than equal, greater than and greater than equal to a particular +boolean value: + + +\begin{verbatim} + flags <= bxxx010xx + flags .gt. bxxx100xx + flags .le. b1xxxxxxx +\end{verbatim} + +Notice the use of the x bit value to limit the range of bits being +compared. + +It is not necessary to specify the leading (most significant) zero +(0) bits in the mask, as shown in the second expression above. + +Bit wise AND, OR and NOT operations are also possible on two or +more bit fields using the '\&'(AND), '$|$'(OR), and the '!'(NOT) +operators. All of these operators result in a bit field which can +then be used with the equal operator. For example: + + +\begin{verbatim} + (!flags) == b1101100 + (flags & b1000001) == bx000001 +\end{verbatim} + +Bit fields can be appended as well using the '+' operator. Strings +can be concatenated this way, too. + +\subsubsection{Good Time Interval Filtering} + + A common filtering method involves selecting rows which have a time + value which lies within what is called a Good Time Interval or GTI. + The time intervals are defined in a separate FITS table extension + which contains 2 columns giving the start and stop time of each + good interval. The filtering operation accepts only those rows of + the input table which have an associated time which falls within + one of the time intervals defined in the GTI extension. A high + level function, gtifilter(a,b,c,d), is available which evaluates + each row of the input table and returns TRUE or FALSE depending + whether the row is inside or outside the good time interval. The + syntax is + +\begin{verbatim} + gtifilter( [ "gtifile" [, expr [, "STARTCOL", "STOPCOL" ] ] ] ) +\end{verbatim} + where each "[]" demarks optional parameters. Note that the quotes + around the gtifile and START/STOP column are required. Either single + or double quote characters may be used. The gtifile, + if specified, can be blank ("") which will mean to use the first + extension with the name "*GTI*" in the current file, a plain + extension specifier (eg, "+2", "[2]", or "[STDGTI]") which will be + used to select an extension in the current file, or a regular + filename with or without an extension specifier which in the latter + case will mean to use the first extension with an extension name + "*GTI*". Expr can be any arithmetic expression, including simply + the time column name. A vector time expression will produce a + vector boolean result. STARTCOL and STOPCOL are the names of the + START/STOP columns in the GTI extension. If one of them is + specified, they both must be. + + In its simplest form, no parameters need to be provided -- default + values will be used. The expression {\tt "gtifilter()"} is equivalent to + +\begin{verbatim} + gtifilter( "", TIME, "*START*", "*STOP*" ) +\end{verbatim} + This will search the current file for a GTI extension, filter the + TIME column in the current table, using START/STOP times taken from + columns in the GTI extension with names containing the strings + "START" and "STOP". The wildcards ('*') allow slight variations in + naming conventions such as "TSTART" or "STARTTIME". The same + default values apply for unspecified parameters when the first one + or two parameters are specified. The function automatically + searches for TIMEZERO/I/F keywords in the current and GTI + extensions, applying a relative time offset, if necessary. + +\subsubsection{Spatial Region Filtering} + + Another common filtering method selects rows based on whether the + spatial position associated with each row is located within a given + 2-dimensional region. The syntax for this high-level filter is + +\begin{verbatim} + regfilter( "regfilename" [ , Xexpr, Yexpr [ , "wcs cols" ] ] ) +\end{verbatim} + where each "[ ]" demarks optional parameters. The region file name + is required and must be enclosed in quotes. The remaining + parameters are optional. The region file is an ASCII text file + which contains a list of one or more geometric shapes (circle, + ellipse, box, etc.) which defines a region on the celestial sphere + or an area within a particular 2D image. The region file is + typically generated using an image display program such as fv/POW + (distribute by the HEASARC), or ds9 (distributed by the Smithsonian + Astrophysical Observatory). Users should refer to the documentation + provided with these programs for more details on the syntax used in + the region files. + + In its simpliest form, (e.g., {\tt regfilter("region.reg")} ) the + coordinates in the default 'X' and 'Y' columns will be used to + determine if each row is inside or outside the area specified in + the region file. Alternate position column names, or expressions, + may be entered if needed, as in + +\begin{verbatim} + regfilter("region.reg", XPOS, YPOS) +\end{verbatim} + Region filtering can be applied most unambiguously if the positions + in the region file and in the table to be filtered are both give in + terms of absolute celestial coordinate units. In this case the + locations and sizes of the geometric shapes in the region file are + specified in angular units on the sky (e.g., positions given in + R.A. and Dec. and sizes in arcseconds or arcminutes). Similarly, + each row of the filtered table will have a celestial coordinate + associated with it. This association is usually implemented using + a set of so-called 'World Coordinate System' (or WCS) FITS keywords + that define the coordinate transformation that must be applied to + the values in the 'X' and 'Y' columns to calculate the coordinate. + + Alternatively, one can perform spatial filtering using unitless + 'pixel' coordinates for the regions and row positions. In this + case the user must be careful to ensure that the positions in the 2 + files are self-consistent. A typical problem is that the region + file may be generated using a binned image, but the unbinned + coordinates are given in the event table. The ROSAT events files, + for example, have X and Y pixel coordinates that range from 1 - + 15360. These coordinates are typically binned by a factor of 32 to + produce a 480x480 pixel image. If one then uses a region file + generated from this image (in image pixel units) to filter the + ROSAT events file, then the X and Y column values must be converted + to corresponding pixel units as in: + +\begin{verbatim} + regfilter("rosat.reg", X/32.+.5, Y/32.+.5) +\end{verbatim} + Note that this binning conversion is not necessary if the region + file is specified using celestial coordinate units instead of pixel + units because CFITSIO is then able to directly compare the + celestial coordinate of each row in the table with the celestial + coordinates in the region file without having to know anything + about how the image may have been binned. + + The last "wcs cols" parameter should rarely be needed. If supplied, + this string contains the names of the 2 columns (space or comma + separated) which have the associated WCS keywords. If not supplied, + the filter will scan the X and Y expressions for column names. + If only one is found in each expression, those columns will be + used, otherwise an error will be returned. + + These region shapes are supported (names are case insensitive): + +\begin{verbatim} + Point ( X1, Y1 ) <- One pixel square region + Line ( X1, Y1, X2, Y2 ) <- One pixel wide region + Polygon ( X1, Y1, X2, Y2, ... ) <- Rest are interiors with + Rectangle ( X1, Y1, X2, Y2, A ) | boundaries considered + Box ( Xc, Yc, Wdth, Hght, A ) V within the region + Diamond ( Xc, Yc, Wdth, Hght, A ) + Circle ( Xc, Yc, R ) + Annulus ( Xc, Yc, Rin, Rout ) + Ellipse ( Xc, Yc, Rx, Ry, A ) + Elliptannulus ( Xc, Yc, Rinx, Riny, Routx, Routy, Ain, Aout ) + Sector ( Xc, Yc, Amin, Amax ) +\end{verbatim} + where (Xc,Yc) is the coordinate of the shape's center; (X\#,Y\#) are + the coordinates of the shape's edges; Rxxx are the shapes' various + Radii or semimajor/minor axes; and Axxx are the angles of rotation + (or bounding angles for Sector) in degrees. For rotated shapes, the + rotation angle can be left off, indicating no rotation. Common + alternate names for the regions can also be used: rotbox = box; + rotrectangle = rectangle; (rot)rhombus = (rot)diamond; and pie + = sector. When a shape's name is preceded by a minus sign, '-', + the defined region is instead the area *outside* its boundary (ie, + the region is inverted). All the shapes within a single region + file are OR'd together to create the region, and the order is + significant. The overall way of looking at region files is that if + the first region is an excluded region then a dummy included region + of the whole detector is inserted in the front. Then each region + specification as it is processed overrides any selections inside of + that region specified by previous regions. Another way of thinking + about this is that if a previous excluded region is completely + inside of a subsequent included region the excluded region is + ignored. + + The positional coordinates may be given either in pixel units, + decimal degrees or hh:mm:ss.s, dd:mm:ss.s units. The shape sizes + may be given in pixels, degrees, arcminutes, or arcseconds. Look + at examples of region file produced by fv/POW or ds9 for further + details of the region file format. + +\subsubsection{Example Row Filters} + +\begin{verbatim} + [double && mag <= 5.0] - Extract all double stars brighter + than fifth magnitude + + [#row >= 125 && #row <= 175] - Extract row numbers 125 through 175 + + [abs(sin(theta * #deg)) < 0.5] - Extract all rows having the + absolute value of the sine of theta + less than a half where the angles + are tabulated in degrees + + [@rowFilter.txt] - Extract rows using the expression + contained within the text file + rowFilter.txt + + [gtifilter()] - Search the current file for a GTI + extension, filter the TIME + column in the current table, using + START/STOP times taken from + columns in the GTI extension + + [regfilter("pow.reg")] - Extract rows which have a coordinate + (as given in the X and Y columns) + within the spatial region specified + in the pow.reg region file. +\end{verbatim} + +\newpage +\subsection{Combined Filtering Examples} + +The previous sections described all the individual types of filters +that may be applied to the input file. In this section we show +examples which combine several different filters at once. These +examples all use the {\tt fitscopy} program that is distributed with +the CFITSIO code. It simply copies the input file to the output file. + +\begin{verbatim} +fitscopy rosat.fit out.fit +\end{verbatim} + +This trivial example simply makes an identical copy of the input +rosat.fit file without any filtering. + +\begin{verbatim} +fitscopy 'rosat.fit[events][col Time;X;Y][#row < 1000]' out.fit +\end{verbatim} + +The output file contains only the Time, X, and Y columns, and only +the first 999 rows from the 'EVENTS' table extension of the input file. +All the other HDUs in the input file are copied to the output file +without any modification. + +\begin{verbatim} +fitscopy 'rosat.fit[events][PI < 50][bin (Xdet,Ydet) = 16]' image.fit +\end{verbatim} + +This creates an output image by binning the Xdet and Ydet columns of +the events table with a pixel binning factor of 16. Only the rows +which have a PI energy less than 50 are used to construct this image. +The output image file contains a primary array image without any +extensions. + +\begin{verbatim} +fitscopy 'rosat.fit[events][gtifilter() && regfilter("pow.reg")]' out.fit +\end{verbatim} + +The filtering expression in this example uses the {\tt gtifilter} +function to test whether the TIME column value in each row is within +one of the Good Time Intervals defined in the GTI extension in the same +input file, and also uses the {\tt regfilter} function to test if the +position associated with each row (derived by default from the values +in the X and Y columns of the events table) is located within the area +defined in the {\tt pow.reg} text region file (which was previously +created with the {\tt fv/POW} image display program). Only the rows +which satisfy both tests are copied to the output table. + +\begin{verbatim} +fitscopy 'r.fit[evt][PI<50]' stdout | fitscopy stdin[evt][col X,Y] out.fit +\end{verbatim} + +In this somewhat convoluted example, fitscopy is used to first select +the rows from the evt extension which have PI less than 50 and write the +resulting table out to the stdout stream. This is piped to a 2nd +instance of fitscopy (with the Unix `$|$' pipe command) which reads that +filtered FITS file from the stdin stream and copies only the X and Y +columns from the evt table to the output file. + +\begin{verbatim} +fitscopy 'r.fit[evt][col RAD=sqrt((X-#XCEN)**2+(Y-#YCEN)**2)][rad<100]' out.fit +\end{verbatim} + +This example first creates a new column called RAD which gives the +distance between the X,Y coordinate of each event and the coordinate +defined by the XCEN and YCEN keywords in the header. Then, only those +rows which have a distance less than 100 are copied to the output +table. In other words, only the events which are located within 100 +pixel units from the (XCEN, YCEN) coordinate are copied to the output +table. + +\begin{verbatim} +fitscopy 'ftp://heasarc.gsfc.nasa.gov/rosat.fit[events][bin (X,Y)=16]' img.fit +\end{verbatim} + +This example bins the X and Y columns of the hypothetical ROSAT file +at the HEASARC ftp site to create the output image. + +\begin{verbatim} +fitscopy 'raw.fit[i512,512][101:110,51:60]' image.fit +\end{verbatim} + +This example converts the 512 x 512 pixel raw binary 16-bit integer +image to a FITS file and copies a 10 x 10 pixel subimage from it to the +output FITS image. + +\newpage +\section{CFITSIO Error Status Codes} + +The following table lists all the error status codes used by CFITSIO. +Programmers are encouraged to use the symbolic mnemonics (defined in +the file fitsio.h) rather than the actual integer status values to +improve the readability of their code. + +\begin{verbatim} + Symbolic Const Value Meaning + -------------- ----- ----------------------------------------- + 0 OK, no error + SAME_FILE 101 input and output files are the same + TOO_MANY_FILES 103 tried to open too many FITS files at once + FILE_NOT_OPENED 104 could not open the named file + FILE_NOT_CREATED 105 could not create the named file + WRITE_ERROR 106 error writing to FITS file + END_OF_FILE 107 tried to move past end of file + READ_ERROR 108 error reading from FITS file + FILE_NOT_CLOSED 110 could not close the file + ARRAY_TOO_BIG 111 array dimensions exceed internal limit + READONLY_FILE 112 Cannot write to readonly file + MEMORY_ALLOCATION 113 Could not allocate memory + BAD_FILEPTR 114 invalid fitsfile pointer + NULL_INPUT_PTR 115 NULL input pointer to routine + SEEK_ERROR 116 error seeking position in file + + BAD_URL_PREFIX 121 invalid URL prefix on file name + TOO_MANY_DRIVERS 122 tried to register too many IO drivers + DRIVER_INIT_FAILED 123 driver initialization failed + NO_MATCHING_DRIVER 124 matching driver is not registered + URL_PARSE_ERROR 125 failed to parse input file URL + + SHARED_BADARG 151 bad argument in shared memory driver + SHARED_NULPTR 152 null pointer passed as an argument + SHARED_TABFULL 153 no more free shared memory handles + SHARED_NOTINIT 154 shared memory driver is not initialized + SHARED_IPCERR 155 IPC error returned by a system call + SHARED_NOMEM 156 no memory in shared memory driver + SHARED_AGAIN 157 resource deadlock would occur + SHARED_NOFILE 158 attempt to open/create lock file failed + SHARED_NORESIZE 159 shared memory block cannot be resized at the moment + + HEADER_NOT_EMPTY 201 header already contains keywords + KEY_NO_EXIST 202 keyword not found in header + KEY_OUT_BOUNDS 203 keyword record number is out of bounds + VALUE_UNDEFINED 204 keyword value field is blank + NO_QUOTE 205 string is missing the closing quote + BAD_KEYCHAR 207 illegal character in keyword name or card + BAD_ORDER 208 required keywords out of order + NOT_POS_INT 209 keyword value is not a positive integer + NO_END 210 couldn't find END keyword + BAD_BITPIX 211 illegal BITPIX keyword value + BAD_NAXIS 212 illegal NAXIS keyword value + BAD_NAXES 213 illegal NAXISn keyword value + BAD_PCOUNT 214 illegal PCOUNT keyword value + BAD_GCOUNT 215 illegal GCOUNT keyword value + BAD_TFIELDS 216 illegal TFIELDS keyword value + NEG_WIDTH 217 negative table row size + NEG_ROWS 218 negative number of rows in table + COL_NOT_FOUND 219 column with this name not found in table + BAD_SIMPLE 220 illegal value of SIMPLE keyword + NO_SIMPLE 221 Primary array doesn't start with SIMPLE + NO_BITPIX 222 Second keyword not BITPIX + NO_NAXIS 223 Third keyword not NAXIS + NO_NAXES 224 Couldn't find all the NAXISn keywords + NO_XTENSION 225 HDU doesn't start with XTENSION keyword + NOT_ATABLE 226 the CHDU is not an ASCII table extension + NOT_BTABLE 227 the CHDU is not a binary table extension + NO_PCOUNT 228 couldn't find PCOUNT keyword + NO_GCOUNT 229 couldn't find GCOUNT keyword + NO_TFIELDS 230 couldn't find TFIELDS keyword + NO_TBCOL 231 couldn't find TBCOLn keyword + NO_TFORM 232 couldn't find TFORMn keyword + NOT_IMAGE 233 the CHDU is not an IMAGE extension + BAD_TBCOL 234 TBCOLn keyword value < 0 or > rowlength + NOT_TABLE 235 the CHDU is not a table + COL_TOO_WIDE 236 column is too wide to fit in table + COL_NOT_UNIQUE 237 more than 1 column name matches template + BAD_ROW_WIDTH 241 sum of column widths not = NAXIS1 + UNKNOWN_EXT 251 unrecognizable FITS extension type + UNKNOWN_REC 252 unknown record; 1st keyword not SIMPLE or XTENSION + END_JUNK 253 END keyword is not blank + BAD_HEADER_FILL 254 Header fill area contains non-blank chars + BAD_DATA_FILL 255 Illegal data fill bytes (not zero or blank) + BAD_TFORM 261 illegal TFORM format code + BAD_TFORM_DTYPE 262 unrecognizable TFORM datatype code + BAD_TDIM 263 illegal TDIMn keyword value + BAD_HEAP_PTR 264 invalid BINTABLE heap pointer is out of range + + BAD_HDU_NUM 301 HDU number < 1 or > MAXHDU + BAD_COL_NUM 302 column number < 1 or > tfields + NEG_FILE_POS 304 tried to move to negative byte location in file + NEG_BYTES 306 tried to read or write negative number of bytes + BAD_ROW_NUM 307 illegal starting row number in table + BAD_ELEM_NUM 308 illegal starting element number in vector + NOT_ASCII_COL 309 this is not an ASCII string column + NOT_LOGICAL_COL 310 this is not a logical datatype column + BAD_ATABLE_FORMAT 311 ASCII table column has wrong format + BAD_BTABLE_FORMAT 312 Binary table column has wrong format + NO_NULL 314 null value has not been defined + NOT_VARI_LEN 317 this is not a variable length column + BAD_DIMEN 320 illegal number of dimensions in array + BAD_PIX_NUM 321 first pixel number greater than last pixel + ZERO_SCALE 322 illegal BSCALE or TSCALn keyword = 0 + NEG_AXIS 323 illegal axis length < 1 + + NOT_GROUP_TABLE 340 Grouping function error + HDU_ALREADY_MEMBER 341 + MEMBER_NOT_FOUND 342 + GROUP_NOT_FOUND 343 + BAD_GROUP_ID 344 + TOO_MANY_HDUS_TRACKED 345 + HDU_ALREADY_TRACKED 346 + BAD_OPTION 347 + IDENTICAL_POINTERS 348 + BAD_GROUP_ATTACH 349 + BAD_GROUP_DETACH 350 + + NGP_NO_MEMORY 360 malloc failed + NGP_READ_ERR 361 read error from file + NGP_NUL_PTR 362 null pointer passed as an argument. + Passing null pointer as a name of + template file raises this error + NGP_EMPTY_CURLINE 363 line read seems to be empty (used + internally) + NGP_UNREAD_QUEUE_FULL 364 cannot unread more then 1 line (or single + line twice) + NGP_INC_NESTING 365 too deep include file nesting (infinite + loop, template includes itself ?) + NGP_ERR_FOPEN 366 fopen() failed, cannot open template file + NGP_EOF 367 end of file encountered and not expected + NGP_BAD_ARG 368 bad arguments passed. Usually means + internal parser error. Should not happen + NGP_TOKEN_NOT_EXPECT 369 token not expected here + + BAD_I2C 401 bad int to formatted string conversion + BAD_F2C 402 bad float to formatted string conversion + BAD_INTKEY 403 can't interpret keyword value as integer + BAD_LOGICALKEY 404 can't interpret keyword value as logical + BAD_FLOATKEY 405 can't interpret keyword value as float + BAD_DOUBLEKEY 406 can't interpret keyword value as double + BAD_C2I 407 bad formatted string to int conversion + BAD_C2F 408 bad formatted string to float conversion + BAD_C2D 409 bad formatted string to double conversion + BAD_DATATYPE 410 illegal datatype code value + BAD_DECIM 411 bad number of decimal places specified + NUM_OVERFLOW 412 overflow during datatype conversion + DATA_COMPRESSION_ERR 413 error compressing image + DATA_DECOMPRESSION_ERR 414 error uncompressing image + + BAD_DATE 420 error in date or time conversion + + PARSE_SYNTAX_ERR 431 syntax error in parser expression + PARSE_BAD_TYPE 432 expression did not evaluate to desired type + PARSE_LRG_VECTOR 433 vector result too large to return in array + PARSE_NO_OUTPUT 434 data parser failed not sent an out column + PARSE_BAD_COL 435 bad data encounter while parsing column + PARSE_BAD_OUTPUT 436 Output file not of proper type + + ANGLE_TOO_BIG 501 celestial angle too large for projection + BAD_WCS_VAL 502 bad celestial coordinate or pixel value + WCS_ERROR 503 error in celestial coordinate calculation + BAD_WCS_PROJ 504 unsupported type of celestial projection + NO_WCS_KEY 505 celestial coordinate keywords not found + APPROX_WCS_KEY 506 approximate wcs keyword values were returned +\end{verbatim} + +\end{document} diff --git a/pkg/tbtables/cfitsio/quick.toc b/pkg/tbtables/cfitsio/quick.toc new file mode 100644 index 00000000..9d7c7da6 --- /dev/null +++ b/pkg/tbtables/cfitsio/quick.toc @@ -0,0 +1,25 @@ +\contentsline {section}{\numberline {1}Introduction}{2} +\contentsline {section}{\numberline {2}Installing and Using CFITSIO}{3} +\contentsline {section}{\numberline {3}Example Programs}{4} +\contentsline {section}{\numberline {4}CFITSIO Routines}{6} +\contentsline {subsection}{\numberline {4.1}Error Reporting}{6} +\contentsline {subsection}{\numberline {4.2}File Open/Close Routines}{6} +\contentsline {subsection}{\numberline {4.3}HDU-level Routines}{7} +\contentsline {subsection}{\numberline {4.4}Image I/O Routines}{9} +\contentsline {subsection}{\numberline {4.5}Table I/O Routines}{12} +\contentsline {subsection}{\numberline {4.6}Header Keyword I/O Routines}{19} +\contentsline {subsection}{\numberline {4.7}Utility Routines}{22} +\contentsline {section}{\numberline {5}CFITSIO File Names and Filters}{23} +\contentsline {subsection}{\numberline {5.1}Creating New Files}{23} +\contentsline {subsection}{\numberline {5.2}Opening Existing Files}{24} +\contentsline {subsection}{\numberline {5.3}Image Filtering}{26} +\contentsline {subsubsection}{\numberline {5.3.1}Extracting a subsection of an image}{26} +\contentsline {subsubsection}{\numberline {5.3.2}Create an Image by Binning Table Columns}{26} +\contentsline {subsection}{\numberline {5.4}Table Filtering}{28} +\contentsline {subsubsection}{\numberline {5.4.1}Column and Keyword Filtering}{28} +\contentsline {subsubsection}{\numberline {5.4.2}Row Filtering}{29} +\contentsline {subsubsection}{\numberline {5.4.3}Good Time Interval Filtering}{32} +\contentsline {subsubsection}{\numberline {5.4.4}Spatial Region Filtering}{32} +\contentsline {subsubsection}{\numberline {5.4.5}Example Row Filters}{34} +\contentsline {subsection}{\numberline {5.5}Combined Filtering Examples}{36} +\contentsline {section}{\numberline {6}CFITSIO Error Status Codes}{38} diff --git a/pkg/tbtables/cfitsio/region.c b/pkg/tbtables/cfitsio/region.c new file mode 100644 index 00000000..31df9b7a --- /dev/null +++ b/pkg/tbtables/cfitsio/region.c @@ -0,0 +1,919 @@ +#include +#include +#include +#include +#include "fitsio2.h" +#include "region.h" + +static int Pt_in_Poly( double x, double y, int nPts, double *Pts ); + +/*---------------------------------------------------------------------------*/ +int ffrrgn( const char *filename, + WCSdata *wcs, + SAORegion **Rgn, + int *status ) +/* Read regions from a SAO-style region file and return the information */ +/* in the "SAORegion" structure. If it is nonNULL, use wcs to convert the */ +/* region coordinates to pixels. Return an error if region is in degrees */ +/* but no WCS data is provided. */ +/*---------------------------------------------------------------------------*/ +{ + char *currLine; + char *namePtr, *paramPtr, *currLoc; + char *pX, *pY, *endp; + long allocLen, lineLen, hh, mm, dd; + double *coords = 0, X, Y, R, x, y, ss, xsave= 0., ysave= 0.; + int nParams, nCoords, negdec; + int i, done; + FILE *rgnFile; + coordFmt cFmt; + SAORegion *aRgn; + RgnShape *newShape, *tmpShape; + + if( *status ) return( *status ); + + aRgn = (SAORegion *)malloc( sizeof(SAORegion) ); + if( ! aRgn ) { + ffpmsg("Couldn't allocate memory to hold Region file contents."); + return(*status = MEMORY_ALLOCATION ); + } + aRgn->nShapes = 0; + aRgn->Shapes = NULL; + if( wcs && wcs->exists ) + aRgn->wcs = *wcs; + else + aRgn->wcs.exists = 0; + + cFmt = pixel_fmt; /* set default format */ + + /* Allocate Line Buffer */ + + allocLen = 512; + currLine = (char *)malloc( allocLen * sizeof(char) ); + if( !currLine ) { + free( aRgn ); + ffpmsg("Couldn't allocate memory to hold Region file contents."); + return(*status = MEMORY_ALLOCATION ); + } + + /* Open Region File */ + + if( (rgnFile = fopen( filename, "r" ))==NULL ) { + sprintf(currLine,"Could not open Region file %s.",filename); + ffpmsg( currLine ); + free( currLine ); + free( aRgn ); + return( *status = FILE_NOT_OPENED ); + } + + /* Read in file, line by line */ + + while( fgets(currLine,allocLen,rgnFile) != NULL ) { + + /* Make sure we have a full line of text */ + + lineLen = strlen(currLine); + while( lineLen==allocLen-1 && currLine[lineLen-1]!='\n' ) { + currLoc = (char *)realloc( currLine, 2 * allocLen * sizeof(char) ); + if( !currLoc ) { + ffpmsg("Couldn't allocate memory to hold Region file contents."); + *status = MEMORY_ALLOCATION; + goto error; + } else { + currLine = currLoc; + } + fgets( currLine+lineLen, allocLen+1, rgnFile ); + allocLen += allocLen; + lineLen += strlen(currLine+lineLen); + } + + currLoc = currLine; + if( *currLoc == '#' ) { + + /* Look to see if it is followed by a format statement... */ + /* if not skip line */ + + currLoc++; + while( *currLoc==' ' ) currLoc++; + if( !strncasecmp( currLoc, "format:", 7 ) ) { + if( aRgn->nShapes ) { + ffpmsg("Format code encountered after reading 1 or more shapes."); + *status = PARSE_SYNTAX_ERR; + goto error; + } + currLoc += 7; + while( *currLoc==' ' ) currLoc++; + if( !strncasecmp( currLoc, "pixel", 5 ) ) { + cFmt = pixel_fmt; + } else if( !strncasecmp( currLoc, "degree", 6 ) ) { + cFmt = degree_fmt; + } else if( !strncasecmp( currLoc, "hhmmss", 6 ) ) { + cFmt = hhmmss_fmt; + } else if( !strncasecmp( currLoc, "hms", 3 ) ) { + cFmt = hhmmss_fmt; + } else { + ffpmsg("Unknown format code encountered in region file."); + *status = PARSE_SYNTAX_ERR; + goto error; + } + } + + } else if( !strncasecmp( currLoc, "glob", 4 ) ) { + /* skip lines that begin with the word 'global' */ + + } else { + + while( *currLoc != '\0' ) { + + namePtr = currLoc; + paramPtr = NULL; + nParams = 1; + + /* Search for closing parenthesis */ + + done = 0; + while( !done && !*status && *currLoc ) { + switch (*currLoc) { + case '(': + *currLoc = '\0'; + currLoc++; + if( paramPtr ) /* Can't have two '(' in a region! */ + *status = 1; + else + paramPtr = currLoc; + break; + case ')': + *currLoc = '\0'; + currLoc++; + if( !paramPtr ) /* Can't have a ')' without a '(' first */ + *status = 1; + else + done = 1; + break; + case '#': + case '\n': + *currLoc = '\0'; + if( !paramPtr ) /* Allow for a blank line */ + done = 1; + break; + case ':': + currLoc++; + cFmt = hhmmss_fmt; + break; + case 'd': + currLoc++; + cFmt = degree_fmt; + break; + case ',': + nParams++; /* Fall through to default */ + default: + currLoc++; + break; + } + } + if( *status || !done ) { + ffpmsg( "Error reading Region file" ); + *status = PARSE_SYNTAX_ERR; + goto error; + } + + /* Skip white space in region name */ + + while( *namePtr==' ' ) namePtr++; + + /* Was this a blank line? Or the end of the current one */ + + if( ! *namePtr && ! paramPtr ) continue; + + + /* Check for format code at beginning of the line */ + + if( !strncasecmp( namePtr, "image;", 6 ) ) { + namePtr += 6; + cFmt = pixel_fmt; + } else if( !strncasecmp( namePtr, "physical;", 9 ) ) { + namePtr += 9; + cFmt = pixel_fmt; + } else if( !strncasecmp( namePtr, "fk4;", 4 ) ) { + namePtr += 4; + cFmt = degree_fmt; + } else if( !strncasecmp( namePtr, "fk5;", 4 ) ) { + namePtr += 4; + cFmt = degree_fmt; + } else if( !strncasecmp( namePtr, "icrs;", 5 ) ) { + namePtr += 5; + cFmt = degree_fmt; + + /* the following 4 cases support region files created by POW which + may have lines containing only a format code, not followed + by a ';' (and with no region specifier on the line). We use + the 'continue' statement to jump to the end of the loop and + then continue reading the next line of the region file. */ + + } else if( !strncasecmp( namePtr, "fk5", 3 ) ) { + cFmt = degree_fmt; + continue; /* supports POW region file format */ + } else if( !strncasecmp( namePtr, "fk4", 3 ) ) { + cFmt = degree_fmt; + continue; /* supports POW region file format */ + } else if( !strncasecmp( namePtr, "icrs", 4 ) ) { + cFmt = degree_fmt; + continue; /* supports POW region file format */ + } else if( !strncasecmp( namePtr, "image", 5 ) ) { + cFmt = pixel_fmt; + continue; /* supports POW region file format */ + + + } else if( !strncasecmp( namePtr, "galactic;", 9 ) ) { + ffpmsg( "Galactic region coordinates not supported" ); + ffpmsg( namePtr ); + *status = PARSE_SYNTAX_ERR; + goto error; + } else if( !strncasecmp( namePtr, "ecliptic;", 9 ) ) { + ffpmsg( "ecliptic region coordinates not supported" ); + ffpmsg( namePtr ); + *status = PARSE_SYNTAX_ERR; + goto error; + } + + /**************************************************/ + /* We've apparently found a region... Set it up */ + /**************************************************/ + + if( !(aRgn->nShapes % 10) ) { + if( aRgn->Shapes ) + tmpShape = (RgnShape *)realloc( aRgn->Shapes, + (10+aRgn->nShapes) + * sizeof(RgnShape) ); + else + tmpShape = (RgnShape *) malloc( 10 * sizeof(RgnShape) ); + if( tmpShape ) { + aRgn->Shapes = tmpShape; + } else { + ffpmsg( "Failed to allocate memory for Region data"); + *status = MEMORY_ALLOCATION; + goto error; + } + + } + newShape = &aRgn->Shapes[aRgn->nShapes++]; + newShape->sign = 1; + newShape->shape = point_rgn; + + while( *namePtr==' ' ) namePtr++; + + /* Check for the shape's sign */ + + if( *namePtr=='+' ) { + namePtr++; + } else if( *namePtr=='-' ) { + namePtr++; + newShape->sign = 0; + } + + /* Skip white space in region name */ + + while( *namePtr==' ' ) namePtr++; + if( *namePtr=='\0' ) { + ffpmsg( "Error reading Region file" ); + *status = PARSE_SYNTAX_ERR; + goto error; + } + lineLen = strlen( namePtr ) - 1; + while( namePtr[lineLen]==' ' ) namePtr[lineLen--] = '\0'; + + /* Now identify the region */ + + if( !strcasecmp( namePtr, "circle" ) ) { + newShape->shape = circle_rgn; + if( nParams != 3 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !strcasecmp( namePtr, "annulus" ) ) { + newShape->shape = annulus_rgn; + if( nParams != 4 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !strcasecmp( namePtr, "ellipse" ) ) { + newShape->shape = ellipse_rgn; + if( nParams < 4 || nParams > 5 ) + *status = PARSE_SYNTAX_ERR; + newShape->param.gen.p[4] = 0.0; + nCoords = 2; + } else if( !strcasecmp( namePtr, "elliptannulus" ) ) { + newShape->shape = elliptannulus_rgn; + if( !( nParams==8 || nParams==6 ) ) + *status = PARSE_SYNTAX_ERR; + newShape->param.gen.p[6] = 0.0; + newShape->param.gen.p[7] = 0.0; + nCoords = 2; + } else if( !strcasecmp( namePtr, "box" ) + || !strcasecmp( namePtr, "rotbox" ) ) { + newShape->shape = box_rgn; + if( nParams < 4 || nParams > 5 ) + *status = PARSE_SYNTAX_ERR; + newShape->param.gen.p[4] = 0.0; + nCoords = 2; + } else if( !strcasecmp( namePtr, "rectangle" ) + || !strcasecmp( namePtr, "rotrectangle" ) ) { + newShape->shape = rectangle_rgn; + if( nParams < 4 || nParams > 5 ) + *status = PARSE_SYNTAX_ERR; + newShape->param.gen.p[4] = 0.0; + nCoords = 4; + } else if( !strcasecmp( namePtr, "diamond" ) + || !strcasecmp( namePtr, "rotdiamond" ) + || !strcasecmp( namePtr, "rhombus" ) + || !strcasecmp( namePtr, "rotrhombus" ) ) { + newShape->shape = diamond_rgn; + if( nParams < 4 || nParams > 5 ) + *status = PARSE_SYNTAX_ERR; + newShape->param.gen.p[4] = 0.0; + nCoords = 2; + } else if( !strcasecmp( namePtr, "sector" ) + || !strcasecmp( namePtr, "pie" ) ) { + newShape->shape = sector_rgn; + if( nParams != 4 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !strcasecmp( namePtr, "point" ) ) { + newShape->shape = point_rgn; + if( nParams != 2 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !strcasecmp( namePtr, "line" ) ) { + newShape->shape = line_rgn; + if( nParams != 4 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 4; + } else if( !strcasecmp( namePtr, "polygon" ) ) { + newShape->shape = poly_rgn; + if( nParams < 6 || (nParams&1) ) + *status = PARSE_SYNTAX_ERR; + nCoords = nParams; + } else { + ffpmsg( "Unrecognized region found in region file:" ); + ffpmsg( namePtr ); + *status = PARSE_SYNTAX_ERR; + goto error; + } + if( *status ) { + ffpmsg( "Wrong number of parameters found for region" ); + ffpmsg( namePtr ); + goto error; + } + + /* Parse Parameter string... convert to pixels if necessary */ + + if( newShape->shape==poly_rgn ) { + newShape->param.poly.Pts = (double *)malloc( nParams + * sizeof(double) ); + if( !newShape->param.poly.Pts ) { + ffpmsg( + "Could not allocate memory to hold polygon parameters" ); + *status = MEMORY_ALLOCATION; + goto error; + } + newShape->param.poly.nPts = nParams; + coords = newShape->param.poly.Pts; + } else + coords = newShape->param.gen.p; + + /* Parse the initial "WCS?" coordinates */ + for( i=0; iexists ) { + ffpmsg("WCS information needed to convert region coordinates."); + *status = NO_WCS_KEY; + goto error; + } + + if( ffxypx( X, Y, wcs->xrefval, wcs->yrefval, + wcs->xrefpix, wcs->yrefpix, + wcs->xinc, wcs->yinc, + wcs->rot, wcs->type, + &x, &y, status ) ) { + ffpmsg("Error converting region to pixel coordinates."); + goto error; + } + X = x; Y = y; + } + coords[i] = X; + coords[i+1] = Y; + } + + /* Read in remaining parameters... */ + + for( ; ixrefval, wcs->yrefval, + wcs->xrefpix, wcs->yrefpix, + wcs->xinc, wcs->yinc, + wcs->rot, wcs->type, + &x, &y, status ) ) { + ffpmsg("Error converting region to pixel coordinates."); + goto error; + } + + coords[i] = sqrt( pow(x-coords[0],2) + pow(y-coords[1],2) ); + + } else if (endp && *endp=='\'') { + /* parameter given in arcmin so convert to pixels. */ + /* Increment first Y coordinate by this amount, then calc */ + /* the distance in pixels from the original coordinate. */ + /* NOTE: This assumes the pixels are square!! */ + if (ysave < 0.) + Y = ysave + coords[i]/60.; /* don't exceed -90 */ + else + Y = ysave - coords[i]/60.; /* don't exceed +90 */ + + X = xsave; + if( ffxypx( X, Y, wcs->xrefval, wcs->yrefval, + wcs->xrefpix, wcs->yrefpix, + wcs->xinc, wcs->yinc, + wcs->rot, wcs->type, + &x, &y, status ) ) { + ffpmsg("Error converting region to pixel coordinates."); + goto error; + } + + coords[i] = sqrt( pow(x-coords[0],2) + pow(y-coords[1],2) ); + + } else if (endp && *endp=='d') { + /* parameter given in degrees so convert to pixels. */ + /* Increment first Y coordinate by this amount, then calc */ + /* the distance in pixels from the original coordinate. */ + /* NOTE: This assumes the pixels are square!! */ + if (ysave < 0.) + Y = ysave + coords[i]; /* don't exceed -90 */ + else + Y = ysave - coords[i]; /* don't exceed +90 */ + + X = xsave; + if( ffxypx( X, Y, wcs->xrefval, wcs->yrefval, + wcs->xrefpix, wcs->yrefpix, + wcs->xinc, wcs->yinc, + wcs->rot, wcs->type, + &x, &y, status ) ) { + ffpmsg("Error converting region to pixel coordinates."); + goto error; + } + + coords[i] = sqrt( pow(x-coords[0],2) + pow(y-coords[1],2) ); + } + } + + /* Perform some useful calculations now to speed up filter later */ + + switch( newShape->shape ) { + case circle_rgn: + newShape->param.gen.a = coords[2] * coords[2]; + break; + case annulus_rgn: + newShape->param.gen.a = coords[2] * coords[2]; + newShape->param.gen.b = coords[3] * coords[3]; + break; + case sector_rgn: + while( coords[2]> 180.0 ) coords[2] -= 360.0; + while( coords[2]<=-180.0 ) coords[2] += 360.0; + while( coords[3]> 180.0 ) coords[3] -= 360.0; + while( coords[3]<=-180.0 ) coords[3] += 360.0; + break; + case ellipse_rgn: + newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) ); + newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) ); + break; + case elliptannulus_rgn: + newShape->param.gen.a = sin( myPI * (coords[6] / 180.0) ); + newShape->param.gen.b = cos( myPI * (coords[6] / 180.0) ); + newShape->param.gen.sinT = sin( myPI * (coords[7] / 180.0) ); + newShape->param.gen.cosT = cos( myPI * (coords[7] / 180.0) ); + break; + case box_rgn: + newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) ); + newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) ); + break; + case rectangle_rgn: + newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) ); + newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) ); + X = 0.5 * ( coords[2]-coords[0] ); + Y = 0.5 * ( coords[3]-coords[1] ); + newShape->param.gen.a = fabs( X * newShape->param.gen.cosT + + Y * newShape->param.gen.sinT ); + newShape->param.gen.b = fabs( Y * newShape->param.gen.cosT + - X * newShape->param.gen.sinT ); + newShape->param.gen.p[5] = 0.5 * ( coords[2]+coords[0] ); + newShape->param.gen.p[6] = 0.5 * ( coords[3]+coords[1] ); + break; + case diamond_rgn: + newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) ); + newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) ); + break; + case line_rgn: + X = coords[2] - coords[0]; + Y = coords[3] - coords[1]; + R = sqrt( X*X + Y*Y ); + newShape->param.gen.sinT = ( R ? Y/R : 0.0 ); + newShape->param.gen.cosT = ( R ? X/R : 1.0 ); + newShape->param.gen.a = R + 0.5; + break; + case point_rgn: + break; + case poly_rgn: + /* Find bounding box */ + newShape->param.poly.xmin = coords[0]; + newShape->param.poly.xmax = coords[0]; + newShape->param.poly.ymin = coords[1]; + newShape->param.poly.ymax = coords[1]; + for( i=2; iparam.poly.xmin > coords[i] ) /* Min X */ + newShape->param.poly.xmin = coords[i]; + if( newShape->param.poly.xmax < coords[i] ) /* Max X */ + newShape->param.poly.xmax = coords[i]; + i++; + if( newShape->param.poly.ymin > coords[i] ) /* Min Y */ + newShape->param.poly.ymin = coords[i]; + if( newShape->param.poly.ymax < coords[i] ) /* Max Y */ + newShape->param.poly.ymax = coords[i]; + i++; + } + break; + } + + } /* End of while( *currLoc ) */ +/* + if (coords)printf("%.8f %.8f %.8f %.8f %.8f\n", + coords[0],coords[1],coords[2],coords[3],coords[4]); +*/ + } /* End of if...else parse line */ + } /* End of while( fgets(rgnFile) ) */ + + +error: + + if( *status ) + fits_free_region( aRgn ); + else + *Rgn = aRgn; + + fclose( rgnFile ); + free( currLine ); + + return( *status ); +} + +/*---------------------------------------------------------------------------*/ +int fftrgn( double X, + double Y, + SAORegion *Rgn ) +/* Test if the given point is within the region described by Rgn. X and */ +/* Y are in pixel coordinates. */ +/*---------------------------------------------------------------------------*/ +{ + double x, y, dx, dy, xprime, yprime, r; + RgnShape *Shapes; + int i; + int result = 0; + + Shapes = Rgn->Shapes; + + /* if an excluded region is given first, then implicitly */ + /* assume a previous shape that includes the entire image. */ + if (!Shapes->sign) + result = 1; + + for( i=0; inShapes; i++, Shapes++ ) { + + /* only need to test if */ + /* the point is not already included and this is an include region, */ + /* or the point is included and this is an excluded region */ + + if ( (!result && Shapes->sign) || (result && !Shapes->sign) ) { + + result = 1; + + switch( Shapes->shape ) { + + case box_rgn: + /* Shift origin to center of region */ + xprime = X - Shapes->param.gen.p[0]; + yprime = Y - Shapes->param.gen.p[1]; + + /* Rotate point to region's orientation */ + x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT; + y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT; + + dx = 0.5 * Shapes->param.gen.p[2]; + dy = 0.5 * Shapes->param.gen.p[3]; + if( (x < -dx) || (x > dx) || (y < -dy) || (y > dy) ) + result = 0; + break; + + case rectangle_rgn: + /* Shift origin to center of region */ + xprime = X - Shapes->param.gen.p[5]; + yprime = Y - Shapes->param.gen.p[6]; + + /* Rotate point to region's orientation */ + x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT; + y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT; + + dx = Shapes->param.gen.a; + dy = Shapes->param.gen.b; + if( (x < -dx) || (x > dx) || (y < -dy) || (y > dy) ) + result = 0; + break; + + case diamond_rgn: + /* Shift origin to center of region */ + xprime = X - Shapes->param.gen.p[0]; + yprime = Y - Shapes->param.gen.p[1]; + + /* Rotate point to region's orientation */ + x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT; + y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT; + + dx = 0.5 * Shapes->param.gen.p[2]; + dy = 0.5 * Shapes->param.gen.p[3]; + r = fabs(x/dx) + fabs(y/dy); + if( r > 1 ) + result = 0; + break; + + case circle_rgn: + /* Shift origin to center of region */ + x = X - Shapes->param.gen.p[0]; + y = Y - Shapes->param.gen.p[1]; + + r = x*x + y*y; + if ( r > Shapes->param.gen.a ) + result = 0; + break; + + case annulus_rgn: + /* Shift origin to center of region */ + x = X - Shapes->param.gen.p[0]; + y = Y - Shapes->param.gen.p[1]; + + r = x*x + y*y; + if ( r < Shapes->param.gen.a || r > Shapes->param.gen.b ) + result = 0; + break; + + case sector_rgn: + /* Shift origin to center of region */ + x = X - Shapes->param.gen.p[0]; + y = Y - Shapes->param.gen.p[1]; + + if( x || y ) { + r = atan2( y, x ) * 180.0 / myPI; + if( Shapes->param.gen.p[2] <= Shapes->param.gen.p[3] ) { + if( r < Shapes->param.gen.p[2] || r > Shapes->param.gen.p[3] ) + result = 0; + } else { + if( r < Shapes->param.gen.p[2] && r > Shapes->param.gen.p[3] ) + result = 0; + } + } + break; + + case ellipse_rgn: + /* Shift origin to center of region */ + xprime = X - Shapes->param.gen.p[0]; + yprime = Y - Shapes->param.gen.p[1]; + + /* Rotate point to region's orientation */ + x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT; + y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT; + + x /= Shapes->param.gen.p[2]; + y /= Shapes->param.gen.p[3]; + r = x*x + y*y; + if( r>1.0 ) + result = 0; + break; + + case elliptannulus_rgn: + /* Shift origin to center of region */ + xprime = X - Shapes->param.gen.p[0]; + yprime = Y - Shapes->param.gen.p[1]; + + /* Rotate point to outer ellipse's orientation */ + x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT; + y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT; + + x /= Shapes->param.gen.p[4]; + y /= Shapes->param.gen.p[5]; + r = x*x + y*y; + if( r>1.0 ) + result = 0; + else { + /* Repeat test for inner ellipse */ + x = xprime * Shapes->param.gen.b + yprime * Shapes->param.gen.a; + y = -xprime * Shapes->param.gen.a + yprime * Shapes->param.gen.b; + + x /= Shapes->param.gen.p[2]; + y /= Shapes->param.gen.p[3]; + r = x*x + y*y; + if( r<1.0 ) + result = 0; + } + break; + + case line_rgn: + /* Shift origin to first point of line */ + xprime = X - Shapes->param.gen.p[0]; + yprime = Y - Shapes->param.gen.p[1]; + + /* Rotate point to line's orientation */ + x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT; + y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT; + + if( (y < -0.5) || (y >= 0.5) || (x < -0.5) + || (x >= Shapes->param.gen.a) ) + result = 0; + break; + + case point_rgn: + /* Shift origin to center of region */ + x = X - Shapes->param.gen.p[0]; + y = Y - Shapes->param.gen.p[1]; + + if ( (x<-0.5) || (x>=0.5) || (y<-0.5) || (y>=0.5) ) + result = 0; + break; + + case poly_rgn: + if( Xparam.poly.xmin || X>Shapes->param.poly.xmax + || Yparam.poly.ymin || Y>Shapes->param.poly.ymax ) + result = 0; + else + result = Pt_in_Poly( X, Y, Shapes->param.poly.nPts, + Shapes->param.poly.Pts ); + break; + } + + if( !Shapes->sign ) result = !result; + + } + } + + return( result ); +} + +/*---------------------------------------------------------------------------*/ +void fffrgn( SAORegion *Rgn ) +/* Free up memory allocated to hold the region data. */ +/*---------------------------------------------------------------------------*/ +{ + int i; + + for( i=0; inShapes; i++ ) + if( Rgn->Shapes[i].shape == poly_rgn ) + free( Rgn->Shapes[i].param.poly.Pts ); + if( Rgn->Shapes ) + free( Rgn->Shapes ); + free( Rgn ); +} + +/*---------------------------------------------------------------------------*/ +static int Pt_in_Poly( double x, + double y, + int nPts, + double *Pts ) +/* Internal routine for testing whether the coordinate x,y is within the */ +/* polygon region traced out by the array Pts. */ +/*---------------------------------------------------------------------------*/ +{ + int i, j, flag=0; + double prevX, prevY; + double nextX, nextY; + double dx, dy, Dy; + + nextX = Pts[nPts-2]; + nextY = Pts[nPts-1]; + + for( i=0; iprevY && y>=nextY) || (yprevX && x>=nextX) ) + continue; + + /* Check to see if x,y lies right on the segment */ + + if( x>=prevX || x>nextX ) { + dy = y - prevY; + Dy = nextY - prevY; + + if( fabs(Dy)<1e-10 ) { + if( fabs(dy)<1e-10 ) + return( 1 ); + else + continue; + } + + dx = prevX + ( (nextX-prevX)/(Dy) ) * dy - x; + if( dx < -1e-10 ) + continue; + if( dx < 1e-10 ) + return( 1 ); + } + + /* There is an intersection! Make sure it isn't a V point. */ + + if( y != prevY ) { + flag = 1 - flag; + } else { + j = i+1; /* Point to Y component */ + do { + if( j>1 ) + j -= 2; + else + j = nPts-1; + } while( y == Pts[j] ); + + if( (nextY-y)*(y-Pts[j]) > 0 ) + flag = 1-flag; + } + + } + return( flag ); +} + diff --git a/pkg/tbtables/cfitsio/region.h b/pkg/tbtables/cfitsio/region.h new file mode 100644 index 00000000..4d7c96c9 --- /dev/null +++ b/pkg/tbtables/cfitsio/region.h @@ -0,0 +1,80 @@ +/***************************************************************/ +/* REGION STUFF */ +/***************************************************************/ + +#define myPI 3.1415926535897932385 + +typedef struct { + int exists; + double xrefval, yrefval; + double xrefpix, yrefpix; + double xinc, yinc; + double rot; + char type[6]; +} WCSdata; + +typedef enum { + point_rgn, + line_rgn, + circle_rgn, + annulus_rgn, + ellipse_rgn, + elliptannulus_rgn, + box_rgn, + rectangle_rgn, + diamond_rgn, + sector_rgn, + poly_rgn +} shapeType; + +typedef enum { pixel_fmt, degree_fmt, hhmmss_fmt } coordFmt; + +typedef struct { + char sign; /* Include or exclude? */ + shapeType shape; /* Shape of this region */ + + union { /* Parameters - In pixels */ + + /**** Generic Shape Data ****/ + + struct { + double p[8]; /* Region parameters */ + double sinT, cosT; /* For rotated shapes */ + double a, b; /* Extra scratch area */ + } gen; + + /**** Polygon Data ****/ + + struct { + int nPts; /* Number of Polygon pts */ + double *Pts; /* Polygon points */ + double xmin,xmax; /* Polygon bounding box */ + double ymin,ymax; + } poly; + + } param; + +} RgnShape; + +typedef struct { + int nShapes; + RgnShape *Shapes; + WCSdata wcs; +} SAORegion; + +#ifdef __cplusplus +extern "C" { +#endif + +int ffrrgn( const char *filename, WCSdata *wcs, SAORegion **Rgn, int *status ); +int fftrgn( double X, double Y, SAORegion *Rgn ); +void fffrgn( SAORegion *Rgn ); + +#ifdef __cplusplus + } +#endif + +#define fits_read_rgnfile ffrrgn +#define fits_in_region fftrgn +#define fits_free_region fffrgn + diff --git a/pkg/tbtables/cfitsio/ricecomp.c b/pkg/tbtables/cfitsio/ricecomp.c new file mode 100644 index 00000000..bd184ea1 --- /dev/null +++ b/pkg/tbtables/cfitsio/ricecomp.c @@ -0,0 +1,510 @@ +/* + The following code was written by Richard White at STScI and made + available for use in CFITSIO in July 1999. These routines were + originally contained in 2 source files: rcomp.c and rdecomp.c, + and the 'include' file now called ricecomp.h was originally called buffer.h. +*/ + +/*----------------------------------------------------------*/ +/* */ +/* START OF SOURCE FILE ORIGINALLY CALLED rcomp.c */ +/* */ +/*----------------------------------------------------------*/ +/* @(#) rcomp.c 1.5 99/03/01 12:40:27 */ +/* rcomp.c Compress image line using + * (1) Difference of adjacent pixels + * (2) Rice algorithm coding + * + * Returns number of bytes written to code buffer or + * -1 on failure + */ + +#include +#include +#include +#include "ricecomp.h" /* originally included in rcomp.c file (WDP) */ +#include "fitsio2.h" + + +static void start_outputing_bits(Buffer *buffer); +static int done_outputing_bits(Buffer *buffer); +static int output_nbits(Buffer *buffer, int bits, int n); + +/* this routine used to be called 'rcomp' (WDP) */ + +int fits_rcomp(int a[], /* input array */ + int nx, /* number of input pixels */ + unsigned char *c, /* output buffer */ + int clen, /* max length of output */ + int nblock) /* coding block size */ +{ +Buffer bufmem, *buffer = &bufmem; +int bsize, i, j, thisblock; +int lastpix, nextpix, pdiff; +int v, fs, fsmask, top, fsmax, fsbits, bbits; +int lbitbuffer, lbits_to_go; +unsigned int psum; +double pixelsum, dpsum; +unsigned int *diff; + + /* + * Original size of each pixel (bsize, bytes) and coding block + * size (nblock, pixels) + * Could make bsize a parameter to allow more efficient + * compression of short & byte images. + */ + bsize = 4; +/* nblock = 32; */ + /* + * From bsize derive: + * FSBITS = # bits required to store FS + * FSMAX = maximum value for FS + * BBITS = bits/pixel for direct coding + */ + switch (bsize) { + case 1: + fsbits = 3; + fsmax = 6; + break; + case 2: + fsbits = 4; + fsmax = 14; + break; + case 4: + fsbits = 5; + fsmax = 25; + break; + default: + ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes"); + return(-1); + } + bbits = 1<start = c; + buffer->current = c; + buffer->end = c+clen; + buffer->bits_to_go = 8; + /* + * array for differences mapped to non-negative values + */ + diff = (unsigned int *) malloc(nblock*sizeof(unsigned int)); + if (diff == (unsigned int *) NULL) { + ffpmsg("fits_rcomp: insufficient memory"); + return(-1); + } + /* + * Code in blocks of nblock pixels + */ + start_outputing_bits(buffer); + + /* write out first int value to the first 4 bytes of the buffer */ + if (output_nbits(buffer, a[0], 32) == EOF) { + ffpmsg("rice_encode: end of buffer"); + free(diff); + return(-1); + } + + lastpix = a[0]; /* the first difference will always be zero */ + + thisblock = nblock; + for (i=0; i> 1; + for (fs = 0; psum>0; fs++) psum >>= 1; + /* + * write the codes + * fsbits ID bits used to indicate split level + */ + if (fs >= fsmax) { + /* Special high entropy case when FS >= fsmax + * Just write pixel difference values directly, no Rice coding at all. + */ + if (output_nbits(buffer, fsmax+1, fsbits) == EOF) { + ffpmsg("rice_encode: end of buffer"); + free(diff); + return(-1); + } + for (j=0; jbitbuffer; + lbits_to_go = buffer->bits_to_go; + for (j=0; j> fs; + /* + * top is coded by top zeros + 1 + */ + if (lbits_to_go >= top+1) { + lbitbuffer <<= top+1; + lbitbuffer |= 1; + lbits_to_go -= top+1; + } else { + lbitbuffer <<= lbits_to_go; + if (putcbuf(lbitbuffer & 0xff,buffer) == EOF) { + ffpmsg("rice_encode: end of buffer"); + free(diff); + return(-1); + } + for (top -= lbits_to_go; top>=8; top -= 8) { + if (putcbuf(0, buffer) == EOF) { + ffpmsg("rice_encode: end of buffer"); + free(diff); + return(-1); + } + } + lbitbuffer = 1; + lbits_to_go = 7-top; + } + /* + * bottom FS bits are written without coding + * code is output_nbits, moved into this routine to reduce overheads + * This code potentially breaks if FS>24, so I am limiting + * FS to 24 by choice of FSMAX above. + */ + if (fs > 0) { + lbitbuffer <<= fs; + lbitbuffer |= v & fsmask; + lbits_to_go -= fs; + while (lbits_to_go <= 0) { + if (putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer)==EOF) { + ffpmsg("rice_encode: end of buffer"); + free(diff); + return(-1); + } + lbits_to_go += 8; + } + } + } + buffer->bitbuffer = lbitbuffer; + buffer->bits_to_go = lbits_to_go; + } + } + done_outputing_bits(buffer); + free(diff); + /* + * return number of bytes used + */ + return(buffer->current - buffer->start); +} +/*---------------------------------------------------------------------------*/ +/* bit_output.c + * + * Bit output routines + * Procedures return zero on success, EOF on end-of-buffer + * + * Programmer: R. White Date: 20 July 1998 + */ + +/* Initialize for bit output */ + +static void start_outputing_bits(Buffer *buffer) +{ + /* + * Buffer is empty to start with + */ + buffer->bitbuffer = 0; + buffer->bits_to_go = 8; +} + +/*---------------------------------------------------------------------------*/ +/* Output N bits (N must be <= 32) */ + +static int output_nbits(Buffer *buffer, int bits, int n) +{ +/* local copies */ +int lbitbuffer; +int lbits_to_go; + + /* + * insert bits at end of bitbuffer + */ + lbitbuffer = buffer->bitbuffer; + lbits_to_go = buffer->bits_to_go; + if (lbits_to_go+n > 32) { + /* + * special case for large n: put out the top lbits_to_go bits first + * note that 0 < lbits_to_go <= 8 + */ + lbitbuffer <<= lbits_to_go; + lbitbuffer |= (bits>>(n-lbits_to_go)) & ((1<>(-lbits_to_go)) & 0xff,buffer) == EOF) + return(EOF); + lbits_to_go += 8; + } + buffer->bitbuffer = lbitbuffer; + buffer->bits_to_go = lbits_to_go; + return(0); +} + +/*---------------------------------------------------------------------------*/ +/* Flush out the last bits */ + +static int done_outputing_bits(Buffer *buffer) +{ + if(buffer->bits_to_go < 8) { + if (putcbuf(buffer->bitbuffer<bits_to_go,buffer) == EOF) + return(EOF); + } + return(0); +} +/*---------------------------------------------------------------------------*/ +/*----------------------------------------------------------*/ +/* */ +/* START OF SOURCE FILE ORIGINALLY CALLED rdecomp.c */ +/* */ +/*----------------------------------------------------------*/ + +/* @(#) rdecomp.c 1.4 99/03/01 12:38:41 */ +/* rdecomp.c Decompress image line using + * (1) Difference of adjacent pixels + * (2) Rice algorithm coding + * + * Returns 0 on success or 1 on failure + */ + +/* moved these 'includes' to the beginning of the file (WDP) +#include +#include +*/ + +/* this routine used to be called 'rdecomp' (WDP) */ + +int fits_rdecomp (unsigned char *c, /* input buffer */ + int clen, /* length of input */ + unsigned int array[], /* output array */ + int nx, /* number of output pixels */ + int nblock) /* coding block size */ +{ +int bsize, i, k, imax; +int nbits, nzero, fs; +unsigned char *cend, bytevalue; +unsigned int b, diff, lastpix; +int fsmax, fsbits, bbits; +static int *nonzero_count = (int *)NULL; + + /* + * Original size of each pixel (bsize, bytes) and coding block + * size (nblock, pixels) + * Could make bsize a parameter to allow more efficient + * compression of short & byte images. + */ + bsize = 4; +/* nblock = 32; */ + /* + * From bsize derive: + * FSBITS = # bits required to store FS + * FSMAX = maximum value for FS + * BBITS = bits/pixel for direct coding + */ + switch (bsize) { + case 1: + fsbits = 3; + fsmax = 6; + break; + case 2: + fsbits = 4; + fsmax = 14; + break; + case 4: + fsbits = 5; + fsmax = 25; + break; + default: + ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes"); + return 1; + } + bbits = 1<=0; ) { + for ( ; i>=k; i--) nonzero_count[i] = nzero; + k = k/2; + nzero--; + } + } + /* + * Decode in blocks of nblock pixels + */ + + /* first 4 bytes of input buffer contain the value of the first */ + /* 4 byte integer value, without any encoding */ + + lastpix = 0; + bytevalue = c[0]; + lastpix = lastpix | (bytevalue<<24); + bytevalue = c[1]; + lastpix = lastpix | (bytevalue<<16); + bytevalue = c[2]; + lastpix = lastpix | (bytevalue<<8); + bytevalue = c[3]; + lastpix = lastpix | bytevalue; + + c += 4; + cend = c + clen - 4; + + b = *c++; /* bit buffer */ + nbits = 8; /* number of bits remaining in b */ + for (i = 0; i> nbits) - 1; + b &= (1< nx) imax = nx; + if (fs<0) { + /* low-entropy case, all zero differences */ + for ( ; i= 0; k -= 8) { + b = *c++; + diff |= b<0) { + b = *c++; + diff |= b>>(-k); + b &= (1<>1; + } else { + diff = ~(diff>>1); + } + array[i] = diff+lastpix; + lastpix = array[i]; + } + } else { + /* normal case, Rice coding */ + for ( ; i>nbits); + b &= (1<>1; + } else { + diff = ~(diff>>1); + } + array[i] = diff+lastpix; + lastpix = array[i]; + } + } + if (c > cend) { + ffpmsg("decompression error: hit end of compressed byte stream"); + return 1; + } + } + if (c < cend) { + ffpmsg("decompression warning: unused bytes at end of compressed buffer"); + } + return 0; +} diff --git a/pkg/tbtables/cfitsio/ricecomp.h b/pkg/tbtables/cfitsio/ricecomp.h new file mode 100644 index 00000000..4a48328e --- /dev/null +++ b/pkg/tbtables/cfitsio/ricecomp.h @@ -0,0 +1,107 @@ +/* @(#) buffer.h 1.1 98/07/21 12:34:27 */ +/* buffer.h: structure for compression to buffer rather than to a file, including + * bit I/O buffer + * + * R. White, 19 June 1998 + */ + + +typedef unsigned char Buffer_t; + +typedef struct { + int bitbuffer; /* bit buffer */ + int bits_to_go; /* bits to go in buffer */ + Buffer_t *start; /* start of buffer */ + Buffer_t *current; /* current position in buffer */ + Buffer_t *end; /* end of buffer */ +} Buffer; + +#define buffree(mf) (free(mf->start), free(mf)) +#define bufused(mf) (mf->current - mf->start) +#define bufreset(mf) (mf->current = mf->start) + +/* + * getcbuf, putcbuf macros for character IO to buffer + * putcbuf returns EOF on end of buffer, else returns 0 + */ +#define getcbuf(mf) ((mf->current >= mf->end) ? EOF : *(mf->current)++) +#define putcbuf(c,mf) \ + ((mf->current >= mf->end) ? \ + EOF :\ + ((*(mf->current)++ = c), 0)) + +/* + * bufalloc sets up buffer of length n + */ + +/* not needed by CFITSIO + +static Buffer *bufalloc(int n) +{ +Buffer *mf; + + mf = (Buffer *) malloc(sizeof(Buffer)); + if (mf == (Buffer *)NULL) return((Buffer *)NULL); + + mf->start = (Buffer_t *) malloc(n*sizeof(Buffer_t)); + if (mf->start == (Buffer_t *)NULL) { + free(mf); + return((Buffer *)NULL); + } + mf->bits_to_go = 8; + mf->end = mf->start + n; + mf->current = mf->start; + return(mf); +} +*/ + +/* + * bufrealloc extends buffer (or truncates it) by + * reallocating memory + */ + +/* not needed by CFITSIO +static int bufrealloc(Buffer *mf, int n) +{ +int len; + + len = mf->current - mf->start; + + * silently throw away data if buffer is already longer than n * + if (len>n) len = n; + if (len<0) len = 0; + + mf->start = (Buffer_t *) realloc(mf->start, n*sizeof(Buffer_t)); + if (mf->start == (Buffer_t *)NULL) return(0); + + mf->end = mf->start + n; + mf->current = mf->start + len; + return(n); +} +*/ + +/* + * bufdump dumps contents of buffer to outfile and resets + * it to be empty. Returns number of bytes written. + * + * Note we don't write out the bit buffer -- you must call + * done_outputing_bits() first to ensure that the bit buffer + * is written out. I do it this way to allow incremental + * buffer dumps while bit IO is still going on. + */ + +/* not needed by CFITSIO + +static int bufdump(FILE *outfile, Buffer *buffer) +{ +int ndump; + + ndump = bufused(buffer); + if (fwrite(buffer->start, 1, ndump, outfile) != ndump) { + fprintf(stderr, "bufdump: error in write\n"); + exit(1); + } + bufreset(buffer); + return(ndump); +} +*/ diff --git a/pkg/tbtables/cfitsio/sample.tpl b/pkg/tbtables/cfitsio/sample.tpl new file mode 100644 index 00000000..8cfca14e --- /dev/null +++ b/pkg/tbtables/cfitsio/sample.tpl @@ -0,0 +1,121 @@ +# sample template - create 9 HDUs in one FITS file + +# syntax : + +# everything which starts with a hashmark is ignored +# the same for empty lines + +# one can use \include filename to include other files +# equal sign after keyword name is optional +# \group must be terminated by \end +# xtension is terminated by \group, xtension or EOF +# First HDU of type image may be defined using "SIMPLE T" +# group may contain other groups and xtensions +# keywords may be indented, but indentation is limited to max 7chars. + +# template parser processes all keywords, makes substitutions +# when necessary (hashmarks -> index), converts keyword names +# to uppercase and writes keywords to file. +# For string keywords, parser uses CFITSIO long string routines +# to store string values longer than 72 characters. Parser can +# read/process lines of any length, as long as there is enough memory. +# For a very limited set of keywords (like NAXIS1 for binary tables) +# template parser ignores values specified in template file +# (one should not specify NAXIS1 for binary tables) and computes and +# writes values respective to table structure. +# number of rows in binary/ascii tables can be specified with NAXIS2 + +# if the 1st HDU is not defined with "SIMPLE T" and is defined with +# xtension image/asciitable/bintable then dummy primary HDU is +# created by parser. + +simple t + bitpix 16 + naxis 1 + naxis1 10 +COMMENT + comment + sdsdf / keyword without value (null type) + if line begins with 8+ spaces everything is a comment + +xtension image + bitpix 16 + naxis 1 + naxis1 10 + QWERW F / dfg dfgsd fg - boolean keyword + FFFSDS45 3454345 /integer_or_real keyword + SSSDFS34 32345.453 / real keyword + adsfd34 (234234.34,2342342.3) / complex keyword - no space between () + SDFDF# adfasdfasdfdfcvxccvzxcvcvcxv / autoindexed keyword, here idx=1 + SDFD# 'asf dfa dfad df dfad f ad fadfdaf dfdfa df loooooong keyyywoooord - reaaalllly verrrrrrrrrryy loooooooooong' / comment is max 80 chars + history history record, spaces (all but 1st) after keyname are copied + SDFDF# strg_value_without_spaces / autoindexed keyword, here idx=2 + comment comment record, spaces (all but 1st) after keyname are copied + strg45 'sdfasdfadfffdfasdfasdfasdf &' + continue 'sdfsdfsdfsd fsdf' / 3 spaces must follow CONTINUE keyword + + +xtension image + bitpix 16 + naxis 1 + naxis1 10 + +\group + + xtension image + bitpix 16 + naxis 1 + naxis1 10 + +# create group inside group + + \group + +# one can specify additional columns in group HDU. The first column +# specified will have index 7 however, since the first 6 columns are occupied +# by grouping table itself. +# Please note, that it is not allowed to specify EXTNAME keyword as an +# additional keyword for group HDU, since parser automatically writes +# EXTNAME = GROUPING keyword. + + TFORM# 13A + TTYPE# ADDIT_COL_IN_GRP_HDU + TFORM# 1E + TTYPE# REAL_COLUMN + COMMENT sure, there is always place for comments + +# the following specifies empty ascii table (0 cols / 0 rows) + + xtension asciitable + + \end + +\end + +# one do not have to specify all NAXISn keywords. If not specified +# NAXISn equals zero. + +xtension image + bitpix 16 + naxis 1 +# naxis1 10 + +# the following tells how to set number of rows in binary table +# note also that the last line in template file does not have to +# have LineFeed character as the last one. + +xtension bintable +naxis2 10 +EXTNAME asdjfhsdkf +TTYPE# MEMBER_XTENSION +TFORM# 8A +TTYPE# MEMBER_2 +TFORM# 8U +TTYPE# MEMBER_3 +TFORM# 8V +TTYPE# MEMBER_NAME +TFORM# 32A +TDIM# '(8,4)' +TTYPE# MEMBER_VERSION +TFORM# 1J +TNULL# 0 \ No newline at end of file diff --git a/pkg/tbtables/cfitsio/scalnull.c b/pkg/tbtables/cfitsio/scalnull.c new file mode 100644 index 00000000..e602acf5 --- /dev/null +++ b/pkg/tbtables/cfitsio/scalnull.c @@ -0,0 +1,230 @@ +/* This file, scalnull.c, contains the FITSIO routines used to define */ +/* the starting heap address, the value scaling and the null values. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffpthp(fitsfile *fptr, /* I - FITS file pointer */ + long theap, /* I - starting addrss for the heap */ + int *status) /* IO - error status */ +/* + Define the starting address for the heap for a binary table. + The default address is NAXIS1 * NAXIS2. It is in units of + bytes relative to the beginning of the regular binary table data. + This routine also writes the appropriate THEAP keyword to the + FITS header. +*/ +{ + if (*status > 0 || theap < 1) + return(*status); + + /* reset position to the correct HDU if necessary */ + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + (fptr->Fptr)->heapstart = theap; + + ffukyj(fptr, "THEAP", theap, "byte offset to heap area", status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpscl(fitsfile *fptr, /* I - FITS file pointer */ + double scale, /* I - scaling factor: value of BSCALE */ + double zero, /* I - zero point: value of BZERO */ + int *status) /* IO - error status */ +/* + Define the linear scaling factor for the primary array or image extension + pixel values. This routine overrides the scaling values given by the + BSCALE and BZERO keywords if present. Note that this routine does not + write or modify the BSCALE and BZERO keywords, but instead only modifies + the values temporarily in the internal buffer. Thus, a subsequent call to + the ffrdef routine will reset the scaling back to the BSCALE and BZERO + keyword values (or 1. and 0. respectively if the keywords are not present). +*/ +{ + tcolumn *colptr; + int hdutype; + + if (*status > 0) + return(*status); + + if (scale == 0) + return(*status = ZERO_SCALE); /* zero scale value is illegal */ + + if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */ + return(*status); + + if (hdutype != IMAGE_HDU) + return(*status = NOT_IMAGE); /* not proper HDU type */ + + if (fits_is_compressed_image(fptr, status)) /* compressed images */ + { + (fptr->Fptr)->cn_bscale = scale; + (fptr->Fptr)->cn_bzero = zero; + + return(*status); + } + + /* set pointer to the first 'column' (contains group parameters if any) */ + colptr = (fptr->Fptr)->tableptr; + + colptr++; /* increment to the 2nd 'column' pointer (the image itself) */ + + colptr->tscale = scale; + colptr->tzero = zero; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpnul(fitsfile *fptr, /* I - FITS file pointer */ + long nulvalue, /* I - null pixel value: value of BLANK */ + int *status) /* IO - error status */ +/* + Define the value used to represent undefined pixels in the primary array or + image extension. This only applies to integer image pixel (i.e. BITPIX > 0). + This routine overrides the null pixel value given by the BLANK keyword + if present. Note that this routine does not write or modify the BLANK + keyword, but instead only modifies the value temporarily in the internal + buffer. Thus, a subsequent call to the ffrdef routine will reset the null + value back to the BLANK keyword value (or not defined if the keyword is not + present). +*/ +{ + tcolumn *colptr; + int hdutype; + + if (*status > 0) + return(*status); + + if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */ + return(*status); + + if (hdutype != IMAGE_HDU) + return(*status = NOT_IMAGE); /* not proper HDU type */ + + if (fits_is_compressed_image(fptr, status)) /* ignore compressed images */ + return(*status); + + /* set pointer to the first 'column' (contains group parameters if any) */ + colptr = (fptr->Fptr)->tableptr; + + colptr++; /* increment to the 2nd 'column' pointer (the image itself) */ + + colptr->tnull = nulvalue; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftscl(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number to apply scaling to */ + double scale, /* I - scaling factor: value of TSCALn */ + double zero, /* I - zero point: value of TZEROn */ + int *status) /* IO - error status */ +/* + Define the linear scaling factor for the TABLE or BINTABLE extension + column values. This routine overrides the scaling values given by the + TSCALn and TZEROn keywords if present. Note that this routine does not + write or modify the TSCALn and TZEROn keywords, but instead only modifies + the values temporarily in the internal buffer. Thus, a subsequent call to + the ffrdef routine will reset the scaling back to the TSCALn and TZEROn + keyword values (or 1. and 0. respectively if the keywords are not present). +*/ +{ + tcolumn *colptr; + int hdutype; + + if (*status > 0) + return(*status); + + if (scale == 0) + return(*status = ZERO_SCALE); /* zero scale value is illegal */ + + if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */ + return(*status); + + if (hdutype == IMAGE_HDU) + return(*status = NOT_TABLE); /* not proper HDU type */ + + colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */ + colptr += (colnum - 1); /* increment to the correct column */ + + colptr->tscale = scale; + colptr->tzero = zero; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fftnul(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number to apply nulvalue to */ + long nulvalue, /* I - null pixel value: value of TNULLn */ + int *status) /* IO - error status */ +/* + Define the value used to represent undefined pixels in the BINTABLE column. + This only applies to integer datatype columns (TFORM = B, I, or J). + This routine overrides the null pixel value given by the TNULLn keyword + if present. Note that this routine does not write or modify the TNULLn + keyword, but instead only modifies the value temporarily in the internal + buffer. Thus, a subsequent call to the ffrdef routine will reset the null + value back to the TNULLn keyword value (or not defined if the keyword is not + present). +*/ +{ + tcolumn *colptr; + int hdutype; + + if (*status > 0) + return(*status); + + if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */ + return(*status); + + if (hdutype != BINARY_TBL) + return(*status = NOT_BTABLE); /* not proper HDU type */ + + colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */ + colptr += (colnum - 1); /* increment to the correct column */ + + colptr->tnull = nulvalue; + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffsnul(fitsfile *fptr, /* I - FITS file pointer */ + int colnum, /* I - column number to apply nulvalue to */ + char *nulstring, /* I - null pixel value: value of TNULLn */ + int *status) /* IO - error status */ +/* + Define the string used to represent undefined pixels in the ASCII TABLE + column. This routine overrides the null value given by the TNULLn keyword + if present. Note that this routine does not write or modify the TNULLn + keyword, but instead only modifies the value temporarily in the internal + buffer. Thus, a subsequent call to the ffrdef routine will reset the null + value back to the TNULLn keyword value (or not defined if the keyword is not + present). +*/ +{ + tcolumn *colptr; + int hdutype; + + if (*status > 0) + return(*status); + + if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */ + return(*status); + + if (hdutype != ASCII_TBL) + return(*status = NOT_ATABLE); /* not proper HDU type */ + + colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */ + colptr += (colnum - 1); /* increment to the correct column */ + + colptr->strnull[0] = '\0'; + strncat(colptr->strnull, nulstring, 19); /* limit string to 19 chars */ + + return(*status); +} diff --git a/pkg/tbtables/cfitsio/smem.c b/pkg/tbtables/cfitsio/smem.c new file mode 100644 index 00000000..3cddb764 --- /dev/null +++ b/pkg/tbtables/cfitsio/smem.c @@ -0,0 +1,67 @@ +#include +#include +#include +#include +#include "fitsio.h" /* needed to define OFF_T */ +#include "drvrsmem.h" /* uses OFF_T */ + +int main(int argc, char **argv) +{ int cmdok, listmode, longlistmode, recovermode, deletemode, id; + +listmode = longlistmode = recovermode = deletemode = 0; +id = -1; +cmdok = 1; + +switch (argc) + { case 1: listmode = 1; + break; + case 2: + if (0 == strcmp("-l", argv[1])) longlistmode = 1; + else if (0 == strcmp("-r", argv[1])) recovermode = 1; + else if (0 == strcmp("-d", argv[1])) deletemode = 1; + else cmdok = 0; + break; + case 3: + if (0 == strcmp("-r", argv[1])) recovermode = 1; + else if (0 == strcmp("-d", argv[1])) deletemode = 1; + else + { cmdok = 0; /* signal invalid cmd line syntax */ + break; + } + if (1 != sscanf(argv[2], "%d", &id)) cmdok = 0; + break; + default: + cmdok = 0; + break; + } + +if (0 == cmdok) + { printf("usage :\n\n"); + printf("smem - list all shared memory segments\n"); + printf("\t!\tcouldn't obtain RDONLY lock - info unreliable\n"); + printf("\tIdx\thandle of shared memory segment (visible by application)\n"); + printf("\tKey\tcurrent system key of shared memory segment. Key\n"); + printf("\t\tchanges whenever shmem segment is reallocated. Use\n"); + printf("\t\tipcs (or ipcs -a) to view all shmem segments\n"); + printf("\tNproc\tnumber of processes attached to segment\n"); + printf("\tSize\tsize of shmem segment in bytes\n"); + printf("\tFlags\tRESIZABLE - realloc allowed, PERSIST - segment is not\n"); + printf("\t\tdeleted after shared_free called by last process attached\n"); + printf("\t\tto it.\n"); + printf("smem -d - delete all shared memory segments (may block)\n"); + printf("smem -d id - delete specific shared memory segment (may block)\n"); + printf("smem -r - unconditionally reset all shared memory segments\n\t\t(does not block, recovers zombie handles left by kill -9)\n"); + printf("smem -r id - unconditionally reset specific shared memory segment\n"); + } + +if (shared_init(0)) + { printf("couldn't initialize shared memory, aborting ...\n"); + return(10); + } + +if (listmode) shared_list(id); +else if (recovermode) shared_recover(id); +else if (deletemode) shared_uncond_delete(id); + +return(0); +} diff --git a/pkg/tbtables/cfitsio/speed.c b/pkg/tbtables/cfitsio/speed.c new file mode 100644 index 00000000..2a948b43 --- /dev/null +++ b/pkg/tbtables/cfitsio/speed.c @@ -0,0 +1,485 @@ +#include +#include +#include +#include + +/* + Every program which uses the CFITSIO interface must include the + the fitsio.h header file. This contains the prototypes for all + the routines and defines the error status values and other symbolic + constants used in the interface. +*/ +#include "fitsio.h" + +#define minvalue(A,B) ((A) < (B) ? (A) : (B)) + +/* size of the image */ +#define XSIZE 3000 +#define YSIZE 3000 + +/* size of data buffer */ +#define SHTSIZE 20000 +static long sarray[ SHTSIZE ] = {SHTSIZE * 0}; + +/* no. of rows in binary table */ +#define BROWS 2500000 + +/* no. of rows in ASCII table */ +#define AROWS 400000 + +/* CLOCKS_PER_SEC should be defined by most compilers */ +#if defined(CLOCKS_PER_SEC) +#define CLOCKTICKS CLOCKS_PER_SEC +#else +/* on SUN OS machine, CLOCKS_PER_SEC is not defined, so set its value */ +#define CLOCKTICKS 1000000 +#define difftime(A,B) ((double) A - (double) B) +#endif + +/* define variables for measuring elapsed time */ +clock_t scpu, ecpu; +time_t start, finish; + +int writeimage(fitsfile *fptr, int *status); +int writebintable(fitsfile *fptr, int *status); +int writeasctable(fitsfile *fptr, int *status); +int readimage(fitsfile *fptr, int *status); +int readatable(fitsfile *fptr, int *status); +int readbtable(fitsfile *fptr, int *status); +void printerror( int status); +int marktime(int *status); +int gettime(double *elapse, float *elapscpu, int *status); + +main() +{ +/************************************************************************* + This program tests the speed of writing/reading FITS files with cfitsio +**************************************************************************/ + + FILE *diskfile; + fitsfile *fptr; /* pointer to the FITS file, defined in fitsio.h */ + int status, ii; + long rawloop; + char filename[] = "speedcc.fit"; /* name for new FITS file */ + char buffer[2880] = {2880 * 0}; + time_t tbegin, tend; + float rate, size, elapcpu, cpufrac; + double elapse; + + tbegin = time(0); + + remove(filename); /* Delete old file if it already exists */ + + diskfile = fopen(filename,"w+b"); + rawloop = XSIZE * YSIZE / 720; + + printf(" "); + printf(" SIZE / ELAPSE(%%CPU) = RATE\n"); + printf("RAW fwrite (2880 bytes/loop)... "); + marktime(&status); + + for (ii = 0; ii < rawloop; ii++) + if (fwrite(buffer, 1, 2880, diskfile) != 2880) + printf("write error \n"); + + gettime(&elapse, &elapcpu, &status); + + cpufrac = elapcpu / elapse * 100.; + size = 2880. * rawloop / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + /* read back the binary records */ + fseek(diskfile, 0, 0); + + printf("RAW fread (2880 bytes/loop)... "); + marktime(&status); + + for (ii = 0; ii < rawloop; ii++) + if (fread(buffer, 1, 2880, diskfile) != 2880) + printf("read error \n"); + + gettime(&elapse, &elapcpu, &status); + + cpufrac = elapcpu / elapse * 100.; + size = 2880. * rawloop / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + fclose(diskfile); + remove(filename); + + status = 0; + fptr = 0; + + if (fits_create_file(&fptr, filename, &status)) /* create new FITS file */ + printerror( status); + + if (writeimage(fptr, &status)) + printerror( status); + + if (writebintable(fptr, &status)) + printerror( status); + + if (writeasctable(fptr, &status)) + printerror( status); + + if (readimage(fptr, &status)) + printerror( status); + + if (readbtable(fptr, &status)) + printerror( status); + + if (readatable(fptr, &status)) + printerror( status); + + if (fits_close_file(fptr, &status)) + printerror( status ); + + tend = time(0); + elapse = difftime(tend, tbegin) + 0.5; + printf("Total elapsed time = %.1fs, status = %d\n",elapse, status); + return(0); +} +/*--------------------------------------------------------------------------*/ +int writeimage(fitsfile *fptr, int *status) + + /**************************************************/ + /* write the primary array containing a 2-D image */ + /**************************************************/ +{ + long nremain, ii; + float rate, size, elapcpu, cpufrac; + double elapse; + + /* initialize FITS image parameters */ + int bitpix = 32; /* 32-bit signed integer pixel values */ + long naxis = 2; /* 2-dimensional image */ + long naxes[2] = {XSIZE, YSIZE }; /* image size */ + + /* write the required keywords for the primary array image */ + if ( fits_create_img(fptr, bitpix, naxis, naxes, status) ) + printerror( *status ); + + printf("\nWrite %dx%d I*4 image, %d pixels/loop: ",XSIZE,YSIZE,SHTSIZE); + marktime(status); + + nremain = XSIZE * YSIZE; + for (ii = 1; ii <= nremain; ii += SHTSIZE) + { + ffpprj(fptr, 0, ii, SHTSIZE, sarray, status); + } + + ffflus(fptr, status); /* flush all buffers to disk */ + + gettime(&elapse, &elapcpu, status); + + cpufrac = elapcpu / elapse * 100.; + size = XSIZE * 4. * YSIZE / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int writebintable (fitsfile *fptr, int *status) + + /*********************************************************/ + /* Create a binary table extension containing 3 columns */ + /*********************************************************/ +{ + int hdutype, tfields = 2; + long nremain, ntodo, firstrow = 1, firstelem = 1, nrows; + float rate, size, elapcpu, cpufrac; + double elapse; + + char extname[] = "Speed_Test"; /* extension name */ + + /* define the name, datatype, and physical units for the columns */ + char *ttype[] = { "first", "second" }; + char *tform[] = {"1J", "1J" }; + char *tunit[] = { " ", " " }; + + /* append a new empty binary table onto the FITS file */ + + if ( fits_create_tbl( fptr, BINARY_TBL, BROWS, tfields, ttype, tform, + tunit, extname, status) ) + printerror( *status ); + + /* get table row size and optimum number of rows to write per loop */ + fits_get_rowsize(fptr, &nrows, status); + nrows = minvalue(nrows, SHTSIZE); + nremain = BROWS; + + printf("Write %7drow x %dcol bintable %4d rows/loop:", BROWS, tfields, + nrows); + marktime(status); + + while(nremain) + { + ntodo = minvalue(nrows, nremain); + ffpclj(fptr, 1, firstrow, firstelem, ntodo, sarray, status); + ffpclj(fptr, 2, firstrow, firstelem, ntodo, sarray, status); + firstrow += ntodo; + nremain -= ntodo; + } + + ffflus(fptr, status); /* flush all buffers to disk */ + + gettime(&elapse, &elapcpu, status); + + cpufrac = elapcpu / elapse * 100.; + size = BROWS * 8. / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int writeasctable (fitsfile *fptr, int *status) + + /*********************************************************/ + /* Create an ASCII table extension containing 2 columns */ + /*********************************************************/ +{ + int hdutype, tfields = 2; + long nremain, ntodo, firstrow = 1, firstelem = 1; + long nrows; + float rate, size, elapcpu, cpufrac; + double elapse; + + char extname[] = "Speed_Test"; /* extension name */ + + /* define the name, datatype, and physical units for the columns */ + char *ttype[] = { "first", "second" }; + char *tform[] = {"I6", "I6" }; + char *tunit[] = { " ", " " }; + + /* append a new empty ASCII table onto the FITS file */ + if ( fits_create_tbl( fptr, ASCII_TBL, AROWS, tfields, ttype, tform, + tunit, extname, status) ) + printerror( *status ); + + /* get table row size and optimum number of rows to write per loop */ + fits_get_rowsize(fptr, &nrows, status); + nrows = minvalue(nrows, SHTSIZE); + nremain = AROWS; + + printf("Write %7drow x %dcol asctable %4d rows/loop:", AROWS, tfields, + nrows); + marktime(status); + + while(nremain) + { + ntodo = minvalue(nrows, nremain); + ffpclj(fptr, 1, firstrow, firstelem, ntodo, sarray, status); + ffpclj(fptr, 2, firstrow, firstelem, ntodo, sarray, status); + firstrow += ntodo; + nremain -= ntodo; + } + + ffflus(fptr, status); /* flush all buffers to disk */ + + gettime(&elapse, &elapcpu, status); + + cpufrac = elapcpu / elapse * 100.; + size = AROWS * 13. / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int readimage( fitsfile *fptr, int *status ) + + /*********************/ + /* Read a FITS image */ + /*********************/ +{ + int anynull, hdutype; + long nremain, ii; + long longnull = 0; + float rate, size, elapcpu, cpufrac; + double elapse; + + /* move to the primary array */ + if ( fits_movabs_hdu(fptr, 1, &hdutype, status) ) + printerror( *status ); + + printf("\nRead back image "); + marktime(status); + + nremain = XSIZE * YSIZE; + for (ii=1; ii <= nremain; ii += SHTSIZE) + { + ffgpvj(fptr, 0, ii, SHTSIZE, longnull, sarray, &anynull, status); + } + + gettime(&elapse, &elapcpu, status); + + cpufrac = elapcpu / elapse * 100.; + size = XSIZE * 4. * YSIZE / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int readbtable( fitsfile *fptr, int *status ) + + /************************************************************/ + /* read and print data values from the binary table */ + /************************************************************/ +{ + int hdutype, anynull; + long nremain, ntodo, firstrow = 1, firstelem = 1; + long nrows; + long lnull = 0; + float rate, size, elapcpu, cpufrac; + double elapse; + + /* move to the table */ + if ( fits_movrel_hdu(fptr, 1, &hdutype, status) ) + printerror( *status ); + + /* get table row size and optimum number of rows to read per loop */ + fits_get_rowsize(fptr, &nrows, status); + nrows = minvalue(nrows, SHTSIZE); + + /* read the columns */ + nremain = BROWS; + + printf("Read back BINTABLE "); + marktime(status); + + while(nremain) + { + ntodo = minvalue(nrows, nremain); + ffgcvj(fptr, 1, firstrow, firstelem, ntodo, + lnull, sarray, &anynull, status); + ffgcvj(fptr, 2, firstrow, firstelem, ntodo, + lnull, sarray, &anynull, status); + firstrow += ntodo; + nremain -= ntodo; + } + + gettime(&elapse, &elapcpu, status); + + cpufrac = elapcpu / elapse * 100.; + size = BROWS * 8. / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int readatable( fitsfile *fptr, int *status ) + + /************************************************************/ + /* read and print data values from an ASCII or binary table */ + /************************************************************/ +{ + int hdutype, anynull; + long nremain, ntodo, firstrow = 1, firstelem = 1; + long nrows; + long lnull = 0; + float rate, size, elapcpu, cpufrac; + double elapse; + + /* move to the table */ + if ( fits_movrel_hdu(fptr, 1, &hdutype, status) ) + printerror( *status ); + + /* get table row size and optimum number of rows to read per loop */ + fits_get_rowsize(fptr, &nrows, status); + nrows = minvalue(nrows, SHTSIZE); + + /* read the columns */ + nremain = AROWS; + + printf("Read back ASCII Table "); + marktime(status); + + while(nremain) + { + ntodo = minvalue(nrows, nremain); + ffgcvj(fptr, 1, firstrow, firstelem, ntodo, + lnull, sarray, &anynull, status); + ffgcvj(fptr, 2, firstrow, firstelem, ntodo, + lnull, sarray, &anynull, status); + firstrow += ntodo; + nremain -= ntodo; + } + + gettime(&elapse, &elapcpu, status); + + cpufrac = elapcpu / elapse * 100.; + size = AROWS * 13. / 1000000.; + rate = size / elapse; + printf(" %4.1fMB/%4.1fs(%3.0f) = %5.2fMB/s\n", size, elapse, cpufrac,rate); + + return( *status ); +} +/*--------------------------------------------------------------------------*/ +void printerror( int status) +{ + /*****************************************************/ + /* Print out cfitsio error messages and exit program */ + /*****************************************************/ + + char status_str[FLEN_STATUS], errmsg[FLEN_ERRMSG]; + + if (status) + fprintf(stderr, "\n*** Error occurred during program execution ***\n"); + + fits_get_errstatus(status, status_str); /* get the error description */ + fprintf(stderr, "\nstatus = %d: %s\n", status, status_str); + + /* get first message; null if stack is empty */ + if ( fits_read_errmsg(errmsg) ) + { + fprintf(stderr, "\nError message stack:\n"); + fprintf(stderr, " %s\n", errmsg); + + while ( fits_read_errmsg(errmsg) ) /* get remaining messages */ + fprintf(stderr, " %s\n", errmsg); + } + + exit( status ); /* terminate the program, returning error status */ +} +/*--------------------------------------------------------------------------*/ +int marktime( int *status) +{ + double telapse; + time_t temp; + + temp = time(0); + + /* Since elapsed time is only measured to the nearest second */ + /* keep getting the time until the seconds tick just changes. */ + /* This provides more consistent timing measurements since the */ + /* intervals all start on an integer seconds. */ + + telapse = 0.; + while (telapse == 0.) + { + scpu = clock(); + start = time(0); + telapse = difftime( start, temp ); + } + return( *status ); +} +/*--------------------------------------------------------------------------*/ +int gettime(double *elapse, float *elapscpu, int *status) +{ + clock_t ecpu; + time_t finish; + + ecpu = clock(); + finish = time(0); + + *elapse = difftime(finish, start) + 0.5; + *elapscpu = (ecpu - scpu) * 1.0 / CLOCKTICKS; + + return( *status ); +} diff --git a/pkg/tbtables/cfitsio/swapproc.c b/pkg/tbtables/cfitsio/swapproc.c new file mode 100644 index 00000000..247e4933 --- /dev/null +++ b/pkg/tbtables/cfitsio/swapproc.c @@ -0,0 +1,98 @@ +/* This file, swapproc.c, contains general utility routines that are */ +/* used by other FITSIO routines to swap bytes. */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +void ffswap2(short *svalues, /* IO - pointer to shorts to be swapped */ + long nvals) /* I - number of shorts to be swapped */ +/* + swap the bytes in the input short integers: ( 0 1 -> 1 0 ) +*/ +{ + register char *cvalues; + register long ii; + + union u_tag { + char cvals[2]; /* equivalence an array of 4 bytes with */ + short sval; /* a short */ + } u; + + cvalues = (char *) svalues; /* copy the initial pointer value */ + + for (ii = 0; ii < nvals;) + { + u.sval = svalues[ii++]; /* copy next short to temporary buffer */ + + *cvalues++ = u.cvals[1]; /* copy the 2 bytes to output in turn */ + *cvalues++ = u.cvals[0]; + } + return; +} +/*--------------------------------------------------------------------------*/ +void ffswap4(INT32BIT *ivalues, /* IO - pointer to floats to be swapped */ + long nvals) /* I - number of floats to be swapped */ +/* + swap the bytes in the input 4-byte integer: ( 0 1 2 3 -> 3 2 1 0 ) +*/ +{ + register char *cvalues; + register long ii; + + union u_tag { + char cvals[4]; /* equivalence an array of 4 bytes with */ + INT32BIT ival; /* a float */ + } u; + + cvalues = (char *) ivalues; /* copy the initial pointer value */ + + for (ii = 0; ii < nvals;) + { + u.ival = ivalues[ii++]; /* copy next float to buffer */ + + *cvalues++ = u.cvals[3]; /* copy the 4 bytes in turn */ + *cvalues++ = u.cvals[2]; + *cvalues++ = u.cvals[1]; + *cvalues++ = u.cvals[0]; + } + return; +} +/*--------------------------------------------------------------------------*/ +void ffswap8(double *dvalues, /* IO - pointer to doubles to be swapped */ + long nvals) /* I - number of doubles to be swapped */ +/* + swap the bytes in the input doubles: ( 01234567 -> 76543210 ) +*/ +{ + register char *cvalues; + register long ii; + register char temp; + + cvalues = (char *) dvalues; /* copy the pointer value */ + + for (ii = 0; ii < nvals*8; ii += 8) + { + temp = cvalues[ii]; + cvalues[ii] = cvalues[ii+7]; + cvalues[ii+7] = temp; + + temp = cvalues[ii+1]; + cvalues[ii+1] = cvalues[ii+6]; + cvalues[ii+6] = temp; + + temp = cvalues[ii+2]; + cvalues[ii+2] = cvalues[ii+5]; + cvalues[ii+5] = temp; + + temp = cvalues[ii+3]; + cvalues[ii+3] = cvalues[ii+4]; + cvalues[ii+4] = temp; + } + return; +} + diff --git a/pkg/tbtables/cfitsio/testf77.f b/pkg/tbtables/cfitsio/testf77.f new file mode 100644 index 00000000..ac3bc217 --- /dev/null +++ b/pkg/tbtables/cfitsio/testf77.f @@ -0,0 +1,2488 @@ +C This is a big and complicated program that tests most of +C the fitsio routines. This code does not represent +C the most efficient method of reading or writing FITS files +C because this code is primarily designed to stress the fitsio +C library routines. + + character asciisum*17 + character*3 cval + character*1 xinarray(21), binarray(21), boutarray(21), bnul + character colname*70, tdisp*40, nulstr*40 + character oskey*15 + character iskey*21 + character lstr*200 + character comm*73 + character*30 inskey(21) + character*30 onskey(3) + character filename*40, card*78, card2*78 + character keyword*8 + character value*68, comment*72 + character uchars*78 + character*15 ttype(10), tform(10), tunit(10) + character*15 tblname + character*15 binname + character errmsg*75 + character*8 inclist(2),exclist(2) + character*8 xctype,yctype,ctype + character*18 kunit + + logical simple,extend,larray(42), larray2(42) + logical olkey, ilkey, onlkey(3), inlkey(3), anynull + + integer*2 imgarray(19,30), imgarray2(10,20) + integer*2 iinarray(21), ioutarray(21), inul + + integer naxes(3), pcount, gcount, npixels, nrows, rowlen + integer existkeys, morekeys, keynum + integer datastatus, hdustatus + integer status, bitpix, naxis, block + integer ii, jj, jjj, hdutype, hdunum, tfields + integer nkeys, nfound, colnum, typecode, signval,nmsg + integer repeat, offset, width, jnulval + integer kinarray(21), koutarray(21), knul + integer jinarray(21), joutarray(21), jnul + integer ojkey, ijkey, otint + integer onjkey(3), injkey(3) + integer tbcol(5) + integer iunit, tmpunit + integer fpixels(2), lpixels(2), inc(2) + + real estatus, vers + real einarray(21), eoutarray(21), enul, cinarray(42) + real ofkey, oekey, iekey, onfkey(3),onekey(3), inekey(3) + + double precision dinarray(21),doutarray(21),dnul, minarray(42) + double precision scale, zero + double precision ogkey, odkey, idkey, otfrac, ongkey(3) + double precision ondkey(3), indkey(3) + double precision checksum, datsum + double precision xrval,yrval,xrpix,yrpix,xinc,yinc,rot + double precision xpos,ypos,xpix,ypix + + tblname = 'Test-ASCII' + binname = 'Test-BINTABLE' + onskey(1) = 'first string' + onskey(2) = 'second string' + onskey(3) = ' ' + oskey = 'value_string' + inclist(1)='key*' + inclist(2)='newikys' + exclist(1)='key_pr*' + exclist(2)='key_pkls' + xctype='RA---TAN' + yctype='DEC--TAN' + + olkey = .true. + ojkey = 11 + otint = 12345678 + ofkey = 12.121212 + oekey = 13.131313 + ogkey = 14.1414141414141414D+00 + odkey = 15.1515151515151515D+00 + otfrac = .1234567890123456D+00 + onlkey(1) = .true. + onlkey(2) = .false. + onlkey(3) = .true. + onjkey(1) = 11 + onjkey(2) = 12 + onjkey(3) = 13 + onfkey(1) = 12.121212 + onfkey(2) = 13.131313 + onfkey(3) = 14.141414 + onekey(1) = 13.131313 + onekey(2) = 14.141414 + onekey(3) = 15.151515 + ongkey(1) = 14.1414141414141414D+00 + ongkey(2) = 15.1515151515151515D+00 + ongkey(3) = 16.1616161616161616D+00 + ondkey(1) = 15.1515151515151515D+00 + ondkey(2) = 16.1616161616161616D+00 + ondkey(3) = 17.1717171717171717D+00 + + tbcol(1) = 1 + tbcol(2) = 17 + tbcol(3) = 28 + tbcol(4) = 43 + tbcol(5) = 56 + status = 0 + + call ftvers(vers) + write(*,'(1x,A,F7.3)') 'FITSIO TESTPROG, v', vers + write(*, '(1x,A)')' ' + + iunit = 15 + tmpunit = 16 + + write(*,'(1x,A)') 'Try opening then closing a nonexistent file: ' + call ftopen(iunit, 'tq123x.kjl', 1, block, status) + write(*,'(1x,A,2i4)')' ftopen iunit, status (expect an error) =' + & ,iunit, status + call ftclos(iunit, status) + write(*,'(1x,A,i4)')' ftclos status = ', status + write(*,'(1x,A)')' ' + + call ftcmsg + status = 0 + + filename = 'testf77.fit' + +C delete previous version of the file, if it exists + + call ftopen(iunit, filename, 1, block, status) + if (status .eq. 0)then + call ftdelt(iunit, status) + else +C clear the error message stack + call ftcmsg + end if + + status = 0 + +C +C ##################### +C # create FITS file # +C ##################### + + + call ftinit(iunit, filename, 1, status) + write(*,'(1x,A,i4)')'ftinit create new file status = ', status + write(*,'(1x,A)')' ' + + if (status .ne. 0)go to 999 + + simple = .true. + bitpix = 32 + naxis = 2 + naxes(1) = 10 + naxes(2) = 2 + npixels = 20 + pcount = 0 + gcount = 1 + extend = .true. + +C ############################ +C # write single keywords # +C ############################ + + call ftphpr(iunit,simple, bitpix, naxis, naxes, + & 0,1,extend,status) + + call ftprec(iunit, + &'key_prec= ''This keyword was written by fxprec'' / '// + & 'comment goes here', status) + + write(*,'(1x,A)') 'test writing of long string keywords: ' + card = '1234567890123456789012345678901234567890'// + & '12345678901234567890123456789012345' + call ftpkys(iunit, 'card1', card, ' ', status) + call ftgkey(iunit, 'card1', card2, comment, status) + + write(*,'(1x,A)') card + write(*,'(1x,A)') card2 + + card = '1234567890123456789012345678901234567890'// + & '123456789012345678901234''6789012345' + call ftpkys(iunit, 'card2', card, ' ', status) + call ftgkey(iunit, 'card2', card2, comment, status) + write(*,'(1x,A)') card + write(*,'(1x,A)') card2 + + card = '1234567890123456789012345678901234567890'// + & '123456789012345678901234''''789012345' + call ftpkys(iunit, 'card3', card, ' ', status) + call ftgkey(iunit, 'card3', card2, comment, status) + write(*,'(1x,A)') card + write(*,'(1x,A)') card2 + + card = '1234567890123456789012345678901234567890'// + & '123456789012345678901234567''9012345' + call ftpkys(iunit, 'card4', card, ' ', status) + call ftgkey(iunit, 'card4', card2, comment, status) + write(*,'(1x,A)') card + write(*,'(1x,A)') card2 + + call ftpkys(iunit, 'key_pkys', oskey, 'fxpkys comment', status) + call ftpkyl(iunit, 'key_pkyl', olkey, 'fxpkyl comment', status) + call ftpkyj(iunit, 'key_pkyj', ojkey, 'fxpkyj comment', status) + call ftpkyf(iunit,'key_pkyf',ofkey,5, 'fxpkyf comment', status) + call ftpkye(iunit,'key_pkye',oekey,6, 'fxpkye comment', status) + call ftpkyg(iunit,'key_pkyg',ogkey,14, 'fxpkyg comment',status) + call ftpkyd(iunit,'key_pkyd',odkey,14, 'fxpkyd comment',status) + + lstr='This is a very long string '// + & 'value that is continued over more than one keyword.' + + call ftpkls(iunit,'key_pkls',lstr,'fxpkls comment',status) + + call ftplsw(iunit, status) + call ftpkyt(iunit,'key_pkyt',otint,otfrac,'fxpkyt comment', + & status) + call ftpcom(iunit, 'This keyword was written by fxpcom.', + & status) + call ftphis(iunit, + &' This keyword written by fxphis (w/ 2 leading spaces).', + & status) + + call ftpdat(iunit, status) + + if (status .gt. 0)go to 999 + +C +C ############################### +C # write arrays of keywords # +C ############################### + + nkeys = 3 + + comm = 'fxpkns comment&' + call ftpkns(iunit, 'ky_pkns', 1, nkeys, onskey, comm, status) + comm = 'fxpknl comment&' + call ftpknl(iunit, 'ky_pknl', 1, nkeys, onlkey, comm, status) + + comm = 'fxpknj comment&' + call ftpknj(iunit, 'ky_pknj', 1, nkeys, onjkey, comm, status) + + comm = 'fxpknf comment&' + call ftpknf(iunit, 'ky_pknf', 1, nkeys, onfkey,5,comm,status) + + comm = 'fxpkne comment&' + call ftpkne(iunit, 'ky_pkne', 1, nkeys, onekey,6,comm,status) + + comm = 'fxpkng comment&' + call ftpkng(iunit, 'ky_pkng', 1, nkeys, ongkey,13,comm,status) + + comm = 'fxpknd comment&' + call ftpknd(iunit, 'ky_pknd', 1, nkeys, ondkey,14,comm,status) + + if (status .gt. 0)go to 999 + +C ############################ +C # write generic keywords # +C ############################ + + + oskey = '1' + call ftpkys(iunit, 'tstring', oskey, 'tstring comment',status) + + olkey = .true. + call ftpkyl(iunit, 'tlogical', olkey, 'tlogical comment', + & status) + + ojkey = 11 + call ftpkyj(iunit, 'tbyte', ojkey, 'tbyte comment', status) + + ojkey = 21 + call ftpkyj(iunit, 'tshort', ojkey, 'tshort comment', status) + + ojkey = 31 + call ftpkyj(iunit, 'tint', ojkey, 'tint comment', status) + + ojkey = 41 + call ftpkyj(iunit, 'tlong', ojkey, 'tlong comment', status) + + oekey = 42 + call ftpkye(iunit, 'tfloat', oekey, 6,'tfloat comment', status) + + odkey = 82.D+00 + call ftpkyd(iunit, 'tdouble', odkey, 14, 'tdouble comment', + & status) + + if (status .gt. 0)go to 999 + write(*,'(1x,A)') 'Wrote all Keywords successfully ' + + +C ############################ +C # write data # +C ############################ + + +C define the null value (must do this before writing any data) + call ftpkyj(iunit,'BLANK',-99, + & 'value to use for undefined pixels', status) + +C initialize arrays of values to write to primary array + do ii = 1, npixels + boutarray(ii) = char(ii) + ioutarray(ii) = ii + joutarray(ii) = ii + eoutarray(ii) = ii + doutarray(ii) = ii + end do + +C write a few pixels with each datatype +C set the last value in each group of 4 as undefined + call ftpprb(iunit, 1, 1, 2, boutarray(1), status) + call ftppri(iunit, 1, 5, 2, ioutarray(5), status) + call ftpprj(iunit, 1, 9, 2, joutarray(9), status) + call ftppre(iunit, 1, 13, 2, eoutarray(13), status) + call ftpprd(iunit, 1, 17, 2, doutarray(17), status) + bnul = char(4) + call ftppnb(iunit, 1, 3, 2, boutarray(3), bnul, status) + inul = 8 + call ftppni(iunit, 1, 7, 2, ioutarray(7), inul, status) + call ftppnj(iunit, 1, 11, 2, joutarray(11), 12, status) + call ftppne(iunit, 1, 15, 2, eoutarray(15), 16., status) + dnul = 20. + call ftppnd(iunit, 1, 19, 2, doutarray(19), dnul, status) + call ftppru(iunit, 1, 1, 1, status) + + if (status .gt. 0)then + write(*,'(1x,A,I4)')'ftppnx status = ', status + goto 999 + end if + + call ftflus(iunit, status) +C flush all data to the disk file + write(*,'(1x,A,I4)')'ftflus status = ', status + write(*,'(1x,A)')' ' + + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)')'HDU number = ', hdunum + +C ############################ +C # read data # +C ############################ + + +C read back the data, setting null values = 99 + write(*,'(1x,A)') + & 'Values read back from primary array (99 = null pixel)' + write(*,'(1x,A)') + & 'The 1st, and every 4th pixel should be undefined: ' + + anynull = .false. + bnul = char(99) + call ftgpvb(iunit, 1, 1, 10, bnul, binarray, anynull, status) + call ftgpvb(iunit, 1, 11, 10, bnul, binarray(11),anynull,status) + + do ii = 1,npixels + iinarray(ii) = ichar(binarray(ii)) + end do + + write(*,1101) (iinarray(ii), ii = 1, npixels), anynull, + & ' (ftgpvb) ' +1101 format(1x,20i3,l3,a) + + inul = 99 + call ftgpvi(iunit, 1, 1, npixels, inul, iinarray,anynull,status) + + write(*,1101) (iinarray(ii), ii = 1, npixels), anynull, + & ' (ftgpvi) ' + + call ftgpvj(iunit, 1, 1, npixels, 99, jinarray,anynull,status) + + write(*,1101) (jinarray(ii), ii = 1, npixels), anynull, + & ' (ftgpvj) ' + + call ftgpve(iunit, 1, 1, npixels, 99., einarray,anynull,status) + + write(*,1102) (einarray(ii), ii = 1, npixels), anynull, + & ' (ftgpve) ' + +1102 format(2x,20f3.0,l2,a) + + dnul = 99. + call ftgpvd(iunit, 1, 1, 10, dnul, dinarray, anynull, status) + call ftgpvd(iunit, 1, 11, 10, dnul,dinarray(11),anynull,status) + + write(*,1102) (dinarray(ii), ii = 1, npixels), anynull, + & ' (ftgpvd) ' + + if (status .gt. 0)then + write(*,'(1x,A,I4)')'ERROR: ftgpv_ status = ', status + goto 999 + end if + + if (.not. anynull)then + write(*,'(1x,A)') 'ERROR: ftgpv_ did not detect null values ' + go to 999 + end if + +C reset the output null value to the expected input value + + do ii = 4, npixels, 4 + boutarray(ii) = char(99) + ioutarray(ii) = 99 + joutarray(ii) = 99 + eoutarray(ii) = 99. + doutarray(ii) = 99. + end do + + ii = 1 + boutarray(ii) = char(99) + ioutarray(ii) = 99 + joutarray(ii) = 99 + eoutarray(ii) = 99. + doutarray(ii) = 99. + + +C compare the output with the input flag any differences + do ii = 1, npixels + + if (boutarray(ii) .ne. binarray(ii))then + write(*,'(1x,A,2A2)') 'bout != bin ', boutarray(ii), + & binarray(ii) + end if + + if (ioutarray(ii) .ne. iinarray(ii))then + write(*,'(1x,A,2I8)') 'bout != bin ', ioutarray(ii), + & iinarray(ii) + end if + + if (joutarray(ii) .ne. jinarray(ii))then + write(*,'(1x,A,2I12)') 'bout != bin ', joutarray(ii), + & jinarray(ii) + end if + + if (eoutarray(ii) .ne. einarray(ii))then + write(*,'(1x,A,2E15.3)') 'bout != bin ', eoutarray(ii), + & einarray(ii) + end if + + if (doutarray(ii) .ne. dinarray(ii))then + write(*,'(1x,A,2D20.6)') 'bout != bin ', doutarray(ii), + & dinarray(ii) + end if + end do + + do ii = 1, npixels + binarray(ii) = char(0) + iinarray(ii) = 0 + jinarray(ii) = 0 + einarray(ii) = 0. + dinarray(ii) = 0. + end do + + anynull = .false. + call ftgpfb(iunit, 1, 1, 10, binarray, larray, anynull,status) + call ftgpfb(iunit, 1, 11, 10, binarray(11), larray(11), + & anynull, status) + + do ii = 1, npixels + if (larray(ii))binarray(ii) = char(0) + end do + + do ii = 1,npixels + iinarray(ii) = ichar(binarray(ii)) + end do + + write(*,1101)(iinarray(ii),ii = 1,npixels),anynull,' (ftgpfb)' + + call ftgpfi(iunit, 1, 1, npixels, iinarray, larray, anynull, + & status) + + do ii = 1, npixels + if (larray(ii))iinarray(ii) = 0 + end do + + write(*,1101)(iinarray(ii),ii = 1,npixels),anynull,' (ftgpfi)' + + call ftgpfj(iunit, 1, 1, npixels, jinarray, larray, anynull, + & status) + + do ii = 1, npixels + if (larray(ii))jinarray(ii) = 0 + end do + + write(*,1101)(jinarray(ii),ii = 1,npixels),anynull,' (ftgpfj)' + + call ftgpfe(iunit, 1, 1, npixels, einarray, larray, anynull, + & status) + + do ii = 1, npixels + if (larray(ii))einarray(ii) = 0. + end do + + write(*,1102)(einarray(ii),ii = 1,npixels),anynull,' (ftgpfe)' + + call ftgpfd(iunit, 1, 1, 10, dinarray, larray, anynull,status) + call ftgpfd(iunit, 1, 11, 10, dinarray(11), larray(11), + & anynull, status) + + do ii = 1, npixels + if (larray(ii))dinarray(ii) = 0. + end do + + write(*,1102)(dinarray(ii),ii = 1,npixels),anynull,' (ftgpfd)' + + if (status .gt. 0)then + write(*,'(1x,A,I4)')'ERROR: ftgpf_ status = ', status + go to 999 + end if + + if (.not. anynull)then + write(*,'(1x,A)') 'ERROR: ftgpf_ did not detect null values' + go to 999 + end if + + +C ########################################## +C # close and reopen file multiple times # +C ########################################## + + + do ii = 1, 10 + call ftclos(iunit, status) + + if (status .gt. 0)then + write(*,'(1x,A,I4)')'ERROR in ftclos (1) = ', status + go to 999 + end if + + call ftopen(iunit, filename, 1, block, status) + + if (status .gt. 0)then + write(*,'(1x,A,I4)')'ERROR: ftopen open file status = ', + & status + go to 999 + end if + end do + + write(*,'(1x,A)') ' ' + write(*,'(1x,A)') 'Closed then reopened the FITS file 10 times.' + write(*,'(1x,A)')' ' + + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)')'HDU number = ', hdunum + + +C ############################ +C # read single keywords # +C ############################ + + + simple = .false. + bitpix = 0 + naxis = 0 + naxes(1) = 0 + naxes(2) = 0 + pcount = -99 + gcount = -99 + extend = .false. + write(*,'(1x,A)') 'Read back keywords: ' + call ftghpr(iunit, 3, simple, bitpix, naxis, naxes, pcount, + & gcount, extend, status) + write(*,'(1x,A,L4,4I4)')'simple, bitpix, naxis, naxes = ', + & simple, bitpix, naxis, naxes(1), naxes(2) + write(*,'(1x,A,2I4,L4)')' pcount, gcount, extend = ', + & pcount, gcount, extend + + call ftgrec(iunit, 9, card, status) + write(*,'(1x,A)') card + if (card(1:15) .ne. 'KEY_PREC= ''This') + & write(*,'(1x,A)') 'ERROR in ftgrec ' + + call ftgkyn(iunit, 9, keyword, value, comment, status) + write(*,'(1x,5A)') keyword,' ', value(1:35),' ', comment(1:20) + + if (keyword(1:8) .ne. 'KEY_PREC' ) + & write(*,'(1x,2A)') 'ERROR in ftgkyn: ', keyword + + call ftgcrd(iunit, keyword, card, status) + write(*,'(1x,A)') card + + if (keyword(1:8) .ne. card(1:8) ) + & write(*,'(1x,2A)') 'ERROR in ftgcrd: ', keyword + + call ftgkey(iunit, 'KY_PKNS1', value, comment, status) + write(*,'(1x,5A)') 'KY_PKNS1 ',':', value(1:15),':', comment(1:16) + + if (value(1:14) .ne. '''first string''') + & write(*,'(1x,2A)') 'ERROR in ftgkey: ', value + + call ftgkys(iunit, 'key_pkys', iskey, comment, status) + write(*,'(1x,5A,I4)')'KEY_PKYS ',':',iskey,':',comment(1:16), + & status + + call ftgkyl(iunit, 'key_pkyl', ilkey, comment, status) + write(*,'(1x,2A,L4,2A,I4)') 'KEY_PKYL ',':', ilkey,':', + &comment(1:16), status + + call ftgkyj(iunit, 'KEY_PKYJ', ijkey, comment, status) + write(*,'(1x,2A,I4,2A,I4)') 'KEY_PKYJ ',':',ijkey,':', + & comment(1:16), status + + call ftgkye(iunit, 'KEY_PKYJ', iekey, comment, status) + write(*,'(1x,2A,f12.5,2A,I4)') 'KEY_PKYE ',':',iekey,':', + & comment(1:16), status + + call ftgkyd(iunit, 'KEY_PKYJ', idkey, comment, status) + write(*,'(1x,2A,F12.5,2A,I4)') 'KEY_PKYD ',':',idkey,':', + & comment(1:16), status + + if (ijkey .ne. 11 .or. iekey .ne. 11. .or. idkey .ne. 11.) + & write(*,'(1x,A,I4,2F5.1)') 'ERROR in ftgky(jed): ', + & ijkey, iekey, idkey + + iskey= ' ' + call ftgkys(iunit, 'key_pkys', iskey, comment, status) + write(*,'(1x,5A,I4)') 'KEY_PKYS ',':', iskey,':', comment(1:16), + & status + + ilkey = .false. + call ftgkyl(iunit, 'key_pkyl', ilkey, comment, status) + write(*,'(1x,2A,L4,2A,I4)') 'KEY_PKYL ',':', ilkey,':', + & comment(1:16), status + + ijkey = 0 + call ftgkyj(iunit, 'KEY_PKYJ', ijkey, comment, status) + write(*,'(1x,2A,I4,2A,I4)') 'KEY_PKYJ ',':',ijkey,':', + & comment(1:16), status + + iekey = 0 + call ftgkye(iunit, 'KEY_PKYE', iekey, comment, status) + write(*,'(1x,2A,f12.5,2A,I4)') 'KEY_PKYE ',':',iekey,':', + & comment(1:16), status + + idkey = 0 + call ftgkyd(iunit, 'KEY_PKYD', idkey, comment, status) + write(*,'(1x,2A,F12.5,2A,I4)') 'KEY_PKYD ',':',idkey,':', + & comment(1:16), status + + iekey = 0 + call ftgkye(iunit, 'KEY_PKYF', iekey, comment, status) + write(*,'(1x,2A,f12.5,2A,I4)') 'KEY_PKYF ',':',iekey,':', + & comment(1:16), status + + iekey = 0 + call ftgkye(iunit, 'KEY_PKYE', iekey, comment, status) + write(*,'(1x,2A,f12.5,2A,I4)') 'KEY_PKYE ',':',iekey,':', + & comment(1:16), status + + idkey = 0 + call ftgkyd(iunit, 'KEY_PKYG', idkey, comment, status) + write(*,'(1x,2A,f16.12,2A,I4)') 'KEY_PKYG ',':',idkey,':', + & comment(1:16), status + + idkey = 0 + call ftgkyd(iunit, 'KEY_PKYD', idkey, comment, status) + write(*,'(1x,2A,f16.12,2A,I4)') 'KEY_PKYD ',':',idkey,':', + & comment(1:16), status + + call ftgkyt(iunit, 'KEY_PKYT', ijkey, idkey, comment, status) + write(*,'(1x,2A,i10,A,f16.14,A,I4)') 'KEY_PKYT ',':', + & ijkey,':', idkey, comment(1:16), status + + call ftpunt(iunit, 'KEY_PKYJ', 'km/s/Mpc', status) + ijkey = 0 + call ftgkyj(iunit, 'KEY_PKYJ', ijkey, comment, status) + write(*,'(1x,2A,I4,2A,I4)') 'KEY_PKYJ ',':',ijkey,':', + & comment(1:38), status + call ftgunt(iunit,'KEY_PKYJ',kunit,status) + write(*,'(1x,2A)') 'keyword unit=', kunit + + call ftpunt(iunit, 'KEY_PKYJ', ' ', status) + ijkey = 0 + call ftgkyj(iunit, 'KEY_PKYJ', ijkey, comment, status) + write(*,'(1x,2A,I4,2A,I4)') 'KEY_PKYJ ',':',ijkey,':', + & comment(1:38), status + call ftgunt(iunit,'KEY_PKYJ',kunit,status) + write(*,'(1x,2A)') 'keyword unit=', kunit + + call ftpunt(iunit, 'KEY_PKYJ', 'feet/second/second', status) + ijkey = 0 + call ftgkyj(iunit, 'KEY_PKYJ', ijkey, comment, status) + write(*,'(1x,2A,I4,2A,I4)') 'KEY_PKYJ ',':',ijkey,':', + & comment(1:38), status + call ftgunt(iunit,'KEY_PKYJ',kunit,status) + write(*,'(1x,2A)') 'keyword unit=', kunit + + call ftgkys(iunit, 'key_pkls', lstr, comment, status) + write(*,'(1x,2A)') 'KEY_PKLS long string value = ', lstr(1:50) + write(*,'(1x,A)')lstr(51:120) + +C get size and position in header + call ftghps(iunit, existkeys, keynum, status) + write(*,'(1x,A,I4,A,I4)') 'header contains ', existkeys, + & ' keywords; located at keyword ', keynum + +C ############################ +C # read array keywords # +C ############################ + + call ftgkns(iunit, 'ky_pkns', 1, 3, inskey, nfound, status) + write(*,'(1x,4A)') 'ftgkns: ', inskey(1)(1:14), inskey(2)(1:14), + & inskey(3)(1:14) + if (nfound .ne. 3 .or. status .gt. 0) + & write(*,'(1x,A,2I4)') ' ERROR in ftgkns ', nfound, status + + call ftgknl(iunit, 'ky_pknl', 1, 3, inlkey, nfound, status) + write(*,'(1x,A,3L4)') 'ftgknl: ', inlkey(1), inlkey(2), inlkey(3) + if (nfound .ne. 3 .or. status .gt. 0) + & write(*,'(1x,A,2I4)') ' ERROR in ftgknl ', nfound, status + + call ftgknj(iunit, 'ky_pknj', 1, 3, injkey, nfound, status) + write(*,'(1x,A,3I4)') 'ftgknj: ', injkey(1), injkey(2), injkey(3) + if (nfound .ne. 3 .or. status .gt. 0) + & write(*,'(1x,A,2I4)') ' ERROR in ftgknj ', nfound, status + + call ftgkne(iunit, 'ky_pkne', 1, 3, inekey, nfound, status) + write(*,'(1x,A,3F10.5)') 'ftgkne: ',inekey(1),inekey(2),inekey(3) + if (nfound .ne. 3 .or. status .gt. 0) + & write(*,'(1x,A,2I4)') ' ERROR in ftgkne ', nfound, status + + call ftgknd(iunit, 'ky_pknd', 1, 3, indkey, nfound, status) + write(*,'(1x,A,3F10.5)') 'ftgknd: ',indkey(1),indkey(2),indkey(3) + if (nfound .ne. 3 .or. status .gt. 0) + & write(*,'(1x,A,2I4)') ' ERROR in ftgknd ', nfound, status + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') + & 'Before deleting the HISTORY and DATE keywords...' + do ii = 29, 32 + call ftgrec(iunit, ii, card, status) + write(*,'(1x,A)') card(1:8) + end do + +C don't print date value, so that +C the output will always be the same + + +C ############################ +C # delete keywords # +C ############################ + + + call ftdrec(iunit, 30, status) + call ftdkey(iunit, 'DATE', status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'After deleting the keywords... ' + do ii = 29, 30 + call ftgrec(iunit, ii, card, status) + write(*,'(1x,A)') card + end do + + if (status .gt. 0) + & write(*,'(1x,A)') ' ERROR deleting keywords ' + + +C ############################ +C # insert keywords # +C ############################ + + call ftirec(iunit,26, + & 'KY_IREC = ''This keyword inserted by fxirec''', + & status) + call ftikys(iunit, 'KY_IKYS', 'insert_value_string', + & 'ikys comment', status) + call ftikyj(iunit, 'KY_IKYJ', 49, 'ikyj comment', status) + call ftikyl(iunit, 'KY_IKYL', .true., 'ikyl comment', status) + call ftikye(iunit, 'KY_IKYE',12.3456,4,'ikye comment',status) + odkey = 12.345678901234567D+00 + call ftikyd(iunit, 'KY_IKYD', odkey, 14, + & 'ikyd comment', status) + call ftikyf(iunit, 'KY_IKYF', 12.3456, 4, 'ikyf comment', + & status) + call ftikyg(iunit, 'KY_IKYG', odkey, 13, + & 'ikyg comment', status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'After inserting the keywords... ' + do ii = 25, 34 + call ftgrec(iunit, ii, card, status) + write(*,'(1x,A)') card + end do + + if (status .gt. 0) + & write(*,'(1x,A)') ' ERROR inserting keywords ' + + +C ############################ +C # modify keywords # +C ############################ + + call ftmrec(iunit, 25, + & 'COMMENT This keyword was modified by fxmrec', status) + call ftmcrd(iunit, 'KY_IREC', + & 'KY_MREC = ''This keyword was modified by fxmcrd''', status) + call ftmnam(iunit, 'KY_IKYS', 'NEWIKYS', status) + + call ftmcom(iunit,'KY_IKYJ','This is a modified comment', + & status) + call ftmkyj(iunit, 'KY_IKYJ', 50, '&', status) + call ftmkyl(iunit, 'KY_IKYL', .false., '&', status) + call ftmkys(iunit, 'NEWIKYS', 'modified_string', '&', status) + call ftmkye(iunit, 'KY_IKYE', -12.3456, 4, '&', status) + odkey = -12.345678901234567D+00 + + call ftmkyd(iunit, 'KY_IKYD', odkey, 14, + & 'modified comment', status) + call ftmkyf(iunit, 'KY_IKYF', -12.3456, 4, '&', status) + call ftmkyg(iunit,'KY_IKYG', odkey,13,'&',status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'After modifying the keywords... ' + do ii = 25, 34 + call ftgrec(iunit, ii, card, status) + write(*,'(1x,A)') card + end do + + if (status .gt. 0)then + write(*,'(1x,A)') ' ERROR modifying keywords ' + go to 999 + end if + +C ############################ +C # update keywords # +C ############################ + + call ftucrd(iunit, 'KY_MREC', + & 'KY_UCRD = ''This keyword was updated by fxucrd''', + & status) + + call ftukyj(iunit, 'KY_IKYJ', 51, '&', status) + call ftukyl(iunit, 'KY_IKYL', .true., '&', status) + call ftukys(iunit, 'NEWIKYS', 'updated_string', '&', status) + call ftukye(iunit, 'KY_IKYE', -13.3456, 4, '&', status) + odkey = -13.345678901234567D+00 + + call ftukyd(iunit, 'KY_IKYD',odkey , 14, + & 'modified comment', status) + call ftukyf(iunit, 'KY_IKYF', -13.3456, 4, '&', status) + call ftukyg(iunit, 'KY_IKYG', odkey, 13, '&', status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'After updating the keywords... ' + do ii = 25, 34 + call ftgrec(iunit, ii, card, status) + write(*,'(1x,A)') card + end do + + if (status .gt. 0)then + write(*,'(1x,A)') ' ERROR modifying keywords ' + go to 999 + end if + +C move to top of header and find keywords using wild cards + call ftgrec(iunit, 0, card, status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') + & 'Keywords found using wildcard search (should be 9)...' + nfound = -1 +91 nfound = nfound +1 + call ftgnxk(iunit, inclist, 2, exclist, 2, card, status) + if (status .eq. 0)then + write(*,'(1x,A)') card + go to 91 + end if + + if (nfound .ne. 9)then + write(*,'(1x,A)') + & 'ERROR reading keywords using wildcards (ftgnxk)' + go to 999 + end if + status = 0 + +C ############################ +C # create binary table # +C ############################ + + tform(1) = '15A' + tform(2) = '1L' + tform(3) = '16X' + tform(4) = '1B' + tform(5) = '1I' + tform(6) = '1J' + tform(7) = '1E' + tform(8) = '1D' + tform(9) = '1C' + tform(10)= '1M' + + ttype(1) = 'Avalue' + ttype(2) = 'Lvalue' + ttype(3) = 'Xvalue' + ttype(4) = 'Bvalue' + ttype(5) = 'Ivalue' + ttype(6) = 'Jvalue' + ttype(7) = 'Evalue' + ttype(8) = 'Dvalue' + ttype(9) = 'Cvalue' + ttype(10)= 'Mvalue' + + tunit(1) = ' ' + tunit(2) = 'm**2' + tunit(3) = 'cm' + tunit(4) = 'erg/s' + tunit(5) = 'km/s' + tunit(6) = ' ' + tunit(7) = ' ' + tunit(8) = ' ' + tunit(9) = ' ' + tunit(10)= ' ' + + nrows = 21 + tfields = 10 + pcount = 0 + + call ftibin(iunit, nrows, tfields, ttype, tform, tunit, + & binname, pcount, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)') 'ftibin status = ', status + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + +C get size and position in header, and reserve space for more keywords + call ftghps(iunit, existkeys, keynum, status) + write(*,'(1x,A,I4,A,I4)') 'header contains ',existkeys, + & ' keywords located at keyword ', keynum + + morekeys = 40 + call fthdef(iunit, morekeys, status) + call ftghsp(iunit, existkeys, morekeys, status) + write(*,'(1x,A,I4,A,I4,A)') 'header contains ', existkeys, + &' keywords with room for ', morekeys,' more' + +C define null value for int cols + call fttnul(iunit, 4, 99, status) + call fttnul(iunit, 5, 99, status) + call fttnul(iunit, 6, 99, status) + + call ftpkyj(iunit, 'TNULL4', 99, 'value for undefined pixels', + & status) + call ftpkyj(iunit, 'TNULL5', 99, 'value for undefined pixels', + & status) + call ftpkyj(iunit, 'TNULL6', 99, 'value for undefined pixels', + & status) + + naxis = 3 + naxes(1) = 1 + naxes(2) = 2 + naxes(3) = 8 + call ftptdm(iunit, 3, naxis, naxes, status) + + naxis = 0 + naxes(1) = 0 + naxes(2) = 0 + naxes(3) = 0 + call ftgtdm(iunit, 3, 3, naxis, naxes, status) + call ftgkys(iunit, 'TDIM3', iskey, comment, status) + write(*,'(1x,2A,4I4)') 'TDIM3 = ', iskey, naxis, naxes(1), + & naxes(2), naxes(3) + +C force header to be scanned (not required) + call ftrdef(iunit, status) + +C ############################ +C # write data to columns # +C ############################ + +C initialize arrays of values to write to table + signval = -1 + do ii = 1, 21 + signval = signval * (-1) + boutarray(ii) = char(ii) + ioutarray(ii) = (ii) * signval + joutarray(ii) = (ii) * signval + koutarray(ii) = (ii) * signval + eoutarray(ii) = (ii) * signval + doutarray(ii) = (ii) * signval + end do + + call ftpcls(iunit, 1, 1, 1, 3, onskey, status) +C write string values + call ftpclu(iunit, 1, 4, 1, 1, status) +C write null value + + larray(1) = .false. + larray(2) =.true. + larray(3) = .false. + larray(4) = .false. + larray(5) =.true. + larray(6) =.true. + larray(7) = .false. + larray(8) = .false. + larray(9) = .false. + larray(10) =.true. + larray(11) =.true. + larray(12) = .true. + larray(13) = .false. + larray(14) = .false. + larray(15) =.false. + larray(16) =.false. + larray(17) = .true. + larray(18) = .true. + larray(19) = .true. + larray(20) = .true. + larray(21) =.false. + larray(22) =.false. + larray(23) =.false. + larray(24) =.false. + larray(25) =.false. + larray(26) = .true. + larray(27) = .true. + larray(28) = .true. + larray(29) = .true. + larray(30) = .true. + larray(31) =.false. + larray(32) =.false. + larray(33) =.false. + larray(34) =.false. + larray(35) =.false. + larray(36) =.false. + +C write bits + call ftpclx(iunit, 3, 1, 1, 36, larray, status) + +C loop over cols 4 - 8 + do ii = 4, 8 + call ftpclb(iunit, ii, 1, 1, 2, boutarray, status) + if (status .eq. 412) status = 0 + + call ftpcli(iunit, ii, 3, 1, 2, ioutarray(3), status) + if (status .eq. 412) status = 0 + + call ftpclj(iunit, ii, 5, 1, 2, koutarray(5), status) + if (status .eq. 412) status = 0 + + call ftpcle(iunit, ii, 7, 1, 2, eoutarray(7), status) + if (status .eq. 412)status = 0 + + call ftpcld(iunit, ii, 9, 1, 2, doutarray(9), status) + if (status .eq. 412)status = 0 + +C write null value + call ftpclu(iunit, ii, 11, 1, 1, status) + end do + + call ftpclc(iunit, 9, 1, 1, 10, eoutarray, status) + call ftpclm(iunit, 10, 1, 1, 10, doutarray, status) + +C loop over cols 4 - 8 + do ii = 4, 8 + bnul = char(13) + call ftpcnb(iunit, ii, 12, 1, 2, boutarray(12),bnul,status) + if (status .eq. 412) status = 0 + inul=15 + call ftpcni(iunit, ii, 14, 1, 2, ioutarray(14),inul,status) + if (status .eq. 412) status = 0 + call ftpcnj(iunit, ii, 16, 1, 2, koutarray(16), 17, status) + if (status .eq. 412) status = 0 + call ftpcne(iunit, ii, 18, 1, 2, eoutarray(18), 19.,status) + if (status .eq. 412) status = 0 + dnul = 21. + call ftpcnd(iunit, ii, 20, 1, 2, doutarray(20),dnul,status) + if (status .eq. 412) status = 0 + end do + +C write logicals + call ftpcll(iunit, 2, 1, 1, 21, larray, status) +C write null value + call ftpclu(iunit, 2, 11, 1, 1, status) + write(*,'(1x,A,I4)') 'ftpcl_ status = ', status + if (status .gt. 0)go to 999 + +C ######################################### +C # get information about the columns # +C ######################################### + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') + & 'Find the column numbers a returned status value'// + & ' of 237 is' + write(*,'(1x,A)') + & 'expected and indicates that more than one column'// + & ' name matches' + write(*,'(1x,A)')'the input column name template.'// + & ' Status = 219 indicates that' + write(*,'(1x,A)') 'there was no matching column name.' + + call ftgcno(iunit, 0, 'Xvalue', colnum, status) + write(*,'(1x,A,I4,A,I4)') 'Column Xvalue is number', colnum, + &' status =',status + +219 continue + if (status .ne. 219)then + call ftgcnn(iunit, 1, '*ue', colname, colnum, status) + write(*,'(1x,3A,I4,A,I4)') 'Column ',colname(1:6),' is number', + & colnum,' status = ', status + go to 219 + end if + + status = 0 + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Information about each column: ' + + do ii = 1, tfields + call ftgtcl(iunit, ii, typecode, repeat, width, status) + call ftgbcl(iunit,ii,ttype,tunit,cval,repeat,scale, + & zero, jnulval, tdisp, status) + + write(*,'(1x,A,3I4,5A,2F8.2,I12,A)') + & tform(ii)(1:3), typecode, repeat, width,' ', + & ttype(1)(1:6),' ',tunit(1)(1:6), cval, scale, zero, jnulval, + & tdisp(1:8) + end do + + write(*,'(1x,A)') ' ' + +C ############################################### +C # insert ASCII table before the binary table # +C ############################################### + + call ftmrhd(iunit, -1, hdutype, status) + if (status .gt. 0)goto 999 + + tform(1) = 'A15' + tform(2) = 'I10' + tform(3) = 'F14.6' + tform(4) = 'E12.5' + tform(5) = 'D21.14' + + ttype(1) = 'Name' + ttype(2) = 'Ivalue' + ttype(3) = 'Fvalue' + ttype(4) = 'Evalue' + ttype(5) = 'Dvalue' + + tunit(1) = ' ' + tunit(2) = 'm**2' + tunit(3) = 'cm' + tunit(4) = 'erg/s' + tunit(5) = 'km/s' + + rowlen = 76 + nrows = 11 + tfields = 5 + + call ftitab(iunit, rowlen, nrows, tfields, ttype, tbcol, + & tform, tunit, tblname, status) + write(*,'(1x,A,I4)') 'ftitab status = ', status + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + +C define null value for int cols + call ftsnul(iunit, 1, 'null1', status) + call ftsnul(iunit, 2, 'null2', status) + call ftsnul(iunit, 3, 'null3', status) + call ftsnul(iunit, 4, 'null4', status) + call ftsnul(iunit, 5, 'null5', status) + + call ftpkys(iunit, 'TNULL1', 'null1', + & 'value for undefined pixels', status) + call ftpkys(iunit, 'TNULL2', 'null2', + & 'value for undefined pixels', status) + call ftpkys(iunit, 'TNULL3', 'null3', + & 'value for undefined pixels', status) + call ftpkys(iunit, 'TNULL4', 'null4', + & 'value for undefined pixels', status) + call ftpkys(iunit, 'TNULL5', 'null5', + & 'value for undefined pixels', status) + + if (status .gt. 0) goto 999 + +C ############################ +C # write data to columns # +C ############################ + +C initialize arrays of values to write to table + do ii = 1,21 + boutarray(ii) = char(ii) + ioutarray(ii) = ii + joutarray(ii) = ii + eoutarray(ii) = ii + doutarray(ii) = ii + end do + +C write string values + call ftpcls(iunit, 1, 1, 1, 3, onskey, status) +C write null value + call ftpclu(iunit, 1, 4, 1, 1, status) + + do ii = 2,5 +C loop over cols 2 - 5 + call ftpclb(iunit, ii, 1, 1, 2, boutarray, status) +C char array + if (status .eq. 412) status = 0 + + call ftpcli(iunit, ii, 3, 1, 2, ioutarray(3), status) +C short array + if (status .eq. 412) status = 0 + + call ftpclj(iunit, ii, 5, 1, 2, joutarray(5), status) +C long array + if (status .eq. 412)status = 0 + + call ftpcle(iunit, ii, 7, 1, 2, eoutarray(7), status) +C float array + if (status .eq. 412) status = 0 + + call ftpcld(iunit, ii, 9, 1, 2, doutarray(9), status) +C double array + if (status .eq. 412) status = 0 + + call ftpclu(iunit, ii, 11, 1, 1, status) +C write null value + end do + write(*,'(1x,A,I4)') 'ftpcl_ status = ', status + write(*,'(1x,A)')' ' + +C ################################ +C # read data from ASCII table # +C ################################ + + call ftghtb(iunit, 99, rowlen, nrows, tfields, ttype, tbcol, + & tform, tunit, tblname, status) + + write(*,'(1x,A,3I3,2A)') + & 'ASCII table: rowlen, nrows, tfields, extname:', + & rowlen, nrows, tfields,' ',tblname + + do ii = 1,tfields + write(*,'(1x,A,I4,3A)') + & ttype(ii)(1:7), tbcol(ii),' ',tform(ii)(1:7), tunit(ii)(1:7) + end do + + nrows = 11 + call ftgcvs(iunit, 1, 1, 1, nrows, 'UNDEFINED', inskey, + & anynull, status) + bnul = char(99) + call ftgcvb(iunit, 2, 1, 1, nrows, bnul, binarray, + & anynull, status) + inul = 99 + call ftgcvi(iunit, 2, 1, 1, nrows, inul, iinarray, + & anynull, status) + call ftgcvj(iunit, 3, 1, 1, nrows, 99, jinarray, + & anynull, status) + call ftgcve(iunit, 4, 1, 1, nrows, 99., einarray, + & anynull, status) + dnul = 99. + call ftgcvd(iunit, 5, 1, 1, nrows, dnul, dinarray, + & anynull, status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values read from ASCII table: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1011) inskey(ii), jj, + & iinarray(ii), jinarray(ii), einarray(ii), dinarray(ii) +1011 format(1x,a15,3i3,1x,2f3.0) + end do + + call ftgtbs(iunit, 1, 20, 78, uchars, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A)') uchars + call ftptbs(iunit, 1, 20, 78, uchars, status) + +C ######################################### +C # get information about the columns # +C ######################################### + + call ftgcno(iunit, 0, 'name', colnum, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4,A,I4)') + & 'Column name is number',colnum,' status = ', status + +2190 continue + if (status .ne. 219)then + if (status .gt. 0 .and. status .ne. 237)go to 999 + + call ftgcnn(iunit, 1, '*ue', colname, colnum, status) + write(*,'(1x,3A,I4,A,I4)') + & 'Column ',colname(1:6),' is number',colnum,' status = ',status + go to 2190 + end if + + status = 0 + + do ii = 1, tfields + call ftgtcl(iunit, ii, typecode, repeat, width, status) + call ftgacl(iunit, ii, ttype, tbcol,tunit,tform, + & scale,zero, nulstr, tdisp, status) + + write(*,'(1x,A,3I4,2A,I4,2A,2F10.2,3A)') + & tform(ii)(1:7), typecode, repeat, width,' ', + & ttype(1)(1:6), tbcol(1), ' ',tunit(1)(1:5), + & scale, zero, ' ', nulstr(1:6), tdisp(1:2) + + end do + + write(*,'(1x,A)') ' ' + +C ############################################### +C # test the insert/delete row/column routines # +C ############################################### + + call ftirow(iunit, 2, 3, status) + if (status .gt. 0) goto 999 + + nrows = 14 + call ftgcvs(iunit, 1, 1, 1, nrows, 'UNDEFINED', + & inskey, anynull, status) + call ftgcvb(iunit, 2, 1, 1, nrows, bnul, binarray, + & anynull, status) + call ftgcvi(iunit, 2, 1, 1, nrows, inul, iinarray, + & anynull, status) + call ftgcvj(iunit, 3, 1, 1, nrows, 99, jinarray, + & anynull, status) + call ftgcve(iunit, 4, 1, 1, nrows, 99., einarray, + & anynull, status) + call ftgcvd(iunit, 5, 1, 1, nrows, dnul, dinarray, + & anynull, status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)')'Data values after inserting 3 rows after row 2:' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1011) inskey(ii), jj, + & iinarray(ii), jinarray(ii), einarray(ii), dinarray(ii) + end do + + call ftdrow(iunit, 10, 2, status) + + nrows = 12 + call ftgcvs(iunit, 1, 1, 1, nrows, 'UNDEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 2, 1, 1, nrows, bnul, binarray, anynull, + & status) + call ftgcvi(iunit, 2, 1, 1, nrows, inul, iinarray, anynull, + & status) + call ftgcvj(iunit, 3, 1, 1, nrows, 99, jinarray, anynull, + & status) + call ftgcve(iunit, 4, 1, 1, nrows, 99., einarray, anynull, + & status) + call ftgcvd(iunit, 5, 1, 1, nrows, dnul, dinarray, anynull, + & status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values after deleting 2 rows at row 10: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1011) inskey(ii), jj, + & iinarray(ii), jinarray(ii), einarray(ii), dinarray(ii) + end do + call ftdcol(iunit, 3, status) + + call ftgcvs(iunit, 1, 1, 1, nrows, 'UNDEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 2, 1, 1, nrows, bnul, binarray, anynull, + & status) + call ftgcvi(iunit, 2, 1, 1, nrows, inul, iinarray, anynull, + & status) + call ftgcve(iunit, 3, 1, 1, nrows, 99., einarray, anynull, + & status) + call ftgcvd(iunit, 4, 1, 1, nrows, dnul, dinarray, anynull, + & status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values after deleting column 3: ' + do ii = 1,nrows + jj = ichar(binarray(ii)) + write(*,1012) inskey(ii), jj, + & iinarray(ii), einarray(ii), dinarray(ii) +1012 format(1x,a15,2i3,1x,2f3.0) + + end do + + call fticol(iunit, 5, 'INSERT_COL', 'F14.6', status) + + call ftgcvs(iunit, 1, 1, 1, nrows, 'UNDEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 2, 1, 1, nrows, bnul, binarray, anynull, + & status) + call ftgcvi(iunit, 2, 1, 1, nrows, inul, iinarray, anynull, + & status) + call ftgcve(iunit, 3, 1, 1, nrows, 99., einarray, anynull, + & status) + call ftgcvd(iunit, 4, 1, 1, nrows, dnul, dinarray, anynull, + & status) + call ftgcvj(iunit, 5, 1, 1, nrows, 99, jinarray, anynull, + & status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') ' Data values after inserting column 5: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1013) inskey(ii), jj, + & iinarray(ii), einarray(ii), dinarray(ii) , jinarray(ii) +1013 format(1x,a15,2i3,1x,2f3.0,i2) + + end do + +C ################################ +C # read data from binary table # +C ################################ + + + call ftmrhd(iunit, 1, hdutype, status) + if (status .gt. 0)go to 999 + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + + call ftghsp(iunit, existkeys, morekeys, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A)')'Moved to binary table' + write(*,'(1x,A,I4,A,I4,A)') 'header contains ',existkeys, + & ' keywords with room for ',morekeys,' more ' + + call ftghbn(iunit, 99, nrows, tfields, ttype, + & tform, tunit, binname, pcount, status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A,2I4,A,I4)') + & 'Binary table: nrows, tfields, extname, pcount:', + & nrows, tfields, binname, pcount + + do ii = 1,tfields + write(*,'(1x,3A)') ttype(ii), tform(ii), tunit(ii) + end do + + do ii = 1, 40 + larray(ii) = .false. + end do + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values read from binary table: ' + write(*,'(1x,A)') ' Bit column (X) data values: ' + + call ftgcx(iunit, 3, 1, 1, 36, larray, status) + write(*,1014) (larray(ii), ii = 1,40) +1014 format(1x,8l1,' ',8l1,' ',8l1,' ',8l1,' ',8l1) + + nrows = 21 + do ii = 1, nrows + larray(ii) = .false. + xinarray(ii) = ' ' + binarray(ii) = ' ' + iinarray(ii) = 0 + kinarray(ii) = 0 + einarray(ii) = 0. + dinarray(ii) = 0. + cinarray(ii * 2 -1) = 0. + minarray(ii * 2 -1) = 0. + cinarray(ii * 2 ) = 0. + minarray(ii * 2 ) = 0. + end do + + write(*,'(1x,A)') ' ' + call ftgcvs(iunit, 1, 4, 1, 1, ' ', inskey, anynull,status) + if (ichar(inskey(1)(1:1)) .eq. 0)inskey(1)=' ' + write(*,'(1x,2A)') 'null string column value (should be blank):', + & inskey(1) + + call ftgcvs(iunit, 1, 1, 1, nrows, 'NOT DEFINED', inskey, + & anynull, status) + call ftgcl( iunit, 2, 1, 1, nrows, larray, status) + bnul = char(98) + call ftgcvb(iunit, 3, 1, 1,nrows,bnul, xinarray,anynull,status) + call ftgcvb(iunit, 4, 1, 1,nrows,bnul, binarray,anynull,status) + inul = 98 + call ftgcvi(iunit, 5, 1, 1,nrows,inul, iinarray,anynull,status) + call ftgcvj(iunit, 6, 1, 1, nrows, 98, kinarray,anynull,status) + call ftgcve(iunit, 7, 1, 1, nrows, 98.,einarray,anynull,status) + dnul = 98. + call ftgcvd(iunit, 8, 1, 1, nrows,dnul,dinarray,anynull,status) + call ftgcvc(iunit, 9, 1, 1, nrows, 98.,cinarray,anynull,status) + call ftgcvm(iunit,10, 1, 1, nrows,dnul,minarray,anynull,status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Read columns with ftgcv_: ' + do ii = 1,nrows + jj = ichar(xinarray(ii)) + jjj = ichar(binarray(ii)) + write(*,1201)inskey(ii),larray(ii),jj,jjj,iinarray(ii), + & kinarray(ii), einarray(ii), dinarray(ii), cinarray(ii * 2 -1), + &cinarray(ii * 2 ), minarray(ii * 2 -1), minarray(ii * 2 ) + end do +1201 format(1x,a14,l4,4i4,6f5.0) + + do ii = 1, nrows + larray(ii) = .false. + xinarray(ii) = ' ' + binarray(ii) = ' ' + iinarray(ii) = 0 + kinarray(ii) = 0 + einarray(ii) = 0. + dinarray(ii) = 0. + cinarray(ii * 2 -1) = 0. + minarray(ii * 2 -1) = 0. + cinarray(ii * 2 ) = 0. + minarray(ii * 2 ) = 0. + end do + + call ftgcfs(iunit, 1, 1, 1, nrows, inskey, larray2, anynull, + & status) +C put blanks in strings if they are undefined. (contain nulls) + do ii = 1, nrows + if (larray2(ii))inskey(ii) = ' ' + end do + + call ftgcfl(iunit, 2, 1, 1, nrows, larray, larray2, anynull, + & status) + call ftgcfb(iunit, 3, 1, 1, nrows, xinarray, larray2, anynull, + & status) + call ftgcfb(iunit, 4, 1, 1, nrows, binarray, larray2, anynull, + & status) + call ftgcfi(iunit, 5, 1, 1, nrows, iinarray, larray2, anynull, + & status) + call ftgcfj(iunit, 6, 1, 1, nrows, kinarray, larray2, anynull, + & status) + call ftgcfe(iunit, 7, 1, 1, nrows, einarray, larray2, anynull, + & status) + call ftgcfd(iunit, 8, 1, 1, nrows, dinarray, larray2, anynull, + & status) + call ftgcfc(iunit, 9, 1, 1, nrows, cinarray, larray2, anynull, + & status) + call ftgcfm(iunit, 10,1, 1, nrows, minarray, larray2, anynull, + & status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') ' Read columns with ftgcf_: ' + do ii = 1, 10 + jj = ichar(xinarray(ii)) + jjj = ichar(binarray(ii)) + write(*,1201) + & inskey(ii),larray(ii),jj,jjj,iinarray(ii), + & kinarray(ii), einarray(ii), dinarray(ii), cinarray(ii * 2 -1), + & cinarray(ii * 2 ), minarray(ii * 2 -1), minarray(ii * 2) + end do + + do ii = 11, 21 +C don't try to print the NaN values + jj = ichar(xinarray(ii)) + jjj = ichar(binarray(ii)) + write(*,1201) inskey(ii), larray(ii), jj, + & jjj, iinarray(ii) + end do + + call ftprec(iunit,'key_prec= '// + &'''This keyword was written by f_prec'' / comment here', + & status) + +C ############################################### +C # test the insert/delete row/column routines # +C ############################################### + + call ftirow(iunit, 2, 3, status) + if (status .gt. 0) go to 999 + + nrows = 14 + call ftgcvs(iunit, 1, 1, 1, nrows, 'NOT DEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 4, 1, 1, nrows,bnul,binarray,anynull,status) + call ftgcvi(iunit, 5, 1, 1, nrows,inul,iinarray,anynull,status) + call ftgcvj(iunit, 6, 1, 1, nrows, 98, jinarray,anynull,status) + call ftgcve(iunit, 7, 1, 1, nrows, 98.,einarray,anynull,status) + call ftgcvd(iunit, 8, 1, 1, nrows,dnul,dinarray,anynull,status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)')'Data values after inserting 3 rows after row 2:' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1202) inskey(ii), jj, + & iinarray(ii), jinarray(ii), einarray(ii), dinarray(ii) + end do +1202 format(1x,a14,3i4,2f5.0) + + call ftdrow(iunit, 10, 2, status) + if (status .gt. 0)goto 999 + + nrows = 12 + call ftgcvs(iunit, 1, 1, 1, nrows, 'NOT DEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 4, 1, 1, nrows,bnul,binarray,anynull,status) + call ftgcvi(iunit, 5, 1, 1, nrows,inul,iinarray,anynull,status) + call ftgcvj(iunit, 6, 1, 1, nrows, 98,jinarray,anynull,status) + call ftgcve(iunit, 7, 1, 1, nrows, 98.,einarray,anynull,status) + call ftgcvd(iunit, 8, 1, 1, nrows,dnul,dinarray,anynull,status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values after deleting 2 rows at row 10: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1202) inskey(ii), jj, + & iinarray(ii), jinarray(ii), einarray(ii), dinarray(ii) + end do + + call ftdcol(iunit, 6, status) + + call ftgcvs(iunit, 1, 1, 1, nrows, 'NOT DEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 4, 1, 1, nrows,bnul,binarray,anynull,status) + call ftgcvi(iunit, 5, 1, 1, nrows,inul,iinarray,anynull,status) + call ftgcve(iunit, 6, 1, 1, nrows, 98.,einarray,anynull,status) + call ftgcvd(iunit, 7, 1, 1, nrows,dnul,dinarray,anynull,status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values after deleting column 6: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1203) inskey(ii), jj, + & iinarray(ii), einarray(ii), dinarray(ii) +1203 format(1x,a14,2i4,2f5.0) + + end do + call fticol(iunit, 8, 'INSERT_COL', '1E', status) + + call ftgcvs(iunit, 1, 1, 1, nrows, 'NOT DEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 4, 1, 1, nrows,bnul,binarray,anynull,status) + call ftgcvi(iunit, 5, 1, 1, nrows,inul,iinarray,anynull,status) + call ftgcve(iunit, 6, 1, 1, nrows, 98.,einarray,anynull,status) + call ftgcvd(iunit, 7, 1, 1, nrows,dnul,dinarray,anynull,status) + call ftgcvj(iunit, 8, 1, 1, nrows, 98,jinarray,anynull,status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') 'Data values after inserting column 8: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1204) inskey(ii), jj, + & iinarray(ii), einarray(ii), dinarray(ii) , jinarray(ii) +1204 format(1x,a14,2i4,2f5.0,i3) + end do + call ftpclu(iunit, 8, 1, 1, 10, status) + + call ftgcvs(iunit, 1, 1, 1, nrows, 'NOT DEFINED', inskey, + & anynull, status) + call ftgcvb(iunit, 4,1,1,nrows,bnul,binarray,anynull,status) + call ftgcvi(iunit, 5,1,1,nrows,inul,iinarray,anynull,status) + call ftgcve(iunit, 6,1,1,nrows,98., einarray,anynull,status) + call ftgcvd(iunit, 7,1,1,nrows,dnul, dinarray,anynull,status) + call ftgcvj(iunit, 8,1,1,nrows,98, jinarray,anynull, status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') + & 'Values after setting 1st 10 elements in column 8 = null: ' + do ii = 1, nrows + jj = ichar(binarray(ii)) + write(*,1204) inskey(ii), jj, + & iinarray(ii), einarray(ii), dinarray(ii) , jinarray(ii) + end do + +C #################################################### +C # insert binary table following the primary array # +C #################################################### + + call ftmahd(iunit, 1, hdutype, status) + + tform(1) = '15A' + tform(2) = '1L' + tform(3) = '16X' + tform(4) = '1B' + tform(5) = '1I' + tform(6) = '1J' + tform(7) = '1E' + tform(8) = '1D' + tform(9) = '1C' + tform(10)= '1M' + + ttype(1) = 'Avalue' + ttype(2) = 'Lvalue' + ttype(3) = 'Xvalue' + ttype(4) = 'Bvalue' + ttype(5) = 'Ivalue' + ttype(6) = 'Jvalue' + ttype(7) = 'Evalue' + ttype(8) = 'Dvalue' + ttype(9) = 'Cvalue' + ttype(10)= 'Mvalue' + + tunit(1)= ' ' + tunit(2)= 'm**2' + tunit(3)= 'cm' + tunit(4)= 'erg/s' + tunit(5)= 'km/s' + tunit(6)= ' ' + tunit(7)= ' ' + tunit(8)= ' ' + tunit(9)= ' ' + tunit(10)= ' ' + + nrows = 20 + tfields = 10 + pcount = 0 + + call ftibin(iunit, nrows, tfields, ttype, tform, tunit, + & binname, pcount, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)') 'ftibin status = ', status + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + + call ftpkyj(iunit, 'TNULL4', 77, + & 'value for undefined pixels', status) + call ftpkyj(iunit, 'TNULL5', 77, + & 'value for undefined pixels', status) + call ftpkyj(iunit, 'TNULL6', 77, + & 'value for undefined pixels', status) + + call ftpkyj(iunit, 'TSCAL4', 1000, 'scaling factor', status) + call ftpkyj(iunit, 'TSCAL5', 1, 'scaling factor', status) + call ftpkyj(iunit, 'TSCAL6', 100, 'scaling factor', status) + + call ftpkyj(iunit, 'TZERO4', 0, 'scaling offset', status) + call ftpkyj(iunit, 'TZERO5', 32768, 'scaling offset', status) + call ftpkyj(iunit, 'TZERO6', 100, 'scaling offset', status) + + call fttnul(iunit, 4, 77, status) +C define null value for int cols + call fttnul(iunit, 5, 77, status) + call fttnul(iunit, 6, 77, status) + +C set scaling + scale=1000. + zero = 0. + call fttscl(iunit, 4, scale, zero, status) + scale=1. + zero = 32768. + call fttscl(iunit, 5, scale, zero, status) + scale=100. + zero = 100. + call fttscl(iunit, 6, scale, zero, status) + +C for some reason, it is still necessary to call ftrdef at this point + call ftrdef(iunit,status) + +C ############################ +C # write data to columns # +C ############################ + +C initialize arrays of values to write to table + + joutarray(1) = 0 + joutarray(2) = 1000 + joutarray(3) = 10000 + joutarray(4) = 32768 + joutarray(5) = 65535 + + + do ii = 4,6 + + call ftpclj(iunit, ii, 1, 1, 5, joutarray, status) + if (status .eq. 412)then + write(*,'(1x,A,I4)') 'Overflow writing to column ', ii + status = 0 + end if + + call ftpclu(iunit, ii, 6, 1, 1, status) +C write null value + end do + + do jj = 4,6 + call ftgcvj(iunit, jj, 1,1,6, -999,jinarray,anynull,status) + write(*,'(1x,6I6)') (jinarray(ii), ii=1,6) + end do + + write(*,'(1x,A)') ' ' + +C turn off scaling, and read the unscaled values + scale = 1. + zero = 0. + call fttscl(iunit, 4, scale, zero, status) + call fttscl(iunit, 5, scale, zero, status) + call fttscl(iunit, 6, scale, zero, status) + + do jj = 4,6 + call ftgcvj(iunit, jj,1,1,6,-999,jinarray,anynull,status) + write(*,'(1x,6I6)') (jinarray(ii), ii = 1,6) + end do + + if (status .gt. 0)go to 999 + +C ###################################################### +C # insert image extension following the binary table # +C ###################################################### + + bitpix = -32 + naxis = 2 + naxes(1) = 15 + naxes(2) = 25 + call ftiimg(iunit, bitpix, naxis, naxes, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)') + & ' Create image extension: ftiimg status = ', status + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + + do jj = 0,29 + do ii = 0,18 + imgarray(ii+1,jj+1) = (jj * 10) + ii + end do + end do + + call ftp2di(iunit, 1, 19, naxes(1),naxes(2),imgarray,status) + write(*,'(1x,A)') ' ' + write(*,'(1x,A,I4)')'Wrote whole 2D array: ftp2di status =', + & status + + do jj =1, 30 + do ii = 1, 19 + imgarray(ii,jj) = 0 + end do + end do + + call ftg2di(iunit,1,0,19,naxes(1),naxes(2),imgarray,anynull, + & status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)')'Read whole 2D array: ftg2di status =',status + + do jj =1, 30 + write (*,1301)(imgarray(ii,jj),ii=1,19) +1301 format(1x,19I4) + end do + + write(*,'(1x,A)') ' ' + + + do jj =1, 30 + do ii = 1, 19 + imgarray(ii,jj) = 0 + end do + end do + + do jj =0, 19 + do ii = 0, 9 + imgarray2(ii+1,jj+1) = (jj * (-10)) - ii + end do + end do + + fpixels(1) = 5 + fpixels(2) = 5 + lpixels(1) = 14 + lpixels(2) = 14 + call ftpssi(iunit, 1, naxis, naxes, fpixels, lpixels, + & imgarray2, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)')'Wrote subset 2D array: ftpssi status =', + & status + + call ftg2di(iunit,1,0,19,naxes(1), naxes(2),imgarray,anynull, + & status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)')'Read whole 2D array: ftg2di status =',status + + do jj =1, 30 + write (*,1301)(imgarray(ii,jj),ii=1,19) + end do + write(*,'(1x,A)') ' ' + + + fpixels(1) = 2 + fpixels(2) = 5 + lpixels(1) = 10 + lpixels(2) = 8 + inc(1) = 2 + inc(2) = 3 + + do jj = 1,30 + do ii = 1, 19 + imgarray(ii,jj) = 0 + end do + end do + + call ftgsvi(iunit, 1, naxis, naxes, fpixels, lpixels, inc, 0, + & imgarray, anynull, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)') + & 'Read subset of 2D array: ftgsvi status = ',status + + write(*,'(1x,10I5)')(imgarray(ii,1),ii = 1,10) + + +C ########################################################### +C # insert another image extension # +C # copy the image extension to primary array of tmp file. # +C # then delete the tmp file, and the image extension # +C ########################################################### + + bitpix = 16 + naxis = 2 + naxes(1) = 15 + naxes(2) = 25 + call ftiimg(iunit, bitpix, naxis, naxes, status) + write(*,'(1x,A)') ' ' + write(*,'(1x,A,I4)')'Create image extension: ftiimg status =', + & status + call ftrdef(iunit, status) + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + + + filename = 't1q2s3v4.tmp' + call ftinit(tmpunit, filename, 1, status) + write(*,'(1x,A,I4)')'Create temporary file: ftinit status = ', + & status + + call ftcopy(iunit, tmpunit, 0, status) + write(*,'(1x,A)') + & 'Copy image extension to primary array of tmp file.' + write(*,'(1x,A,I4)')'ftcopy status = ',status + + + call ftgrec(tmpunit, 1, card, status) + write(*,'(1x,A)') card + call ftgrec(tmpunit, 2, card, status) + write(*,'(1x,A)') card + call ftgrec(tmpunit, 3, card, status) + write(*,'(1x,A)') card + call ftgrec(tmpunit, 4, card, status) + write(*,'(1x,A)') card + call ftgrec(tmpunit, 5, card, status) + write(*,'(1x,A)') card + call ftgrec(tmpunit, 6, card, status) + write(*,'(1x,A)') card + + call ftdelt(tmpunit, status) + write(*,'(1x,A,I4)')'Delete the tmp file: ftdelt status =',status + call ftdhdu(iunit, hdutype, status) + write(*,'(1x,A,2I4)') + & 'Delete the image extension hdutype, status =', + & hdutype, status + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + + +C ########################################################### +C # append bintable extension with variable length columns # +C ########################################################### + + call ftcrhd(iunit, status) + write(*,'(1x,A,I4)') 'ftcrhd status = ', status + + tform(1)= '1PA' + tform(2)= '1PL' + tform(3)= '1PB' +C Fortran FITSIO doesn't support 1PX + tform(4)= '1PB' + tform(5)= '1PI' + tform(6)= '1PJ' + tform(7)= '1PE' + tform(8)= '1PD' + tform(9)= '1PC' + tform(10)= '1PM' + + ttype(1)= 'Avalue' + ttype(2)= 'Lvalue' + ttype(3)= 'Xvalue' + ttype(4)= 'Bvalue' + ttype(5)= 'Ivalue' + ttype(6)= 'Jvalue' + ttype(7)= 'Evalue' + ttype(8)= 'Dvalue' + ttype(9)= 'Cvalue' + ttype(10)= 'Mvalue' + + tunit(1)= ' ' + tunit(2)= 'm**2' + tunit(3)= 'cm' + tunit(4)= 'erg/s' + tunit(5)= 'km/s' + tunit(6)= ' ' + tunit(7)= ' ' + tunit(8)= ' ' + tunit(9)= ' ' + tunit(10)= ' ' + + nrows = 20 + tfields = 10 + pcount = 0 + + call ftphbn(iunit, nrows, tfields, ttype, tform, + & tunit, binname, pcount, status) + write(*,'(1x,A,I4)')'Variable length arrays: ftphbn status =', + & status + call ftpkyj(iunit, 'TNULL4', 88, 'value for undefined pixels', + & status) + call ftpkyj(iunit, 'TNULL5', 88, 'value for undefined pixels', + & status) + call ftpkyj(iunit, 'TNULL6', 88, 'value for undefined pixels', + & status) + +C ############################ +C # write data to columns # +C ############################ + +C initialize arrays of values to write to table + iskey='abcdefghijklmnopqrst' + + do ii = 1, 20 + + boutarray(ii) = char(ii) + ioutarray(ii) = ii + joutarray(ii) = ii + eoutarray(ii) = ii + doutarray(ii) = ii + end do + + larray(1) = .false. + larray(2) = .true. + larray(3) = .false. + larray(4) = .false. + larray(5) = .true. + larray(6) = .true. + larray(7) = .false. + larray(8) = .false. + larray(9) = .false. + larray(10) = .true. + larray(11) = .true. + larray(12) = .true. + larray(13) = .false. + larray(14) = .false. + larray(15) = .false. + larray(16) = .false. + larray(17) = .true. + larray(18) = .true. + larray(19) = .true. + larray(20) = .true. + +C inskey(1) = iskey(1:1) + inskey(1) = ' ' + + call ftpcls(iunit, 1, 1, 1, 1, inskey, status) +C write string values + call ftpcll(iunit, 2, 1, 1, 1, larray, status) +C write logicals + call ftpclx(iunit, 3, 1, 1, 1, larray, status) +C write bits + call ftpclb(iunit, 4, 1, 1, 1, boutarray, status) + call ftpcli(iunit, 5, 1, 1, 1, ioutarray, status) + call ftpclj(iunit, 6, 1, 1, 1, joutarray, status) + call ftpcle(iunit, 7, 1, 1, 1, eoutarray, status) + call ftpcld(iunit, 8, 1, 1, 1, doutarray, status) + + do ii = 2, 20 +C loop over rows 1 - 20 + + inskey(1) = iskey(1:ii) + call ftpcls(iunit, 1, ii, 1, ii, inskey, status) +C write string values + + call ftpcll(iunit, 2, ii, 1, ii, larray, status) +C write logicals + call ftpclu(iunit, 2, ii, ii-1, 1, status) + + call ftpclx(iunit, 3, ii, 1, ii, larray, status) +C write bits + + call ftpclb(iunit, 4, ii, 1, ii, boutarray, status) + call ftpclu(iunit, 4, ii, ii-1, 1, status) + + call ftpcli(iunit, 5, ii, 1, ii, ioutarray, status) + call ftpclu(iunit, 5, ii, ii-1, 1, status) + + call ftpclj(iunit, 6, ii, 1, ii, joutarray, status) + call ftpclu(iunit, 6, ii, ii-1, 1, status) + + call ftpcle(iunit, 7, ii, 1, ii, eoutarray, status) + call ftpclu(iunit, 7, ii, ii-1, 1, status) + + call ftpcld(iunit, 8, ii, 1, ii, doutarray, status) + call ftpclu(iunit, 8, ii, ii-1, 1, status) + end do + +C it is no longer necessary to update the PCOUNT keyword; +C FITSIO now does this automatically when the HDU is closed. +C call ftmkyj(iunit,'PCOUNT',4446, '&',status) + write(*,'(1x,A,I4)') 'ftpcl_ status = ', status + +C ################################# +C # close then reopen this HDU # +C ################################# + + call ftmrhd(iunit, -1, hdutype, status) + call ftmrhd(iunit, 1, hdutype, status) + +C ############################# +C # read data from columns # +C ############################# + + + call ftgkyj(iunit, 'PCOUNT', pcount, comm, status) + write(*,'(1x,A,I4)') 'PCOUNT = ', pcount + +C initialize the variables to be read + inskey(1) =' ' + iskey = ' ' + + do jj = 1, ii + larray(jj) = .false. + boutarray(jj) = char(0) + ioutarray(jj) = 0 + joutarray(jj) = 0 + eoutarray(jj) = 0 + doutarray(jj) = 0 + end do + + call ftghdn(iunit, hdunum) + write(*,'(1x,A,I4)') 'HDU number = ', hdunum + + do ii = 1, 20 +C loop over rows 1 - 20 + + do jj = 1, ii + larray(jj) = .false. + boutarray(jj) = char(0) + ioutarray(jj) = 0 + joutarray(jj) = 0 + eoutarray(jj) = 0 + doutarray(jj) = 0 + end do + + call ftgcvs(iunit, 1, ii, 1,1,iskey,inskey,anynull,status) + write(*,'(1x,2A,I4)') 'A ', inskey(1), status + + call ftgcl( iunit, 2, ii, 1, ii, larray, status) + write(*,1400)'L',status,(larray(jj),jj=1,ii) +1400 format(1x,a1,i3,20l3) +1401 format(1x,a1,21i3) + + call ftgcx(iunit, 3, ii, 1, ii, larray, status) + write(*,1400)'X',status,(larray(jj),jj=1,ii) + + bnul = char(99) + call ftgcvb(iunit, 4, ii, 1,ii,bnul,boutarray,anynull,status) + do jj = 1,ii + jinarray(jj) = ichar(boutarray(jj)) + end do + write(*,1401)'B',(jinarray(jj),jj=1,ii),status + + inul = 99 + call ftgcvi(iunit, 5, ii, 1,ii,inul,ioutarray,anynull,status) + write(*,1401)'I',(ioutarray(jj),jj=1,ii),status + + call ftgcvj(iunit, 6, ii, 1, ii,99,joutarray,anynull,status) + write(*,1401)'J',(joutarray(jj),jj=1,ii),status + + call ftgcve(iunit, 7, ii, 1,ii,99.,eoutarray,anynull,status) + estatus=status + write(*,1402)'E',(eoutarray(jj),jj=1,ii),estatus +1402 format(1x,a1,1x,21f3.0) + + dnul = 99. + call ftgcvd(iunit, 8, ii,1,ii,dnul,doutarray,anynull,status) + estatus=status + write(*,1402)'D',(doutarray(jj),jj=1,ii),estatus + + call ftgdes(iunit, 8, ii, repeat, offset, status) + write(*,'(1x,A,2I5)')'Column 8 repeat and offset =', + & repeat,offset + end do + +C ##################################### +C # create another image extension # +C ##################################### + + + bitpix = 32 + naxis = 2 + naxes(1) = 10 + naxes(2) = 2 + npixels = 20 + + call ftiimg(iunit, bitpix, naxis, naxes, status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)')'Create image extension: ftiimg status =', + & status + +C initialize arrays of values to write to primary array + do ii = 1, npixels + boutarray(ii) = char(ii * 2 -2) + ioutarray(ii) = ii * 2 -2 + joutarray(ii) = ii * 2 -2 + koutarray(ii) = ii * 2 -2 + eoutarray(ii) = ii * 2 -2 + doutarray(ii) = ii * 2 -2 + end do + +C write a few pixels with each datatype + call ftpprb(iunit, 1, 1, 2, boutarray(1), status) + call ftppri(iunit, 1, 3, 2, ioutarray(3), status) + call ftpprj(iunit, 1, 5, 2, koutarray(5), status) + call ftppri(iunit, 1, 7, 2, ioutarray(7), status) + call ftpprj(iunit, 1, 9, 2, joutarray(9), status) + call ftppre(iunit, 1, 11, 2, eoutarray(11), status) + call ftpprd(iunit, 1, 13, 2, doutarray(13), status) + write(*,'(1x,A,I4)') 'ftppr status = ', status + + +C read back the pixels with each datatype + bnul = char(0) + inul = 0 + knul = 0 + jnul = 0 + enul = 0. + dnul = 0. + + call ftgpvb(iunit, 1, 1, 14, bnul, binarray, anynull, status) + call ftgpvi(iunit, 1, 1, 14, inul, iinarray, anynull, status) + call ftgpvj(iunit, 1, 1, 14, knul, kinarray, anynull, status) + call ftgpvj(iunit, 1, 1, 14, jnul, jinarray, anynull, status) + call ftgpve(iunit, 1, 1, 14, enul, einarray, anynull, status) + call ftgpvd(iunit, 1, 1, 14, dnul, dinarray, anynull, status) + + write(*,'(1x,A)')' ' + write(*,'(1x,A)') + & 'Image values written with ftppr and read with ftgpv:' + npixels = 14 + do jj = 1,ii + joutarray(jj) = ichar(binarray(jj)) + end do + + write(*,1501)(joutarray(ii),ii=1,npixels),anynull,'(byte)' +1501 format(1x,14i3,l3,1x,a) + write(*,1501)(iinarray(ii),ii=1,npixels),anynull,'(short)' + write(*,1501)(kinarray(ii),ii=1,npixels),anynull,'(int)' + write(*,1501)(jinarray(ii),ii=1,npixels),anynull,'(long)' + write(*,1502)(einarray(ii),ii=1,npixels),anynull,'(float)' + write(*,1502)(dinarray(ii),ii=1,npixels),anynull,'(double)' +1502 format(2x,14f3.0,l2,1x,a) + +C ########################################## +C # test world coordinate system routines # +C ########################################## + + xrval = 45.83D+00 + yrval = 63.57D+00 + xrpix = 256.D+00 + yrpix = 257.D+00 + xinc = -.00277777D+00 + yinc = .00277777D+00 + +C write the WCS keywords +C use example values from the latest WCS document + call ftpkyd(iunit, 'CRVAL1', xrval, 10, 'comment', status) + call ftpkyd(iunit, 'CRVAL2', yrval, 10, 'comment', status) + call ftpkyd(iunit, 'CRPIX1', xrpix, 10, 'comment', status) + call ftpkyd(iunit, 'CRPIX2', yrpix, 10, 'comment', status) + call ftpkyd(iunit, 'CDELT1', xinc, 10, 'comment', status) + call ftpkyd(iunit, 'CDELT2', yinc, 10, 'comment', status) +C call ftpkyd(iunit, 'CROTA2', rot, 10, 'comment', status) + call ftpkys(iunit, 'CTYPE1', xctype, 'comment', status) + call ftpkys(iunit, 'CTYPE2', yctype, 'comment', status) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4)')'Wrote WCS keywords status =', status + +C reset value, to make sure they are reread correctly + xrval = 0.D+00 + yrval = 0.D+00 + xrpix = 0.D+00 + yrpix = 0.D+00 + xinc = 0.D+00 + yinc = 0.D+00 + rot = 67.D+00 + + call ftgics(iunit, xrval, yrval, xrpix, + & yrpix, xinc, yinc, rot, ctype, status) + write(*,'(1x,A,I4)')'Read WCS keywords with ftgics status =', + & status + + xpix = 0.5D+00 + ypix = 0.5D+00 + + call ftwldp(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc, + & rot,ctype, xpos, ypos,status) + + write(*,'(1x,A,2f8.3)')' CRVAL1, CRVAL2 =', xrval,yrval + write(*,'(1x,A,2f8.3)')' CRPIX1, CRPIX2 =', xrpix,yrpix + write(*,'(1x,A,2f12.8)')' CDELT1, CDELT2 =', xinc,yinc + write(*,'(1x,A,f8.3,2A)')' Rotation =',rot,' CTYPE =',ctype + write(*,'(1x,A,I4)')'Calculated sky coord. with ftwldp status =', + & status + write(*,6501)xpix,ypix,xpos,ypos +6501 format(' Pixels (',f10.6,f10.6,') --> (',f10.6,f10.6,') Sky') + + call ftxypx(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc, + & rot,ctype, xpix, ypix,status) + write(*,'(1x,A,I4)') + & 'Calculated pixel coord. with ftxypx status =', status + write(*,6502)xpos,ypos,xpix,ypix +6502 format(' Sky (',f10.6,f10.6,') --> (',f10.6,f10.6,') Pixels') + + +C ###################################### +C # append another ASCII table # +C ###################################### + + + tform(1)= 'A15' + tform(2)= 'I11' + tform(3)= 'F15.6' + tform(4)= 'E13.5' + tform(5)= 'D22.14' + + tbcol(1)= 1 + tbcol(2)= 17 + tbcol(3)= 29 + tbcol(4)= 45 + tbcol(5)= 59 + rowlen = 80 + + ttype(1)= 'Name' + ttype(2)= 'Ivalue' + ttype(3)= 'Fvalue' + ttype(4)= 'Evalue' + ttype(5)= 'Dvalue' + + tunit(1)= ' ' + tunit(2)= 'm**2' + tunit(3)= 'cm' + tunit(4)= 'erg/s' + tunit(5)= 'km/s' + + nrows = 11 + tfields = 5 + tblname = 'new_table' + + call ftitab(iunit, rowlen, nrows, tfields, ttype, tbcol, + & tform, tunit, tblname, status) + write(*,'(1x,A)') ' ' + write(*,'(1x,A,I4)') 'ftitab status = ', status + + call ftpcls(iunit, 1, 1, 1, 3, onskey, status) +C write string values + +C initialize arrays of values to write to primary array + + do ii = 1,npixels + boutarray(ii) = char(ii * 3 -3) + ioutarray(ii) = ii * 3 -3 + joutarray(ii) = ii * 3 -3 + koutarray(ii) = ii * 3 -3 + eoutarray(ii) = ii * 3 -3 + doutarray(ii) = ii * 3 -3 + end do + + do ii = 2,5 +C loop over cols 2 - 5 + + call ftpclb(iunit, ii, 1, 1, 2, boutarray, status) + call ftpcli(iunit, ii, 3, 1, 2,ioutarray(3),status) + call ftpclj(iunit, ii, 5, 1, 2,joutarray(5),status) + call ftpcle(iunit, ii, 7, 1, 2,eoutarray(7),status) + call ftpcld(iunit, ii, 9, 1, 2,doutarray(9),status) + end do + write(*,'(1x,A,I4)') 'ftpcl status = ', status + +C read back the pixels with each datatype + call ftgcvb(iunit, 2, 1, 1, 10, bnul, binarray,anynull, + & status) + call ftgcvi(iunit, 2, 1, 1, 10, inul, iinarray,anynull, + & status) + call ftgcvj(iunit, 3, 1, 1, 10, knul, kinarray,anynull, + & status) + call ftgcvj(iunit, 3, 1, 1, 10, jnul, jinarray,anynull, + & status) + call ftgcve(iunit, 4, 1, 1, 10, enul, einarray,anynull, + & status) + call ftgcvd(iunit, 5, 1, 1, 10, dnul, dinarray,anynull, + & status) + + write(*,'(1x,A)') + &'Column values written with ftpcl and read with ftgcl: ' + npixels = 10 + do ii = 1,npixels + joutarray(ii) = ichar(binarray(ii)) + end do + write(*,1601)(joutarray(ii),ii = 1, npixels),anynull,'(byte) ' + write(*,1601)(iinarray(ii),ii = 1, npixels),anynull,'(short) ' + write(*,1601)(kinarray(ii),ii = 1, npixels),anynull,'(int) ' + write(*,1601)(jinarray(ii),ii = 1, npixels),anynull,'(long) ' + write(*,1602)(einarray(ii),ii = 1, npixels),anynull,'(float) ' + write(*,1602)(dinarray(ii),ii = 1, npixels),anynull,'(double) ' +1601 format(1x,10i3,l3,1x,a) +1602 format(2x,10f3.0,l2,1x,a) + +C ########################################################### +C # perform stress test by cycling thru all the extensions # +C ########################################################### + write(*,'(1x,A)')' ' + write(*,'(1x,A)')'Repeatedly move to the 1st 4 HDUs of the file: ' + + do ii = 1,10 + call ftmahd(iunit, 1, hdutype, status) + call ftghdn(iunit, hdunum) + call ftmrhd(iunit, 1, hdutype, status) + call ftghdn(iunit, hdunum) + call ftmrhd(iunit, 1, hdutype, status) + call ftghdn(iunit, hdunum) + call ftmrhd(iunit, 1, hdutype, status) + call ftghdn(iunit, hdunum) + call ftmrhd(iunit, -1, hdutype, status) + call ftghdn(iunit, hdunum) + if (status .gt. 0) go to 999 + end do + + write(*,'(1x,A)') ' ' + + checksum = 1234567890.D+00 + call ftesum(checksum, .false., asciisum) + write(*,'(1x,A,F13.1,2A)')'Encode checksum: ',checksum,' -> ', + & asciisum + checksum = 0 + call ftdsum(asciisum, 0, checksum) + write(*,'(1x,3A,F13.1)') 'Decode checksum: ',asciisum,' -> ', + & checksum + + call ftpcks(iunit, status) + +C don't print the CHECKSUM value because it is different every day +C because the current date is in the comment field. + + call ftgcrd(iunit, 'CHECKSUM', card, status) +C write(*,'(1x,A)') card + + call ftgcrd(iunit, 'DATASUM', card, status) + write(*,'(1x,A)') card(1:22) + + call ftgcks(iunit, datsum, checksum, status) + write(*,'(1x,A,F13.1,I4)') 'ftgcks data checksum, status = ', + & datsum, status + + call ftvcks(iunit, datastatus, hdustatus, status) + write(*,'(1x,A,3I4)')'ftvcks datastatus, hdustatus, status = ', + & datastatus, hdustatus, status + + call ftprec(iunit, + & 'new_key = ''written by fxprec'' / to change checksum',status) + call ftucks(iunit, status) + write(*,'(1x,A,I4)') 'ftupck status = ', status + + call ftgcrd(iunit, 'DATASUM', card, status) + write(*,'(1x,A)') card(1:22) + call ftvcks(iunit, datastatus, hdustatus, status) + write(*,'(1x,A,3I4)') 'ftvcks datastatus, hdustatus, status = ', + & datastatus, hdustatus, status + +C delete the checksum keywords, so that the FITS file is always +C the same, regardless of the date of when testprog is run. + + call ftdkey(iunit, 'CHECKSUM', status) + call ftdkey(iunit, 'DATASUM', status) + + +C ############################ +C # close file and quit # +C ############################ + + +999 continue +C jump here on error + + call ftclos(iunit, status) + write(*,'(1x,A,I4)') 'ftclos status = ', status + write(*,'(1x,A)')' ' + + write(*,'(1x,A)') + & 'Normally, there should be 8 error messages on the' + write(*,'(1x,A)') 'stack all regarding ''numerical overflows'':' + + call ftgmsg(errmsg) + nmsg = 0 + +998 continue + if (errmsg .ne. ' ')then + write(*,'(1x,A)') errmsg + nmsg = nmsg + 1 + call ftgmsg(errmsg) + go to 998 + end if + + if (nmsg .ne. 8)write(*,'(1x,A)') + & ' WARNING: Did not find the expected 8 error messages!' + + call ftgerr(status, errmsg) + write(*,'(1x,A)')' ' + write(*,'(1x,A,I4,2A)') 'Status =', status,': ', errmsg(1:50) + end diff --git a/pkg/tbtables/cfitsio/testf77.out b/pkg/tbtables/cfitsio/testf77.out new file mode 100644 index 00000000..56755b86 --- /dev/null +++ b/pkg/tbtables/cfitsio/testf77.out @@ -0,0 +1,746 @@ + FITSIO TESTPROG, v 2.401 + + Try opening then closing a nonexistent file: + ftopen iunit, status (expect an error) = 15 104 + ftclos status = 104 + + ftinit create new file status = 0 + + test writing of long string keywords: + 123456789012345678901234567890123456789012345678901234567890123456789012345 + '12345678901234567890123456789012345678901234567890123456789012345678' + 1234567890123456789012345678901234567890123456789012345678901234'6789012345 + '1234567890123456789012345678901234567890123456789012345678901234''67' + 1234567890123456789012345678901234567890123456789012345678901234''789012345 + '1234567890123456789012345678901234567890123456789012345678901234''''' + 1234567890123456789012345678901234567890123456789012345678901234567'9012345 + '1234567890123456789012345678901234567890123456789012345678901234567' + Wrote all Keywords successfully + ftflus status = 0 + + HDU number = 1 + Values read back from primary array (99 = null pixel) + The 1st, and every 4th pixel should be undefined: + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 T (ftgpvb) + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 T (ftgpvi) + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 T (ftgpvj) + 99. 2. 3.99. 5. 6. 7.99. 9.10.11.99.13.14.15.99.17.18.19.99. T (ftgpve) + 99. 2. 3.99. 5. 6. 7.99. 9.10.11.99.13.14.15.99.17.18.19.99. T (ftgpvd) + 0 2 3 0 5 6 7 0 9 10 11 0 13 14 15 0 17 18 19 0 T (ftgpfb) + 0 2 3 0 5 6 7 0 9 10 11 0 13 14 15 0 17 18 19 0 T (ftgpfi) + 0 2 3 0 5 6 7 0 9 10 11 0 13 14 15 0 17 18 19 0 T (ftgpfj) + 0. 2. 3. 0. 5. 6. 7. 0. 9.10.11. 0.13.14.15. 0.17.18.19. 0. T (ftgpfe) + 0. 2. 3. 0. 5. 6. 7. 0. 9.10.11. 0.13.14.15. 0.17.18.19. 0. T (ftgpfd) + + Closed then reopened the FITS file 10 times. + + HDU number = 1 + Read back keywords: + simple, bitpix, naxis, naxes = T 32 2 10 2 + pcount, gcount, extend = 0 1 T + KEY_PREC= 'This keyword was written by fxprec' / comment goes here + KEY_PREC 'This keyword was written by fxprec comment goes here + KEY_PREC= 'This keyword was written by fxprec' / comment goes here + KY_PKNS1 :'first string' :fxpkns comment + KEY_PKYS :value_string :fxpkys comment 0 + KEY_PKYL : T:fxpkyl comment 0 + KEY_PKYJ : 11:fxpkyj comment 0 + KEY_PKYE : 11.00000:fxpkyj comment 0 + KEY_PKYD : 11.00000:fxpkyj comment 0 + KEY_PKYS :value_string :fxpkys comment 0 + KEY_PKYL : T:fxpkyl comment 0 + KEY_PKYJ : 11:fxpkyj comment 0 + KEY_PKYE : 13.13131:fxpkye comment 0 + KEY_PKYD : 15.15152:fxpkyd comment 0 + KEY_PKYF : 12.12121:fxpkyf comment 0 + KEY_PKYE : 13.13131:fxpkye comment 0 + KEY_PKYG : 14.141414141414:fxpkyg comment 0 + KEY_PKYD : 15.151515151515:fxpkyd comment 0 + KEY_PKYT : 12345678:0.12345678901235fxpkyt comment 0 + KEY_PKYJ : 11:[km/s/Mpc] fxpkyj comment 0 + keyword unit=km/s/Mpc + KEY_PKYJ : 11:fxpkyj comment 0 + keyword unit= + KEY_PKYJ : 11:[feet/second/second] fxpkyj comment 0 + keyword unit=feet/second/second + KEY_PKLS long string value = This is a very long string value that is continued + over more than one keyword. + header contains 61 keywords; located at keyword 23 + ftgkns: first string second string + ftgknl: T F T + ftgknj: 11 12 13 + ftgkne: 13.13131 14.14141 15.15152 + ftgknd: 15.15152 16.16162 17.17172 + + Before deleting the HISTORY and DATE keywords... + COMMENT + HISTORY + DATE + KY_PKNS1 + + After deleting the keywords... + COMMENT This keyword was written by fxpcom. + KY_PKNS1= 'first string' / fxpkns comment + + After inserting the keywords... + COMMENT continued over multiple keywords. The HEASARC convention uses the & + KY_IREC = 'This keyword inserted by fxirec' + KY_IKYS = 'insert_value_string' / ikys comment + KY_IKYJ = 49 / ikyj comment + KY_IKYL = T / ikyl comment + KY_IKYE = 1.2346E+01 / ikye comment + KY_IKYD = 1.23456789012346E+01 / ikyd comment + KY_IKYF = 12.3456 / ikyf comment + KY_IKYG = 12.3456789012346 / ikyg comment + COMMENT character at the end of each substring which is then continued + + After modifying the keywords... + COMMENT This keyword was modified by fxmrec + KY_MREC = 'This keyword was modified by fxmcrd' + NEWIKYS = 'modified_string' / ikys comment + KY_IKYJ = 50 / This is a modified comment + KY_IKYL = F / ikyl comment + KY_IKYE = -1.2346E+01 / ikye comment + KY_IKYD = -1.23456789012346E+01 / modified comment + KY_IKYF = -12.3456 / ikyf comment + KY_IKYG = -12.3456789012346 / ikyg comment + COMMENT character at the end of each substring which is then continued + + After updating the keywords... + COMMENT This keyword was modified by fxmrec + KY_UCRD = 'This keyword was updated by fxucrd' + NEWIKYS = 'updated_string' / ikys comment + KY_IKYJ = 51 / This is a modified comment + KY_IKYL = T / ikyl comment + KY_IKYE = -1.3346E+01 / ikye comment + KY_IKYD = -1.33456789012346E+01 / modified comment + KY_IKYF = -13.3456 / ikyf comment + KY_IKYG = -13.3456789012346 / ikyg comment + COMMENT character at the end of each substring which is then continued + + Keywords found using wildcard search (should be 9)... + KEY_PKYS= 'value_string' / fxpkys comment + KEY_PKYL= T / fxpkyl comment + KEY_PKYJ= 11 / [feet/second/second] fxpkyj comment + KEY_PKYF= 12.12121 / fxpkyf comment + KEY_PKYE= 1.313131E+01 / fxpkye comment + KEY_PKYG= 14.14141414141414 / fxpkyg comment + KEY_PKYD= 1.51515151515152E+01 / fxpkyd comment + NEWIKYS = 'updated_string' / ikys comment + KEY_PKYT= 12345678.1234567890123456 / fxpkyt comment + + ftibin status = 0 + HDU number = 2 + header contains 33 keywords located at keyword 1 + header contains 33 keywords with room for 74 more + TDIM3 = (1,2,8) 3 1 2 8 + ftpcl_ status = 0 + + Find the column numbers a returned status value of 237 is + expected and indicates that more than one column name matches + the input column name template. Status = 219 indicates that + there was no matching column name. + Column Xvalue is number 3 status = 0 + Column Avalue is number 1 status = 237 + Column Lvalue is number 2 status = 237 + Column Xvalue is number 3 status = 237 + Column Bvalue is number 4 status = 237 + Column Ivalue is number 5 status = 237 + Column Jvalue is number 6 status = 237 + Column Evalue is number 7 status = 237 + Column Dvalue is number 8 status = 237 + Column Cvalue is number 9 status = 237 + Column Mvalue is number 10 status = 237 + Column is number 0 status = 219 + + Information about each column: + 15A 16 15 15 Avalue A 1.00 0.00 1234554321 + 1L 14 1 1 Lvalue m**2 L 1.00 0.00 1234554321 + 16X 1 16 1 Xvalue cm X 1.00 0.00 1234554321 + 1B 11 1 1 Bvalue erg/s B 1.00 0.00 99 + 1I 21 1 2 Ivalue km/s I 1.00 0.00 99 + 1J 41 1 4 Jvalue J 1.00 0.00 99 + 1E 42 1 4 Evalue E 1.00 0.00 1234554321 + 1D 82 1 8 Dvalue D 1.00 0.00 1234554321 + 1C 83 1 8 Cvalue C 1.00 0.00 1234554321 + 1M 163 1 16 Mvalue M 1.00 0.00 1234554321 + + ftitab status = 0 + HDU number = 2 + ftpcl_ status = 0 + + ASCII table: rowlen, nrows, tfields, extname: 76 11 5 Test-ASCII + Name 1 A15 + Ivalue 17 I10 m**2 + Fvalue 28 F14.6 cm + Evalue 43 E12.5 erg/s + Dvalue 56 D21.14 km/s + + Data values read from ASCII table: + first string 1 1 1 1. 1. + second string 2 2 2 2. 2. + 3 3 3 3. 3. + UNDEFINED 4 4 4 4. 4. + 5 5 5 5. 5. + 6 6 6 6. 6. + 7 7 7 7. 7. + 8 8 8 8. 8. + 9 9 9 9. 9. + 10 10 10 10.10. + 99 99 99 99.99. + + 1 1.000000 1.00000E+00 1.00000000000000E+00second string + + Column name is number 1 status = 0 + Column Ivalue is number 2 status = 237 + Column Fvalue is number 3 status = 237 + Column Evalue is number 4 status = 237 + Column Dvalue is number 5 status = 237 + Column is number 0 status = 219 + A15 16 1 15 Name 1 1.00 0.00 null1 + I10 41 1 10 Ivalue 17 m**2 1.00 0.00 null2 + F14.6 82 1 14 Fvalue 28 cm 1.00 0.00 null3 + E12.5 42 1 12 Evalue 43 erg/s 1.00 0.00 null4 + D21.14 82 1 21 Dvalue 56 km/s 1.00 0.00 null5 + + + Data values after inserting 3 rows after row 2: + first string 1 1 1 1. 1. + second string 2 2 2 2. 2. + 0 0 0 0. 0. + 0 0 0 0. 0. + 0 0 0 0. 0. + 3 3 3 3. 3. + UNDEFINED 4 4 4 4. 4. + 5 5 5 5. 5. + 6 6 6 6. 6. + 7 7 7 7. 7. + 8 8 8 8. 8. + 9 9 9 9. 9. + 10 10 10 10.10. + 99 99 99 99.99. + + Data values after deleting 2 rows at row 10: + first string 1 1 1 1. 1. + second string 2 2 2 2. 2. + 0 0 0 0. 0. + 0 0 0 0. 0. + 0 0 0 0. 0. + 3 3 3 3. 3. + UNDEFINED 4 4 4 4. 4. + 5 5 5 5. 5. + 6 6 6 6. 6. + 9 9 9 9. 9. + 10 10 10 10.10. + 99 99 99 99.99. + + Data values after deleting column 3: + first string 1 1 1. 1. + second string 2 2 2. 2. + 0 0 0. 0. + 0 0 0. 0. + 0 0 0. 0. + 3 3 3. 3. + UNDEFINED 4 4 4. 4. + 5 5 5. 5. + 6 6 6. 6. + 9 9 9. 9. + 10 10 10.10. + 99 99 99.99. + + Data values after inserting column 5: + first string 1 1 1. 1. 0 + second string 2 2 2. 2. 0 + 0 0 0. 0. 0 + 0 0 0. 0. 0 + 0 0 0. 0. 0 + 3 3 3. 3. 0 + UNDEFINED 4 4 4. 4. 0 + 5 5 5. 5. 0 + 6 6 6. 6. 0 + 9 9 9. 9. 0 + 10 10 10.10. 0 + 99 99 99.99. 0 + HDU number = 3 + + Moved to binary table + header contains 37 keywords with room for 70 more + + Binary table: nrows, tfields, extname, pcount: 21 10Test-BINTABLE 0 + Avalue 15A + Lvalue 1L m**2 + Xvalue 16X cm + Bvalue 1B erg/s + Ivalue 1I km/s + Jvalue 1J + Evalue 1E + Dvalue 1D + Cvalue 1C + Mvalue 1M + + Data values read from binary table: + Bit column (X) data values: + FTFFTTFF FTTTFFFF TTTTFFFF FTTTTTFF FFFFFFFF + + null string column value (should be blank): + + Read columns with ftgcv_: + first string F 76 1 1 1 1. 1. 1. -2. 1. -2. + second string T 112 2 2 2 2. 2. 3. -4. 3. -4. + F 240 3 3 3 3. 3. 5. -6. 5. -6. + NOT DEFINED F 124 0 -4 -4 -4. -4. 7. -8. 7. -8. + NOT DEFINED T 0 5 5 5 5. 5. 9. -10. 9. -10. + NOT DEFINED T 0 0 -6 -6 -6. -6. 11. -12. 11. -12. + NOT DEFINED F 0 7 7 7 7. 7. 13. -14. 13. -14. + NOT DEFINED F 0 0 -8 -8 -8. -8. 15. -16. 15. -16. + NOT DEFINED F 0 9 9 9 9. 9. 17. -18. 17. -18. + NOT DEFINED T 0 0 -10 -10 -10. -10. 19. -20. 19. -20. + NOT DEFINED F 0 98 98 98 98. 98. 0. 0. 0. 0. + NOT DEFINED T 0 12 12 12 12. 12. 0. 0. 0. 0. + NOT DEFINED F 0 98 98 98 98. 98. 0. 0. 0. 0. + NOT DEFINED F 0 0 -14 -14 -14. -14. 0. 0. 0. 0. + NOT DEFINED F 0 0 98 98 98. 98. 0. 0. 0. 0. + NOT DEFINED F 0 0 -16 -16 -16. -16. 0. 0. 0. 0. + NOT DEFINED T 0 0 98 98 98. 98. 0. 0. 0. 0. + NOT DEFINED T 0 0 -18 -18 -18. -18. 0. 0. 0. 0. + NOT DEFINED T 0 0 98 98 98. 98. 0. 0. 0. 0. + NOT DEFINED T 0 0 -20 -20 -20. -20. 0. 0. 0. 0. + NOT DEFINED F 0 0 98 98 98. 98. 0. 0. 0. 0. + + Read columns with ftgcf_: + first string F 76 1 1 1 1. 1. 1. -2. 1. -2. + second string T 112 2 2 2 2. 2. 3. -4. 3. -4. + F 240 3 3 3 3. 3. 5. -6. 5. -6. + F 124 0 -4 -4 -4. -4. 7. -8. 7. -8. + T 0 5 5 5 5. 5. 9. -10. 9. -10. + T 0 0 -6 -6 -6. -6. 11. -12. 11. -12. + F 0 7 7 7 7. 7. 13. -14. 13. -14. + F 0 0 -8 -8 -8. -8. 15. -16. 15. -16. + F 0 9 9 9 9. 9. 17. -18. 17. -18. + T 0 0 -10 -10 -10. -10. 19. -20. 19. -20. + F 0 99 99 + T 0 12 12 + F 0 99 99 + F 0 0 -14 + F 0 0 99 + F 0 0 -16 + T 0 0 99 + T 0 0 -18 + T 0 0 99 + T 0 0 -20 + F 0 0 99 + + Data values after inserting 3 rows after row 2: + first string 1 1 1 1. 1. + second string 2 2 2 2. 2. + NOT DEFINED 0 0 0 0. 0. + NOT DEFINED 0 0 0 0. 0. + NOT DEFINED 0 0 0 0. 0. + 3 3 3 3. 3. + NOT DEFINED 0 -4 -4 -4. -4. + NOT DEFINED 5 5 5 5. 5. + NOT DEFINED 0 -6 -6 -6. -6. + NOT DEFINED 7 7 7 7. 7. + NOT DEFINED 0 -8 -8 -8. -8. + NOT DEFINED 9 9 9 9. 9. + NOT DEFINED 0 -10 -10 -10. -10. + NOT DEFINED 98 98 98 98. 98. + + Data values after deleting 2 rows at row 10: + first string 1 1 1 1. 1. + second string 2 2 2 2. 2. + NOT DEFINED 0 0 0 0. 0. + NOT DEFINED 0 0 0 0. 0. + NOT DEFINED 0 0 0 0. 0. + 3 3 3 3. 3. + NOT DEFINED 0 -4 -4 -4. -4. + NOT DEFINED 5 5 5 5. 5. + NOT DEFINED 0 -6 -6 -6. -6. + NOT DEFINED 9 9 9 9. 9. + NOT DEFINED 0 -10 -10 -10. -10. + NOT DEFINED 98 98 98 98. 98. + + Data values after deleting column 6: + first string 1 1 1. 1. + second string 2 2 2. 2. + NOT DEFINED 0 0 0. 0. + NOT DEFINED 0 0 0. 0. + NOT DEFINED 0 0 0. 0. + 3 3 3. 3. + NOT DEFINED 0 -4 -4. -4. + NOT DEFINED 5 5 5. 5. + NOT DEFINED 0 -6 -6. -6. + NOT DEFINED 9 9 9. 9. + NOT DEFINED 0 -10 -10. -10. + NOT DEFINED 98 98 98. 98. + + Data values after inserting column 8: + first string 1 1 1. 1. 0 + second string 2 2 2. 2. 0 + NOT DEFINED 0 0 0. 0. 0 + NOT DEFINED 0 0 0. 0. 0 + NOT DEFINED 0 0 0. 0. 0 + 3 3 3. 3. 0 + NOT DEFINED 0 -4 -4. -4. 0 + NOT DEFINED 5 5 5. 5. 0 + NOT DEFINED 0 -6 -6. -6. 0 + NOT DEFINED 9 9 9. 9. 0 + NOT DEFINED 0 -10 -10. -10. 0 + NOT DEFINED 98 98 98. 98. 0 + + Values after setting 1st 10 elements in column 8 = null: + first string 1 1 1. 1. 98 + second string 2 2 2. 2. 98 + NOT DEFINED 0 0 0. 0. 98 + NOT DEFINED 0 0 0. 0. 98 + NOT DEFINED 0 0 0. 0. 98 + 3 3 3. 3. 98 + NOT DEFINED 0 -4 -4. -4. 98 + NOT DEFINED 5 5 5. 5. 98 + NOT DEFINED 0 -6 -6. -6. 98 + NOT DEFINED 9 9 9. 9. 98 + NOT DEFINED 0 -10 -10. -10. 0 + NOT DEFINED 98 98 98. 98. 0 + + ftibin status = 0 + HDU number = 2 + 0 1000 10000 33000 66000 -999 + 0 1000 10000 32768 65535 -999 + 0 1000 10000 32800 65500 -999 + + 0 1 10 33 66 -999 + -32768-31768-22768 0 32767 -999 + -1 9 99 327 654 -999 + + Create image extension: ftiimg status = 0 + HDU number = 3 + + Wrote whole 2D array: ftp2di status = 0 + + Read whole 2D array: ftg2di status = 0 + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 0 0 0 + 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 0 0 0 0 + 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 0 0 0 0 + 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 0 0 0 0 + 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 0 0 0 0 + 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 0 0 0 0 + 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 0 0 0 0 + 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 0 0 0 0 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 0 0 0 0 + 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 0 0 0 0 + 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 0 0 0 0 + 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 0 0 0 0 + 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 0 0 0 0 + 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 0 0 0 0 + 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 0 0 0 0 + 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 0 0 0 0 + 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 0 0 0 0 + 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 0 0 0 0 + 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 0 0 0 0 + 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 0 0 0 0 + 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 0 0 0 0 + 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 0 0 0 0 + 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 0 0 0 0 + 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 0 0 0 0 + 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + + + Wrote subset 2D array: ftpssi status = 0 + + Read whole 2D array: ftg2di status = 0 + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 0 0 0 + 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 0 0 0 0 + 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 0 0 0 0 + 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 0 0 0 0 + 40 41 42 43 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 54 0 0 0 0 + 50 51 52 53 -10 -11 -12 -13 -14 -15 -16 -17 -18 -19 64 0 0 0 0 + 60 61 62 63 -20 -21 -22 -23 -24 -25 -26 -27 -28 -29 74 0 0 0 0 + 70 71 72 73 -30 -31 -32 -33 -34 -35 -36 -37 -38 -39 84 0 0 0 0 + 80 81 82 83 -40 -41 -42 -43 -44 -45 -46 -47 -48 -49 94 0 0 0 0 + 90 91 92 93 -50 -51 -52 -53 -54 -55 -56 -57 -58 -59 104 0 0 0 0 + 100 101 102 103 -60 -61 -62 -63 -64 -65 -66 -67 -68 -69 114 0 0 0 0 + 110 111 112 113 -70 -71 -72 -73 -74 -75 -76 -77 -78 -79 124 0 0 0 0 + 120 121 122 123 -80 -81 -82 -83 -84 -85 -86 -87 -88 -89 134 0 0 0 0 + 130 131 132 133 -90 -91 -92 -93 -94 -95 -96 -97 -98 -99 144 0 0 0 0 + 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 0 0 0 0 + 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 0 0 0 0 + 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 0 0 0 0 + 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 0 0 0 0 + 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 0 0 0 0 + 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 0 0 0 0 + 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 0 0 0 0 + 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 0 0 0 0 + 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 0 0 0 0 + 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 0 0 0 0 + 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + + + Read subset of 2D array: ftgsvi status = 0 + 41 43 -1 -3 -5 71 73 -31 -33 -35 + + Create image extension: ftiimg status = 0 + HDU number = 4 + Create temporary file: ftinit status = 0 + Copy image extension to primary array of tmp file. + ftcopy status = 0 + SIMPLE = T / file does conform to FITS standard + BITPIX = 16 / number of bits per data pixel + NAXIS = 2 / number of data axes + NAXIS1 = 15 / length of data axis 1 + NAXIS2 = 25 / length of data axis 2 + EXTEND = T / FITS dataset may contain extensions + Delete the tmp file: ftdelt status = 0 + Delete the image extension hdutype, status = 1 0 + HDU number = 4 + ftcrhd status = 0 + Variable length arrays: ftphbn status = 0 + ftpcl_ status = 0 + PCOUNT = 4446 + HDU number = 6 + A 0 + L 0 F + X 0 F + B 1 0 + I 1 0 + J 1 0 + E 1. 0. + D 1. 0. + Column 8 repeat and offset = 1 14 + A ab 0 + L 0 F T + X 0 F T + B 99 2 0 + I 99 2 0 + J 99 2 0 + E 99. 2. 0. + D 99. 2. 0. + Column 8 repeat and offset = 2 49 + A abc 0 + L 0 F F F + X 0 F T F + B 1 99 3 0 + I 1 99 3 0 + J 1 99 3 0 + E 1.99. 3. 0. + D 1.99. 3. 0. + Column 8 repeat and offset = 3 105 + A abcd 0 + L 0 F T F F + X 0 F T F F + B 1 2 99 4 0 + I 1 2 99 4 0 + J 1 2 99 4 0 + E 1. 2.99. 4. 0. + D 1. 2.99. 4. 0. + Column 8 repeat and offset = 4 182 + A abcde 0 + L 0 F T F F T + X 0 F T F F T + B 1 2 3 99 5 0 + I 1 2 3 99 5 0 + J 1 2 3 99 5 0 + E 1. 2. 3.99. 5. 0. + D 1. 2. 3.99. 5. 0. + Column 8 repeat and offset = 5 280 + A abcdef 0 + L 0 F T F F F T + X 0 F T F F T T + B 1 2 3 4 99 6 0 + I 1 2 3 4 99 6 0 + J 1 2 3 4 99 6 0 + E 1. 2. 3. 4.99. 6. 0. + D 1. 2. 3. 4.99. 6. 0. + Column 8 repeat and offset = 6 399 + A abcdefg 0 + L 0 F T F F T F F + X 0 F T F F T T F + B 1 2 3 4 5 99 7 0 + I 1 2 3 4 5 99 7 0 + J 1 2 3 4 5 99 7 0 + E 1. 2. 3. 4. 5.99. 7. 0. + D 1. 2. 3. 4. 5.99. 7. 0. + Column 8 repeat and offset = 7 539 + A abcdefgh 0 + L 0 F T F F T T F F + X 0 F T F F T T F F + B 1 2 3 4 5 6 99 8 0 + I 1 2 3 4 5 6 99 8 0 + J 1 2 3 4 5 6 99 8 0 + E 1. 2. 3. 4. 5. 6.99. 8. 0. + D 1. 2. 3. 4. 5. 6.99. 8. 0. + Column 8 repeat and offset = 8 700 + A abcdefghi 0 + L 0 F T F F T T F F F + X 0 F T F F T T F F F + B 1 2 3 4 5 6 7 99 9 0 + I 1 2 3 4 5 6 7 99 9 0 + J 1 2 3 4 5 6 7 99 9 0 + E 1. 2. 3. 4. 5. 6. 7.99. 9. 0. + D 1. 2. 3. 4. 5. 6. 7.99. 9. 0. + Column 8 repeat and offset = 9 883 + A abcdefghij 0 + L 0 F T F F T T F F F T + X 0 F T F F T T F F F T + B 1 2 3 4 5 6 7 8 99 10 0 + I 1 2 3 4 5 6 7 8 99 10 0 + J 1 2 3 4 5 6 7 8 99 10 0 + E 1. 2. 3. 4. 5. 6. 7. 8.99.10. 0. + D 1. 2. 3. 4. 5. 6. 7. 8.99.10. 0. + Column 8 repeat and offset = 10 1087 + A abcdefghijk 0 + L 0 F T F F T T F F F F T + X 0 F T F F T T F F F T T + B 1 2 3 4 5 6 7 8 9 99 11 0 + I 1 2 3 4 5 6 7 8 9 99 11 0 + J 1 2 3 4 5 6 7 8 9 99 11 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.99.11. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.99.11. 0. + Column 8 repeat and offset = 11 1312 + A abcdefghijkl 0 + L 0 F T F F T T F F F T F T + X 0 F T F F T T F F F T T T + B 1 2 3 4 5 6 7 8 9 10 99 12 0 + I 1 2 3 4 5 6 7 8 9 10 99 12 0 + J 1 2 3 4 5 6 7 8 9 10 99 12 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.99.12. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.99.12. 0. + Column 8 repeat and offset = 12 1558 + A abcdefghijklm 0 + L 0 F T F F T T F F F T T F F + X 0 F T F F T T F F F T T T F + B 1 2 3 4 5 6 7 8 9 10 11 99 13 0 + I 1 2 3 4 5 6 7 8 9 10 11 99 13 0 + J 1 2 3 4 5 6 7 8 9 10 11 99 13 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.99.13. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.99.13. 0. + Column 8 repeat and offset = 13 1825 + A abcdefghijklmn 0 + L 0 F T F F T T F F F T T T F F + X 0 F T F F T T F F F T T T F F + B 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.99.14. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.99.14. 0. + Column 8 repeat and offset = 14 2113 + A abcdefghijklmno 0 + L 0 F T F F T T F F F T T T F F F + X 0 F T F F T T F F F T T T F F F + B 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.99.15. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.99.15. 0. + Column 8 repeat and offset = 15 2422 + A abcdefghijklmnop 0 + L 0 F T F F T T F F F T T T F F F F + X 0 F T F F T T F F F T T T F F F F + B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.99.16. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.99.16. 0. + Column 8 repeat and offset = 16 2752 + A abcdefghijklmnopq 0 + L 0 F T F F T T F F F T T T F F F F T + X 0 F T F F T T F F F T T T F F F F T + B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.99.17. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.99.17. 0. + Column 8 repeat and offset = 17 3104 + A abcdefghijklmnopqr 0 + L 0 F T F F T T F F F T T T F F F F F T + X 0 F T F F T T F F F T T T F F F F T T + B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.16.99.18. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.16.99.18. 0. + Column 8 repeat and offset = 18 3477 + A abcdefghijklmnopqrs 0 + L 0 F T F F T T F F F T T T F F F F T F T + X 0 F T F F T T F F F T T T F F F F T T T + B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.16.17.99.19. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.16.17.99.19. 0. + Column 8 repeat and offset = 19 3871 + A abcdefghijklmnopqrst 0 + L 0 F T F F T T F F F T T T F F F F T T F T + X 0 F T F F T T F F F T T T F F F F T T T T + B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 + I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 + J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 + E 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.16.17.18.99.20. 0. + D 1. 2. 3. 4. 5. 6. 7. 8. 9.10.11.12.13.14.15.16.17.18.99.20. 0. + Column 8 repeat and offset = 20 4286 + + Create image extension: ftiimg status = 0 + ftppr status = 0 + + Image values written with ftppr and read with ftgpv: + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 F (byte) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 F (short) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 F (int) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 F (long) + 0. 2. 4. 6. 8.10.12.14.16.18.20.22.24.26. F (float) + 0. 2. 4. 6. 8.10.12.14.16.18.20.22.24.26. F (double) + + Wrote WCS keywords status = 0 + Read WCS keywords with ftgics status = 0 + CRVAL1, CRVAL2 = 45.830 63.570 + CRPIX1, CRPIX2 = 256.000 257.000 + CDELT1, CDELT2 = -0.00277777 0.00277777 + Rotation = 0.000 CTYPE =-TAN + Calculated sky coord. with ftwldp status = 0 + Pixels ( 0.500000 0.500000) --> ( 47.385204 62.848968) Sky + Calculated pixel coord. with ftxypx status = 0 + Sky ( 47.385204 62.848968) --> ( 0.500000 0.500000) Pixels + + ftitab status = 0 + ftpcl status = 0 + Column values written with ftpcl and read with ftgcl: + 0 3 6 9 12 15 18 21 24 27 F (byte) + 0 3 6 9 12 15 18 21 24 27 F (short) + 0 3 6 9 12 15 18 21 24 27 F (int) + 0 3 6 9 12 15 18 21 24 27 F (long) + 0. 3. 6. 9.12.15.18.21.24.27. F (float) + 0. 3. 6. 9.12.15.18.21.24.27. F (double) + + Repeatedly move to the 1st 4 HDUs of the file: + + Encode checksum: 1234567890.0 -> dCW2fBU0dBU0dBU0 + Decode checksum: dCW2fBU0dBU0dBU0 -> 1234567890.0 + DATASUM = '2338390162' + ftgcks data checksum, status = 2338390162.0 0 + ftvcks datastatus, hdustatus, status = 1 1 0 + ftupck status = 0 + DATASUM = '2338390162' + ftvcks datastatus, hdustatus, status = 1 1 0 + ftclos status = 0 + + Normally, there should be 8 error messages on the + stack all regarding 'numerical overflows': + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + + Status = 0: OK - no error diff --git a/pkg/tbtables/cfitsio/testf77.std b/pkg/tbtables/cfitsio/testf77.std new file mode 100644 index 00000000..ec1281fc Binary files /dev/null and b/pkg/tbtables/cfitsio/testf77.std differ diff --git a/pkg/tbtables/cfitsio/testprog.c b/pkg/tbtables/cfitsio/testprog.c new file mode 100644 index 00000000..cd4724ea --- /dev/null +++ b/pkg/tbtables/cfitsio/testprog.c @@ -0,0 +1,2588 @@ +#include +#include +#include "fitsio.h" +int main(void); + +int main() +{ +/* + This is a big and complicated program that tests most of + the cfitsio routines. This code does not represent + the most efficient method of reading or writing FITS files + because this code is primarily designed to stress the cfitsio + library routines. +*/ + char asciisum[17]; + unsigned long checksum, datsum; + int datastatus, hdustatus, filemode; + int status, simple, bitpix, naxis, extend, hdutype, hdunum, tfields; + long ii, jj, extvers; + int nkeys, nfound, colnum, typecode, signval,nmsg; + char cval; + long repeat, offset, width, jnulval; + int anynull; + float vers; + unsigned char xinarray[21], binarray[21], boutarray[21], bnul; + short iinarray[21], ioutarray[21], inul; + int kinarray[21], koutarray[21], knul; + long jinarray[21], joutarray[21], jnul; + float einarray[21], eoutarray[21], enul, cinarray[42]; + double dinarray[21], doutarray[21], dnul, minarray[42]; + double scale, zero; + long naxes[3], pcount, gcount, npixels, nrows, rowlen, firstpix[3]; + int existkeys, morekeys, keynum; + + char larray[42], larray2[42], colname[70], tdisp[40], nulstr[40]; + char oskey[] = "value_string"; + char iskey[21]; + int olkey = 1; + int ilkey; + short oshtkey, ishtkey; + long ojkey = 11, ijkey; + long otint = 12345678; + float ofkey = 12.121212; + float oekey = 13.131313, iekey; + double ogkey = 14.1414141414141414; + double odkey = 15.1515151515151515, idkey; + double otfrac = .1234567890123456; + + double xrval,yrval,xrpix,yrpix,xinc,yinc,rot,xpos,ypos,xpix,ypix; + char xcoordtype[] = "RA---TAN"; + char ycoordtype[] = "DEC--TAN"; + char ctype[5]; + + char *lsptr; /* pointer to long string value */ + char comm[73]; + char *comms[3]; + char *inskey[21]; + char *onskey[3] = {"first string", "second string", " "}; + char *inclist[2] = {"key*", "newikys"}; + char *exclist[2] = {"key_pr*", "key_pkls"}; + + int onlkey[3] = {1, 0, 1}, inlkey[3]; + long onjkey[3] = {11, 12, 13}, injkey[3]; + float onfkey[3] = {12.121212, 13.131313, 14.141414}; + float onekey[3] = {13.131313, 14.141414, 15.151515}, inekey[3]; + double ongkey[3] = {14.1414141414141414, 15.1515151515151515, + 16.1616161616161616}; + double ondkey[3] = {15.1515151515151515, 16.1616161616161616, + 17.1717171717171717}, indkey[3]; + + long tbcol[5] = {1, 17, 28, 43, 56}; + + char filename[40], card[FLEN_CARD], card2[FLEN_CARD]; + char keyword[FLEN_KEYWORD]; + char value[FLEN_VALUE], comment[FLEN_COMMENT]; + unsigned char uchars[80]; + + fitsfile *fptr, *tmpfptr; + char *ttype[10], *tform[10], *tunit[10]; + char tblname[40]; + char binname[] = "Test-BINTABLE"; + char templt[] = "testprog.tpt"; + char errmsg[FLEN_ERRMSG]; + short imgarray[30][19], imgarray2[20][10]; + long fpixels[2], lpixels[2], inc[2]; + + status = 0; + strcpy(tblname, "Test-ASCII"); + + ffvers(&vers); + printf("CFITSIO TESTPROG, v%.3f\n\n",vers); + + printf("Try opening then closing a nonexistent file:\n"); + ffopen(&fptr, "tq123x.kjl", READWRITE, &status); + printf(" ffopen fptr, status = %lu %d (expect an error)\n", + (unsigned long) fptr, status); + ffclos(fptr, &status); + printf(" ffclos status = %d\n\n", status); + ffcmsg(); + status = 0; + + for (ii = 0; ii < 21; ii++) /* allocate space for string column value */ + inskey[ii] = (char *) malloc(21); + + for (ii = 0; ii < 10; ii++) + { + ttype[ii] = (char *) malloc(20); + tform[ii] = (char *) malloc(20); + tunit[ii] = (char *) malloc(20); + } + + comms[0] = comm; + + /* delete previous version of the file, if it exists (with ! prefix) */ + strcpy(filename, "!testprog.fit"); + + status = 0; + + /* + ##################### + # create FITS file # + ##################### + */ + + ffinit(&fptr, filename, &status); + printf("ffinit create new file status = %d\n", status); + if (status) + goto errstatus; + + filename[0] = '\0'; + ffflnm(fptr, filename, &status); + + ffflmd(fptr, &filemode, &status); + printf("Name of file = %s, I/O mode = %d\n", filename, filemode); + simple = 1; + bitpix = 32; + naxis = 2; + naxes[0] = 10; + naxes[1] = 2; + npixels = 20; + pcount = 0; + gcount = 1; + extend = 1; + /* + ############################ + # write single keywords # + ############################ + */ + + if (ffphps(fptr, bitpix, naxis, naxes, &status) > 0) + printf("ffphps status = %d\n", status); + + if (ffprec(fptr, + "key_prec= 'This keyword was written by fxprec' / comment goes here", + &status) > 0 ) + printf("ffprec status = %d\n", status); + + printf("\ntest writing of long string keywords:\n"); + strcpy(card, "1234567890123456789012345678901234567890"); + strcat(card, "12345678901234567890123456789012345"); + ffpkys(fptr, "card1", card, "", &status); + ffgkey(fptr, "card1", card2, comment, &status); + printf(" %s\n%s\n", card, card2); + + strcpy(card, "1234567890123456789012345678901234567890"); + strcat(card, "123456789012345678901234'6789012345"); + ffpkys(fptr, "card2", card, "", &status); + ffgkey(fptr, "card2", card2, comment, &status); + printf(" %s\n%s\n", card, card2); + + strcpy(card, "1234567890123456789012345678901234567890"); + strcat(card, "123456789012345678901234''789012345"); + ffpkys(fptr, "card3", card, "", &status); + ffgkey(fptr, "card3", card2, comment, &status); + printf(" %s\n%s\n", card, card2); + + strcpy(card, "1234567890123456789012345678901234567890"); + strcat(card, "123456789012345678901234567'9012345"); + ffpkys(fptr, "card4", card, "", &status); + ffgkey(fptr, "card4", card2, comment, &status); + printf(" %s\n%s\n", card, card2); + + if (ffpkys(fptr, "key_pkys", oskey, "fxpkys comment", &status) > 0) + printf("ffpkys status = %d\n", status); + + if (ffpkyl(fptr, "key_pkyl", olkey, "fxpkyl comment", &status) > 0) + printf("ffpkyl status = %d\n", status); + + if (ffpkyj(fptr, "key_pkyj", ojkey, "fxpkyj comment", &status) > 0) + printf("ffpkyj status = %d\n", status); + + if (ffpkyf(fptr, "key_pkyf", ofkey, 5, "fxpkyf comment", &status) > 0) + printf("ffpkyf status = %d\n", status); + + if (ffpkye(fptr, "key_pkye", oekey, 6, "fxpkye comment", &status) > 0) + printf("ffpkye status = %d\n", status); + + if (ffpkyg(fptr, "key_pkyg", ogkey, 14, "fxpkyg comment", &status) > 0) + printf("ffpkyg status = %d\n", status); + + if (ffpkyd(fptr, "key_pkyd", odkey, 14, "fxpkyd comment", &status) > 0) + printf("ffpkyd status = %d\n", status); + + if (ffpkyc(fptr, "key_pkyc", onekey, 6, "fxpkyc comment", &status) > 0) + printf("ffpkyc status = %d\n", status); + + if (ffpkym(fptr, "key_pkym", ondkey, 14, "fxpkym comment", &status) > 0) + printf("ffpkym status = %d\n", status); + + if (ffpkfc(fptr, "key_pkfc", onekey, 6, "fxpkfc comment", &status) > 0) + printf("ffpkfc status = %d\n", status); + + if (ffpkfm(fptr, "key_pkfm", ondkey, 14, "fxpkfm comment", &status) > 0) + printf("ffpkfm status = %d\n", status); + + if (ffpkls(fptr, "key_pkls", +"This is a very long string value that is continued over more than one keyword.", + "fxpkls comment", &status) > 0) + printf("ffpkls status = %d\n", status); + + if (ffplsw(fptr, &status) > 0 ) + printf("ffplsw status = %d\n", status); + + if (ffpkyt(fptr, "key_pkyt", otint, otfrac, "fxpkyt comment", &status) > 0) + printf("ffpkyt status = %d\n", status); + + if (ffpcom(fptr, " This keyword was written by fxpcom.", &status) > 0) + printf("ffpcom status = %d\n", status); + + if (ffphis(fptr, " This keyword written by fxphis (w/ 2 leading spaces).", + &status) > 0) + printf("ffphis status = %d\n", status); + + if (ffpdat(fptr, &status) > 0) + { + printf("ffpdat status = %d\n", status); + goto errstatus; + } + + /* + ############################### + # write arrays of keywords # + ############################### + */ + nkeys = 3; + + comms[0] = comm; /* use the inskey array of pointers for the comments */ + + strcpy(comm, "fxpkns comment&"); + if (ffpkns(fptr, "ky_pkns", 1, nkeys, onskey, comms, &status) > 0) + printf("ffpkns status = %d\n", status); + + strcpy(comm, "fxpknl comment&"); + if (ffpknl(fptr, "ky_pknl", 1, nkeys, onlkey, comms, &status) > 0) + printf("ffpknl status = %d\n", status); + + strcpy(comm, "fxpknj comment&"); + if (ffpknj(fptr, "ky_pknj", 1, nkeys, onjkey, comms, &status) > 0) + printf("ffpknj status = %d\n", status); + + strcpy(comm, "fxpknf comment&"); + if (ffpknf(fptr, "ky_pknf", 1, nkeys, onfkey, 5, comms, &status) > 0) + printf("ffpknf status = %d\n", status); + + strcpy(comm, "fxpkne comment&"); + if (ffpkne(fptr, "ky_pkne", 1, nkeys, onekey, 6, comms, &status) > 0) + printf("ffpkne status = %d\n", status); + + strcpy(comm, "fxpkng comment&"); + if (ffpkng(fptr, "ky_pkng", 1, nkeys, ongkey, 13, comms, &status) > 0) + printf("ffpkng status = %d\n", status); + + strcpy(comm, "fxpknd comment&"); + if (ffpknd(fptr, "ky_pknd", 1, nkeys, ondkey, 14, comms, &status) > 0) + { + printf("ffpknd status = %d\n", status); + goto errstatus; + } + /* + ############################ + # write generic keywords # + ############################ + */ + + strcpy(oskey, "1"); + if (ffpky(fptr, TSTRING, "tstring", oskey, "tstring comment", &status) > 0) + printf("ffpky status = %d\n", status); + + olkey = TLOGICAL; + if (ffpky(fptr, TLOGICAL, "tlogical", &olkey, "tlogical comment", + &status) > 0) + printf("ffpky status = %d\n", status); + + cval = TBYTE; + if (ffpky(fptr, TBYTE, "tbyte", &cval, "tbyte comment", &status) > 0) + printf("ffpky status = %d\n", status); + + oshtkey = TSHORT; + if (ffpky(fptr, TSHORT, "tshort", &oshtkey, "tshort comment", &status) > 0) + printf("ffpky status = %d\n", status); + + olkey = TINT; + if (ffpky(fptr, TINT, "tint", &olkey, "tint comment", &status) > 0) + printf("ffpky status = %d\n", status); + + ojkey = TLONG; + if (ffpky(fptr, TLONG, "tlong", &ojkey, "tlong comment", &status) > 0) + printf("ffpky status = %d\n", status); + + oekey = TFLOAT; + if (ffpky(fptr, TFLOAT, "tfloat", &oekey, "tfloat comment", &status) > 0) + printf("ffpky status = %d\n", status); + + odkey = TDOUBLE; + if (ffpky(fptr, TDOUBLE, "tdouble", &odkey, "tdouble comment", + &status) > 0) + printf("ffpky status = %d\n", status); + + /* + ############################ + # write data # + ############################ + */ + /* define the null value (must do this before writing any data) */ + if (ffpkyj(fptr, "BLANK", -99, "value to use for undefined pixels", + &status) > 0) + printf("BLANK keyword status = %d\n", status); + + /* initialize arrays of values to write to primary array */ + for (ii = 0; ii < npixels; ii++) + { + boutarray[ii] = ii + 1; + ioutarray[ii] = ii + 1; + joutarray[ii] = ii + 1; + eoutarray[ii] = ii + 1; + doutarray[ii] = ii + 1; + } + + /* write a few pixels with each datatype */ + /* set the last value in each group of 4 as undefined */ + +/* + ffpprb(fptr, 1, 1, 2, &boutarray[0], &status); + ffppri(fptr, 1, 5, 2, &ioutarray[4], &status); + ffpprj(fptr, 1, 9, 2, &joutarray[8], &status); + ffppre(fptr, 1, 13, 2, &eoutarray[12], &status); + ffpprd(fptr, 1, 17, 2, &doutarray[16], &status); +*/ + +/* test the newer ffpx routine, instead of the older ffppr_ routines */ + firstpix[0]=1; + firstpix[1]=1; + ffppx(fptr, TBYTE, firstpix, 2, &boutarray[0], &status); + firstpix[0]=5; + ffppx(fptr, TSHORT, firstpix, 2, &ioutarray[4], &status); + firstpix[0]=9; + ffppx(fptr, TLONG, firstpix, 2, &joutarray[8], &status); + firstpix[0]=3; + firstpix[1]=2; + ffppx(fptr, TFLOAT, firstpix, 2, &eoutarray[12], &status); + firstpix[0]=7; + ffppx(fptr, TDOUBLE, firstpix, 2, &doutarray[16], &status); + +/* + ffppnb(fptr, 1, 3, 2, &boutarray[2], 4, &status); + ffppni(fptr, 1, 7, 2, &ioutarray[6], 8, &status); + ffppnj(fptr, 1, 11, 2, &joutarray[10], 12, &status); + ffppne(fptr, 1, 15, 2, &eoutarray[14], 16., &status); + ffppnd(fptr, 1, 19, 2, &doutarray[18], 20., &status); +*/ + firstpix[0]=3; + firstpix[1]=1; + bnul = 4; + ffppxn(fptr, TBYTE, firstpix, 2, &boutarray[2], &bnul, &status); + firstpix[0]=7; + inul = 8; + ffppxn(fptr, TSHORT, firstpix, 2, &ioutarray[6], &inul, &status); + firstpix[0]=1; + firstpix[1]=2; + jnul = 12; + ffppxn(fptr, TLONG, firstpix, 2, &joutarray[10], &jnul, &status); + firstpix[0]=5; + enul = 16.; + ffppxn(fptr, TFLOAT, firstpix, 2, &eoutarray[14], &enul, &status); + firstpix[0]=9; + dnul = 20.; + ffppxn(fptr, TDOUBLE, firstpix, 2, &doutarray[18], &dnul, &status); + + ffppru(fptr, 1, 1, 1, &status); + + + if (status > 0) + { + printf("ffppnx status = %d\n", status); + goto errstatus; + } + + ffflus(fptr, &status); /* flush all data to the disk file */ + printf("ffflus status = %d\n", status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + /* + ############################ + # read data # + ############################ + */ + /* read back the data, setting null values = 99 */ + printf("\nValues read back from primary array (99 = null pixel)\n"); + printf("The 1st, and every 4th pixel should be undefined:\n"); + + anynull = 0; + ffgpvb(fptr, 1, 1, 10, 99, binarray, &anynull, &status); + + ffgpvb(fptr, 1, 11, 10, 99, &binarray[10], &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + printf(" %2d", binarray[ii]); + printf(" %d (ffgpvb)\n", anynull); + + ffgpvi(fptr, 1, 1, npixels, 99, iinarray, &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + printf(" %2d", iinarray[ii]); + printf(" %d (ffgpvi)\n", anynull); + + ffgpvj(fptr, 1, 1, npixels, 99, jinarray, &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + printf(" %2ld", jinarray[ii]); + printf(" %d (ffgpvj)\n", anynull); + + ffgpve(fptr, 1, 1, npixels, 99., einarray, &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + printf(" %2.0f", einarray[ii]); + printf(" %d (ffgpve)\n", anynull); + + ffgpvd(fptr, 1, 1, 10, 99., dinarray, &anynull, &status); + ffgpvd(fptr, 1, 11, 10, 99., &dinarray[10], &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + printf(" %2.0f", dinarray[ii]); + printf(" %d (ffgpvd)\n", anynull); + + if (status > 0) + { + printf("ERROR: ffgpv_ status = %d\n", status); + goto errstatus; + } + if (anynull == 0) + printf("ERROR: ffgpv_ did not detect null values\n"); + + /* reset the output null value to the expected input value */ + for (ii = 3; ii < npixels; ii += 4) + { + boutarray[ii] = 99; + ioutarray[ii] = 99; + joutarray[ii] = 99; + eoutarray[ii] = 99.; + doutarray[ii] = 99.; + } + ii = 0; + boutarray[ii] = 99; + ioutarray[ii] = 99; + joutarray[ii] = 99; + eoutarray[ii] = 99.; + doutarray[ii] = 99.; + + /* compare the output with the input; flag any differences */ + for (ii = 0; ii < npixels; ii++) + { + if (boutarray[ii] != binarray[ii]) + printf("bout != bin = %u %u \n", boutarray[ii], binarray[ii]); + + if (ioutarray[ii] != iinarray[ii]) + printf("iout != iin = %d %d \n", ioutarray[ii], iinarray[ii]); + + if (joutarray[ii] != jinarray[ii]) + printf("jout != jin = %ld %ld \n", joutarray[ii], jinarray[ii]); + + if (eoutarray[ii] != einarray[ii]) + printf("eout != ein = %f %f \n", eoutarray[ii], einarray[ii]); + + if (doutarray[ii] != dinarray[ii]) + printf("dout != din = %f %f \n", doutarray[ii], dinarray[ii]); + } + + for (ii = 0; ii < npixels; ii++) + { + binarray[ii] = 0; + iinarray[ii] = 0; + jinarray[ii] = 0; + einarray[ii] = 0.; + dinarray[ii] = 0.; + } + + anynull = 0; + ffgpfb(fptr, 1, 1, 10, binarray, larray, &anynull, &status); + ffgpfb(fptr, 1, 11, 10, &binarray[10], &larray[10], &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + if (larray[ii]) + printf(" *"); + else + printf(" %2d", binarray[ii]); + printf(" %d (ffgpfb)\n", anynull); + + ffgpfi(fptr, 1, 1, npixels, iinarray, larray, &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + if (larray[ii]) + printf(" *"); + else + printf(" %2d", iinarray[ii]); + printf(" %d (ffgpfi)\n", anynull); + + ffgpfj(fptr, 1, 1, npixels, jinarray, larray, &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + if (larray[ii]) + printf(" *"); + else + printf(" %2ld", jinarray[ii]); + printf(" %d (ffgpfj)\n", anynull); + + ffgpfe(fptr, 1, 1, npixels, einarray, larray, &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + if (larray[ii]) + printf(" *"); + else + printf(" %2.0f", einarray[ii]); + printf(" %d (ffgpfe)\n", anynull); + + ffgpfd(fptr, 1, 1, 10, dinarray, larray, &anynull, &status); + ffgpfd(fptr, 1, 11, 10, &dinarray[10], &larray[10], &anynull, &status); + + for (ii = 0; ii < npixels; ii++) + if (larray[ii]) + printf(" *"); + else + printf(" %2.0f", dinarray[ii]); + printf(" %d (ffgpfd)\n", anynull); + + if (status > 0) + { + printf("ERROR: ffgpf_ status = %d\n", status); + goto errstatus; + } + if (anynull == 0) + printf("ERROR: ffgpf_ did not detect null values\n"); + + + /* + ########################################## + # close and reopen file multiple times # + ########################################## + */ + + for (ii = 0; ii < 10; ii++) + { + if (ffclos(fptr, &status) > 0) + { + printf("ERROR in ftclos (1) = %d", status); + goto errstatus; + } + + if (ffopen(&fptr, filename, READWRITE, &status) > 0) + { + printf("ERROR: ffopen open file status = %d\n", status); + goto errstatus; + } + } + printf("\nClosed then reopened the FITS file 10 times.\n"); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + filename[0] = '\0'; + ffflnm(fptr, filename, &status); + + ffflmd(fptr, &filemode, &status); + printf("Name of file = %s, I/O mode = %d\n", filename, filemode); + + /* + ############################ + # read single keywords # + ############################ + */ + + simple = 0; + bitpix = 0; + naxis = 0; + naxes[0] = 0; + naxes[1] = 0; + pcount = -99; + gcount = -99; + extend = -99; + printf("\nRead back keywords:\n"); + ffghpr(fptr, 99, &simple, &bitpix, &naxis, naxes, &pcount, + &gcount, &extend, &status); + printf("simple = %d, bitpix = %d, naxis = %d, naxes = (%ld, %ld)\n", + simple, bitpix, naxis, naxes[0], naxes[1]); + printf(" pcount = %ld, gcount = %ld, extend = %d\n", + pcount, gcount, extend); + + ffgrec(fptr, 9, card, &status); + printf("%s\n", card); + if (strncmp(card, "KEY_PREC= 'This", 15) ) + printf("ERROR in ffgrec\n"); + + ffgkyn(fptr, 9, keyword, value, comment, &status); + printf("%s : %s : %s :\n",keyword, value, comment); + if (strncmp(keyword, "KEY_PREC", 8) ) + printf("ERROR in ffgkyn: %s\n", keyword); + + ffgcrd(fptr, keyword, card, &status); + printf("%s\n", card); + + if (strncmp(keyword, card, 8) ) + printf("ERROR in ffgcrd: %s\n", keyword); + + ffgkey(fptr, "KY_PKNS1", value, comment, &status); + printf("KY_PKNS1 : %s : %s :\n", value, comment); + + if (strncmp(value, "'first string'", 14) ) + printf("ERROR in ffgkey: %s\n", value); + + ffgkys(fptr, "key_pkys", iskey, comment, &status); + printf("KEY_PKYS %s %s %d\n", iskey, comment, status); + + ffgkyl(fptr, "key_pkyl", &ilkey, comment, &status); + printf("KEY_PKYL %d %s %d\n", ilkey, comment, status); + + ffgkyj(fptr, "KEY_PKYJ", &ijkey, comment, &status); + printf("KEY_PKYJ %ld %s %d\n",ijkey, comment, status); + + ffgkye(fptr, "KEY_PKYJ", &iekey, comment, &status); + printf("KEY_PKYJ %f %s %d\n",iekey, comment, status); + + ffgkyd(fptr, "KEY_PKYJ", &idkey, comment, &status); + printf("KEY_PKYJ %f %s %d\n",idkey, comment, status); + + if (ijkey != 11 || iekey != 11. || idkey != 11.) + printf("ERROR in ffgky[jed]: %ld, %f, %f\n",ijkey, iekey, idkey); + + iskey[0] = '\0'; + ffgky(fptr, TSTRING, "key_pkys", iskey, comment, &status); + printf("KEY_PKY S %s %s %d\n", iskey, comment, status); + + ilkey = 0; + ffgky(fptr, TLOGICAL, "key_pkyl", &ilkey, comment, &status); + printf("KEY_PKY L %d %s %d\n", ilkey, comment, status); + + ffgky(fptr, TBYTE, "KEY_PKYJ", &cval, comment, &status); + printf("KEY_PKY BYTE %d %s %d\n",cval, comment, status); + + ffgky(fptr, TSHORT, "KEY_PKYJ", &ishtkey, comment, &status); + printf("KEY_PKY SHORT %d %s %d\n",ishtkey, comment, status); + + ffgky(fptr, TINT, "KEY_PKYJ", &ilkey, comment, &status); + printf("KEY_PKY INT %d %s %d\n",ilkey, comment, status); + + ijkey = 0; + ffgky(fptr, TLONG, "KEY_PKYJ", &ijkey, comment, &status); + printf("KEY_PKY J %ld %s %d\n",ijkey, comment, status); + + iekey = 0; + ffgky(fptr, TFLOAT, "KEY_PKYE", &iekey, comment, &status); + printf("KEY_PKY E %f %s %d\n",iekey, comment, status); + + idkey = 0; + ffgky(fptr, TDOUBLE, "KEY_PKYD", &idkey, comment, &status); + printf("KEY_PKY D %f %s %d\n",idkey, comment, status); + + ffgkyd(fptr, "KEY_PKYF", &idkey, comment, &status); + printf("KEY_PKYF %f %s %d\n",idkey, comment, status); + + ffgkyd(fptr, "KEY_PKYE", &idkey, comment, &status); + printf("KEY_PKYE %f %s %d\n",idkey, comment, status); + + ffgkyd(fptr, "KEY_PKYG", &idkey, comment, &status); + printf("KEY_PKYG %.14f %s %d\n",idkey, comment, status); + + ffgkyd(fptr, "KEY_PKYD", &idkey, comment, &status); + printf("KEY_PKYD %.14f %s %d\n",idkey, comment, status); + + ffgkyc(fptr, "KEY_PKYC", inekey, comment, &status); + printf("KEY_PKYC %f %f %s %d\n",inekey[0], inekey[1], comment, status); + + ffgkyc(fptr, "KEY_PKFC", inekey, comment, &status); + printf("KEY_PKFC %f %f %s %d\n",inekey[0], inekey[1], comment, status); + + ffgkym(fptr, "KEY_PKYM", indkey, comment, &status); + printf("KEY_PKYM %f %f %s %d\n",indkey[0], indkey[1], comment, status); + + ffgkym(fptr, "KEY_PKFM", indkey, comment, &status); + printf("KEY_PKFM %f %f %s %d\n",indkey[0], indkey[1], comment, status); + + ffgkyt(fptr, "KEY_PKYT", &ijkey, &idkey, comment, &status); + printf("KEY_PKYT %ld %.14f %s %d\n",ijkey, idkey, comment, status); + + ffpunt(fptr, "KEY_PKYJ", "km/s/Mpc", &status); + ijkey = 0; + ffgky(fptr, TLONG, "KEY_PKYJ", &ijkey, comment, &status); + printf("KEY_PKY J %ld %s %d\n",ijkey, comment, status); + ffgunt(fptr,"KEY_PKYJ", comment, &status); + printf("KEY_PKY units = %s\n",comment); + + ffpunt(fptr, "KEY_PKYJ", "", &status); + ijkey = 0; + ffgky(fptr, TLONG, "KEY_PKYJ", &ijkey, comment, &status); + printf("KEY_PKY J %ld %s %d\n",ijkey, comment, status); + ffgunt(fptr,"KEY_PKYJ", comment, &status); + printf("KEY_PKY units = %s\n",comment); + + ffpunt(fptr, "KEY_PKYJ", "feet/second/second", &status); + ijkey = 0; + ffgky(fptr, TLONG, "KEY_PKYJ", &ijkey, comment, &status); + printf("KEY_PKY J %ld %s %d\n",ijkey, comment, status); + ffgunt(fptr,"KEY_PKYJ", comment, &status); + printf("KEY_PKY units = %s\n",comment); + + ffgkls(fptr, "key_pkls", &lsptr, comment, &status); + printf("KEY_PKLS long string value = \n%s\n", lsptr); + + /* free the memory for the long string value */ + free(lsptr); + + /* get size and position in header */ + ffghps(fptr, &existkeys, &keynum, &status); + printf("header contains %d keywords; located at keyword %d \n",existkeys, + keynum); + + /* + ############################ + # read array keywords # + ############################ + */ + ffgkns(fptr, "ky_pkns", 1, 3, inskey, &nfound, &status); + printf("ffgkns: %s, %s, %s\n", inskey[0], inskey[1], inskey[2]); + if (nfound != 3 || status > 0) + printf("\nERROR in ffgkns %d, %d\n", nfound, status); + + ffgknl(fptr, "ky_pknl", 1, 3, inlkey, &nfound, &status); + printf("ffgknl: %d, %d, %d\n", inlkey[0], inlkey[1], inlkey[2]); + if (nfound != 3 || status > 0) + printf("\nERROR in ffgknl %d, %d\n", nfound, status); + + ffgknj(fptr, "ky_pknj", 1, 3, injkey, &nfound, &status); + printf("ffgknj: %ld, %ld, %ld\n", injkey[0], injkey[1], injkey[2]); + if (nfound != 3 || status > 0) + printf("\nERROR in ffgknj %d, %d\n", nfound, status); + + ffgkne(fptr, "ky_pkne", 1, 3, inekey, &nfound, &status); + printf("ffgkne: %f, %f, %f\n", inekey[0], inekey[1], inekey[2]); + if (nfound != 3 || status > 0) + printf("\nERROR in ffgkne %d, %d\n", nfound, status); + + ffgknd(fptr, "ky_pknd", 1, 3, indkey, &nfound, &status); + printf("ffgknd: %f, %f, %f\n", indkey[0], indkey[1], indkey[2]); + if (nfound != 3 || status > 0) + printf("\nERROR in ffgknd %d, %d\n", nfound, status); + + /* get position of HISTORY keyword for subsequent deletes and inserts */ + ffgcrd(fptr, "HISTORY", card, &status); + ffghps(fptr, &existkeys, &keynum, &status); + keynum -= 2; + + printf("\nBefore deleting the HISTORY and DATE keywords...\n"); + for (ii = keynum; ii <= keynum + 3; ii++) + { + ffgrec(fptr, ii, card, &status); + printf("%.8s\n", card); /* don't print date value, so that */ + } /* the output will always be the same */ + /* + ############################ + # delete keywords # + ############################ + */ + + ffdrec(fptr, keynum + 1, &status); + ffdkey(fptr, "DATE", &status); + + printf("\nAfter deleting the keywords...\n"); + for (ii = keynum; ii <= keynum + 1; ii++) + { + ffgrec(fptr, ii, card, &status); + printf("%s\n", card); + } + + if (status > 0) + printf("\nERROR deleting keywords\n"); + /* + ############################ + # insert keywords # + ############################ + */ + keynum += 4; + ffirec(fptr, keynum - 3, "KY_IREC = 'This keyword inserted by fxirec'", + &status); + ffikys(fptr, "KY_IKYS", "insert_value_string", "ikys comment", &status); + ffikyj(fptr, "KY_IKYJ", 49, "ikyj comment", &status); + ffikyl(fptr, "KY_IKYL", 1, "ikyl comment", &status); + ffikye(fptr, "KY_IKYE", 12.3456, 4, "ikye comment", &status); + ffikyd(fptr, "KY_IKYD", 12.345678901234567, 14, "ikyd comment", &status); + ffikyf(fptr, "KY_IKYF", 12.3456, 4, "ikyf comment", &status); + ffikyg(fptr, "KY_IKYG", 12.345678901234567, 13, "ikyg comment", &status); + + printf("\nAfter inserting the keywords...\n"); + for (ii = keynum - 4; ii <= keynum + 5; ii++) + { + ffgrec(fptr, ii, card, &status); + printf("%s\n", card); + } + + if (status > 0) + printf("\nERROR inserting keywords\n"); + /* + ############################ + # modify keywords # + ############################ + */ + ffmrec(fptr, keynum - 4, "COMMENT This keyword was modified by fxmrec", &status); + ffmcrd(fptr, "KY_IREC", "KY_MREC = 'This keyword was modified by fxmcrd'", + &status); + ffmnam(fptr, "KY_IKYS", "NEWIKYS", &status); + + ffmcom(fptr, "KY_IKYJ","This is a modified comment", &status); + ffmkyj(fptr, "KY_IKYJ", 50, "&", &status); + ffmkyl(fptr, "KY_IKYL", 0, "&", &status); + ffmkys(fptr, "NEWIKYS", "modified_string", "&", &status); + ffmkye(fptr, "KY_IKYE", -12.3456, 4, "&", &status); + ffmkyd(fptr, "KY_IKYD", -12.345678901234567, 14, "modified comment", + &status); + ffmkyf(fptr, "KY_IKYF", -12.3456, 4, "&", &status); + ffmkyg(fptr, "KY_IKYG", -12.345678901234567, 13, "&", &status); + + printf("\nAfter modifying the keywords...\n"); + for (ii = keynum - 4; ii <= keynum + 5; ii++) + { + ffgrec(fptr, ii, card, &status); + printf("%s\n", card); + } + if (status > 0) + printf("\nERROR modifying keywords\n"); + + /* + ############################ + # update keywords # + ############################ + */ + ffucrd(fptr, "KY_MREC", "KY_UCRD = 'This keyword was updated by fxucrd'", + &status); + + ffukyj(fptr, "KY_IKYJ", 51, "&", &status); + ffukyl(fptr, "KY_IKYL", 1, "&", &status); + ffukys(fptr, "NEWIKYS", "updated_string", "&", &status); + ffukye(fptr, "KY_IKYE", -13.3456, 4, "&", &status); + ffukyd(fptr, "KY_IKYD", -13.345678901234567, 14, "modified comment", + &status); + ffukyf(fptr, "KY_IKYF", -13.3456, 4, "&", &status); + ffukyg(fptr, "KY_IKYG", -13.345678901234567, 13, "&", &status); + + printf("\nAfter updating the keywords...\n"); + for (ii = keynum - 4; ii <= keynum + 5; ii++) + { + ffgrec(fptr, ii, card, &status); + printf("%s\n", card); + } + if (status > 0) + printf("\nERROR modifying keywords\n"); + + /* move to top of header and find keywords using wild cards */ + ffgrec(fptr, 0, card, &status); + + printf("\nKeywords found using wildcard search (should be 13)...\n"); + nfound = 0; + while (!ffgnxk(fptr,inclist, 2, exclist, 2, card, &status)) + { + nfound++; + printf("%s\n", card); + } + if (nfound != 13) + { + printf("\nERROR reading keywords using wildcards (ffgnxk)\n"); + goto errstatus; + } + status = 0; + + /* + ############################ + # copy index keyword # + ############################ + */ + ffcpky(fptr, fptr, 1, 4, "KY_PKNE", &status); + ffgkne(fptr, "ky_pkne", 2, 4, inekey, &nfound, &status); + printf("\nCopied keyword: ffgkne: %f, %f, %f\n", inekey[0], inekey[1], + inekey[2]); + + if (status > 0) + { + printf("\nERROR in ffgkne %d, %d\n", nfound, status); + goto errstatus; + } + + /* + ###################################### + # modify header using template file # + ###################################### + */ + if (ffpktp(fptr, templt, &status)) + { + printf("\nERROR returned by ffpktp:\n"); + printf("Could not open or process the file 'testprog.tpt'.\n"); + printf(" This file is included with the CFITSIO distribution\n"); + printf(" and should be copied into the current directory\n"); + printf(" before running the testprog program.\n"); + status = 0; + } + printf("Updated header using template file (ffpktp)\n"); + /* + ############################ + # create binary table # + ############################ + */ + + strcpy(tform[0], "15A"); + strcpy(tform[1], "1L"); + strcpy(tform[2], "16X"); + strcpy(tform[3], "1B"); + strcpy(tform[4], "1I"); + strcpy(tform[5], "1J"); + strcpy(tform[6], "1E"); + strcpy(tform[7], "1D"); + strcpy(tform[8], "1C"); + strcpy(tform[9], "1M"); + + strcpy(ttype[0], "Avalue"); + strcpy(ttype[1], "Lvalue"); + strcpy(ttype[2], "Xvalue"); + strcpy(ttype[3], "Bvalue"); + strcpy(ttype[4], "Ivalue"); + strcpy(ttype[5], "Jvalue"); + strcpy(ttype[6], "Evalue"); + strcpy(ttype[7], "Dvalue"); + strcpy(ttype[8], "Cvalue"); + strcpy(ttype[9], "Mvalue"); + + strcpy(tunit[0], ""); + strcpy(tunit[1], "m**2"); + strcpy(tunit[2], "cm"); + strcpy(tunit[3], "erg/s"); + strcpy(tunit[4], "km/s"); + strcpy(tunit[5], ""); + strcpy(tunit[6], ""); + strcpy(tunit[7], ""); + strcpy(tunit[8], ""); + strcpy(tunit[9], ""); + + nrows = 21; + tfields = 10; + pcount = 0; + +/* + ffcrtb(fptr, BINARY_TBL, nrows, tfields, ttype, tform, tunit, binname, + &status); +*/ + ffibin(fptr, nrows, tfields, ttype, tform, tunit, binname, 0L, + &status); + + printf("\nffibin status = %d\n", status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + /* get size and position in header, and reserve space for more keywords */ + ffghps(fptr, &existkeys, &keynum, &status); + printf("header contains %d keywords; located at keyword %d \n",existkeys, + keynum); + + morekeys = 40; + ffhdef(fptr, morekeys, &status); + ffghsp(fptr, &existkeys, &morekeys, &status); + printf("header contains %d keywords with room for %d more\n",existkeys, + morekeys); + + fftnul(fptr, 4, 99, &status); /* define null value for int cols */ + fftnul(fptr, 5, 99, &status); + fftnul(fptr, 6, 99, &status); + + extvers = 1; + ffpkyj(fptr, "EXTVER", extvers, "extension version number", &status); + ffpkyj(fptr, "TNULL4", 99, "value for undefined pixels", &status); + ffpkyj(fptr, "TNULL5", 99, "value for undefined pixels", &status); + ffpkyj(fptr, "TNULL6", 99, "value for undefined pixels", &status); + + naxis = 3; + naxes[0] = 1; + naxes[1] = 2; + naxes[2] = 8; + ffptdm(fptr, 3, naxis, naxes, &status); + + naxis = 0; + naxes[0] = 0; + naxes[1] = 0; + naxes[2] = 0; + ffgtdm(fptr, 3, 3, &naxis, naxes, &status); + ffgkys(fptr, "TDIM3", iskey, comment, &status); + printf("TDIM3 = %s, %d, %ld, %ld, %ld\n", iskey, naxis, naxes[0], + naxes[1], naxes[2]); + + ffrdef(fptr, &status); /* force header to be scanned (not required) */ + + /* + ############################ + # write data to columns # + ############################ + */ + + /* initialize arrays of values to write to table */ + signval = -1; + for (ii = 0; ii < 21; ii++) + { + signval *= -1; + boutarray[ii] = (ii + 1); + ioutarray[ii] = (ii + 1) * signval; + joutarray[ii] = (ii + 1) * signval; + koutarray[ii] = (ii + 1) * signval; + eoutarray[ii] = (ii + 1) * signval; + doutarray[ii] = (ii + 1) * signval; + } + + ffpcls(fptr, 1, 1, 1, 3, onskey, &status); /* write string values */ + ffpclu(fptr, 1, 4, 1, 1, &status); /* write null value */ + + larray[0] = 0; + larray[1] = 1; + larray[2] = 0; + larray[3] = 0; + larray[4] = 1; + larray[5] = 1; + larray[6] = 0; + larray[7] = 0; + larray[8] = 0; + larray[9] = 1; + larray[10] = 1; + larray[11] = 1; + larray[12] = 0; + larray[13] = 0; + larray[14] = 0; + larray[15] = 0; + larray[16] = 1; + larray[17] = 1; + larray[18] = 1; + larray[19] = 1; + larray[20] = 0; + larray[21] = 0; + larray[22] = 0; + larray[23] = 0; + larray[24] = 0; + larray[25] = 1; + larray[26] = 1; + larray[27] = 1; + larray[28] = 1; + larray[29] = 1; + larray[30] = 0; + larray[31] = 0; + larray[32] = 0; + larray[33] = 0; + larray[34] = 0; + larray[35] = 0; + + + ffpclx(fptr, 3, 1, 1, 36, larray, &status); /*write bits*/ + + for (ii = 4; ii < 9; ii++) /* loop over cols 4 - 8 */ + { + ffpclb(fptr, ii, 1, 1, 2, boutarray, &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcli(fptr, ii, 3, 1, 2, &ioutarray[2], &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpclk(fptr, ii, 5, 1, 2, &koutarray[4], &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcle(fptr, ii, 7, 1, 2, &eoutarray[6], &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcld(fptr, ii, 9, 1, 2, &doutarray[8], &status); + if (status == NUM_OVERFLOW) + status = 0; + + ffpclu(fptr, ii, 11, 1, 1, &status); /* write null value */ + } + + ffpclc(fptr, 9, 1, 1, 10, eoutarray, &status); + ffpclm(fptr, 10, 1, 1, 10, doutarray, &status); + + for (ii = 4; ii < 9; ii++) /* loop over cols 4 - 8 */ + { + ffpcnb(fptr, ii, 12, 1, 2, &boutarray[11], 13, &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcni(fptr, ii, 14, 1, 2, &ioutarray[13], 15, &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcnk(fptr, ii, 16, 1, 2, &koutarray[15], 17, &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcne(fptr, ii, 18, 1, 2, &eoutarray[17], 19., &status); + if (status == NUM_OVERFLOW) + status = 0; + ffpcnd(fptr, ii, 20, 1, 2, &doutarray[19], 21., &status); + if (status == NUM_OVERFLOW) + status = 0; + + } + ffpcll(fptr, 2, 1, 1, 21, larray, &status); /*write logicals*/ + ffpclu(fptr, 2, 11, 1, 1, &status); /* write null value */ + printf("ffpcl_ status = %d\n", status); + + /* + ######################################### + # get information about the columns # + ######################################### + */ + + printf("\nFind the column numbers; a returned status value of 237 is"); + printf("\nexpected and indicates that more than one column name matches"); + printf("\nthe input column name template. Status = 219 indicates that"); + printf("\nthere was no matching column name."); + + ffgcno(fptr, 0, "Xvalue", &colnum, &status); + printf("\nColumn Xvalue is number %d; status = %d.\n", colnum, status); + + while (status != COL_NOT_FOUND) + { + ffgcnn(fptr, 1, "*ue", colname, &colnum, &status); + printf("Column %s is number %d; status = %d.\n", + colname, colnum, status); + } + status = 0; + + printf("\nInformation about each column:\n"); + + for (ii = 0; ii < tfields; ii++) + { + ffgtcl(fptr, ii + 1, &typecode, &repeat, &width, &status); + printf("%4s %3d %2ld %2ld", tform[ii], typecode, repeat, width); + ffgbcl(fptr, ii + 1, ttype[0], tunit[0], &cval, &repeat, &scale, + &zero, &jnulval, tdisp, &status); + printf(" %s, %s, %c, %ld, %f, %f, %ld, %s.\n", + ttype[0], tunit[0], cval, repeat, scale, zero, jnulval, tdisp); + } + + printf("\n"); + + /* + ############################################### + # insert ASCII table before the binary table # + ############################################### + */ + + if (ffmrhd(fptr, -1, &hdutype, &status) > 0) + goto errstatus; + + strcpy(tform[0], "A15"); + strcpy(tform[1], "I10"); + strcpy(tform[2], "F14.6"); + strcpy(tform[3], "E12.5"); + strcpy(tform[4], "D21.14"); + + strcpy(ttype[0], "Name"); + strcpy(ttype[1], "Ivalue"); + strcpy(ttype[2], "Fvalue"); + strcpy(ttype[3], "Evalue"); + strcpy(ttype[4], "Dvalue"); + + strcpy(tunit[0], ""); + strcpy(tunit[1], "m**2"); + strcpy(tunit[2], "cm"); + strcpy(tunit[3], "erg/s"); + strcpy(tunit[4], "km/s"); + + rowlen = 76; + nrows = 11; + tfields = 5; + + ffitab(fptr, rowlen, nrows, tfields, ttype, tbcol, tform, tunit, tblname, + &status); + printf("ffitab status = %d\n", status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + ffsnul(fptr, 1, "null1", &status); /* define null value for int cols */ + ffsnul(fptr, 2, "null2", &status); + ffsnul(fptr, 3, "null3", &status); + ffsnul(fptr, 4, "null4", &status); + ffsnul(fptr, 5, "null5", &status); + + extvers = 2; + ffpkyj(fptr, "EXTVER", extvers, "extension version number", &status); + + ffpkys(fptr, "TNULL1", "null1", "value for undefined pixels", &status); + ffpkys(fptr, "TNULL2", "null2", "value for undefined pixels", &status); + ffpkys(fptr, "TNULL3", "null3", "value for undefined pixels", &status); + ffpkys(fptr, "TNULL4", "null4", "value for undefined pixels", &status); + ffpkys(fptr, "TNULL5", "null5", "value for undefined pixels", &status); + + if (status > 0) + goto errstatus; + + /* + ############################ + # write data to columns # + ############################ + */ + + /* initialize arrays of values to write to table */ + for (ii = 0; ii < 21; ii++) + { + boutarray[ii] = ii + 1; + ioutarray[ii] = ii + 1; + joutarray[ii] = ii + 1; + eoutarray[ii] = ii + 1; + doutarray[ii] = ii + 1; + } + + ffpcls(fptr, 1, 1, 1, 3, onskey, &status); /* write string values */ + ffpclu(fptr, 1, 4, 1, 1, &status); /* write null value */ + + for (ii = 2; ii < 6; ii++) /* loop over cols 2 - 5 */ + { + ffpclb(fptr, ii, 1, 1, 2, boutarray, &status); /* char array */ + if (status == NUM_OVERFLOW) + status = 0; + ffpcli(fptr, ii, 3, 1, 2, &ioutarray[2], &status); /* short array */ + if (status == NUM_OVERFLOW) + status = 0; + ffpclj(fptr, ii, 5, 1, 2, &joutarray[4], &status); /* long array */ + if (status == NUM_OVERFLOW) + status = 0; + ffpcle(fptr, ii, 7, 1, 2, &eoutarray[6], &status); /* float array */ + if (status == NUM_OVERFLOW) + status = 0; + ffpcld(fptr, ii, 9, 1, 2, &doutarray[8], &status); /* double array */ + if (status == NUM_OVERFLOW) + status = 0; + + ffpclu(fptr, ii, 11, 1, 1, &status); /* write null value */ + } + printf("ffpcl_ status = %d\n", status); + + /* + ################################ + # read data from ASCII table # + ################################ + */ + ffghtb(fptr, 99, &rowlen, &nrows, &tfields, ttype, tbcol, + tform, tunit, tblname, &status); + + printf("\nASCII table: rowlen, nrows, tfields, extname: %ld %ld %d %s\n", + rowlen, nrows, tfields, tblname); + + for (ii = 0; ii < tfields; ii++) + printf("%8s %3ld %8s %8s \n", ttype[ii], tbcol[ii], + tform[ii], tunit[ii]); + + nrows = 11; + ffgcvs(fptr, 1, 1, 1, nrows, "UNDEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 2, 1, 1, nrows, 99, binarray, &anynull, &status); + ffgcvi(fptr, 2, 1, 1, nrows, 99, iinarray, &anynull, &status); + ffgcvj(fptr, 3, 1, 1, nrows, 99, jinarray, &anynull, &status); + ffgcve(fptr, 4, 1, 1, nrows, 99., einarray, &anynull, &status); + ffgcvd(fptr, 5, 1, 1, nrows, 99., dinarray, &anynull, &status); + + printf("\nData values read from ASCII table:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %2d %2ld %4.1f %4.1f\n", inskey[ii], binarray[ii], + iinarray[ii], jinarray[ii], einarray[ii], dinarray[ii]); + } + + ffgtbb(fptr, 1, 20, 78, uchars, &status); + uchars[78] = '\0'; + printf("\n%s\n", uchars); + ffptbb(fptr, 1, 20, 78, uchars, &status); + + /* + ######################################### + # get information about the columns # + ######################################### + */ + + ffgcno(fptr, 0, "name", &colnum, &status); + printf("\nColumn name is number %d; status = %d.\n", colnum, status); + + while (status != COL_NOT_FOUND) + { + ffgcnn(fptr, 1, "*ue", colname, &colnum, &status); + printf("Column %s is number %d; status = %d.\n", + colname, colnum, status); + } + status = 0; + + for (ii = 0; ii < tfields; ii++) + { + ffgtcl(fptr, ii + 1, &typecode, &repeat, &width, &status); + printf("%4s %3d %2ld %2ld", tform[ii], typecode, repeat, width); + ffgacl(fptr, ii + 1, ttype[0], tbcol, tunit[0], tform[0], &scale, + &zero, nulstr, tdisp, &status); + printf(" %s, %ld, %s, %s, %f, %f, %s, %s.\n", + ttype[0], tbcol[0], tunit[0], tform[0], scale, zero, + nulstr, tdisp); + } + + printf("\n"); + + /* + ############################################### + # test the insert/delete row/column routines # + ############################################### + */ + + if (ffirow(fptr, 2, 3, &status) > 0) + goto errstatus; + + nrows = 14; + ffgcvs(fptr, 1, 1, 1, nrows, "UNDEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 2, 1, 1, nrows, 99, binarray, &anynull, &status); + ffgcvi(fptr, 2, 1, 1, nrows, 99, iinarray, &anynull, &status); + ffgcvj(fptr, 3, 1, 1, nrows, 99, jinarray, &anynull, &status); + ffgcve(fptr, 4, 1, 1, nrows, 99., einarray, &anynull, &status); + ffgcvd(fptr, 5, 1, 1, nrows, 99., dinarray, &anynull, &status); + + + printf("\nData values after inserting 3 rows after row 2:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %2d %2ld %4.1f %4.1f\n", inskey[ii], binarray[ii], + iinarray[ii], jinarray[ii], einarray[ii], dinarray[ii]); + } + + if (ffdrow(fptr, 10, 2, &status) > 0) + goto errstatus; + + nrows = 12; + ffgcvs(fptr, 1, 1, 1, nrows, "UNDEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 2, 1, 1, nrows, 99, binarray, &anynull, &status); + ffgcvi(fptr, 2, 1, 1, nrows, 99, iinarray, &anynull, &status); + ffgcvj(fptr, 3, 1, 1, nrows, 99, jinarray, &anynull, &status); + ffgcve(fptr, 4, 1, 1, nrows, 99., einarray, &anynull, &status); + ffgcvd(fptr, 5, 1, 1, nrows, 99., dinarray, &anynull, &status); + + printf("\nData values after deleting 2 rows at row 10:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %2d %2ld %4.1f %4.1f\n", inskey[ii], binarray[ii], + iinarray[ii], jinarray[ii], einarray[ii], dinarray[ii]); + } + if (ffdcol(fptr, 3, &status) > 0) + goto errstatus; + + ffgcvs(fptr, 1, 1, 1, nrows, "UNDEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 2, 1, 1, nrows, 99, binarray, &anynull, &status); + ffgcvi(fptr, 2, 1, 1, nrows, 99, iinarray, &anynull, &status); + ffgcve(fptr, 3, 1, 1, nrows, 99., einarray, &anynull, &status); + ffgcvd(fptr, 4, 1, 1, nrows, 99., dinarray, &anynull, &status); + + printf("\nData values after deleting column 3:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %2d %4.1f %4.1f\n", inskey[ii], binarray[ii], + iinarray[ii], einarray[ii], dinarray[ii]); + } + + if (fficol(fptr, 5, "INSERT_COL", "F14.6", &status) > 0) + goto errstatus; + + ffgcvs(fptr, 1, 1, 1, nrows, "UNDEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 2, 1, 1, nrows, 99, binarray, &anynull, &status); + ffgcvi(fptr, 2, 1, 1, nrows, 99, iinarray, &anynull, &status); + ffgcve(fptr, 3, 1, 1, nrows, 99., einarray, &anynull, &status); + ffgcvd(fptr, 4, 1, 1, nrows, 99., dinarray, &anynull, &status); + ffgcvj(fptr, 5, 1, 1, nrows, 99, jinarray, &anynull, &status); + + printf("\nData values after inserting column 5:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %2d %4.1f %4.1f %ld\n", inskey[ii], binarray[ii], + iinarray[ii], einarray[ii], dinarray[ii] , jinarray[ii]); + } + + /* + ############################################################ + # create a temporary file and copy the ASCII table to it, # + # column by column. # + ############################################################ + */ + bitpix = 16; + naxis = 0; + + strcpy(filename, "!t1q2s3v6.tmp"); + ffinit(&tmpfptr, filename, &status); + printf("Create temporary file: ffinit status = %d\n", status); + + ffiimg(tmpfptr, bitpix, naxis, naxes, &status); + printf("\nCreate null primary array: ffiimg status = %d\n", status); + + /* create an empty table with 12 rows and 0 columns */ + nrows = 12; + tfields = 0; + rowlen = 0; + ffitab(tmpfptr, rowlen, nrows, tfields, ttype, tbcol, tform, tunit, + tblname, &status); + printf("\nCreate ASCII table with 0 columns: ffitab status = %d\n", + status); + + /* copy columns from one table to the other */ + ffcpcl(fptr, tmpfptr, 4, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 3, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 2, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 1, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + + /* now repeat by copying ASCII input to Binary output table */ + ffibin(tmpfptr, nrows, tfields, ttype, tform, tunit, + tblname, 0L, &status); + printf("\nCreate Binary table with 0 columns: ffibin status = %d\n", + status); + + /* copy columns from one table to the other */ + ffcpcl(fptr, tmpfptr, 4, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 3, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 2, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 1, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + + +/* + ffclos(tmpfptr, &status); + printf("Close the tmp file: ffclos status = %d\n", status); +*/ + + ffdelt(tmpfptr, &status); + printf("Delete the tmp file: ffdelt status = %d\n", status); + + if (status > 0) + { + goto errstatus; + } + + /* + ################################ + # read data from binary table # + ################################ + */ + + if (ffmrhd(fptr, 1, &hdutype, &status) > 0) + goto errstatus; + + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + ffghsp(fptr, &existkeys, &morekeys, &status); + printf("header contains %d keywords with room for %d more\n",existkeys, + morekeys); + + ffghbn(fptr, 99, &nrows, &tfields, ttype, + tform, tunit, binname, &pcount, &status); + + printf("\nBinary table: nrows, tfields, extname, pcount: %ld %d %s %ld\n", + nrows, tfields, binname, pcount); + + for (ii = 0; ii < tfields; ii++) + printf("%8s %8s %8s \n", ttype[ii], tform[ii], tunit[ii]); + + for (ii = 0; ii < 40; ii++) + larray[ii] = 0; + + printf("\nData values read from binary table:\n"); + printf(" Bit column (X) data values: \n\n"); + + ffgcx(fptr, 3, 1, 1, 36, larray, &status); + for (jj = 0; jj < 5; jj++) + { + for (ii = 0; ii < 8; ii++) + printf("%1d",larray[jj * 8 + ii]); + printf(" "); + } + + for (ii = 0; ii < nrows; ii++) + { + larray[ii] = 0; + xinarray[ii] = 0; + binarray[ii] = 0; + iinarray[ii] = 0; + kinarray[ii] = 0; + einarray[ii] = 0.; + dinarray[ii] = 0.; + cinarray[ii * 2] = 0.; + minarray[ii * 2] = 0.; + cinarray[ii * 2 + 1] = 0.; + minarray[ii * 2 + 1] = 0.; + } + + printf("\n\n"); + ffgcvs(fptr, 1, 4, 1, 1, "", inskey, &anynull, &status); + printf("null string column value = -%s- (should be --)\n",inskey[0]); + + nrows = 21; + ffgcvs(fptr, 1, 1, 1, nrows, "NOT DEFINED", inskey, &anynull, &status); + ffgcl( fptr, 2, 1, 1, nrows, larray, &status); + ffgcvb(fptr, 3, 1, 1, nrows, 98, xinarray, &anynull, &status); + ffgcvb(fptr, 4, 1, 1, nrows, 98, binarray, &anynull, &status); + ffgcvi(fptr, 5, 1, 1, nrows, 98, iinarray, &anynull, &status); + ffgcvk(fptr, 6, 1, 1, nrows, 98, kinarray, &anynull, &status); + ffgcve(fptr, 7, 1, 1, nrows, 98., einarray, &anynull, &status); + ffgcvd(fptr, 8, 1, 1, nrows, 98., dinarray, &anynull, &status); + ffgcvc(fptr, 9, 1, 1, nrows, 98., cinarray, &anynull, &status); + ffgcvm(fptr, 10, 1, 1, nrows, 98., minarray, &anynull, &status); + + printf("\nRead columns with ffgcv_:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %d %3d %2d %3d %3d %5.1f %5.1f (%5.1f,%5.1f) (%5.1f,%5.1f) \n", + inskey[ii], larray[ii], xinarray[ii], binarray[ii], iinarray[ii], + kinarray[ii], einarray[ii], dinarray[ii], cinarray[ii * 2], + cinarray[ii * 2 + 1], minarray[ii * 2], minarray[ii * 2 + 1]); + } + + for (ii = 0; ii < nrows; ii++) + { + larray[ii] = 0; + xinarray[ii] = 0; + binarray[ii] = 0; + iinarray[ii] = 0; + kinarray[ii] = 0; + einarray[ii] = 0.; + dinarray[ii] = 0.; + cinarray[ii * 2] = 0.; + minarray[ii * 2] = 0.; + cinarray[ii * 2 + 1] = 0.; + minarray[ii * 2 + 1] = 0.; + } + + ffgcfs(fptr, 1, 1, 1, nrows, inskey, larray2, &anynull, &status); + ffgcfl(fptr, 2, 1, 1, nrows, larray, larray2, &anynull, &status); + ffgcfb(fptr, 3, 1, 1, nrows, xinarray, larray2, &anynull, &status); + ffgcfb(fptr, 4, 1, 1, nrows, binarray, larray2, &anynull, &status); + ffgcfi(fptr, 5, 1, 1, nrows, iinarray, larray2, &anynull, &status); + ffgcfk(fptr, 6, 1, 1, nrows, kinarray, larray2, &anynull, &status); + ffgcfe(fptr, 7, 1, 1, nrows, einarray, larray2, &anynull, &status); + ffgcfd(fptr, 8, 1, 1, nrows, dinarray, larray2, &anynull, &status); + ffgcfc(fptr, 9, 1, 1, nrows, cinarray, larray2, &anynull, &status); + ffgcfm(fptr, 10, 1, 1, nrows, minarray, larray2, &anynull, &status); + + printf("\nRead columns with ffgcf_:\n"); + for (ii = 0; ii < 10; ii++) + { + + printf("%15s %d %3d %2d %3d %3d %5.1f %5.1f (%5.1f,%5.1f) (%5.1f,%5.1f)\n", + inskey[ii], larray[ii], xinarray[ii], binarray[ii], iinarray[ii], + kinarray[ii], einarray[ii], dinarray[ii], cinarray[ii * 2], + cinarray[ii * 2 + 1], minarray[ii * 2], minarray[ii * 2 + 1]); + } + for (ii = 10; ii < nrows; ii++) + { + /* don't try to print the NaN values */ + printf("%15s %d %3d %2d %3d \n", + inskey[ii], larray[ii], xinarray[ii], binarray[ii], iinarray[ii]); + } + ffprec(fptr, + "key_prec= 'This keyword was written by f_prec' / comment here", &status); + + /* + ############################################### + # test the insert/delete row/column routines # + ############################################### + */ + if (ffirow(fptr, 2, 3, &status) > 0) + goto errstatus; + + nrows = 14; + ffgcvs(fptr, 1, 1, 1, nrows, "NOT DEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 4, 1, 1, nrows, 98, binarray, &anynull, &status); + ffgcvi(fptr, 5, 1, 1, nrows, 98, iinarray, &anynull, &status); + ffgcvj(fptr, 6, 1, 1, nrows, 98, jinarray, &anynull, &status); + ffgcve(fptr, 7, 1, 1, nrows, 98., einarray, &anynull, &status); + ffgcvd(fptr, 8, 1, 1, nrows, 98., dinarray, &anynull, &status); + + printf("\nData values after inserting 3 rows after row 2:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %3d %3ld %5.1f %5.1f\n", inskey[ii], binarray[ii], + iinarray[ii], jinarray[ii], einarray[ii], dinarray[ii]); + } + + if (ffdrow(fptr, 10, 2, &status) > 0) + goto errstatus; + + nrows = 12; + ffgcvs(fptr, 1, 1, 1, nrows, "NOT DEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 4, 1, 1, nrows, 98, binarray, &anynull, &status); + ffgcvi(fptr, 5, 1, 1, nrows, 98, iinarray, &anynull, &status); + ffgcvj(fptr, 6, 1, 1, nrows, 98, jinarray, &anynull, &status); + ffgcve(fptr, 7, 1, 1, nrows, 98., einarray, &anynull, &status); + ffgcvd(fptr, 8, 1, 1, nrows, 98., dinarray, &anynull, &status); + + printf("\nData values after deleting 2 rows at row 10:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %3d %3ld %5.1f %5.1f\n", inskey[ii], binarray[ii], + iinarray[ii], jinarray[ii], einarray[ii], dinarray[ii]); + } + + if (ffdcol(fptr, 6, &status) > 0) + goto errstatus; + + ffgcvs(fptr, 1, 1, 1, nrows, "NOT DEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 4, 1, 1, nrows, 98, binarray, &anynull, &status); + ffgcvi(fptr, 5, 1, 1, nrows, 98, iinarray, &anynull, &status); + ffgcve(fptr, 6, 1, 1, nrows, 98., einarray, &anynull, &status); + ffgcvd(fptr, 7, 1, 1, nrows, 98., dinarray, &anynull, &status); + + printf("\nData values after deleting column 6:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %3d %5.1f %5.1f\n", inskey[ii], binarray[ii], + iinarray[ii], einarray[ii], dinarray[ii]); + } + + if (fficol(fptr, 8, "INSERT_COL", "1E", &status) > 0) + goto errstatus; + + ffgcvs(fptr, 1, 1, 1, nrows, "NOT DEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 4, 1, 1, nrows, 98, binarray, &anynull, &status); + ffgcvi(fptr, 5, 1, 1, nrows, 98, iinarray, &anynull, &status); + ffgcve(fptr, 6, 1, 1, nrows, 98., einarray, &anynull, &status); + ffgcvd(fptr, 7, 1, 1, nrows, 98., dinarray, &anynull, &status); + ffgcvj(fptr, 8, 1, 1, nrows, 98, jinarray, &anynull, &status); + + printf("\nData values after inserting column 8:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %3d %5.1f %5.1f %ld\n", inskey[ii], binarray[ii], + iinarray[ii], einarray[ii], dinarray[ii] , jinarray[ii]); + } + + ffpclu(fptr, 8, 1, 1, 10, &status); + + ffgcvs(fptr, 1, 1, 1, nrows, "NOT DEFINED", inskey, &anynull, &status); + ffgcvb(fptr, 4, 1, 1, nrows, 98, binarray, &anynull, &status); + ffgcvi(fptr, 5, 1, 1, nrows, 98, iinarray, &anynull, &status); + ffgcve(fptr, 6, 1, 1, nrows, 98., einarray, &anynull, &status); + ffgcvd(fptr, 7, 1, 1, nrows, 98., dinarray, &anynull, &status); + ffgcvj(fptr, 8, 1, 1, nrows, 98, jinarray, &anynull, &status); + + printf("\nValues after setting 1st 10 elements in column 8 = null:\n"); + for (ii = 0; ii < nrows; ii++) + { + printf("%15s %2d %3d %5.1f %5.1f %ld\n", inskey[ii], binarray[ii], + iinarray[ii], einarray[ii], dinarray[ii] , jinarray[ii]); + } + + /* + ############################################################ + # create a temporary file and copy the binary table to it,# + # column by column. # + ############################################################ + */ + bitpix = 16; + naxis = 0; + + strcpy(filename, "!t1q2s3v5.tmp"); + ffinit(&tmpfptr, filename, &status); + printf("Create temporary file: ffinit status = %d\n", status); + + ffiimg(tmpfptr, bitpix, naxis, naxes, &status); + printf("\nCreate null primary array: ffiimg status = %d\n", status); + + /* create an empty table with 22 rows and 0 columns */ + nrows = 22; + tfields = 0; + ffibin(tmpfptr, nrows, tfields, ttype, tform, tunit, binname, 0L, + &status); + printf("\nCreate binary table with 0 columns: ffibin status = %d\n", + status); + + /* copy columns from one table to the other */ + ffcpcl(fptr, tmpfptr, 7, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 6, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 5, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 4, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 3, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 2, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + ffcpcl(fptr, tmpfptr, 1, 1, TRUE, &status); + printf("copy column, ffcpcl status = %d\n", status); + +/* + ffclos(tmpfptr, &status); + printf("Close the tmp file: ffclos status = %d\n", status); +*/ + + ffdelt(tmpfptr, &status); + printf("Delete the tmp file: ffdelt status = %d\n", status); + if (status > 0) + { + goto errstatus; + } + /* + #################################################### + # insert binary table following the primary array # + #################################################### + */ + + ffmahd(fptr, 1, &hdutype, &status); + + strcpy(tform[0], "15A"); + strcpy(tform[1], "1L"); + strcpy(tform[2], "16X"); + strcpy(tform[3], "1B"); + strcpy(tform[4], "1I"); + strcpy(tform[5], "1J"); + strcpy(tform[6], "1E"); + strcpy(tform[7], "1D"); + strcpy(tform[8], "1C"); + strcpy(tform[9], "1M"); + + strcpy(ttype[0], "Avalue"); + strcpy(ttype[1], "Lvalue"); + strcpy(ttype[2], "Xvalue"); + strcpy(ttype[3], "Bvalue"); + strcpy(ttype[4], "Ivalue"); + strcpy(ttype[5], "Jvalue"); + strcpy(ttype[6], "Evalue"); + strcpy(ttype[7], "Dvalue"); + strcpy(ttype[8], "Cvalue"); + strcpy(ttype[9], "Mvalue"); + + strcpy(tunit[0], ""); + strcpy(tunit[1], "m**2"); + strcpy(tunit[2], "cm"); + strcpy(tunit[3], "erg/s"); + strcpy(tunit[4], "km/s"); + strcpy(tunit[5], ""); + strcpy(tunit[6], ""); + strcpy(tunit[7], ""); + strcpy(tunit[8], ""); + strcpy(tunit[9], ""); + + nrows = 20; + tfields = 10; + pcount = 0; + + ffibin(fptr, nrows, tfields, ttype, tform, tunit, binname, pcount, + &status); + printf("ffibin status = %d\n", status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + extvers = 3; + ffpkyj(fptr, "EXTVER", extvers, "extension version number", &status); + + + ffpkyj(fptr, "TNULL4", 77, "value for undefined pixels", &status); + ffpkyj(fptr, "TNULL5", 77, "value for undefined pixels", &status); + ffpkyj(fptr, "TNULL6", 77, "value for undefined pixels", &status); + + ffpkyj(fptr, "TSCAL4", 1000, "scaling factor", &status); + ffpkyj(fptr, "TSCAL5", 1, "scaling factor", &status); + ffpkyj(fptr, "TSCAL6", 100, "scaling factor", &status); + + ffpkyj(fptr, "TZERO4", 0, "scaling offset", &status); + ffpkyj(fptr, "TZERO5", 32768, "scaling offset", &status); + ffpkyj(fptr, "TZERO6", 100, "scaling offset", &status); + + fftnul(fptr, 4, 77, &status); /* define null value for int cols */ + fftnul(fptr, 5, 77, &status); + fftnul(fptr, 6, 77, &status); + /* set scaling */ + fftscl(fptr, 4, 1000., 0., &status); + fftscl(fptr, 5, 1., 32768., &status); + fftscl(fptr, 6, 100., 100., &status); + + /* + ############################ + # write data to columns # + ############################ + */ + + /* initialize arrays of values to write to table */ + + joutarray[0] = 0; + joutarray[1] = 1000; + joutarray[2] = 10000; + joutarray[3] = 32768; + joutarray[4] = 65535; + + + for (ii = 4; ii < 7; ii++) + { + ffpclj(fptr, ii, 1, 1, 5, joutarray, &status); + if (status == NUM_OVERFLOW) + { + printf("Overflow writing to column %ld\n", ii); + status = 0; + } + + ffpclu(fptr, ii, 6, 1, 1, &status); /* write null value */ + } + + for (jj = 4; jj < 7; jj++) + { + ffgcvj(fptr, jj, 1, 1, 6, -999, jinarray, &anynull, &status); + for (ii = 0; ii < 6; ii++) + { + printf(" %6ld", jinarray[ii]); + } + printf("\n"); + } + + printf("\n"); + /* turn off scaling, and read the unscaled values */ + fftscl(fptr, 4, 1., 0., &status); + fftscl(fptr, 5, 1., 0., &status); + fftscl(fptr, 6, 1., 0., &status); + + for (jj = 4; jj < 7; jj++) + { + ffgcvj(fptr, jj, 1, 1, 6, -999, jinarray, &anynull, &status); + for (ii = 0; ii < 6; ii++) + { + printf(" %6ld", jinarray[ii]); + } + printf("\n"); + } + /* + ###################################################### + # insert image extension following the binary table # + ###################################################### + */ + + bitpix = -32; + naxis = 2; + naxes[0] = 15; + naxes[1] = 25; + ffiimg(fptr, bitpix, naxis, naxes, &status); + printf("\nCreate image extension: ffiimg status = %d\n", status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + for (jj = 0; jj < 30; jj++) + { + for (ii = 0; ii < 19; ii++) + { + imgarray[jj][ii] = (jj * 10) + ii; + } + } + + ffp2di(fptr, 1, 19, naxes[0], naxes[1], imgarray[0], &status); + printf("\nWrote whole 2D array: ffp2di status = %d\n", status); + + for (jj = 0; jj < 30; jj++) + { + for (ii = 0; ii < 19; ii++) + { + imgarray[jj][ii] = 0; + } + } + + ffg2di(fptr, 1, 0, 19, naxes[0], naxes[1], imgarray[0], &anynull, + &status); + printf("\nRead whole 2D array: ffg2di status = %d\n", status); + + for (jj = 0; jj < 30; jj++) + { + for (ii = 0; ii < 19; ii++) + { + printf(" %3d", imgarray[jj][ii]); + } + printf("\n"); + } + + for (jj = 0; jj < 30; jj++) + { + for (ii = 0; ii < 19; ii++) + { + imgarray[jj][ii] = 0; + } + } + + for (jj = 0; jj < 20; jj++) + { + for (ii = 0; ii < 10; ii++) + { + imgarray2[jj][ii] = (jj * -10) - ii; + } + } + + fpixels[0] = 5; + fpixels[1] = 5; + lpixels[0] = 14; + lpixels[1] = 14; + ffpssi(fptr, 1, naxis, naxes, fpixels, lpixels, + imgarray2[0], &status); + printf("\nWrote subset 2D array: ffpssi status = %d\n", status); + + ffg2di(fptr, 1, 0, 19, naxes[0], naxes[1], imgarray[0], &anynull, + &status); + printf("\nRead whole 2D array: ffg2di status = %d\n", status); + + for (jj = 0; jj < 30; jj++) + { + for (ii = 0; ii < 19; ii++) + { + printf(" %3d", imgarray[jj][ii]); + } + printf("\n"); + } + + fpixels[0] = 2; + fpixels[1] = 5; + lpixels[0] = 10; + lpixels[1] = 8; + inc[0] = 2; + inc[1] = 3; + + for (jj = 0; jj < 30; jj++) + { + for (ii = 0; ii < 19; ii++) + { + imgarray[jj][ii] = 0; + } + } + + ffgsvi(fptr, 1, naxis, naxes, fpixels, lpixels, inc, 0, + imgarray[0], &anynull, &status); + printf("\nRead subset of 2D array: ffgsvi status = %d\n", status); + + for (ii = 0; ii < 10; ii++) + { + printf(" %3d", imgarray[0][ii]); + } + printf("\n"); + + /* + ########################################################### + # insert another image extension # + # copy the image extension to primary array of tmp file. # + # then delete the tmp file, and the image extension # + ########################################################### + */ + bitpix = 16; + naxis = 2; + naxes[0] = 15; + naxes[1] = 25; + ffiimg(fptr, bitpix, naxis, naxes, &status); + printf("\nCreate image extension: ffiimg status = %d\n", status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + strcpy(filename, "t1q2s3v4.tmp"); + ffinit(&tmpfptr, filename, &status); + printf("Create temporary file: ffinit status = %d\n", status); + + ffcopy(fptr, tmpfptr, 0, &status); + printf("Copy image extension to primary array of tmp file.\n"); + printf("ffcopy status = %d\n", status); + + ffgrec(tmpfptr, 1, card, &status); + printf("%s\n", card); + ffgrec(tmpfptr, 2, card, &status); + printf("%s\n", card); + ffgrec(tmpfptr, 3, card, &status); + printf("%s\n", card); + ffgrec(tmpfptr, 4, card, &status); + printf("%s\n", card); + ffgrec(tmpfptr, 5, card, &status); + printf("%s\n", card); + ffgrec(tmpfptr, 6, card, &status); + printf("%s\n", card); + + ffdelt(tmpfptr, &status); + printf("Delete the tmp file: ffdelt status = %d\n", status); + + ffdhdu(fptr, &hdutype, &status); + printf("Delete the image extension; hdutype, status = %d %d\n", + hdutype, status); + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + + /* + ########################################################### + # append bintable extension with variable length columns # + ########################################################### + */ + + ffcrhd(fptr, &status); + printf("ffcrhd status = %d\n", status); + + strcpy(tform[0], "1PA"); + strcpy(tform[1], "1PL"); + strcpy(tform[2], "1PB"); /* Fortran FITSIO doesn't support 1PX */ + strcpy(tform[3], "1PB"); + strcpy(tform[4], "1PI"); + strcpy(tform[5], "1PJ"); + strcpy(tform[6], "1PE"); + strcpy(tform[7], "1PD"); + strcpy(tform[8], "1PC"); + strcpy(tform[9], "1PM"); + + strcpy(ttype[0], "Avalue"); + strcpy(ttype[1], "Lvalue"); + strcpy(ttype[2], "Xvalue"); + strcpy(ttype[3], "Bvalue"); + strcpy(ttype[4], "Ivalue"); + strcpy(ttype[5], "Jvalue"); + strcpy(ttype[6], "Evalue"); + strcpy(ttype[7], "Dvalue"); + strcpy(ttype[8], "Cvalue"); + strcpy(ttype[9], "Mvalue"); + + strcpy(tunit[0], ""); + strcpy(tunit[1], "m**2"); + strcpy(tunit[2], "cm"); + strcpy(tunit[3], "erg/s"); + strcpy(tunit[4], "km/s"); + strcpy(tunit[5], ""); + strcpy(tunit[6], ""); + strcpy(tunit[7], ""); + strcpy(tunit[8], ""); + strcpy(tunit[9], ""); + + nrows = 20; + tfields = 10; + pcount = 0; + + ffphbn(fptr, nrows, tfields, ttype, tform, tunit, binname, pcount, + &status); + printf("Variable length arrays: ffphbn status = %d\n", status); + + + extvers = 4; + ffpkyj(fptr, "EXTVER", extvers, "extension version number", &status); + + ffpkyj(fptr, "TNULL4", 88, "value for undefined pixels", &status); + ffpkyj(fptr, "TNULL5", 88, "value for undefined pixels", &status); + ffpkyj(fptr, "TNULL6", 88, "value for undefined pixels", &status); + + /* + ############################ + # write data to columns # + ############################ + */ + + /* initialize arrays of values to write to table */ + strcpy(iskey,"abcdefghijklmnopqrst"); + + for (ii = 0; ii < 20; ii++) + { + boutarray[ii] = ii + 1; + ioutarray[ii] = ii + 1; + joutarray[ii] = ii + 1; + eoutarray[ii] = ii + 1; + doutarray[ii] = ii + 1; + } + + larray[0] = 0; + larray[1] = 1; + larray[2] = 0; + larray[3] = 0; + larray[4] = 1; + larray[5] = 1; + larray[6] = 0; + larray[7] = 0; + larray[8] = 0; + larray[9] = 1; + larray[10] = 1; + larray[11] = 1; + larray[12] = 0; + larray[13] = 0; + larray[14] = 0; + larray[15] = 0; + larray[16] = 1; + larray[17] = 1; + larray[18] = 1; + larray[19] = 1; + + /* write values in 1st row */ + /* strncpy(inskey[0], iskey, 1); */ + inskey[0][0] = '\0'; /* write a null string (i.e., a blank) */ + ffpcls(fptr, 1, 1, 1, 1, inskey, &status); /* write string values */ + ffpcll(fptr, 2, 1, 1, 1, larray, &status); /* write logicals */ + ffpclx(fptr, 3, 1, 1, 1, larray, &status); /* write bits */ + ffpclb(fptr, 4, 1, 1, 1, boutarray, &status); + ffpcli(fptr, 5, 1, 1, 1, ioutarray, &status); + ffpclj(fptr, 6, 1, 1, 1, joutarray, &status); + ffpcle(fptr, 7, 1, 1, 1, eoutarray, &status); + ffpcld(fptr, 8, 1, 1, 1, doutarray, &status); + + for (ii = 2; ii <= 20; ii++) /* loop over rows 1 - 20 */ + { + strncpy(inskey[0], iskey, ii); + inskey[0][ii] = '\0'; + ffpcls(fptr, 1, ii, 1, 1, inskey, &status); /* write string values */ + + ffpcll(fptr, 2, ii, 1, ii, larray, &status); /* write logicals */ + ffpclu(fptr, 2, ii, ii-1, 1, &status); + + ffpclx(fptr, 3, ii, 1, ii, larray, &status); /* write bits */ + + ffpclb(fptr, 4, ii, 1, ii, boutarray, &status); + ffpclu(fptr, 4, ii, ii-1, 1, &status); + + ffpcli(fptr, 5, ii, 1, ii, ioutarray, &status); + ffpclu(fptr, 5, ii, ii-1, 1, &status); + + ffpclj(fptr, 6, ii, 1, ii, joutarray, &status); + ffpclu(fptr, 6, ii, ii-1, 1, &status); + + ffpcle(fptr, 7, ii, 1, ii, eoutarray, &status); + ffpclu(fptr, 7, ii, ii-1, 1, &status); + + ffpcld(fptr, 8, ii, 1, ii, doutarray, &status); + ffpclu(fptr, 8, ii, ii-1, 1, &status); + } + printf("ffpcl_ status = %d\n", status); + + /* + ################################# + # close then reopen this HDU # + ################################# + */ + + + ffmrhd(fptr, -1, &hdutype, &status); + ffmrhd(fptr, 1, &hdutype, &status); + + /* + ############################# + # read data from columns # + ############################# + */ + + ffgkyj(fptr, "PCOUNT", &pcount, comm, &status); + printf("PCOUNT = %ld\n", pcount); + + /* initialize the variables to be read */ + strcpy(inskey[0]," "); + strcpy(iskey," "); + + + printf("HDU number = %d\n", ffghdn(fptr, &hdunum)); + for (ii = 1; ii <= 20; ii++) /* loop over rows 1 - 20 */ + { + for (jj = 0; jj < ii; jj++) + { + larray[jj] = 0; + boutarray[jj] = 0; + ioutarray[jj] = 0; + joutarray[jj] = 0; + eoutarray[jj] = 0; + doutarray[jj] = 0; + } + + ffgcvs(fptr, 1, ii, 1, 1, iskey, inskey, &anynull, &status); + printf("A %s %d\nL", inskey[0], status); + + ffgcl( fptr, 2, ii, 1, ii, larray, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2d", larray[jj]); + printf(" %d\nX", status); + + ffgcx(fptr, 3, ii, 1, ii, larray, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2d", larray[jj]); + printf(" %d\nB", status); + + ffgcvb(fptr, 4, ii, 1, ii, 99, boutarray, &anynull, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2d", boutarray[jj]); + printf(" %d\nI", status); + + ffgcvi(fptr, 5, ii, 1, ii, 99, ioutarray, &anynull, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2d", ioutarray[jj]); + printf(" %d\nJ", status); + + ffgcvj(fptr, 6, ii, 1, ii, 99, joutarray, &anynull, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2ld", joutarray[jj]); + printf(" %d\nE", status); + + ffgcve(fptr, 7, ii, 1, ii, 99., eoutarray, &anynull, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2.0f", eoutarray[jj]); + printf(" %d\nD", status); + + ffgcvd(fptr, 8, ii, 1, ii, 99., doutarray, &anynull, &status); + for (jj = 0; jj < ii; jj++) + printf(" %2.0f", doutarray[jj]); + printf(" %d\n", status); + + ffgdes(fptr, 8, ii, &repeat, &offset, &status); + printf("Column 8 repeat and offset = %ld %ld\n", repeat, offset); + } + + /* + ##################################### + # create another image extension # + ##################################### + */ + + bitpix = 32; + naxis = 2; + naxes[0] = 10; + naxes[1] = 2; + npixels = 20; + +/* ffcrim(fptr, bitpix, naxis, naxes, &status); */ + ffiimg(fptr, bitpix, naxis, naxes, &status); + printf("\nffcrim status = %d\n", status); + + /* initialize arrays of values to write to primary array */ + for (ii = 0; ii < npixels; ii++) + { + boutarray[ii] = ii * 2; + ioutarray[ii] = ii * 2; + joutarray[ii] = ii * 2; + koutarray[ii] = ii * 2; + eoutarray[ii] = ii * 2; + doutarray[ii] = ii * 2; + } + + /* write a few pixels with each datatype */ + ffppr(fptr, TBYTE, 1, 2, &boutarray[0], &status); + ffppr(fptr, TSHORT, 3, 2, &ioutarray[2], &status); + ffppr(fptr, TINT, 5, 2, &koutarray[4], &status); + ffppr(fptr, TSHORT, 7, 2, &ioutarray[6], &status); + ffppr(fptr, TLONG, 9, 2, &joutarray[8], &status); + ffppr(fptr, TFLOAT, 11, 2, &eoutarray[10], &status); + ffppr(fptr, TDOUBLE, 13, 2, &doutarray[12], &status); + printf("ffppr status = %d\n", status); + + /* read back the pixels with each datatype */ + bnul = 0; + inul = 0; + knul = 0; + jnul = 0; + enul = 0.; + dnul = 0.; + + ffgpv(fptr, TBYTE, 1, 14, &bnul, binarray, &anynull, &status); + ffgpv(fptr, TSHORT, 1, 14, &inul, iinarray, &anynull, &status); + ffgpv(fptr, TINT, 1, 14, &knul, kinarray, &anynull, &status); + ffgpv(fptr, TLONG, 1, 14, &jnul, jinarray, &anynull, &status); + ffgpv(fptr, TFLOAT, 1, 14, &enul, einarray, &anynull, &status); + ffgpv(fptr, TDOUBLE, 1, 14, &dnul, dinarray, &anynull, &status); + + printf("\nImage values written with ffppr and read with ffgpv:\n"); + npixels = 14; + for (ii = 0; ii < npixels; ii++) + printf(" %2d", binarray[ii]); + printf(" %d (byte)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2d", iinarray[ii]); + printf(" %d (short)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2d", kinarray[ii]); + printf(" %d (int)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2ld", jinarray[ii]); + printf(" %d (long)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2.0f", einarray[ii]); + printf(" %d (float)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2.0f", dinarray[ii]); + printf(" %d (double)\n", anynull); + + /* + ########################################## + # test world coordinate system routines # + ########################################## + */ + + xrval = 45.83; + yrval = 63.57; + xrpix = 256.; + yrpix = 257.; + xinc = -.00277777; + yinc = .00277777; + + /* write the WCS keywords */ + /* use example values from the latest WCS document */ + ffpkyd(fptr, "CRVAL1", xrval, 10, "comment", &status); + ffpkyd(fptr, "CRVAL2", yrval, 10, "comment", &status); + ffpkyd(fptr, "CRPIX1", xrpix, 10, "comment", &status); + ffpkyd(fptr, "CRPIX2", yrpix, 10, "comment", &status); + ffpkyd(fptr, "CDELT1", xinc, 10, "comment", &status); + ffpkyd(fptr, "CDELT2", yinc, 10, "comment", &status); + /* ffpkyd(fptr, "CROTA2", rot, 10, "comment", &status); */ + ffpkys(fptr, "CTYPE1", xcoordtype, "comment", &status); + ffpkys(fptr, "CTYPE2", ycoordtype, "comment", &status); + printf("\nWrote WCS keywords status = %d\n",status); + + xrval = 0.; + yrval = 0.; + xrpix = 0.; + yrpix = 0.; + xinc = 0.; + yinc = 0.; + rot = 0.; + + ffgics(fptr, &xrval, &yrval, &xrpix, + &yrpix, &xinc, &yinc, &rot, ctype, &status); + printf("Read WCS keywords with ffgics status = %d\n",status); + + xpix = 0.5; + ypix = 0.5; + + ffwldp(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,ctype, + &xpos, &ypos,&status); + + printf(" CRVAL1, CRVAL2 = %16.12f, %16.12f\n", xrval,yrval); + printf(" CRPIX1, CRPIX2 = %16.12f, %16.12f\n", xrpix,yrpix); + printf(" CDELT1, CDELT2 = %16.12f, %16.12f\n", xinc,yinc); + printf(" Rotation = %10.3f, CTYPE = %s\n", rot, ctype); + printf("Calculated sky coordinate with ffwldp status = %d\n",status); + printf(" Pixels (%8.4f,%8.4f) --> (%11.6f, %11.6f) Sky\n", + xpix,ypix,xpos,ypos); + ffxypx(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,ctype, + &xpix, &ypix,&status); + printf("Calculated pixel coordinate with ffxypx status = %d\n",status); + printf(" Sky (%11.6f, %11.6f) --> (%8.4f,%8.4f) Pixels\n", + xpos,ypos,xpix,ypix); + /* + ###################################### + # append another ASCII table # + ###################################### + */ + + strcpy(tform[0], "A15"); + strcpy(tform[1], "I11"); + strcpy(tform[2], "F15.6"); + strcpy(tform[3], "E13.5"); + strcpy(tform[4], "D22.14"); + + strcpy(ttype[0], "Name"); + strcpy(ttype[1], "Ivalue"); + strcpy(ttype[2], "Fvalue"); + strcpy(ttype[3], "Evalue"); + strcpy(ttype[4], "Dvalue"); + + strcpy(tunit[0], ""); + strcpy(tunit[1], "m**2"); + strcpy(tunit[2], "cm"); + strcpy(tunit[3], "erg/s"); + strcpy(tunit[4], "km/s"); + + nrows = 11; + tfields = 5; + strcpy(tblname, "new_table"); + + ffcrtb(fptr, ASCII_TBL, nrows, tfields, ttype, tform, tunit, tblname, + &status); + printf("\nffcrtb status = %d\n", status); + + extvers = 5; + ffpkyj(fptr, "EXTVER", extvers, "extension version number", &status); + + ffpcl(fptr, TSTRING, 1, 1, 1, 3, onskey, &status); /* write string values */ + + /* initialize arrays of values to write */ + + for (ii = 0; ii < npixels; ii++) + { + boutarray[ii] = ii * 3; + ioutarray[ii] = ii * 3; + joutarray[ii] = ii * 3; + koutarray[ii] = ii * 3; + eoutarray[ii] = ii * 3; + doutarray[ii] = ii * 3; + } + + for (ii = 2; ii < 6; ii++) /* loop over cols 2 - 5 */ + { + ffpcl(fptr, TBYTE, ii, 1, 1, 2, boutarray, &status); + ffpcl(fptr, TSHORT, ii, 3, 1, 2, &ioutarray[2], &status); + ffpcl(fptr, TLONG, ii, 5, 1, 2, &joutarray[4], &status); + ffpcl(fptr, TFLOAT, ii, 7, 1, 2, &eoutarray[6], &status); + ffpcl(fptr, TDOUBLE, ii, 9, 1, 2, &doutarray[8], &status); + } + printf("ffpcl status = %d\n", status); + + /* read back the pixels with each datatype */ + ffgcv(fptr, TBYTE, 2, 1, 1, 10, &bnul, binarray, &anynull, &status); + ffgcv(fptr, TSHORT, 2, 1, 1, 10, &inul, iinarray, &anynull, &status); + ffgcv(fptr, TINT, 3, 1, 1, 10, &knul, kinarray, &anynull, &status); + ffgcv(fptr, TLONG, 3, 1, 1, 10, &jnul, jinarray, &anynull, &status); + ffgcv(fptr, TFLOAT, 4, 1, 1, 10, &enul, einarray, &anynull, &status); + ffgcv(fptr, TDOUBLE, 5, 1, 1, 10, &dnul, dinarray, &anynull, &status); + + printf("\nColumn values written with ffpcl and read with ffgcl:\n"); + npixels = 10; + for (ii = 0; ii < npixels; ii++) + printf(" %2d", binarray[ii]); + printf(" %d (byte)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2d", iinarray[ii]); + printf(" %d (short)\n", anynull); + + for (ii = 0; ii < npixels; ii++) + printf(" %2d", kinarray[ii]); + printf(" %d (int)\n", anynull); + + for (ii = 0; ii < npixels; ii++) + printf(" %2ld", jinarray[ii]); + printf(" %d (long)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2.0f", einarray[ii]); + printf(" %d (float)\n", anynull); + for (ii = 0; ii < npixels; ii++) + printf(" %2.0f", dinarray[ii]); + printf(" %d (double)\n", anynull); + + /* + ########################################################### + # perform stress test by cycling thru all the extensions # + ########################################################### + */ + printf("\nRepeatedly move to the 1st 4 HDUs of the file:\n"); + for (ii = 0; ii < 10; ii++) + { + ffmahd(fptr, 1, &hdutype, &status); + printf("%d", ffghdn(fptr, &hdunum)); + ffmrhd(fptr, 1, &hdutype, &status); + printf("%d", ffghdn(fptr, &hdunum)); + ffmrhd(fptr, 1, &hdutype, &status); + printf("%d", ffghdn(fptr, &hdunum)); + ffmrhd(fptr, 1, &hdutype, &status); + printf("%d", ffghdn(fptr, &hdunum)); + ffmrhd(fptr, -1, &hdutype, &status); + printf("%d", ffghdn(fptr, &hdunum)); + if (status > 0) + break; + } + printf("\n"); + + printf("Move to extensions by name and version number: (ffmnhd)\n"); + extvers = 1; + ffmnhd(fptr, ANY_HDU, binname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d\n", binname, extvers, hdunum, status); + extvers = 3; + ffmnhd(fptr, ANY_HDU, binname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d\n", binname, extvers, hdunum, status); + extvers = 4; + ffmnhd(fptr, ANY_HDU, binname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d\n", binname, extvers, hdunum, status); + + + strcpy(tblname, "Test-ASCII"); + extvers = 2; + ffmnhd(fptr, ANY_HDU, tblname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d\n", tblname, extvers, hdunum, status); + + strcpy(tblname, "new_table"); + extvers = 5; + ffmnhd(fptr, ANY_HDU, tblname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d\n", tblname, extvers, hdunum, status); + extvers = 0; + ffmnhd(fptr, ANY_HDU, binname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d\n", binname, extvers, hdunum, status); + extvers = 17; + ffmnhd(fptr, ANY_HDU, binname, (int) extvers, &status); + ffghdn(fptr, &hdunum); + printf(" %s, %ld = hdu %d, %d", binname, extvers, hdunum, status); + printf (" (expect a 301 error status here)\n"); + status = 0; + + ffthdu(fptr, &hdunum, &status); + printf("Total number of HDUs in the file = %d\n", hdunum); + /* + ######################## + # checksum tests # + ######################## + */ + checksum = 1234567890; + ffesum(checksum, 0, asciisum); + printf("\nEncode checksum: %lu -> %s\n", checksum, asciisum); + checksum = 0; + ffdsum(asciisum, 0, &checksum); + printf("Decode checksum: %s -> %lu\n", asciisum, checksum); + + ffpcks(fptr, &status); + + /* + don't print the CHECKSUM value because it is different every day + because the current date is in the comment field. + + ffgcrd(fptr, "CHECKSUM", card, &status); + printf("%s\n", card); + */ + + ffgcrd(fptr, "DATASUM", card, &status); + printf("%.30s\n", card); + + ffgcks(fptr, &datsum, &checksum, &status); + printf("ffgcks data checksum, status = %lu, %d\n", + datsum, status); + + ffvcks(fptr, &datastatus, &hdustatus, &status); + printf("ffvcks datastatus, hdustatus, status = %d %d %d\n", + datastatus, hdustatus, status); + + ffprec(fptr, + "new_key = 'written by fxprec' / to change checksum", &status); + ffupck(fptr, &status); + printf("ffupck status = %d\n", status); + + ffgcrd(fptr, "DATASUM", card, &status); + printf("%.30s\n", card); + ffvcks(fptr, &datastatus, &hdustatus, &status); + printf("ffvcks datastatus, hdustatus, status = %d %d %d\n", + datastatus, hdustatus, status); + + /* + delete the checksum keywords, so that the FITS file is always + the same, regardless of the date of when testprog is run. + */ + + ffdkey(fptr, "CHECKSUM", &status); + ffdkey(fptr, "DATASUM", &status); + + /* + ############################ + # close file and quit # + ############################ + */ + + errstatus: /* jump here on error */ + + ffclos(fptr, &status); + printf("ffclos status = %d\n", status); + + printf("\nNormally, there should be 8 error messages on the stack\n"); + printf("all regarding 'numerical overflows':\n"); + + ffgmsg(errmsg); + nmsg = 0; + + while (errmsg[0]) + { + printf(" %s\n", errmsg); + nmsg++; + ffgmsg(errmsg); + } + + if (nmsg != 8) + printf("\nWARNING: Did not find the expected 8 error messages!\n"); + + ffgerr(status, errmsg); + printf("\nStatus = %d: %s\n", status, errmsg); + + /* free the allocated memory */ + for (ii = 0; ii < 21; ii++) + free(inskey[ii]); + for (ii = 0; ii < 10; ii++) + { + free(ttype[ii]); + free(tform[ii]); + free(tunit[ii]); + } + + return(0); +} + diff --git a/pkg/tbtables/cfitsio/testprog.out b/pkg/tbtables/cfitsio/testprog.out new file mode 100644 index 00000000..c57d16f3 --- /dev/null +++ b/pkg/tbtables/cfitsio/testprog.out @@ -0,0 +1,797 @@ +CFITSIO TESTPROG, v2.401 + +Try opening then closing a nonexistent file: + ffopen fptr, status = 0 104 (expect an error) + ffclos status = 115 + +ffinit create new file status = 0 +Name of file = testprog.fit, I/O mode = 1 + +test writing of long string keywords: + 123456789012345678901234567890123456789012345678901234567890123456789012345 +'12345678901234567890123456789012345678901234567890123456789012345678' + 1234567890123456789012345678901234567890123456789012345678901234'6789012345 +'1234567890123456789012345678901234567890123456789012345678901234''67' + 1234567890123456789012345678901234567890123456789012345678901234''789012345 +'1234567890123456789012345678901234567890123456789012345678901234''''' + 1234567890123456789012345678901234567890123456789012345678901234567'9012345 +'1234567890123456789012345678901234567890123456789012345678901234567' +ffflus status = 0 +HDU number = 1 + +Values read back from primary array (99 = null pixel) +The 1st, and every 4th pixel should be undefined: + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 1 (ffgpvb) + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 1 (ffgpvi) + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 1 (ffgpvj) + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 1 (ffgpve) + 99 2 3 99 5 6 7 99 9 10 11 99 13 14 15 99 17 18 19 99 1 (ffgpvd) + * 2 3 * 5 6 7 * 9 10 11 * 13 14 15 * 17 18 19 * 1 (ffgpfb) + * 2 3 * 5 6 7 * 9 10 11 * 13 14 15 * 17 18 19 * 1 (ffgpfi) + * 2 3 * 5 6 7 * 9 10 11 * 13 14 15 * 17 18 19 * 1 (ffgpfj) + * 2 3 * 5 6 7 * 9 10 11 * 13 14 15 * 17 18 19 * 1 (ffgpfe) + * 2 3 * 5 6 7 * 9 10 11 * 13 14 15 * 17 18 19 * 1 (ffgpfd) + +Closed then reopened the FITS file 10 times. +HDU number = 1 +Name of file = testprog.fit, I/O mode = 1 + +Read back keywords: +simple = 1, bitpix = 32, naxis = 2, naxes = (10, 2) + pcount = 0, gcount = 1, extend = 1 +KEY_PREC= 'This keyword was written by fxprec' / comment goes here +KEY_PREC : 'This keyword was written by fxprec' : comment goes here : +KEY_PREC= 'This keyword was written by fxprec' / comment goes here +KY_PKNS1 : 'first string' : fxpkns comment : +KEY_PKYS value_string fxpkys comment 0 +KEY_PKYL 1 fxpkyl comment 0 +KEY_PKYJ 11 fxpkyj comment 0 +KEY_PKYJ 11.000000 fxpkyj comment 0 +KEY_PKYJ 11.000000 fxpkyj comment 0 +KEY_PKY S value_string fxpkys comment 0 +KEY_PKY L 1 fxpkyl comment 0 +KEY_PKY BYTE 11 fxpkyj comment 0 +KEY_PKY SHORT 11 fxpkyj comment 0 +KEY_PKY INT 11 fxpkyj comment 0 +KEY_PKY J 11 fxpkyj comment 0 +KEY_PKY E 13.131310 fxpkye comment 0 +KEY_PKY D 15.151515 fxpkyd comment 0 +KEY_PKYF 12.121210 fxpkyf comment 0 +KEY_PKYE 13.131310 fxpkye comment 0 +KEY_PKYG 14.14141414141414 fxpkyg comment 0 +KEY_PKYD 15.15151515151520 fxpkyd comment 0 +KEY_PKYC 13.131310 14.141410 fxpkyc comment 0 +KEY_PKFC 13.131313 14.141414 fxpkfc comment 0 +KEY_PKYM 15.151515 16.161616 fxpkym comment 0 +KEY_PKFM 15.151515 16.161616 fxpkfm comment 0 +KEY_PKYT 12345678 0.12345678901235 fxpkyt comment 0 +KEY_PKY J 11 [km/s/Mpc] fxpkyj comment 0 +KEY_PKY units = km/s/Mpc +KEY_PKY J 11 fxpkyj comment 0 +KEY_PKY units = +KEY_PKY J 11 [feet/second/second] fxpkyj comment 0 +KEY_PKY units = feet/second/second +KEY_PKLS long string value = +This is a very long string value that is continued over more than one keyword. +header contains 65 keywords; located at keyword 27 +ffgkns: first string, second string, +ffgknl: 1, 0, 1 +ffgknj: 11, 12, 13 +ffgkne: 13.131310, 14.141410, 15.151520 +ffgknd: 15.151515, 16.161616, 17.171717 + +Before deleting the HISTORY and DATE keywords... +COMMENT +HISTORY +DATE +KY_PKNS1 + +After deleting the keywords... +COMMENT This keyword was written by fxpcom. +KY_PKNS1= 'first string' / fxpkns comment + +After inserting the keywords... +COMMENT This keyword was written by fxpcom. +KY_IREC = 'This keyword inserted by fxirec' +KY_IKYS = 'insert_value_string' / ikys comment +KY_IKYJ = 49 / ikyj comment +KY_IKYL = T / ikyl comment +KY_IKYE = 1.2346E+01 / ikye comment +KY_IKYD = 1.23456789012346E+01 / ikyd comment +KY_IKYF = 12.3456 / ikyf comment +KY_IKYG = 12.3456789012346 / ikyg comment +KY_PKNS1= 'first string' / fxpkns comment + +After modifying the keywords... +COMMENT This keyword was modified by fxmrec +KY_MREC = 'This keyword was modified by fxmcrd' +NEWIKYS = 'modified_string' / ikys comment +KY_IKYJ = 50 / This is a modified comment +KY_IKYL = F / ikyl comment +KY_IKYE = -1.2346E+01 / ikye comment +KY_IKYD = -1.23456789012346E+01 / modified comment +KY_IKYF = -12.3456 / ikyf comment +KY_IKYG = -12.3456789012346 / ikyg comment +KY_PKNS1= 'first string' / fxpkns comment + +After updating the keywords... +COMMENT This keyword was modified by fxmrec +KY_UCRD = 'This keyword was updated by fxucrd' +NEWIKYS = 'updated_string' / ikys comment +KY_IKYJ = 51 / This is a modified comment +KY_IKYL = T / ikyl comment +KY_IKYE = -1.3346E+01 / ikye comment +KY_IKYD = -1.33456789012346E+01 / modified comment +KY_IKYF = -13.3456 / ikyf comment +KY_IKYG = -13.3456789012346 / ikyg comment +KY_PKNS1= 'first string' / fxpkns comment + +Keywords found using wildcard search (should be 13)... +KEY_PKYS= 'value_string' / fxpkys comment +KEY_PKYL= T / fxpkyl comment +KEY_PKYJ= 11 / [feet/second/second] fxpkyj comment +KEY_PKYF= 12.12121 / fxpkyf comment +KEY_PKYE= 1.313131E+01 / fxpkye comment +KEY_PKYG= 14.14141414141414 / fxpkyg comment +KEY_PKYD= 1.51515151515152E+01 / fxpkyd comment +KEY_PKYC= (1.313131E+01, 1.414141E+01) / fxpkyc comment +KEY_PKYM= (1.51515151515152E+01, 1.61616161616162E+01) / fxpkym comment +KEY_PKFC= (13.131313, 14.141414) / fxpkfc comment +KEY_PKFM= (15.15151515151515, 16.16161616161616) / fxpkfm comment +KEY_PKYT= 12345678.1234567890123456 / fxpkyt comment +NEWIKYS = 'updated_string' / ikys comment + +Copied keyword: ffgkne: 14.141410, 15.151520, 13.131310 +Updated header using template file (ffpktp) + +ffibin status = 0 +HDU number = 2 +header contains 33 keywords; located at keyword 1 +header contains 33 keywords with room for 74 more +TDIM3 = (1,2,8), 3, 1, 2, 8 +ffpcl_ status = 0 + +Find the column numbers; a returned status value of 237 is +expected and indicates that more than one column name matches +the input column name template. Status = 219 indicates that +there was no matching column name. +Column Xvalue is number 3; status = 0. +Column Avalue is number 1; status = 237. +Column Lvalue is number 2; status = 237. +Column Xvalue is number 3; status = 237. +Column Bvalue is number 4; status = 237. +Column Ivalue is number 5; status = 237. +Column Jvalue is number 6; status = 237. +Column Evalue is number 7; status = 237. +Column Dvalue is number 8; status = 237. +Column Cvalue is number 9; status = 237. +Column Mvalue is number 10; status = 237. +Column is number 0; status = 219. + +Information about each column: + 15A 16 15 15 Avalue, , A, 15, 1.000000, 0.000000, 1234554321, . + 1L 14 1 1 Lvalue, m**2, L, 1, 1.000000, 0.000000, 1234554321, . + 16X 1 16 1 Xvalue, cm, X, 16, 1.000000, 0.000000, 1234554321, . + 1B 11 1 1 Bvalue, erg/s, B, 1, 1.000000, 0.000000, 99, . + 1I 21 1 2 Ivalue, km/s, I, 1, 1.000000, 0.000000, 99, . + 1J 41 1 4 Jvalue, , J, 1, 1.000000, 0.000000, 99, . + 1E 42 1 4 Evalue, , E, 1, 1.000000, 0.000000, 1234554321, . + 1D 82 1 8 Dvalue, , D, 1, 1.000000, 0.000000, 1234554321, . + 1C 83 1 8 Cvalue, , C, 1, 1.000000, 0.000000, 1234554321, . + 1M 163 1 16 Mvalue, , M, 1, 1.000000, 0.000000, 1234554321, . + +ffitab status = 0 +HDU number = 2 +ffpcl_ status = 0 + +ASCII table: rowlen, nrows, tfields, extname: 76 11 5 Test-ASCII + Name 1 A15 + Ivalue 17 I10 m**2 + Fvalue 28 F14.6 cm + Evalue 43 E12.5 erg/s + Dvalue 56 D21.14 km/s + +Data values read from ASCII table: + first string 1 1 1 1.0 1.0 + second string 2 2 2 2.0 2.0 + 3 3 3 3.0 3.0 + UNDEFINED 4 4 4 4.0 4.0 + 5 5 5 5.0 5.0 + 6 6 6 6.0 6.0 + 7 7 7 7.0 7.0 + 8 8 8 8.0 8.0 + 9 9 9 9.0 9.0 + 10 10 10 10.0 10.0 + 99 99 99 99.0 99.0 + + 1 1.000000 1.00000E+00 1.00000000000000E+00second string + +Column name is number 1; status = 0. +Column Ivalue is number 2; status = 237. +Column Fvalue is number 3; status = 237. +Column Evalue is number 4; status = 237. +Column Dvalue is number 5; status = 237. +Column is number 0; status = 219. + A15 16 1 15 Name, 1, , A15, 1.000000, 0.000000, null1, . + I10 41 1 10 Ivalue, 17, m**2, I10, 1.000000, 0.000000, null2, . +F14.6 82 1 14 Fvalue, 28, cm, F14.6, 1.000000, 0.000000, null3, . +E12.5 42 1 12 Evalue, 43, erg/s, E12.5, 1.000000, 0.000000, null4, . +D21.14 82 1 21 Dvalue, 56, km/s, D21.14, 1.000000, 0.000000, null5, . + + +Data values after inserting 3 rows after row 2: + first string 1 1 1 1.0 1.0 + second string 2 2 2 2.0 2.0 + 0 0 0 0.0 0.0 + 0 0 0 0.0 0.0 + 0 0 0 0.0 0.0 + 3 3 3 3.0 3.0 + UNDEFINED 4 4 4 4.0 4.0 + 5 5 5 5.0 5.0 + 6 6 6 6.0 6.0 + 7 7 7 7.0 7.0 + 8 8 8 8.0 8.0 + 9 9 9 9.0 9.0 + 10 10 10 10.0 10.0 + 99 99 99 99.0 99.0 + +Data values after deleting 2 rows at row 10: + first string 1 1 1 1.0 1.0 + second string 2 2 2 2.0 2.0 + 0 0 0 0.0 0.0 + 0 0 0 0.0 0.0 + 0 0 0 0.0 0.0 + 3 3 3 3.0 3.0 + UNDEFINED 4 4 4 4.0 4.0 + 5 5 5 5.0 5.0 + 6 6 6 6.0 6.0 + 9 9 9 9.0 9.0 + 10 10 10 10.0 10.0 + 99 99 99 99.0 99.0 + +Data values after deleting column 3: + first string 1 1 1.0 1.0 + second string 2 2 2.0 2.0 + 0 0 0.0 0.0 + 0 0 0.0 0.0 + 0 0 0.0 0.0 + 3 3 3.0 3.0 + UNDEFINED 4 4 4.0 4.0 + 5 5 5.0 5.0 + 6 6 6.0 6.0 + 9 9 9.0 9.0 + 10 10 10.0 10.0 + 99 99 99.0 99.0 + +Data values after inserting column 5: + first string 1 1 1.0 1.0 0 + second string 2 2 2.0 2.0 0 + 0 0 0.0 0.0 0 + 0 0 0.0 0.0 0 + 0 0 0.0 0.0 0 + 3 3 3.0 3.0 0 + UNDEFINED 4 4 4.0 4.0 0 + 5 5 5.0 5.0 0 + 6 6 6.0 6.0 0 + 9 9 9.0 9.0 0 + 10 10 10.0 10.0 0 + 99 99 99.0 99.0 0 +Create temporary file: ffinit status = 0 + +Create null primary array: ffiimg status = 0 + +Create ASCII table with 0 columns: ffitab status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 + +Create Binary table with 0 columns: ffibin status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +Delete the tmp file: ffdelt status = 0 +HDU number = 3 +header contains 38 keywords with room for 69 more + +Binary table: nrows, tfields, extname, pcount: 21 10 Test-BINTABLE 0 + Avalue 15A + Lvalue 1L m**2 + Xvalue 16X cm + Bvalue 1B erg/s + Ivalue 1I km/s + Jvalue 1J + Evalue 1E + Dvalue 1D + Cvalue 1C + Mvalue 1M + +Data values read from binary table: + Bit column (X) data values: + +01001100 01110000 11110000 01111100 00000000 + +null string column value = -- (should be --) + +Read columns with ffgcv_: + first string 0 76 1 1 1 1.0 1.0 ( 1.0, -2.0) ( 1.0, -2.0) + second string 1 112 2 2 2 2.0 2.0 ( 3.0, -4.0) ( 3.0, -4.0) + 0 240 3 3 3 3.0 3.0 ( 5.0, -6.0) ( 5.0, -6.0) + NOT DEFINED 0 124 0 -4 -4 -4.0 -4.0 ( 7.0, -8.0) ( 7.0, -8.0) + NOT DEFINED 1 0 5 5 5 5.0 5.0 ( 9.0,-10.0) ( 9.0,-10.0) + NOT DEFINED 1 0 0 -6 -6 -6.0 -6.0 ( 11.0,-12.0) ( 11.0,-12.0) + NOT DEFINED 0 0 7 7 7 7.0 7.0 ( 13.0,-14.0) ( 13.0,-14.0) + NOT DEFINED 0 0 0 -8 -8 -8.0 -8.0 ( 15.0,-16.0) ( 15.0,-16.0) + NOT DEFINED 0 0 9 9 9 9.0 9.0 ( 17.0,-18.0) ( 17.0,-18.0) + NOT DEFINED 1 0 0 -10 -10 -10.0 -10.0 ( 19.0,-20.0) ( 19.0,-20.0) + NOT DEFINED 0 0 98 98 98 98.0 98.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 1 0 12 12 12 12.0 12.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 0 0 98 98 98 98.0 98.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 0 0 0 -14 -14 -14.0 -14.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 0 0 0 98 98 98.0 98.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 0 0 0 -16 -16 -16.0 -16.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 1 0 0 98 98 98.0 98.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 1 0 0 -18 -18 -18.0 -18.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 1 0 0 98 98 98.0 98.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 1 0 0 -20 -20 -20.0 -20.0 ( 0.0, 0.0) ( 0.0, 0.0) + NOT DEFINED 0 0 0 98 98 98.0 98.0 ( 0.0, 0.0) ( 0.0, 0.0) + +Read columns with ffgcf_: + first string 0 76 1 1 1 1.0 1.0 ( 1.0, -2.0) ( 1.0, -2.0) + second string 1 112 2 2 2 2.0 2.0 ( 3.0, -4.0) ( 3.0, -4.0) + 0 240 3 3 3 3.0 3.0 ( 5.0, -6.0) ( 5.0, -6.0) + 0 124 0 -4 -4 -4.0 -4.0 ( 7.0, -8.0) ( 7.0, -8.0) + 1 0 5 5 5 5.0 5.0 ( 9.0,-10.0) ( 9.0,-10.0) + 1 0 0 -6 -6 -6.0 -6.0 ( 11.0,-12.0) ( 11.0,-12.0) + 0 0 7 7 7 7.0 7.0 ( 13.0,-14.0) ( 13.0,-14.0) + 0 0 0 -8 -8 -8.0 -8.0 ( 15.0,-16.0) ( 15.0,-16.0) + 0 0 9 9 9 9.0 9.0 ( 17.0,-18.0) ( 17.0,-18.0) + 1 0 0 -10 -10 -10.0 -10.0 ( 19.0,-20.0) ( 19.0,-20.0) + 0 0 99 99 + 1 0 12 12 + 0 0 99 99 + 0 0 0 -14 + 0 0 0 99 + 0 0 0 -16 + 1 0 0 99 + 1 0 0 -18 + 1 0 0 99 + 1 0 0 -20 + 0 0 0 99 + +Data values after inserting 3 rows after row 2: + first string 1 1 1 1.0 1.0 + second string 2 2 2 2.0 2.0 + NOT DEFINED 0 0 0 0.0 0.0 + NOT DEFINED 0 0 0 0.0 0.0 + NOT DEFINED 0 0 0 0.0 0.0 + 3 3 3 3.0 3.0 + NOT DEFINED 0 -4 -4 -4.0 -4.0 + NOT DEFINED 5 5 5 5.0 5.0 + NOT DEFINED 0 -6 -6 -6.0 -6.0 + NOT DEFINED 7 7 7 7.0 7.0 + NOT DEFINED 0 -8 -8 -8.0 -8.0 + NOT DEFINED 9 9 9 9.0 9.0 + NOT DEFINED 0 -10 -10 -10.0 -10.0 + NOT DEFINED 98 98 98 98.0 98.0 + +Data values after deleting 2 rows at row 10: + first string 1 1 1 1.0 1.0 + second string 2 2 2 2.0 2.0 + NOT DEFINED 0 0 0 0.0 0.0 + NOT DEFINED 0 0 0 0.0 0.0 + NOT DEFINED 0 0 0 0.0 0.0 + 3 3 3 3.0 3.0 + NOT DEFINED 0 -4 -4 -4.0 -4.0 + NOT DEFINED 5 5 5 5.0 5.0 + NOT DEFINED 0 -6 -6 -6.0 -6.0 + NOT DEFINED 9 9 9 9.0 9.0 + NOT DEFINED 0 -10 -10 -10.0 -10.0 + NOT DEFINED 98 98 98 98.0 98.0 + +Data values after deleting column 6: + first string 1 1 1.0 1.0 + second string 2 2 2.0 2.0 + NOT DEFINED 0 0 0.0 0.0 + NOT DEFINED 0 0 0.0 0.0 + NOT DEFINED 0 0 0.0 0.0 + 3 3 3.0 3.0 + NOT DEFINED 0 -4 -4.0 -4.0 + NOT DEFINED 5 5 5.0 5.0 + NOT DEFINED 0 -6 -6.0 -6.0 + NOT DEFINED 9 9 9.0 9.0 + NOT DEFINED 0 -10 -10.0 -10.0 + NOT DEFINED 98 98 98.0 98.0 + +Data values after inserting column 8: + first string 1 1 1.0 1.0 0 + second string 2 2 2.0 2.0 0 + NOT DEFINED 0 0 0.0 0.0 0 + NOT DEFINED 0 0 0.0 0.0 0 + NOT DEFINED 0 0 0.0 0.0 0 + 3 3 3.0 3.0 0 + NOT DEFINED 0 -4 -4.0 -4.0 0 + NOT DEFINED 5 5 5.0 5.0 0 + NOT DEFINED 0 -6 -6.0 -6.0 0 + NOT DEFINED 9 9 9.0 9.0 0 + NOT DEFINED 0 -10 -10.0 -10.0 0 + NOT DEFINED 98 98 98.0 98.0 0 + +Values after setting 1st 10 elements in column 8 = null: + first string 1 1 1.0 1.0 98 + second string 2 2 2.0 2.0 98 + NOT DEFINED 0 0 0.0 0.0 98 + NOT DEFINED 0 0 0.0 0.0 98 + NOT DEFINED 0 0 0.0 0.0 98 + 3 3 3.0 3.0 98 + NOT DEFINED 0 -4 -4.0 -4.0 98 + NOT DEFINED 5 5 5.0 5.0 98 + NOT DEFINED 0 -6 -6.0 -6.0 98 + NOT DEFINED 9 9 9.0 9.0 98 + NOT DEFINED 0 -10 -10.0 -10.0 0 + NOT DEFINED 98 98 98.0 98.0 0 +Create temporary file: ffinit status = 0 + +Create null primary array: ffiimg status = 0 + +Create binary table with 0 columns: ffibin status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +copy column, ffcpcl status = 0 +Delete the tmp file: ffdelt status = 0 +ffibin status = 0 +HDU number = 2 + 0 1000 10000 33000 66000 -999 + 0 1000 10000 32768 65535 -999 + 0 1000 10000 32800 65500 -999 + + 0 1 10 33 66 -999 + -32768 -31768 -22768 0 32767 -999 + -1 9 99 327 654 -999 + +Create image extension: ffiimg status = 0 +HDU number = 3 + +Wrote whole 2D array: ffp2di status = 0 + +Read whole 2D array: ffg2di status = 0 + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 0 0 0 + 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 0 0 0 0 + 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 0 0 0 0 + 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 0 0 0 0 + 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 0 0 0 0 + 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 0 0 0 0 + 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 0 0 0 0 + 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 0 0 0 0 + 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 0 0 0 0 + 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 0 0 0 0 + 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 0 0 0 0 + 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 0 0 0 0 + 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 0 0 0 0 + 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 0 0 0 0 + 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 0 0 0 0 + 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 0 0 0 0 + 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 0 0 0 0 + 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 0 0 0 0 + 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 0 0 0 0 + 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 0 0 0 0 + 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 0 0 0 0 + 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 0 0 0 0 + 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 0 0 0 0 + 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 0 0 0 0 + 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + +Wrote subset 2D array: ffpssi status = 0 + +Read whole 2D array: ffg2di status = 0 + 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 0 0 0 + 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 0 0 0 0 + 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 0 0 0 0 + 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 0 0 0 0 + 40 41 42 43 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 54 0 0 0 0 + 50 51 52 53 -10 -11 -12 -13 -14 -15 -16 -17 -18 -19 64 0 0 0 0 + 60 61 62 63 -20 -21 -22 -23 -24 -25 -26 -27 -28 -29 74 0 0 0 0 + 70 71 72 73 -30 -31 -32 -33 -34 -35 -36 -37 -38 -39 84 0 0 0 0 + 80 81 82 83 -40 -41 -42 -43 -44 -45 -46 -47 -48 -49 94 0 0 0 0 + 90 91 92 93 -50 -51 -52 -53 -54 -55 -56 -57 -58 -59 104 0 0 0 0 + 100 101 102 103 -60 -61 -62 -63 -64 -65 -66 -67 -68 -69 114 0 0 0 0 + 110 111 112 113 -70 -71 -72 -73 -74 -75 -76 -77 -78 -79 124 0 0 0 0 + 120 121 122 123 -80 -81 -82 -83 -84 -85 -86 -87 -88 -89 134 0 0 0 0 + 130 131 132 133 -90 -91 -92 -93 -94 -95 -96 -97 -98 -99 144 0 0 0 0 + 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 0 0 0 0 + 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 0 0 0 0 + 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 0 0 0 0 + 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 0 0 0 0 + 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 0 0 0 0 + 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 0 0 0 0 + 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 0 0 0 0 + 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 0 0 0 0 + 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 0 0 0 0 + 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 0 0 0 0 + 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + +Read subset of 2D array: ffgsvi status = 0 + 41 43 -1 -3 -5 71 73 -31 -33 -35 + +Create image extension: ffiimg status = 0 +HDU number = 4 +Create temporary file: ffinit status = 0 +Copy image extension to primary array of tmp file. +ffcopy status = 0 +SIMPLE = T / file does conform to FITS standard +BITPIX = 16 / number of bits per data pixel +NAXIS = 2 / number of data axes +NAXIS1 = 15 / length of data axis 1 +NAXIS2 = 25 / length of data axis 2 +EXTEND = T / FITS dataset may contain extensions +Delete the tmp file: ffdelt status = 0 +Delete the image extension; hdutype, status = 1 0 +HDU number = 4 +ffcrhd status = 0 +Variable length arrays: ffphbn status = 0 +ffpcl_ status = 0 +PCOUNT = 4446 +HDU number = 6 +A 0 +L 0 0 +X 0 0 +B 1 0 +I 1 0 +J 1 0 +E 1 0 +D 1 0 +Column 8 repeat and offset = 1 14 +A ab 0 +L 0 1 0 +X 0 1 0 +B 99 2 0 +I 99 2 0 +J 99 2 0 +E 99 2 0 +D 99 2 0 +Column 8 repeat and offset = 2 49 +A abc 0 +L 0 0 0 0 +X 0 1 0 0 +B 1 99 3 0 +I 1 99 3 0 +J 1 99 3 0 +E 1 99 3 0 +D 1 99 3 0 +Column 8 repeat and offset = 3 105 +A abcd 0 +L 0 1 0 0 0 +X 0 1 0 0 0 +B 1 2 99 4 0 +I 1 2 99 4 0 +J 1 2 99 4 0 +E 1 2 99 4 0 +D 1 2 99 4 0 +Column 8 repeat and offset = 4 182 +A abcde 0 +L 0 1 0 0 1 0 +X 0 1 0 0 1 0 +B 1 2 3 99 5 0 +I 1 2 3 99 5 0 +J 1 2 3 99 5 0 +E 1 2 3 99 5 0 +D 1 2 3 99 5 0 +Column 8 repeat and offset = 5 280 +A abcdef 0 +L 0 1 0 0 0 1 0 +X 0 1 0 0 1 1 0 +B 1 2 3 4 99 6 0 +I 1 2 3 4 99 6 0 +J 1 2 3 4 99 6 0 +E 1 2 3 4 99 6 0 +D 1 2 3 4 99 6 0 +Column 8 repeat and offset = 6 399 +A abcdefg 0 +L 0 1 0 0 1 0 0 0 +X 0 1 0 0 1 1 0 0 +B 1 2 3 4 5 99 7 0 +I 1 2 3 4 5 99 7 0 +J 1 2 3 4 5 99 7 0 +E 1 2 3 4 5 99 7 0 +D 1 2 3 4 5 99 7 0 +Column 8 repeat and offset = 7 539 +A abcdefgh 0 +L 0 1 0 0 1 1 0 0 0 +X 0 1 0 0 1 1 0 0 0 +B 1 2 3 4 5 6 99 8 0 +I 1 2 3 4 5 6 99 8 0 +J 1 2 3 4 5 6 99 8 0 +E 1 2 3 4 5 6 99 8 0 +D 1 2 3 4 5 6 99 8 0 +Column 8 repeat and offset = 8 700 +A abcdefghi 0 +L 0 1 0 0 1 1 0 0 0 0 +X 0 1 0 0 1 1 0 0 0 0 +B 1 2 3 4 5 6 7 99 9 0 +I 1 2 3 4 5 6 7 99 9 0 +J 1 2 3 4 5 6 7 99 9 0 +E 1 2 3 4 5 6 7 99 9 0 +D 1 2 3 4 5 6 7 99 9 0 +Column 8 repeat and offset = 9 883 +A abcdefghij 0 +L 0 1 0 0 1 1 0 0 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 0 +B 1 2 3 4 5 6 7 8 99 10 0 +I 1 2 3 4 5 6 7 8 99 10 0 +J 1 2 3 4 5 6 7 8 99 10 0 +E 1 2 3 4 5 6 7 8 99 10 0 +D 1 2 3 4 5 6 7 8 99 10 0 +Column 8 repeat and offset = 10 1087 +A abcdefghijk 0 +L 0 1 0 0 1 1 0 0 0 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 1 0 +B 1 2 3 4 5 6 7 8 9 99 11 0 +I 1 2 3 4 5 6 7 8 9 99 11 0 +J 1 2 3 4 5 6 7 8 9 99 11 0 +E 1 2 3 4 5 6 7 8 9 99 11 0 +D 1 2 3 4 5 6 7 8 9 99 11 0 +Column 8 repeat and offset = 11 1312 +A abcdefghijkl 0 +L 0 1 0 0 1 1 0 0 0 1 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 +B 1 2 3 4 5 6 7 8 9 10 99 12 0 +I 1 2 3 4 5 6 7 8 9 10 99 12 0 +J 1 2 3 4 5 6 7 8 9 10 99 12 0 +E 1 2 3 4 5 6 7 8 9 10 99 12 0 +D 1 2 3 4 5 6 7 8 9 10 99 12 0 +Column 8 repeat and offset = 12 1558 +A abcdefghijklm 0 +L 0 1 0 0 1 1 0 0 0 1 1 0 0 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 +B 1 2 3 4 5 6 7 8 9 10 11 99 13 0 +I 1 2 3 4 5 6 7 8 9 10 11 99 13 0 +J 1 2 3 4 5 6 7 8 9 10 11 99 13 0 +E 1 2 3 4 5 6 7 8 9 10 11 99 13 0 +D 1 2 3 4 5 6 7 8 9 10 11 99 13 0 +Column 8 repeat and offset = 13 1825 +A abcdefghijklmn 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 99 14 0 +Column 8 repeat and offset = 14 2113 +A abcdefghijklmno 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 13 99 15 0 +Column 8 repeat and offset = 15 2422 +A abcdefghijklmnop 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 13 14 99 16 0 +Column 8 repeat and offset = 16 2752 +A abcdefghijklmnopq 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 99 17 0 +Column 8 repeat and offset = 17 3104 +A abcdefghijklmnopqr 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 99 18 0 +Column 8 repeat and offset = 18 3477 +A abcdefghijklmnopqrs 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 99 19 0 +Column 8 repeat and offset = 19 3871 +A abcdefghijklmnopqrst 0 +L 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 0 1 0 +X 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 +B 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 +I 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 +J 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 +E 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 +D 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 99 20 0 +Column 8 repeat and offset = 20 4286 + +ffcrim status = 0 +ffppr status = 0 + +Image values written with ffppr and read with ffgpv: + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 0 (byte) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 0 (short) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 0 (int) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 0 (long) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 0 (float) + 0 2 4 6 8 10 12 14 16 18 20 22 24 26 0 (double) + +Wrote WCS keywords status = 0 +Read WCS keywords with ffgics status = 0 + CRVAL1, CRVAL2 = 45.830000000000, 63.570000000000 + CRPIX1, CRPIX2 = 256.000000000000, 257.000000000000 + CDELT1, CDELT2 = -0.002777770000, 0.002777770000 + Rotation = 0.000, CTYPE = -TAN +Calculated sky coordinate with ffwldp status = 0 + Pixels ( 0.5000, 0.5000) --> ( 47.385204, 62.848968) Sky +Calculated pixel coordinate with ffxypx status = 0 + Sky ( 47.385204, 62.848968) --> ( 0.5000, 0.5000) Pixels + +ffcrtb status = 0 +ffpcl status = 0 + +Column values written with ffpcl and read with ffgcl: + 0 3 6 9 12 15 18 21 24 27 0 (byte) + 0 3 6 9 12 15 18 21 24 27 0 (short) + 0 3 6 9 12 15 18 21 24 27 0 (int) + 0 3 6 9 12 15 18 21 24 27 0 (long) + 0 3 6 9 12 15 18 21 24 27 0 (float) + 0 3 6 9 12 15 18 21 24 27 0 (double) + +Repeatedly move to the 1st 4 HDUs of the file: +12343123431234312343123431234312343123431234312343 +Move to extensions by name and version number: (ffmnhd) + Test-BINTABLE, 1 = hdu 5, 0 + Test-BINTABLE, 3 = hdu 2, 0 + Test-BINTABLE, 4 = hdu 6, 0 + Test-ASCII, 2 = hdu 4, 0 + new_table, 5 = hdu 8, 0 + Test-BINTABLE, 0 = hdu 2, 0 + Test-BINTABLE, 17 = hdu 2, 301 (expect a 301 error status here) +Total number of HDUs in the file = 8 + +Encode checksum: 1234567890 -> dCW2fBU0dBU0dBU0 +Decode checksum: dCW2fBU0dBU0dBU0 -> 1234567890 +DATASUM = '475248536' +ffgcks data checksum, status = 475248536, 0 +ffvcks datastatus, hdustatus, status = 1 1 0 +ffupck status = 0 +DATASUM = '475248536' +ffvcks datastatus, hdustatus, status = 1 1 0 +ffclos status = 0 + +Normally, there should be 8 error messages on the stack +all regarding 'numerical overflows': + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + Numerical overflow during type conversion while writing FITS data. + +Status = 0: OK - no error diff --git a/pkg/tbtables/cfitsio/testprog.std b/pkg/tbtables/cfitsio/testprog.std new file mode 100644 index 00000000..2f2a10cc --- /dev/null +++ b/pkg/tbtables/cfitsio/testprog.std @@ -0,0 +1,48 @@ +SIMPLE = T / file does conform to FITS standard BITPIX = 32 / number of bits per data pixel NAXIS = 2 / number of data axes NAXIS1 = 10 / length of data axis 1 NAXIS2 = 2 / length of data axis 2 EXTEND = T / FITS dataset may contain extensions COMMENT FITS (Flexible Image Transport System) format is defined in 'AstronomyCOMMENT and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H KEY_PREC= 'This keyword was written by fxprec' / comment goes here CARD1 = '12345678901234567890123456789012345678901234567890123456789012345678'CARD2 = '1234567890123456789012345678901234567890123456789012345678901234''67'CARD3 = '1234567890123456789012345678901234567890123456789012345678901234'''''CARD4 = '1234567890123456789012345678901234567890123456789012345678901234567' KEY_PKYS= 'value_string' / fxpkys comment KEY_PKYL= T / fxpkyl comment KEY_PKYJ= 11 / [feet/second/second] fxpkyj comment KEY_PKYF= 12.12121 / fxpkyf comment KEY_PKYE= 1.313131E+01 / fxpkye comment KEY_PKYG= 14.14141414141414 / fxpkyg comment KEY_PKYD= 1.51515151515152E+01 / fxpkyd comment KEY_PKYC= (1.313131E+01, 1.414141E+01) / fxpkyc comment KEY_PKYM= (1.51515151515152E+01, 1.61616161616162E+01) / fxpkym comment KEY_PKFC= (13.131313, 14.141414) / fxpkfc comment KEY_PKFM= (15.15151515151515, 16.16161616161616) / fxpkfm comment KEY_PKLS= 'This is a very long string value that is continued over more than o&'CONTINUE 'ne keyword.' / fxpkls comment LONGSTRN= 'OGIP 1.0' / The HEASARC Long String Convention may be used.COMMENT This FITS file may contain long string keyword values that are COMMENT continued over multiple keywords. The HEASARC convention uses the & COMMENT character at the end of each substring which is then continued COMMENT on the next keyword which has the name CONTINUE. KEY_PKYT= 12345678.1234567890123456 / fxpkyt comment COMMENT This keyword was modified by fxmrec KY_UCRD = 'This keyword was updated by fxucrd' NEWIKYS = 'updated_string' / ikys comment KY_IKYJ = 51 / This is a modified comment KY_IKYL = T / ikyl comment KY_IKYE = -1.3346E+01 / ikye comment KY_IKYD = -1.33456789012346E+01 / modified comment KY_IKYF = -13.3456 / ikyf comment KY_IKYG = -13.3456789012346 / ikyg comment KY_PKNS1= 'first string' / fxpkns comment KY_PKNS2= 'second string' / fxpkns comment KY_PKNS3= ' ' / fxpkns comment KY_PKNL1= T / fxpknl comment KY_PKNL2= F / fxpknl comment KY_PKNL3= T / fxpknl comment KY_PKNJ1= 11 / fxpknj comment KY_PKNJ2= 12 / fxpknj comment KY_PKNJ3= 13 / fxpknj comment KY_PKNF1= 12.12121 / fxpknf comment KY_PKNF2= 13.13131 / fxpknf comment KY_PKNF3= 14.14141 / fxpknf comment KY_PKNE1= 1.313131E+01 / fxpkne comment KY_PKNE2= 1.414141E+01 / fxpkne comment KY_PKNE3= 1.515152E+01 / fxpkne comment KY_PKNG1= 14.1414141414141 / fxpkng comment KY_PKNG2= 15.1515151515152 / fxpkng comment KY_PKNG3= 16.1616161616162 / fxpkng comment KY_PKND1= 1.51515151515152E+01 / fxpknd comment KY_PKND2= 1.61616161616162E+01 / fxpknd comment KY_PKND3= 1.71717171717172E+01 / fxpknd comment TSTRING = '1 ' / tstring comment TLOGICAL= T / tlogical comment TBYTE = 11 / tbyte comment TSHORT = 21 / tshort comment TINT = 31 / tint comment TLONG = 41 / tlong comment TFLOAT = 42. / tfloat comment TDOUBLE = 82. / tdouble comment BLANK = -99 / value to use for undefined pixels KY_PKNE4= 1.313131E+01 / fxpkne comment TMPCARDA= 1001 / this is the 1st template card TMPCARD2= 'ABCD ' / this is the 2nd template card TMPCARD3= 1001.23 / this is the 3rd template card COMMENT this is the 5th template card HISTORY this is the 6th template card TMPCARD7= / comment for null keyword END ÿÿÿÿÿÿÿÿÿ + ÿÿÿ ÿÿÿÿÿÿXTENSION= 'BINTABLE' / binary table extension BITPIX = 8 / 8-bit bytes NAXIS = 2 / 2-dimensional binary table NAXIS1 = 61 / width of table in bytes NAXIS2 = 20 / number of rows in table PCOUNT = 0 / size of special data area GCOUNT = 1 / one data group (required keyword) TFIELDS = 10 / number of fields in each row TTYPE1 = 'Avalue ' / label for field 1 TFORM1 = '15A ' / data format of field: ASCII Character TTYPE2 = 'Lvalue ' / label for field 2 TFORM2 = '1L ' / data format of field: 1-byte LOGICAL TUNIT2 = 'm**2 ' / physical unit of field TTYPE3 = 'Xvalue ' / label for field 3 TFORM3 = '16X ' / data format of field: BIT TUNIT3 = 'cm ' / physical unit of field TTYPE4 = 'Bvalue ' / label for field 4 TFORM4 = '1B ' / data format of field: BYTE TUNIT4 = 'erg/s ' / physical unit of field TTYPE5 = 'Ivalue ' / label for field 5 TFORM5 = '1I ' / data format of field: 2-byte INTEGER TUNIT5 = 'km/s ' / physical unit of field TTYPE6 = 'Jvalue ' / label for field 6 TFORM6 = '1J ' / data format of field: 4-byte INTEGER TTYPE7 = 'Evalue ' / label for field 7 TFORM7 = '1E ' / data format of field: 4-byte REAL TTYPE8 = 'Dvalue ' / label for field 8 TFORM8 = '1D ' / data format of field: 8-byte DOUBLE TTYPE9 = 'Cvalue ' / label for field 9 TFORM9 = '1C ' / data format of field: COMPLEX TTYPE10 = 'Mvalue ' / label for field 10 TFORM10 = '1M ' / data format of field: DOUBLE COMPLEX EXTNAME = 'Test-BINTABLE' / name of this binary table extension EXTVER = 3 / extension version number TNULL4 = 77 / value for undefined pixels TNULL5 = 77 / value for undefined pixels TNULL6 = 77 / value for undefined pixels TSCAL4 = 1000 / scaling factor TSCAL5 = 1 / scaling factor TSCAL6 = 100 / scaling factor TZERO4 = 0 / scaling offset TZERO5 = 32768 / scaling offset TZERO6 = 100 / scaling offset NEW_KEY = 'written by fxprec' / to change checksum END €ÿÿÿÿƒè +§c!GBÿŽMMMXTENSION= 'IMAGE ' / IMAGE extension BITPIX = -32 / number of bits per data pixel NAXIS = 2 / number of data axes NAXIS1 = 15 / length of data axis 1 NAXIS2 = 25 / length of data axis 2 PCOUNT = 0 / required keyword; must = 0 GCOUNT = 1 / required keyword; must = 1 END ?€@@@@€@ @À@àAAA A0A@APA`A A0A@APA`ApA€AˆAA˜A A¨A°A¸AÀA A¨A°A¸AÀAÈAÐAØAàAèAðAøBBBAðAøBBBB BBBBB B$B(B,B0B B$B(B,¿€ÀÀ@À€À ÀÀÀàÁÁBXBHBLBPBTÁ Á0Á@ÁPÁ`ÁpÁ€ÁˆÁÁ˜B€BpBtBxB|Á Á¨Á°Á¸ÁÀÁÈÁÐÁØÁàÁèB”BŒBŽBB’ÁðÁø ÂÂÂÂB¨B B¢B¤B¦Â Â$Â(Â,Â0Â4Â8Â<Â@ÂDB¼B´B¶B¸BºÂHÂLÂPÂTÂXÂ\Â`ÂdÂhÂlBÐBÈBÊBÌBÎÂpÂtÂxÂ|€‚„†ˆŠBäBÜBÞBàB⌎’”–˜šœžBøBðBòBôBö ¢¤¦¨ª¬®°²CCCCC´¶¸º¼¾ÂÀÂÂÂÄÂÆCC C CCCCCCCCCCCCCCCCCCCCCCCC C!C"C#C$C C!C"C#C$C%C&C'C(C)C*C+C,C-C.C*C+C,C-C.C/C0C1C2C3C4C5C6C7C8C4C5C6C7C8C9C:C;C<C=C>C?C@CACBC>C?C@CACBCCCDCECFCGCHCICJCKCLCHCICJCKCLCMCNCOCPCQCRCSCTCUCVCRCSCTCUCVCWCXCYCZC[C\C]C^C_C`C\C]C^C_C`CaCbCcCdCeCfCgChCiCjCfCgChCiCjCkClCmCnCoCpCqCrCsCtCpCqCrCsCtCuCvCwCxCyCzC{C|C}C~XTENSION= 'TABLE ' / ASCII table extension BITPIX = 8 / 8-bit ASCII characters NAXIS = 2 / 2-dimensional ASCII table NAXIS1 = 76 / width of table in characters NAXIS2 = 12 / number of rows in table PCOUNT = 0 / no group parameters (required keyword) GCOUNT = 1 / one data group (required keyword) TFIELDS = 5 / number of fields in each row TTYPE1 = 'Name ' / label for field 1 TBCOL1 = 1 / beginning column of field 1 TFORM1 = 'A15 ' / Fortran-77 format of field TTYPE2 = 'Ivalue ' / label for field 2 TBCOL2 = 17 / beginning column of field 2 TFORM2 = 'I10 ' / Fortran-77 format of field TUNIT2 = 'm**2 ' / physical unit of field TTYPE3 = 'Evalue ' / label for field 4 TBCOL3 = 28 / beginning column of field 4 TFORM3 = 'E12.5 ' / Fortran-77 format of field TUNIT3 = 'erg/s ' / physical unit of field TTYPE4 = 'Dvalue ' / label for field 5 TBCOL4 = 41 / beginning column of field 5 TFORM4 = 'D21.14 ' / Fortran-77 format of field TUNIT4 = 'km/s ' / physical unit of field EXTNAME = 'Test-ASCII' / name of this ASCII table extension EXTVER = 2 / extension version number TNULL1 = 'null1 ' / value for undefined pixels TNULL2 = 'null2 ' / value for undefined pixels TNULL3 = 'null4 ' / value for undefined pixels TNULL4 = 'null5 ' / value for undefined pixels TTYPE5 = 'INSERT_COL' / label for field TFORM5 = 'F14.6 ' / format of field TBCOL5 = 63 / beginning column of field END first string 1 1.00000E+00 1.00000000000000E+00 second string 2 2.00000E+00 2.00000000000000E+00 3 3.00000E+00 3.00000000000000E+00 null1 4 4.00000E+00 4.00000000000000E+00 5 5.00000E+00 5.00000000000000E+00 6 6.00000E+00 6.00000000000000E+00 9 9.00000E+00 9.00000000000000E+00 10 1.00000E+01 1.00000000000000E+01 null2 null4 null5 XTENSION= 'BINTABLE' / binary table extension BITPIX = 8 / 8-bit bytes NAXIS = 2 / 2-dimensional binary table NAXIS1 = 61 / width of table in bytes NAXIS2 = 22 / number of rows in table PCOUNT = 0 / size of special data area GCOUNT = 1 / one data group (required keyword) TFIELDS = 10 / number of fields in each row TTYPE1 = 'Avalue ' / label for field 1 TFORM1 = '15A ' / data format of field: ASCII Character TTYPE2 = 'Lvalue ' / label for field 2 TFORM2 = '1L ' / data format of field: 1-byte LOGICAL TUNIT2 = 'm**2 ' / physical unit of field TTYPE3 = 'Xvalue ' / label for field 3 TFORM3 = '16X ' / data format of field: BIT TUNIT3 = 'cm ' / physical unit of field TTYPE4 = 'Bvalue ' / label for field 4 TFORM4 = '1B ' / data format of field: BYTE TUNIT4 = 'erg/s ' / physical unit of field TTYPE5 = 'Ivalue ' / label for field 5 TFORM5 = '1I ' / data format of field: 2-byte INTEGER TUNIT5 = 'km/s ' / physical unit of field TTYPE6 = 'Evalue ' / label for field 7 TFORM6 = '1E ' / data format of field: 4-byte REAL TTYPE7 = 'Dvalue ' / label for field 8 TFORM7 = '1D ' / data format of field: 8-byte DOUBLE TTYPE9 = 'Cvalue ' / label for field 9 TFORM9 = '1C ' / data format of field: COMPLEX TTYPE10 = 'Mvalue ' / label for field 10 TFORM10 = '1M ' / data format of field: DOUBLE COMPLEX EXTNAME = 'Test-BINTABLE' / name of this binary table extension EXTVER = 1 / extension version number TNULL4 = 99 / value for undefined pixels TNULL5 = 99 / value for undefined pixels TDIM3 = '(1,2,8) ' / size of the multidimensional array KEY_PREC= 'This keyword was written by f_prec' / comment here TTYPE8 = 'INSERT_COL' / label for field TFORM8 = '1E ' / format of field END first string FLp?€?ðÿÿÿÿ?€À?ðÀsecond string Tð|@@ÿÿÿÿ@@À€@Àÿÿÿÿÿÿÿÿÿÿÿÿ F@@@ÿÿÿÿ@ ÀÀ@À FÿüÀ€Àÿÿÿÿ@àÁ@À T@ @ÿÿÿÿAÁ @"À$TÿúÀÀÀÿÿÿÿA0Á@@&À(F A@"ÿÿÿÿAˆÁ@1À2TÿöÁ À$A˜Á @3À4ccÿÿÿÿÿÿÿÿÿÿÿÿT A@@(FccÿÿÿÿÿÿÿÿÿÿÿÿFÿòÁ`À,FcÿÿÿÿÿÿÿÿÿÿÿÿFÿðÁ€À0TcÿÿÿÿÿÿÿÿÿÿÿÿTÿîÁÀ2TcÿÿÿÿÿÿÿÿÿÿÿÿTÿìÁ À4FcÿÿÿÿÿÿÿÿÿÿÿÿXTENSION= 'BINTABLE' / binary table extension BITPIX = 8 / 8-bit bytes NAXIS = 2 / 2-dimensional binary table NAXIS1 = 80 / width of table in bytes NAXIS2 = 20 / number of rows in table PCOUNT = 4446 / size of special data area GCOUNT = 1 / one data group (required keyword) TFIELDS = 10 / number of fields in each row TTYPE1 = 'Avalue ' / label for field 1 TFORM1 = '1PA(20) ' / data format of field: variable length array TTYPE2 = 'Lvalue ' / label for field 2 TFORM2 = '1PL(20) ' / data format of field: variable length array TUNIT2 = 'm**2 ' / physical unit of field TTYPE3 = 'Xvalue ' / label for field 3 TFORM3 = '1PB(3) ' / data format of field: variable length array TUNIT3 = 'cm ' / physical unit of field TTYPE4 = 'Bvalue ' / label for field 4 TFORM4 = '1PB(20) ' / data format of field: variable length array TUNIT4 = 'erg/s ' / physical unit of field TTYPE5 = 'Ivalue ' / label for field 5 TFORM5 = '1PI(20) ' / data format of field: variable length array TUNIT5 = 'km/s ' / physical unit of field TTYPE6 = 'Jvalue ' / label for field 6 TFORM6 = '1PJ(20) ' / data format of field: variable length array TTYPE7 = 'Evalue ' / label for field 7 TFORM7 = '1PE(20) ' / data format of field: variable length array TTYPE8 = 'Dvalue ' / label for field 8 TFORM8 = '1PD(20) ' / data format of field: variable length array TTYPE9 = 'Cvalue ' / label for field 9 TFORM9 = '1PC(0) ' / data format of field: variable length array TTYPE10 = 'Mvalue ' / label for field 10 TFORM10 = '1PM(0) ' / data format of field: variable length array EXTNAME = 'Test-BINTABLE' / name of this binary table extension EXTVER = 4 / extension version number TNULL4 = 88 / value for undefined pixels TNULL5 = 88 / value for undefined pixels TNULL6 = 88 / value for undefined pixels END  +!)1ADGHKQ]i…‰ŠŽ–¦¶ÖÛàáæð@FLMS_w¿ÆÍÎÕãÿS[cdl|œ¼ ü    + O s +» +ÅÏ +Ñ +Û +ï + +?  š¥ § ² È ô  x „ ’ ž ¶ æ  v ƒ ’ Ÿ ¹ í !‰—¥§µÑ A±ÀÏÑàþ : v î þ + + +  +@ +€ +À @ Q b e v ˜ Ü  ¨ º Ì Ï á  M •%8KNa‡Ó·Ëßâön¾ F?€?ðabT@XXXÿÿÿÿ@ÿÿÿÿÿÿÿÿ@abcFF@XXX?€ÿÿÿÿ@@?ðÿÿÿÿÿÿÿÿ@abcdFTF@XXX?€@ÿÿÿÿ@€?ð@ÿÿÿÿÿÿÿÿ@abcdeFTFTHXXX?€@@@ÿÿÿÿ@ ?ð@@ÿÿÿÿÿÿÿÿ@abcdefFTFFTLXXX?€@@@@€ÿÿÿÿ@À?ð@@@ÿÿÿÿÿÿÿÿ@abcdefgFTFFTFLXXX?€@@@@€@ ÿÿÿÿ@à?ð@@@@ÿÿÿÿÿÿÿÿ@abcdefghFTFFTTFLXXX?€@@@@€@ @ÀÿÿÿÿA?ð@@@@@ÿÿÿÿÿÿÿÿ@ abcdefghiFTFFTTFFLX X X ?€@@@@€@ @À@àÿÿÿÿA?ð@@@@@@ÿÿÿÿÿÿÿÿ@"abcdefghijFTFFTTFFTL@X +X +X +?€@@@@€@ @À@àAÿÿÿÿA ?ð@@@@@@@ ÿÿÿÿÿÿÿÿ@$abcdefghijkFTFFTTFFFTL` X  X  X ?€@@@@€@ @À@àAAÿÿÿÿA0?ð@@@@@@@ @"ÿÿÿÿÿÿÿÿ@&abcdefghijklFTFFTTFFFTTLp +X  +X  +X ?€@@@@€@ @À@àAAA ÿÿÿÿA@?ð@@@@@@@ @"@$ÿÿÿÿÿÿÿÿ@(abcdefghijklmFTFFTTFFFTTFLp + X  + X  + X ?€@@@@€@ @À@àAAA A0ÿÿÿÿAP?ð@@@@@@@ @"@$@&ÿÿÿÿÿÿÿÿ@*abcdefghijklmnFTFFTTFFFTTTFLp + X + X + X?€@@@@€@ @À@àAAA A0A@ÿÿÿÿA`?ð@@@@@@@ @"@$@&@(ÿÿÿÿÿÿÿÿ@,abcdefghijklmnoFTFFTTFFFTTTFFLp + X + X + X?€@@@@€@ @À@àAAA A0A@APÿÿÿÿAp?ð@@@@@@@ @"@$@&@(@*ÿÿÿÿÿÿÿÿ@.abcdefghijklmnopFTFFTTFFFTTTFFFLp + X + X + X?€@@@@€@ @À@àAAA A0A@APA`ÿÿÿÿA€?ð@@@@@@@ @"@$@&@(@*@,ÿÿÿÿÿÿÿÿ@0abcdefghijklmnopqFTFFTTFFFTTTFFFTLp€ + X + X + X?€@@@@€@ @À@àAAA A0A@APA`ApÿÿÿÿAˆ?ð@@@@@@@ @"@$@&@(@*@,@.ÿÿÿÿÿÿÿÿ@1abcdefghijklmnopqrFTFFTTFFFTTTFFFFTLpÀ + X + X + X?€@@@@€@ @À@àAAA A0A@APA`ApA€ÿÿÿÿA?ð@@@@@@@ @"@$@&@(@*@,@.@0ÿÿÿÿÿÿÿÿ@2abcdefghijklmnopqrsFTFFTTFFFTTTFFFFTTLpà + X + X + X?€@@@@€@ @À@àAAA A0A@APA`ApA€AˆÿÿÿÿA˜?ð@@@@@@@ @"@$@&@(@*@,@.@0@1ÿÿÿÿÿÿÿÿ@3abcdefghijklmnopqrstFTFFTTFFFTTTFFFFTTTLpð + X + X + X?€@@@@€@ @À@àAAA A0A@APA`ApA€AˆAÿÿÿÿA ?ð@@@@@@@ @"@$@&@(@*@,@.@0@1@2ÿÿÿÿÿÿÿÿ@4XTENSION= 'IMAGE ' / IMAGE extension BITPIX = 32 / number of bits per data pixel NAXIS = 2 / number of data axes NAXIS1 = 10 / length of data axis 1 NAXIS2 = 2 / length of data axis 2 PCOUNT = 0 / required keyword; must = 0 GCOUNT = 1 / required keyword; must = 1 CRVAL1 = 4.5830000000E+01 / comment CRVAL2 = 6.3570000000E+01 / comment CRPIX1 = 2.5600000000E+02 / comment CRPIX2 = 2.5700000000E+02 / comment CDELT1 = -2.7777700000E-03 / comment CDELT2 = 2.7777700000E-03 / comment CTYPE1 = 'RA---TAN' / comment CTYPE2 = 'DEC--TAN' / comment END  + XTENSION= 'TABLE ' / ASCII table extension BITPIX = 8 / 8-bit ASCII characters NAXIS = 2 / 2-dimensional ASCII table NAXIS1 = 80 / width of table in characters NAXIS2 = 11 / number of rows in table PCOUNT = 0 / no group parameters (required keyword) GCOUNT = 1 / one data group (required keyword) TFIELDS = 5 / number of fields in each row TTYPE1 = 'Name ' / label for field 1 TBCOL1 = 1 / beginning column of field 1 TFORM1 = 'A15 ' / Fortran-77 format of field TTYPE2 = 'Ivalue ' / label for field 2 TBCOL2 = 17 / beginning column of field 2 TFORM2 = 'I11 ' / Fortran-77 format of field TUNIT2 = 'm**2 ' / physical unit of field TTYPE3 = 'Fvalue ' / label for field 3 TBCOL3 = 29 / beginning column of field 3 TFORM3 = 'F15.6 ' / Fortran-77 format of field TUNIT3 = 'cm ' / physical unit of field TTYPE4 = 'Evalue ' / label for field 4 TBCOL4 = 45 / beginning column of field 4 TFORM4 = 'E13.5 ' / Fortran-77 format of field TUNIT4 = 'erg/s ' / physical unit of field TTYPE5 = 'Dvalue ' / label for field 5 TBCOL5 = 59 / beginning column of field 5 TFORM5 = 'D22.14 ' / Fortran-77 format of field TUNIT5 = 'km/s ' / physical unit of field EXTNAME = 'new_table' / name of this ASCII table extension EXTVER = 5 / extension version number END first string 0 0.000000 0.00000E+00 0.00000000000000E+00second string 3 3.000000 3.00000E+00 3.00000000000000E+00 6 6.000000 6.00000E+00 6.00000000000000E+00 9 9.000000 9.00000E+00 9.00000000000000E+00 12 12.000000 1.20000E+01 1.20000000000000E+01 15 15.000000 1.50000E+01 1.50000000000000E+01 18 18.000000 1.80000E+01 1.80000000000000E+01 21 21.000000 2.10000E+01 2.10000000000000E+01 24 24.000000 2.40000E+01 2.40000000000000E+01 27 27.000000 2.70000E+01 2.70000000000000E+01 \ No newline at end of file diff --git a/pkg/tbtables/cfitsio/testprog.tpt b/pkg/tbtables/cfitsio/testprog.tpt new file mode 100644 index 00000000..def9dcb2 --- /dev/null +++ b/pkg/tbtables/cfitsio/testprog.tpt @@ -0,0 +1,12 @@ +tmpcard1 1001 this is the 1st template card +tmpcard2 ABCD this is the 2nd template card +tmpcard3 1001.23 this is the 3rd template card +tmpcard4 1001.45 this is the 4rd template card +comment this is the 5th template card +history this is the 6th template card +tmpcard7 = / comment for null keyword +-tmpcard1 tmpcarda change the name of tmpcard1 +-tmpcard4 +end + +junk will be ignored diff --git a/pkg/tbtables/cfitsio/vmsieee.c b/pkg/tbtables/cfitsio/vmsieee.c new file mode 100644 index 00000000..5ddc7486 --- /dev/null +++ b/pkg/tbtables/cfitsio/vmsieee.c @@ -0,0 +1,130 @@ +#include +#include + +unsigned long CVT$CONVERT_FLOAT(); + +/* IEEVPAKR -- Pack a native floating point vector into an IEEE one. +*/ +void ieevpr (unsigned int *native, unsigned int *ieee, int *nelem) +{ + unsigned long status; + unsigned long options; + unsigned int *unanval; + int nanval = -1; + int i,n; + + unanval = (unsigned int *) &nanval; + options = CVT$M_BIG_ENDIAN; + + n = *nelem; + status = CVT$_NORMAL; + + for (i = 0; i < n ; i++) { + + status = CVT$CONVERT_FLOAT (&native[i], CVT$K_VAX_F, + &ieee[i], CVT$K_IEEE_S, + options); + if (status != CVT$_NORMAL) { + ieee[i] = *unanval; + } + } + +} +/* IEEVPAKD -- Pack a native double floating point vector into an IEEE one. +*/ +void ieevpd (unsigned long *native, unsigned long *ieee, int *nelem) +{ + unsigned long status; + unsigned long options; + unsigned long *unanval; + long nanval = -1; + int i,n; + + unanval = (unsigned long *) &nanval; + options = CVT$M_BIG_ENDIAN; + + n = *nelem * 2; + status = CVT$_NORMAL; + + for (i = 0; i < n ; i=i+2) { + + status = CVT$CONVERT_FLOAT (&native[i], CVT$K_VAX_D, + &ieee[i], CVT$K_IEEE_T, + options); + if (status != CVT$_NORMAL) { + ieee[i] = *unanval; + ieee[i+1] = *unanval; + } + } + +} +/* IEEVUPKR -- Unpack an ieee vector into native single floating point vector. +*/ +void ieevur (unsigned int *ieee, unsigned int *native, int *nelem) +{ + unsigned long status; + unsigned long options; + unsigned int *unanval; + int nanval = -1; + int j,n; + + unanval = (unsigned int *) &nanval; + options = CVT$M_ERR_UNDERFLOW+CVT$M_BIG_ENDIAN; + + n = *nelem; + + status = CVT$_NORMAL; + + for (j = 0; j < n ; j++) { + status = CVT$CONVERT_FLOAT (&ieee[j], CVT$K_IEEE_S, + &native[j], CVT$K_VAX_F, + options); + if (status != CVT$_NORMAL) + switch(status) { + case CVT$_INVVAL: + case CVT$_NEGINF: + case CVT$_OVERFLOW: + case CVT$_POSINF: + native[j] = *unanval; + break; + default: + native[j] = 0; + } + } +} +/* IEEVUPKD -- Unpack an ieee vector into native double floating point vector. +*/ +void ieevud (unsigned long *ieee, unsigned long *native, int *nelem) +{ + unsigned long status; + unsigned long options; + unsigned long *unanval; + long nanval = -1; + int j,n; + + unanval = (unsigned long *) &nanval; + options = CVT$M_BIG_ENDIAN + CVT$M_ERR_UNDERFLOW; + + n = *nelem * 2; + + status = CVT$_NORMAL; + + for (j = 0; j < n ; j=j+2) { + status = CVT$CONVERT_FLOAT (&ieee[j], CVT$K_IEEE_T, + &native[j], CVT$K_VAX_D, + options); + if (status != CVT$_NORMAL) + switch(status) { + case CVT$_INVVAL: + case CVT$_NEGINF: + case CVT$_OVERFLOW: + case CVT$_POSINF: + native[j] = *unanval; + native[j+1] = *unanval; + break; + default: + native[j] = 0; + native[j+1] = 0; + } + } +} diff --git a/pkg/tbtables/cfitsio/vmsieeed.mar b/pkg/tbtables/cfitsio/vmsieeed.mar new file mode 100644 index 00000000..f9928dda --- /dev/null +++ b/pkg/tbtables/cfitsio/vmsieeed.mar @@ -0,0 +1,137 @@ + .TITLE ieeed - ieee double to vax floating conversions + .ident /v1.0/ + +;# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. +;# +;# IEEED.S -- IEEE double to VAX double floating conversions. +;# +;# ieepakd (x) # scalar, vax->ieee +;# ieeupkd (x) # scalar, ieee->vax +;# ieevpakd (native, ieee, nelem) # vector, vax->ieee +;# ieevupkd (ieee, native, nelem) # vector, ieee->vax +;# ieesnand (NaN) # set VAX NaN value +;# ieegnand (NaN) # get VAX NaN value +;# +;# These routines convert between the VAX and IEEE double floating formats, +;# operating upon a single value or an array of values. +/- zero is converted +;# to zero. When converting IEEE to VAX, underflow maps to zero, and exponent +;# overflow and NaN input values map to the value set by IEESNAND (default 0). +;# These routines are functionally equivalent to the semi-portable versions of +;# the IRAF ieee/native floating conversion routines in osb$ieeed.x. +;# TODO - Add a function callback option for processing NaN values. + +; Vax NaN *MUST* be 11111... or the fitsio code will break horribly. +; It is explicitly tested for in a couple of places, so be warned. + + .PSECT IEEED$CODE, PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC + + .ENTRY IEEPAD ^M +;_ieepad_: ;# IEEPAKD (X) + movl 4(ap), r4 ;# data addr -> r4 + movl r4, r5 ;# output clobbers input + jsb cvt_vax_ieee ;# convert value + ret + .ENTRY IEEVPD ^M +;_ieevpd_: ;# IEEVPAKD (VAX, IEEE, NELEM) + movl 4(ap), r4 ;# input vector -> r4 + movl 8(ap), r5 ;# output vector -> r5 + movl @12(ap), r6 ;# loop counter +L1: jsb cvt_vax_ieee ;# convert one value + sobgtr r6, L1 ;# loop + ret + .ENTRY IEEUPD ^M +;_ieeupd_: ;# IEEUPKD (X) + movl 4(ap), r4 ;# data addr -> r4 + movl r4, r5 ;# output clobbers input + jsb cvt_ieee_vax ;# convert value + ret + .ENTRY IEEVUD ^M +;_ieevud_: ;# IEEVUPKD (IEEE, VAX, NELEM) + movl 4(ap), r4 ;# input vector -> r4 + movl 8(ap), r5 ;# output vector -> r5 + movl @12(ap), r6 ;# loop counter +L2: jsb cvt_ieee_vax ;# convert one value + sobgtr r6, L2 ;# loop + ret + .ENTRY IEESND ^M<> +;_ieesnd_: ;# IEESNAND (VAXNAN) +bugger::nop ; real no-op added to enable + ; enbuging. +; movq @4(ap), vaxnan ; no-oped. See above. + ret ; This could be no-oped in + ; the vector, but isn't. + .ENTRY IEEGND ^M<> +;_ieegnd_: ;# IEEGNAND (VAXNAN) + movq #-1, @4(ap) ; See above + ret + +cvt_vax_ieee: ;# R4=in, R5=out + rotl #16, (r4)+, r1 ;# swap words -> r1 + rotl #16, (r4)+, r0 ;# swap words -> r0 + + extzv #23, #8, r1, r2 ;# 8 bit exponent -> r2 + beql L6 ;# branch if zero exponent + extzv #2, #1, r0, r3 ;# get round bit -> r3 + ashq #-3, r0, r0 ;# shift 64 data bits by 3 + addw2 #<1024-130>, r2 ;# adjust exponent bias + insv r2, #20, #11, r1 ;# insert new exponent + blbc r3, L5 ;# branch if round bit clear + incl r0 ;# round low longword + adwc #0, r1 ;# carry to high longword +L5: + movl sp, r3 ;# r3 points to input byte + pushl r1 ;# push r1 on stack + pushl r0 ;# push r0 on stack + movb -(r3), (r5)+ ;# output quadword, swapped + movb -(r3), (r5)+ + movb -(r3), (r5)+ + movb -(r3), (r5)+ + movb -(r3), (r5)+ + movb -(r3), (r5)+ + movb -(r3), (r5)+ + movb -(r3), (r5)+ + addl2 #8, sp ;# pop stack + rsb ;# all done +L6: + clrl r0 ;# return all 64 bits zero + clrl r1 + brb L5 + +cvt_ieee_vax: ;# R4=in, R5=out + movb (r4)+, -(sp) ;# byte swap quadword onto stack + movb (r4)+, -(sp) + movb (r4)+, -(sp) + movb (r4)+, -(sp) + movb (r4)+, -(sp) + movb (r4)+, -(sp) + movb (r4)+, -(sp) + movb (r4)+, -(sp) + + movl (sp)+, r0 ;# pop low bits + movl (sp)+, r1 ;# pop high bits + extzv #20, #11, r1, r2 ;# exponent -> r2 + beql L10 ;# zero exponent + extzv #31, #1, r1, r3 ;# save sign bit + ashq #3, r0, r0 ;# shift 64 bits left 3 bits + subw2 #<1024-130>, r2 ;# adjust exponent bias + bleq L10 ;# return zero if underflow + cmpw r2, #256 ;# compare with max VAX exponent + bgeq L11 ;# return VAX-NaN if overflow + insv r2, #23, #8, r1 ;# insert VAX-D exponent + insv r3, #31, #1, r1 ;# restore sign bit + + rotl #16, r1, (r5)+ ;# output VAX double + rotl #16, r0, (r5)+ ;# output VAX double + rsb +L10: + clrl (r5)+ ;# return all 64 bits zero + clrl (r5)+ + rsb +L11: + movl #-1, r3 ;# return VAX equiv. of NaN + movl r3, (r5)+ + movl r3, (r5)+ ; changed to only return -1 + rsb + + .END + diff --git a/pkg/tbtables/cfitsio/vmsieeer.mar b/pkg/tbtables/cfitsio/vmsieeer.mar new file mode 100644 index 00000000..f3105880 --- /dev/null +++ b/pkg/tbtables/cfitsio/vmsieeer.mar @@ -0,0 +1,106 @@ + .TITLE ieeer - ieee real to vax floating conversions + .ident /v1.0/ + +;# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. +;# +;# IEEER.S -- IEEE real to VAX single precision floating conversions. +;# +;# ieepakr (x) # scalar, vax->ieee +;# ieeupkr (x) # scalar, ieee->vax +;# ieevpakr (native, ieee, nelem) # vector, vax->ieee +;# ieevupkr (ieee, native, nelem) # vector, ieee->vax +;# ieesnanr (NaN) # set VAX NaN value +;# ieegnanr (NaN) # get VAX NaN value +;# +;# These routines convert between the VAX and IEEE real floating formats, +;# operating upon a single value or an array of values. +/- zero is converted +;# to zero. When converting IEEE to VAX, underflow maps to zero, and exponent +;# overflow and NaN input values map to the value set by IEESNANR (default 0). +;# These routines are functionally equivalent to the semi-portable versions of +;# the IRAF ieee/native floating conversion routines in osb$ieeer.x. +;# TODO - Add a function callback option for processing NaN values. + +; See IEEED for details about NaNs. + + .PSECT IEEER$CODE, PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC + + .ENTRY IEEPAR ^M +;_ieepar_: ;# IEEPAKR (X) + movl 4(ap), r2 ;# data addr -> r2 + movl r2, r3 ;# output clobbers input + jsb cvt_vax_ieee ;# convert value + ret + .ENTRY IEEVPR ^M +;_ieevpr_: ;# IEEVPAKR (VAX, IEEE, NELEM) + movl 4(ap), r2 ;# input vector -> r2 + movl 8(ap), r3 ;# output vector -> r3 + movl @12(ap), r4 ;# loop counter +L1: jsb cvt_vax_ieee ;# convert one value + sobgtr r4, L1 ;# loop + ret + .ENTRY IEEUPR ^M +;_ieeupr_: ;# IEEUPKR (X) + movl 4(ap), r2 ;# data addr -> r2 + movl r2, r3 ;# output clobbers input + jsb cvt_ieee_vax ;# convert value + ret + .ENTRY IEEVUR ^M +;_ieevur_: ;# IEEVUPKR (IEEE, VAX, NELEM) + movl 4(ap), r2 ;# input vector -> r2 + movl 8(ap), r3 ;# output vector -> r3 + movl @12(ap), r4 ;# loop counter +L2: jsb cvt_ieee_vax ;# convert one value + sobgtr r4, L2 ;# loop + ret + .ENTRY IEESNR ^M<> +;_ieesnr_: ;# IEESNANR (VAXNAN) +buger:: nop ; plug bpt here for crap catching. +; movl @4(ap), vaxnan + ret + .ENTRY IEEGNR ^M<> +;_ieegnr_: ;# IEEGNANR (VAXNAN) + movl #-1, @4(ap) + ret + +cvt_vax_ieee: ;# R2=in, R3=out + rotl #16, (r2)+, r0 ;# swap words -> r0 + extzv #23, #8, r0, r1 ;# 8 bit exponent -> r1 + beql L6 ;# branch if zero exponent + subw2 #2, r1 ;# adjust exponent bias + bleq L6 ;# return zero if underflow + insv r1, #23, #8, r0 ;# insert new exponent +L5: + movl sp, r1 ;# r3 points to input byte + pushl r0 ;# push r0 on stack + movb -(r1), (r3)+ ;# output longword, swapped + movb -(r1), (r3)+ + movb -(r1), (r3)+ + movb -(r1), (r3)+ + tstl (sp)+ ;# pop stack + rsb ;# all done +L6: + clrl r0 ;# return all 32 bits zero + brb L5 + +cvt_ieee_vax: ;# R2=in, R3=out + movb (r2)+, -(sp) ;# byte swap longword onto stack + movb (r2)+, -(sp) + movb (r2)+, -(sp) + movb (r2)+, -(sp) + movl (sp)+, r0 ;# pop swapped value -> r0 + extzv #23, #8, r0, r1 ;# exponent -> r1 + beql L10 ;# zero exponent + addw2 #2, r1 ;# adjust exponent bias + cmpw r1, #256 ;# compare with max VAX exponent + bgeq L11 ;# return VAX-NaN if overflow + insv r1, #23, #8, r0 ;# insert VAX-D exponent + rotl #16, r0, (r3)+ ;# output VAX value + rsb +L10: + clrl (r3)+ ;# return all 32 bits zero + rsb +L11: + movl #-1, (r3)+ ; return fixed NaN value... + rsb + + .END diff --git a/pkg/tbtables/cfitsio/wcssub.c b/pkg/tbtables/cfitsio/wcssub.c new file mode 100644 index 00000000..c523f357 --- /dev/null +++ b/pkg/tbtables/cfitsio/wcssub.c @@ -0,0 +1,327 @@ +#include +#include +#include "fitsio2.h" + +/*--------------------------------------------------------------------------*/ +int ffgiwcs(fitsfile *fptr, /* I - FITS file pointer */ + char **header, /* O - pointer to the WCS related keywords */ + int *status) /* IO - error status */ +/* + int fits_get_image_wcs_keys + return a string containing all the image WCS header keywords. + This string is then used as input to the wcsinit WCSlib routine. +*/ +{ + int hdutype; + + if (*status > 0) + return(*status); + + fits_get_hdu_type(fptr, &hdutype, status); + if (hdutype != IMAGE_HDU) + { + ffpmsg( + "Error in ffgiwcs. This HDU is not an image. Can't read WCS keywords"); + return(*status = NOT_IMAGE); + } + + /* read header keywords into a long string of chars */ + if (ffh2st(fptr, header, status) > 0) + { + ffpmsg("error creating string of image WCS keywords (ffgiwcs)"); + return(*status); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtwcs(fitsfile *fptr, /* I - FITS file pointer */ + int xcol, /* I - column number for the X column */ + int ycol, /* I - column number for the Y column */ + char **header, /* O - string of all the WCS keywords */ + int *status) /* IO - error status */ +/* + int fits_get_table_wcs_keys + Return string containing all the WCS keywords appropriate for the + pair of X and Y columns containing the coordinate + of each event in an event list table. This string may then be passed + to Doug Mink's WCS library wcsinit routine, to create and initialize the + WCS structure. The calling routine must free the header character string + when it is no longer needed. +*/ +{ + int hdutype, ncols, tstatus, length; + int naxis1 = 1, naxis2 = 1; + long tlmin, tlmax; + char keyname[FLEN_KEYWORD]; + char valstring[FLEN_VALUE]; + char comm[2]; + char *cptr; + /* construct a string of 80 blanks, for adding fill to the keywords */ + /* 12345678901234567890123456789012345678901234567890123456789012345678901234567890 */ + char blanks[] = " "; + + if (*status > 0) + return(*status); + + fits_get_hdu_type(fptr, &hdutype, status); + if (hdutype == IMAGE_HDU) + { + ffpmsg("Can't read table WSC keywords. This HDU is not a table"); + return(*status = NOT_TABLE); + } + + fits_get_num_cols(fptr, &ncols, status); + + if (xcol < 1 || xcol > ncols) + { + ffpmsg("illegal X axis column number in fftwcs"); + return(*status = BAD_COL_NUM); + } + + if (ycol < 1 || ycol > ncols) + { + ffpmsg("illegal Y axis column number in fftwcs"); + return(*status = BAD_COL_NUM); + } + + /* allocate character string for all the WCS keywords */ + *header = calloc(1, 2401); /* room for up to 30 keywords */ + if (*header == 0) + { + ffpmsg("error allocating memory for WCS header keywords (fftwcs)"); + return(*status = MEMORY_ALLOCATION); + } + + cptr = *header; + comm[0] = '\0'; + + tstatus = 0; + ffkeyn("TLMIN",xcol,keyname,status); + ffgkyj(fptr,keyname, &tlmin,NULL,&tstatus); + + if (!tstatus) + { + ffkeyn("TLMAX",xcol,keyname,status); + ffgkyj(fptr,keyname, &tlmax,NULL,&tstatus); + } + + if (!tstatus) + { + naxis1 = tlmax - tlmin + 1; + } + + tstatus = 0; + ffkeyn("TLMIN",ycol,keyname,status); + ffgkyj(fptr,keyname, &tlmin,NULL,&tstatus); + + if (!tstatus) + { + ffkeyn("TLMAX",ycol,keyname,status); + ffgkyj(fptr,keyname, &tlmax,NULL,&tstatus); + } + + if (!tstatus) + { + naxis2 = tlmax - tlmin + 1; + } + + /* 123456789012345678901234567890 */ + strcat(cptr, "NAXIS = 2"); + strncat(cptr, blanks, 50); + cptr += 80; + + ffi2c(naxis1, valstring, status); /* convert to formatted string */ + ffmkky("NAXIS1", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + strcpy(keyname, "NAXIS2"); + ffi2c(naxis2, valstring, status); /* convert to formatted string */ + ffmkky(keyname, valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* read the required header keywords (use defaults if not found) */ + + /* CTYPE1 keyword */ + tstatus = 0; + ffkeyn("TCTYP",xcol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + valstring[0] = '\0'; + ffmkky("CTYPE1", valstring, comm, cptr, status); /* construct the keyword*/ + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + + /* CTYPE2 keyword */ + tstatus = 0; + ffkeyn("TCTYP",ycol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + valstring[0] = '\0'; + ffmkky("CTYPE2", valstring, comm, cptr, status); /* construct the keyword*/ + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + + /* CRPIX1 keyword */ + tstatus = 0; + ffkeyn("TCRPX",xcol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + strcpy(valstring, "1"); + ffmkky("CRPIX1", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* CRPIX2 keyword */ + tstatus = 0; + ffkeyn("TCRPX",ycol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + strcpy(valstring, "1"); + ffmkky("CRPIX2", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* CRVAL1 keyword */ + tstatus = 0; + ffkeyn("TCRVL",xcol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + strcpy(valstring, "1"); + ffmkky("CRVAL1", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* CRVAL2 keyword */ + tstatus = 0; + ffkeyn("TCRVL",ycol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + strcpy(valstring, "1"); + ffmkky("CRVAL2", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* CDELT1 keyword */ + tstatus = 0; + ffkeyn("TCDLT",xcol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + strcpy(valstring, "1"); + ffmkky("CDELT1", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* CDELT2 keyword */ + tstatus = 0; + ffkeyn("TCDLT",ycol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) ) + strcpy(valstring, "1"); + ffmkky("CDELT2", valstring, comm, cptr, status); /* construct the keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + + /* the following keywords may not exist */ + + /* CROTA2 keyword */ + tstatus = 0; + ffkeyn("TCROT",ycol,keyname,status); + if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) == 0 ) + { + ffmkky("CROTA2", valstring, comm, cptr, status); /* construct keyword*/ + strncat(cptr, blanks, 50); /* pad with blanks */ + cptr += 80; + } + + /* EPOCH keyword */ + tstatus = 0; + if (ffgkey(fptr, "EPOCH", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("EPOCH", valstring, comm, cptr, status); /* construct keyword*/ + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* EQUINOX keyword */ + tstatus = 0; + if (ffgkey(fptr, "EQUINOX", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("EQUINOX", valstring, comm, cptr, status); /* construct keyword*/ + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* RADECSYS keyword */ + tstatus = 0; + if (ffgkey(fptr, "RADECSYS", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("RADECSYS", valstring, comm, cptr, status); /*construct keyword*/ + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* TELESCOPE keyword */ + tstatus = 0; + if (ffgkey(fptr, "TELESCOP", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("TELESCOP", valstring, comm, cptr, status); + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* INSTRUME keyword */ + tstatus = 0; + if (ffgkey(fptr, "INSTRUME", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("INSTRUME", valstring, comm, cptr, status); + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* DETECTOR keyword */ + tstatus = 0; + if (ffgkey(fptr, "DETECTOR", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("DETECTOR", valstring, comm, cptr, status); + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* MJD-OBS keyword */ + tstatus = 0; + if (ffgkey(fptr, "MJD-OBS", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("MJD-OBS", valstring, comm, cptr, status); + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* DATE-OBS keyword */ + tstatus = 0; + if (ffgkey(fptr, "DATE-OBS", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("DATE-OBS", valstring, comm, cptr, status); + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + /* DATE keyword */ + tstatus = 0; + if (ffgkey(fptr, "DATE", valstring, NULL, &tstatus) == 0 ) + { + ffmkky("DATE", valstring, comm, cptr, status); + length = strlen(cptr); + strncat(cptr, blanks, 80 - length); /* pad with blanks */ + cptr += 80; + } + + strcat(cptr, "END"); + strncat(cptr, blanks, 77); + + return(*status); +} diff --git a/pkg/tbtables/cfitsio/wcsutil.c b/pkg/tbtables/cfitsio/wcsutil.c new file mode 100644 index 00000000..95d93c3c --- /dev/null +++ b/pkg/tbtables/cfitsio/wcsutil.c @@ -0,0 +1,72 @@ +#include +#include +#include +#include "fitsio2.h" + +/* ====================================================================== +This file contains stubs for the AIPS WCS routines that are +contained in the source file wcsutil.c. The routines in wcsutil.c +should only be used by software that adheres to the terms of +the GNU General Public License. Users who want to use CFITSIO but are +unwilling to release their code under the terms of the GNU General +Public License should replace the wcsutil.c file with this current +file before building the CFITSIO library. This alternate version of +CFITSIO will behave the same as the standard version, except that it +will not support the ffwldp and ffxypx routines that calculate +image coordinate transformation from pixel coordinates to world +coordinates (e.g. Right Ascension and Declination) and vise versa. +======================================================================== */ + +int ffgics(fitsfile *fptr, + double *xrval, + double *yrval, + double *xrpix, + double *yrpix, + double *xinc, + double *yinc, + double *rot, + char *type, + int *status) { + return(*status = NO_WCS_KEY); +} + +int ffgtcs(fitsfile *fptr, + int xcol, + int ycol, + double *xrval, + double *yrval, + double *xrpix, + double *yrpix, + double *xinc, + double *yinc, + double *rot, + char *type, + int *status) { + return(*status = NO_WCS_KEY); +} + + +/*--------------------------------------------------------------------------*/ +int ffwldp(double xpix, double ypix, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, double rot, + char *type, double *xpos, double *ypos, int *status) +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support"); + ffpmsg(" celestial coordinate transformations."); + return(*status = 503); +} +/*--------------------------------------------------------------------------*/ +int ffxypx(double xpos, double ypos, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, double rot, + char *type, double *xpix, double *ypix, int *status) +{ + if (*status > 0) + return(*status); + + ffpmsg("This non-GNU version of CFITSIO does not support"); + ffpmsg(" celestial coordinate transformations."); + return(*status = 503); +} diff --git a/pkg/tbtables/cfitsio/wcsutil.c.OLD b/pkg/tbtables/cfitsio/wcsutil.c.OLD new file mode 100644 index 00000000..c5b87fa8 --- /dev/null +++ b/pkg/tbtables/cfitsio/wcsutil.c.OLD @@ -0,0 +1,786 @@ +#include +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffgics(fitsfile *fptr, /* I - FITS file pointer */ + double *xrval, /* O - X reference value */ + double *yrval, /* O - Y reference value */ + double *xrpix, /* O - X reference pixel */ + double *yrpix, /* O - Y reference pixel */ + double *xinc, /* O - X increment per pixel */ + double *yinc, /* O - Y increment per pixel */ + double *rot, /* O - rotation angle (degrees) */ + char *type, /* O - type of projection ('-tan') */ + int *status) /* IO - error status */ +/* + read the values of the celestial coordinate system keywords. + These values may be used as input to the subroutines that + calculate celestial coordinates. (ffxypx, ffwldp) + + Modified in Nov 1999 to convert the CD matrix keywords back + to the old CDELTn form, and to swap the axes if the dec-like + axis is given first, and to assume default values if any of the + keywords are not present. +*/ +{ + int tstat = 0, cd_exists = 0, pc_exists = 0; + char ctype[FLEN_VALUE]; + double cd11 = 0.0, cd21 = 0.0, cd22 = 0.0, cd12 = 0.0; + double pc11 = 1.0, pc21 = 0.0, pc22 = 1.0, pc12 = 0.0; + double pi = 3.1415926535897932; + double phia, phib, temp; + double toler = .0002; /* tolerance for angles to agree (radians) */ + /* (= approximately 0.01 degrees) */ + + if (*status > 0) + return(*status); + + tstat = 0; + if (ffgkyd(fptr, "CRVAL1", xrval, NULL, &tstat)) + *xrval = 0.; + + tstat = 0; + if (ffgkyd(fptr, "CRVAL2", yrval, NULL, &tstat)) + *yrval = 0.; + + tstat = 0; + if (ffgkyd(fptr, "CRPIX1", xrpix, NULL, &tstat)) + *xrpix = 0.; + + tstat = 0; + if (ffgkyd(fptr, "CRPIX2", yrpix, NULL, &tstat)) + *yrpix = 0.; + + /* look for CDELTn first, then CDi_j keywords */ + tstat = 0; + if (ffgkyd(fptr, "CDELT1", xinc, NULL, &tstat)) + { + /* CASE 1: no CDELTn keyword, so look for the CD matrix */ + tstat = 0; + if (ffgkyd(fptr, "CD1_1", &cd11, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + cd_exists = 1; /* found at least 1 CD_ keyword */ + + if (ffgkyd(fptr, "CD2_1", &cd21, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + cd_exists = 1; /* found at least 1 CD_ keyword */ + + if (ffgkyd(fptr, "CD1_2", &cd12, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + cd_exists = 1; /* found at least 1 CD_ keyword */ + + if (ffgkyd(fptr, "CD2_2", &cd22, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + cd_exists = 1; /* found at least 1 CD_ keyword */ + + if (cd_exists) /* convert CDi_j back to CDELTn */ + { + /* there are 2 ways to compute the angle: */ + phia = atan2( cd21, cd11); + phib = atan2(-cd12, cd22); + + /* ensure that phia <= phib */ + temp = minvalue(phia, phib); + phib = maxvalue(phia, phib); + phia = temp; + + /* there is a possible 180 degree ambiguity in the angles */ + /* so add 180 degress to the smaller value if the values */ + /* differ by more than 90 degrees = pi/2 radians. */ + /* (Later, we may decide to take the other solution by */ + /* subtracting 180 degrees from the larger value). */ + + if ((phib - phia) > (pi / 2.)) + phia += pi; + + if (fabs(phia - phib) > toler) + { + /* angles don't agree, so looks like there is some skewness */ + /* between the axes. Return with an error to be safe. */ + *status = APPROX_WCS_KEY; + } + + phia = (phia + phib) /2.; /* use the average of the 2 values */ + *xinc = cd11 / cos(phia); + *yinc = cd22 / cos(phia); + *rot = phia * 180. / pi; + + /* common usage is to have a positive yinc value. If it is */ + /* negative, then subtract 180 degrees from rot and negate */ + /* both xinc and yinc. */ + + if (*yinc < 0) + { + *xinc = -(*xinc); + *yinc = -(*yinc); + *rot = *rot - 180.; + } + } + else /* no CD matrix keywords either */ + { + *xinc = 1.; + + /* there was no CDELT1 keyword, but check for CDELT2 just in case */ + tstat = 0; + if (ffgkyd(fptr, "CDELT2", yinc, NULL, &tstat)) + *yinc = 1.; + + tstat = 0; + if (ffgkyd(fptr, "CROTA2", rot, NULL, &tstat)) + *rot=0.; + } + } + else /* Case 2: CDELTn + optional PC matrix */ + { + if (ffgkyd(fptr, "CDELT2", yinc, NULL, &tstat)) + *yinc = 1.; + + tstat = 0; + if (ffgkyd(fptr, "CROTA2", rot, NULL, &tstat)) + { + *rot=0.; + + /* no CROTA2 keyword, so look for the PC matrix */ + tstat = 0; + if (ffgkyd(fptr, "PC1_1", &pc11, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + pc_exists = 1; /* found at least 1 PC_ keyword */ + + if (ffgkyd(fptr, "PC2_1", &pc21, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + pc_exists = 1; /* found at least 1 PC_ keyword */ + + if (ffgkyd(fptr, "PC1_2", &pc12, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + pc_exists = 1; /* found at least 1 PC_ keyword */ + + if (ffgkyd(fptr, "PC2_2", &pc22, NULL, &tstat)) + tstat = 0; /* reset keyword not found error */ + else + pc_exists = 1; /* found at least 1 PC_ keyword */ + + if (pc_exists) /* convert PCi_j back to CDELTn */ + { + /* there are 2 ways to compute the angle: */ + phia = atan2( pc21, pc11); + phib = atan2(-pc12, pc22); + + /* ensure that phia <= phib */ + temp = minvalue(phia, phib); + phib = maxvalue(phia, phib); + phia = temp; + + /* there is a possible 180 degree ambiguity in the angles */ + /* so add 180 degress to the smaller value if the values */ + /* differ by more than 90 degrees = pi/2 radians. */ + /* (Later, we may decide to take the other solution by */ + /* subtracting 180 degrees from the larger value). */ + + if ((phib - phia) > (pi / 2.)) + phia += pi; + + if (fabs(phia - phib) > toler) + { + /* angles don't agree, so looks like there is some skewness */ + /* between the axes. Return with an error to be safe. */ + *status = APPROX_WCS_KEY; + } + + phia = (phia + phib) /2.; /* use the average of the 2 values */ + *rot = phia * 180. / pi; + } + } + } + + /* get the type of projection, if any */ + tstat = 0; + if (ffgkys(fptr, "CTYPE1", ctype, NULL, &tstat)) + type[0] = '\0'; + else + { + /* copy the projection type string */ + strncpy(type, &ctype[4], 4); + type[4] = '\0'; + + /* check if RA and DEC are inverted */ + if (!strncmp(ctype, "DEC-", 4) || !strncmp(ctype+1, "LAT", 3)) + { + /* the latitudinal axis is given first, so swap them */ + +/* + this case was removed on 12/9. Apparently not correct. + + if ((*xinc / *yinc) < 0. ) + *rot = -90. - (*rot); + else +*/ + *rot = 90. - (*rot); + + /* Empirical tests with ds9 show the y-axis sign must be negated */ + /* and the xinc and yinc values must NOT be swapped. */ + *yinc = -(*yinc); + + temp = *xrval; + *xrval = *yrval; + *yrval = temp; + } + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgtcs(fitsfile *fptr, /* I - FITS file pointer */ + int xcol, /* I - column containing the RA coordinate */ + int ycol, /* I - column containing the DEC coordinate */ + double *xrval, /* O - X reference value */ + double *yrval, /* O - Y reference value */ + double *xrpix, /* O - X reference pixel */ + double *yrpix, /* O - Y reference pixel */ + double *xinc, /* O - X increment per pixel */ + double *yinc, /* O - Y increment per pixel */ + double *rot, /* O - rotation angle (degrees) */ + char *type, /* O - type of projection ('-sin') */ + int *status) /* IO - error status */ +/* + read the values of the celestial coordinate system keywords + from a FITS table where the X and Y or RA and DEC coordinates + are stored in separate column. + These values may be used as input to the subroutines that + calculate celestial coordinates. (ffxypx, ffwldp) +*/ +{ + char comm[FLEN_COMMENT],ctype[FLEN_VALUE],keynam[FLEN_KEYWORD]; + int tstatus = 0; + + if (*status > 0) + return(*status); + + ffkeyn("TCRVL",xcol,keynam,status); + ffgkyd(fptr,keynam,xrval,comm,status); + + ffkeyn("TCRVL",ycol,keynam,status); + ffgkyd(fptr,keynam,yrval,comm,status); + + ffkeyn("TCRPX",xcol,keynam,status); + ffgkyd(fptr,keynam,xrpix,comm,status); + + ffkeyn("TCRPX",ycol,keynam,status); + ffgkyd(fptr,keynam,yrpix,comm,status); + + ffkeyn("TCDLT",xcol,keynam,status); + ffgkyd(fptr,keynam,xinc,comm,status); + + ffkeyn("TCDLT",ycol,keynam,status); + ffgkyd(fptr,keynam,yinc,comm,status); + + ffkeyn("TCTYP",xcol,keynam,status); + ffgkys(fptr,keynam,ctype,comm,status); + + if (*status > 0) + { + ffpmsg + ("ffgtcs could not find all the celestial coordinate keywords"); + return(*status = NO_WCS_KEY); + } + + /* copy the projection type string */ + strncpy(type, &ctype[4], 4); + type[4] = '\0'; + + *rot=0.; /* default rotation is 0 */ + ffkeyn("TCROT",ycol,keynam,status); + ffgkyd(fptr,keynam,rot,comm,&tstatus); /* keyword may not exist */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffwldp(double xpix, double ypix, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, double rot, + char *type, double *xpos, double *ypos, int *status) + +/* WDP 1/97: change the name of the routine from 'worldpos' to 'ffwldp' */ + +/* worldpos.c -- WCS Algorithms from Classic AIPS. + Copyright (C) 1994 + Associated Universities, Inc. Washington DC, USA. + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public + License for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. + + Correspondence concerning AIPS should be addressed as follows: + Internet email: aipsmail@nrao.edu + Postal address: AIPS Group + National Radio Astronomy Observatory + 520 Edgemont Road + Charlottesville, VA 22903-2475 USA + + -=-=-=-=-=-=- + + These two ANSI C functions, worldpos() and xypix(), perform + forward and reverse WCS computations for 8 types of projective + geometries ("-SIN", "-TAN", "-ARC", "-NCP", "-GLS", "-MER", "-AIT" + and "-STG"): + + worldpos() converts from pixel location to RA,Dec + xypix() converts from RA,Dec to pixel location + + where "(RA,Dec)" are more generically (long,lat). These functions + are based on the WCS implementation of Classic AIPS, an + implementation which has been in production use for more than ten + years. See the two memos by Eric Greisen + + ftp://fits.cv.nrao.edu/fits/documents/wcs/aips27.ps.Z + ftp://fits.cv.nrao.edu/fits/documents/wcs/aips46.ps.Z + + for descriptions of the 8 projective geometries and the + algorithms. Footnotes in these two documents describe the + differences between these algorithms and the 1993-94 WCS draft + proposal (see URL below). In particular, these algorithms support + ordinary field rotation, but not skew geometries (CD or PC matrix + cases). Also, the MER and AIT algorithms work correctly only for + CRVALi=(0,0). Users should note that GLS projections with yref!=0 + will behave differently in this code than in the draft WCS + proposal. The NCP projection is now obsolete (it is a special + case of SIN). WCS syntax and semantics for various advanced + features is discussed in the draft WCS proposal by Greisen and + Calabretta at: + + ftp://fits.cv.nrao.edu/fits/documents/wcs/wcs.all.ps.Z + + -=-=-=- + + The original version of this code was Emailed to D.Wells on + Friday, 23 September by Bill Cotton , + who described it as a "..more or less.. exact translation from the + AIPSish..". Changes were made by Don Wells + during the period October 11-13, 1994: + 1) added GNU license and header comments + 2) added testpos.c program to perform extensive circularity tests + 3) changed float-->double to get more than 7 significant figures + 4) testpos.c circularity test failed on MER and AIT. B.Cotton + found that "..there were a couple of lines of code [in] the wrong + place as a result of merging several Fortran routines." + 5) testpos.c found 0h wraparound in xypix() and worldpos(). + 6) E.Greisen recommended removal of various redundant if-statements, + and addition of a 360d difference test to MER case of worldpos(). +*/ + +/*-----------------------------------------------------------------------*/ +/* routine to determine accurate position for pixel coordinates */ +/* returns 0 if successful otherwise: */ +/* 1 = angle too large for projection; */ +/* (WDP 1/97: changed the return value to 501 instead of 1) */ +/* does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections */ +/* anything else is linear (== -CAR) */ +/* Input: */ +/* f xpix x pixel number (RA or long without rotation) */ +/* f ypiy y pixel number (dec or lat without rotation) */ +/* d xref x reference coordinate value (deg) */ +/* d yref y reference coordinate value (deg) */ +/* f xrefpix x reference pixel */ +/* f yrefpix y reference pixel */ +/* f xinc x coordinate increment (deg) */ +/* f yinc y coordinate increment (deg) */ +/* f rot rotation (deg) (from N through E) */ +/* c *type projection type code e.g. "-SIN"; */ +/* Output: */ +/* d *xpos x (RA) coordinate (deg) */ +/* d *ypos y (dec) coordinate (deg) */ +/*-----------------------------------------------------------------------*/ + {double cosr, sinr, dx, dy, dz, temp, x, y, z; + double sins, coss, dect, rat, dt, l, m, mg, da, dd, cos0, sin0; + double dec0, ra0, decout, raout; + double geo1, geo2, geo3; + double cond2r=1.745329252e-2; + double twopi = 6.28318530717959, deps = 1.0e-5; + int i, itype; + char ctypes[9][5] ={"-CAR","-SIN","-TAN","-ARC","-NCP", "-GLS", "-MER", + "-AIT", "-STG"}; + + if (*status > 0) + return(*status); + +/* Offset from ref pixel */ + dx = (xpix-xrefpix) * xinc; + dy = (ypix-yrefpix) * yinc; +/* Take out rotation */ + cosr = cos(rot*cond2r); + sinr = sin(rot*cond2r); + if (rot!=0.0) + {temp = dx * cosr - dy * sinr; + dy = dy * cosr + dx * sinr; + dx = temp;} +/* find type */ +/* WDP 1/97: removed support for default type for better error checking */ +/* itype = 0; default type is linear */ + itype = -1; /* no default type */ + for (i=0;i<9;i++) if (!strncmp(type, ctypes[i], 4)) itype = i; +/* default, linear result for error return */ + *xpos = xref + dx; + *ypos = yref + dy; +/* convert to radians */ + ra0 = xref * cond2r; + dec0 = yref * cond2r; + l = dx * cond2r; + m = dy * cond2r; + sins = l*l + m*m; + cos0 = cos(dec0); + sin0 = sin(dec0); + +/* process by case */ + switch (itype) { + case 0: /* linear -CAR */ + rat = ra0 + l; + dect = dec0 + m; + break; + case 1: /* -SIN sin*/ + if (sins>1.0) return(*status = 501); + coss = sqrt (1.0 - sins); + dt = sin0 * coss + cos0 * m; + if ((dt>1.0) || (dt<-1.0)) return(*status = 501); + dect = asin (dt); + rat = cos0 * coss - sin0 * m; + if ((rat==0.0) && (l==0.0)) return(*status = 501); + rat = atan2 (l, rat) + ra0; + break; + case 2: /* -TAN tan */ + x = cos0*cos(ra0) - l*sin(ra0) - m*cos(ra0)*sin0; + y = cos0*sin(ra0) + l*cos(ra0) - m*sin(ra0)*sin0; + z = sin0 + m* cos0; + rat = atan2( y, x ); + dect = atan ( z / sqrt(x*x+y*y) ); + break; + case 3: /* -ARC Arc*/ + if (sins>=twopi*twopi/4.0) return(*status = 501); + sins = sqrt(sins); + coss = cos (sins); + if (sins!=0.0) sins = sin (sins) / sins; + else + sins = 1.0; + dt = m * cos0 * sins + sin0 * coss; + if ((dt>1.0) || (dt<-1.0)) return(*status = 501); + dect = asin (dt); + da = coss - dt * sin0; + dt = l * sins * cos0; + if ((da==0.0) && (dt==0.0)) return(*status = 501); + rat = ra0 + atan2 (dt, da); + break; + case 4: /* -NCP North celestial pole*/ + dect = cos0 - m * sin0; + if (dect==0.0) return(*status = 501); + rat = ra0 + atan2 (l, dect); + dt = cos (rat-ra0); + if (dt==0.0) return(*status = 501); + dect = dect / dt; + if ((dect>1.0) || (dect<-1.0)) return(*status = 501); + dect = acos (dect); + if (dec0<0.0) dect = -dect; + break; + case 5: /* -GLS global sinusoid */ + dect = dec0 + m; + if (fabs(dect)>twopi/4.0) return(*status = 501); + coss = cos (dect); + if (fabs(l)>twopi*coss/2.0) return(*status = 501); + rat = ra0; + if (coss>deps) rat = rat + l / coss; + break; + case 6: /* -MER mercator*/ + dt = yinc * cosr + xinc * sinr; + if (dt==0.0) dt = 1.0; + dy = (yref/2.0 + 45.0) * cond2r; + dx = dy + dt / 2.0 * cond2r; + dy = log (tan (dy)); + dx = log (tan (dx)); + geo2 = dt * cond2r / (dx - dy); + geo3 = geo2 * dy; + geo1 = cos (yref*cond2r); + if (geo1<=0.0) geo1 = 1.0; + rat = l / geo1 + ra0; + if (fabs(rat - ra0) > twopi) return(*status = 501); /* added 10/13/94 DCW/EWG */ + dt = 0.0; + if (geo2!=0.0) dt = (m + geo3) / geo2; + dt = exp (dt); + dect = 2.0 * atan (dt) - twopi / 4.0; + break; + case 7: /* -AIT Aitoff*/ + dt = yinc*cosr + xinc*sinr; + if (dt==0.0) dt = 1.0; + dt = dt * cond2r; + dy = yref * cond2r; + dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) - + sin(dy)/sqrt((1.0+cos(dy))/2.0); + if (dx==0.0) dx = 1.0; + geo2 = dt / dx; + dt = xinc*cosr - yinc* sinr; + if (dt==0.0) dt = 1.0; + dt = dt * cond2r; + dx = 2.0 * cos(dy) * sin(dt/2.0); + if (dx==0.0) dx = 1.0; + geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx; + geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0); + rat = ra0; + dect = dec0; + if ((l==0.0) && (m==0.0)) break; + dz = 4.0 - l*l/(4.0*geo1*geo1) - ((m+geo3)/geo2)*((m+geo3)/geo2) ; + if ((dz>4.0) || (dz<2.0)) return(*status = 501);; + dz = 0.5 * sqrt (dz); + dd = (m+geo3) * dz / geo2; + if (fabs(dd)>1.0) return(*status = 501);; + dd = asin (dd); + if (fabs(cos(dd))1.0) return(*status = 501);; + da = asin (da); + rat = ra0 + 2.0 * da; + dect = dd; + break; + case 8: /* -STG Sterographic*/ + dz = (4.0 - sins) / (4.0 + sins); + if (fabs(dz)>1.0) return(*status = 501); + dect = dz * sin0 + m * cos0 * (1.0+dz) / 2.0; + if (fabs(dect)>1.0) return(*status = 501); + dect = asin (dect); + rat = cos(dect); + if (fabs(rat)1.0) return(*status = 501); + rat = asin (rat); + mg = 1.0 + sin(dect) * sin0 + cos(dect) * cos0 * cos(rat); + if (fabs(mg)deps) rat = twopi/2.0 - rat; + rat = ra0 + rat; + break; + + default: + /* fall through to here on error */ + return(*status = 504); + } + +/* return ra in range */ + raout = rat; + decout = dect; + if (raout-ra0>twopi/2.0) raout = raout - twopi; + if (raout-ra0<-twopi/2.0) raout = raout + twopi; + if (raout < 0.0) raout += twopi; /* added by DCW 10/12/94 */ + +/* correct units back to degrees */ + *xpos = raout / cond2r; + *ypos = decout / cond2r; + return(*status); +} /* End of worldpos */ +/*--------------------------------------------------------------------------*/ +int ffxypx(double xpos, double ypos, double xref, double yref, + double xrefpix, double yrefpix, double xinc, double yinc, double rot, + char *type, double *xpix, double *ypix, int *status) +/* WDP 1/97: changed name of routine from xypix to ffxypx */ +/*-----------------------------------------------------------------------*/ +/* routine to determine accurate pixel coordinates for an RA and Dec */ +/* returns 0 if successful otherwise: */ +/* 1 = angle too large for projection; */ +/* 2 = bad values */ +/* WDP 1/97: changed the return values to 501 and 502 instead of 1 and 2 */ +/* does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections */ +/* anything else is linear */ +/* Input: */ +/* d xpos x (RA) coordinate (deg) */ +/* d ypos y (dec) coordinate (deg) */ +/* d xref x reference coordinate value (deg) */ +/* d yref y reference coordinate value (deg) */ +/* f xrefpix x reference pixel */ +/* f yrefpix y reference pixel */ +/* f xinc x coordinate increment (deg) */ +/* f yinc y coordinate increment (deg) */ +/* f rot rotation (deg) (from N through E) */ +/* c *type projection type code e.g. "-SIN"; */ +/* Output: */ +/* f *xpix x pixel number (RA or long without rotation) */ +/* f *ypiy y pixel number (dec or lat without rotation) */ +/*-----------------------------------------------------------------------*/ + {double dx, dy, dz, r, ra0, dec0, ra, dec, coss, sins, dt, da, dd, sint; + double l, m, geo1, geo2, geo3, sinr, cosr, cos0, sin0; + double cond2r=1.745329252e-2, deps=1.0e-5, twopi=6.28318530717959; + int i, itype; + char ctypes[9][5] ={"-CAR","-SIN","-TAN","-ARC","-NCP", "-GLS", "-MER", + "-AIT", "-STG"}; + + /* 0h wrap-around tests added by D.Wells 10/12/94: */ + dt = (xpos - xref); + if (dt > 180) xpos -= 360; + if (dt < -180) xpos += 360; + /* NOTE: changing input argument xpos is OK (call-by-value in C!) */ + +/* default values - linear */ + dx = xpos - xref; + dy = ypos - yref; +/* dz = 0.0; */ +/* Correct for rotation */ + r = rot * cond2r; + cosr = cos (r); + sinr = sin (r); + dz = dx*cosr + dy*sinr; + dy = dy*cosr - dx*sinr; + dx = dz; +/* check axis increments - bail out if either 0 */ + if ((xinc==0.0) || (yinc==0.0)) {*xpix=0.0; *ypix=0.0; return(*status = 502);} +/* convert to pixels */ + *xpix = dx / xinc + xrefpix; + *ypix = dy / yinc + yrefpix; + +/* find type */ +/* WDP 1/97: removed support for default type for better error checking */ +/* itype = 0; default type is linear */ + itype = -1; /* no default type */ + for (i=0;i<9;i++) if (!strncmp(type, ctypes[i], 4)) itype = i; + if (itype==0) return(*status); /* done if linear */ + +/* Non linear position */ + ra0 = xref * cond2r; + dec0 = yref * cond2r; + ra = xpos * cond2r; + dec = ypos * cond2r; + +/* compute direction cosine */ + coss = cos (dec); + sins = sin (dec); + cos0 = cos (dec0); + sin0 = sin (dec0); + l = sin(ra-ra0) * coss; + sint = sins * sin0 + coss * cos0 * cos(ra-ra0); + +/* process by case */ + switch (itype) { + case 1: /* -SIN sin*/ + if (sint<0.0) return(*status = 501); + m = sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0); + break; + case 2: /* -TAN tan */ + if (sint<=0.0) return(*status = 501); + if( cos0<0.001 ) { + /* Do a first order expansion around pole */ + m = (coss * cos(ra-ra0)) / (sins * sin0); + m = (-m + cos0 * (1.0 + m*m)) / sin0; + } else { + m = ( sins/sint - sin0 ) / cos0; + } + if( fabs(sin(ra0)) < 0.3 ) { + l = coss*sin(ra)/sint - cos0*sin(ra0) + m*sin(ra0)*sin0; + l /= cos(ra0); + } else { + l = coss*cos(ra)/sint - cos0*cos(ra0) + m*cos(ra0)*sin0; + l /= -sin(ra0); + } + break; + case 3: /* -ARC Arc*/ + m = sins * sin(dec0) + coss * cos(dec0) * cos(ra-ra0); + if (m<-1.0) m = -1.0; + if (m>1.0) m = 1.0; + m = acos (m); + if (m!=0) + m = m / sin(m); + else + m = 1.0; + l = l * m; + m = (sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0)) * m; + break; + case 4: /* -NCP North celestial pole*/ + if (dec0==0.0) + return(*status = 501); /* can't stand the equator */ + else + m = (cos(dec0) - coss * cos(ra-ra0)) / sin(dec0); + break; + case 5: /* -GLS global sinusoid */ + dt = ra - ra0; + if (fabs(dec)>twopi/4.0) return(*status = 501); + if (fabs(dec0)>twopi/4.0) return(*status = 501); + m = dec - dec0; + l = dt * coss; + break; + case 6: /* -MER mercator*/ + dt = yinc * cosr + xinc * sinr; + if (dt==0.0) dt = 1.0; + dy = (yref/2.0 + 45.0) * cond2r; + dx = dy + dt / 2.0 * cond2r; + dy = log (tan (dy)); + dx = log (tan (dx)); + geo2 = dt * cond2r / (dx - dy); + geo3 = geo2 * dy; + geo1 = cos (yref*cond2r); + if (geo1<=0.0) geo1 = 1.0; + dt = ra - ra0; + l = geo1 * dt; + dt = dec / 2.0 + twopi / 8.0; + dt = tan (dt); + if (dttwopi/4.0) return(*status = 501); + dt = yinc*cosr + xinc*sinr; + if (dt==0.0) dt = 1.0; + dt = dt * cond2r; + dy = yref * cond2r; + dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) - + sin(dy)/sqrt((1.0+cos(dy))/2.0); + if (dx==0.0) dx = 1.0; + geo2 = dt / dx; + dt = xinc*cosr - yinc* sinr; + if (dt==0.0) dt = 1.0; + dt = dt * cond2r; + dx = 2.0 * cos(dy) * sin(dt/2.0); + if (dx==0.0) dx = 1.0; + geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx; + geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0); + dt = sqrt ((1.0 + cos(dec) * cos(da))/2.0); + if (fabs(dt)twopi/4.0) return(*status = 501); + dd = 1.0 + sins * sin(dec0) + coss * cos(dec0) * cos(da); + if (fabs(dd) +#include +#include +#include + +#ifdef _ALPHA_ +#define e_magic_number IMAGE_FILE_MACHINE_ALPHA +#else +#define e_magic_number IMAGE_FILE_MACHINE_I386 +#endif + +/* + *---------------------------------------------------------------------- + * GetArgcArgv -- + * + * Break up a line into argc argv + *---------------------------------------------------------------------- + */ +int +GetArgcArgv(char *s, char **argv) +{ + int quote = 0; + int argc = 0; + char *bp; + + bp = s; + while (1) { + while (isspace(*bp)) { + bp++; + } + if (*bp == '\n' || *bp == '\0') { + *bp = '\0'; + return argc; + } + if (*bp == '\"') { + quote = 1; + bp++; + } + argv[argc++] = bp; + + while (*bp != '\0') { + if (quote) { + if (*bp == '\"') { + quote = 0; + *bp = '\0'; + bp++; + break; + } + bp++; + continue; + } + if (isspace(*bp)) { + *bp = '\0'; + bp++; + break; + } + bp++; + } + } +} + +/* + * The names of the first group of possible symbol table storage classes + */ +char * SzStorageClass1[] = { + "NULL","AUTOMATIC","EXTERNAL","STATIC","REGISTER","EXTERNAL_DEF","LABEL", + "UNDEFINED_LABEL","MEMBER_OF_STRUCT","ARGUMENT","STRUCT_TAG", + "MEMBER_OF_UNION","UNION_TAG","TYPE_DEFINITION","UNDEFINED_STATIC", + "ENUM_TAG","MEMBER_OF_ENUM","REGISTER_PARAM","BIT_FIELD" +}; + +/* + * The names of the second group of possible symbol table storage classes + */ +char * SzStorageClass2[] = { + "BLOCK","FUNCTION","END_OF_STRUCT","FILE","SECTION","WEAK_EXTERNAL" +}; + +/* + *---------------------------------------------------------------------- + * GetSZStorageClass -- + * + * Given a symbol storage class value, return a descriptive + * ASCII string + *---------------------------------------------------------------------- + */ +PSTR +GetSZStorageClass(BYTE storageClass) +{ + if ( storageClass <= IMAGE_SYM_CLASS_BIT_FIELD ) + return SzStorageClass1[storageClass]; + else if ( (storageClass >= IMAGE_SYM_CLASS_BLOCK) + && (storageClass <= IMAGE_SYM_CLASS_WEAK_EXTERNAL) ) + return SzStorageClass2[storageClass-IMAGE_SYM_CLASS_BLOCK]; + else + return "???"; +} + +/* + *---------------------------------------------------------------------- + * GetSectionName -- + * + * Used by DumpSymbolTable, it gives meaningful names to + * the non-normal section number. + * + * Results: + * A name is returned in buffer + *---------------------------------------------------------------------- + */ +void +GetSectionName(WORD section, PSTR buffer, unsigned cbBuffer) +{ + char tempbuffer[10]; + + switch ( (SHORT)section ) + { + case IMAGE_SYM_UNDEFINED: strcpy(tempbuffer, "UNDEF"); break; + case IMAGE_SYM_ABSOLUTE: strcpy(tempbuffer, "ABS "); break; + case IMAGE_SYM_DEBUG: strcpy(tempbuffer, "DEBUG"); break; + default: wsprintf(tempbuffer, "%-5X", section); + } + + strncpy(buffer, tempbuffer, cbBuffer-1); +} + +/* + *---------------------------------------------------------------------- + * DumpSymbolTable -- + * + * Dumps a COFF symbol table from an EXE or OBJ. We only use + * it to dump tables from OBJs. + *---------------------------------------------------------------------- + */ +void +DumpSymbolTable(PIMAGE_SYMBOL pSymbolTable, FILE *fout, unsigned cSymbols) +{ + unsigned i; + PSTR stringTable; + char sectionName[10]; + + fprintf(fout, "Symbol Table - %X entries (* = auxillary symbol)\n", + cSymbols); + + fprintf(fout, + "Indx Name Value Section cAux Type Storage\n" + "---- -------------------- -------- ---------- ----- ------- --------\n"); + + /* + * The string table apparently starts right after the symbol table + */ + stringTable = (PSTR)&pSymbolTable[cSymbols]; + + for ( i=0; i < cSymbols; i++ ) { + fprintf(fout, "%04X ", i); + if ( pSymbolTable->N.Name.Short != 0 ) + fprintf(fout, "%-20.8s", pSymbolTable->N.ShortName); + else + fprintf(fout, "%-20s", stringTable + pSymbolTable->N.Name.Long); + + fprintf(fout, " %08X", pSymbolTable->Value); + + GetSectionName(pSymbolTable->SectionNumber, sectionName, + sizeof(sectionName)); + fprintf(fout, " sect:%s aux:%X type:%02X st:%s\n", + sectionName, + pSymbolTable->NumberOfAuxSymbols, + pSymbolTable->Type, + GetSZStorageClass(pSymbolTable->StorageClass) ); +#if 0 + if ( pSymbolTable->NumberOfAuxSymbols ) + DumpAuxSymbols(pSymbolTable); +#endif + + /* + * Take into account any aux symbols + */ + i += pSymbolTable->NumberOfAuxSymbols; + pSymbolTable += pSymbolTable->NumberOfAuxSymbols; + pSymbolTable++; + } +} + +/* + *---------------------------------------------------------------------- + * DumpExternals -- + * + * Dumps a COFF symbol table from an EXE or OBJ. We only use + * it to dump tables from OBJs. + *---------------------------------------------------------------------- + */ +void +DumpExternals(PIMAGE_SYMBOL pSymbolTable, FILE *fout, unsigned cSymbols) +{ + unsigned i; + PSTR stringTable; + char *s, *f; + char symbol[1024]; + + /* + * The string table apparently starts right after the symbol table + */ + stringTable = (PSTR)&pSymbolTable[cSymbols]; + + for ( i=0; i < cSymbols; i++ ) { + if (pSymbolTable->SectionNumber > 0 && pSymbolTable->Type == 0x20) { + if (pSymbolTable->StorageClass == IMAGE_SYM_CLASS_EXTERNAL) { + if (pSymbolTable->N.Name.Short != 0) { + strncpy(symbol, pSymbolTable->N.ShortName, 8); + symbol[8] = 0; + } else { + s = stringTable + pSymbolTable->N.Name.Long; + strcpy(symbol, s); + } + s = symbol; + f = strchr(s, '@'); + if (f) { + *f = 0; + } +#if defined(_MSC_VER) && defined(_X86_) + if (symbol[0] == '_') { + s = &symbol[1]; + } +#endif + if ((stricmp(s, "DllEntryPoint") != 0) + && (stricmp(s, "DllMain") != 0)) { + fprintf(fout, "\t%s\n", s); + } + } + } + + /* + * Take into account any aux symbols + */ + i += pSymbolTable->NumberOfAuxSymbols; + pSymbolTable += pSymbolTable->NumberOfAuxSymbols; + pSymbolTable++; + } +} + +/* + *---------------------------------------------------------------------- + * DumpObjFile -- + * + * Dump an object file--either a full listing or just the exported + * symbols. + *---------------------------------------------------------------------- + */ +void +DumpObjFile(PIMAGE_FILE_HEADER pImageFileHeader, FILE *fout, int full) +{ + PIMAGE_SYMBOL PCOFFSymbolTable; + DWORD COFFSymbolCount; + + PCOFFSymbolTable = (PIMAGE_SYMBOL) + ((DWORD)pImageFileHeader + pImageFileHeader->PointerToSymbolTable); + COFFSymbolCount = pImageFileHeader->NumberOfSymbols; + + if (full) { + DumpSymbolTable(PCOFFSymbolTable, fout, COFFSymbolCount); + } else { + DumpExternals(PCOFFSymbolTable, fout, COFFSymbolCount); + } +} + +/* + *---------------------------------------------------------------------- + * SkipToNextRecord -- + * + * Skip over the current ROMF record and return the type of the + * next record. + *---------------------------------------------------------------------- + */ + +BYTE +SkipToNextRecord(BYTE **ppBuffer) +{ + int length; + (*ppBuffer)++; /* Skip over the type.*/ + length = *((WORD*)(*ppBuffer))++; /* Retrieve the length. */ + *ppBuffer += length; /* Skip over the rest. */ + return **ppBuffer; /* Return the type. */ +} + +/* + *---------------------------------------------------------------------- + * DumpROMFObjFile -- + * + * Dump a Relocatable Object Module Format file, displaying only + * the exported symbols. + *---------------------------------------------------------------------- + */ +void +DumpROMFObjFile(LPVOID pBuffer, FILE *fout) +{ + BYTE type, length; + char symbol[1024], *s; + + while (1) { + type = SkipToNextRecord(&(BYTE*)pBuffer); + if (type == 0x90) { /* PUBDEF */ + if (((BYTE*)pBuffer)[4] != 0) { + length = ((BYTE*)pBuffer)[5]; + strncpy(symbol, ((char*)pBuffer) + 6, length); + symbol[length] = '\0'; + s = symbol; + if ((stricmp(s, "DllEntryPoint") != 0) + && (stricmp(s, "DllMain") != 0)) { + if (s[0] == '_') { + s++; + fprintf(fout, "\t_%s\n\t%s=_%s\n", s, s, s); + } else { + fprintf(fout, "\t%s\n", s); + } + } + } + } else if (type == 0x8B || type == 0x8A) { /* MODEND */ + break; + } + } +} + +/* + *---------------------------------------------------------------------- + * DumpFile -- + * + * Open up a file, memory map it, and call the appropriate + * dumping routine + *---------------------------------------------------------------------- + */ +void +DumpFile(LPSTR filename, FILE *fout, int full) +{ + HANDLE hFile; + HANDLE hFileMapping; + LPVOID lpFileBase; + PIMAGE_DOS_HEADER dosHeader; + + hFile = CreateFile(filename, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + + if (hFile == INVALID_HANDLE_VALUE) { + fprintf(stderr, "Couldn't open file with CreateFile()\n"); + return; + } + + hFileMapping = CreateFileMapping(hFile, NULL, PAGE_READONLY, 0, 0, NULL); + if (hFileMapping == 0) { + CloseHandle(hFile); + fprintf(stderr, "Couldn't open file mapping with CreateFileMapping()\n"); + return; + } + + lpFileBase = MapViewOfFile(hFileMapping, FILE_MAP_READ, 0, 0, 0); + if (lpFileBase == 0) { + CloseHandle(hFileMapping); + CloseHandle(hFile); + fprintf(stderr, "Couldn't map view of file with MapViewOfFile()\n"); + return; + } + + dosHeader = (PIMAGE_DOS_HEADER)lpFileBase; + if (dosHeader->e_magic == IMAGE_DOS_SIGNATURE) { +#if 0 + DumpExeFile( dosHeader ); +#else + fprintf(stderr, "File is an executable. I don't dump those.\n"); + return; +#endif + } + /* Does it look like a i386 COFF OBJ file??? */ + else if ((dosHeader->e_magic == e_magic_number) + && (dosHeader->e_sp == 0)) { + /* + * The two tests above aren't what they look like. They're + * really checking for IMAGE_FILE_HEADER.Machine == i386 (0x14C) + * and IMAGE_FILE_HEADER.SizeOfOptionalHeader == 0; + */ + DumpObjFile((PIMAGE_FILE_HEADER) lpFileBase, fout, full); + } else if (*((BYTE *)lpFileBase) == 0x80) { + /* + * This file looks like it might be a ROMF file. + */ + DumpROMFObjFile(lpFileBase, fout); + } else { + printf("unrecognized file format\n"); + } + UnmapViewOfFile(lpFileBase); + CloseHandle(hFileMapping); + CloseHandle(hFile); +} + +void +main(int argc, char **argv) +{ + char *fargv[1000]; + char cmdline[10000]; + int i, arg; + FILE *fout; + int pos; + int full = 0; + char *outfile = NULL; + + if (argc < 3) { + Usage: + fprintf(stderr, "Usage: %s ?-o outfile? ?-f(ull)? ..\n", argv[0]); + exit(1); + } + + arg = 1; + while (argv[arg][0] == '-') { + if (strcmp(argv[arg], "--") == 0) { + arg++; + break; + } else if (strcmp(argv[arg], "-f") == 0) { + full = 1; + } else if (strcmp(argv[arg], "-o") == 0) { + arg++; + if (arg == argc) { + goto Usage; + } + outfile = argv[arg]; + } + arg++; + } + if (arg == argc) { + goto Usage; + } + + if (outfile) { + fout = fopen(outfile, "w+"); + if (fout == NULL) { + fprintf(stderr, "Unable to open \'%s\' for writing:\n", + argv[arg]); + perror(""); + exit(1); + } + } else { + fout = stdout; + } + + if (! full) { + char *dllname = argv[arg]; + arg++; + if (arg == argc) { + goto Usage; + } + fprintf(fout, "LIBRARY %s\n", dllname); + fprintf(fout, "EXETYPE WINDOWS\n"); + fprintf(fout, "CODE PRELOAD MOVEABLE DISCARDABLE\n"); + fprintf(fout, "DATA PRELOAD MOVEABLE MULTIPLE\n\n"); + fprintf(fout, "EXPORTS\n"); + } + + for (; arg < argc; arg++) { + if (argv[arg][0] == '@') { + FILE *fargs = fopen(&argv[arg][1], "r"); + if (fargs == NULL) { + fprintf(stderr, "Unable to open \'%s\' for reading:\n", + argv[arg]); + perror(""); + exit(1); + } + pos = 0; + for (i = 0; i < arg; i++) { + strcpy(&cmdline[pos], argv[i]); + pos += strlen(&cmdline[pos]) + 1; + fargv[i] = argv[i]; + } + fgets(&cmdline[pos], sizeof(cmdline), fargs); + fprintf(stderr, "%s\n", &cmdline[pos]); + fclose(fargs); + i += GetArgcArgv(&cmdline[pos], &fargv[i]); + argc = i; + argv = fargv; + } + DumpFile(argv[arg], fout, full); + } + exit(0); +} diff --git a/pkg/tbtables/doc/Notes b/pkg/tbtables/doc/Notes new file mode 100644 index 00000000..fef2c22a --- /dev/null +++ b/pkg/tbtables/doc/Notes @@ -0,0 +1,46 @@ +18 Sep 1987 get/put element routines + + The user-callable get/put element routines are tbegt[tbird] and +tbept[tbird]. In outline, each of these routines calls tbeoff to get +the offset to the element (i.e. row & column) to be gotten or put, +then calls a get/put primitive routine (tbegp[], tbepp[]) of the data +type of the column, and finally converts the data type if that is +necessary. If the data type of the column is the same as that of the +I/O buffer then the value is read directly into or from that buffer. +No separate null flag is returned by tbegt[]; if the table value is +undefined the output value will be INDEF. + + A subroutine call could have been saved by writing tbeoff into +each of the get/put primitives. That would have been very reasonable, +but there were a couple of reasons for not doing it that way. I would +like to replace the seek & read or seek & write in get/put row (tbrgt[], +tbrpt[]) by calls to these get/put primitives, and in that case the +offset does not need to be recomputed from scratch for each column. +If we ever have 3-D tables (i.e. entries which are arrays) then these +primitives could still be used for getting/putting single elements in +the arrays. + + I should also write get/put array primitives for get/put column +or for arrays in 3-D tables. Eventually it would be nice to include +conversion between machine-dependent and machine-independent formats +in these primitives. + + The use of TB_CURROW and TB_OFFSET in tbrgt[] and tbrpt[] seems +rather clumsy. I think it would be better to just call tbxoff or tbeoff. + +1 Oct 1987 tbpset & tbpsta for FIO buffer size + + I have not handled this very well. It is supposed to be not possible +to set the FIO buffer size after the first I/O operation to a file. When +an existing table is opened by tbtopn, the size-information record is read. +For a new table tbtopn does not actually call open (but perhaps it should!), +so the buffer size can't be set before calling tbtcre, which does call open +but which also writes the size-info record to the table. So in neither case +is it possible to change the FIO buffer size. My solution, in the routine +tbtfst, was to close the table file (using close, not tbtclo), reopen it, +and then call fset before any I/O operation is done. This precludes calling +tbpset to set the buffer size (e.g. advice=RANDOM) for a new table between +calls to tbtopn and tbtcre. This is just where you would expect to be able +to set it, however, so one of these days I will have to make that possible. +This could be done by calling open in tbtopn even for a new table but not +writing to the table until the call to tbtcre. diff --git a/pkg/tbtables/doc/README b/pkg/tbtables/doc/README new file mode 100644 index 00000000..4271bf9e --- /dev/null +++ b/pkg/tbtables/doc/README @@ -0,0 +1,10 @@ + 2328 Sep 11 14:53 cfitsio.install info about installing CFITSIO + 5988 Apr 20 1999 calls.doc user-callable table I/O routines + 3328 Jul 30 1997 ex.x a complete example + 3579 Jul 30 1997 example.doc example + 4463 Aug 17 1999 fileformat.doc description of stsdas table file format + 582 Jul 30 1997 tbtcpy.lis info about tbtcpy +11898 Aug 17 1999 text_tables.doc info about text tables + 1605 Aug 17 1999 versions.doc changes to stsdas table format + 2654 Jul 30 1997 Notes not up to date + 2858 Jul 30 1997 descrip.doc not up to date diff --git a/pkg/tbtables/doc/calls.doc b/pkg/tbtables/doc/calls.doc new file mode 100644 index 00000000..5ebd45dc --- /dev/null +++ b/pkg/tbtables/doc/calls.doc @@ -0,0 +1,190 @@ + 1999 April 20 +opening and closing tables: + + tbtopn - initialize (and open the table if not NEW_FILE or NEW_COPY) + tbtcre - create a new table (after initializing with tbtopn) + tbtclo - close a table + +table parameters: + + tbpset - set a table parameter + tbpsta - get the value of a table parameter (e.g. number of rows) + +row and column selectors: + + tbcdes - get the pointer to a column selector descriptor + tbsirow - get the actual row number from the selected row number + +columns: + + tbcdef - define columns + tbcdef1 - define one column + tbcfnd - find columns from their names + tbcfnd1 - find a column from its name + tbcinf - get information about a column + tbcig[ti] - get specific info about a column (e.g. name or data type) + tbcnel - get number of elements in column + tbcga[rd] - get all elements in column + +get and put: + + tbegt[tbirds] - get a value from the table + tbept[tbirds] - put a value into the table + tbagt[tbirds] - get an array from a row and column location + tbapt[tbirds] - put an array at a row and column location + tbrgt[tbirds] - get values from a row + tbrpt[tbirds] - put values into a row + tbcgt[tbirds] - get values from a column + tbcpt[tbirds] - put values into a column + tbrudf - set values in a row to undefined + +header parameters: + + tbhgt[tbird] - get a header parameter + tbhad[tbird] - add a new header parameter or replace existing one + tbhpt[tbird] - replace an existing header parameter + tbhcal - copy all header parameters + tbhgnp - get Nth header parameter as a string + tbhgcm - get a comment associated with a header parameter + tbhpcm - add or replace a comment for a header parameter + +table files: + + tbtcpy - copy a table + tbtdel - delete a table + tbtren - rename a table + tbtacc - test for the existence of a table + tbtext - append default extension (if it's not already there) + tbtnam - get the name (including extension) of the table + tbtflu - flush FIO buffer for table + tbfpri - copy primary header of FITS table, if appropriate + tbparse - get file name from table name + +miscellaneous: + + tbtchs - change allocated space of any/all portions of a table + tbrcpy - copy an entire row (only for tables with identical columns) + tbrcsc - copy a row, but copy only selected columns + tbrswp - swap two rows + tbtsrt - sort an index for the table rows + tbrdel - delete a range of rows + tbrnll - set all columns in a range of rows to INDEF + tbcnam - change the name of a column + tbcfmt - change the format for printing a column + tbcnit - change the units for a column + tbcnum - get the column pointer from the column number + +Calling sequences: + + nret = tbagt[] (tp, cp, rownum, buffer, first, nelem) + nret = tbagtt (tp, cp, rownum, buffer, lenstr, first, nelem) + tbapt[] (tp, cp, rownum, buffer, first, nelem) + tbaptt (tp, cp, rownum, buffer, lenstr, first, nelem) + + tbcdef (tp, cptr, + colnames, colunits, colfmt, datatype, nelem, numcols) + tbcdef1 (tp, cp, + colname, colunits, colfmt, datatype, nelem) + + descrip = tbcdes (tp, cp) + + tbcfmt (tp, cp, colfmt) + + tbcfnd (tp, colnames, cptr, numcols) + tbcfnd1 (tp, colname, cp) + + int = tbcga[rd] (tp, cp, buffer, nelem) + + tbcgt[] (tp, cp, buffer, nullflag, firstrow, lastrow) + tbcgtt (tp, cp, buffer, nullflag, lenstr, firstrow, lastrow) + + tbcinf (cp, + colnum, colname, colunits, colfmt, datatype, lendata, lenfmt) + + int = tbcigi (cp, param) + tbcigt (cp, param, outstr, maxch) + + tbcnam (tp, cp, colname) + + int = tbcnel (tp, cp) + + tbcnit (tp, cp, colunits) + + cp = tbcnum (tp, colnum) + + tbcpt[] (tp, cp, buffer, firstrow, lastrow) + tbcptt (tp, cp, buffer, lenstr, firstrow, lastrow) + + tbegt[] (tp, cp, rownum, buffer) + tbegtt (tp, cp, rownum, buffer, maxch) + + tbept[] (tp, cp, rownum, buffer) + + tbfpri (inname, outname, copied) + + tbhad[] (tp, keyword, value) + + tbhcal (itp, otp) + + tbhgcm (tp, keyword, comment, maxch) + tbhpcm (tp, keyword, comment) + + tbhgnp (tp, parnum, keyword, datatype, str) + + bool = tbhgtb (tp, keyword) + double = tbhgtd (tp, keyword) + int = tbhgti (tp, keyword) + real = tbhgtr (tp, keyword) + tbhgtt (tp, keyword, text, maxch) + + tbhpt[] (tp, keyword, value) + + int = tbparse (tablename, filename, extname, maxch, hdu) + + tbpset (tp, param, value) + + int = tbpsta (tp, param) + + tbrcpy (itp, otp, irownum, orownum) + + tbrcsc (itp, otp, icptr, ocptr, irownum, orownum, numcols) + + tbrdel (tp, firstrow, lastrow) + + tbrgt[] (tp, cptr, buffer, nullflag, numcols, rownum) + tbrgtt (tp, cptr, buffer, nullflag, lenstr, numcols, rownum) + + tbrnll (tp, firstrow, lastrow) + + tbrpt[] (tp, cptr, buffer, numcols, rownum) + tbrptt (tp, cptr, buffer, lenstr, numcols, rownum) + + tbrswp (tp, row1, row2) + + tbrudf (tp, cptr, numcols, rownum) + + tbsirow (tp, selrow, rownum) + + int = tbtacc (tablename) + + tbtchs (tp, maxpar, maxcols, rowlen, allrows) + + tbtclo (tp) + + tbtcpy (inname, outname) + + tbtcre (tp) + + tbtdel (tablename) + + tbtext (inname, outname, maxch) + + tbtflu (tp) + + tbtnam (tp, tblname, maxch) + + tp = tbtopn (tablename, iomode, template) + + tbtren (oldname, newname) + + tbtsrt (tp, numcols, cp, fold, nindex, index) diff --git a/pkg/tbtables/doc/cfitsio.install b/pkg/tbtables/doc/cfitsio.install new file mode 100644 index 00000000..3fb2afb5 --- /dev/null +++ b/pkg/tbtables/doc/cfitsio.install @@ -0,0 +1,57 @@ +This file describes how to install a new version of CFITSIO in TABLES. + +CFITSIO can be obtained from the High Energy Astrophysics Archive Research +Center, HEASARC: + + http://heasarc.gsfc.nasa.gov/fitsio + +The directory containing CFITSIO in the TABLES package is: + + tables$lib/tbtables/cfitsio/ + +Before installing a new version, save the mkpkg file from the above +directory, since a new distribution may include a file with the same +name but with very different contents. + +After saving mkpkg, the files in the distribution can then be installed +in tables$lib/tbtables/cfitsio/. Copy the saved version of mkpkg into +this directory, clobbering the version from the distribution. This saved +version of mkpkg may need to be modified to include new files, as described +below. + +These are the files that may need to be modified (unless these changes +have been incorporated into future versions of CFITSIO): + + eval_l.c + fitsio2.h + +Changes to eval_l.c and fitsio2.h: + +On a VMS machine, if the linker gives an error about strcasecmp and +strncasecmp being redefined, remove vms and __vms from this section +(this is near the end of both files): + +#if defined(vms) || defined(__vms) || defined(WIN32) || defined(__WIN32__) || defined(macintosh) + +/* ================================================================== */ +/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */ +/* ================================================================== */ + +changing it to this: + +#if defined(WIN32) || defined(__WIN32__) || defined(macintosh) + +/* ================================================================== */ +/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */ +/* ================================================================== */ + +Changes to mkpkg: + +There will be files in the CFITSIO distribution that are not needed by +the TABLES library, such as test programs; these should not be included +in mkpkg. However, there may be new source files that contain functions +that are called by functions that are called by the table I/O routines. +If the link fails for the ttools package, find the source files containing +the missing modules, and add these files to the list of dependents in mkpkg +for libtbtables.a. It may require more than one iteration to find all the +required source files. diff --git a/pkg/tbtables/doc/descrip.doc b/pkg/tbtables/doc/descrip.doc new file mode 100644 index 00000000..3905bdba --- /dev/null +++ b/pkg/tbtables/doc/descrip.doc @@ -0,0 +1,62 @@ + This note describes some specific characteristics and limitations +of STSDAS tables. + +1. Six data types are supported: + + single-precision real + double-precision real + integer (same number of bytes as real) + short integer (int*2) + boolean (Fortran logical; same size as real) + text (character strings) in multiples of four characters up to + 160 characters + +Type conversion is done implicitly if the data type of the column differs +from that of the buffer. Boolean true and false are converted to YES and NO +respectively if they are read as integer values. + +2. Header parameters: + + The same data types are supported for header (user) parameters as for +table data, except for short integers, and text strings are limited to 70 +characters. Type conversion is done for numeric and boolean parameters, +but text parameters may only be gotten as text. The I/O routines for header +parameters get and put single parameters, not arrays. A user program may +construct array elements by appending numbers to a root portion of a keyword, +and the array elements may be gotten or put one at a time. + + The table must exist in order to get or put header parameters. + +3. Undefined elements are flagged by using special values. There is at +present no undefined value for a boolean element; the default value is false +(or no). A null character string is regarded as undefined. Trailing blanks +are truncated by the Fortran-callable routines (ut...) but not by the +SPP-callable (tb...) routines. + +4. The format for printing table values supports the more common Fortran +formats with a few differences and some additional options: + + h: H:M:S.d + m: H:M.d (or M:S.d) + i-: left justified (but SPP uses d instead of i) + i0: fill the field with zeros on the left; Fortran also allows filling + a portion of the field (e.g. I4.2) + o: octal + x: hexadecimal + b: "yes" or "no" instead of "T" or "F" + +5. The header parameters and column descriptors are stored in the table +together with the data, so if more parameters are written or more columns +defined than there is space in the table, the table will be rewritten to +allocate more room. If the table is large, this can be a problem either +due to the time involved or because of disk space limitations. When a new +table is created it is possible to specify the amount of space to be +allocated for header parameters and for column descriptors. + + A table may be row-ordered (which is the default) or column-ordered. +If the table is row-ordered then rows may be written at the end of the table +without ever specifying the maximum number of rows. Adding new columns after +creating the table, however, requires rewriting the table unless space was +allocated for new columns. + + There is no intrinsic limit on the number of columns or rows. diff --git a/pkg/tbtables/doc/ex.x b/pkg/tbtables/doc/ex.x new file mode 100644 index 00000000..1e9438de --- /dev/null +++ b/pkg/tbtables/doc/ex.x @@ -0,0 +1,109 @@ +task ttt + +# Example task for creating a table from a text file. The text file +# is assumed to contain five columns per row, containing an integer +# catalog number, a text string, right ascension, declination, and +# magnitude. An example of three lines from the text file could be: +# +# 0172 abcd 0:01:17.865 -89:43:17.62 14.7 +# 0213 "a b" 0:02:29.775 -84:43:17.64 12.8 +# 0490 "" 2:19:21.000 -84:46:22.98 11.5 + +define NCOLS 5 # number of columns to create +# column numbers: +define ID 1 # catalog ID +define NAME 2 # name +define RA 3 # right ascension +define DEC 4 # declination +define MAG 5 # magnitude + +procedure ttt() + +char input[SZ_FNAME] # name of input file +char outtable[SZ_FNAME] # name of output table +#-- +pointer tp # pointer to table struct +pointer cp[NCOLS] # pointers to column info +pointer tbtopn() + +char name[SZ_FNAME] # star name +double ra, dec # coordinates +double mag # magnitude +int cat_id # catalog ID +int row # row number + +char lbuf[SZ_LINE] # buffer for reading from input +int ip, ctoi(), ctod(), ctowrd() +int fd # fd for input file +int open(), getline() + +errchk tbtopn, open + +begin + call clgstr ("input", input, SZ_FNAME) + call clgstr ("outtable", outtable, SZ_FNAME) + + # Open output table (file not created yet, though). + tp = tbtopn (outtable, NEW_FILE, NULL) # NULL --> no template + + # Define columns. The "Name" column is a string up to 20 char long. + call tbcdef (tp, cp[ID], "catalog_ID", "", "%8d", TY_INT, 1, 1) + call tbcdef (tp, cp[NAME], "Name", "", "", -20, 1, 1) + call tbcdef (tp, cp[RA], "RA", "hours", "%12.2h", TY_DOUBLE, 1, 1) + call tbcdef (tp, cp[DEC], "DEC", "degrees", "%12.1h", TY_DOUBLE, 1, 1) + call tbcdef (tp, cp[MAG], "V", "Vmag", "%6.2f", TY_REAL, 1, 1) + # ^ ^ ^ ^ ^ + # output col name units format datatype + + # Create the output table file. + call tbtcre (tp) + + # Add a history record. + call tbhadt (tp, "history", "created as an example") + + # Open the input file. + fd = open (input, READ_ONLY, TEXT_FILE) + + # Read each line from the input file. + row = 0 # initialize + while (getline (fd, lbuf) != EOF) { + + if (lbuf[1] == '#' || lbuf[1] == '\n' || lbuf[1] == EOS) + next # ignore comment or blank lines + + ip = 1 # beginning of line + + # Read the catalog ID. + if (ctoi (lbuf, ip, cat_id) < 1) + next # ignore comment or bad line + + # Read the star name. + if (ctowrd (lbuf, ip, name, SZ_FNAME) < 1) + name[1] = EOS + + # Read the right ascension and declination. + if (ctod (lbuf, ip, ra) < 1) + call error (1, "can't read right ascension") + if (ctod (lbuf, ip, dec) < 1) + call error (1, "can't read declination") + + # Read the magnitude (may be missing). + if (ctod (lbuf, ip, mag) < 1) + mag = INDEFD + + row = row + 1 # increment row number + + # Write the information to the table. The "Vmag" column is + # real in the table, but we're passing it a double, so we use + # tbeptd instead of tbeptr. + call tbepti (tp, cp[ID], row, cat_id) + call tbeptt (tp, cp[NAME], row, name) + call tbeptd (tp, cp[RA], row, ra) + call tbeptd (tp, cp[DEC], row, dec) + call tbeptd (tp, cp[MAG], row, mag) + } + + # Close input file and output table. + call close (fd) + call tbtclo (tp) +end diff --git a/pkg/tbtables/doc/example.doc b/pkg/tbtables/doc/example.doc new file mode 100644 index 00000000..b5f81c78 --- /dev/null +++ b/pkg/tbtables/doc/example.doc @@ -0,0 +1,122 @@ + Here is a sample program that demonstrates creating a new table, +opening an existing table, and creating a new table based on a template. +The example can be compiled and linked using: + +xc -p tables test.x -ltbtables + +You can use xc regardless of whether you are logged into the cl or not; +it doesn't matter. + + +include + +task ttt + +define MAXROWS 10 # just for local buffer size + +procedure ttt() + +pointer tp, template # pointers to table descriptors +int nrows +int k +pointer outdec # column pointer for output column "Dec" +pointer inra, outra # column pointers for input & output "RA" +bool nullflag[MAXROWS] +double ra, dec, racol[MAXROWS] +pointer tbtopn() +int tbpsta() + +begin +# +# This section creates a new table (without using a template): +# + tp = tbtopn ("ex1", NEW_FILE, 0) # initialize for a new table + + call tbcdef (tp, outra, # define column with name "RA" + "RA", "degrees", "%12.1h", TY_DOUBLE, 1, 1) + + call tbtcre (tp) # open the table + + do k = 1, MAXROWS { # put RA in each row + ra = k/60. + call tbrptd (tp, outra, ra, 1, k) + } + call tbtclo (tp) # close the table +# +# Example for an existing table. +# + tp = tbtopn ("ex1", READ_ONLY, 0) # initialize and open the table + + call tbcfnd (tp, "RA", inra, 1) # find column "RA" + if (inra ==NULL) + call eprintf ("column RA not found\n") + + nrows = tbpsta (tp, TBL_NROWS) # how many rows? + + do k = 1, nrows { + call tbrgtd (tp, inra, ra, nullflag, 1, k) # read RA from each row + if (nullflag[1]) { + call eprintf ("column is null for row %d\n") + call pargi (k) + } else { + call printf ("ra = %12.1h\n") + call pargd (ra) + } + } + call tbtclo (tp) +# +# Example for creating a new table using a template to define column(s). +# + # Initialize and open the template table. + template = tbtopn ("ex1", READ_ONLY, 0) + + # Initialize using template. + tp = tbtopn ("ex2", NEW_COPY, template) + + call tbcdef (tp, outdec, # define new column "Dec" + "Dec", "degrees", "%12.0h", TY_DOUBLE, 1, 1) + + call tbtcre (tp) # open the output table + + call tbcfnd (template, "RA", inra, 1) # find col "RA" in input table + if (inra == NULL) + call eprintf ("column RA not found in input table\n") + + call tbcfnd (tp, "RA", outra, 1) # find col "RA" in output table + if (inra == NULL) + call eprintf ("column RA not found in output table\n") + + nrows = tbpsta (template, TBL_NROWS) # how many rows in template? + if (nrows > MAXROWS) + call error (1, + "input table has too many rows for size of input buffer") + + # Copy column "RA" from template to output. + call tbcgtd (template, inra, racol, nullflag, 1, nrows) + call tbcptd (tp, outra, racol, 1, nrows) + + call tbtclo (template) # we're done with the template + + do k = 1, nrows { # put Dec in each row + dec = -k/60.D0 + call tbrptd (tp, outdec, dec, 1, k) + } + + call tbtclo (tp) # close the output table +end + + The tprint task gave the following output for table ex2.tab: + +# ex2 has 10 rows and 2 columns + +(row) RA Dec + 1 0:01:00.0 -0:01:00 + 2 0:02:00.0 -0:02:00 + 3 0:03:00.0 -0:03:00 + 4 0:04:00.0 -0:04:00 + 5 0:05:00.0 -0:05:00 + 6 0:06:00.0 -0:06:00 + 7 0:07:00.0 -0:07:00 + 8 0:08:00.0 -0:08:00 + 9 0:09:00.0 -0:09:00 + 10 0:10:00.0 -0:10:00 diff --git a/pkg/tbtables/doc/fileformat.doc b/pkg/tbtables/doc/fileformat.doc new file mode 100644 index 00000000..3c9d3ef6 --- /dev/null +++ b/pkg/tbtables/doc/fileformat.doc @@ -0,0 +1,91 @@ + 1999 August 17 + + This note describes the file format for STSDAS tables. See +text_tables.doc for information on support for text tables in the +TABLES package. + +There are four sections to an STSDAS table: + +(1) a size-information record which gives the number of rows, etc +(2) optional header-parameter records +(3) a record for each column that describes the column +(4) the table data + + +1. The size-information record is 12 integers in length. Only the first +ten are used at the moment, and these have the following meanings: + + 1 The number of header parameters that have been written to the table. + 2 The maximum number of header parameters for which space has been allocated. + 3 The number of rows that have been written to the table. + 4 The allocated number of rows (relevant only for a column-ordered table). + 5 The number of columns that have been defined. + 6 The maximum number of column descriptors for which space has been + allocated. + 7 The length of the portion of the row that is used by columns that have + been defined; unit = SZ_CHAR (= two bytes). + 8 The allocated row length; unit = SZ_CHAR. This is relevant only for + a row-ordered table. + 9 Table type: 11 implies row-ordered; 12 implies column-ordered. + 10 Table software version number. Originally this was zero, and the + current value is three. The differences between versions are + described in the file "versions.doc". + + +2. The header parameters are FITS-like records for storing information such +as comments or numerical values. They are not used by the table routines +at all. There need not be any header parameters, and there need not be any +space allocated for them; that is, words one and two of the size-information +record may be zero. Each header-parameter record is 80 bytes in length and +contains the following: + +bytes description +----- ----------- + 1-8 Keyword; from one to eight characters padded on the right with blanks. + All letters will be in upper case. + 9 Data type; a single lower-case letter: t, b, i, r, d indicating a + type of text, boolean, integer, real, or double-precision respectively. + The data type has little real meaning since the value is ASCII. +10-80 The value, a left-justified ASCII string terminated by an ASCII null + and followed by garbage. Boolean true and false are represented by + one and zero respectively. + + +3. There is a column descriptor for each column that has been defined. Each +column-descriptor record has a length of 16 integer words and contains the +following: + + word description + ---- ----------- + 1 The column number. + 2 The offset from the start of the row; unit = SZ_CHAR (= two bytes). + This is the sum of the widths of all previous columns, or zero for + the first column. + 3 The amount of space (unit = SZ_CHAR) required to store one element. + 4 The data type: + 6 = single-precision real + 7 = double-precision real + 4 = integer + 3 = short integer + 1 = boolean + -n = character string containing up to n characters + 5-9 The column name, up to 20 characters, left justified. If the name + is shorter than 20 characters, it will be terminated by an ASCII + NULL; otherwise, the NULL will be omitted. Upper and lower case + are allowed, but they are not distinguished. + 10-14 The units, up to 20 characters, left justified. If the units string + is shorter than 20 characters, it will be terminated by an ASCII + NULL; otherwise, the NULL will be omitted. Upper and lower case + are allowed. + 15-16 The format for printing the column, up to eight characters. If the + string is shorter than eight characters, it will be terminated by + an ASCII NULL; otherwise, the NULL will be omitted. This format + string is an SPP-style format without the leading %. + + +4. The table data may be either row-ordered or column-ordered. Integer, +single- and double-precision reals, and boolean (logical) are stored in the +Fortran binary format of the host machine. For character data type, each +element will be terminated with an ASCII null if there is room for the null; +if an element fills the entire column width (a multiple of two bytes) then +the null will not be present. diff --git a/pkg/tbtables/doc/tbtcpy.lis b/pkg/tbtables/doc/tbtcpy.lis new file mode 100644 index 00000000..a371a618 --- /dev/null +++ b/pkg/tbtables/doc/tbtcpy.lis @@ -0,0 +1,30 @@ +Here is the algorithm for determining the type of output table that +will be created when calling tbtcpy: + + if output == STDOUT then + + type = text + + else if extension of output file is .fits (or .fit or .??f) then + + type = fits + + else if extension of output file is .qp + + type = row # but in a qpoe file + + else if input is text file or STDIN then + + # text --> text, except for extensions .tab, .fits, .qp + + if extension of output file is .tab + type = row + else # .fits & .qp taken care of above + type = text + end if + + else + + type = row + + end if diff --git a/pkg/tbtables/doc/text_tables.doc b/pkg/tbtables/doc/text_tables.doc new file mode 100644 index 00000000..a20a93c3 --- /dev/null +++ b/pkg/tbtables/doc/text_tables.doc @@ -0,0 +1,234 @@ + Text Tables 1999 August 17 + +The TABLES package I/O routines support text tables (ascii files in row +and column format) as well as FITS binary tables and STSDAS format binary +tables. There are limitations on size because the entire file is read +into memory when a text table is opened. Text tables are not as flexible +and certainly not as fast as binary tables, but for small files the ability +to use the table tools and other tasks can be very handy. + +Text tables can be plain ascii files with default column names (c1, c2, c3, +etc.) and no header keywords. However, the text table I/O routines now also +support explicit column definitions and/or header keywords. + +Header keywords have the following syntax: + +#k keyword = value comment + +The "#k " must be the first three characters of the line, and the space +following "k" is required. The "k" is not case sensitive. Header keywords +can be added to any text table, and they can appear anywhere in the file. +For a text string keyword, quotes around the value are needed if there is +a comment, in order to distinguish value from comment. Everything following +the value is considered to be the comment. + +Column definitions have the following syntax: + +#c column_name data_type print_format units + +The "#c " must be the first three characters of the line, and the space +following "c" is required. The "c" is not case sensitive. Aside from the +"#c ", the syntax is the same as the output from tlcol or the input cdfile +for tcreate. Only the column name is required, although in most cases you +will also need to give the data type (the default is d, double precision). + +Adding column definitions to a text table makes it a different "subtype" +(tinfo now prints this). If any column is defined this way, all columns +in the file must be defined, and all column definitions must precede the +table data. + +The print format is used for displaying the table or writing it back out +if the table was modified. The file is still read in free format, with +whitespace (blank or tab) separated columns. This means that text string +columns must be enclosed in quotes if they contain embedded blanks. + +A task that opens a simple text table read-write may change the table to one +with explicit column definitions. This will happen if the task changes a +column name to something other than "c" followed by an integer, or sets the +units to a non-null value, or if it creates a new column with non-default +name or units. In this case, column definitions will be written for all +columns, but the names for columns that weren't modified will still be c1, +c2, c3, etc. Tasks such as tchcol, tcalc and tedit can do this, for example. +Therefore, an easy way to add this information to a simple text table is to +run tchcol and change a column name, say from "c1" to "x". You can then edit +those "#c " lines to set the column names, print format and units. You can +change the data type, too, though it must be consistent with the data in the +file; for example, you could change i to d (integer to double), or ch*3 to +ch*8. + +Here are a couple of examples. + +#This is a simple text table (no column definitions), but it does have +#keywords. Some of the keywords have comments; anything following the +#value is a comment. +#k pi 3.14 +#k keywords "rootname opt_elem cenwave" these are the keywords we need +#k rootname = "o47s01k7m" rootname of the observation set +#k cenwave = 1307 Angstroms +#k opt_elem "E140H" grating name +1 2 3 +4 5 6 + +# This example has explicit column definitions as well as a header keyword. +#c rootname ch*9 +#c description ch*15 "" notes +#c cenwave i i4 angstrom +#c texpstrt d f20.8 "Modified Julian Date" +#k opt_elem = E140H +o47s01k9m "lost data" 1234 5.067942601191E+04 +o47s01kbm "" 1416 5.067945625487E+04 +o47s01kdm OK 1598 5.067949325747E+04 + +For a text table that does not contain explicit column definitions (referred +to as a simple text table), the column names are c1, c2, c3, etc., the data +types and print format are inferred from the data, and there are no units. +Columns should be separated by blanks or tabs. The supported data types are +double precision, integer and character string. Use a ":" to separate parts +of a sexagesimal value, e.g. 3:18:26.2. Except as described above, the "#" +sign is the comment character. Each line of the file is treated as a separate +table row (unless the newline is escaped with a backslash), and the total row +length may be as long as 4096 characters. + +The table routines determine the data type of each column in a simple text +table by examining the values in the column. If the value is numerical but +doesn't contain a decimal point, colon, or exponent, the column is taken to +be integer. You can use INDEF for undefined elements in numerical columns +and "" (or quotes enclosing blanks) for undefined string elements. For an +integer column, however, use INDEFI to indicate the data type. All columns +must be defined in the first line; that is, no other line may have more +columns than the first line has. To a certain extent, this serves as a check +to distinguish ordinary text files from text tables. + +For a simple text table, the print format for each column is determined from +the values in that column. (This is a good reason for using explicit column +definitions.) The precision is set by counting digits in each value, including +trailing zeroes. The field width of a column may be increased by inserting +spaces in front of a value in any row, and the precision may be increased by +appending zeroes to any value in the column. An output table or one opened +read-write is written out using this format, and the intention is that the +result should closely resemble the input table, rather than being reformatted +with a lot of extra space and more digits than are useful. G format is used +for floating point data, except that h and m formats (for HH:MM:SS.d and +HH:MM.d respectively) are also supported. This usually works well for tables +containing only numerical data or when the string columns follow the numerical +columns. Problems determining the field width typically arise when a floating +point column follows a string column, and the strings vary in length. In this +case, each time you open the table read-write the width of the floating point +column expands because of the extra space after the shortest string in the +previous string column. A hard upper limit to the width of about 25 stops +the expansion eventually. + +A character string in an input text table must be quoted if the string +contains whitespace, so that the table I/O routines will be able to tell +that the whole phrase is one table element. This is the case regardless +of whether the table contains explicit column definitions or not. Strings +in an output (or read-write) text table will be enclosed in quotes if they +contain whitespace, when the table is written back to disk. Strings in text +tables may not contain embedded quotes. The upper limit for the length of +a string is 1023 characters (SZ_LINE). + +Blank lines and lines beginning with # are comments (except for the #c and +#k cases described above) and will be ignored on input. For files opened +read-write or new-copy, the comments will be saved and written out at the +beginning of the file. In-line comments are not saved; they will be lost +if a table is opened read-write. + +While the name of a binary table must include an extension, with ".tab" as +the default, the name of a text table need not include an extension. For +this reason it is necessary to specify the extension explicitly for a text +table, even if it is ".tab". STDIN and STDOUT are acceptable names for input +and output text tables, but not for tables opened read-write. Thus you +cannot use STDIN or STDOUT for tcalc because it opens the table read-write. +Other table tools such as tquery, tselect, and tproject can read from STDIN +and write to STDOUT, so you can pipe text through these tasks. + +When running tcalc on a text table, it is generally advisable to create a new +column because the table is modified in-place, and it is possible to clobber +values when changing an existing column. For example, suppose a floating +point column contains three-digit values, and you add 1000000 to that column +using tcalc. The print format could be G6.3, which would be OK for the +original values, but you would need seven digits of precision for the modified +values. The result would be displayed as "1.00E6". Putting the output in a +new column, however, gives you full control over the print format. The +default print format (tcalc.colfmt = "") displays full precision. + +To prevent accidental deletion of text files, tdelete will not delete +text tables unless verify=yes. Tcopy will copy text tables, but it makes +more sense to use copy. + + +Notes about the system subroutines: + +While a text table is being read into memory (by tbzopn), tbcadd is called +to "create" columns, which means that column descriptors are allocated and +filled in, and memory is allocated for the column data. This may be done +even if the table is opened read-only, but we can't call tbcdef for a +read-only table. + +The upper limit on the line length for an input text table is set to 4096 +in tbltext.h. The macro SZ_TEXTBUF is SZ_LINE longer than 4096 because of +the way getlline works. + +BUGS: + +Get text, put text for a non-text input column but text output column does not +work very well. The value is sometimes lost off the end of the string. + +Summary of the text table routines: + +tbzgt.x get element; called by tbegt, tbzcg. +tbzpt.x put element; called by tbept, tbzcp. + +tbzopn.x read an existing text table into memory; + called by tbuopn; calls tbzsub, tbzrds, tbzrdx. +tbzsub.x determines table subtype (explicit or simple); + called by tbzopn; calls tbzlin, tbzkey, tbbcmt. +tbzrds.x read a simple text table into memory; + called by tbzopn; calls tbzlin, tbbcmt, tbzkey, tbzcol, tbzmem. +tbzrdx.x read a text table with explicit column definitions into memory; + called by tbzopn; calls tbzlin, tbbcmt, tbzkey, + tbbecd, tbcadd, tbzmex. +tbzlin.x read (getlline) a line of text, check if comment; + called by tbzsub, tbzrds, tbzrdx. +tbzcol.x define columns (except for print format) based on + values in first row; called by tbzrds; calls tbbwrd, tbcadd. +tbzmem.x read values from line and copy to memory; update info + for print format; called by tbzrds; calls tbbwrd, + tbzt2t, tbzd2t, tbzi2t, tbzi2d, tbzpbt. +tbzmex (in tbzmem.x) reads values from one line, for a table with explicit + column definitions; called by tbzrdx; calls tbzpbt. + +tbbwrd.x read one "word" from input line; interpret as to data type, + field width and precision. +tbzd2t.x change data type of a column from double to text, used + when actual data type was not clear from first row; + called by tbzmem. +tbzi2d.x change data type of a column from integer to double; + called by tbzmem. +tbzi2t.x change data type of a column from integer to character; + called by tbzmem. +tbzt2t.x increase allocated width of a character column; + called by tbzmem. + +tbznew.x open a new text file and call tbzadd to allocate memory + for each column for which we have a descriptor; + called by tbtcre; calls tbzadd. + +tbzadd.x check (& correct) data type; allocate memory for column + values and assign INDEF to each element; + called by tbcadd and tbznew. + +tbzsiz.x reallocate buffers for column values to change the + allocated size (number of rows) of a text table; + called by tbtchs. + +tbzsft.x shift a set of rows either up or down; + called by tbrsft; calls tbznll. + +tbznll.x set all columns in a range of rows to INDEF; called by tbzsft +tbzudf.x set specified columns to INDEF in one row; called by tbrudf. + +tbzclo.x call tbzwrt and deallocate memory; + called by tbtclo; calls tbzwrt. +tbzwrt.x write column values back to text file, and close the file; + called by tbzclo. diff --git a/pkg/tbtables/doc/versions.doc b/pkg/tbtables/doc/versions.doc new file mode 100644 index 00000000..256d8886 --- /dev/null +++ b/pkg/tbtables/doc/versions.doc @@ -0,0 +1,29 @@ + 1999 August 17 + +This file describes changes in the STSDAS table format for the various +software versions, from 0 to 3. For an STSDAS table, the software version +number can be found in the size-information record; see fileformat.doc. + +version = 0 (before stsdas and tables package version 1.3): +This is the original version. Data types supported were single and double +precision real, integer, logical, and character strings. Each table element +was a multiple of four bytes in length (i.e. the size of single precision +real, integer, or logical). The row length was also a multiple of four +bytes. Data type short (integer*2) was not supported. + +version = 1 (1993 May 5, tables package version 1.3): +Data type short is supported, and the length of a character string is rounded +up to a multiple of two instead of four. The row length (used or allocated) +can be an odd multiple of SZ_CHAR (i.e. a multiple of two bytes instead of +four bytes). + +version = 2 (1995 Oct 11, tables package version 1.3.4): +Header parameters can have associated comments. The value of a header +parameter that is of type text may optionally be enclosed in single quotes; +this is to allow a comment following the value. Header parameters with +keyword HISTORY, COMMENT or blank are not in quotes and may not have comments. + +version = 3 (1998 Apr 14, tables package version 2.0.2): +The character strings in column definitions can have one more character +than before. This was done by not including the end-of-string character if +the string fills the available space. diff --git a/pkg/tbtables/fitsio/README b/pkg/tbtables/fitsio/README new file mode 100644 index 00000000..750f9700 --- /dev/null +++ b/pkg/tbtables/fitsio/README @@ -0,0 +1,11 @@ +# These routines are part of the FITSIO library and are designed to run in +# the IRAF/SPP environment. +#------------------------------------------------------------------------------ +# This software was prepared by High Energy Astrophysics Science Archive +# Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +# shall not, without prior written permission of the U.S. Government, +# establish a claim to statutory copyright. The Government and others acting +# on its behalf shall have a royalty-free, non-exclusive, irrevocable, +# worldwide license for Government purposes to publish, distribute, +# translate, copy, exhibit, and perform such material. +#------------------------------------------------------------------------------ diff --git a/pkg/tbtables/fitsio/fitsspp.com b/pkg/tbtables/fitsio/fitsspp.com new file mode 100644 index 00000000..04e4ad79 --- /dev/null +++ b/pkg/tbtables/fitsio/fitsspp.com @@ -0,0 +1,23 @@ +# FITSSPP.COM -- Common block definitions used in fitsspp.x. + +define NB 20 # number of file buffers +define NE 200 # maximun allowed number of extensions + # in the FITS files +define MAXFILES 199 # more than needed + +# The following common is used throughout the fitsio code. +int bufnum, chdu, hdutyp, maxhdu, hdstrt, hdend, nxthdr, dtstrt +int nxtfld +bool wrmode + +common /ft0001/ bufnum[MAXFILES],chdu[NB],hdutyp[NB],maxhdu[NB], + wrmode[NB],hdstrt[NB,NE],hdend[NB],nxthdr[NB],dtstrt[NB],nxtfld + +int compid +common /ftcpid/compid + +int buflun, reclen, bytnum, filesize, recnum, bufid + +common /ftsbuf/buflun[NB],reclen[NB], + bytnum[NB],filesize[NB],recnum[NB],bufid[MAXFILES] + diff --git a/pkg/tbtables/fitsio/fitsspp.x b/pkg/tbtables/fitsio/fitsspp.x new file mode 100644 index 00000000..436ba4d6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitsspp.x @@ -0,0 +1,831 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include +include + +#------------------------------------------------------------------------------ +# FITSSPP.X - IRAF/SPP interface for FITSIO. +# These routines are part of the FITSIO library and are designed to run in +# the IRAF/SPP environment. +# +# FTOPNX -- Open or create a file. NOTE: calls ieesnan[rd] +# FTCLSX -- Close a file opened with FTOPNX. +# FTFLSH -- dummy routine to flush a file to disk. Not needed in IRAF. +# +# FTGSDT -- Get the current date and time. +# +# FTMBYT -- move internal file pointer to specified byte +# FTMOFF -- offset internal file pointer to specified byte +# +# FTPI2B -- Write an array of Integer*2 bytes to the output FITS file. +# FTPI4B -- Write an array of Integer*4 bytes to the output FITS file. +# FTPR4B -- Write an array of Real*4 bytes to the output FITS file. +# FTPR8B -- Write an array of Real*8 bytes to the output FITS file. +# +# FTGI2B -- Read an array of Integer*2 bytes from the input FITS file. +# FTGI4B -- Read an array of Integer*4 bytes from the input FITS file. +# FTGR4B -- Read an array of Real*4 bytes from the input FITS file. +# FTGR8B -- Read an array of Real*8 bytes from the input FITS file. +# +# FTUPCH -- Convert input string to upper case. +# +# FTPBYT -- Write a byte sequence to a file. +# FTPCBF -- Write a sequence of characters to a file. (see unix/ or [.vms]) +# +# FTGBYT -- Read a byte sequence from a file. +# FTGCBF -- Read a sequence of characters from a file. (see unix/ or [.vms]) +# +# FTWRIT -- Write a sequence of bytes to a file +# FTREAD -- Read a sequence of bytes from a file +#------------------------------------------------------------------------------ +# This software was prepared by High Energy Astrophysic Science Archive +# Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +# shall not, without prior written permission of the U.S. Government, +# establish a claim to statutory copyright. The Government and others acting +# on its behalf, shall have a royalty-free, non-exclusive, irrevocable, +# worldwide license for Government purposes to publish, distribute, +# translate, copy, exhibit, and perform such material. +#------------------------------------------------------------------------------ + +define SZ_FITSREC 1440 # FITS record size in chars + +# FTOPNX -- Open or create a file. + +procedure ftopnx (funit, pkname, oldnew, rwmode, block, status) + +int funit #I Fortran I/O unit number +% character*(*) pkname +int oldnew #I file status: 0 = existing file; else new file +int rwmode #I file access mode: 0 = readonly; else = read/write +int block #O FITS record blocking factor +int status #U returned error status (0=ok) + +bool firsttime +int mode, i, nbuff, fd +char fname[SZ_PATHNAME] +int access(), open() +int fstati() +include "fitsspp.com" +data firsttime /true/ + +begin + if (status > 0) + return + + # Initialize fitsspp common. + if (firsttime) { + nxtfld=0 + call aclri (buflun, NB) + firsttime = false + } + + # Determine at run time what type of machine we are running on. + call ftarch(compid) + if (compid == 4) + compid=3 + + # Set the values for real and double undefined values, and turn on + # conversion between IEEE NaN and IRAF INDEF. (added by PEH) + # NOTE: This has a global effect for any task in any executable + # that is linked with this (ftopnx) routine. + call ieesnanr (INDEFR) + call ieesnand (INDEFD) + + # Check for valid unit number. + if (funit < 1 || funit > 199) { + status = 101 + return + } + + # Find available buffer slot for this file. + nbuff = ERR + do i = 1, NB { + if (buflun[i] == 0) { + nbuff = i + break + } + } + + # Error: no vacant buffer slots left. + if (nbuff == ERR) { + status = 102 + return + } + + # Convert Fortran string to an SPP string. + call f77upk (pkname, fname, SZ_PATHNAME) + + # Get the file access mode. + if (oldnew == 0) { + # Test if file exists. + if (access (fname, 0,0) == NO) { + # Error: file doesn't exist. + status = 103 + return + } + + # Set the access mode. + if (rwmode == 0) + mode = READ_ONLY + else + mode = READ_WRITE + + # Set the FITS blocking factor. + block = 1 + } else + mode = NEW_FILE + + # Open the file. + iferr (fd = open (fname, mode, BINARY_FILE)) { + if (oldnew == 0) + status = 104 + else + status = 105 + return + } + + # advise fio that the I/O will be primarily sequential + call fseti (fd, F_ADVICE, SEQUENTIAL) + + # Store the current size of the file + filesize[nbuff] = fstati (fd, F_FILESIZE) + + # Initialize the HDU parameters + bufnum[funit] = nbuff + chdu[nbuff] = 1 + hdutyp[nbuff] = 0 + maxhdu[nbuff] = 1 + hdstrt[nbuff,1] = 0 + hdend[nbuff] = 0 + nxthdr[nbuff] = 0 + # Data start location is undefined. + dtstrt[nbuff] = -1000000000 + + buflun[nbuff] = funit + reclen[nbuff] = 2880 + recnum[nbuff] = 0 + bytnum[nbuff] = 2880 + + wrmode[nbuff] = (rwmode != 0) + + bufid[funit] = fd +end + +# FTCLSX -- Close a file opened with FTOPNX. + +procedure ftclsx (iunit, keep, status) + +int iunit #I Fortran I/O unit number +bool keep #I keep the file (or delete it)? +int status #U returned error status (0=ok) + +int fd +int nbuff +char fname[SZ_PATHNAME] +include "fitsspp.com" + +begin + fd = bufid[iunit] + nbuff = bufnum[iunit] + + if (keep) { + iferr (call close(fd)) +# set error code, if it has not previous been set + if (status <= 0) status = 110 + } else { + call fstats (fd, F_FILENAME, fname, SZ_PATHNAME) + iferr (call close(fd)) +# set error code, if it has not previous been set + if (status <= 0) status = 110 + +# now delete the file + call delete (fname) + } + + bufnum[iunit] = 0 + buflun[nbuff] = 0 +end + +# FTFLSH -- dummy routine to flush a file to disk. Not needed in IRAF. + +procedure ftflsh (nbuff, status) + +int nbuff #I number of the buffer to be written +int status #U output error status + +begin +end + +# FTGSDT -- Get the current date and time. + +procedure ftgsdt (dd, mm, yy, status) + +int dd #O day of the month (1-31) +int mm #O month of the year (1-12) +int yy #O last 2 digits of the year (1992 = 92, 2001 = 01) +int status #U returned error status + +int itime +int tm[LEN_TMSTRUCT] +int clktime() + +begin + if (status > 0) + return + + itime = clktime (0) + call brktime (itime, tm) + + dd = TM_MDAY(tm) + mm = TM_MONTH(tm) + yy = mod (TM_YEAR(tm), 100) +end + +# FTMBYT -- move internal file pointer to specified byte + +procedure ftmbyt (iunit, bytno, igneof, status) + +int iunit #I fortran I/O unit number +int bytno #I byte to move to +bool igneof #I ignore moves past EOF? +int status #U output error status + +int nbuff +include "fitsspp.com" + +begin + if (status > 0) + return + + nbuff = bufnum[iunit] + + recnum[nbuff] = (bytno / reclen[nbuff]) + 1 + bytnum[nbuff] = mod ((bytno), reclen[nbuff]) + + if ((bytno >= (filesize[nbuff] * SZB_CHAR)) && !(igneof) ) + status = 107 +end + +# FTMOFF -- offset internal file pointer to specified byte + +procedure ftmoff (iunit, offset, igneof, status) + +int iunit #I fortran I/O unit number +int offset #I number of byte to move +bool igneof #I ignore moves past EOF? +int status #U output error status + +int nbuff,bytno +include "fitsspp.com" + +begin + if (status > 0) + return + + nbuff = bufnum[iunit] + bytno = ((recnum[nbuff]-1) * reclen[nbuff]) + bytnum[nbuff] + offset + + recnum[nbuff] = (bytno / reclen[nbuff]) + 1 + bytnum[nbuff] = mod ((bytno), reclen[nbuff]) + + if ((bytno >= (filesize[nbuff] * SZB_CHAR)) && !(igneof) ) + status = 107 +end + +# FTPI2B -- Write an array of Integer*2 bytes to the output FITS file. +# Does any required translation from internal machine format to FITS. + +procedure ftpi2b (ounit, nvals, incre, i2vals, status) + +int ounit #I fortran I/O unit number +int nvals #I number of pixels in the i2vals array +int incre #I byte increment between values +short i2vals[ARB] #I array of input integer*2 values +int status #U output error status + +int i +int offset + +begin + call miipak(i2vals,i2vals,nvals,TY_SHORT,MII_SHORT) + + if (incre .le. 2) + call ftpbyt(ounit,nvals*2,i2vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-2 + call ftpbyt(ounit,2,i2vals,status) + do i=2,nvals { + call ftmoff(ounit,offset,true,status) + call ftpbyt(ounit,2,i2vals[i],status) + } + } +end + + +# FTPI4B -- Write an array of Integer*4 bytes to the output FITS file. +# Does any required translation from internal machine format to FITS. + +procedure ftpi4b (ounit, nvals, incre, i4vals, status) + +int ounit #I fortran I/O unit number +int nvals #I number of pixels in the i4vals array +int incre #I byte increment between values +int i4vals[ARB] #I array of input integer*4 values +int status #U output error status + +int i +int offset + +begin + call miipak(i4vals,i4vals,nvals,TY_INT,MII_LONG) + + if (incre .le. 4) + call ftpbyt(ounit,nvals*4,i4vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-4 + call ftpbyt(ounit,4,i4vals,status) + do i=2,nvals { + call ftmoff(ounit,offset,true,status) + call ftpbyt(ounit,4,i4vals[i],status) + } + } +end + + +# FTPR4B -- Write an array of Real*4 bytes to the output FITS file. +# Does any required translation from internal machine format to FITS. + +procedure ftpr4b (ounit, nvals, incre, r4vals, status) + +int ounit #I fortran I/O unit number +int nvals #I number of pixels in the r4vals array +int incre #I byte increment between values +real r4vals[ARB] #I array of input real*4 values +int status #U output error status + +int i +int offset + +begin + call miipak(r4vals,r4vals,nvals,TY_REAL,MII_REAL) + + if (incre .le. 4) + call ftpbyt(ounit,nvals*4,r4vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-4 + call ftpbyt(ounit,4,r4vals,status) + do i=2,nvals { + call ftmoff(ounit,offset,true,status) + call ftpbyt(ounit,4,r4vals[i],status) + } + } +end + + +# FTPR8B -- Write an array of Real*8 bytes to the output FITS file. +# Does any required translation from internal machine format to FITS. + +procedure ftpr8b (ounit, nvals, incre, r8vals, status) + +int ounit #I fortran I/O unit number +int nvals #I number of pixels in the r8vals array +int incre #I byte increment between values +double r8vals[ARB] #I array of input real*8 values +int status #U output error status + +int i +int offset + +begin + call miipak(r8vals,r8vals,nvals,TY_DOUBLE,MII_DOUBLE) + + if (incre .le. 8) + call ftpbyt(ounit,nvals*8,r8vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-8 + call ftpbyt(ounit,8,r8vals,status) + do i=2,nvals { + call ftmoff(ounit,offset,true,status) + call ftpbyt(ounit,8,r8vals[i],status) + } + } +end + + +# FTGI2B -- Read an array of Integer*2 bytes from the input FITS file. +# Does any required translation from FITS to internal machine format + +procedure ftgi2b (iunit, nvals, incre, i2vals, status) + +int iunit #I fortran I/O unit number +int nvals #I number of pixels in the i2vals array +int incre #I byte increment between values +short i2vals[ARB] #O array of output integer*2 values +int status #U output error status + +int i +int offset + +begin + if (incre .le. 2) + call ftgbyt(iunit,nvals*2,i2vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-2 + call ftgbyt(iunit,2,i2vals,status) + do i=2,nvals { + call ftmoff(iunit,offset,false,status) + call ftgbyt(iunit,2,i2vals[i],status) + } + } + call miiupk(i2vals,i2vals,nvals,MII_SHORT,TY_SHORT) +end + + +# FTGI4B -- Read an array of Integer*4 bytes from the intput FITS file. +# Does any required translation from FITS to internal machine format + +procedure ftgi4b (iunit, nvals, incre, i4vals, status) + +int iunit #I fortran I/O unit number +int nvals #I number of pixels in the i4vals array +int incre #I byte increment between values +int i4vals[ARB] #O array of output integer*4 values +int status #U output error status + +int i +int offset + +begin + if (incre .le. 4) + call ftgbyt(iunit,nvals*4,i4vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-4 + call ftgbyt(iunit,4,i4vals,status) + do i=2,nvals { + call ftmoff(iunit,offset,false,status) + call ftgbyt(iunit,4,i4vals[i],status) + } + } + call miiupk(i4vals,i4vals,nvals,MII_LONG,TY_INT) +end + + +# FTGR4B -- Read an array of Real*4 bytes from the intput FITS file. +# Does any required translation from FITS to internal machine format + +procedure ftgr4b (iunit, nvals, incre, r4vals, status) + +int iunit #I fortran I/O unit number +int nvals #I number of pixels in the r4vals array +int incre #I byte increment between values +real r4vals[ARB] #O array of output real*4 values +int status #U output error status + +int i +int offset + +begin + if (incre .le. 4) + call ftgbyt(iunit,nvals*4,r4vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-4 + call ftgbyt(iunit,4,r4vals,status) + do i=2,nvals { + call ftmoff(iunit,offset,false,status) + call ftgbyt(iunit,4,r4vals[i],status) + } + } + call miiupk(r4vals,r4vals,nvals,MII_REAL,TY_REAL) +end + + +# FTGR8B -- Read an array of Real*8 bytes from the intput FITS file. +# Does any required translation from FITS to internal machine format + +procedure ftgr8b (iunit, nvals, incre, r8vals, status) + +int iunit #I fortran I/O unit number +int nvals #I number of pixels in the r8vals array +int incre #I byte increment between values +double r8vals[ARB] #O array of output real*8 values +int status #U output error status + +int i +int offset + +begin + if (incre .le. 8) + call ftgbyt(iunit,nvals*8,r8vals,status) + else { +# offset is the number of bytes to move between each value + offset=incre-8 + call ftgbyt(iunit,8,r8vals,status) + do i=2,nvals { + call ftmoff(iunit,offset,false,status) + call ftgbyt(iunit,8,r8vals[i],status) + } + } + call miiupk(r8vals,r8vals,nvals,MII_DOUBLE,TY_DOUBLE) +end + +# FTUPCH -- Convert input string (a Fortran character string) to upper case. + +procedure ftupch (fstr) + +% character fstr*(*) +char sstr[SZ_LINE] + +begin + call f77upk (fstr, sstr, SZ_LINE) + call strupr (sstr) + call f77pak (sstr, fstr, SZ_LINE) +end + +# FTPBYT -- Write a byte sequence to a file. The sequence may begin on any +# byte boundary and may be any number of bytes long. + +procedure ftpbyt (iunit, nbytes, array, status) + +int iunit #I fortran unit number +int nbytes #I number of bytes to be transferred +char array[ARB] #I input data buffer +int status #U output error status + +int fd, nbuff, fpos, hdtype +int bytes_per_record +include "fitsspp.com" + +begin + # Special cases. + if (status > 0) + return + if (nbytes <= 0) { + status = 306 + return + } + + fd = bufid[iunit] + + # Get byte index in file. + nbuff = bufnum[iunit] + bytes_per_record = reclen[nbuff] + hdtype = hdutyp[nbuff] + + # zero indexed byte position in the file + fpos = bytes_per_record * (recnum[nbuff]-1) + bytnum[nbuff] + + # Write the data. + iferr (call ftwrit (fd, array, hdtype, fpos, nbytes, + filesize[nbuff])) { + status = 107 + return + } + + # Update the FITSIO common to track the new file position. + fpos = fpos + nbytes + + recnum[nbuff] = (fpos / bytes_per_record)+1 + bytnum[nbuff] = mod (fpos, bytes_per_record) +end + +# FTGBYT -- Read a byte sequence from a file. The sequence may begin on any +# byte boundary and may be any number of bytes long. An error status is +# returned if less than the requested amount of data is read. + +procedure ftgbyt (iunit, nbytes, array, status) + +int iunit #I fortran unit number +int nbytes #I number of bytes to be transferred +char array[ARB] #O output data buffer +int status #U output error status + +int bytes_per_record +int fd, nbuff, fpos, nb +int ftread() +include "fitsspp.com" + +begin + # Special cases. + if (status > 0 || nbytes == 0) + return + if (nbytes < 0) { + status = 306 + return + } + + fd = bufid[iunit] + + # Get byte index in file. + nbuff = bufnum[iunit] + bytes_per_record = reclen[nbuff] + + # zero indexed byte position in the file + fpos = bytes_per_record * (recnum[nbuff]-1) + bytnum[nbuff] + + # Read the data. + iferr (nb = ftread (fd, array, fpos, nbytes)) { + status = 107 + return + } else if (nb != nbytes) { + status = 107 + } + + # Update the FITSIO common to track the new file position. + fpos = fpos + max (0, nb) + + recnum[nbuff] = (fpos / bytes_per_record)+1 + bytnum[nbuff] = mod (fpos, bytes_per_record) +end + +# FTWRIT -- Write a sequence of bytes to a file at the indicated +# position. The sequence can begin at any byte and can be any number of +# bytes long. +# +# This routine could be implemented more efficiently using fwritep to +# directly access the file buffer for unaligned transfers, but so long +# as most transfers are aligned the following code is as fast as anything. + +procedure ftwrit (fd, ibuf, hdtype, fpos, nbytes, fsize) + +int fd #I file descriptor +char ibuf[ARB] #I data buffer +int hdtype #I type of HDU (1=ASCII table) +int fpos #I starting byte (0 index) in output file +int nbytes #I number of bytes to transfer +int fsize #I current size of the file + +char ch +pointer sp, bp +int start_char, endchr +int nchars, boff, junk, bufsize, nc +errchk getc, seek, write, malloc +char getc() + +bool initialized +char blanks[SZ_FITSREC], zeros[SZ_FITSREC] +data initialized /false/ + +begin + call smark (sp) + + # The first time we are called initialize the empty (blank or + # zero fill) FITS records. + + if (!initialized) { + bufsize = SZ_FITSREC * SZB_CHAR + call malloc (bp, bufsize, TY_CHAR) + + ch = ' ' + call amovkc (ch, Memc[bp], bufsize) + call achtcb (Memc[bp], blanks, bufsize) + call aclrc (zeros, SZ_FITSREC) + + call mfree (bp, TY_CHAR) + initialized = true + } + + # Get index of first and last file chars. + start_char = fpos / SZB_CHAR + 1 + endchr = (fpos+nbytes - 1) / SZB_CHAR + 1 + nchars = endchr - start_char + 1 + boff = mod (fpos, SZB_CHAR) + + # If write starting point is beyond the end of file, + # then insert fill bytes from the current end of file to + # the starting point. + + if (start_char > fsize+1) { + + # Extend the file, using blank or zero fill. Blank fill is + # used for ascii tables (hdtype=1) otherwise zero fill is used. + + call seek (fd, fsize + 1) + while (fsize < start_char) { + nc=min(start_char-fsize, SZ_FITSREC) + if (hdtype == 1) + call write (fd, blanks, nc) + else + call write (fd, zeros, nc) + + fsize = fsize + nc + } + } + + # If things are nicely aligned write data directly to the output file + + if (boff == 0 && mod(nbytes,SZB_CHAR) == 0) { + call seek (fd, start_char) + call write (fd, ibuf, nchars) + + } else { + + # Allocate intermediate buffer. + call salloc (bp, nchars, TY_CHAR) + + # Get any partial chars at ends of sequence. + if (boff > 0) { + call seek (fd, start_char) + junk = getc (fd, Memc[bp]) + } + if (mod (fpos+nbytes, SZB_CHAR) != 0) { + if (endchr > fsize) { + # off end of file, so add correct fill value to last char + if (hdtype == 1) + Memc[bp+nchars-1]=blanks[1] + else + Memc[bp+nchars-1]=0 + } else { + # read existing byte in file, and insert the char + call seek (fd, endchr) + junk = getc (fd, Memc[bp+nchars-1]) + } + } + + # Insert data segment into buffer. + call bytmov (ibuf, 1, Memc[bp], boff + 1, nbytes) + + # Write edited sequence to output file. + call seek (fd, start_char) + call write (fd, Memc[bp], nchars) + } + + fsize=max(fsize,endchr) + + # Now, if file is not a multiple of 2880 bytes long, pad it with fill + + nc=SZ_FITSREC - mod(fsize, SZ_FITSREC) + if (nc .ne. SZ_FITSREC) { + + call seek (fd, fsize + 1) + if (hdtype == 1) + call write (fd, blanks, nc) + else + call write (fd, zeros, nc) + fsize = fsize + nc + } + + call sfree (sp) +end + +# FTREAD -- Read a sequence of bytes from a file at the indicated +# position. The sequence can begin at any byte and can be any number of +# bytes long. +# +# This routine could be implemented more efficiently using freadp to +# directly access the file buffer for unaligned transfers, but so long +# as most transfers are aligned the following code is as fast as anything. + +int procedure ftread (fd, obuf, fpos, nbytes) + +int fd #I file descriptor +char obuf[ARB] #O output buffer +int fpos #I starting byte (zero index) in input file +int nbytes #I number of bytes to transfer + +pointer sp, bp +int start_char, endchr +int nchars, boff, iostat, nout +int read() +errchk read + +begin + # Get index of first and last file chars. + start_char = fpos / SZB_CHAR + 1 + endchr = (fpos+nbytes - 1) / SZB_CHAR + 1 + nchars = endchr - start_char + 1 + boff = mod (fpos, SZB_CHAR) + + # If things are nicely aligned read data directly into the output + # buffer and we are done. + + call seek (fd, start_char) + if (boff == 0 && mod(nbytes,SZB_CHAR) == 0) + return (read (fd, obuf, nchars) * SZB_CHAR) + + # Allocate intermediate buffer. + call smark (sp) + call salloc (bp, nchars, TY_CHAR) + + # Read raw file segment. + iostat = read (fd, Memc[bp], nchars) + if (iostat == EOF) { + call sfree (sp) + return (0) + } + + # Extract and return desired bytes. + nout = min (nbytes, iostat * SZB_CHAR - boff) + call bytmov (Memc[bp], boff + 1, obuf, 1, nout) + + call sfree (sp) + return (nout) +end diff --git a/pkg/tbtables/fitsio/fitssppb/README b/pkg/tbtables/fitsio/fitssppb/README new file mode 100644 index 00000000..a0207701 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/README @@ -0,0 +1,14 @@ +# These routines are part of the FITSIO library and are designed to run in +# the IRAF/SPP environment. +#------------------------------------------------------------------------------ +# This software was prepared by High Energy Astrophysics Science Archive +# Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +# shall not, without prior written permission of the U.S. Government, +# establish a claim to statutory copyright. The Government and others acting +# on its behalf shall have a royalty-free, non-exclusive, irrevocable, +# worldwide license for Government purposes to publish, distribute, +# translate, copy, exhibit, and perform such material. +#------------------------------------------------------------------------------ +# +# In the standard FITSIO distribution, the SPP source files in this +# directory are contained in a single file, fitssppb.x. diff --git a/pkg/tbtables/fitsio/fitssppb/fitsio.h b/pkg/tbtables/fitsio/fitssppb/fitsio.h new file mode 100644 index 00000000..1bb75ded --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fitsio.h @@ -0,0 +1,15 @@ +# This file contains the global defines for the IRAF/SPP version of FITSIO. +# (This is not a C header file) +# SZ_FTTYPE, SZ_FTFORM, and SZ_FTUNIT were changed on 1999 Mar 10 by PEH + +define SZ_FERRTXT 30 # length of FITSIO error message +define SZ_FKEYWORD 8 # length of keyword name string +define SZ_FSTRVAL 70 # length of keyword value string +define SZ_FCOMMENT 48 # length of keyword comment string +define SZ_FLONGCOMM 72 # length of long keyword comment +define SZ_FCARD 80 # length of 'card' record +define SZ_FTTYPE 70 # length of column name string +define SZ_FTFORM 70 # len of col datatype and display format strings +define SZ_FTUNIT 70 # length of column units string +define SZ_FEXTNAME 24 # length of extension name string +define SZ_FTNULL 16 # length of null value string diff --git a/pkg/tbtables/fitsio/fitssppb/fsadef.x b/pkg/tbtables/fitsio/fitssppb/fsadef.x new file mode 100644 index 00000000..c3b4ea82 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsadef.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsadef(ounit,lenrow,nfield,tbcol,tform,nrows,status) + +# Ascii table data DEFinition +# define the structure of the ASCII table data unit + +int ounit # i output file pointer +int lenrow # o length of a table row +int nfield # i number of fields +int tbcol[ARB] # i beginning volumn +char tform[SZ_FTFORM,ARB] # i column datatype +% character*16 ftform(512) +int nrows # i number of rows +int status # o error status +int i + +begin + +do i=1,nfield + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + +call ftadef(ounit,lenrow,nfield,tbcol,ftform,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsarch.x b/pkg/tbtables/fitsio/fitssppb/fsarch.x new file mode 100644 index 00000000..f5fe6c60 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsarch.x @@ -0,0 +1,9 @@ +include "fitsio.h" + +procedure fsarch(machid) + +int machid # machine ID code + +begin +call ftarch(machid) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsasfm.x b/pkg/tbtables/fitsio/fitssppb/fsasfm.x new file mode 100644 index 00000000..02d00fab --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsasfm.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsasfm(tform,code,width,decims,status) + +char tform[SZ_FTTYPE] +% character ftform*24 +int code,width,decims +int status # o error status + +begin + +call f77pak(tform,ftform,4) +call ftasfm(ftform,code,width,decims,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsbdef.x b/pkg/tbtables/fitsio/fitssppb/fsbdef.x new file mode 100644 index 00000000..ba99ad1e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsbdef.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsbdef(ounit,nfield,tform,pcount,nrows,status) + +# Binary table data DEFinition +# define the structure of the binary table data unit + +int ounit # i output file pointer +int nfield # i number of fields +char tform[SZ_FTFORM,ARB] # i column datatype +% character*16 ftform(512) +int pcount # i number of group parame +int nrows # i number of rows +int status # o error status +int i + +begin + +do i=1,nfield + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + +call ftbdef(ounit,nfield,ftform,pcount,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsbnfm.x b/pkg/tbtables/fitsio/fitssppb/fsbnfm.x new file mode 100644 index 00000000..37ddb13f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsbnfm.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsbnfm(tform,dtype,rcount,width,status) + +# 'Binary Format' +# parse the binary table column format to determine the data +# type and the repeat count (and string width, if it is an ASCII field) + +char tform[SZ_FTFORM] # i column format +% character*16 ftform +int dtype # o datatype code +int rcount # o vector column repeat count +int width # o width of character string +int status # o error status + +begin + +call f77pak(tform ,ftform ,SZ_FTFORM) + +call ftbnfm(ftform,dtype,rcount,width,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsclos.x b/pkg/tbtables/fitsio/fitssppb/fsclos.x new file mode 100644 index 00000000..ddd39b2a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsclos.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsclos(iunit,status) + +# close a FITS file that was previously opened with ftopen or ftinit + +int iunit # i input file pointer +int status # o error status + +begin + +call ftclos(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscmps.x b/pkg/tbtables/fitsio/fitssppb/fscmps.x new file mode 100644 index 00000000..a3261a41 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscmps.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fscmps(templ,strng,casesn,match,exact) + +char templ[SZ_FTTYPE] # i column name template +% character ftemp*24 +char strng[SZ_FTTYPE] # i column name +% character fstrng*24 +bool casesn # i require same case? +bool match # o do the strings match? +bool exact # o is it an exact match? + +begin + +call f77pak(templ,ftemp,SZ_FTTYPE) +call f77pak(strng,fstrng,SZ_FTTYPE) +call ftcmps(ftemp,fstrng,casesn,match,exact) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscmsg.x b/pkg/tbtables/fitsio/fitssppb/fscmsg.x new file mode 100644 index 00000000..d6f0c292 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscmsg.x @@ -0,0 +1,11 @@ +include "fitsio.h" + +procedure fscmsg + +# clear the FITSIO error stack + +begin + + +call ftcmsg +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscopy.x b/pkg/tbtables/fitsio/fitssppb/fscopy.x new file mode 100644 index 00000000..aa508f34 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscopy.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fscopy(iunit,ounit,moreky,status) + +# copies the CHDU from IUNIT to the CHDU of OUNIT. +# This will also reserve space in the header for MOREKY keywords +# if MOREKY > 0. + +int iunit # i input file pointer +int ounit # i output file pointer +int moreky # i how many more keywords +int status # o error status + +begin + +call ftcopy(iunit,ounit,moreky,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscpdt.x b/pkg/tbtables/fitsio/fitssppb/fscpdt.x new file mode 100644 index 00000000..2da715ff --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscpdt.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fscpdt(iunit,ounit,status) + +# copies the data from IUNIT to the CHDU of OUNIT. + + +int iunit # i input file pointer +int ounit # i output file pointer +int status # o error status + +begin + +call ftcpdt(iunit,ounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscrhd.x b/pkg/tbtables/fitsio/fitssppb/fscrhd.x new file mode 100644 index 00000000..69ae8b9d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscrhd.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fscrhd(iunit,status) + +# 'CReate Header Data unit' +# create, initialize, and move the i/o pointer to a new extension at +# the end of the FITS file. + +int iunit # i input file pointer +int status # o error status + +begin + +call ftcrhd(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdcol.x b/pkg/tbtables/fitsio/fitssppb/fsdcol.x new file mode 100644 index 00000000..25aa36f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdcol.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdcol(ounit,colnum,status) + +# delete column in a table + +int ounit # i output file pointer +int colnum # i column to be deleted +int status # o error status + +begin + +call ftdcol(ounit,colnum,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsddef.x b/pkg/tbtables/fitsio/fitssppb/fsddef.x new file mode 100644 index 00000000..c07bb65a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsddef.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsddef(ounit,bytlen,status) + +# Data DEFinition +# re-define the length of the data unit +# this simply redefines the start of the next HDU + +int ounit # i output file pointer +int bytlen # i length in bytes +int status # o error status + +begin + +call ftddef(ounit,bytlen,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdelt.x b/pkg/tbtables/fitsio/fitssppb/fsdelt.x new file mode 100644 index 00000000..eae6e2f5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdelt.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsdelt(iunit,status) + +# close and delete a FITS file that was previously opened with ftopen or ftinit + +int iunit # i input file pointer +int status # o error status + +begin + +call ftdelt(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdhdu.x b/pkg/tbtables/fitsio/fitssppb/fsdhdu.x new file mode 100644 index 00000000..cb62ad45 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdhdu.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdhdu(iunit,hdutyp,status) + +# delete the CHDU + +int iunit # i input file pointer +int hdutyp # o type of the new CHDU +int status # o error status + +begin + +call ftdhdu(iunit,hdutyp,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdkey.x b/pkg/tbtables/fitsio/fitssppb/fsdkey.x new file mode 100644 index 00000000..5b7dc487 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdkey.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsdkey(iunit,keywrd,status) + +# delete a header keyword + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftdkey(iunit,fkeywr,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdrec.x b/pkg/tbtables/fitsio/fitssppb/fsdrec.x new file mode 100644 index 00000000..fc535fc8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdrec.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdrec(iunit,pos,status) + +# delete a header keyword + +int iunit # i input file pointer +int pos # i position of the keyword to be deleted +int status # o error status + +begin + +call ftdrec(iunit,pos,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdrow.x b/pkg/tbtables/fitsio/fitssppb/fsdrow.x new file mode 100644 index 00000000..dd926469 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdrow.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsdrow(ounit,frow,nrows,status) + +# delete rows in a table + +int ounit # i output file pointer +int frow # first row to delete +int nrows # number of rows +int status # o error status + +begin + +call ftdrow(ounit,frow,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdsum.x b/pkg/tbtables/fitsio/fitssppb/fsdsum.x new file mode 100644 index 00000000..10f43f2e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdsum.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdsum(chksum,comp,sum) + +char chksum[16] +bool comp +double sum +% character fsum*16 + +begin + +call f77pak(chksum,fsum,16) +call ftdsum(fsum,comp,sum) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdtyp.x b/pkg/tbtables/fitsio/fitssppb/fsdtyp.x new file mode 100644 index 00000000..da2ee7f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdtyp.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsdtyp(value,dtype,status) + +# determine datatype of a FITS value field +# This assumes value field conforms to FITS standards and may not +# detect all invalid formats. +# value c input value field from FITS header record only, +# (usually the value field is in columns 11-30 of record) +# The value string is left justified. +# dtype c output type (C,L,I,F) for Character string, Logical, +# Integer, Floating point, respectively + +char value[SZ_FSTRVAL] # i data value +% character*70 fvalue +char dtype # o datatype code +% character*1 fdtype +int status # o error status +char sdtype[1] +begin + +call f77pak(value,fvalue,SZ_FSTRVAL) +call ftdtyp(fvalue,fdtype,status) +call f77upk(fdtype,sdtype,1) +dtype=sdtype[1] +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsesum.x b/pkg/tbtables/fitsio/fitssppb/fsesum.x new file mode 100644 index 00000000..4ed10305 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsesum.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsesum(sum,comp,chksum) + +double sum +bool comp +char chksum[16] +% character fsum*16 + +begin + +call ftesum(sum,comp,fsum) +call f77upk(fsum,chksum,16) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsfiou.x b/pkg/tbtables/fitsio/fitssppb/fsfiou.x new file mode 100644 index 00000000..e87cbf50 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsfiou.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsfiou(iounit,status) + +# Returns an unused I/O unit number which may then be used as input +# to the fsinit or fsopen procedures. + +int iounit # i I/O unit number +int status # o error status + +begin +call ftfiou(iounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2db.x b/pkg/tbtables/fitsio/fitssppb/fsg2db.x new file mode 100644 index 00000000..ee4636eb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2db.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2db(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2db(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2dd.x b/pkg/tbtables/fitsio/fitssppb/fsg2dd.x new file mode 100644 index 00000000..989831c9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2dd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2dd(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of r*8 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +double nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +double array[ARB] # i array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2dd(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2de.x b/pkg/tbtables/fitsio/fitssppb/fsg2de.x new file mode 100644 index 00000000..a8ec666e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2de.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2de(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of real values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +real nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +real array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2de(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2di.x b/pkg/tbtables/fitsio/fitssppb/fsg2di.x new file mode 100644 index 00000000..5f47a303 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2di.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2di(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of i*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +short nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +short array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2di(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2dj.x b/pkg/tbtables/fitsio/fitssppb/fsg2dj.x new file mode 100644 index 00000000..29d7ce3f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2dj.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2dj(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of i*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2dj(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3db.x b/pkg/tbtables/fitsio/fitssppb/fsg3db.x new file mode 100644 index 00000000..be6562a6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3db.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3db(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3db(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3dd.x b/pkg/tbtables/fitsio/fitssppb/fsg3dd.x new file mode 100644 index 00000000..b08eb765 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3dd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3dd(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +double nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +double array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3dd(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3de.x b/pkg/tbtables/fitsio/fitssppb/fsg3de.x new file mode 100644 index 00000000..af302158 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3de.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3de(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of real values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +real nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +real array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3de(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3di.x b/pkg/tbtables/fitsio/fitssppb/fsg3di.x new file mode 100644 index 00000000..3e2fc780 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3di.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3di(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of i*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +short nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +short array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3di(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3dj.x b/pkg/tbtables/fitsio/fitssppb/fsg3dj.x new file mode 100644 index 00000000..857a7a8e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3dj.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3dj(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3dj(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgabc.x b/pkg/tbtables/fitsio/fitssppb/fsgabc.x new file mode 100644 index 00000000..430fed56 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgabc.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgabc(nfield,tform,space,rowlen,tbcol,status) + +# Get ASCII table Beginning Columns +# determine the byte offset of the beginning of each field of a +# ASCII table, and the total width of the table + +int nfield # i number of fields +char tform[SZ_FTFORM,ARB] # i column datatypes +% character*16 ftform(512) +int space # i no. spaces between col +int rowlen # o length of a table row +int tbcol[ARB] # o starting column positions +int status # o error status +int i + +begin + +do i=1,nfield + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + +call ftgabc(nfield,ftform,space,rowlen,tbcol,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgacl.x b/pkg/tbtables/fitsio/fitssppb/fsgacl.x new file mode 100644 index 00000000..09db30a0 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgacl.x @@ -0,0 +1,33 @@ +include "fitsio.h" + +procedure fsgacl(iunit,colnum,ttype,tbcol,tunit,tform, + tscal,tzero,tnull,tdisp,status) + +# Get information about an Ascii table CoLumn +# returns the parameters which define the column + +int iunit # i input file pointer +int colnum # i column number +char ttype[SZ_FTTYPE] # o column name +int tbcol # o starting column position in the row +char tunit[SZ_FTUNIT] # o physical units of the column +char tform[SZ_FTFORM] # o FITS data format of the column +double tscal # o scaling factor +double tzero # o scaling zero point +char tnull[SZ_FTNULL] # o string used to represent null values +char tdisp[SZ_FTFORM] # o Fortran display format +int status # o error status +% character fttype*24, ftunit*24,ftform*16,ftnull*16,ftdisp*16 + +begin + +call ftgacl(iunit,colnum,fttype,tbcol,ftunit,ftform, + tscal,tzero,ftnull,ftdisp,status) + +call f77upk(fttype,ttype,SZ_FTTYPE) +call f77upk(ftunit,tunit,SZ_FTUNIT) +call f77upk(ftform,tform,SZ_FTFORM) +call f77upk(ftnull,tnull,SZ_FTNULL) +call f77upk(ftdisp,tdisp,SZ_FTFORM) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgbcl.x b/pkg/tbtables/fitsio/fitssppb/fsgbcl.x new file mode 100644 index 00000000..b6281f49 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgbcl.x @@ -0,0 +1,32 @@ +include "fitsio.h" + +procedure fsgbcl(iunit,colnum,ttype,tunit,dtype,rcount, + tscal,tzero,tnull,tdisp,status) + +# Get information about a Binary table CoLumn +# returns the parameters which define the column + +int iunit # i input file pointer +int colnum # i column number +char ttype[SZ_FTTYPE] # o column name +char tunit[SZ_FTUNIT] # o physical units of the column +char dtype[SZ_FTFORM] # o datatype code +int rcount # o repeat count for vector column +double tscal # o scaling factor +double tzero # o scaling zero point +int tnull # o integer used to represent null values +char tdisp[SZ_FTFORM] # o Fortran display format +int status # o error status +% character fttype*24, ftunit*24, ftdisp*16, fdtype*16 + +begin + +call ftgbcl(iunit,colnum,fttype,ftunit,fdtype,rcount, + tscal,tzero,tnull,ftdisp,status) + +call f77upk(fttype,ttype,SZ_FTTYPE) +call f77upk(ftunit,tunit,SZ_FTUNIT) +call f77upk(ftdisp,tdisp,SZ_FTFORM) +call f77upk(fdtype,dtype,SZ_FTFORM) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfb.x b/pkg/tbtables/fitsio/fitssppb/fsgcfb.x new file mode 100644 index 00000000..d61d749a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfb.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfb(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of byte values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfb(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfc.x b/pkg/tbtables/fitsio/fitssppb/fsgcfc.x new file mode 100644 index 00000000..9bf07063 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfc.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfc(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of complex values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfc(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfd.x b/pkg/tbtables/fitsio/fitssppb/fsgcfd.x new file mode 100644 index 00000000..3c2b846e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfd(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of r*8 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfd(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfe.x b/pkg/tbtables/fitsio/fitssppb/fsgcfe.x new file mode 100644 index 00000000..8e24508b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfe.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfe(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of R*4 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfe(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfi.x b/pkg/tbtables/fitsio/fitssppb/fsgcfi.x new file mode 100644 index 00000000..566a60d8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfi.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfi(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of I*2 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfi(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfj.x b/pkg/tbtables/fitsio/fitssppb/fsgcfj.x new file mode 100644 index 00000000..cfc7da3f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfj.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfj(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of I*4 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfj(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfl.x b/pkg/tbtables/fitsio/fitssppb/fsgcfl.x new file mode 100644 index 00000000..ce8384ef --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfl.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgcfl(iunit,colnum,frow,felem,nelem,lray, + flgval,anynul,status) + +# read an array of logical values from a specified column of the table. +# The binary table column being read from must have datatype 'L' +# and no datatype conversion will be perform if it is not. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +bool lray[ARB] # o logical array +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfl(iunit,colnum,frow,felem,nelem,lray, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfm.x b/pkg/tbtables/fitsio/fitssppb/fsgcfm.x new file mode 100644 index 00000000..25447f55 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfm.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsgcfm(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of double precision complex values from a specified +# column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfm(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfs.x b/pkg/tbtables/fitsio/fitssppb/fsgcfs.x new file mode 100644 index 00000000..a9f81e22 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfs.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsgcfs(iunit,colnum,frow,felem,nelem,array,dim1, + flgval,anynul,status) + +# read an array of string values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +char array[dim1,ARB] # o array of values +% character farray*256 +int dim1 # i size of 1st dimension of 2D character string array +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status +int i +int elem +bool null + +begin + +anynul=false +elem=felem +do i=1,nelem { + call ftgcfs(iunit,colnum,frow,elem,1,farray,flgval(i),null,status) + if (null) + anynul=true + + call f77upk(farray,array(1,i),dim1) + elem=elem+1 + } +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcks.x b/pkg/tbtables/fitsio/fitssppb/fsgcks.x new file mode 100644 index 00000000..3085ce58 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcks.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsgcks(iunit,datasum,hdusum,status) + +int iunit +double datasum +double hdusum +int status # o error status + +begin + +call ftgcks(iunit,datasum,hdusum,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcl.x b/pkg/tbtables/fitsio/fitssppb/fsgcl.x new file mode 100644 index 00000000..3d3132c2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgcl(iunit,colnum,frow,felem,nelem,lray,status) + +# read an array of logical values from a specified column of the table. +# The binary table column being read from must have datatype 'L' +# and no datatype conversion will be perform if it is not. +# This routine ignores any undefined values in the logical array. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +bool lray[ARB] # o logical array +int status # o error status + +begin + +call ftgcl(iunit,colnum,frow,felem,nelem,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcnn.x b/pkg/tbtables/fitsio/fitssppb/fsgcnn.x new file mode 100644 index 00000000..bd31a11a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcnn.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgcnn(iunit,exact,colnam,realnm,colnum,status) + +# determine the column number corresponding to an input column name. + +int iunit # i input file pointer +bool exact # i require same case? +char colnam[SZ_FTTYPE] # i column name template +% character fcolna*24 +char realnm[SZ_FTTYPE] # o column name +% character frealn*24 +int colnum # o column number +int status # o error status + +begin + +call f77pak(colnam,fcolna,SZ_FTTYPE) +call ftgcnn(iunit,exact,fcolna,frealn,colnum,status) +call f77upk(frealn,realnm,SZ_FTTYPE) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcno.x b/pkg/tbtables/fitsio/fitssppb/fsgcno.x new file mode 100644 index 00000000..a69e0ef1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcno.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsgcno(iunit,exact,colnam,colnum,status) + +# determine the column number corresponding to an input column name. +# this assumes that the first 16 characters uniquely define the name + +int iunit # i input file pointer +bool exact # i require same case? +char colnam[SZ_FTTYPE] # column name +% character fcolna*24 +int colnum # o column number +int status # o error status + +begin + +call f77pak(colnam,fcolna,SZ_FTTYPE) + +call ftgcno(iunit,exact,fcolna,colnum,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcrd.x b/pkg/tbtables/fitsio/fitssppb/fsgcrd.x new file mode 100644 index 00000000..e2ceb9e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcrd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgcrd(iunit,keywrd,card,status) + +# Read the 80 character card image of a specified header keyword record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char card[SZ_FCARD] # o 80-char header record +% character fcard*80 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgcrd(iunit,fkeywr,fcard,status) + +call f77upk(fcard ,card ,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvb.x b/pkg/tbtables/fitsio/fitssppb/fsgcvb.x new file mode 100644 index 00000000..21297842 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvb.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvb(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of byte values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixels +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvb(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvc.x b/pkg/tbtables/fitsio/fitssppb/fsgcvc.x new file mode 100644 index 00000000..1a804e49 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvc.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvc(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of complex values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real nulval[2] # i value for undefined pixels +real array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvc(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvd.x b/pkg/tbtables/fitsio/fitssppb/fsgcvd.x new file mode 100644 index 00000000..860363d7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvd(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of r*8 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double nulval # i value for undefined pixels +double array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvd(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcve.x b/pkg/tbtables/fitsio/fitssppb/fsgcve.x new file mode 100644 index 00000000..3753b0f1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcve.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcve(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of R*4 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real nulval # i value for undefined pixels +real array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcve(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvi.x b/pkg/tbtables/fitsio/fitssppb/fsgcvi.x new file mode 100644 index 00000000..66fd4bf8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvi.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvi(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of I*2 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short nulval # i value for undefined pixels +short array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvi(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvj.x b/pkg/tbtables/fitsio/fitssppb/fsgcvj.x new file mode 100644 index 00000000..8cab67a2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvj.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvj(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of I*4 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixels +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvj(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvm.x b/pkg/tbtables/fitsio/fitssppb/fsgcvm.x new file mode 100644 index 00000000..a787faf0 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvm.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsgcvm(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of double precision complex values from a specified +# column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double nulval[2] # i value for undefined pixels +double array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvm(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvs.x b/pkg/tbtables/fitsio/fitssppb/fsgcvs.x new file mode 100644 index 00000000..b5bd9c05 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvs.x @@ -0,0 +1,41 @@ +include "fitsio.h" + +procedure fsgcvs(iunit,colnum,frow,felem,nelem,nulval,array,dim1,anynul, + status) + +# read an array of string values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=' ', in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +char nulval[SZ_FTNULL] # i value for undefined pixels +% character fnulva*16 +char array[dim1,ARB] # o array of values +% character farray*256 +int dim1 # i size of 1st dimension of 2D character string array +bool anynul # o any null values returned? +int status # o error status +int i +int elem +bool null + +begin + +call f77pak(nulval,fnulva,SZ_FTNULL) + +anynul=false +elem=felem +do i=1,nelem { + call ftgcvs(iunit,colnum,frow,elem,1,fnulva,farray,null,status) + if (null) + anynul=true + + call f77upk(farray,array(1,i),dim1) + elem=elem+1 + } +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcx.x b/pkg/tbtables/fitsio/fitssppb/fsgcx.x new file mode 100644 index 00000000..8cedb3f3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcx.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgcx(iunit,colnum,frow,fbit,nbit,lray,status) + +# read an array of logical values from a specified bit or byte +# column of the binary table. A logical .true. value is returned +# if the corresponding bit is 1, and a logical .false. value is +# returned if the bit is 0. +# The binary table column being read from must have datatype 'B' +# or 'X'. This routine ignores any undefined values in the 'B' array. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int fbit # i first bit +int nbit # i number of bits +bool lray[ARB] # o logical array +int status # o error status + +begin + +call ftgcx(iunit,colnum,frow,fbit,nbit,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcxd.x b/pkg/tbtables/fitsio/fitssppb/fsgcxd.x new file mode 100644 index 00000000..624143d4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcxd.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgcxd(iunit,colnum,frow,nrow,fbit,nbit,dvalue,status) + +# read consecutive bits from 'X' or 'B' column as an unsigned integer + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int nrow # i number of rows +int fbit # i first bit +int nbit # i number of bits +double dvalue[ARB] # o double integer array +int status # o error status + +begin + +call ftgcxd(iunit,colnum,frow,nrow,fbit,nbit,dvalue,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcxi.x b/pkg/tbtables/fitsio/fitssppb/fsgcxi.x new file mode 100644 index 00000000..319146f1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcxi.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgcxi(iunit,colnum,frow,nrow,fbit,nbit,ivalue,status) + +# read consecutive bits from 'X' or 'B' column as an unsigned integer + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int nrow # i number of rows +int fbit # i first bit +int nbit # i number of bits +short ivalue[ARB] # o short integer array +int status # o error status + +begin + +call ftgcxi(iunit,colnum,frow,nrow,fbit,nbit,ivalue,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcxj.x b/pkg/tbtables/fitsio/fitssppb/fsgcxj.x new file mode 100644 index 00000000..a38400bf --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcxj.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgcxj(iunit,colnum,frow,nrow,fbit,nbit,jvalue,status) + +# read consecutive bits from 'X' or 'B' column as an unsigned integer + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int nrow # i number of rows +int fbit # i first bit +int nbit # i number of bits +int jvalue[ARB] # o integer array +int status # o error status + +begin + +call ftgcxj(iunit,colnum,frow,nrow,fbit,nbit,jvalue,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgdes.x b/pkg/tbtables/fitsio/fitssppb/fsgdes.x new file mode 100644 index 00000000..c180304d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgdes.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgdes(iunit,colnum,rownum,nelem,offset,status) + +# read the descriptor values from a binary table. This is only +# used for column which have TFORMn = 'P', i.e., for variable +# length arrays. + +int iunit # i input file pointer +int colnum # i column number +int rownum # i row number +int nelem # o number of elements +int offset # o offset +int status # o error status + +begin + +call ftgdes(iunit,colnum,rownum,nelem,offset,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgerr.x b/pkg/tbtables/fitsio/fitssppb/fsgerr.x new file mode 100644 index 00000000..039454c8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgerr.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsgerr(errnum,text) + +# Return a descriptive error message corresponding to the error number + +int errnum # i error number +char text[SZ_FERRTXT] # i text string +% character ftext*30 + +begin + +call ftgerr(errnum,ftext) + +call f77upk(ftext ,text ,SZ_FERRTXT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpb.x b/pkg/tbtables/fitsio/fitssppb/fsggpb.x new file mode 100644 index 00000000..763d2533 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpb(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # o array of values +int status # o error status + +begin + +call ftggpb(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpd.x b/pkg/tbtables/fitsio/fitssppb/fsggpd.x new file mode 100644 index 00000000..fea28527 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpd(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +double array[ARB] # i array of values +int status # o error status + +begin + +call ftggpd(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpe.x b/pkg/tbtables/fitsio/fitssppb/fsggpe.x new file mode 100644 index 00000000..9ca8b786 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpe.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpe(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +real array[ARB] # i array of values +int status # o error status + +begin + +call ftggpe(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpi.x b/pkg/tbtables/fitsio/fitssppb/fsggpi.x new file mode 100644 index 00000000..4ac34cdf --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpi.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpi(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +short array[ARB] # o array of values +int status # o error status + +begin + +call ftggpi(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpj.x b/pkg/tbtables/fitsio/fitssppb/fsggpj.x new file mode 100644 index 00000000..f5e91a34 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpj(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # i array of values +int status # o error status + +begin + +call ftggpj(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghad.x b/pkg/tbtables/fitsio/fitssppb/fsghad.x new file mode 100644 index 00000000..5511af26 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghad.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsghad(iunit,curadd,nxtadd) + +# delete the CHDU + +int iunit # i input file pointer +int curadd # o starting byte address of the CHDU +int nxtadd # o starting byte address of the next HDU + +begin + +call ftghad(iunit,curadd,nxtadd) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghbn.x b/pkg/tbtables/fitsio/fitssppb/fsghbn.x new file mode 100644 index 00000000..b5122129 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghbn.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsghbn(iunit,maxfld,nrows,nfield,ttype,tform, + tunit,extnam,pcount,status) + +# read required standard header keywords from a binary table extension + +int iunit # i input file pointer +int maxfld # i max. number of fields +int nrows # o number of rows +int nfield # o number of fields +char ttype[SZ_FTTYPE,ARB] # o column name +% character*24 fttype(512) +char tform[SZ_FTFORM,ARB] # o column datatype +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # o column units +% character*16 ftunit(512) +char extnam +% character fextna*48 +int pcount # o size of 'heap' +int status # o error status +int i +int n + +begin + +call ftghbn(iunit,maxfld,nrows,nfield,fttype,ftform, + ftunit,fextna,pcount,status) +n=min(maxfld,nfield) +do i = 1, n + { call f77upk(fttype(i) ,ttype(1,i),SZ_FTTYPE) + call f77upk(ftform(i) ,tform(1,i),SZ_FTFORM) + call f77upk(ftunit(i) ,tunit(1,i),SZ_FTUNIT) + } + +call f77upk(fextna ,extnam,SZ_FEXTNAME) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghdn.x b/pkg/tbtables/fitsio/fitssppb/fsghdn.x new file mode 100644 index 00000000..9748b924 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghdn.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsghdn(iunit,hdunum) + +# return the number of the current header data unit. The +# first HDU (the primary array) is number 1. + +int iunit # i input file pointer +int hdunum # o returned number of the current HDU + +begin + +call ftghdn(iunit,hdunum) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghpr.x b/pkg/tbtables/fitsio/fitssppb/fsghpr.x new file mode 100644 index 00000000..ed0bf343 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghpr.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsghpr(iunit,maxdim,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) + +# get the required primary header or image extension keywords + +int iunit # i input file pointer +int maxdim # i max. number of dimensions +bool simple # o simple FITS file? +int bitpix # o bits per pixel +int naxis # o number of axes +int naxes[ARB] # o dimension of each axis +int pcount # o no. of group parameters +int gcount # o no. of groups +bool extend # o EXTEND keyword = TRUE? +int status # o error status + +begin + +call ftghpr(iunit,maxdim,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghps.x b/pkg/tbtables/fitsio/fitssppb/fsghps.x new file mode 100644 index 00000000..1d431117 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghps.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsghps(ounit,nexist,keyno,status) + +# return the current position in the header + +int ounit # i output file pointer +int nexist # o how many exist? +int keyno # o position of the last keyword that was read + 1 +int status # o error status + +begin + +call ftghps(ounit,nexist,keyno,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghsp.x b/pkg/tbtables/fitsio/fitssppb/fsghsp.x new file mode 100644 index 00000000..916efd3c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghsp.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsghsp(ounit,nexist,nmore,status) + +# Get Header SPace +# return the number of additional keywords that will fit in the header + +int ounit # i output file pointer +int nexist # o how many exist? +int nmore # o this many more will fit +int status # o error status + +begin + +call ftghsp(ounit,nexist,nmore,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghtb.x b/pkg/tbtables/fitsio/fitssppb/fsghtb.x new file mode 100644 index 00000000..3d769a12 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghtb.x @@ -0,0 +1,40 @@ +include "fitsio.h" + +procedure fsghtb(iunit,maxfld,ncols,nrows,nfield,ttype, + tbcol,tform,tunit,extnam,status) + +# read required standard header keywords from an ASCII table extension + +int iunit # i input file pointer +int maxfld # i max. number of fields to return +int ncols # o number of columns +int nrows # o number of rows +int nfield # o number of fields +char ttype[SZ_FTTYPE,ARB] # o column name +% character*24 fttype(512) +int tbcol[ARB] # o starting column position +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int status # o error status +int i +int n + +begin + +call ftghtb(iunit,maxfld,ncols,nrows,nfield,fttype, + tbcol,ftform,ftunit,fextna,status) + +n=min(maxfld,nfield) +do i = 1, n + { call f77upk(fttype(i) ,ttype(1,i),SZ_FTTYPE) + call f77upk(ftform(i) ,tform(1,i),SZ_FTFORM) + call f77upk(ftunit(i) ,tunit(1,i),SZ_FTUNIT) + } + +call f77upk(fextna ,extnam,SZ_FEXTNAME) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgics.x b/pkg/tbtables/fitsio/fitssppb/fsgics.x new file mode 100644 index 00000000..1453e054 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgics.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsgics(iunit,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coord,status) + +int iunit +double xrval,yrval,xrpix,yrpix,xinc,yinc,rot +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call ftgics(iunit,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,fcoord,status) +call f77upk(fcoord,coord,4) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgiou.x b/pkg/tbtables/fitsio/fitssppb/fsgiou.x new file mode 100644 index 00000000..eee38391 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgiou.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsgiou(iounit,status) + +# Returns an unused I/O unit number which may then be used as input +# to the fsinit or fsopen procedures. + +int iounit # o unused I/O unit number +int status # o error status + +begin +call ftgiou(iounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkey.x b/pkg/tbtables/fitsio/fitssppb/fsgkey.x new file mode 100644 index 00000000..a5f2cd52 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkey.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgkey(iunit,keywrd,value,comm,status) + +# Read value and comment of a header keyword from the keyword buffer + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char value[SZ_FSTRVAL] # o keyword value +% character fvalue*70 +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkey(iunit,fkeywr,fvalue,fcomm,status) + +call f77upk(fvalue ,value ,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FCOMMENT) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgknd.x b/pkg/tbtables/fitsio/fitssppb/fsgknd.x new file mode 100644 index 00000000..8a34bb21 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgknd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgknd(iunit,keywrd,nstart,nmax,dval,nfound,status) + +# read an array of real*8 values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +double dval[ARB] # o real*8 value +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgknd(iunit,fkeywr,nstart,nmax,dval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkne.x b/pkg/tbtables/fitsio/fitssppb/fsgkne.x new file mode 100644 index 00000000..b71ba65b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkne.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgkne(iunit,keywrd,nstart,nmax,rval,nfound,status) + +# read an array of real*4 values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +real rval[ARB] # o real*4 values +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkne(iunit,fkeywr,nstart,nmax,rval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgknj.x b/pkg/tbtables/fitsio/fitssppb/fsgknj.x new file mode 100644 index 00000000..7f95bc07 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgknj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgknj(iunit,keywrd,nstart,nmax,intval,nfound,status) + +# read an array of integer values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +int intval[ARB] # o integer values +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgknj(iunit,fkeywr,nstart,nmax,intval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgknl.x b/pkg/tbtables/fitsio/fitssppb/fsgknl.x new file mode 100644 index 00000000..929c1173 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgknl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgknl(iunit,keywrd,nstart,nmax,logval,nfound,status) + +# read an array of logical values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +bool logval[ARB] # o logical values +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgknl(iunit,fkeywr,nstart,nmax,logval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkns.x b/pkg/tbtables/fitsio/fitssppb/fsgkns.x new file mode 100644 index 00000000..b2ad098a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkns.x @@ -0,0 +1,49 @@ +include "fitsio.h" + +procedure fsgkns(iunit,keywrd,nstart,nmax,strval,nfound,status) + +# read an array of character string values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +char strval[SZ_FSTRVAL,ARB] # o string value +% character*70 fstrva +% character*48 comm +% character*8 keynam + +int nfound # o no. of keywords found +int status # o error status +int i +int j + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +nfound=0 +j=nstart + +do i=1,nmax { + call ftkeyn(fkeywr,j,keynam,status) + if (status > 0) + go to 10 + + call ftgkys(iunit,keynam,fstrva,comm,status) + + if (status <= 0) { + nfound=i + call f77upk(fstrva,strval(1,i),SZ_FSTRVAL) + + } else if (status == 202) { +# ignore keyword not found error + status=0 + } + j=j+1 + } + +10 + j=0 +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyd.x b/pkg/tbtables/fitsio/fitssppb/fsgkyd.x new file mode 100644 index 00000000..96ae59a3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyd.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkyd(iunit,keywrd,dval,comm,status) + +# read a double precision value and comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # o real*8 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyd(iunit,fkeywr,dval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkye.x b/pkg/tbtables/fitsio/fitssppb/fsgkye.x new file mode 100644 index 00000000..8442e96b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkye(iunit,keywrd,rval,comm,status) + +# read a real*4 value and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # o real*4 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkye(iunit,fkeywr,rval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyj.x b/pkg/tbtables/fitsio/fitssppb/fsgkyj.x new file mode 100644 index 00000000..2260b3d5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyj.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkyj(iunit,keywrd,intval,comm,status) + +# read an integer value and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # o integer value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyj(iunit,fkeywr,intval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyl.x b/pkg/tbtables/fitsio/fitssppb/fsgkyl.x new file mode 100644 index 00000000..9ba9aea4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyl.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkyl(iunit,keywrd,logval,comm,status) + +# read a logical value and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # o logical value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyl(iunit,fkeywr,logval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyn.x b/pkg/tbtables/fitsio/fitssppb/fsgkyn.x new file mode 100644 index 00000000..7f52b7e4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyn.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsgkyn(iunit,nkey,keywrd,value,comm,status) + +# Read the name, value, and comment of the NKEYth header record +# This routine is useful for reading the entire header, one +# record at a time. + +int iunit # i input file pointer +int nkey # i number of keywords +char keywrd[SZ_FKEYWORD] # o keyword name +% character fkeywr*8 +char value[SZ_FSTRVAL] # o data value +% character fvalue*70 +char comm[SZ_FLONGCOMM] # o keyword comment +% character fcomm*72 +int status # o error status + +begin + +call ftgkyn(iunit,nkey,fkeywr,fvalue,fcomm,status) + +call f77upk(fkeywr ,keywrd ,SZ_FKEYWORD) +call f77upk(fvalue ,value ,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FLONGCOMM) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkys.x b/pkg/tbtables/fitsio/fitssppb/fsgkys.x new file mode 100644 index 00000000..a93a8bcf --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkys.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgkys(iunit,keywrd,strval,comm,status) + +# read a character string value and comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # o string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkys(iunit,fkeywr,fstrva,fcomm,status) + +call f77upk(fstrva,strval,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FCOMMENT) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyt.x b/pkg/tbtables/fitsio/fitssppb/fsgkyt.x new file mode 100644 index 00000000..c3db4645 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyt.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgkyt(iunit,keywrd,intval,dval,comm,status) + +# read an integer value and fractional parts of a keyword value +# and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # o integer value +double dval # o real*8 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyt(iunit,fkeywr,intval,dval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgmsg.x b/pkg/tbtables/fitsio/fitssppb/fsgmsg.x new file mode 100644 index 00000000..7c6f6a2e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgmsg.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsgmsg(text) + +# Return oldest error message from the FITSIO error stack + +char text[SZ_FCARD] # o text string +% character ftext*80 + +begin + +call ftgmsg(ftext) + +call f77upk(ftext ,text ,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfb.x b/pkg/tbtables/fitsio/fitssppb/fsgpfb.x new file mode 100644 index 00000000..941123cb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfb.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfb(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfb(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfd.x b/pkg/tbtables/fitsio/fitssppb/fsgpfd.x new file mode 100644 index 00000000..b222425e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfd(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of r*8 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfd(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfe.x b/pkg/tbtables/fitsio/fitssppb/fsgpfe.x new file mode 100644 index 00000000..91f63dff --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfe.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfe(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of r*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfe(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfi.x b/pkg/tbtables/fitsio/fitssppb/fsgpfi.x new file mode 100644 index 00000000..33ec211c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfi.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfi(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of I*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfi(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfj.x b/pkg/tbtables/fitsio/fitssppb/fsgpfj.x new file mode 100644 index 00000000..2cef04ea --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfj.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfj(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of I*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfj(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvb.x b/pkg/tbtables/fitsio/fitssppb/fsgpvb.x new file mode 100644 index 00000000..f1a8f79d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvb.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvb(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixel +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvb(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvd.x b/pkg/tbtables/fitsio/fitssppb/fsgpvd.x new file mode 100644 index 00000000..d3e9bd9b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvd(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of r*8 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double nulval # i value for undefined pixels +double array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvd(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpve.x b/pkg/tbtables/fitsio/fitssppb/fsgpve.x new file mode 100644 index 00000000..ac7f6e79 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpve.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpve(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of r*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real nulval # i value for undefined pixels +real array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpve(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvi.x b/pkg/tbtables/fitsio/fitssppb/fsgpvi.x new file mode 100644 index 00000000..e68c1625 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvi.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvi(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of i*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short nulval # i value for undefined pixels +short array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvi(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvj.x b/pkg/tbtables/fitsio/fitssppb/fsgpvj.x new file mode 100644 index 00000000..45e55099 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvj.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvj(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of i*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixels +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvj(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgrec.x b/pkg/tbtables/fitsio/fitssppb/fsgrec.x new file mode 100644 index 00000000..440c8bdb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgrec.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsgrec(iunit,nrec,record,status) + +# Read the Nth 80-byte header record +# This routine is useful for reading the entire header, one +# record at a time. + +int iunit # i input file pointer +int nrec # i number of keywords +char record[SZ_FCARD] # o 80-char header record +% character frecor*80 +int status # o error status + +begin + +call ftgrec(iunit,nrec,frecor,status) + +call f77upk(frecor,record,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgrsz.x b/pkg/tbtables/fitsio/fitssppb/fsgrsz.x new file mode 100644 index 00000000..83dca679 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgrsz.x @@ -0,0 +1,35 @@ +include +include "fitsio.h" + +# This was added for compatibility with CFITSIO. + +procedure fsgrsz (iunit, maxrows, status) + + +int iunit # i input file pointer +int maxrows # o number of rows that fit in buffer +int status # o error status +#-- +int fd +int bufsize +int naxis1 +char comm[SZ_FCOMMENT] +int fstati() +include "../fitsspp.com" # in order to get fd from iunit + +begin + call fsgkyj (iunit, "NAXIS1", naxis1, comm, status) + if (status != 0) + return + naxis1 = naxis1 / 2 # convert from bytes to SPP char + + fd = bufid[iunit] + + bufsize = fstati (fd, F_BUFSIZE) + if (naxis1 > 0) { + maxrows = bufsize / naxis1 + maxrows = max (1, maxrows) + } else { + maxrows = bufsize + } +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsdt.x b/pkg/tbtables/fitsio/fitssppb/fsgsdt.x new file mode 100644 index 00000000..8a223280 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsdt.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsgsdt(dd,mm,yy,status) + +# get the current date + +int dd #O day of the month (1-31) +int mm #O month of the year (1-12) +int yy #O last 2 digits of the year (1992 = 92, 2001 = 01) +int status # o error status + +begin +call ftgsdt (dd, mm, yy, status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfb.x b/pkg/tbtables/fitsio/fitssppb/fsgsfb.x new file mode 100644 index 00000000..2f5be792 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfb.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsfb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +# Read a subsection of byte values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfd.x b/pkg/tbtables/fitsio/fitssppb/fsgsfd.x new file mode 100644 index 00000000..3f3fa6c9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsfd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of double precision values from the primary array. +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfe.x b/pkg/tbtables/fitsio/fitssppb/fsgsfe.x new file mode 100644 index 00000000..8360592a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfe.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsfe(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of real values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfe(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfi.x b/pkg/tbtables/fitsio/fitssppb/fsgsfi.x new file mode 100644 index 00000000..13ff31e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfi.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsfi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of Integer*2 values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +short array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfj.x b/pkg/tbtables/fitsio/fitssppb/fsgsfj.x new file mode 100644 index 00000000..255705f2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfj.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsfj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of integer values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvb.x b/pkg/tbtables/fitsio/fitssppb/fsgsvb.x new file mode 100644 index 00000000..4fa8556b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvb.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsvb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +# Read a subsection of byte values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int nulval # i value for undefined pi +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvd.x b/pkg/tbtables/fitsio/fitssppb/fsgsvd.x new file mode 100644 index 00000000..c66993a6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsvd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of double precision values from the primary array. +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +double nulval # i value for undefined pi +double array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsve.x b/pkg/tbtables/fitsio/fitssppb/fsgsve.x new file mode 100644 index 00000000..b65e565f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsve.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsve(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of real values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +real nulval # i value for undefined pi +real array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsve(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvi.x b/pkg/tbtables/fitsio/fitssppb/fsgsvi.x new file mode 100644 index 00000000..37276fd8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvi.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsvi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of Integer*2 values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +short nulval # i value for undefined pi +short array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvj.x b/pkg/tbtables/fitsio/fitssppb/fsgsvj.x new file mode 100644 index 00000000..7c2144f8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvj.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsvj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of integer values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int nulval # i value for undefined pi +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtbb.x b/pkg/tbtables/fitsio/fitssppb/fsgtbb.x new file mode 100644 index 00000000..423300c3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtbb.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgtbb(iunit,frow,fchar,nchars,value,status) + +# read a consecutive string of bytes from an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of bytes +int value[ARB] # o data value +int status # o error status + +begin + +call ftgtbb(iunit,frow,fchar,nchars,value,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtbs.x b/pkg/tbtables/fitsio/fitssppb/fsgtbs.x new file mode 100644 index 00000000..63f13469 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtbs.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsgtbs(iunit,frow,fchar,nchars,svalue,status) + +# read a consecutive string of characters from an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of characters +char svalue[ARB] # o string value +% character fsvalu*256 +int status # o error status +int readfirst +int writefirst +int ntodo +int itodo + +begin + +# since the string may be arbitrarily long, read it in pieces +readfirst=fchar +writefirst=1 +ntodo=nchars +itodo=min(256,ntodo) + +while (itodo > 0) { + call ftgtbs(iunit,frow,readfirst,itodo,fsvalu,status) + call fsupk(fsvalu,svalue[writefirst],itodo) + writefirst=writefirst+itodo + readfirst=readfirst+itodo + ntodo=ntodo-itodo + itodo=min(256,ntodo) + } + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtcl.x b/pkg/tbtables/fitsio/fitssppb/fsgtcl.x new file mode 100644 index 00000000..43dcbd8d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtcl.x @@ -0,0 +1,12 @@ +include "fitsio.h" + +procedure fsgtcl(iunit,colnum,tcode,rpeat,wdth,status) + +int iunit,colnum,tcode,rpeat,wdth +int status # o error status + +begin + +call ftgtcl(iunit,colnum,tcode,rpeat,wdth,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtcs.x b/pkg/tbtables/fitsio/fitssppb/fsgtcs.x new file mode 100644 index 00000000..5ef0818e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtcs.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fsgtcs(iunit,xcol,ycol,xrval,yrval,xrpix,yrpix,xinc,yinc, + rot,coord,status) + +int iunit,xcol,ycol +double xrval,yrval,xrpix,yrpix,xinc,yinc,rot +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call ftgtcs(iunit,xcol,ycol,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + fcoord,status) +call f77upk(fcoord,coord,4) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtdm.x b/pkg/tbtables/fitsio/fitssppb/fsgtdm.x new file mode 100644 index 00000000..d2482b08 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtdm.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsgtdm(iunit,colnum,maxdim,naxis,naxes,status) + +# read the TDIMnnn keyword + +int iunit # i input file pointer +int colnum # i column number +int maxdim # i maximum number of dimensions to return +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int status # o error status + +begin + +call ftgtdm(iunit,colnum,maxdim,naxis,naxes,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgthd.x b/pkg/tbtables/fitsio/fitssppb/fsgthd.x new file mode 100644 index 00000000..c7ff0e71 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgthd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgthd(tmplat,card,hdtype,status) + +# 'Get Template HeaDer' +# parse a template header line and create a formated +# 80-character string which is suitable for appending to a FITS header + +char tmplat[ARB] # i template string +% character ftmpla*100 +char card[SZ_FCARD] # o 80-char header record +% character fcard*80 +int hdtype # o hdu type code +int status # o error status + +begin + +call f77pak(tmplat,ftmpla,100) + +call ftgthd(ftmpla,fcard,hdtype,status) + +call f77upk(fcard ,card ,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fshdef.x b/pkg/tbtables/fitsio/fitssppb/fshdef.x new file mode 100644 index 00000000..56ceab74 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fshdef.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fshdef(ounit,moreky,status) + +# Header DEFinition +# define the size of the current header unit; this simply lets +# us determine where the data unit will start + +int ounit # i output file pointer +int moreky # i reserve space for this many more keywords +int status # o error status + +begin + +call fthdef(ounit,moreky,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsibin.x b/pkg/tbtables/fitsio/fitssppb/fsibin.x new file mode 100644 index 00000000..ee585149 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsibin.x @@ -0,0 +1,35 @@ +include "fitsio.h" + +procedure fsibin(ounit,nrows,nfield,ttype,tform,tunit, + extnam,pcount,status) + +# insert a binary table extension + +int ounit # i output file pointer +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int pcount # i size of 'heap' +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftibin(ounit,nrows,nfield,fttype,ftform,ftunit, + fextna,pcount,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsicol.x b/pkg/tbtables/fitsio/fitssppb/fsicol.x new file mode 100644 index 00000000..500aeb62 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsicol.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsicol(ounit,colnum,ttype,tform,status) + +# insert column in a table + +int ounit # i output file pointer +int colnum # i column to be inserted +char ttype[SZ_FTTYPE] # i column name +% character*24 ftype +char tform[SZ_FTFORM] # i column data format +% character*16 fform +int status # o error status + +begin + +call f77pak(ttype ,ftype,SZ_FTTYPE) +call f77pak(tform ,fform,SZ_FTFORM) + +call fticol(ounit,colnum,ftype,fform,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsiimg.x b/pkg/tbtables/fitsio/fitssppb/fsiimg.x new file mode 100644 index 00000000..78d224fb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsiimg.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsiimg(ounit,bitpix,naxis,naxes,status) + +# insert an IMAGE extension + +int ounit # i output file pointer +int bitpix # i bits per pixel +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int status # o error status + +begin + +call ftiimg(ounit,bitpix,naxis,naxes,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyd.x b/pkg/tbtables/fitsio/fitssppb/fsikyd.x new file mode 100644 index 00000000..be4af4f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsikyd(ounit,keywrd,dval,decim,comm,status) + +# insert a double precision value to a header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikye.x b/pkg/tbtables/fitsio/fitssppb/fsikye.x new file mode 100644 index 00000000..a43a1a74 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsikye(ounit,keywrd,rval,decim,comm,status) + +# insert a real*4 value to a header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyf.x b/pkg/tbtables/fitsio/fitssppb/fsikyf.x new file mode 100644 index 00000000..5806ae6d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsikyf(ounit,keywrd,rval,decim,comm,status) + +# insert a real*4 value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyg.x b/pkg/tbtables/fitsio/fitssppb/fsikyg.x new file mode 100644 index 00000000..c5d877e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsikyg(ounit,keywrd,dval,decim,comm,status) + +# insert a double precision value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyj.x b/pkg/tbtables/fitsio/fitssppb/fsikyj.x new file mode 100644 index 00000000..cf8e89f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsikyj(ounit,keywrd,intval,comm,status) + +# insert an integer value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyl.x b/pkg/tbtables/fitsio/fitssppb/fsikyl.x new file mode 100644 index 00000000..f63fd370 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsikyl(ounit,keywrd,logval,comm,status) + +# insert a logical value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikys.x b/pkg/tbtables/fitsio/fitssppb/fsikys.x new file mode 100644 index 00000000..0ad5821e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsikys(ounit,keywrd,strval,comm,status) + +# insert a character string value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsinit.x b/pkg/tbtables/fitsio/fitssppb/fsinit.x new file mode 100644 index 00000000..85cd96de --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsinit.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fsinit(funit,fname,block,status) + +# open a new FITS file with write access + +int funit # i file I/O pointer +char fname[ARB] # i file name +% character ffname*255 +int block # i FITS blocking factor +int status # o error status + +begin + +call f77pak(fname ,ffname,255) + +call ftinit(funit,ffname,block,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsirec.x b/pkg/tbtables/fitsio/fitssppb/fsirec.x new file mode 100644 index 00000000..35f0190c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsirec.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fsirec(ounit,keyno,record,status) + +# insert a character string card record to a header + +int ounit # i output file pointer +int keyno # i number of the keyword to insert before +char record[SZ_FCARD] # i 80-char header record +% character frecor*80 +int status # o error status + +begin + +call f77pak(record,frecor,SZ_FCARD) + +call ftirec(ounit,keyno,frecor,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsirow.x b/pkg/tbtables/fitsio/fitssppb/fsirow.x new file mode 100644 index 00000000..7d735c2c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsirow.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsirow(ounit,frow,nrows,status) + +# insert rows in a table + +int ounit # i output file pointer +int frow # insert rows after this row +int nrows # number of rows +int status # o error status + +begin + +call ftirow(ounit,frow,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsitab.x b/pkg/tbtables/fitsio/fitssppb/fsitab.x new file mode 100644 index 00000000..cf8b852e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsitab.x @@ -0,0 +1,36 @@ +include "fitsio.h" + +procedure fsitab(ounit,ncols,nrows,nfield,ttype,tbcol, + tform,tunit,extnam,status) + +# insert an ASCII table extension + +int ounit # i output file pointer +int ncols # i number of columns +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +int tbcol[ARB] # i starting column position +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftitab(ounit,ncols,nrows,nfield,fttype,tbcol, + ftform,ftunit,fextna,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fskeyn.x b/pkg/tbtables/fitsio/fitssppb/fskeyn.x new file mode 100644 index 00000000..1ce2ff8f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fskeyn.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fskeyn(keywrd,nseq,keyout,status) + +# Make a keyword name by concatinating the root name and a +# sequence number + +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nseq # i keyword sequence no. +char keyout[SZ_FKEYWORD] # o output keyword +% character fkeyou*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftkeyn(fkeywr,nseq,fkeyou,status) + +call f77upk(fkeyou,keyout,SZ_FKEYWORD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmahd.x b/pkg/tbtables/fitsio/fitssppb/fsmahd.x new file mode 100644 index 00000000..61479f04 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmahd.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsmahd(iunit,extno,xtend,status) + +# Move to Absolute Header Data unit +# move the i/o pointer to the specified HDU and initialize all +# the common block parameters which describe the extension + +int iunit # i input file pointer +int extno # i extension number +int xtend # o type of extension +int status # o error status + +begin + +call ftmahd(iunit,extno,xtend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmcom.x b/pkg/tbtables/fitsio/fitssppb/fsmcom.x new file mode 100644 index 00000000..7c762ecd --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmcom.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsmcom(ounit,keywrd,comm,status) + +# modify the comment string in a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char comm[SZ_FLONGCOMM] # i keyword comment +% character fcomm*72 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FLONGCOMM) + +call ftmcom(ounit,fkeywr,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmcrd.x b/pkg/tbtables/fitsio/fitssppb/fsmcrd.x new file mode 100644 index 00000000..a4e3be3f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmcrd.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmcrd(ounit,keywrd,card,status) + +# modify (overwrite) a given header record specified by keyword name. +# This can be used to overwrite the name of the keyword as well as +# the value and comment fields. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char card[SZ_FCARD] # i 80-char header record +% character fcard*80 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(card ,fcard, SZ_FCARD) + +call ftmcrd(ounit,fkeywr,fcard,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyd.x b/pkg/tbtables/fitsio/fitssppb/fsmkyd.x new file mode 100644 index 00000000..3715c59d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsmkyd(ounit,keywrd,dval,decim,comm,status) + +# modify a double precision value header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkye.x b/pkg/tbtables/fitsio/fitssppb/fsmkye.x new file mode 100644 index 00000000..7b6fdeb6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmkye(ounit,keywrd,rval,decim,comm,status) + +# modify a real*4 value header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyf.x b/pkg/tbtables/fitsio/fitssppb/fsmkyf.x new file mode 100644 index 00000000..7b4deb8a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmkyf(ounit,keywrd,rval,decim,comm,status) + +# modify a real*4 value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyg.x b/pkg/tbtables/fitsio/fitssppb/fsmkyg.x new file mode 100644 index 00000000..928e69e1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmkyg(ounit,keywrd,dval,decim,comm,status) + +# modify a double precision value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyj.x b/pkg/tbtables/fitsio/fitssppb/fsmkyj.x new file mode 100644 index 00000000..66ab5bbe --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsmkyj(ounit,keywrd,intval,comm,status) + +# modify an integer value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyl.x b/pkg/tbtables/fitsio/fitssppb/fsmkyl.x new file mode 100644 index 00000000..ba902380 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsmkyl(ounit,keywrd,logval,comm,status) + +# modify a logical value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkys.x b/pkg/tbtables/fitsio/fitssppb/fsmkys.x new file mode 100644 index 00000000..e0417e72 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsmkys(ounit,keywrd,strval,comm,status) + +# modify a character string value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmnam.x b/pkg/tbtables/fitsio/fitssppb/fsmnam.x new file mode 100644 index 00000000..8c7d4e82 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmnam.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsmnam(ounit,oldkey,newkey,status) + +# modify the name of a header keyword + +int ounit # i output file pointer +char oldkey[SZ_FKEYWORD] # i keyword name +% character fokey*8 +char newkey[SZ_FKEYWORD] # i keyword name +% character fnkey*8 +int status # o error status + +begin + +call f77pak(oldkey,fokey,SZ_FKEYWORD) +call f77pak(newkey,fnkey,SZ_FKEYWORD) + +call ftmnam(ounit,fokey,fnkey,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmrec.x b/pkg/tbtables/fitsio/fitssppb/fsmrec.x new file mode 100644 index 00000000..5951427b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmrec.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsmrec(ounit,nkey,record,status) + +# modify the nth keyword in the CHU, by replacing it with the +# input 80 character string. + +int ounit # i output file pointer +int nkey # i number of keyword to be modified +char record[SZ_FCARD] # i 80-char header record +% character frecor*80 +int status # o error status + +begin + +call f77pak(record,frecor,SZ_FCARD) + +call ftmrec(ounit,nkey,frecor,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmrhd.x b/pkg/tbtables/fitsio/fitssppb/fsmrhd.x new file mode 100644 index 00000000..d253bc5b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmrhd.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsmrhd(iunit,extmov,xtend,status) + +# Move Relative Header Data unit +# move the i/o pointer to the specified HDU and initialize all +# the common block parameters which describe the extension + +int iunit # i input file pointer +int extmov # i relative extension number +int xtend # o type of extension +int status # o error status + +begin + +call ftmrhd(iunit,extmov,xtend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsnkey.x b/pkg/tbtables/fitsio/fitssppb/fsnkey.x new file mode 100644 index 00000000..92f7d8fb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsnkey.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsnkey(nseq,keywrd,keyout,status) + +# Make a keyword name by concatinating the root name and a +# sequence number + +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nseq # i keyword sequence no. +char keyout[SZ_FKEYWORD] # o output keyword +% character fkeyou*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftnkey(nseq,fkeywr,fkeyou,status) + +call f77upk(fkeyou,keyout,SZ_FKEYWORD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsopen.x b/pkg/tbtables/fitsio/fitssppb/fsopen.x new file mode 100644 index 00000000..c31f832b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsopen.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsopen(funit,fname,rwmode,block,status) + +# open an existing FITS file with readonly or read/write access + +int funit # i file I/O pointer +char fname[ARB] # i file name +% character ffname*255 +int rwmode # i file read/write mode +int block # i FITS blocking factor +int status # o error status + +begin + +call f77pak(fname ,ffname,255) + +call ftopen(funit,ffname,rwmode,block,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2db.x b/pkg/tbtables/fitsio/fitssppb/fsp2db.x new file mode 100644 index 00000000..5f02278c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2db.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2db(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp2db(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2dd.x b/pkg/tbtables/fitsio/fitssppb/fsp2dd.x new file mode 100644 index 00000000..1ae13748 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2dd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2dd(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +double array[ARB] # i array of values +int status # o error status + +begin + +call ftp2dd(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2de.x b/pkg/tbtables/fitsio/fitssppb/fsp2de.x new file mode 100644 index 00000000..3449af47 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2de.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2de(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +real array[ARB] # i array of values +int status # o error status + +begin + +call ftp2de(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2di.x b/pkg/tbtables/fitsio/fitssppb/fsp2di.x new file mode 100644 index 00000000..7678af53 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2di.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2di(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +short array[ARB] # i array of values +int status # o error status + +begin + +call ftp2di(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2dj.x b/pkg/tbtables/fitsio/fitssppb/fsp2dj.x new file mode 100644 index 00000000..444e4ee4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2dj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2dj(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp2dj(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3db.x b/pkg/tbtables/fitsio/fitssppb/fsp3db.x new file mode 100644 index 00000000..04152f97 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3db.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3db(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp3db(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3dd.x b/pkg/tbtables/fitsio/fitssppb/fsp3dd.x new file mode 100644 index 00000000..35db8e93 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3dd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3dd(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +double array[ARB] # i array of values +int status # o error status + +begin + +call ftp3dd(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3de.x b/pkg/tbtables/fitsio/fitssppb/fsp3de.x new file mode 100644 index 00000000..806f7b02 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3de.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3de(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +real array[ARB] # i array of values +int status # o error status + +begin + +call ftp3de(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3di.x b/pkg/tbtables/fitsio/fitssppb/fsp3di.x new file mode 100644 index 00000000..9f4ac32c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3di.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3di(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +short array[ARB] # i array of values +int status # o error status + +begin + +call ftp3di(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3dj.x b/pkg/tbtables/fitsio/fitssppb/fsp3dj.x new file mode 100644 index 00000000..fc1967e3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3dj.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3dj(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp3dj(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcks.x b/pkg/tbtables/fitsio/fitssppb/fspcks.x new file mode 100644 index 00000000..a5b9039a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcks.x @@ -0,0 +1,11 @@ +include "fitsio.h" + +procedure fspcks(iunit,status) + +int iunit +int status # o error status + +begin + +call ftpcks(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclb.x b/pkg/tbtables/fitsio/fitssppb/fspclb.x new file mode 100644 index 00000000..5a994710 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclb.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspclb(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of unsigned byte data values to the +# specified column of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpclb(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclc.x b/pkg/tbtables/fitsio/fitssppb/fspclc.x new file mode 100644 index 00000000..ac198fa3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclc.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspclc(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of single precision complex data values to the +# specified column of the table. +# The binary table column being written to must have datatype 'C' +# and no datatype conversion will be perform if it is not. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpclc(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcld.x b/pkg/tbtables/fitsio/fitssppb/fspcld.x new file mode 100644 index 00000000..21d413fa --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcld.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspcld(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of double precision data values to the specified column +# of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpcld(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcle.x b/pkg/tbtables/fitsio/fitssppb/fspcle.x new file mode 100644 index 00000000..9727c8ea --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcle.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspcle(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of real data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpcle(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcli.x b/pkg/tbtables/fitsio/fitssppb/fspcli.x new file mode 100644 index 00000000..c89d2730 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcli.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspcli(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of integer*2 data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +int status # o error status + +begin + +call ftpcli(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclj.x b/pkg/tbtables/fitsio/fitssppb/fspclj.x new file mode 100644 index 00000000..22e5561c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclj.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspclj(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of integer data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpclj(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcll.x b/pkg/tbtables/fitsio/fitssppb/fspcll.x new file mode 100644 index 00000000..6ade3400 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcll.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcll(ounit,colnum,frow,felem,nelem,lray,status) + +# write an array of logical values to the specified column of the table. +# The binary table column being written to must have datatype 'L' +# and no datatype conversion will be perform if it is not. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +bool lray[ARB] # i logical array +int status # o error status + +begin + +call ftpcll(ounit,colnum,frow,felem,nelem,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclm.x b/pkg/tbtables/fitsio/fitssppb/fspclm.x new file mode 100644 index 00000000..4cdef809 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclm.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspclm(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of double precision complex data values to the +# specified column of the table. +# The binary table column being written to must have datatype 'M' +# and no datatype conversion will be perform if it is not. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpclm(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcls.x b/pkg/tbtables/fitsio/fitssppb/fspcls.x new file mode 100644 index 00000000..2d4f4a56 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcls.x @@ -0,0 +1,29 @@ +include "fitsio.h" + +procedure fspcls(ounit,colnum,frow,felem,nelem,sray,dim1,status) + +# write an array of character string values to the specified column of +# the table. +# The binary or ASCII table column being written to must have datatype 'A' + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +char sray[dim1,ARB] # i array of strings +int dim1 # i size of 1st dimension of 2D character string array +% character*256 fsray +int status # o error status +int i +int elem + +begin + +elem=felem +do i=1,nelem { + call f77pak(sray(1,i),fsray,dim1) + call ftpcls(ounit,colnum,frow,elem,1,fsray,status) + elem=elem+1 +} +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclu.x b/pkg/tbtables/fitsio/fitssppb/fspclu.x new file mode 100644 index 00000000..8d341d3c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclu.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fspclu(ounit,colnum,frow,felem,nelem,status) + +# set elements of a table to be undefined + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int status # o error status + +begin + +call ftpclu(ounit,colnum,frow,felem,nelem,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclx.x b/pkg/tbtables/fitsio/fitssppb/fspclx.x new file mode 100644 index 00000000..140be2b9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclx.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspclx(iunit,colnum,frow,fbit,nbit,lray,status) + +# write an array of logical values to a specified bit or byte +# column of the binary table. If the LRAY parameter is .true., +# then the corresponding bit is set to 1, otherwise it is set +# to 0. +# The binary table column being written to must have datatype 'B' +# or 'X'. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int fbit # i first bit +int nbit # i number of bits +bool lray[ARB] # i logical array +int status # o error status + +begin + +call ftpclx(iunit,colnum,frow,fbit,nbit,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcnb.x b/pkg/tbtables/fitsio/fitssppb/fspcnb.x new file mode 100644 index 00000000..6e158397 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcnb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcnb(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of unsigned byte data values to the +# specified column of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value representing a null +int status # o error status + +begin + +call ftpcnb(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcnd.x b/pkg/tbtables/fitsio/fitssppb/fspcnd.x new file mode 100644 index 00000000..6fc182be --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcnd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcnd(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of double precision data values to the specified column +# of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +double nulval # d value representing a null +int status # o error status + +begin + +call ftpcnd(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcne.x b/pkg/tbtables/fitsio/fitssppb/fspcne.x new file mode 100644 index 00000000..413ab23a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcne.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcne(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of real data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # r array of values +real nulval # r value representing a null +int status # o error status + +begin + +call ftpcne(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcni.x b/pkg/tbtables/fitsio/fitssppb/fspcni.x new file mode 100644 index 00000000..1c4bc5bc --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcni.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcni(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of integer*2 data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +short nulval # i value representing a null +int status # o error status + +begin + +call ftpcni(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcnj.x b/pkg/tbtables/fitsio/fitssppb/fspcnj.x new file mode 100644 index 00000000..a64b8e9e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcnj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcnj(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of integer data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value representing a null +int status # o error status + +begin + +call ftpcnj(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcom.x b/pkg/tbtables/fitsio/fitssppb/fspcom.x new file mode 100644 index 00000000..9e9f2f14 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcom.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fspcom(ounit,commnt,status) + +# write a COMMENT record to the FITS header + +int ounit # i output file pointer +char commnt[SZ_FLONGCOMM] # i comment keyword +% character fcommn*72 +int status # o error status + +begin + +call f77pak(commnt,fcommn,SZ_FLONGCOMM) + +call ftpcom(ounit,fcommn,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspdat.x b/pkg/tbtables/fitsio/fitssppb/fspdat.x new file mode 100644 index 00000000..bfddbe94 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspdat.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fspdat(ounit,status) + +# write the current date to the DATE keyword in the ounit CHU + +int ounit # i output file pointer +int status # o error status + +begin + +call ftpdat(ounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspdef.x b/pkg/tbtables/fitsio/fitssppb/fspdef.x new file mode 100644 index 00000000..f9368e99 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspdef.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspdef(ounit,bitpix,naxis,naxes,pcount,gcount,status) + +# Primary data DEFinition +# define the structure of the primary data unit or an IMAGE extension + +int ounit # i output file pointer +int bitpix # i bits per pixel +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int pcount # i number of group parame +int gcount # i number of groups +int status # o error status + +begin + +call ftpdef(ounit,bitpix,naxis,naxes,pcount,gcount,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspdes.x b/pkg/tbtables/fitsio/fitssppb/fspdes.x new file mode 100644 index 00000000..ca1561f1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspdes.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspdes(ounit,colnum,rownum,nelem,offset,status) + +# write the descriptor values to a binary table. This is only +# used for column which have TFORMn = 'P', i.e., for variable +# length arrays. + +int ounit # i output file pointer +int colnum # i column number +int rownum # i row number +int nelem # i number of elements +int offset # i offset +int status # o error status + +begin + +call ftpdes(ounit,colnum,rownum,nelem,offset,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpb.x b/pkg/tbtables/fitsio/fitssppb/fspgpb.x new file mode 100644 index 00000000..ee9ae600 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpb(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpb(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpd.x b/pkg/tbtables/fitsio/fitssppb/fspgpd.x new file mode 100644 index 00000000..d7b53ef2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpd(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpd(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpe.x b/pkg/tbtables/fitsio/fitssppb/fspgpe.x new file mode 100644 index 00000000..ff117afe --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpe.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpe(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpe(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpi.x b/pkg/tbtables/fitsio/fitssppb/fspgpi.x new file mode 100644 index 00000000..455ec26d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpi.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpi(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +short array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpi(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpj.x b/pkg/tbtables/fitsio/fitssppb/fspgpj.x new file mode 100644 index 00000000..3f3cbd66 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpj(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpj(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphbn.x b/pkg/tbtables/fitsio/fitssppb/fsphbn.x new file mode 100644 index 00000000..d9e8af02 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphbn.x @@ -0,0 +1,35 @@ +include "fitsio.h" + +procedure fsphbn(ounit,nrows,nfield,ttype,tform,tunit, + extnam,pcount,status) + +# write required standard header keywords for a binary table extension + +int ounit # i output file pointer +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int pcount # i size of 'heap' +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftphbn(ounit,nrows,nfield,fttype,ftform,ftunit, + fextna,pcount,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphis.x b/pkg/tbtables/fitsio/fitssppb/fsphis.x new file mode 100644 index 00000000..a83669ed --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphis.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsphis(ounit,histry,status) + +# write a HISTORY record to the FITS header + +int ounit # i output file pointer +char histry[SZ_FLONGCOMM] # i history keyword +% character fhistr*72 +int status # o error status + +begin + +call f77pak(histry,fhistr,SZ_FLONGCOMM) + +call ftphis(ounit,fhistr,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphpr.x b/pkg/tbtables/fitsio/fitssppb/fsphpr.x new file mode 100644 index 00000000..28977af1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphpr.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsphpr(ounit,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) + +# write required primary header keywords + +int ounit # i output file pointer +bool simple # i simple FITS file? +int bitpix # i bits per pixel +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int pcount # i no. of group parameters +int gcount # i no. of groups +bool extend # i EXTEND keyword = TRUE? +int status # o error status + +begin + +call ftphpr(ounit,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphtb.x b/pkg/tbtables/fitsio/fitssppb/fsphtb.x new file mode 100644 index 00000000..b7bcf953 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphtb.x @@ -0,0 +1,36 @@ +include "fitsio.h" + +procedure fsphtb(ounit,ncols,nrows,nfield,ttype,tbcol, + tform,tunit,extnam,status) + +# write required standard header keywords for an ASCII table extension + +int ounit # i output file pointer +int ncols # i number of columns +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +int tbcol[ARB] # i starting column position +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftphtb(ounit,ncols,nrows,nfield,fttype,tbcol, + ftform,ftunit,fextna,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkls.x b/pkg/tbtables/fitsio/fitssppb/fspkls.x new file mode 100644 index 00000000..f16108cb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkls.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspkls(ounit,keywrd,strval,comm,status) + +# write a character string value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkls(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknd.x b/pkg/tbtables/fitsio/fitssppb/fspknd.x new file mode 100644 index 00000000..c5b384f5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspknd(ounit,keywrd,nstart,nkey,dval,decim,comm,status) + +# write an array of real*8 values to header records in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknd(ounit,fkeywr,nstart,nkey,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkne.x b/pkg/tbtables/fitsio/fitssppb/fspkne.x new file mode 100644 index 00000000..45a9c4dc --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkne.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspkne(ounit,keywrd,nstart,nkey,rval,decim,comm,status) + +# write an array of real*4 values to header records in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpkne(ounit,fkeywr,nstart,nkey,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknf.x b/pkg/tbtables/fitsio/fitssppb/fspknf.x new file mode 100644 index 00000000..8579d358 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknf.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspknf(ounit,keywrd,nstart,nkey,rval,decim,comm,status) + +# write an array of real*4 values to header records in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknf(ounit,fkeywr,nstart,nkey,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkng.x b/pkg/tbtables/fitsio/fitssppb/fspkng.x new file mode 100644 index 00000000..d4225e4d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkng.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspkng(ounit,keywrd,nstart,nkey,dval,decim,comm,status) + +# write an array of real*8 values to header records in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpkng(ounit,fkeywr,nstart,nkey,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknj.x b/pkg/tbtables/fitsio/fitssppb/fspknj.x new file mode 100644 index 00000000..8d303f1a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknj.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fspknj(ounit,keywrd,nstart,nkey,intval,comm,status) + +# write an array of integer values to header records + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknj(ounit,fkeywr,nstart,nkey,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknl.x b/pkg/tbtables/fitsio/fitssppb/fspknl.x new file mode 100644 index 00000000..89a9c569 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknl.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fspknl(ounit,keywrd,nstart,nkey,logval,comm,status) + +# write an array of logical values to header records + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +bool logval[ARB] # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknl(ounit,fkeywr,nstart,nkey,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkns.x b/pkg/tbtables/fitsio/fitssppb/fspkns.x new file mode 100644 index 00000000..1ac5b007 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkns.x @@ -0,0 +1,34 @@ +include "fitsio.h" + +procedure fspkns(ounit,keywrd,nstart,nkey,strval,comm,status) + +# write an array of character string values to header records + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +char strval[SZ_FSTRVAL,ARB] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status +int i +int n1 + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +n1=nstart +do i=1,nkey { + call f77pak(strval(1,i),fstrva,SZ_FSTRVAL) + call ftpkns(ounit,fkeywr,n1,1,fstrva,fcomm,status) + n1=n1+1 + } + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyd.x b/pkg/tbtables/fitsio/fitssppb/fspkyd.x new file mode 100644 index 00000000..6169674b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fspkyd(ounit,keywrd,dval,decim,comm,status) + +# write a double precision value to a header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkye.x b/pkg/tbtables/fitsio/fitssppb/fspkye.x new file mode 100644 index 00000000..395e6b6f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fspkye(ounit,keywrd,rval,decim,comm,status) + +# write a real*4 value to a header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyf.x b/pkg/tbtables/fitsio/fitssppb/fspkyf.x new file mode 100644 index 00000000..9ef7d359 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fspkyf(ounit,keywrd,rval,decim,comm,status) + +# write a real*4 value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyg.x b/pkg/tbtables/fitsio/fitssppb/fspkyg.x new file mode 100644 index 00000000..a9faccec --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fspkyg(ounit,keywrd,dval,decim,comm,status) + +# write a double precision value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyj.x b/pkg/tbtables/fitsio/fitssppb/fspkyj.x new file mode 100644 index 00000000..8cbc90e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspkyj(ounit,keywrd,intval,comm,status) + +# write an integer value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyl.x b/pkg/tbtables/fitsio/fitssppb/fspkyl.x new file mode 100644 index 00000000..69f57797 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspkyl(ounit,keywrd,logval,comm,status) + +# write a logical value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkys.x b/pkg/tbtables/fitsio/fitssppb/fspkys.x new file mode 100644 index 00000000..6d2b45c5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspkys(ounit,keywrd,strval,comm,status) + +# write a character string value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyt.x b/pkg/tbtables/fitsio/fitssppb/fspkyt.x new file mode 100644 index 00000000..d78bad96 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyt.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspkyt(iunit,keywrd,intval,dval,comm,status) + +# concatinate a integer value with a double precision fraction +# and write it to the FITS header along with the comment string +# The value will be displayed in F28.16 format + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +double dval # i real*8 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyt(iunit,fkeywr,intval,dval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsplsw.x b/pkg/tbtables/fitsio/fitssppb/fsplsw.x new file mode 100644 index 00000000..d8d12137 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsplsw.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsplsw(iunit,status) + +# write keywords to warn users that longstring convention may be used + +int iunit # i input file pointer +int status # o error status + +begin + +call ftplsw(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspmsg.x b/pkg/tbtables/fitsio/fitssppb/fspmsg.x new file mode 100644 index 00000000..ec9f66ae --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspmsg.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fspmsg(text) + +# write a 80 character record to the FITSIO error stack + +char text[SZ_FCARD] # i 80-char message +% character ftext*80 + +begin + +call f77pak(text,ftext,SZ_FCARD) + +call ftpmsg(ftext) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspnul.x b/pkg/tbtables/fitsio/fitssppb/fspnul.x new file mode 100644 index 00000000..56cb31b3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspnul.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fspnul(ounit,blank,status) + +# Primary Null value definition +# Define the null value for an integer primary array. +# This must be the first HDU of the FITS file. + +int ounit # i output file pointer +int blank # i value used to represent undefined values +int status # o error status + +begin + +call ftpnul(ounit,blank,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppnb.x b/pkg/tbtables/fitsio/fitssppb/fsppnb.x new file mode 100644 index 00000000..45d09699 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppnb.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppnb(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value used for null pixels +int status # o error status + +begin + +call ftppnb(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppnd.x b/pkg/tbtables/fitsio/fitssppb/fsppnd.x new file mode 100644 index 00000000..4f808aa8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppnd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppnd(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +double nulval # d value used for null pixels +int status # o error status + +begin + +call ftppnd(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppne.x b/pkg/tbtables/fitsio/fitssppb/fsppne.x new file mode 100644 index 00000000..6279e59f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppne.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppne(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # r array of values +real nulval # r value used for null pixels +int status # o error status + +begin + +call ftppne(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppni.x b/pkg/tbtables/fitsio/fitssppb/fsppni.x new file mode 100644 index 00000000..dca6f308 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppni.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppni(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +short nulval # i value used for null pixels +int status # o error status + +begin + +call ftppni(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppnj.x b/pkg/tbtables/fitsio/fitssppb/fsppnj.x new file mode 100644 index 00000000..4ec4b718 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppnj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppnj(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value used for null pixels +int status # o error status + +begin + +call ftppnj(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspprb.x b/pkg/tbtables/fitsio/fitssppb/fspprb.x new file mode 100644 index 00000000..6a9bf554 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspprb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspprb(ounit,group,felem,nelem,array,status) + +# Write an array of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpprb(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspprd.x b/pkg/tbtables/fitsio/fitssppb/fspprd.x new file mode 100644 index 00000000..d5cd4565 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspprd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspprd(ounit,group,felem,nelem,array,status) + +# Write an array of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpprd(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppre.x b/pkg/tbtables/fitsio/fitssppb/fsppre.x new file mode 100644 index 00000000..fa9b2853 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppre.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsppre(ounit,group,felem,nelem,array,status) + +# Write an array of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # i array of values +int status # o error status + +begin + +call ftppre(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppri.x b/pkg/tbtables/fitsio/fitssppb/fsppri.x new file mode 100644 index 00000000..ab6afd59 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppri.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsppri(ounit,group,felem,nelem,array,status) + +# Write an array of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +int status # o error status + +begin + +call ftppri(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspprj.x b/pkg/tbtables/fitsio/fitssppb/fspprj.x new file mode 100644 index 00000000..b9d86710 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspprj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspprj(ounit,group,felem,nelem,array,status) + +# Write an array of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpprj(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppru.x b/pkg/tbtables/fitsio/fitssppb/fsppru.x new file mode 100644 index 00000000..eedd82bd --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppru.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsppru(ounit,group,felem,nelem,status) + +# set elements of the primary array equal to the undefined value + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int status # o error status + +begin + +call ftppru(ounit,group,felem,nelem,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsprec.x b/pkg/tbtables/fitsio/fitssppb/fsprec.x new file mode 100644 index 00000000..ee91cead --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsprec.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsprec(ounit,record,status) + +# write a 80 character record to the FITS header + +int ounit # i output file pointer +char record[SZ_FCARD] # i 80-char header record +% character frecor*80 +int status # o error status + +begin + +call f77pak(record,frecor,SZ_FCARD) + +call ftprec(ounit,frecor,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspscl.x b/pkg/tbtables/fitsio/fitssppb/fspscl.x new file mode 100644 index 00000000..df7d8233 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspscl.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fspscl(ounit,bscale,bzero,status) + +# Primary SCaLing factor definition +# Define the scaling factor for the primary header data. +# This must be the first HDU of the FITS file. + +int ounit # i output file pointer +double bscale # i scaling factor +double bzero # i scaling zeropoint +int status # o error status + +begin + +call ftpscl(ounit,bscale,bzero,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssb.x b/pkg/tbtables/fitsio/fitssppb/fspssb.x new file mode 100644 index 00000000..3a26ef08 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssb.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssb(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of byte values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpssb(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssd.x b/pkg/tbtables/fitsio/fitssppb/fspssd.x new file mode 100644 index 00000000..0960c17f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssd.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssd(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of double precision values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpssd(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspsse.x b/pkg/tbtables/fitsio/fitssppb/fspsse.x new file mode 100644 index 00000000..ffe42b34 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspsse.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspsse(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of real values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpsse(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssi.x b/pkg/tbtables/fitsio/fitssppb/fspssi.x new file mode 100644 index 00000000..10612a9a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssi.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssi(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of integer*2 values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +short array[ARB] # i array of values +int status # o error status + +begin + +call ftpssi(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssj.x b/pkg/tbtables/fitsio/fitssppb/fspssj.x new file mode 100644 index 00000000..46c7770e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssj.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssj(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of integer values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpssj(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspsvc.x b/pkg/tbtables/fitsio/fitssppb/fspsvc.x new file mode 100644 index 00000000..2c6ac3eb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspsvc.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspsvc(keyrec,value,comm,status) + +# parse the header record to find value and comment strings + +char keyrec[SZ_FCARD] # i header keyword string +% character fkeyre*80 +char value[SZ_FSTRVAL] # o data value +% character fvalue*70 +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keyrec,fkeyre,SZ_FCARD) + +call ftpsvc(fkeyre,fvalue,fcomm,status) + +call f77upk(fvalue ,value,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsptbb.x b/pkg/tbtables/fitsio/fitssppb/fsptbb.x new file mode 100644 index 00000000..1f424db2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsptbb.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsptbb(iunit,frow,fchar,nchars,value,status) + +# write a consecutive string of bytes to an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of bytes +int value[ARB] # i data value +int status # o error status + +begin + +call ftptbb(iunit,frow,fchar,nchars,value,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsptbs.x b/pkg/tbtables/fitsio/fitssppb/fsptbs.x new file mode 100644 index 00000000..c1c52b40 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsptbs.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsptbs(iunit,frow,fchar,nchars,svalue,status) + +# write a consecutive string of characters to an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of characters +char svalue[ARB] # i string value +% character fsvalu*256 +int status # o error status +int readfirst +int writefirst +int ntodo +int itodo + +begin + +# since the string may be arbitrarily long, write it in pieces +readfirst=1 +writefirst=fchar +ntodo=nchars +itodo=min(256,ntodo) + +while (itodo > 0) { + call f77pak(svalue[readfirst],fsvalu,itodo) + call ftptbs(iunit,frow,writefirst,itodo,fsvalu,status) + writefirst=writefirst+itodo + readfirst=readfirst+itodo + ntodo=ntodo-itodo + itodo=min(256,ntodo) + } + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsptdm.x b/pkg/tbtables/fitsio/fitssppb/fsptdm.x new file mode 100644 index 00000000..32f96fca --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsptdm.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsptdm(ounit,colnum,naxis,naxes,status) + +# write the TDIMnnn keyword + +int ounit # i output file pointer +int colnum # i column number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int status # o error status + +begin + +call ftptdm(ounit,colnum,naxis,naxes,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspthp.x b/pkg/tbtables/fitsio/fitssppb/fspthp.x new file mode 100644 index 00000000..1c11c2e9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspthp.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fspthp(ounit,heap,status) + +# Define the starting address for the heap for a binary table. +# The default address is NAXIS1 * NAXIS2. It is in units of +# bytes relative to the beginning of the regular binary table data. +# This routine also writes the appropriate THEAP keyword to the +# FITS header. + +int ounit # i output file pointer +int heap # i heap starting address +int status # o error status + +begin + +call ftpthp(ounit,heap,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsrdef.x b/pkg/tbtables/fitsio/fitssppb/fsrdef.x new file mode 100644 index 00000000..afa92419 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsrdef.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsrdef(ounit,status) + +# Data DEFinition +# re-define the length of the data unit +# this simply redefines the start of the next HDU + +int ounit # i output file pointer +int status # o error status + +begin + +call ftrdef(ounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fssnul.x b/pkg/tbtables/fitsio/fitssppb/fssnul.x new file mode 100644 index 00000000..6a11962b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fssnul.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fssnul(ounit,colnum,nulval,status) + +# ascii table Column NULl value definition +# Define the null value for an ASCII table column. + +int ounit # i output file pointer +int colnum # i column number +char nulval # i value for undefined pixels +% character*16 fnulva +int status # o error status + +begin + +call f77pak(nulval,fnulva,16) + +call ftsnul(ounit,colnum,fnulva,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fstkey.x b/pkg/tbtables/fitsio/fitssppb/fstkey.x new file mode 100644 index 00000000..0b98485e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fstkey.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fstkey(keywrd,status) + +# test that keyword name contains only legal characters: +# uppercase letters, numbers, hyphen, underscore, or space + +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call fttkey(fkeywr,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fstnul.x b/pkg/tbtables/fitsio/fitssppb/fstnul.x new file mode 100644 index 00000000..1c8997b4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fstnul.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fstnul(ounit,colnum,inull,status) + +# Table column NULl value definition +# Define the null value for an integer binary table column + +int ounit # i output file pointer +int colnum # i column number +int inull # integer null value +int status # o error status + +begin + +call fttnul(ounit,colnum,inull,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fstscl.x b/pkg/tbtables/fitsio/fitssppb/fstscl.x new file mode 100644 index 00000000..09d86cb2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fstscl.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fstscl(ounit,colnum,bscale,bzero,status) + +# Table column SCaLing factor definition +# Define the scaling factor for a table column. + +int ounit # i output file pointer +int colnum # i column number +double bscale # i scaling factor +double bzero # i scaling zeropoint +int status # o error status + +begin + +call fttscl(ounit,colnum,bscale,bzero,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsucks.x b/pkg/tbtables/fitsio/fitssppb/fsucks.x new file mode 100644 index 00000000..d024f2d8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsucks.x @@ -0,0 +1,11 @@ +include "fitsio.h" + +procedure fsucks(iunit,status) + +int iunit +int status # o error status + +begin + +call ftucks(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsucrd.x b/pkg/tbtables/fitsio/fitssppb/fsucrd.x new file mode 100644 index 00000000..70c0a609 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsucrd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsucrd(ounit,keywrd,card,status) + +# update a given header record specified by keyword name. +# new record is appended to header if it doesn't exist. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char card[SZ_FCARD] # i 80-char header record +% character fcard*80 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(card ,fcard, SZ_FCARD) + +call ftucrd(ounit,fkeywr,fcard,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyd.x b/pkg/tbtables/fitsio/fitssppb/fsukyd.x new file mode 100644 index 00000000..1de99474 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsukyd(ounit,keywrd,dval,decim,comm,status) + +# update a double precision value header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukye.x b/pkg/tbtables/fitsio/fitssppb/fsukye.x new file mode 100644 index 00000000..31668640 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsukye(ounit,keywrd,rval,decim,comm,status) + +# update a real*4 value header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyf.x b/pkg/tbtables/fitsio/fitssppb/fsukyf.x new file mode 100644 index 00000000..6c8fa1eb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsukyf(ounit,keywrd,rval,decim,comm,status) + +# update a real*4 value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyg.x b/pkg/tbtables/fitsio/fitssppb/fsukyg.x new file mode 100644 index 00000000..8922299a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsukyg(ounit,keywrd,dval,decim,comm,status) + +# update a double precision value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyj.x b/pkg/tbtables/fitsio/fitssppb/fsukyj.x new file mode 100644 index 00000000..2a639547 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsukyj(ounit,keywrd,intval,comm,status) + +# update an integer value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyl.x b/pkg/tbtables/fitsio/fitssppb/fsukyl.x new file mode 100644 index 00000000..4f32127c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsukyl(ounit,keywrd,logval,comm,status) + +# update a logical value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukys.x b/pkg/tbtables/fitsio/fitssppb/fsukys.x new file mode 100644 index 00000000..71ba3696 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsukys(ounit,keywrd,strval,comm,status) + +# update a character string value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsvcks.x b/pkg/tbtables/fitsio/fitssppb/fsvcks.x new file mode 100644 index 00000000..17149c03 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsvcks.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsvcks(iunit,dataok,hduok,status) + +int iunit +int dataok +int hduok +int status # o error status + +begin + +call ftvcks(iunit,dataok,hduok,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsvers.x b/pkg/tbtables/fitsio/fitssppb/fsvers.x new file mode 100644 index 00000000..09f1a8e6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsvers.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsvers(vernum) + +# Returns the current revision number of the FITSIO package. +# The revision number will be incremented whenever any modifications, +# bug fixes, or enhancements are made to the package + +real vernum # o FITSIO version number + +begin + +call ftvers(vernum) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fswldp.x b/pkg/tbtables/fitsio/fitssppb/fswldp.x new file mode 100644 index 00000000..006b0480 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fswldp.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fswldp(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coord, + xpos,ypos,status) + +double xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,xpos,ypos +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call f77pak(coord,fcoord,4) +call ftwldp(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,fcoord, + xpos,ypos,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsxypx.x b/pkg/tbtables/fitsio/fitssppb/fsxypx.x new file mode 100644 index 00000000..a6343d0a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsxypx.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsxypx(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coord, + xpix,ypix,status) + +double xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,xpos,ypos +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call f77pak(coord,fcoord,4) +call ftxypx(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,fcoord, + xpix,ypix,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/mkpkg b/pkg/tbtables/fitsio/fitssppb/mkpkg new file mode 100644 index 00000000..0b527127 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/mkpkg @@ -0,0 +1,262 @@ +# FITSIO -- This IRAF mkpkg file updates the TBTABLES library to include +# the FITSIO interface. + +tbtables: +$checkout libtbtables.a ../ +$update libtbtables.a +$checkin libtbtables.a ../ +$exit + +libtbtables.a: + fsadef.x + fsarch.x + fsasfm.x + fsbdef.x + fsbnfm.x + fsclos.x + fscmps.x + fscmsg.x + fscopy.x + fscpdt.x + fscrhd.x + fsdcol.x + fsddef.x + fsdelt.x + fsdhdu.x + fsdkey.x + fsdrec.x + fsdrow.x + fsdsum.x + fsdtyp.x + fsesum.x + fsfiou.x + fsg2db.x + fsg2dd.x + fsg2de.x + fsg2di.x + fsg2dj.x + fsg3db.x + fsg3dd.x + fsg3de.x + fsg3di.x + fsg3dj.x + fsgabc.x + fsgacl.x + fsgbcl.x + fsgcfb.x + fsgcfc.x + fsgcfd.x + fsgcfe.x + fsgcfi.x + fsgcfj.x + fsgcfl.x + fsgcfm.x + fsgcfs.x + fsgcks.x + fsgcl.x + fsgcnn.x + fsgcno.x + fsgcrd.x + fsgcvb.x + fsgcvc.x + fsgcvd.x + fsgcve.x + fsgcvi.x + fsgcvj.x + fsgcvm.x + fsgcvs.x + fsgcx.x + fsgcxd.x + fsgcxi.x + fsgcxj.x + fsgdes.x + fsgerr.x + fsggpb.x + fsggpd.x + fsggpe.x + fsggpi.x + fsggpj.x + fsghad.x + fsghbn.x + fsghdn.x + fsghpr.x + fsghps.x + fsghsp.x + fsghtb.x + fsgics.x + fsgiou.x + fsgkey.x + fsgknd.x + fsgkne.x + fsgknj.x + fsgknl.x + fsgkns.x + fsgkyd.x + fsgkye.x + fsgkyj.x + fsgkyl.x + fsgkyn.x + fsgkys.x + fsgkyt.x + fsgmsg.x + fsgpfb.x + fsgpfd.x + fsgpfe.x + fsgpfi.x + fsgpfj.x + fsgpvb.x + fsgpvd.x + fsgpve.x + fsgpvi.x + fsgpvj.x + fsgrec.x + fsgrsz.x + fsgsdt.x + fsgsfb.x + fsgsfd.x + fsgsfe.x + fsgsfi.x + fsgsfj.x + fsgsvb.x + fsgsvd.x + fsgsve.x + fsgsvi.x + fsgsvj.x + fsgtbb.x + fsgtbs.x + fsgtcl.x + fsgtcs.x + fsgtdm.x + fsgthd.x + fshdef.x + fsibin.x + fsicol.x + fsiimg.x + fsikyd.x + fsikye.x + fsikyf.x + fsikyg.x + fsikyj.x + fsikyl.x + fsikys.x + fsinit.x + fsirec.x + fsirow.x + fsitab.x + fskeyn.x + fsmahd.x + fsmcom.x + fsmcrd.x + fsmkyd.x + fsmkye.x + fsmkyf.x + fsmkyg.x + fsmkyj.x + fsmkyl.x + fsmkys.x + fsmnam.x + fsmrec.x + fsmrhd.x + fsnkey.x + fsopen.x + fsp2db.x + fsp2dd.x + fsp2de.x + fsp2di.x + fsp2dj.x + fsp3db.x + fsp3dd.x + fsp3de.x + fsp3di.x + fsp3dj.x + fspcks.x + fspclb.x + fspclc.x + fspcld.x + fspcle.x + fspcli.x + fspclj.x + fspcll.x + fspclm.x + fspcls.x + fspclu.x + fspclx.x + fspcnb.x + fspcnd.x + fspcne.x + fspcni.x + fspcnj.x + fspcom.x + fspdat.x + fspdef.x + fspdes.x + fspgpb.x + fspgpd.x + fspgpe.x + fspgpi.x + fspgpj.x + fsphbn.x + fsphis.x + fsphpr.x + fsphtb.x + fspkls.x + fspknd.x + fspkne.x + fspknf.x + fspkng.x + fspknj.x + fspknl.x + fspkns.x + fspkyd.x + fspkye.x + fspkyf.x + fspkyg.x + fspkyj.x + fspkyl.x + fspkys.x + fspkyt.x + fsplsw.x + fspmsg.x + fspnul.x + fsppnb.x + fsppnd.x + fsppne.x + fsppni.x + fsppnj.x + fspprb.x + fspprd.x + fsppre.x + fsppri.x + fspprj.x + fsppru.x + fsprec.x + fspscl.x + fspssb.x + fspssd.x + fspsse.x + fspssi.x + fspssj.x + fspsvc.x + fsptbb.x + fsptbs.x + fsptdm.x + fspthp.x + fsrdef.x + fssnul.x + fstkey.x + fstnul.x + fstscl.x + fsucks.x + fsucrd.x + fsukyd.x + fsukye.x + fsukyf.x + fsukyg.x + fsukyj.x + fsukyl.x + fsukys.x + fsvcks.x + fsvers.x + fswldp.x + fsxypx.x + ; diff --git a/pkg/tbtables/fitsio/ftadef.f b/pkg/tbtables/fitsio/ftadef.f new file mode 100644 index 00000000..5c516448 --- /dev/null +++ b/pkg/tbtables/fitsio/ftadef.f @@ -0,0 +1,143 @@ +C-------------------------------------------------------------------------- + subroutine ftadef(ounit,lenrow,nfield,bcol,tform,nrows,status) + +C Ascii table data DEFinition +C define the structure of the ASCII table data unit +C +C ounit i Fortran I/O unit number +C lenrow i length of a row, in characters +C nfield i number of fields in the table +C bcol i starting position of each column, (starting with 1) +C tform C the data format of the column +C nrows i number of rows in the table +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,lenrow,nfield,bcol(*),nrows,status + character*(*) tform(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,i,j,clen,c2 + character ctemp*24, cnum*3,cbcol*10,caxis1*10 + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + + if (dtstrt(ibuff) .lt. 0)then +C freeze the header at its current size + call fthdef(ounit,0,status) + if (status .gt. 0)return + end if + + hdutyp(ibuff)=1 + tfield(ibuff)=nfield + + if (nxtfld + nfield .gt. nf)then +C too many columns open at one time; exceeded array dimensions + status=111 + return + end if + + tstart(ibuff)=nxtfld + nxtfld=nxtfld+nfield + + if (nfield .eq. 0)then +C no data; the next HDU begins in the next logical block + hdstrt(ibuff,chdu(ibuff)+1)=dtstrt(ibuff) + scount(ibuff)=0 + theap(ibuff)=0 + nxheap(ibuff)=0 + else +C initialize the table column parameters + clen=len(tform(1)) + do 20 i=1,nfield + tscale(i+tstart(ibuff))=1. + tzero(i+tstart(ibuff))=0. +C choose special value to indicate null values are not defined + cnull(i+tstart(ibuff))=char(1) + cform(i+tstart(ibuff))=tform(i) + tbcol(i+tstart(ibuff))=bcol(i)-1 + tdtype(i+tstart(ibuff))=16 +C the repeat count is always one for ASCII tables + trept(i+tstart(ibuff))=1 +C store the width of the field in TNULL + c2=0 + do 10 j=2,clen + if (tform(i)(j:j) .ge. '0' .and. + & tform(i)(j:j) .le. '9')then + c2=j + else + go to 15 + end if +10 continue +15 continue + if (c2 .eq. 0)then +C no explicit width, so assume width of 1 character + tnull(i+tstart(ibuff))=1 + else + call ftc2ii(tform(i)(2:c2),tnull(i+tstart(ibuff)) + & ,status) + if (status .gt. 0)then +C error parsing TFORM to determine field width + status=261 + ctemp=tform(i) + call ftpmsg('Error parsing TFORM to get field' + & //' width: '//ctemp) + return + end if + end if + +C check that column fits within the table + if (tbcol(i+tstart(ibuff))+tnull(i+tstart(ibuff)) + & .gt. lenrow .and. lenrow .ne. 0)then + status=236 + write(cnum,1000)i + write(cbcol,1001)bcol(i) + write(caxis1,1001)lenrow +1000 format(i3) +1001 format(i10) + call ftpmsg('Column '//cnum//' will not fit '// + & 'within the specified width of the ASCII table.') + + call ftpmsg('TFORM='//cform(i+tstart(ibuff))// + & ' TBCOL='//cbcol//' NAXIS1='//caxis1) + return + end if +20 continue + +C calculate the start of the next header unit, based on the +C size of the data unit + rowlen(ibuff)=lenrow + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+(lenrow*nrows+2879)/2880*2880 + +C initialize the fictitious heap starting address (immediately following +C the table data) and a zero length heap. This is used to find the +C end of the table data when checking the fill values in the last block. +C ASCII tables have no special data area + scount(ibuff)=0 + theap(ibuff)=rowlen(ibuff)*nrows + nxheap(ibuff)=0 + end if + end diff --git a/pkg/tbtables/fitsio/ftaini.f b/pkg/tbtables/fitsio/ftaini.f new file mode 100644 index 00000000..1f7d2d70 --- /dev/null +++ b/pkg/tbtables/fitsio/ftaini.f @@ -0,0 +1,183 @@ +C-------------------------------------------------------------------------- + subroutine ftaini(iunit,status) + +C initialize the parameters defining the structure of an ASCII table + +C iunit i Fortran I/O unit number +C OUTPUT PARAMETERS: +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer nrows,tfld,nkey,ibuff,i,nblank + character keynam*8,value*70,comm*72,rec*80 + character cnum*3,cbcol*10,caxis1*10 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C store the type of HDU (1 = ASCII table extension) + hdutyp(ibuff)=1 + +C temporarily set the location of the end of the header to a huge number + hdend(ibuff)=2000000000 + hdstrt(ibuff,chdu(ibuff)+1)=2000000000 + +C check that this is a valid ASCII table, and get parameters + call ftgttb(iunit,rowlen(ibuff),nrows,tfld,status) + if (status .gt. 0)go to 900 + + if (tfld .gt. nf)then +C arrays not dimensioned large enough for this many fields + status=111 + call ftpmsg('This ASCII table has too many fields '// + & 'to be read with FITSIO (FTAINI).') + go to 900 + end if + +C store the number of fields in the common block + tfield(ibuff)=tfld + + if (nxtfld + tfld .gt. nf)then +C too many columns open at one time; exceeded array dimensions + status=111 + return + end if + + tstart(ibuff)=nxtfld + nxtfld=nxtfld+tfld + +C initialize the table field parameters + do 5 i=1,tfld + tscale(i+tstart(ibuff))=1. + tzero(i+tstart(ibuff))=0. +C choose special value to indicate that null value is not defined + cnull(i+tstart(ibuff))=char(1) +C pre-set required keyword values to a null value + tbcol(i+tstart(ibuff))=-1 + tdtype(i+tstart(ibuff))=-9999 +5 continue + +C initialize the fictitious heap starting address (immediately following +C the table data) and a zero length heap. This is used to find the +C end of the table data when checking the fill values in the last block. +C there is no special data following an ASCII table + scount(ibuff)=0 + theap(ibuff)=rowlen(ibuff)*nrows + nxheap(ibuff)=0 + +C now read through the rest of the header looking for table column +C definition keywords, and the END keyword. + + nkey=8 +8 nblank=0 +10 nkey=nkey+1 + call ftgrec(iunit,nkey,rec,status) + if (status .eq. 107)then +C if we hit the end of file, then set status = no END card found + status=210 + call ftpmsg('Required END keyword not found in ASCII table'// + & ' header (FTAINI).') + go to 900 + else if (status .gt. 0)then + go to 900 + end if + keynam=rec(1:8) + comm=rec(9:80) + + if (keynam(1:1) .eq. 'T')then +C get the ASCII table parameter (if it is one) + call ftpsvc(rec,value,comm,status) + call ftgatp(ibuff,keynam,value,status) + else if (keynam .eq. ' ' .and. comm .eq. ' ')then + nblank=nblank+1 + go to 10 + else if (keynam .eq. 'END')then + go to 20 + end if + go to 8 + +20 continue + +C test that all the required keywords were found + do 25 i=1,tfld + if (tbcol(i+tstart(ibuff)) .eq. -1)then + status=231 + call ftkeyn('TBCOL',i,keynam,status) + call ftpmsg('Required '//keynam// + & ' keyword not found (FTAINI).') + return + else if (tbcol(i+tstart(ibuff)) .lt. 0 .or. + & tbcol(i+tstart(ibuff)) .ge. rowlen(ibuff) + & .and. rowlen(ibuff) .ne. 0)then + status=234 + call ftkeyn('TBCOL',i,keynam,status) + call ftpmsg('Value of the '//keynam// + & ' keyword is out of range (FTAINI).') + return + +C check that column fits within the table + else if (tbcol(i+tstart(ibuff))+tnull(i+tstart(ibuff)) .gt. + & rowlen(ibuff) .and. rowlen(ibuff) .ne. 0)then + status=236 + write(cnum,1000)i + write(cbcol,1001)tbcol(i+tstart(ibuff))+1 + write(caxis1,1001)rowlen(ibuff) +1000 format(i3) +1001 format(i10) + call ftpmsg('Column '//cnum//' will not fit '// + & 'within the specified width of the ASCII table.') + + call ftpmsg('TFORM='//cform(i+tstart(ibuff))// + & ' TBCOL='//cbcol//' NAXIS1='//caxis1) + return + else if (tdtype(i+tstart(ibuff)) .eq. -9999)then + status=232 + call ftkeyn('TFORM',i,keynam,status) + call ftpmsg('Required '//keynam// + & ' keyword not found (FTAINI).') + return + end if +25 continue + +C now we know everything about the table; just fill in the parameters: +C the 'END' record begins 80 bytes before the current position, +C ignoring any trailing blank keywords just before the END keyword + hdend(ibuff)=nxthdr(ibuff)-80*(nblank+1) + +C the data unit begins at the beginning of the next logical block + dtstrt(ibuff)=((nxthdr(ibuff)-80)/2880+1)*2880 + +C reset header pointer to the first keyword + nxthdr(ibuff)=hdstrt(ibuff,chdu(ibuff)) + +C the next HDU begins in the next logical block after the data + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+(rowlen(ibuff)*nrows+2879)/2880*2880 + +900 continue + end diff --git a/pkg/tbtables/fitsio/ftarch.f b/pkg/tbtables/fitsio/ftarch.f new file mode 100644 index 00000000..25d9525c --- /dev/null +++ b/pkg/tbtables/fitsio/ftarch.f @@ -0,0 +1,40 @@ +C------------------------------------------------------------------------------ + subroutine ftarch(compid) + +C This routine looks at how integers and reals are internally +C stored, to figure out what kind of machine it is running on. + +C compid = 1 - VAX or Alpha VMS system +C 2 - Decstation or Alpha OSF/1, or IBM PC +C 3 - SUN workstation +C 4 - IBM mainframe + + integer compid + real rword + integer*2 iword(2) + equivalence (rword, iword) + +C set rword to some arbitrary value + rword=1.1111111111 + +C Then look at the equivalent integer, to distinquish the machine type. +C The machine type is needed when testing for NaNs. + + if (iword(1) .eq. 16270)then +C looks like a SUN workstation (uses IEEE word format) + compid=3 + else if (iword(1) .eq. 14564)then +C looks like a Decstation, alpha OSF/1, or IBM PC (byte swapped) + compid=2 + else if (iword(1) .eq. 16526)then +C looks like a VAX or ALPHA VMS system + compid=1 + else if (iword(1) .eq. 16657)then +C an IBM main frame (the test for NaNs is the same as on SUNs) + compid=4 + else +C unknown machine + compid=0 + return + end if + end diff --git a/pkg/tbtables/fitsio/ftas2c.f b/pkg/tbtables/fitsio/ftas2c.f new file mode 100644 index 00000000..069b2af0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftas2c.f @@ -0,0 +1,52 @@ +C-------------------------------------------------------------------------- + subroutine ftas2c(array,nchar) + +C convert characters in the array from ASCII codes to +C the machine's native character coding sequence + +C array c array of characters to be converted (in place) +C nchar i number of characters to convert + + character*(*) array + integer nchar,i + + integer ebcd1(128),ebcd2(128),ebcdic(256) + equivalence(ebcd1(1),ebcdic(1)) + equivalence(ebcd2(1),ebcdic(129)) + integer compid + common/ftcpid/compid + +C The following look-up table gives the EBCDIC character code for +C the corresponding ASCII code. The conversion is not universally +C established, so some sites may need to modify this table. +C (The table has been broken into 2 arrays to reduce the number of +C continuation lines in a single statement). + + data ebcd1/0,1,2,3,55,45,46,47,22,5,37,11,12,13,14,15,16,17, + & 18,19,60,61,50,38,24,25,63,39,28,29,30,31,64,79,127,123,91,108, + & 80,125,77,93,92,78,107,96,75,97,240,241,242,243,244,245,246, + & 247,248,249,122,94,76,126,110,111,124,193,194,195,196,197, + & 198,199,200,201,209,210,211,212,213,214,215,216,217,226,227, + & 228,229,230,231,232,233,74,224,90,95,109,121,129,130,131,132, + & 133,134,135,136,137,145,146,147,148,149,150,151,152,153,162, + & 163,164,165,166,167,168,169,192,106,208,161,7/ + + data ebcd2/32,33,34,35,36,21, + & 6,23,40,41,42,43,44,9,10,27,48,49,26,51,52,53,54,8,56,57,58,59, + & 4,20,62,225,65,66,67,68,69,70,71,72,73,81,82,83,84,85,86,87,88, + & 89,98,99,100,101,102,103,104,105,112,113,114,115,116,117,118, + & 119,120,128,138,139,140,141,142,143,144,154,155,156,157,158,159, + & 160,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184, + & 185,186,187,188,189,190,191,202,203,204,205,206,207,218,219,220, + & 221,222,223,234,235,236,237,238,239,250,251,252,253,254,255/ + +C this conversion is only necessary on IBM mainframes (compid=4) +C This executable statement was originally located before the +C data statements, and it was moved here by PEH on 19 June 1998. + if (compid .ne. 4)return + + do 10 i=1,nchar +C find the internal equivalent of the character + array(i:i)=char(ebcdic(ichar(array(i:i))+1)) +10 continue + end diff --git a/pkg/tbtables/fitsio/ftasfm.f b/pkg/tbtables/fitsio/ftasfm.f new file mode 100644 index 00000000..0961ce28 --- /dev/null +++ b/pkg/tbtables/fitsio/ftasfm.f @@ -0,0 +1,143 @@ +C---------------------------------------------------------------------- + subroutine ftasfm(form,dtype,width,decims,status) + +C 'ASCII Format' +C parse the ASCII table TFORM column format to determine the data +C type, the field width, and number of decimal places (if relevant) +C +C form c TFORM format string +C OUTPUT PARAMETERS: +C dattyp i datatype code +C width i width of the field +C decims i number of decimal places +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, November 1994 + + character*(*) form + integer dtype,width,decims,status + character dattyp*1,cform*16 + integer nc,c1,i,nw + + if (status .gt. 0)return + + cform=form + +C find first non-blank character + nc=len(form) + do 5 i=1,nc + if (form(i:i) .ne. ' ')then + c1=i + go to 10 + end if +5 continue + +C error: TFORM is a blank string + status=261 + call ftpmsg('The TFORM keyword has a blank value.') + return + +10 continue + +C now the chararcter at position c1 should be the data type code + dattyp=form(c1:c1) + +C set the numeric datatype code + if (dattyp .eq. 'I')then + dtype=41 + else if (dattyp .eq. 'E')then + dtype=42 + else if (dattyp .eq. 'F')then + dtype=42 + else if (dattyp .eq. 'D')then + dtype=82 + else if (dattyp .eq. 'A')then + dtype=16 + else +C unknown tform datatype code + status=262 + call ftpmsg('Unknown ASCII table TFORMn keyword '// + & 'datatype: '//cform) + return + end if + +C determine the field width + c1=c1+1 + nw=0 + do 40 i=c1,nc + if (form(i:i) .ge. '0' .and. form(i:i).le.'9')then + nw=nw+1 + else + go to 50 + end if +40 continue +50 continue + if (nw .eq. 0)then +C error, no width specified + go to 990 + else + call ftc2ii(form(c1:c1+nw-1),width,status) + if (status .gt. 0 .or. width .eq. 0)then +C unrecognized characters following the type code + go to 990 + end if + end if + +C determine the number of decimal places (if any) + decims=-1 + c1=c1+nw + if (form(c1:c1) .eq. '.')then + c1=c1+1 + nw=0 + do 60 i=c1,nc + if (form(i:i) .ge. '0' .and. form(i:i).le.'9')then + nw=nw+1 + else + go to 70 + end if +60 continue +70 continue + + if (nw .eq. 0)then +C error, no decimals specified + go to 990 + else + call ftc2ii(form(c1:c1+nw-1),decims,status) + if (status .gt. 0)then +C unrecognized characters + go to 990 + end if + end if + else if (form(c1:c1) .ne. ' ')then + go to 990 + end if + +C consistency checks + if (dattyp .eq. 'A' .or. dattyp .eq. 'I')then + if (decims .eq. -1)then + decims=0 + else + go to 990 + end if + else if (decims .eq. -1)then +C number of decmal places must be specified for D, E, or F fields + go to 990 + else if (decims .ge. width)then +C number of decimals must be less than the width + go to 990 + end if + + if (dattyp .eq. 'I')then +C set datatype to SHORT integer if 4 digits or less + if (width .le. 4)dtype=21 + else if (dattyp .eq. 'F')then +C set datatype to DOUBLE if 8 digits or more + if (width .ge. 8)dtype=82 + end if + + return + +990 continue + status=261 + call ftpmsg('Illegal ASCII table TFORMn keyword: '//cform) + end diff --git a/pkg/tbtables/fitsio/ftbdef.f b/pkg/tbtables/fitsio/ftbdef.f new file mode 100644 index 00000000..97c74cf7 --- /dev/null +++ b/pkg/tbtables/fitsio/ftbdef.f @@ -0,0 +1,121 @@ +C-------------------------------------------------------------------------- + subroutine ftbdef(ounit,nfield,tform,pcount,nrows,status) + +C Binary table data DEFinition +C define the structure of the binary table data unit +C +C ounit i Fortran I/O unit number +C nfield i number of fields in the table +C tform C the data format of the column +C nrows i number of rows in the table +C pcount i size in bytes of the special data block following the table +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,nfield,nrows,pcount,status + character*(*) tform(*) + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,i,j,width + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + + if (dtstrt(ibuff) .lt. 0)then +C freeze the header at its current size + call fthdef(ounit,0,status) + if (status .gt. 0)return + end if + + hdutyp(ibuff)=2 + tfield(ibuff)=nfield + + if (nxtfld + nfield .gt. nf)then +C too many columns open at one time; exceeded array dimensions + status=111 + return + end if + + tstart(ibuff)=nxtfld + nxtfld=nxtfld+nfield + + if (nfield .eq. 0)then +C no data; the next HDU begins in the next logical block + hdstrt(ibuff,chdu(ibuff)+1)=dtstrt(ibuff) + scount(ibuff)=0 + theap(ibuff)=0 + nxheap(ibuff)=0 + else +C initialize the table column parameters + do 5 i=1,nfield + tscale(i+tstart(ibuff))=1. + tzero(i+tstart(ibuff))=0. +C choose special value to indicate that null value is not defined + tnull(i+tstart(ibuff))=123454321 +C reset character NUL string, in case it has been +C previously defined from an ASCII table extension + cnull(i+tstart(ibuff))=char(0) + +C parse the tform strings to get the data type and repeat count + call ftbnfm(tform(i),tdtype(i+tstart(ibuff)), + & trept(i+tstart(ibuff)),width,status) + if (tdtype(i+tstart(ibuff)) .eq. 1)then +C treat Bit datatype as if it were a Byte datatype + tdtype(i+tstart(ibuff))=11 + trept(i+tstart(ibuff))=(trept(i+tstart(ibuff))+7)/8 + else if (tdtype(i+tstart(ibuff)) .eq. 16)then +C store ASCII unit string length in TNULL parameter + tnull(i+tstart(ibuff))=width + end if + if (status .gt. 0)return +5 continue + +C determine byte offset of the beginning of each field and row length + call ftgtbc(nfield,tdtype(1+tstart(ibuff)),trept(1+ + & tstart(ibuff)),tbcol(1+tstart(ibuff)),rowlen(ibuff), + & status) + +C FITSIO deals with ASCII columns as arrays of strings, not +C arrays of characters, so need to change the repeat count +C to indicate the number of strings in the field, not the +C total number of characters in the field. + do 10 i=1,nfield + if (tdtype(i+tstart(ibuff)) .eq. 16)then + j=trept(i+tstart(ibuff))/tnull(i+tstart(ibuff)) + trept(i+tstart(ibuff))=max(j,1) + end if +10 continue + +C initialize the heap offset (=nrows x ncolumns) +C store the size of the special data area, if any + scount(ibuff)=pcount + theap(ibuff)=nrows*rowlen(ibuff) + nxheap(ibuff)=0 + +C calculate the start of the next header unit, based on the +C size of the data unit (table + special data) + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+(rowlen(ibuff)*nrows+pcount+2879)/2880*2880 + end if + end diff --git a/pkg/tbtables/fitsio/ftbini.f b/pkg/tbtables/fitsio/ftbini.f new file mode 100644 index 00000000..5f39e763 --- /dev/null +++ b/pkg/tbtables/fitsio/ftbini.f @@ -0,0 +1,181 @@ +C-------------------------------------------------------------------------- + subroutine ftbini(iunit,status) + +C initialize the parameters defining the structure of a binary table + +C iunit i Fortran I/O unit number +C OUTPUT PARAMETERS: +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer lenrow,nrows,pcnt,tfld,nkey,ibuff,i,j,nblank + character keynam*8,value*70,comm*72,cnaxis*8,clen*8,rec*80 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C store the type of HDU (2 = Binary table extension) + hdutyp(ibuff)=2 + +C temporarily set the location of the end of the header to a huge number + hdend(ibuff)=2000000000 + hdstrt(ibuff,chdu(ibuff)+1)=2000000000 + +C check that this is a valid binary table, and get parameters + call ftgtbn(iunit,rowlen(ibuff),nrows,pcnt,tfld,status) + if (status .gt. 0)go to 900 + + if (tfld .gt. nf)then +C arrays not dimensioned large enough for this many fields + status=111 + call ftpmsg('This Binary table has too many fields '// + & 'to be read with FITSIO (FTBINI).') + go to 900 + end if + +C store the number of fields in the common block + tfield(ibuff)=tfld + + if (nxtfld + tfld .gt. nf)then +C too many columns open at one time; exceeded array dimensions + status=111 + return + end if + + tstart(ibuff)=nxtfld + nxtfld=nxtfld+tfld + +C initialize the table field parameters + do 5 i=1,tfld + tscale(i+tstart(ibuff))=1. + tzero(i+tstart(ibuff))=0. + tnull(i+tstart(ibuff))=123454321 + tdtype(i+tstart(ibuff))=-9999 + trept(i+tstart(ibuff))=0 +C reset character NUL string, in case it has been previously +C defined from an ASCII table extension + cnull(i+tstart(ibuff))=char(0) +5 continue + +C initialize the default heap starting address (immediately following +C the table data) and set the next empty heap address +C PCOUNT specifies the amount of special data following the table + scount(ibuff)=pcnt + theap(ibuff)=rowlen(ibuff)*nrows + nxheap(ibuff)=pcnt + +C now read through the rest of the header looking for table column +C definition keywords, and the END keyword. + + nkey=8 +8 nblank=0 +10 nkey=nkey+1 + call ftgrec(iunit,nkey,rec,status) + if (status .eq. 107)then +C if we hit the end of file, then set status = no END card found + status=210 + call ftpmsg('Required END keyword not found in Binary table'// + & ' header (FTBINI).') + go to 900 + else if (status .gt. 0)then + go to 900 + end if + keynam=rec(1:8) + comm=rec(9:80) + + if (keynam(1:1) .eq. 'T')then +C get the binary table parameter (if it is one) + call ftpsvc(rec,value,comm,status) + call ftgbtp(ibuff,keynam,value,status) + else if (keynam .eq. ' ' .and. comm .eq. ' ')then + nblank=nblank+1 + go to 10 + else if (keynam .eq. 'END')then + go to 20 + end if + go to 8 + +20 continue + +C test that all the required keywords were found + do 25 i=1,tfld + if (tdtype(i+tstart(ibuff)) .eq. -9999)then + status=232 + call ftkeyn('TFORM',i,keynam,status) + call ftpmsg('Required '//keynam// + & ' keyword not found (FTAINI).') + return + end if +25 continue + + +C now we know everything about the table; just fill in the parameters: +C the 'END' record begins 80 bytes before the current position, ignoring +C any trailing blank keywords just before the END keyword + hdend(ibuff)=nxthdr(ibuff)-80*(nblank+1) + +C the data unit begins at the beginning of the next logical block + dtstrt(ibuff)=((nxthdr(ibuff)-80)/2880+1)*2880 + +C reset header pointer to the first keyword + nxthdr(ibuff)=hdstrt(ibuff,chdu(ibuff)) + +C the next HDU begins in the next logical block after the data + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+(rowlen(ibuff)*nrows+pcnt+2879)/2880*2880 + +C determine the byte offset of the beginning of each field and row length + if (tfld .gt. 0)then + call ftgtbc(tfld,tdtype(1+tstart(ibuff)), + & trept(1+tstart(ibuff)),tbcol(1+tstart(ibuff)),lenrow,status) + +C FITSIO deals with ASCII columns as arrays of strings, not +C arrays of characters, so need to change the repeat count +C to indicate the number of strings in the field, not the +C total number of characters in the field. + do 30 i=1,tfld + if (tdtype(i+tstart(ibuff)) .eq. 16)then + j=trept(i+tstart(ibuff))/tnull(i+tstart(ibuff)) + trept(i+tstart(ibuff))=max(j,1) + end if +30 continue + if (status .gt. 0)go to 900 + +C check that the sum of the column widths = NAXIS2 value + if (rowlen(ibuff) .ne. lenrow)then + status=241 + write(cnaxis,1001)rowlen(ibuff) + write(clen,1001)lenrow +1001 format(i8) + call ftpmsg('NAXIS1 ='//cnaxis//' not equal'// + & ' to the sum of the column widths ='//clen//' (FTBINI).') + end if + end if + +900 continue + end diff --git a/pkg/tbtables/fitsio/ftbnfm.f b/pkg/tbtables/fitsio/ftbnfm.f new file mode 100644 index 00000000..92c18590 --- /dev/null +++ b/pkg/tbtables/fitsio/ftbnfm.f @@ -0,0 +1,137 @@ +C---------------------------------------------------------------------- + subroutine ftbnfm(form,dtype,rcount,width,status) + +C 'Binary Format' +C parse the binary table column format to determine the data +C type and the repeat count (and string width, if it is an ASCII field) +C +C form c format string +C OUTPUT PARAMETERS: +C dattyp i datatype code +C rcount i repeat count +C width i if ASCII field, this is the width of the unit string +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) form + integer dtype,rcount,width,status,tstat + character dattyp*1,cform*16 + integer point,nc,c1,i,nw + + if (status .gt. 0)return + + cform=form + +C find first non-blank character + nc=len(form) + do 5 i=1,nc + if (form(i:i) .ne. ' ')then + c1=i + go to 10 + end if +5 continue + +C error: TFORM is a blank string + status=261 + call ftpmsg('The TFORM keyword has a blank value.') + return + +10 continue + +C find the size of the field repeat count, if present + nw=0 + do 20 i=c1,nc + if (form(i:i) .ge. '0' .and. form(i:i) .le. '9')then + nw=nw+1 + else + go to 30 + end if +20 continue +30 continue + if (nw .eq. 0)then +C no explicit repeat count, so assume a value of 1 + rcount=1 + else + call ftc2ii(form(c1:c1+nw-1),rcount,status) + if (status .gt. 0)then + call ftpmsg('Error in FTBNFM evaluating TFORM' + & //' repeat value: '//cform) + return + end if + end if + + c1=c1+nw + +C see if this is a variable length pointer column (e.g., 'rPt'); if so, +C then add 1 to the starting search position in the TFORM string + if (form(c1:c1) .eq. 'P')then + point=-1 + c1=c1+1 + rcount=1 + else + point=1 + end if + +C now the chararcter at position c1 should be the data type code + dattyp=form(c1:c1) + +C set the numeric datatype code + if (dattyp .eq. 'I')then + dtype=21 + else if (dattyp .eq. 'J')then + dtype=41 + else if (dattyp .eq. 'E')then + dtype=42 + else if (dattyp .eq. 'D')then + dtype=82 + else if (dattyp .eq. 'A')then + dtype=16 + else if (dattyp .eq. 'L')then + dtype=14 + else if (dattyp .eq. 'X')then + dtype=1 + else if (dattyp .eq. 'B')then + dtype=11 + else if (dattyp .eq. 'C')then + dtype=83 + else if (dattyp .eq. 'M')then + dtype=163 + else +C unknown tform datatype code + status=262 + call ftpmsg('Unknown Binary table TFORMn keyword '// + & 'datatype: '//cform) + return + end if + +C set dtype negative if this is a variable length field ('P') + dtype=dtype*point + +C if this is an ASCII field, determine its width + if (dtype .eq. 16)then + c1=c1+1 + nw=0 + do 40 i=c1,nc + if (form(i:i) .ge. '0' .and. form(i:i).le.'9')then + nw=nw+1 + else + go to 50 + end if +40 continue +50 continue + if (nw .eq. 0)then +C no explicit width field, so assume that the +C width is the same as the repeat count + width=rcount + else + tstat=status + call ftc2ii(form(c1:c1+nw-1),width,status) + if (status .gt. 0)then +C unrecognized characters following the 'A', so ignore it + width=rcount + status=tstat + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftc2as.f b/pkg/tbtables/fitsio/ftc2as.f new file mode 100644 index 00000000..1658e851 --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2as.f @@ -0,0 +1,54 @@ + +C-------------------------------------------------------------------------- + subroutine ftc2as(array,nchar) + +C convert characters from the machines +C native character coding sequence in to ASCII codes + +C array c array of characters to be converted (in place) +C nchar i number of characters to convert + + character*(*) array + integer nchar,i + + integer asci1(128),asci2(128),ascii(256) + equivalence (asci1(1),ascii(1)) + equivalence (asci2(1),ascii(129)) + integer compid + common/ftcpid/compid + +C The following look-up table gives the ASCII character code for +C the corresponding EBCDIC code. The conversion is not universally +C established, so some sites may need to modify this table. +C (The table has been broken into 2 arrays to reduce the number of +C continuation lines in a single statement). + + data asci1/0,1,2,3,156,9,134,127,151,141,142, 11, 12, 13, 14, 15, + & 16, 17, 18, 19,157,133, 8,135, 24, 25,146,143, 28, 29, 30, 31, + & 128,129,130,131,132, 10, 23, 27,136,137,138,139,140, 5, 6, 7, + & 144,145, 22,147,148,149,150, 4,152,153,154,155, 20, 21,158, 26, + & 32,160,161,162,163,164,165,166,167,168, 91, 46, 60, 40, 43, 33, + & 38,169,170,171,172,173,174,175,176,177, 93, 36, 42, 41, 59, 94, + & 45, 47,178,179,180,181,182,183,184,185,124, 44, 37, 95, 62, 63, + & 186,187,188,189,190,191,192,193,194, 96, 58, 35, 64, 39, 61, 34/ + + data asci2/ + & 195, 97, 98, 99,100,101,102,103,104,105,196,197,198,199,200,201, + & 202,106,107,108,109,110,111,112,113,114,203,204,205,206,207,208, + & 209,126,115,116,117,118,119,120,121,122,210,211,212,213,214,215, + & 216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231, + & 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,232,233,234,235,236,237, + & 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,238,239,240,241,242,243, + & 92,159, 83, 84, 85, 86, 87, 88, 89, 90,244,245,246,247,248,249, + & 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,250,251,252,253,254,255/ + +C this conversion is only necessary on IBM mainframes (compid=4) +C This executable statement was originally located before the +C data statements, and it was moved here by PEH on 19 June 1998. + if (compid .ne. 4)return + + do 10 i=1,nchar +C find the ASCII equivalent of the character + array(i:i)=char(ascii(ichar(array(i:i))+1)) +10 continue + end diff --git a/pkg/tbtables/fitsio/ftc2d.f b/pkg/tbtables/fitsio/ftc2d.f new file mode 100644 index 00000000..e8527312 --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2d.f @@ -0,0 +1,38 @@ +C---------------------------------------------------------------------- + subroutine ftc2d(cval,dval,status) +C convert a character string to a double precision value +C perform datatype conversion, if required + + character*(*) cval + integer ival,status + character*1 dtype + logical lval + character*16 sval + double precision dval + + +C convert string to its intrinsic data type + call ftc2x(cval,dtype,ival,lval,sval,dval,status) + if (status .gt. 0)return + + if (dtype .eq. 'F')then +C no datatype conversion required, so just return + else if (dtype .eq. 'I')then +C convert from integer to double precision + dval=ival + else if (dtype .eq. 'L')then +C need to convert from logical to double precision + if (lval)then + dval=1. + else + dval=0. + end if + else if (dtype .eq. 'C')then +C can't convert a string to double precision, so return error + dval=0 + status=406 + sval=cval + call ftpmsg('Error in FTC2D evaluating this string '// + & 'as a double value: '//sval) + end if + end diff --git a/pkg/tbtables/fitsio/ftc2dd.f b/pkg/tbtables/fitsio/ftc2dd.f new file mode 100644 index 00000000..dfd7ac68 --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2dd.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftc2dd(cval,val,status) + +C convert a character string to double prec. +C (assumes that the input string is left justified) +C cval c input character string to be converted +C val d output value +C status i output error status (0 = OK) + + character*(*) cval + double precision val + integer status,nleng + character iform*8,sval*16 + + if (status .gt. 0)return + +C find length of the input double character string + nleng=index(cval,' ')-1 + if (nleng .eq. -1)nleng=len(cval) + +C construct the format statement to read the character string + if (nleng .le. 9)then + write(iform,1000)nleng +1000 format('(F',I1,'.0)') + else + write(iform,1001)nleng +1001 format('(F',I2,'.0)') + end if + + read(cval,iform,err=900)val + return + +900 status=409 + sval=cval + call ftpmsg('Error in FTC2DD evaluating this string '// + & 'as a double: '//sval) + end diff --git a/pkg/tbtables/fitsio/ftc2i.f b/pkg/tbtables/fitsio/ftc2i.f new file mode 100644 index 00000000..f63493ec --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2i.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftc2i(cval,ival,status) +C convert a character string to an integer +C perform datatype conversion, if required + + integer ival,status + character*(*) cval + character*1 dtype + logical lval + character sval*16 + double precision dval + +C convert string to its intrinsic data type + call ftc2x(cval,dtype,ival,lval,sval,dval,status) + if (status .gt. 0)return + + if (dtype .eq. 'I')then +C no datatype conversion required, so just return + else if (dtype .eq. 'F')then +C need to convert from floating point to integer + ival=dval + else if (dtype .eq. 'L')then +C need to convert from logical to integer + if (lval)then + ival=1 + else + ival=0 + end if + else if (dtype .eq. 'C')then +C can't convert a string to an integer, so return error + ival=0 + status=403 + sval=cval + call ftpmsg('Error in FTC2I evaluating this string as an ' + & //'integer: '//sval) + end if + end diff --git a/pkg/tbtables/fitsio/ftc2ii.f b/pkg/tbtables/fitsio/ftc2ii.f new file mode 100644 index 00000000..350d51ee --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2ii.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftc2ii(cval,ival,status) +C convert a character string to an integer +C (assumes that the input string is left justified) + + integer ival,status,nleng + character*(*) cval + character*8 iform + + if (status .gt. 0)return + + if (cval .eq. ' ')go to 900 + +C find length of the input integer character string + nleng=index(cval,' ')-1 + if (nleng .eq. -1)nleng=len(cval) + +C construct the format statement to read the character string + if (nleng .le. 9)then + write(iform,1000)nleng +1000 format('(I',I1,')') + else + write(iform,1001)nleng +1001 format('(I',I2,')') + end if + + read(cval,iform,err=900)ival + return + +900 continue +C work around for bug in the DEC Alpha VMS compiler + if (cval(1:nleng) .eq. '-2147483648')then + ival=-2147483647 - 1 + else + status=407 + end if + end diff --git a/pkg/tbtables/fitsio/ftc2l.f b/pkg/tbtables/fitsio/ftc2l.f new file mode 100644 index 00000000..8a1e22ef --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2l.f @@ -0,0 +1,26 @@ +C---------------------------------------------------------------------- + subroutine ftc2l(cval,lval,status) + +C convert a character string to a logical value +C perform datatype conversion, if required + + logical lval + integer ival,status + character*(*) cval + character*1 dtype + character sval*16 + double precision dval + + +C convert string to its intrinsic data type + call ftc2x(cval,dtype,ival,lval,sval,dval,status) + if (status .gt. 0)return + + if (dtype .ne. 'L')then +C this is not a logical keyword, so return error + status=404 + sval=cval + call ftpmsg('Error in FTC2L evaluating this string '// + & 'as a logical value: '//sval) + end if + end diff --git a/pkg/tbtables/fitsio/ftc2ll.f b/pkg/tbtables/fitsio/ftc2ll.f new file mode 100644 index 00000000..83bb6d19 --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2ll.f @@ -0,0 +1,18 @@ +C---------------------------------------------------------------------- + subroutine ftc2ll(cval,lval,status) +C convert a character string to a logical value +C (assumes that the input string is left justified) + integer status + logical lval + character*(*) cval + + if (status .gt. 0)return + +C convert character string to logical + if (cval(1:1) .eq.'T')then + lval=.true. + else +C any other character is considered false + lval=.false. + end if + end diff --git a/pkg/tbtables/fitsio/ftc2r.f b/pkg/tbtables/fitsio/ftc2r.f new file mode 100644 index 00000000..71909d70 --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2r.f @@ -0,0 +1,40 @@ +C---------------------------------------------------------------------- + subroutine ftc2r(cval,rval,status) +C convert a character string to a real value +C perform datatype conversion, if required + + character*(*) cval + real rval + integer ival,status + character*1 dtype + logical lval + character*16 sval + double precision dval + + +C convert string to its intrinsic data type + call ftc2x(cval,dtype,ival,lval,sval,dval,status) + if (status .gt. 0)return + + if (dtype .eq. 'F')then +C convert from double to single precision + rval=dval + else if (dtype .eq. 'I')then +C convert from integer to real + rval=ival + else if (dtype .eq. 'L')then +C need to convert from logical to real + if (lval)then + rval=1. + else + rval=0. + end if + else if (dtype .eq. 'C')then +C can't convert a string to a real, so return error + rval=0 + status=405 + sval=cval + call ftpmsg('Error in FTC2R evaluating this string '// + & 'as a real value: '//sval) + end if + end diff --git a/pkg/tbtables/fitsio/ftc2rr.f b/pkg/tbtables/fitsio/ftc2rr.f new file mode 100644 index 00000000..8f11286e --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2rr.f @@ -0,0 +1,39 @@ +C---------------------------------------------------------------------- + subroutine ftc2rr(cval,val,status) + +C convert a character string to a real value +C (assumes that the input string is left justified) +C cval c input character string to be converted +C val r output value +C status i output error status (0 = OK) + + character*(*) cval + real val + integer status,nleng + character iform*8,sval*16 + + if (status .gt. 0)return + + if (cval .eq. ' ')go to 900 + +C find length of the input real character string + nleng=index(cval,' ')-1 + if (nleng .eq. -1)nleng=len(cval) + +C construct the format statement to read the character string + if (nleng .le. 9)then + write(iform,1000)nleng +1000 format('(F',I1,'.0)') + else + write(iform,1001)nleng +1001 format('(F',I2,'.0)') + end if + + read(cval,iform,err=900)val + return + +900 status=408 + sval=cval + call ftpmsg('Error in FTC2RR evaluating this string '// + & 'as a real: '//sval) + end diff --git a/pkg/tbtables/fitsio/ftc2s.f b/pkg/tbtables/fitsio/ftc2s.f new file mode 100644 index 00000000..460b7d34 --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2s.f @@ -0,0 +1,65 @@ +C---------------------------------------------------------------------- + subroutine ftc2s(in,cval,status) +C convert an input quoted string to an unquoted string +C +C The first character of the input string must be a quote character (') +C and at least one additional quote character must also be present in the +C input string. This routine then simply outputs all the characters +C between the first and last quote characters in the input string. +C +C in c input quoted string +C cval c output unquoted string +C status i output error status (0=ok, 1=first quote missing, +C 2=second quote character missing. + + character*(*) in,cval + integer length,i,j,i2,status + character*1 dtype + +C test for datatype + call ftdtyp(in,dtype,status) + if (status .gt. 0)return + if (dtype .ne. 'C')then +C do no conversion and just return the raw character string + cval=in + else +C convert character string to unquoted string + +C find closing quote character + length=len(in) + i2=length-1 + do 10 i=length,2,-1 + if (in(i:i) .eq. '''')go to 20 + i2=i2-1 +10 continue +20 continue + + if (i2 .eq. 0)then +C there was no closing quote character + status=205 + call ftpmsg('The following keyword value string has no ' + & //'closing quote:') + call ftpmsg(in) + else if (i2 .eq. 1)then +C null string + cval=' ' + else + cval=in(2:i2) + +C test for double single quote characters; if found, +C then delete one of the quotes (FITS uses 2 single +C quote characters to represent a single quote) + i2=i2-2 + do 30 i=1,i2 + if (cval(i:i) .eq. '''')then + if (cval(i+1:i+1) .eq. '''')then + do 40 j=i+1,i2 + cval(j:j)=cval(j+1:j+1) +40 continue + cval(i2:i2)=' ' + end if + end if +30 continue + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftc2x.f b/pkg/tbtables/fitsio/ftc2x.f new file mode 100644 index 00000000..804c251e --- /dev/null +++ b/pkg/tbtables/fitsio/ftc2x.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftc2x(cval,dtype,ival,lval,sval,dval,status) + +C convert a character string into it intrinsic data type + +C cval c input character string to be converted +C dtype c returned intrinsic datatype of the string (I,L,C,F) +C +C one of the following values is returned, corresponding to the +C value of dtype: +C ival i integer value +C lval l logical value +C sval c string value +C dval d double precision value +C statue i returned error status + + character*(*) cval + character*1 dtype + integer ival,status + logical lval + character*(*) sval + double precision dval + +C determine intrinsic datatype + call ftdtyp(cval,dtype,status) + +C convert string into its intrinsic datatype + if (dtype .eq. 'I')then + call ftc2ii(cval,ival,status) + else if (dtype .eq. 'F')then + call ftc2dd(cval,dval,status) + else if (dtype .eq. 'L')then + call ftc2ll(cval,lval,status) + else if (dtype .eq. 'C')then + call ftc2s(cval,sval,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftcdel.f b/pkg/tbtables/fitsio/ftcdel.f new file mode 100644 index 00000000..e228486d --- /dev/null +++ b/pkg/tbtables/fitsio/ftcdel.f @@ -0,0 +1,136 @@ +C-------------------------------------------------------------------------- + subroutine ftcdel(iunit,naxis1,naxis2,delbyt,fstbyt,status) + +C delete a specified column by shifting the rows + +C iunit i Fortran I/O unit number +C naxis1 i width in bytes of existing table +C naxis2 i number of rows in the table +C delbyt i how many bytes to delete in each row +C fstbyt i byte position in the row to delete the bytes (0=row start) +C status i returned error status (0=ok) + + integer iunit,naxis1,naxis2,delbyt,fstbyt,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,i,i1,i2,irow,newlen,nseg,nbytes,remain + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + + newlen=naxis1-delbyt + + if (newlen .le. 5760)then +C *********************************************************************** +C CASE #1: optimal case where whole new row fits in the work buffer +C *********************************************************************** + i1=fstbyt+1 + i2=i1+delbyt + do 10 irow=1,naxis2-1 +C read the row to be shifted + call ftgtbs(iunit,irow,i2,newlen,buff,status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row in the new place + call ftptbs(iunit,irow,i1,newlen,buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 +10 continue + +C now do the last row + remain=naxis1-(fstbyt+delbyt) + if (remain .gt. 0)then +C read the row to be shifted + call ftgtbs(iunit,naxis2,i2,remain,buff,status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row in the new place + call ftptbs(iunit,naxis2,i1,remain,buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 + end if + else +C ************************************************************************ +C CASE #2: whole row doesn't fit in work buffer; move row in pieces +C ************************************************************************ + nseg=(newlen+5759)/5760 + + do 40 irow=1,naxis2-1 + i1=fstbyt+1 + i2=i1+delbyt + nbytes=newlen-(nseg-1)*5760 + + do 30 i=1,nseg +C read the row to be shifted + call ftgtbs(iunit,irow,i2,nbytes,buff,status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row in the new place + call ftptbs(iunit,irow,i1,nbytes,buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 + + i1=i1+nbytes + i2=i2+nbytes + nbytes=5760 +30 continue +40 continue + +C now do the last row + remain=naxis1-(fstbyt+delbyt) + if (remain .gt. 0)then + nseg=(remain+5759)/5760 + i1=fstbyt+1 + i2=i1+delbyt + nbytes=remain-(nseg-1)*5760 + + do 50 i=1,nseg +C read the row to be shifted + call ftgtbs(iunit,naxis2,i2,nbytes,buff,status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row in the new place + call ftptbs(iunit,naxis2,i1,nbytes,buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 + + i1=i1+nbytes + i2=i2+nbytes + nbytes=5760 +50 continue + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftcdfl.f b/pkg/tbtables/fitsio/ftcdfl.f new file mode 100644 index 00000000..2429eae5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftcdfl.f @@ -0,0 +1,80 @@ +C---------------------------------------------------------------------- + subroutine ftcdfl(iunit,status) + +C Check Data Unit Fill values +C Check that the data unit is correctly filled with zeros or blanks +C from the end of the data to the end of the current FITS 2880 byte block + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1994 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nf = 3000) + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 chbuff(2880),chfill,xdummy(2879) + common/ftheap/chbuff,chfill,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,filpos,nfill,i + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check if the data unit is null + if (theap(ibuff) .eq. 0)return + +C move to the beginning of the fill bytes + filpos=dtstrt(ibuff)+theap(ibuff)+scount(ibuff) + call ftmbyt(iunit,filpos,.true.,status) + +C get all the fill bytes + nfill=(filpos+2879)/2880*2880-filpos + if (nfill .eq. 0)return + + call ftgcbf(iunit,0,nfill,chbuff,status) + if (status .gt. 0)then + call ftpmsg('Error reading data unit fill bytes (FTCDFL).') + return + end if + +C set the correct fill value to be checked + if (hdutyp(ibuff) .eq. 1)then +C this is an ASCII table; should be filled with blanks + chfill=char(32) + else + chfill=char(0) + end if + +C check for all zeros or blanks + do 10 i=1,nfill + if (chbuff(i) .ne. chfill)then + status=255 + if (hdutyp(ibuff) .eq. 1)then + call ftpmsg('Warning: remaining bytes following'// + & ' ASCII table data are not filled with blanks.') + else + call ftpmsg('Warning: remaining bytes following'// + & ' data are not filled with zeros.') + end if + return + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftchdu.f b/pkg/tbtables/fitsio/ftchdu.f new file mode 100644 index 00000000..0e125727 --- /dev/null +++ b/pkg/tbtables/fitsio/ftchdu.f @@ -0,0 +1,58 @@ +C---------------------------------------------------------------------- + subroutine ftchdu(iunit,status) + +C Close Header Data Unit +C If we have write access to the file, then close the current HDU by: +C -padding remaining space in the header with blanks +C -writing the END keyword in the CHU +C -check the data fill values, and rewrite them if not correct +C -flushing the current buffer to disk +C -recover common block space containing column descriptors + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + +C ignore input status and close HDU regardless of input status value + + ibuff=bufnum(iunit) + +C see if we have write access to this file + if (wrmode(ibuff))then +C rewrite the header END card and the following blank fill, and +C insure that the internal data structure matches the keywords + call ftrdef(iunit,status) + +C write the correct data fill values, if they are not already correct + call ftpdfl(iunit,status) + end if + +C set current column name buffer as undefined + call ftrsnm + +C flush the buffers holding data for this HDU + call ftflsh(ibuff,status) + +C recover common block space containing column descriptors for this HDU + call ftfrcl(iunit,status) + + if (status .gt. 0)then + call ftpmsg('Error while closing current HDU (FTCHDU).') + end if + end diff --git a/pkg/tbtables/fitsio/ftchfl.f b/pkg/tbtables/fitsio/ftchfl.f new file mode 100644 index 00000000..9da24278 --- /dev/null +++ b/pkg/tbtables/fitsio/ftchfl.f @@ -0,0 +1,72 @@ +C---------------------------------------------------------------------- + subroutine ftchfl(iunit,status) + +C Check Header Fill values +C Check that the header unit is correctly filled with blanks from the +C END card to the end of the current FITS 2880-byte block + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1994 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,nblank,i,endpos + character*80 rec + logical gotend + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C calculate the number of blank keyword slots in the header + endpos=hdend(ibuff) + nblank=(dtstrt(ibuff)-endpos)/80 +C move the i/o pointer to the end of the header keywords + call ftmbyt(iunit,endpos,.true.,status) +C find the END card (there may be blank keywords perceeding it) + + gotend=.false. + do 10 i=1,nblank + call ftgcbf(iunit,1,80,rec,status) + if (rec(1:8) .eq. 'END ')then + if (gotend)then +C there is a duplicate END record + status=254 + call ftpmsg('Warning: Header fill area contains '// + & 'duplicate END card:') + end if + gotend=.true. + if (rec(9:80) .ne. ' ')then +C END keyword has extra characters + status=253 + call ftpmsg('Warning: END keyword contains '// + & 'extraneous non-blank characters:') + end if + else if (gotend)then + if (rec .ne. ' ')then +C The fill area contains extraneous characters + status=254 + call ftpmsg('Warning: Header fill area contains '// + & 'extraneous non-blank characters:') + end if + end if + + if (status .gt. 0)then + call ftpmsg(rec) + return + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftcins.f b/pkg/tbtables/fitsio/ftcins.f new file mode 100644 index 00000000..08485ce3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftcins.f @@ -0,0 +1,173 @@ +C-------------------------------------------------------------------------- + subroutine ftcins(iunit,naxis1,naxis2,delbyt,fstbyt,status) + +C insert DELBYT bytes after byte fstbyt in every row of the table + +C iunit i Fortran I/O unit number +C naxis1 i width in bytes of existing table +C naxis2 i number of rows in the table +C delbyt i how many bytes to insert in each row +C fstbyt i byte position in the row to insert the bytes (0=row start) +C status i returned error status (0=ok) + + integer iunit,naxis1,naxis2,delbyt,fstbyt,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,i,i1,irow,newlen,fbyte,nseg,nbytes + character cfill*1 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C select appropriate fill value + if (hdutyp(ibuff) .eq. 1)then +C fill header or ASCII table with space + cfill=char(32) + else +C fill image or bintable data area with Null (0) + cfill=char(0) + end if + + newlen=naxis1+delbyt + + if (newlen .le. 5760)then +C *********************************************************************** +C CASE #1: optimal case where whole new row fits in the work buffer +C *********************************************************************** +C write the correct fill value into the buffer + do 10 i=1,delbyt + buff(i)=cfill +10 continue + i1=delbyt+1 + +C first move the trailing bytes (if any) in the last row + fbyte=fstbyt+1 + nbytes=naxis1-fstbyt + call ftgtbs(iunit,naxis2,fbyte,nbytes,buff(i1),status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row (with leading fill bytes) in the new place + nbytes=nbytes+delbyt + call ftptbs(iunit,naxis2,fbyte,nbytes,buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 + +C now move the rest of the rows + do 20 irow=naxis2-1,1,-1 +C read the row to be shifted (work backwards through the table) + call ftgtbs(iunit,irow,fbyte,naxis1,buff(i1),status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row (with the leading fill bytes) in the new place + call ftptbs(iunit,irow,fbyte,newlen,buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 +20 continue + + else +C ************************************************************************ +C CASE #2: whole row doesn't fit in work buffer; move row in pieces +C ************************************************************************ +C first copy the data, then go back and write fill into the new column +C start by copying the trailing bytes (if any) in the last row + + nbytes=naxis1-fstbyt + nseg=(nbytes+5759)/5760 + fbyte=(nseg-1)*5760+fstbyt+1 + nbytes=naxis1-fbyte+1 + + do 25 i=1,nseg + call ftgtbs(iunit,naxis2,fbyte,nbytes,buff,status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row in the new place + call ftptbs(iunit,naxis2,fbyte+delbyt,nbytes, + & buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 + + fbyte=fbyte-5760 + nbytes=5760 +25 continue + +C now move the rest of the rows + nseg=(naxis1+5759)/5760 + + do 40 irow=naxis2-1,1,-1 + fbyte=(nseg-1)*5760+fstbyt+1 + nbytes=naxis1-(nseg-1)*5760 + do 30 i=1,nseg +C read the row to be shifted (work backwards thru the table) + call ftgtbs(iunit,irow,fbyte,nbytes,buff,status) + +C set row length to its new value + rowlen(ibuff)=newlen + +C write the row in the new place + call ftptbs(iunit,irow,fbyte+delbyt,nbytes, + & buff,status) + +C reset row length to its original value + rowlen(ibuff)=naxis1 + + fbyte=fbyte-5760 + nbytes=5760 +30 continue +40 continue + +C now write the fill values into the new column + nbytes=min(delbyt,5760) + do 50 i=1,nbytes + buff(i)=cfill +50 continue + + nseg=(delbyt+5759)/5760 + +C set row length to its new value + rowlen(ibuff)=newlen + + do 70 irow=1,naxis2 + fbyte=fstbyt+1 + nbytes=delbyt-((nseg-1)*5760) + do 60 i=1,nseg +C write the fill + call ftptbs(iunit,irow,fbyte,nbytes,buff,status) + fbyte=fbyte+nbytes + nbytes=5760 +60 continue +70 continue + +C reset the rowlength + rowlen(ibuff)=naxis1 + end if + end diff --git a/pkg/tbtables/fitsio/ftclos.f b/pkg/tbtables/fitsio/ftclos.f new file mode 100644 index 00000000..d5a1eb75 --- /dev/null +++ b/pkg/tbtables/fitsio/ftclos.f @@ -0,0 +1,21 @@ +C-------------------------------------------------------------------------- + subroutine ftclos(iunit,status) + +C close a FITS file that was previously opened with ftopen or ftinit +C +C iunit i Fortran I/O unit number +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,status + + logical keep + +C close the current HDU and pad the header with blanks + call ftchdu(iunit,status) + +C close the file + keep=.true. + call ftclsx(iunit,keep,status) + end diff --git a/pkg/tbtables/fitsio/ftcmps.f b/pkg/tbtables/fitsio/ftcmps.f new file mode 100644 index 00000000..3ba41e38 --- /dev/null +++ b/pkg/tbtables/fitsio/ftcmps.f @@ -0,0 +1,104 @@ +C-------------------------------------------------------------------------- + subroutine ftcmps(templt,string,casesn,match,exact) + +C compare the template to the string and test if they match. +C The strings are limited to 68 characters or less (the max. length +C of a FITS string keyword value. This routine reports whether +C the two strings match and whether the match is exact or +C involves wildcards. + +C this algorithm is very similar to the way unix filename wildcards +C work except that this first treats a wild card as a literal character +C when looking for a match. If there is no literal match, then +C it interpretes it as a wild card. So the template 'AB*DE' +C is considered to be an exact rather than a wild card match to +C the string 'AB*DE'. + +C templt C input template (may includ % or * wild cards) +C string C input string to be compared to template +C casesn L should comparison be case sensitive? +C match L (output) does the template match the string? +C exact L (output) are the strings an exact match (true) or +C is it a wildcard match (false) + +C written by Wm Pence, HEASARC/GSFC, December 1994 + + character*(*) templt,string + logical casesn,match,exact + character*68 temp,str + integer tlen,slen,t1,s1 + + tlen=len(templt) + slen=len(string) + tlen=min(tlen,68) + slen=min(tlen,68) + + match=.false. + exact=.true. + temp=templt + str=string + if (.not. casesn)then + call ftupch(temp) + call ftupch(str) + end if + +C check for exact match + if (temp .eq. str)then + match=.true. + return + else +C the strings are not identical, any match cannot be exact + exact=.false. + end if + + t1=1 + s1=1 +10 continue + if (t1 .gt. tlen .or. s1 .gt. slen)then +C completely scanned one or both strings, so it must be a match + match=.true. + return + end if + +C see if the characters in the 2 strings are an exact match + if (temp(t1:t1) .eq. str(s1:s1))then + s1=s1+1 + t1=t1+1 + else + exact=.false. + if (temp(t1:t1) .eq. '?')then +C The '?' wild card matches anything + s1=s1+1 + t1=t1+1 + else if (temp(t1:t1) .eq. '*')then +C get next character from template and look for it in the string + t1=t1+1 + if (t1 .le. tlen)then + if (temp(t1:t1) .eq. ' ')then +C * is followed by a space, so a match is guaranteed + t1=tlen+1 + else +20 continue + if (temp(t1:t1) .eq. str(s1:s1))then +C found a matching character + t1=t1+1 + s1=s1+1 + else +C increment the string pointer and try again + s1=s1+1 + if (s1 .le. slen)then + go to 20 + else +C hit end of string and failed to find a match + return + end if + end if + end if + end if + else +C match failed + return + end if + end if + go to 10 + end diff --git a/pkg/tbtables/fitsio/ftcmsg.f b/pkg/tbtables/fitsio/ftcmsg.f new file mode 100644 index 00000000..daae979a --- /dev/null +++ b/pkg/tbtables/fitsio/ftcmsg.f @@ -0,0 +1,6 @@ +C------------------------------------------------------------------------------ + subroutine ftcmsg + +C clear the error message stack + call ftxmsg(0,'dummy') + end diff --git a/pkg/tbtables/fitsio/ftcopy.f b/pkg/tbtables/fitsio/ftcopy.f new file mode 100644 index 00000000..439a5314 --- /dev/null +++ b/pkg/tbtables/fitsio/ftcopy.f @@ -0,0 +1,84 @@ +C---------------------------------------------------------------------- + subroutine ftcopy(iunit,ounit,moreky,status) + +C copies the CHDU from IUNIT to the CHDU of OUNIT. +C This will also reserve space in the header for MOREKY keywords +C if MOREKY > 0. + +C iunit i fortran unit number of the input file to be copied +C ounit i fortran unit number of the output file to be copied to +C moreky i create space in header for this many more keywords +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Jan, 1992 + + integer iunit,ounit,moreky,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,obuff,i,nkeys,nadd + integer bitpix,naxis,naxes(99),pcount,gcount + character hrec*80 + logical simple,extend + + if (status .gt. 0)return + + if (iunit .eq. ounit)then + status=101 + return + end if + + ibuff=bufnum(iunit) + obuff=bufnum(ounit) + +C find out the number of keywords which exist in the input CHDU + call ftghsp(iunit,nkeys,nadd,status) + +C copy the keywords one at a time to the output CHDU + if ( (chdu(ibuff) .eq. 1 .and. chdu(obuff) .ne. 1) .or. + & (chdu(ibuff) .ne. 1 .and. chdu(obuff) .eq. 1) )then +C copy primary array to image extension, or vise versa + +C copy the required keywords: + simple=.true. + extend=.true. + call ftghpr(iunit,99,simple,bitpix,naxis, + & naxes,pcount,gcount,extend,status) + if (status .gt. 0)return + call ftphpr(ounit,simple,bitpix,naxis, + & naxes,pcount,gcount,extend,status) + if (status .gt. 0)return + +C copy remaining keywords, excluding pcount, gcount and extend + do 10 i=naxis+4,nkeys + call ftgrec(iunit,i,hrec,status) + if (hrec(1:8) .ne. 'PCOUNT ' .and. + & hrec(1:8) .ne. 'GCOUNT ' .and. + & hrec(1:8) .ne. 'EXTEND ')then + call ftprec(ounit,hrec,status) + end if +10 continue + else +C just copy all the keys exactly from the input file to the output + do 20 i=1,nkeys + call ftgrec(iunit,i,hrec,status) + call ftprec(ounit,hrec,status) +20 continue + end if + +C reserve space for more keywords (if moreky > 0) + call fthdef(ounit,moreky,status) + +C now ccopy the data from the input CHDU to the output CHDU + call ftcpdt(iunit,ounit,status) + + end diff --git a/pkg/tbtables/fitsio/ftcpdt.f b/pkg/tbtables/fitsio/ftcpdt.f new file mode 100644 index 00000000..eac1c8fe --- /dev/null +++ b/pkg/tbtables/fitsio/ftcpdt.f @@ -0,0 +1,58 @@ +C---------------------------------------------------------------------- + subroutine ftcpdt(iunit,ounit,status) + +C copies the data from the IUNIT CHDU to the data of the OUNIT CHDU. +C This will overwrite any data already in the OUNIT CHDU. + +C iunit i fortran unit number of the input file to be copied +C ounit i fortran unit number of the output file to be copied to +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Aug 1993 + + integer iunit,ounit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 cbuff(2880), xdummy(2880) + common/ftheap/cbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,obuff,nblock,i + + if (status .gt. 0)return + + if (iunit .eq. ounit)then + status=101 + return + end if + + ibuff=bufnum(iunit) + obuff=bufnum(ounit) + +C determine HDU structure as defined by keywords in output file + call ftrdef(ounit,status) + +C Calculate the number of bytes to be copied. By definition there +C will be an integral number of 2880-byte logical blocks to be copied + nblock=(hdstrt(ibuff,chdu(ibuff)+1)-dtstrt(ibuff))/2880 + + if (nblock .gt. 0)then +C move to the beginning of the data in the input and output files + call ftmbyt(iunit,dtstrt(ibuff),.false.,status) + call ftmbyt(ounit,dtstrt(obuff),.true.,status) + +C now copy the data one block at a time + do 30 i=1,nblock + call ftgcbf(iunit,0,2880,cbuff,status) + call ftpcbf(ounit,0,2880,cbuff,status) +30 continue + end if + end diff --git a/pkg/tbtables/fitsio/ftcrep.f b/pkg/tbtables/fitsio/ftcrep.f new file mode 100644 index 00000000..088f2c07 --- /dev/null +++ b/pkg/tbtables/fitsio/ftcrep.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftcrep(comm,comm1,repeat) + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + +C comm c input comment string +C OUTPUT PARAMETERS: +C comm1 c output comment string, = COMM minus the last '&' character +C repeat l true if the last character of COMM was the '&" character +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) comm,comm1 + logical repeat + integer i,j + + repeat=.false. + j=len(comm) + do 10 i=j,1,-1 + if (comm(i:i) .ne. ' ')then + if (comm(i:i) .eq. '&')then + comm1=comm(1:i-1) + repeat=.true. + end if + return + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftcrhd.f b/pkg/tbtables/fitsio/ftcrhd.f new file mode 100644 index 00000000..7b64b1bf --- /dev/null +++ b/pkg/tbtables/fitsio/ftcrhd.f @@ -0,0 +1,53 @@ +C---------------------------------------------------------------------- + subroutine ftcrhd(iunit,status) + +C 'CReate Header Data unit' +C create, initialize, and move the i/o pointer to a new extension at +C the end of the FITS file. + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + +C close the current HDU + call ftchdu(iunit,status) + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check that we haven't exceeded the maximum allowed number of extensions + if (maxhdu(ibuff)+1 .ge. ne)then + status=301 + return + end if + +C move to the end of the highest known extension + call ftmbyt(iunit,hdstrt(ibuff,maxhdu(ibuff)+1),.true.,status) + +C initialize various parameters about the CHDU + maxhdu(ibuff)=maxhdu(ibuff)+1 + chdu(ibuff)=maxhdu(ibuff) + nxthdr(ibuff)=hdstrt(ibuff,chdu(ibuff)) +C the logical location of the END record at the start of the header + hdend(ibuff)=nxthdr(ibuff) +C the data start location is undefined + dtstrt(ibuff)=-2000000000 + end diff --git a/pkg/tbtables/fitsio/ftcsum.f b/pkg/tbtables/fitsio/ftcsum.f new file mode 100644 index 00000000..0e056af9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftcsum.f @@ -0,0 +1,52 @@ +C-------------------------------------------------------------------------- + subroutine ftcsum(iunit,nrec,sum,status) + +C Calculate a 32-bit 1's complement checksum of the FITS 2880-byte blocks. +C This Fortran algorithm is based on the C algorithm developed by Rob +C Seaman at NOAO that was presented at the 1994 ADASS conference, to be +C published in the Astronomical Society of the Pacific Conference Series. + +C This uses a 32-bit 1's complement checksum in which the overflow bits +C are permuted back into the sum and therefore all bit positions are +C sampled evenly. In this Fortran version of the original C algorithm, +C a double precision value (which has at least 48 bits of precision) +C is used to accumulate the checksum because standard Fortran does not +C support an unsigned integer datatype. + +C iunit i fortran unit number +C nrec i number of FITS 2880-byte blocks to be summed +C sum d check sum value (initialize to zero before first call) +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Sept, 1994 + + integer iunit,nrec,status,i,j,hibits,i4vals(720) + double precision sum,word32 + parameter (word32=4.294967296D+09) +C word32 is equal to 2**32 + + if (status .gt. 0)return + +C Sum the specified number of FITS 2880-byte records. This assumes that +C the FITSIO file pointer points to the start of the records to be summed. + do 30 j=1,nrec + +C read the record as 720 pixel I*4 vector (do byte swapping if needed) + call ftgi4b(iunit,720,0,i4vals,status) + do 10 i=1,720 + if (i4vals(i) .ge. 0)then + sum=sum+i4vals(i) + else +C sign bit is set, so add the equalvalent unsigned value + sum=sum+(word32+i4vals(i)) + end if +10 continue + +C fold any overflow bits beyond 32 back into the word +20 hibits=sum/word32 + if (hibits .gt. 0)then + sum=sum-(hibits*word32)+hibits + go to 20 + end if +30 continue + end diff --git a/pkg/tbtables/fitsio/ftd2e.f b/pkg/tbtables/fitsio/ftd2e.f new file mode 100644 index 00000000..71cbb7bc --- /dev/null +++ b/pkg/tbtables/fitsio/ftd2e.f @@ -0,0 +1,43 @@ +C---------------------------------------------------------------------- + subroutine ftd2e(val,dec,cval,vlen,status) + +C convert a double precision value to an E format character string +C If it will fit, the value field will be 20 characters wide; +C otherwise it will be expanded to up to 35 characters, left +C justified. +C +C val d input value to be converted +C dec i number of decimal places to display in output string +C cval c output character string +C vlen i length of output string +C status i output error status (0 = OK) + + double precision val + integer dec,vlen,status + character*35 cval,form*10 + + if (status .gt. 0)return + + if (dec .ge. 1 .and. dec .le. 9)then + vlen=20 + write(form,2000)dec +2000 format('(1pe20.',i1,')') + else if (dec .ge. 10 .and. dec .le. 28)then + vlen=max(20,dec+7) + write(form,2001)vlen,dec +2001 format('(1pe',i2,'.',i2,')') + else +C illegal number of decimal places were specified + status=411 + call ftpmsg('Error in FTR2E: number of decimal places ' + & //'is less than 1 or greater than 28.') + return + endif + + write(cval,form,err=900)val + if (cval(1:1) .eq. '*')go to 900 + return + +900 status=402 + call ftpmsg('Error in FTD2E converting double to En.m string.') + end diff --git a/pkg/tbtables/fitsio/ftd2f.f b/pkg/tbtables/fitsio/ftd2f.f new file mode 100644 index 00000000..2a8de134 --- /dev/null +++ b/pkg/tbtables/fitsio/ftd2f.f @@ -0,0 +1,36 @@ +C---------------------------------------------------------------------- + subroutine ftd2f(val,dec,cval,status) + +C convert double precision value to F20.* format character string +C NOTE: some precision may be lost +C val d input value to be converted +C dec i number of decimal places to display in output string +C cval c output character string +C status i output error status (0 = OK) + + double precision val + integer dec,status + character*20 cval,form*8 + + if (status .gt. 0)return + + if (dec .ge. 0 .and. dec .le. 9)then + write(form,2000)dec +2000 format('(f20.',i1,')') + else if (dec .ge. 10 .and. dec .lt.18)then + write(form,2001)dec +2001 format('(f20.',i2,')') + else +C illegal number of decimal places were specified + status=411 + call ftpmsg('Error in FTD2F: number of decimal places ' + & //'is less than 0 or greater than 18.') + return + endif + + write(cval,form,err=900)val + if (cval(1:1) .eq. '*')go to 900 + return +900 status=402 + call ftpmsg('Error in FTD2F converting double to F20. string.') + end diff --git a/pkg/tbtables/fitsio/ftdblk.f b/pkg/tbtables/fitsio/ftdblk.f new file mode 100644 index 00000000..2fd56c04 --- /dev/null +++ b/pkg/tbtables/fitsio/ftdblk.f @@ -0,0 +1,98 @@ +C-------------------------------------------------------------------------- + subroutine ftdblk(ounit,nblock,hdrdat,status) + +C delete 2880-byte FITS blocks at the end of the current header or data + +C ounit i fortran output unit number +C nblock i number of 2880-byte blocks to be deleted +C hdrdat i delete space at end of header (0) or data (1) +C status i returned error status (0=ok) + + integer ounit,nblock,hdrdat,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,jpoint,i,tstat + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + +C get address of first block to be deleted/overwritten + if (hdrdat .eq. 0)then + jpoint=dtstrt(ibuff)-2880*nblock + else + jpoint=hdstrt(ibuff,chdu(ibuff)+1)-2880*nblock + end if + +C move each block up, until we reach the end of file +10 continue +C move to the read start position + tstat=status + call ftmbyt(ounit,jpoint+nblock*2880,.false.,status) + +C read one 2880-byte FITS logical record + call ftgcbf(ounit,0,2880,buff,status) + +C check for end of file + if (status .eq. 107)then + status=tstat + go to 20 + end if + +C move back to the write start postion + call ftmbyt(ounit,jpoint,.false.,status) + +C write the 2880-byte FITS logical record + call ftpcbf(ounit,0,2880,buff,status) + +C check for error + if (status .gt. 0)then + call ftpmsg('Error deleting FITS blocks (FTDBLK)') + return + end if + +C increment pointer to next block and loop back + jpoint=jpoint+2880 + go to 10 +20 continue + +C now fill the last nblock blocks with zeros; initialize the buffer + do 30 i=1,2880 + buff(i)=char(0) +30 continue + +C move back to the write start postion + call ftmbyt(ounit,jpoint,.false.,status) + +C write the 2880-byte block NBLOCK times. + do 40 i=1,nblock + call ftpcbf(ounit,0,2880,buff,status) +40 continue + + if (hdrdat .eq. 0)then +C recalculate the starting location of the current data unit, if moved + dtstrt(ibuff)=dtstrt(ibuff)-2880*nblock + end if + +C recalculate the starting location of all subsequent HDUs + do 50 i=chdu(ibuff)+1,maxhdu(ibuff)+1 + hdstrt(ibuff,i)=hdstrt(ibuff,i)-2880*nblock +50 continue + + if (status .gt. 0)then + call ftpmsg('Error deleting FITS block(s) (FTDBLK)') + end if + end diff --git a/pkg/tbtables/fitsio/ftdcol.f b/pkg/tbtables/fitsio/ftdcol.f new file mode 100644 index 00000000..8e9b11d7 --- /dev/null +++ b/pkg/tbtables/fitsio/ftdcol.f @@ -0,0 +1,132 @@ +C-------------------------------------------------------------------------- + subroutine ftdcol(iunit,colnum,status) + +C delete a column from a table + +C iunit i Fortran I/O unit number +C colnum i number of of the column to be deleted +C status i returned error status (0=ok) + + integer iunit,colnum,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,typhdu,delbyt,fstbyt,sp,tflds,i + integer naxis1,naxis2,size,freesp,nblock,tbc + character comm*70,keynam*8 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C test that the CHDU is an ASCII table or BINTABLE + typhdu=hdutyp(ibuff) + if (typhdu .ne. 1 .and. typhdu .ne. 2)then + status=235 + call ftpmsg('Can only delete column from TABLE '// + & 'or BINTABLE extension (FTDCOL)') + return + end if + +C check if column number exists in the table + tflds=tfield(ibuff) + if (colnum .lt. 1 .or. colnum .gt. tflds)then + status=302 + return + end if + +C get the starting byte position of the column (=zero for first column) + fstbyt=tbcol(colnum+tstart(ibuff)) + +C find the width of the column + if (typhdu .eq. 1)then +C tnull is used to store the width of the ASCII column field +C NOTE: ASCII columns may not be in physical order, or may overlap. + + delbyt=tnull(colnum+tstart(ibuff)) + +C delete the space(s) between the columns, if there are any. + if (colnum .lt. tflds)then +C check for spaces between following column + sp=tbcol(colnum+1+tstart(ibuff))-tbcol(colnum+ + & tstart(ibuff))-delbyt + if (sp .gt. 0)then + delbyt=delbyt+1 + end if + else if (colnum .gt. 1)then +C check for space between the last and next to last columns + sp=tbcol(colnum+tstart(ibuff))-tbcol(colnum-1+ + & tstart(ibuff))-tnull(colnum-1+tstart(ibuff)) + if (sp .gt. 0)then + delbyt=delbyt+1 + fstbyt=fstbyt-1 + end if + end if + else + if (colnum .lt. tflds)then + delbyt=tbcol(colnum+1+tstart(ibuff))- + & tbcol(colnum+tstart(ibuff)) + else + delbyt=rowlen(ibuff)-tbcol(colnum+tstart(ibuff)) + end if + end if + +C get current size of the table + naxis1=rowlen(ibuff) + call ftgkyj(iunit,'NAXIS2',naxis2,comm,status) + +C Calculate how many FITS blocks (2880 bytes) need to be deleted + size=theap(ibuff)+scount(ibuff) + freesp=(delbyt*naxis2) + ((size+2879)/2880)*2880 - size + nblock=freesp/2880 + +C shift each row up, deleting the desired column + call ftcdel(iunit,naxis1,naxis2,delbyt,fstbyt,status) + +C shift the heap up and update pointer to start of heap + size=delbyt*naxis2 + call fthpup(iunit,size,status) + +C delete the needed number of new FITS blocks at the end of the HDU + if (nblock .gt. 0)call ftdblk(iunit,nblock,1,status) + + if (typhdu .eq. 1)then +C adjust the TBCOL values of the remaining columns + do 10 i=1,tflds + call ftkeyn('TBCOL',i,keynam,status) + call ftgkyj(iunit,keynam,tbc,comm,status) + if (tbc .gt. fstbyt)then + tbc=tbc-delbyt + call ftmkyj(iunit,keynam,tbc,'&',status) + end if +10 continue + end if + +C update the mandatory keywords + call ftmkyj(iunit,'TFIELDS',tflds-1,'&',status) + call ftmkyj(iunit,'NAXIS1',naxis1-delbyt,'&',status) + +C delete the index keywords starting with 'T' associated with the +C deleted column and subtract 1 from index of all higher keywords + call ftkshf(iunit,colnum,tflds,-1,status) + +C parse the header to initialize the new table structure + call ftrdef(iunit,status) + end diff --git a/pkg/tbtables/fitsio/ftddef.f b/pkg/tbtables/fitsio/ftddef.f new file mode 100644 index 00000000..ad82819d --- /dev/null +++ b/pkg/tbtables/fitsio/ftddef.f @@ -0,0 +1,54 @@ +C-------------------------------------------------------------------------- + subroutine ftddef(ounit,bytlen,status) + +C Data DEFinition +C re-define the length of the data unit +C this simply redefines the start of the next HDU +C +C ounit i Fortran I/O unit number +C bytlen i new length of the data unit, in bytes +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,bytlen,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nf = 3000) + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + + if (dtstrt(ibuff) .lt. 0)then +C freeze the header at its current size + call fthdef(ounit,0,status) + end if + + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+(bytlen+2879)/2880*2880 + +C initialize the fictitious heap starting address (immediately following +C the array data) and a zero length heap. This is used to find the +C end of the data when checking the fill values in the last block. + scount(ibuff)=0 + theap(ibuff)=bytlen + nxheap(ibuff)=0 + end diff --git a/pkg/tbtables/fitsio/ftdelt.f b/pkg/tbtables/fitsio/ftdelt.f new file mode 100644 index 00000000..16e5e46e --- /dev/null +++ b/pkg/tbtables/fitsio/ftdelt.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftdelt(iunit,status) + +C delete a FITS file that was previously opened with ftopen or ftinit +C +C iunit i Fortran I/O unit number +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, July 1994 + + integer iunit,status,ibuff + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + +C ignore input status, and delete file regardless of status value + + ibuff=bufnum(iunit) + +C set current column name buffer as undefined + call ftrsnm + +C flush the buffers holding data for this HDU + call ftflsh(ibuff,status) + +C recover common block space containing column descriptors for this HDU + call ftfrcl(iunit,status) + +C delete the file + call ftclsx(iunit,.false.,status) + end diff --git a/pkg/tbtables/fitsio/ftdhdu.f b/pkg/tbtables/fitsio/ftdhdu.f new file mode 100644 index 00000000..6f39a37c --- /dev/null +++ b/pkg/tbtables/fitsio/ftdhdu.f @@ -0,0 +1,58 @@ +C-------------------------------------------------------------------------- + subroutine ftdhdu(ounit,typhdu,status) + +C delete the current HDU (as long as it is not the primary array) + +C ounit i fortran output unit number +C typhdu i type of the new CHDU, after deleting the old CHDU +C status i returned error status (0=ok) + + integer ounit,typhdu,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,nhdu,nblock + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + + nhdu=chdu(ibuff) + if (nhdu .eq. 1)then +C cannot delete the primary array + status=301 + return + end if + +C close the CHDU first, to flush buffers and free memory + call ftchdu(ounit,status) + +C how many blocks to delete? + nblock=(hdstrt(ibuff,nhdu+1)-hdstrt(ibuff,nhdu))/2880 + if (nblock .lt. 1)return + +C delete the blocks + call ftdblk(ounit,nblock,1,status) + if (status .gt. 0)return + +C try reinitializing the CHDU, if there is one + call ftrhdu(ounit,typhdu,status) + if (status .gt. 0)then +C there is no HDU after the one we just deleted so move back one HDU + status=0 + call ftcmsg + call ftgext(ounit,nhdu-1,typhdu,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftdkey.f b/pkg/tbtables/fitsio/ftdkey.f new file mode 100644 index 00000000..0701e190 --- /dev/null +++ b/pkg/tbtables/fitsio/ftdkey.f @@ -0,0 +1,55 @@ +C-------------------------------------------------------------------------- + subroutine ftdkey(iunit,keynam,status) + +C delete a header keyword +C +C iunit i fortran output unit number +C keynam c keyword name ( 8 characters, cols. 1- 8) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + character*(*) keynam + integer iunit,status,i,lenval,nkeys,keypos + character keybuf*80,strval*70,comm*8,value*70,bslash*1,kname*8 + + if (status .gt. 0)return + +C have to use 2 \\'s because the SUN compiler treats 1 \ as an escape + bslash='\\' + +C find the keyword to be deleted + call ftgcrd(iunit,keynam,keybuf,status) + if (status .eq. 202)then + kname=keynam + call ftpmsg('FTDKEY could not find the '//kname// + & ' keyword to be deleted.') + return + end if + +C get the position of the keyword in the header + call ftghps(iunit,nkeys,keypos,status) + keypos=keypos-1 + +C get position of last character in value string to see if it is a \ or & + call ftpsvc(keybuf,strval,comm,status) + call ftc2s(strval,value,status) + do 10 i=70,1,-1 + if (value(i:i) .ne. ' ')then + lenval=i + go to 20 + end if +10 continue + +C now delete this keyword +20 call ftdrec(iunit,keypos,status) + if (status .gt. 0)return + +C test if this keyword was also continued + if (value(lenval:lenval) .eq. bslash .or. + & value(lenval:lenval) .eq. '&')then + call ftgnst(iunit,value,lenval,comm,status) + if (lenval .gt. 0)go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftdrec.f b/pkg/tbtables/fitsio/ftdrec.f new file mode 100644 index 00000000..5265aafc --- /dev/null +++ b/pkg/tbtables/fitsio/ftdrec.f @@ -0,0 +1,64 @@ +C-------------------------------------------------------------------------- + subroutine ftdrec(ounit,pos,status) + +C delete keyword record at position POS from header +C +C ounit i fortran output unit number +C pos i position of keyword to be deleted (1 = first keyword) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Jan 1995 + + integer ounit,pos,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + character*80 keybuf,keytmp + integer ibuff,i,j,nshift + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + + if (pos .lt. 1 .or. pos .gt. + & (hdend(ibuff)-hdstrt(ibuff,chdu(ibuff)))/80)then + status=203 + return + end if + + nxthdr(ibuff)=hdstrt(ibuff,chdu(ibuff))+(pos-1)*80 + +C calculate number of header records following the deleted record + nshift=(hdend(ibuff)-nxthdr(ibuff))/80 + +C go through header shifting each 80 byte record up one place to +C fill in the gap created by the deleted keyword + j=hdend(ibuff) + keybuf=' ' + do 10 i=1,nshift + j=j-80 +C read current record contents + call ftmbyt(ounit,j,.false.,status) + call ftgcbf(ounit,0,80,keytmp,status) +C overwrite with new contents + call ftmbyt(ounit,j,.false.,status) + call ftpcbf(ounit,0,80,keybuf,status) + keybuf=keytmp +10 continue + +C update end-of-header pointer + hdend(ibuff)=hdend(ibuff)-80 + +100 continue + end diff --git a/pkg/tbtables/fitsio/ftdrow.f b/pkg/tbtables/fitsio/ftdrow.f new file mode 100644 index 00000000..22c0bfdd --- /dev/null +++ b/pkg/tbtables/fitsio/ftdrow.f @@ -0,0 +1,94 @@ +C-------------------------------------------------------------------------- + subroutine ftdrow(iunit,frow,nrows,status) + +C delete NROWS rows from a table, beginning with row FROW + +C iunit i Fortran I/O unit number +C frow i row number after which the new rows will be inserted. +C Specify 0 to add rows to the beginning of the table. +C nrows i number of rows to add to the table (must be greater than 0) +C status i returned error status (0=ok) + + integer iunit,frow,nrows,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,naxis1,naxis2,size,freesp,nblock,row + character comm*8 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C test that the CHDU is an ASCII table or BINTABLE + if (hdutyp(ibuff) .ne. 1 .and. hdutyp(ibuff) .ne. 2)then + status=235 + call ftpmsg('Can only delete rows from TABLE or '// + & 'BINTABLE extension (FTDROW)') + return + end if + +C get current size of the table + call ftgkyj(iunit,'NAXIS1',naxis1,comm,status) + call ftgkyj(iunit,'NAXIS2',naxis2,comm,status) + + if (nrows .lt. 0)then + status=306 + call ftpmsg('Cannot delete negative number of ' // + & 'rows in the table (FTDROW)') + return + else if (frow+nrows-1 .gt. naxis2)then + status=307 + call ftpmsg('Specified number of rows to delete ' + & //'exceeds number of rows in table (FTDROW)') + return + else if (nrows .eq. 0)then + return + else if (frow .gt. naxis2)then + status=307 + call ftpmsg('First row to delete is greater'// + & ' than the number of rows in the table (FTDROW)') + return + else if (frow .le. 0)then + status=307 + call ftpmsg('Delete starting row number is less ' + & //'than 1 (FTDROW)') + return + end if + +C Calculate how many FITS blocks (2880 bytes) need to be deleted + size=theap(ibuff)+scount(ibuff) + freesp=((size+2879)/2880)*2880 - size + naxis1*nrows + nblock=freesp/2880 + +C shift the rows up + row=frow+nrows + call ftrwup(iunit,row,naxis2,nrows,status) + +C shift the heap up + size=naxis1*nrows + call fthpup(iunit,size,status) + + if (nblock .gt. 0)call ftdblk(iunit,nblock,1,status) + +C update the NAXIS2 keyword + naxis2=naxis2-nrows + call ftmkyj(iunit,'NAXIS2',naxis2,'&',status) + end diff --git a/pkg/tbtables/fitsio/ftdsum.f b/pkg/tbtables/fitsio/ftdsum.f new file mode 100644 index 00000000..77a3cdf4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftdsum.f @@ -0,0 +1,68 @@ +C-------------------------------------------------------------------------- + subroutine ftdsum(string,complm,sum) + +C decode the 32 bit checksum + +C If complm=.true., then the complement of the sum will be decoded. + +C This Fortran algorithm is based on the C algorithm developed by Rob +C Seaman at NOAO that was presented at the 1994 ADASS conference, to be +C published in the Astronomical Society of the Pacific Conference Series. +C +C sum d checksum value +C complm l encode the complement of the sum? +C string c output ASCII encoded check sum +C sum d checksum value +C +C written by Wm Pence, HEASARC/GSFC, May, 1995 + + double precision sum,all32,word32,factor(4) + character*16 string,tmpstr + integer offset,i,j,k,temp,hibits + logical complm + +C all32 equals a 32 bit unsigned integer with all bits set +C word32 is equal to 2**32 + parameter (all32=4.294967295D+09) + parameter (word32=4.294967296D+09) + +C ASCII 0 is the offset value + parameter (offset=48) + + data factor/16777216.,65536.,256.,1./ + + sum=0 + +C shift the characters 1 place to the left, since the FITS character +C string value starts in column 12, which is not word aligned + tmpstr(1:15)=string(2:16) + tmpstr(16:16)=string(1:1) + +C convert characters from machine's native character coding sequence +C to ASCII codes. This only affects IBM mainframe computers +C that do not use ASCII for the internal character representation. + call ftc2as(tmpstr,16) + +C substract the offset from each byte and interpret each 4 character +C string as a 4-byte unsigned integer; sum the 4 integers + k=0 + do 10 i=1,4 + do 20 j=1,4 + k=k+1 + temp=ichar(tmpstr(k:k))-offset + sum=sum+temp*factor(j) +20 continue +10 continue + +C fold any overflow bits beyond 32 back into the word +30 hibits=sum/word32 + if (hibits .gt. 0)then + sum=sum-(hibits*word32)+hibits + go to 30 + end if + + if (complm)then +C complement the 32-bit unsigned integer equivalent (flip every bit) + sum=all32-sum + end if + end diff --git a/pkg/tbtables/fitsio/ftdtyp.f b/pkg/tbtables/fitsio/ftdtyp.f new file mode 100644 index 00000000..c42410b3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftdtyp.f @@ -0,0 +1,35 @@ +C---------------------------------------------------------------------- + subroutine ftdtyp(value,dtype,status) + +C determine datatype of a FITS value field +C This assumes value field conforms to FITS standards and may not +C detect all invalid formats. +C value c input value field from FITS header record only, +C (usually the value field is in columns 11-30 of record) +C The value string is left justified. +C dtype c output type (C,L,I,F) for Character string, Logical, +C Integer, Floating point, respectively +C +C written by Wm Pence, HEASARC/GSFC, February 1991 + + character*(*)value,dtype + integer status + + if (status .gt. 0)return + + dtype=' ' + + if (value(1:1) .eq. '''')then +C character string + dtype='C' + else if (value(1:1).eq.'T' .or. value(1:1).eq.'F')then +C logical + dtype='L' + else if (index(value,'.') .gt. 0)then +C floating point + dtype='F' + else +C assume it must be an integer, since it isn't anything else + dtype='I' + end if + end diff --git a/pkg/tbtables/fitsio/ftesum.f b/pkg/tbtables/fitsio/ftesum.f new file mode 100644 index 00000000..fe087605 --- /dev/null +++ b/pkg/tbtables/fitsio/ftesum.f @@ -0,0 +1,94 @@ +C-------------------------------------------------------------------------- + subroutine ftesum(sum,complm,string) + +C encode the 32 bit checksum by converting every +C 2 bits of each byte into an ASCII character (32 bit word encoded +C as 16 character string). Only ASCII letters and digits are used +C to encode the values (no ASCII punctuation characters). + +C If complm=.true., then the complement of the sum will be encoded. + +C This Fortran algorithm is based on the C algorithm developed by Rob +C Seaman at NOAO that was presented at the 1994 ADASS conference, to be +C published in the Astronomical Society of the Pacific Conference Series. +C +C sum d checksum value +C complm l encode the complement of the sum? +C string c output ASCII encoded check sum +C +C written by Wm Pence, HEASARC/GSFC, Sept, 1994 + + double precision sum,tmpsum,all32 + character*16 string,tmpstr + integer offset,exclud(13),nbyte(4),ch(4),i,j,k + integer quot,remain,check,nc + logical complm + +C all32 equals a 32 bit unsigned integer with all bits set + parameter (all32=4.294967295D+09) + +C ASCII 0 is the offset value + parameter (offset=48) + +C this is the list of ASCII punctutation characters to be excluded + data exclud/58,59,60,61,62,63,64,91,92,93,94,95,96/ + + if (complm)then +C complement the 32-bit unsigned integer equivalent (flip every bit) + tmpsum=all32-sum + else + tmpsum=sum + end if + +C separate each 8-bit byte into separate integers + nbyte(1)=tmpsum/16777216. + tmpsum=tmpsum-nbyte(1)*16777216. + nbyte(2)=tmpsum/65536. + tmpsum=tmpsum-nbyte(2)*65536. + nbyte(3)=tmpsum/256. + nbyte(4)=tmpsum-nbyte(3)*256. + +C encode each 8-bit integer as 4-characters + do 100 i=1,4 + quot=nbyte(i)/4+offset + remain=nbyte(i) - (nbyte(i)/4*4) + ch(1)=quot+remain + ch(2)=quot + ch(3)=quot + ch(4)=quot + +C avoid ASCII punctuation characters by incrementing and +C decrementing adjacent characters thus preserving checksum value +10 check=0 + do 30 k=1,13 + do 20 j=1,4,2 + if (ch(j) .eq. exclud(k) .or. + & ch(j+1) .eq. exclud(k))then + ch(j)=ch(j)+1 + ch(j+1)=ch(j+1)-1 + check=1 + end if +20 continue +30 continue + +C keep repeating, until all punctuation character are removed + if (check .ne. 0)go to 10 + +C convert the byte values to the equivalent ASCII characters + do 40 j=0,3 + nc=4*j+i + tmpstr(nc:nc)=char(ch(j+1)) +40 continue +100 continue + +C shift the characters 1 place to the right, since the FITS character +C string value starts in column 12, which is not word aligned + string(2:16)=tmpstr(1:15) + string(1:1)=tmpstr(16:16) + +C convert characters from ASCII codes to machine's native character +C coding sequence. (The string gets converted back to ASCII when it +C is written to the FITS file). This only affects IBM mainframe computers +C that do not use ASCII for the internal character representation. + call ftas2c(string,16) + end diff --git a/pkg/tbtables/fitsio/ftfiou.f b/pkg/tbtables/fitsio/ftfiou.f new file mode 100644 index 00000000..ba90c788 --- /dev/null +++ b/pkg/tbtables/fitsio/ftfiou.f @@ -0,0 +1,11 @@ +C------------------------------------------------------------------------------ + subroutine ftfiou(iounit,status) + +C free specified logical unit number; if iounit=-1, then free all units + + integer iounit,status + + if (status .gt. 0)return + + call ftxiou(iounit,status) + end diff --git a/pkg/tbtables/fitsio/ftfrcl.f b/pkg/tbtables/fitsio/ftfrcl.f new file mode 100644 index 00000000..cfbbc017 --- /dev/null +++ b/pkg/tbtables/fitsio/ftfrcl.f @@ -0,0 +1,91 @@ +C---------------------------------------------------------------------- + subroutine ftfrcl(iunit,status) + +C free up space in the common blocks that contain descriptors to +C the columns in the HDU that is being closed. The various parameters +C describing each table column (e.g., starting byte address, datatype, +C tscale, tzero, etc.) are stored in 1-D arrays, and the tstart +C parameter gives the starting element number in the arrays +C for each unit number. If a table is closed, then all the +C descriptors for that table columns must be overwritten by +C shifting any descriptors that follow it in the 1-D arrays to the left. + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC,May, 1995 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,n2shft,i,j1,j2 + +C ignore input status and flush columns regardless of input status value + + ibuff=bufnum(iunit) + + if (status .eq. -999)then +C just initialize the descriptors as undefined + tstart(ibuff)=-1 + else if (tstart(ibuff) .lt. 0)then +C descriptors are already undefined; just return + else if (tfield(ibuff) .eq. 0)then +C table had no columns so just reset pointers as undefined + tstart(ibuff)=-1 + dtstrt(ibuff)=-2000000000 + else +C calc number of descriptors to be shifted over the recovered space + n2shft=nxtfld-(tstart(ibuff)+tfield(ibuff)) + + if (n2shft .gt. 0)then + j1=tstart(ibuff) + j2=j1+tfield(ibuff) + do 10 i=1,n2shft +C shift the descriptors + j1=j1+1 + j2=j2+1 + tbcol(j1)=tbcol(j2) + tdtype(j1)=tdtype(j2) + trept(j1)=trept(j2) + tscale(j1)=tscale(j2) + tzero(j1)=tzero(j2) + tnull(j1)=tnull(j2) + cnull(j1)=cnull(j2) + cform(j1)=cform(j2) +10 continue + end if + +C update pointer to next vacant column discriptor location + nxtfld=nxtfld-tfield(ibuff) + +C update starting pointer for other opened files + do 20 i=1,nb + if (tstart(i) .gt. tstart(ibuff))then + tstart(i)=tstart(i)-tfield(ibuff) + end if +20 continue + +C set pointers for this unit as undefined + tstart(ibuff)=-1 + dtstrt(ibuff)=-2000000000 + end if + end diff --git a/pkg/tbtables/fitsio/ftg2db.f b/pkg/tbtables/fitsio/ftg2db.f new file mode 100644 index 00000000..1210e98e --- /dev/null +++ b/pkg/tbtables/fitsio/ftg2db.f @@ -0,0 +1,36 @@ +C-------------------------------------------------------------------------- + subroutine ftg2db(ounit,group,nulval,dim1,nx,ny, + & array,anyflg,status) + +C Read a 2-d image of byte values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval c*1 undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array c*1 the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + character*1 array(dim1,*),nulval + logical anyflg,ltemp + integer fpixel,row + + anyflg=.false. + fpixel=1 + do 10 row = 1,ny + call ftgpvb(ounit,group,fpixel,nx,nulval, + & array(1,row),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftg2dd.f b/pkg/tbtables/fitsio/ftg2dd.f new file mode 100644 index 00000000..c6eae3fe --- /dev/null +++ b/pkg/tbtables/fitsio/ftg2dd.f @@ -0,0 +1,36 @@ +C-------------------------------------------------------------------------- + subroutine ftg2dd(ounit,group,nulval,dim1,nx,ny, + & array,anyflg,status) + +C Read a 2-d image of r*8 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval d undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array d the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + double precision array(dim1,*),nulval + logical anyflg,ltemp + integer fpixel,row + + anyflg=.false. + fpixel=1 + do 10 row = 1,ny + call ftgpvd(ounit,group,fpixel,nx,nulval, + & array(1,row),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftg2de.f b/pkg/tbtables/fitsio/ftg2de.f new file mode 100644 index 00000000..cd4684b6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftg2de.f @@ -0,0 +1,36 @@ +C-------------------------------------------------------------------------- + subroutine ftg2de(ounit,group,nulval,dim1,nx,ny, + & array,anyflg,status) + +C Read a 2-d image of real values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval r undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array r the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + real array(dim1,*),nulval + logical anyflg,ltemp + integer fpixel,row + + anyflg=.false. + fpixel=1 + do 10 row = 1,ny + call ftgpve(ounit,group,fpixel,nx,nulval, + & array(1,row),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftg2di.f b/pkg/tbtables/fitsio/ftg2di.f new file mode 100644 index 00000000..d847057d --- /dev/null +++ b/pkg/tbtables/fitsio/ftg2di.f @@ -0,0 +1,36 @@ +C-------------------------------------------------------------------------- + subroutine ftg2di(ounit,group,nulval,dim1,nx,ny, + & array,anyflg,status) + +C Read a 2-d image of i*2 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval i*2 undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array i*2 the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + integer*2 array(dim1,*),nulval + logical anyflg,ltemp + integer fpixel,row + + anyflg=.false. + fpixel=1 + do 10 row = 1,ny + call ftgpvi(ounit,group,fpixel,nx,nulval, + & array(1,row),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftg2dj.f b/pkg/tbtables/fitsio/ftg2dj.f new file mode 100644 index 00000000..21c839c0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftg2dj.f @@ -0,0 +1,36 @@ +C-------------------------------------------------------------------------- + subroutine ftg2dj(ounit,group,nulval,dim1,nx,ny, + & array,anyflg,status) + +C Read a 2-d image of i*4 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval i undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array i the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + integer array(dim1,*),nulval + logical anyflg,ltemp + integer fpixel,row + + anyflg=.false. + fpixel=1 + do 10 row = 1,ny + call ftgpvj(ounit,group,fpixel,nx,nulval, + & array(1,row),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftg3db.f b/pkg/tbtables/fitsio/ftg3db.f new file mode 100644 index 00000000..be3b48a6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftg3db.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftg3db(ounit,group,nulval,dim1,dim2,nx,ny,nz, + & array,anyflg,status) + +C Read a 3-d cube of byte values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval c*1 undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array c*1 the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + character*1 array(dim1,dim2,*),nulval + logical anyflg,ltemp + integer fpixel,row,band + + anyflg=.false. + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftgpvb(ounit,group,fpixel,nx,nulval, + & array(1,row,band),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue +20 continue + end diff --git a/pkg/tbtables/fitsio/ftg3dd.f b/pkg/tbtables/fitsio/ftg3dd.f new file mode 100644 index 00000000..695f1cbf --- /dev/null +++ b/pkg/tbtables/fitsio/ftg3dd.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftg3dd(ounit,group,nulval,dim1,dim2,nx,ny,nz, + & array,anyflg,status) + +C Read a 3-d cube of byte values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval d undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array d the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + double precision array(dim1,dim2,*),nulval + logical anyflg,ltemp + integer fpixel,row,band + + anyflg=.false. + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftgpvd(ounit,group,fpixel,nx,nulval, + & array(1,row,band),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue +20 continue + end diff --git a/pkg/tbtables/fitsio/ftg3de.f b/pkg/tbtables/fitsio/ftg3de.f new file mode 100644 index 00000000..1889640b --- /dev/null +++ b/pkg/tbtables/fitsio/ftg3de.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftg3de(ounit,group,nulval,dim1,dim2,nx,ny,nz, + & array,anyflg,status) + +C Read a 3-d cube of real values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval r undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array r the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + real array(dim1,dim2,*),nulval + logical anyflg,ltemp + integer fpixel,row,band + + anyflg=.false. + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftgpve(ounit,group,fpixel,nx,nulval, + & array(1,row,band),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue +20 continue + end diff --git a/pkg/tbtables/fitsio/ftg3di.f b/pkg/tbtables/fitsio/ftg3di.f new file mode 100644 index 00000000..eb0f76d1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftg3di.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftg3di(ounit,group,nulval,dim1,dim2,nx,ny,nz, + & array,anyflg,status) + +C Read a 3-d cube of i*2 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval i*2 undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array i*2 the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + integer*2 array(dim1,dim2,*),nulval + logical anyflg,ltemp + integer fpixel,row,band + + anyflg=.false. + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftgpvi(ounit,group,fpixel,nx,nulval, + & array(1,row,band),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue +20 continue + end diff --git a/pkg/tbtables/fitsio/ftg3dj.f b/pkg/tbtables/fitsio/ftg3dj.f new file mode 100644 index 00000000..1a26d929 --- /dev/null +++ b/pkg/tbtables/fitsio/ftg3dj.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftg3dj(ounit,group,nulval,dim1,dim2,nx,ny,nz, + & array,anyflg,status) + +C Read a 3-d cube of byte values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C nulval i undefined pixels will be set to this value (unless = 0) +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array i the array of values to be read +C anyflg l set to true if any of the image pixels were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + integer array(dim1,dim2,*),nulval + logical anyflg,ltemp + integer fpixel,row,band + + anyflg=.false. + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftgpvj(ounit,group,fpixel,nx,nulval, + & array(1,row,band),ltemp,status) + if (ltemp)anyflg=.true. + fpixel=fpixel+nx +10 continue +20 continue + end diff --git a/pkg/tbtables/fitsio/ftgabc.f b/pkg/tbtables/fitsio/ftgabc.f new file mode 100644 index 00000000..541f6b56 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgabc.f @@ -0,0 +1,49 @@ +C---------------------------------------------------------------------- + subroutine ftgabc(nfield,tform,space, rowlen,tbcol,status) + +C Get ASCII table Beginning Columns +C determine the byte offset of the beginning of each field of a +C ASCII table, and the total width of the table + +C nfield i number of fields in the binary table +C tform c array of FITS datatype codes of each column. +C must be left justified in the string variable +C space i number of blank spaces to insert between each column +C OUTPUT PARAMETERS: +C rowlen i total width of the table, in bytes +C tbcol i beginning position of each column (first column begins at 1) +C status i returned error status +C +C written by Wm Pence, HEASARC/GSFC, June 1992 + + integer nfield,space,rowlen,tbcol(*),status + character*(*) tform(*) + integer i,j,ival + + if (status .gt. 0)return + + rowlen=0 + do 100 i=1,nfield + if (tform(i)(2:2) .eq. ' ')then +C no explicit width; assume width=1 + ival=1 + else +C find the field width characters + j=2 +10 j=j+1 + if (tform(i)(j:j) .eq. ' ' .or. + & tform(i)(j:j) .eq. '.')then +C read the width + call ftc2ii(tform(i)(2:j-1),ival,status) + else +C keep looking for the end of the width field + go to 10 + end if + tbcol(i)=rowlen+1 + rowlen=rowlen+ival+space + end if +100 continue + +C don't add space after the last field + rowlen=rowlen-space + end diff --git a/pkg/tbtables/fitsio/ftgacl.f b/pkg/tbtables/fitsio/ftgacl.f new file mode 100644 index 00000000..06387b3e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgacl.f @@ -0,0 +1,70 @@ +C-------------------------------------------------------------------------- + subroutine ftgacl(iunit,colnum,xtype,xbcol,xunit,xform, + & xscal,xzero,xnull,xdisp,status) + +C Get information about an Ascii CoLumn +C returns the parameters which define the column + +C iunit i Fortran i/o unit number +C colnum i number of the column (first column = 1) +C xtype c name of the column +C xbcol i starting character in the row of the column +C xunit c physical units of the column +C xform c Fortran-77 format of the column +C xscal d scaling factor for the column values +C xzero d scaling zero point for the column values +C xnull c value used to represent undefined values in the column +C xdisp c display format for the column (if different from xform +C status i returned error status + + integer iunit,colnum,xbcol,status + double precision xscal,xzero + character*(*) xtype,xunit,xform,xnull,xdisp + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C END OF COMMON BLOCK DEFINITIONS------------------------------------ + + integer ibuff,nfound + + if (status .gt. 0)return + + if (colnum .lt. 1 .or. colnum .gt. 999)then +C illegal column number + status=302 + return + end if + + ibuff=bufnum(iunit) + +C get the parameters which are stored in the common block + xbcol=tbcol(colnum+tstart(ibuff))+1 + xform=cform(colnum+tstart(ibuff)) + xscal=tscale(colnum+tstart(ibuff)) + xzero=tzero(colnum+tstart(ibuff)) + xnull=cnull(colnum+tstart(ibuff)) + +C read remaining values from the header keywords + xtype=' ' + call ftgkns(iunit,'TTYPE',colnum,1,xtype,nfound,status) + xunit=' ' + call ftgkns(iunit,'TUNIT',colnum,1,xunit,nfound,status) + xdisp=' ' + call ftgkns(iunit,'TDISP',colnum,1,xdisp,nfound,status) + end diff --git a/pkg/tbtables/fitsio/ftgatp.f b/pkg/tbtables/fitsio/ftgatp.f new file mode 100644 index 00000000..1556915e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgatp.f @@ -0,0 +1,169 @@ +C-------------------------------------------------------------------------- + subroutine ftgatp(ibuff,keynam,value,status) + +C Get ASCII Table Parameter +C test if the keyword is one of the table column definition keywords +C of an ASCII table. If so, decode it and update the value in the common +C block + +C ibuff i sequence number of the data buffer +C keynam c name of the keyword +C value c value of the keyword +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ibuff,status + character keynam*8,value*70 + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- +C nb = number of file buffers = max. number of FITS file opened at once +C nf = maximum number of fields allowed in a table + integer nf,nb + parameter (nb = 20) + parameter (nf = 3000) + +C tfield = number of fields in the table +C tbcol = byte offset in the row of the beginning of the column +C rowlen = length of one row of the table, in bytes +C tdtype = integer code representing the datatype of the column +C trept = the repeat count = number of data values/element in the column +C tnull = the value used to represent an undefined value in the column +C tscale = the scale factor for the column +C tzero = the scaling zero point for the column +C scount = the total size of the binary table heap (+ gap if any) +C theap = the starting byte offset for the binary table heap, relative +C to the start of the binary table data +C nxheap = the next empty heap location + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + +C cnull = character string representing nulls in character columns +C cform = the Fortran format of the column + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer nfield,i,c2,bcol,tstat + character tform*16 + + if (status .gt. 0)return + tstat=status + + if (keynam(1:5) .eq. 'TFORM')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TFORMn keyword + status=tstat + else +C get the TFORM character string, without quotes + call ftc2s(value,tform,status) + if (status .gt. 0)return + if (tform(1:1) .ne. 'A' .and. tform(1:1) .ne. 'I' + & .and. tform(1:1) .ne. 'F' .and. tform(1:1) .ne. 'E' + & .and. tform(1:1) .ne. 'D')then + status=311 + call ftpmsg('Illegal '//keynam//' format code: ' + & //tform) + return + end if + + cform(nfield+tstart(ibuff))=tform +C set numeric data type code to indicate an ASCII table field + tdtype(nfield+tstart(ibuff))=16 +C set the repeat count to 1 + trept(nfield+tstart(ibuff))=1 +C set the TNULL parameter to the width of the field: + c2=0 + do 10 i=2,8 + if (tform(i:i) .ge. '0' .and. tform(i:i) + & .le. '9')then + c2=i + else + go to 20 + end if +10 continue +20 continue + + if (status .gt. 0)return + if (c2 .eq. 0)then +C no explicit field width, so assume width=1 character + tnull(nfield+tstart(ibuff))=1 + else + call ftc2ii(tform(2:c2),tnull(nfield+ + & tstart(ibuff)),status) + if (status .gt. 0)then +C error parsing the TFORM value string + status=261 + call ftpmsg('Error parsing '//keynam//' field width: ' + & //tform) + end if + end if + end if + else if (keynam(1:5) .eq. 'TBCOL')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TBCOLn keyword + status=tstat + else +C get the beginning column number + call ftc2ii(value,bcol,status) + if (status .gt. 0)then + call ftpmsg('Error reading value of '//keynam + & //' as an integer: '//value) + else + tbcol(nfield+tstart(ibuff))=bcol-1 + end if + end if + else if (keynam(1:5) .eq. 'TSCAL')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TSCALn keyword + status=tstat + else +C get the scale factor + call ftc2dd(value,tscale(nfield+tstart(ibuff)), + & status) + if (status .gt. 0)then + call ftpmsg('Error reading value of'//keynam + & //' as a Double: '//value) + end if + end if + else if (keynam(1:5) .eq. 'TZERO')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TZEROn keyword + status=tstat + else +C get the scaling zero point + call ftc2dd(value,tzero(nfield+tstart(ibuff)), + & status) + if (status .gt. 0)then + call ftpmsg('Error reading value of'//keynam + & //' as a Double: '//value) + end if + end if + else if (keynam(1:5) .eq. 'TNULL')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TNULLn keyword + status=tstat + else +C get the Null value flag (character) + call ftc2s(value,cnull(nfield+tstart(ibuff)),status) + if (status .gt. 0)then + call ftpmsg('Error reading value of'//keynam + & //' as a character string: '//value) + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftgbcl.f b/pkg/tbtables/fitsio/ftgbcl.f new file mode 100644 index 00000000..c7ca1244 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgbcl.f @@ -0,0 +1,119 @@ +C-------------------------------------------------------------------------- + subroutine ftgbcl(iunit,colnum,xtype,xunit,dtype,rcount, + & xscal,xzero,xnull,xdisp,status) + +C Get information about a Binary table CoLumn +C returns the parameters which define the column + +C iunit i Fortran i/o unit number +C colnum i number of the column (first column = 1) +C xtype c name of the column +C xunit c physical units of the column +C dtype c datatype of the column +C rcount i repeat count of the column +C xscal d scaling factor for the column values +C xzero d scaling zero point for the column values +C xnull i value used to represent undefined values in integer column +C xdisp c display format for the column +C status i returned error status + + integer iunit,colnum,rcount,xnull,status + double precision xscal,xzero + character*(*) xtype,xunit,dtype,xdisp + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS------------------------------------ + + integer ibuff,nfound,tcode + logical descrp + character ctemp*2,fwide*4 + + if (status .gt. 0)return + + if (colnum .lt. 1 .or. colnum .gt. 999)then +C illegal column number + status=302 + return + end if + + ibuff=bufnum(iunit) + +C get the parameters which are stored in the common block + rcount=trept(colnum+tstart(ibuff)) + xscal=tscale(colnum+tstart(ibuff)) + xzero=tzero(colnum+tstart(ibuff)) + xnull=tnull(colnum+tstart(ibuff)) + +C translate the numeric data type code + dtype=' ' + tcode=tdtype(colnum+tstart(ibuff)) + if (tcode .lt. 0)then + descrp=.true. + tcode=-tcode + else + descrp=.false. + end if + + if (tcode .eq. 21)then + dtype='I' + else if (tcode .eq. 41)then + dtype='J' + else if (tcode .eq. 42)then + dtype='E' + else if (tcode .eq. 82)then + dtype='D' + else if (tcode .eq. 16)then +C this is an ASCII field; width of field is stored in TNULL + write(fwide,1000)tnull(colnum+tstart(ibuff)) +1000 format(i4) + if (tnull(colnum+tstart(ibuff)) .gt. 999)then + dtype='A'//fwide + else if (tnull(colnum+tstart(ibuff)) .gt. 99)then + dtype='A'//fwide(2:4) + else if (tnull(colnum+tstart(ibuff)) .gt. 9)then + dtype='A'//fwide(3:4) + else if (tnull(colnum+tstart(ibuff)) .gt. 0)then + dtype='A'//fwide(4:4) + else + dtype='A' + end if + else if (tcode .eq. 14)then + dtype='L' + else if (tcode .eq. 1)then + dtype='X' + else if (tcode .eq. 11)then + dtype='B' + else if (tcode .eq. 83)then + dtype='C' + else if (tcode .eq. 163)then + dtype='M' + end if + + if (descrp)then + ctemp='P'//dtype(1:1) + dtype=ctemp + end if + +C read remaining values from the header keywords + xtype=' ' + call ftgkns(iunit,'TTYPE',colnum,1,xtype,nfound,status) + xunit=' ' + call ftgkns(iunit,'TUNIT',colnum,1,xunit,nfound,status) + xdisp=' ' + call ftgkns(iunit,'TDISP',colnum,1,xdisp,nfound,status) + end diff --git a/pkg/tbtables/fitsio/ftgbit.f b/pkg/tbtables/fitsio/ftgbit.f new file mode 100644 index 00000000..08dc9e29 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgbit.f @@ -0,0 +1,68 @@ +C---------------------------------------------------------------------- + subroutine ftgbit(buffer,log8) + +C decode the individual bits within the byte into an array of +C logical values. The corresponding logical value is set to +C true if the bit is set to 1. + +C buffer i input integer containing the byte to be decoded +C log8 l output array of logical data values corresponding +C to the bits in the input buffer +C +C written by Wm Pence, HEASARC/GSFC, May 1992 + + integer buffer,tbuff + logical log8(8) + + log8(1)=.false. + log8(2)=.false. + log8(3)=.false. + log8(4)=.false. + log8(5)=.false. + log8(6)=.false. + log8(7)=.false. + log8(8)=.false. + +C test for special case: no bits are set + if (buffer .eq. 0)return + +C This algorithm tests to see if each bit is set by testing +C the numerical value of the byte, starting with the most significant +C bit. If the bit is set, then it is reset to zero before testing +C the next most significant bit, and so on. + + tbuff=buffer + +C now decode the least significant byte + if (tbuff .gt. 127)then + log8(1)=.true. + tbuff=tbuff-128 + end if + if (tbuff .gt. 63)then + log8(2)=.true. + tbuff=tbuff-64 + end if + if (tbuff .gt. 31)then + log8(3)=.true. + tbuff=tbuff-32 + end if + if (tbuff .gt. 15)then + log8(4)=.true. + tbuff=tbuff-16 + end if + if (tbuff .gt. 7)then + log8(5)=.true. + tbuff=tbuff-8 + end if + if (tbuff .gt. 3)then + log8(6)=.true. + tbuff=tbuff-4 + end if + if (tbuff .gt. 1)then + log8(7)=.true. + tbuff=tbuff-2 + end if + if (tbuff .eq. 1)then + log8(8)=.true. + end if + end diff --git a/pkg/tbtables/fitsio/ftgbnh.f b/pkg/tbtables/fitsio/ftgbnh.f new file mode 100644 index 00000000..894bffdf --- /dev/null +++ b/pkg/tbtables/fitsio/ftgbnh.f @@ -0,0 +1,12 @@ +C---------------------------------------------------------------------- + subroutine ftgbnh(iunit,nrows,nfield,ttype,tform,tunit, + & extnam,pcount,status) + +C OBSOLETE routine: should call ftghbn instead + + integer iunit,nrows,nfield,pcount,status + character*(*) ttype(*),tform(*),tunit(*),extnam + + call ftghbn(iunit,-1,nrows,nfield,ttype,tform, + & tunit,extnam,pcount,status) + end diff --git a/pkg/tbtables/fitsio/ftgbtp.f b/pkg/tbtables/fitsio/ftgbtp.f new file mode 100644 index 00000000..91af6d81 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgbtp.f @@ -0,0 +1,119 @@ +C-------------------------------------------------------------------------- + subroutine ftgbtp(ibuff,keynam,value,status) + +C Get Binary Table Parameter +C test if the keyword is one of the table column definition keywords +C of a binary table. If so, decode it and update the values in the common +C block + +C ibuff i sequence number of the data buffer +C OUTPUT PARAMETERS: +C keynam c name of the keyword +C value c value of the keyword +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ibuff,status,width + character keynam*8,value*70 + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- +C nb = number of file buffers = max. number of FITS file opened at once +C nf = maximum number of fields allowed in a table + integer nf,nb + parameter (nb = 20) + parameter (nf = 3000) + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer nfield,tstat + character tform*16 + + if (status .gt. 0)return + tstat=status + + if (keynam(1:5) .eq. 'TFORM')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TFORMn keyword + status=tstat + else +C get the TFORM character string, without quotes + call ftc2s(value,tform,status) +C get the datatype code and repeat count + call ftbnfm(tform,tdtype(nfield+tstart(ibuff)), + & trept(nfield+tstart(ibuff)),width,status) + if (tdtype(nfield+tstart(ibuff)) .eq. 1)then +C treat Bit datatype as if it were a Byte datatype + tdtype(nfield+tstart(ibuff))=11 + trept(nfield+tstart(ibuff))=(trept(nfield+ + & tstart(ibuff))+7)/8 + else if (tdtype(nfield+tstart(ibuff)) .eq. 16)then +C store the width of the ASCII field in the TNULL parameter + tnull(nfield+tstart(ibuff))=width + end if + end if + else if (keynam(1:5) .eq. 'TSCAL')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TSCALn keyword + status=tstat + else +C get the scale factor + call ftc2dd(value,tscale(nfield+tstart(ibuff)), + & status) + if (status .gt. 0)then + call ftpmsg('Error reading value of'//keynam + & //' as a Double: '//value) + end if + end if + else if (keynam(1:5) .eq. 'TZERO')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TZEROn keyword + status=tstat + else +C get the scaling zero point + call ftc2dd(value,tzero(nfield+tstart(ibuff)), + & status) + if (status .gt. 0)then + call ftpmsg('Error reading value of'//keynam + & //' as a Double: '//value) + end if + end if + else if (keynam(1:5) .eq. 'TNULL')then +C get the field number + call ftc2ii(keynam(6:8),nfield,status) + if (status .gt. 0)then +C this must not have been a TNULLn keyword + status=tstat + else +C make sure this is not an ASCII column (the tnull +C variable is use to store the ASCII column width) + if (tdtype(nfield+tstart(ibuff)) .ne. 16)then +C get the Null value flag (Integer) + call ftc2ii(value,tnull(nfield+tstart(ibuff)), + & status) + if (status .gt. 0)then + call ftpmsg('Error reading value of '// + & keynam//' as an integer: '//value) + end if + end if + end if + else if (keynam(1:8) .eq. 'THEAP ')then +C get the heap offset value + call ftc2ii(value,theap(ibuff),status) + if (status .gt. 0)then + call ftpmsg('Error reading value of '//keynam + & //' as an integer: '//value) + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftgcfb.f b/pkg/tbtables/fitsio/ftgcfb.f new file mode 100644 index 00000000..5c480f1d --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfb.f @@ -0,0 +1,33 @@ +C---------------------------------------------------------------------- + subroutine ftgcfb(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of byte values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array b returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + character*1 array(*),dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgclb(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfc.f b/pkg/tbtables/fitsio/ftgcfc.f new file mode 100644 index 00000000..a1598b9a --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfc.f @@ -0,0 +1,33 @@ +C---------------------------------------------------------------------- + subroutine ftgcfc(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of complex values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array cmp returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + real array(*),dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgclc(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfd.f b/pkg/tbtables/fitsio/ftgcfd.f new file mode 100644 index 00000000..546a9e41 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfd.f @@ -0,0 +1,33 @@ +C---------------------------------------------------------------------- + subroutine ftgcfd(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of r*8 values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array d returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + double precision array(*),dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgcld(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfe.f b/pkg/tbtables/fitsio/ftgcfe.f new file mode 100644 index 00000000..8944d0b4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfe.f @@ -0,0 +1,33 @@ +C---------------------------------------------------------------------- + subroutine ftgcfe(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of R*4 values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array r returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + real array(*),dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgcle(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfi.f b/pkg/tbtables/fitsio/ftgcfi.f new file mode 100644 index 00000000..63a44d66 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfi.f @@ -0,0 +1,33 @@ +C---------------------------------------------------------------------- + subroutine ftgcfi(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of I*2 values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array i*2 returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + integer*2 array(*),dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgcli(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfj.f b/pkg/tbtables/fitsio/ftgcfj.f new file mode 100644 index 00000000..ff21759e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfj.f @@ -0,0 +1,32 @@ +C---------------------------------------------------------------------- + subroutine ftgcfj(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of I*4 values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array i returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + integer array(*),dummy,i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgclj(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfl.f b/pkg/tbtables/fitsio/ftgcfl.f new file mode 100644 index 00000000..5bb9d2d4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfl.f @@ -0,0 +1,150 @@ +C---------------------------------------------------------------------- + subroutine ftgcfl(iunit,colnum,frow,felem,nelem,lray, + & flgval,anynul,status) + +C read an array of logical values from a specified column of the table. +C The binary table column being read from must have datatype 'L' +C and no datatype conversion will be perform if it is not. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C lray l returned array of data values that is read +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical lray(*),flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,maxpix,tcode,offset + integer ibuff,i,i1,ntodo,itodo,repeat,rstart,estart + character*1 buffer(80) + logical descrp + + if (status .gt. 0)return + + ibuff=bufnum(iunit) +C check for zero length array + if (nelem .le. 0)then + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + else if (felem .lt. 1)then +C illegal element number + status=308 + end if + + if (status .gt. 0)return + +C initialize the null flag array + do 5 i=1,nelem + flgval(i)=.false. +5 continue + anynul=.false. + + i1=0 + ntodo=nelem + rstart=frow-1 + estart=felem-1 + maxpix=80 + tcode=tdtype(colnum+tstart(ibuff)) + + if (tcode .eq. 14)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + return + end if + descrp=.false. + else if (tcode .eq. -14)then +C this is a variable length descriptor column + descrp=.true. +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+ntodo .gt. repeat)then +C error: trying to read beyond end of record + status=319 + return + end if +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+offset+ + & theap(ibuff)+estart + call ftmbyt(iunit,bstart,.true.,status) + else +C column must be logical data type + status=312 + return + end if + +C process as many contiguous pixels as possible +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + call ftmbyt(iunit,bstart,.false.,status) + end if + +C get the array of logical bytes + call ftgcbf(iunit,1,itodo,buffer,status) + if (status .gt. 0)return + +C decode the 'T' and 'F' characters, and look for nulls (0) + do 10 i=1,itodo + if (buffer(i) .eq. 'T')then + lray(i1+i)=.true. + else if (buffer(i) .eq. 'F')then + lray(i1+i)=.false. + else if (ichar(buffer(i)) .eq. 0)then + flgval(i1+i)=.true. + anynul=.true. + else + status=316 + return + end if +10 continue + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftgcfm.f b/pkg/tbtables/fitsio/ftgcfm.f new file mode 100644 index 00000000..a76c9724 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfm.f @@ -0,0 +1,34 @@ +C---------------------------------------------------------------------- + subroutine ftgcfm(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of double precision complex values from a specified +C column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C array dcmp returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + double precision array(*),dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgclm(iunit,colnum,frow,felem,nelem,1,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcfs.f b/pkg/tbtables/fitsio/ftgcfs.f new file mode 100644 index 00000000..a2625149 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcfs.f @@ -0,0 +1,34 @@ +C---------------------------------------------------------------------- + subroutine ftgcfs(iunit,colnum,frow,felem,nelem,array, + & flgval,anynul,status) + +C read an array of string values from a specified column of the table. +C Any undefined pixels will be have the corresponding value of FLGVAL +C set equal to .true., and ANYNUL will be set equal to .true. if +C any pixels are undefined. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element in the row to read +C nelem i number of elements to read +C array c returned array of data values that was read from FITS file +C flgval l set .true. if corresponding element undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval(*),anynul + character*(*) array(*) + character*8 dummy + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + + call ftgcls(iunit,colnum,frow,felem,nelem,2,dummy, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcks.f b/pkg/tbtables/fitsio/ftgcks.f new file mode 100644 index 00000000..ac712f08 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcks.f @@ -0,0 +1,54 @@ +C---------------------------------------------------------------------- + subroutine ftgcks(iunit,datsum,chksum,status) + +C calculate and encode the checksums of the data unit and the total HDU + +C iunit i fortran unit number +C datsum d output checksum for the data +C chksum d output checksum for the entire HDU +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Sept, 1994 + + integer iunit,status + double precision datsum,chksum + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,nrec + + if (status .gt. 0)return + +C calculate number of data records + ibuff=bufnum(iunit) + nrec=(hdstrt(ibuff,chdu(ibuff)+1)-dtstrt(ibuff))/2880 + + datsum=0. + if (nrec .gt. 0)then + +C move to the start of the data + call ftmbyt(iunit,dtstrt(ibuff),.true.,status) + +C accumulate the 32-bit 1's complement checksum + call ftcsum(iunit,nrec,datsum,status) + end if + +C move to the start of the header + call ftmbyt(iunit,hdstrt(ibuff,chdu(ibuff)),.true.,status) + +C calculate number of FITS blocks in the header + nrec=(dtstrt(ibuff)-hdstrt(ibuff,chdu(ibuff)))/2880 + +C accumulate the header into the checksum + chksum=datsum + call ftcsum(iunit,nrec,chksum,status) + end diff --git a/pkg/tbtables/fitsio/ftgcl.f b/pkg/tbtables/fitsio/ftgcl.f new file mode 100644 index 00000000..4331aa93 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcl.f @@ -0,0 +1,184 @@ +C---------------------------------------------------------------------- + subroutine ftgcl(iunit,colnum,frow,felem,nelem,lray,status) + +C read an array of logical values from a specified column of the table. +C The binary table column being read from must have datatype 'L' +C and no datatype conversion will be perform if it is not. +C This routine ignores any undefined values in the logical array. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C lray l returned array of data values that is read +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical lray(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,maxpix,offset,tcode + integer ibuff,i,i1,ntodo,itodo,repeat,rstart,estart + character*1 buffer(80) + logical descrp + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + tcode=tdtype(colnum+tstart(ibuff)) + +C check for zero length array + if (nelem .le. 0)then + return + else if (frow .lt. 1)then +C error: illegal first row number + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCL).') + status=307 + return + else if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCL).') + return + end if + + i1=0 + ntodo=nelem + rstart=frow-1 + estart=felem-1 + maxpix=80 + + if (tcode .eq. 14)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCL).') + return + end if + descrp=.false. + else if (tcode .eq. -14)then +C this is a variable length descriptor column + descrp=.true. +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+ntodo .gt. repeat)then +C error: trying to read beyond end of record + status=319 + return + end if +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+offset+ + & theap(ibuff)+estart + call ftmbyt(iunit,bstart,.true.,status) + else +C column must be logical data type + status=312 + return + end if + +C process as many contiguous pixels as possible +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + call ftmbyt(iunit,bstart,.false.,status) + end if + +C get the array of logical bytes + call ftgcbf(iunit,1,itodo,buffer,status) + +C decode the 'T' and 'F' characters, + do 10 i=1,itodo + if (buffer(i) .eq. 'T')then + lray(i1+i)=.true. + else if (buffer(i) .eq. 'F')then + lray(i1+i)=.false. + else if (ichar(buffer(i)) .eq. 0)then +C ignore null values; leave input logical value unchanged + else +C illegal logical value + status=316 + return + end if +10 continue + + if (status .gt. 0)then + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLB.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLB).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLB).') + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftgclb.f b/pkg/tbtables/fitsio/ftgclb.f new file mode 100644 index 00000000..c3f7a7e0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgclb.f @@ -0,0 +1,380 @@ +C---------------------------------------------------------------------- + subroutine ftgclb(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of byte data values from the specified column of +C the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval b value that undefined pixels will be set to (if nultyp=1) +C array b array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + character*1 array(*),nulval + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,i4null,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + integer offset,rskip,dstart,begcol,lenrow + integer*2 i2null + character*1 i1null + real rval + double precision scale,zero,dval + character sval*40,sform*13,snull*16 + logical tofits,descrp,trans + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLB).') + return + end if + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) +C the data are being scaled from FITS to internal format + tofits=.false. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) +C check for important special case: no datatype conversion required + if (abs(tcode) .eq. 11)then + maxpix=nelem + else + maxpix=bufdim/bytpix*4 + end if + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + if (tcode .eq. 16)then +C this is an ASCII table; each element will be read one at a time + repeat=1 + estart=0 +C construct the read format, and get the null value string +C Microsoft Fortran 5.0 can't handle: +C sform='(BN,'//cform(colnum+tstart(ibuff))//')' + sform='(BN, )' + sform(5:12)=cform(colnum+tstart(ibuff)) + snull=cnull(colnum+tstart(ibuff)) + sval=' ' + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLB).') + return + end if + estart=felem-1 + + if (tcode .gt. 0)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLB).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=maxpix*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) + % then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + end if + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. ichar(nulval) .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values +C see if the null value has been defined for this column + nulchk=0 + if (tcode .eq. 11)then +C check if byte datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i1null=char(tnull(colnum+tstart(ibuff))) + nulchk=nultyp + end if + else if (tcode .eq. 21)then +C check if I*2 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i2null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 41)then +C check if I*4 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i4null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 42 .or. tcode .eq. 82)then +C have to check floating point data for NaN values + nulchk=nultyp + end if + end if + + if (nulchk .eq. 0 .and. scale .eq. 1. .and. zero .eq. 0.)then + trans=.false. + else + trans=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1,maxpix) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data from FITS file, doing datatype conversion and scaling + if (tcode .eq. 21)then +C column data type is I (I*2) +C read the data and do any machine dependent data conversion + call ftgi2b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti2i1(buffer,itodo,scale,zero,tofits, + & nulchk,i2null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 41)then +C column data type is J (I*4) +C read the data and do any machine dependent data conversion + call ftgi4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti4i1(buffer,itodo,scale,zero,tofits, + & nulchk,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 42)then +C column data type is E (R*4) +C read the data and do any machine dependent data conversion + call ftgr4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr4i1(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 82)then +C column data type is D (R*8) +C read the data and do any machine dependent data conversion + call ftgr8b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr8i1(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 11)then +C column data type is B (byte) +C read the data and do any machine dependent data conversion +C note that we can use the input array directly + call ftgi1b(iunit,itodo,incre,array(i1),status) +C check for null values, and do scaling and datatype conversion + if (trans)then + call fti1i1(array(i1),itodo,scale,zero,tofits,nulchk, + & i1null,nulval,flgval(i1),anynul,array(i1),status) + end if + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column; get the character string + call ftgcbf(iunit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + if (status .gt. 0)return + +C check for null + if (sval(1:16) .eq. snull)then + anynul=.true. + if (nultyp .eq. 1)then + array(i1)=nulval + else + flgval(i1)=.true. + end if + go to 30 + end if + +C now read the value, then do scaling and datatype conversion + if (sform(5:5) .eq. 'I')then + read(sval,sform,err=900)ival + call fti4i1(ival,itodo,scale,zero,tofits,0, + & i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5).eq.'F'.or. sform(5:5).eq.'E')then + read(sval,sform,err=900)rval + call ftr4i1(rval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5) .eq. 'D')then + read(sval,sform,err=900)dval + call ftr8i1(dval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot read byte (I*1) values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLB).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot read byte (I*1) values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLB).') + return + end if + +C find number of pixels left to do, and quit if none left +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading pixels'//cp1//' to'//cp2 + & // ' of the FITS image array (FTGCLB).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while reading group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLB.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLB).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLB).') + end if + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred reading '// + & 'Byte data from FITS file.') + end if + return + +900 continue +C error reading formatted data value from ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error reading colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to read "'//sval(1:20)// + & '" with format '//sform//' (FTGCLB).') + status=315 + end diff --git a/pkg/tbtables/fitsio/ftgclc.f b/pkg/tbtables/fitsio/ftgclc.f new file mode 100644 index 00000000..f90ff05c --- /dev/null +++ b/pkg/tbtables/fitsio/ftgclc.f @@ -0,0 +1,238 @@ +C---------------------------------------------------------------------- + subroutine ftgclc(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of complex data values from the specified column of +C the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. +C The binary table column being read to must have datatype 'C' +C and no datatype conversion will be perform if it is not. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of (pairs) elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval r value that undefined pixels will be set to (if nultyp=1) +C array r array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + real array(*),nulval(2) + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bytpix,bstart,tcode,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart + integer offset,rskip,dstart,begcol,lenrow,i,j + logical scaled,descrp + double precision scale,zero + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLC).') + return + end if + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLC).') + return + end if + + i1=1 + ntodo=nelem + estart=felem-1 + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + bytpix=8 + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + + if (tcode .eq. 83)then + descrp=.false. + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLC).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=nelem*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else if (tcode .eq. -83)then +C this is a variable length descriptor column +C read the number of elements and the starting offset: + descrp=.true. + call ftgdes(iunit,colnum,frow,repeat,offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + else +C column must be complex data type + status=312 + call ftpmsg('Column'//ccol//' does not have '// + & 'Complex (C) data type (FTGCLC).') + return + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval(1) .eq. 0 .and. + & nulval(2) .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values + nulchk=nultyp + end if + +C check if scaling is required + if (scale .eq. 1.0 .and. zero .eq. 0.)then + scaled=.false. + else + scaled=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data + if (incre .eq. 8)then +C the data values are contiguous in the FITS file +C multiply itodo*2 because we are getting pairs of values + call ftgr4b(iunit,itodo*2,4,array(i1),status) + else +C have to read each complex pair one by one + j=i1 + call ftgr4b(iunit,2,4,array(j),status) + j=j+2 + do 25 i=2,itodo + call ftmoff(iunit,incre-8,.false.,status) + call ftgr4b(iunit,2,4,array(j),status) + j=j+2 +25 continue + end if + +C find number of pixels left to do, and process them +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLC.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLC).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLC).') + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo*2 + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for null values and/or scale the values + if (nulchk .ne. 0 .or. scaled)then + call ftnulc(array,nelem,nulchk,nulval,flgval,anynul, + & scaled,scale,zero) + end if + end diff --git a/pkg/tbtables/fitsio/ftgcld.f b/pkg/tbtables/fitsio/ftgcld.f new file mode 100644 index 00000000..46b2d92e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcld.f @@ -0,0 +1,382 @@ +C---------------------------------------------------------------------- + subroutine ftgcld(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of real*8 data values from the specified column of +C the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval d value that undefined pixels will be set to (if nultyp=1) +C array d array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + double precision array(*),nulval + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,i4null,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + integer offset,rskip,dstart,begcol,lenrow + integer*2 i2null + character*1 i1null + real rval + double precision scale,zero,dval + character sval*40,sform*13,snull*16 + character crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,descrp,trans + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLD).') + return + end if + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) +C the data are being scaled from FITS to internal format + tofits=.false. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) +C check for important special case: no datatype conversion required + if (abs(tcode) .eq. 82)then + maxpix=nelem + else + maxpix=bufdim/bytpix*4 + end if + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + if (tcode .eq. 16)then +C this is an ASCII table; each element will be read one at a time + repeat=1 + estart=0 +C construct the read format, and get the null value string +C Microsoft Fortran 5.0 bug can't handle: +C sform='(BN,'//cform(colnum+tstart(ibuff))//')' + sform='(BN, )' + sform(5:12)=cform(colnum+tstart(ibuff)) + snull=cnull(colnum+tstart(ibuff)) + sval=' ' + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLD).') + return + end if + estart=felem-1 + + if (tcode .gt. 0)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLD).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=maxpix*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) + % then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + end if + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values +C see if the null value has been defined for this column + nulchk=0 + if (tcode .eq. 11)then +C check if byte datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i1null=char(tnull(colnum+tstart(ibuff))) + nulchk=nultyp + end if + else if (tcode .eq. 21)then +C check if I*2 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i2null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 41)then +C check if I*4 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i4null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 42 .or. tcode .eq. 82)then +C have to check floating point data for NaN values + nulchk=nultyp + end if + end if + + if (nulchk .eq. 0 .and. scale .eq. 1. .and. zero .eq. 0.)then + trans=.false. + else + trans=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1,maxpix) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data from FITS file, doing datatype conversion and scaling + if (tcode .eq. 21)then +C column data type is I (I*2) +C read the data and do any machine dependent data conversion + call ftgi2b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti2r8(buffer,itodo,scale,zero,tofits, + & nulchk,i2null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 41)then +C column data type is J (I*4) +C read the data and do any machine dependent data conversion + call ftgi4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti4r8(buffer,itodo,scale,zero,tofits, + & nulchk,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 42)then +C column data type is E (R*4) +C read the data and do any machine dependent data conversion + call ftgr4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr4r8(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 82)then +C column data type is D (R*8) +C read the data and do any machine dependent data conversion +C note that we can use the input array directly + call ftgr8b(iunit,itodo,incre,array(i1),status) +C check for null values, and do scaling and datatype conversion + if (trans)then + call ftr8r8(array(i1),itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + end if + else if (tcode .eq. 11)then +C column data type is B (byte) +C read the data and do any machine dependent data conversion + call ftgi1b(iunit,itodo,incre,chbuff,status) +C check for null values, and do scaling and datatype conversion + call fti1r8(chbuff,itodo,scale,zero,tofits, + & nulchk,i1null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column; get the character string + call ftgcbf(iunit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + if (status .gt. 0)return + +C check for null + if (sval(1:16) .eq. snull)then + anynul=.true. + if (nultyp .eq. 1)then + array(i1)=nulval + else + flgval(i1)=.true. + end if + go to 30 + end if + +C now read the value, then do scaling and datatype conversion + if (sform(5:5) .eq. 'I')then + read(sval,sform,err=900)ival + call fti4r8(ival,itodo,scale,zero,tofits, + & 0,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5).eq.'F'.or. sform(5:5).eq.'E')then + read(sval,sform,err=900)rval + call ftr4r8(rval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5) .eq. 'D')then + read(sval,sform,err=900)dval + call ftr8r8(dval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot read double values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLD).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot read double values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLD).') + return + end if + +C find number of pixels left to do, and quit if none left +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading pixels'//cp1//' to'//cp2 + & // ' of the FITS image array (FTGCLD).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while reading group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLD.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLD).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLD).') + end if + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred reading '// + & 'Real*8 data from FITS file.') + end if + return + +900 continue +C error reading formatted data value from ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error reading colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to read "'//sval(1:20)// + & '" with format '//sform//' (FTGCLD).') + status=315 + end diff --git a/pkg/tbtables/fitsio/ftgcle.f b/pkg/tbtables/fitsio/ftgcle.f new file mode 100644 index 00000000..375db9f9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcle.f @@ -0,0 +1,382 @@ +C---------------------------------------------------------------------- + subroutine ftgcle(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of real*4 data values from the specified column of +C the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval r value that undefined pixels will be set to (if nultyp=1) +C array r array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + real array(*),nulval + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,i4null,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + integer offset,rskip,dstart,begcol,lenrow + integer*2 i2null + character*1 i1null + real rval + double precision scale,zero,dval + character sval*40,sform*13,snull*16 + character crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,descrp,trans + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLE).') + return + end if + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) +C the data are being scaled from FITS to internal format + tofits=.false. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) +C check for important special case: no datatype conversion required + if (abs(tcode) .eq. 42)then + maxpix=nelem + else + maxpix=bufdim/bytpix*4 + end if + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + if (tcode .eq. 16)then +C this is an ASCII table; each element will be read one at a time + repeat=1 + estart=0 +C construct the read format, and get the null value string +C Microsoft Fortran 5.0 bug can't handle: +C sform='(BN,'//cform(colnum+tstart(ibuff))//')' + sform='(BN, )' + sform(5:12)=cform(colnum+tstart(ibuff)) + snull=cnull(colnum+tstart(ibuff)) + sval=' ' + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLE).') + return + end if + estart=felem-1 + + if (tcode .gt. 0)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLE).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=maxpix*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) + % then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + end if + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values +C see if the null value has been defined for this column + nulchk=0 + if (tcode .eq. 11)then +C check if byte datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i1null=char(tnull(colnum+tstart(ibuff))) + nulchk=nultyp + end if + else if (tcode .eq. 21)then +C check if I*2 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i2null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 41)then +C check if I*4 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i4null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 42 .or. tcode .eq. 82)then +C have to check floating point data for NaN values + nulchk=nultyp + end if + end if + + if (nulchk .eq. 0 .and. scale .eq. 1. .and. zero .eq. 0.)then + trans=.false. + else + trans=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1,maxpix) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data from FITS file, doing datatype conversion and scaling + if (tcode .eq. 21)then +C column data type is I (I*2) +C read the data and do any machine dependent data conversion + call ftgi2b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti2r4(buffer,itodo,scale,zero,tofits, + & nulchk,i2null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 41)then +C column data type is J (I*4) +C read the data and do any machine dependent data conversion + call ftgi4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti4r4(buffer,itodo,scale,zero,tofits, + & nulchk,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 42)then +C column data type is E (R*4) +C read the data and do any machine dependent data conversion +C note that we can use the input array directly + call ftgr4b(iunit,itodo,incre,array(i1),status) +C check for null values, and do scaling and datatype conversion + if (trans)then + call ftr4r4(array(i1),itodo,scale,zero,tofits,nulchk, + & nulval,flgval(i1),anynul,array(i1),status) + end if + else if (tcode .eq. 82)then +C column data type is D (R*8) +C read the data and do any machine dependent data conversion + call ftgr8b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr8r4(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 11)then +C column data type is B (byte) +C read the data and do any machine dependent data conversion + call ftgi1b(iunit,itodo,incre,chbuff,status) +C check for null values, and do scaling and datatype conversion + call fti1r4(chbuff,itodo,scale,zero,tofits, + & nulchk,i1null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column; get the character string + call ftgcbf(iunit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + if (status .gt. 0)return + +C check for null + if (sval(1:16) .eq. snull)then + anynul=.true. + if (nultyp .eq. 1)then + array(i1)=nulval + else + flgval(i1)=.true. + end if + go to 30 + end if + +C now read the value, then do scaling and datatype conversion + if (sform(5:5) .eq. 'I')then + read(sval,sform,err=900)ival + call fti4r4(ival,itodo,scale,zero,tofits, + & 0,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5).eq.'F'.or. sform(5:5).eq.'E')then + read(sval,sform,err=900)rval + call ftr4r4(rval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5) .eq. 'D')then + read(sval,sform,err=900)dval + call ftr8r4(dval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot read real values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLE).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot read real values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLE).') + return + end if + +C find number of pixels left to do, and quit if none left +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading pixels'//cp1//' to'//cp2 + & // ' of the FITS image array (FTGCLE).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while reading group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLE.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLE).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLE).') + end if + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred reading '// + & 'Real*4 data from FITS file.') + end if + return + +900 continue +C error reading formatted data value from ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error reading colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to read "'//sval(1:20)// + & '" with format '//sform//' (FTGCLE).') + status=315 + end diff --git a/pkg/tbtables/fitsio/ftgcli.f b/pkg/tbtables/fitsio/ftgcli.f new file mode 100644 index 00000000..1ef258c4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcli.f @@ -0,0 +1,382 @@ +C---------------------------------------------------------------------- + subroutine ftgcli(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of integer*2 data values from the specified column of +C the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval i*2 value that undefined pixels will be set to (if nultyp=1) +C array i*2 array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + integer*2 array(*),nulval + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,i4null,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + integer offset,rskip,dstart,begcol,lenrow + integer*2 i2null + character*1 i1null + real rval + double precision scale,zero,dval + character sval*40,sform*13,snull*16 + character crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,descrp,trans + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLI).') + return + end if + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) +C the data are being scaled from FITS to internal format + tofits=.false. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) +C check for important special case: no datatype conversion required + if (abs(tcode) .eq. 21)then + maxpix=nelem + else + maxpix=bufdim/bytpix*4 + end if + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + if (tcode .eq. 16)then +C this is an ASCII table; each element will be read one at a time + repeat=1 + estart=0 +C construct the read format, and get the null value string +C Microsoft Fortran 5.0 bug can't handle: +C sform='(BN,'//cform(colnum+tstart(ibuff))//')' + sform='(BN, )' + sform(5:12)=cform(colnum+tstart(ibuff)) + snull=cnull(colnum+tstart(ibuff)) + sval=' ' + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLI).') + return + end if + estart=felem-1 + + if (tcode .gt. 0)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLI).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=maxpix*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) + % then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + end if + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values +C see if the null value has been defined for this column + nulchk=0 + if (tcode .eq. 11)then +C check if byte datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i1null=char(tnull(colnum+tstart(ibuff))) + nulchk=nultyp + end if + else if (tcode .eq. 21)then +C check if I*2 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i2null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 41)then +C check if I*4 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i4null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 42 .or. tcode .eq. 82)then +C have to check floating point data for NaN values + nulchk=nultyp + end if + end if + + if (nulchk .eq. 0 .and. scale .eq. 1. .and. zero .eq. 0.)then + trans=.false. + else + trans=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1,maxpix) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data from FITS file, doing datatype conversion and scaling + if (tcode .eq. 21)then +C column data type is I (I*2) +C read the data and do any machine dependent data conversion +C note that we can use the input array directly + call ftgi2b(iunit,itodo,incre,array(i1),status) +C check for null values, and do scaling and datatype conversion + if (trans)then + call fti2i2(array(i1),itodo,scale,zero,tofits,nulchk, + & i2null,nulval,flgval(i1),anynul,array(i1),status) + end if + else if (tcode .eq. 41)then +C column data type is J (I*4) +C read the data and do any machine dependent data conversion + call ftgi4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti4i2(buffer,itodo,scale,zero,tofits, + & nulchk,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 42)then +C column data type is E (R*4) +C read the data and do any machine dependent data conversion + call ftgr4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr4i2(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 82)then +C column data type is D (R*8) +C read the data and do any machine dependent data conversion + call ftgr8b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr8i2(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 11)then +C column data type is B (byte) +C read the data and do any machine dependent data conversion + call ftgi1b(iunit,itodo,incre,chbuff,status) +C check for null values, and do scaling and datatype conversion + call fti1i2(chbuff,itodo,scale,zero,tofits, + & nulchk,i1null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column; get the character string + call ftgcbf(iunit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + if (status .gt. 0)return + +C check for null + if (sval(1:16) .eq. snull)then + anynul=.true. + if (nultyp .eq. 1)then + array(i1)=nulval + else + flgval(i1)=.true. + end if + go to 30 + end if + +C now read the value, then do scaling and datatype conversion + if (sform(5:5) .eq. 'I')then + read(sval,sform,err=900)ival + call fti4i2(ival,itodo,scale,zero,tofits, + & 0,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5).eq.'F'.or. sform(5:5).eq.'E')then + read(sval,sform,err=900)rval + call ftr4i2(rval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5) .eq. 'D')then + read(sval,sform,err=900)dval + call ftr8i2(dval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot read integer*2 values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLI).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot read integer*2 values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLI).') + return + end if + +C find number of pixels left to do, and quit if none left +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading pixels'//cp1//' to'//cp2 + & // ' of the FITS image array (FTGCLI).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while reading group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLI.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLI).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLI).') + end if + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred reading '// + & 'Integer*4 data from FITS file.') + end if + return + +900 continue +C error reading formatted data value from ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error reading colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to read "'//sval(1:20)// + & '" with format '//sform//' (FTGCLI).') + status=315 + end diff --git a/pkg/tbtables/fitsio/ftgclj.f b/pkg/tbtables/fitsio/ftgclj.f new file mode 100644 index 00000000..c0309ed6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgclj.f @@ -0,0 +1,384 @@ +C---------------------------------------------------------------------- + subroutine ftgclj(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of integer*4 data values from the specified column of +C the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval i value that undefined pixels will be set to (if nultyp=1) +C array i array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + integer array(*),nulval + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,i4null,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + integer offset,rskip,dstart,begcol,lenrow + integer*2 i2null + character*1 i1null + real rval + double precision scale,zero,dval,align + character sval*40,sform*13,snull*16 + character crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,descrp,trans +C the following equivalence is required for the HP/UX PA-RISC complier +C to force the buffer to be double word aligned. + equivalence (align,buffer(1)) + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLJ).') + return + end if + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) +C the data are being scaled from FITS to internal format + tofits=.false. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) +C check for important special case: no datatype conversion required + if (abs(tcode) .eq. 41)then + maxpix=nelem + else + maxpix=bufdim/bytpix*4 + end if + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + if (tcode .eq. 16)then +C this is an ASCII table; each element will be read one at a time + repeat=1 + estart=0 +C construct the read format, and get the null value string +C Microsoft Fortran 5.0 bug can't handle: +C sform='(BN,'//cform(colnum+tstart(ibuff))//')' + sform='(BN, )' + sform(5:12)=cform(colnum+tstart(ibuff)) + snull=cnull(colnum+tstart(ibuff)) + sval=' ' + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLJ).') + return + end if + estart=felem-1 + + if (tcode .gt. 0)then + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLJ).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=maxpix*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) + % then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + end if + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values +C see if the null value has been defined for this column + nulchk=0 + if (tcode .eq. 11)then +C check if byte datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i1null=char(tnull(colnum+tstart(ibuff))) + nulchk=nultyp + end if + else if (tcode .eq. 21)then +C check if I*2 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i2null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 41)then +C check if I*4 datatype null value is defined, + if (tnull(colnum+tstart(ibuff)).ne.123454321)then + i4null=tnull(colnum+tstart(ibuff)) + nulchk=nultyp + end if + else if (tcode .eq. 42 .or. tcode .eq. 82)then +C have to check floating point data for NaN values + nulchk=nultyp + end if + end if + + if (nulchk .eq. 0 .and. scale .eq. 1. .and. zero .eq. 0.)then + trans=.false. + else + trans=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1,maxpix) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data from FITS file, doing datatype conversion and scaling + if (tcode .eq. 21)then +C column data type is I (I*2) +C read the data and do any machine dependent data conversion + call ftgi2b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call fti2i4(buffer,itodo,scale,zero,tofits, + & nulchk,i2null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 41)then +C column data type is J (I*4) +C read the data and do any machine dependent data conversion +C note that we can use the input array directly + call ftgi4b(iunit,itodo,incre,array(i1),status) +C check for null values, and do scaling and datatype conversion + if (trans)then + call fti4i4(array(i1),itodo,scale,zero,tofits,nulchk, + & i4null,nulval,flgval(i1),anynul,array(i1),status) + end if + else if (tcode .eq. 42)then +C column data type is E (R*4) +C read the data and do any machine dependent data conversion + call ftgr4b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr4i4(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 82)then +C column data type is D (R*8) +C read the data and do any machine dependent data conversion + call ftgr8b(iunit,itodo,incre,buffer,status) +C check for null values, and do scaling and datatype conversion + call ftr8i4(buffer,itodo,scale,zero,tofits, + & nulchk,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 11)then +C column data type is B (byte) +C read the data and do any machine dependent data conversion + call ftgi1b(iunit,itodo,incre,chbuff,status) +C check for null values, and do scaling and datatype conversion + call fti1i4(chbuff,itodo,scale,zero,tofits, + & nulchk,i1null,nulval,flgval(i1),anynul,array(i1),status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column; get the character string + call ftgcbf(iunit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + if (status .gt. 0)return + +C check for null + if (sval(1:16) .eq. snull)then + anynul=.true. + if (nultyp .eq. 1)then + array(i1)=nulval + else + flgval(i1)=.true. + end if + go to 30 + end if +C now read the value, then do scaling and datatype conversion + if (sform(5:5) .eq. 'I')then + read(sval,sform,err=900)ival + call fti4i4(ival,itodo,scale,zero,tofits, + & 0,i4null,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5).eq.'F'.or. sform(5:5).eq.'E')then + read(sval,sform,err=900)rval + call ftr4i4(rval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else if (sform(5:5) .eq. 'D')then + read(sval,sform,err=900)dval + call ftr8i4(dval,itodo,scale,zero,tofits, + & 0,nulval,flgval(i1),anynul,array(i1),status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot read integer*4 values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLJ).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot read integer*4 values from column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTGCLJ).') + return + end if + +C find number of pixels left to do, and quit if none left +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading pixels'//cp1//' to'//cp2 + & // ' of the FITS image array (FTGCLJ).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while reading group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLJ.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLJ).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLJ).') + end if + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred reading '// + & 'Integer*4 data from FITS file.') + end if + return + +900 continue +C error reading formatted data value from ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error reading colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to read "'//sval(1:20)// + & '" with format '//sform//' (FTGCLJ).') + status=315 + end diff --git a/pkg/tbtables/fitsio/ftgclm.f b/pkg/tbtables/fitsio/ftgclm.f new file mode 100644 index 00000000..b299d10b --- /dev/null +++ b/pkg/tbtables/fitsio/ftgclm.f @@ -0,0 +1,239 @@ +C-------------------------------------------------------------------------- + subroutine ftgclm(iunit,colnum,frow,felem,nelem,eincr, + & nultyp,nulval,array,flgval,anynul,status) + +C read an array of double complex data values from the specified +C column of the table. +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. +C The binary table column being read to must have datatype 'M' +C and no datatype conversion will be perform if it is not. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within the row to read +C nelem i number of (pairs) elements to read +C eincr i element increment +C nultyp i input code indicating how to handle undefined values +C nulval d value that undefined pixels will be set to (if nultyp=1) +C array d array of data values that are read from the FITS file +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,eincr,nultyp,status + double precision array(*),nulval(2) + logical flgval(*),anynul + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bytpix,bstart,tcode,nulchk,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart + integer offset,rskip,dstart,begcol,lenrow,i,j + logical scaled,descrp + double precision scale,zero + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLM).') + return + end if + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLM).') + return + end if + + i1=1 + ntodo=nelem + estart=felem-1 + rstart=frow-1 + anynul=.false. + ibuff=bufnum(iunit) + dstart=dtstrt(ibuff) + lenrow=rowlen(ibuff) + begcol=tbcol(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + bytpix=16 + +C determine the repeat count and the first element position +C incre is the byte offset between consecutive pixels + incre=bytpix*eincr + + if (tcode .eq. 163)then + descrp=.false. + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLM).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C read multiple rows of data at one time by +C fooling it into thinking that this is a vector +C column with a large value of bytes per pixel + dstart=dstart+rstart*lenrow + rstart=0 + estart=0 + repeat=nelem*eincr + incre=lenrow*eincr + lenrow=lenrow*repeat + end if + else if (tcode .eq. -163)then +C this is a variable length descriptor column +C read the number of elements and the starting offset: + descrp=.true. + call ftgdes(iunit,colnum,frow,repeat,offset,status) + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if (estart+(nelem-1)*eincr+1 .gt. repeat) then +C error: trying to read beyond end of record + status=319 + return + end if +C define the starting point of the row + dstart=dstart+offset+theap(ibuff) + rstart=0 + begcol=0 + else +C column must be double complex data type + status=312 + write(ccol,2001)colnum + call ftpmsg('Column'//ccol//' does not have '// + & 'Double Precision Complex (M) data type (FTGCLM).') + return + end if + +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval(1) .eq. 0 .and. + & nulval(2) .eq. 0)then +C user doesn't want to check for nulls + nulchk=0 + else +C user does want to check for null values + nulchk=nultyp + end if + +C check if scaling is required + if (scale .eq. 1.0 .and. zero .eq. 0.)then + scaled=.false. + else + scaled=.true. + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,(repeat-estart-1)/eincr+1) + +C move the i/o pointer to the start of the sequence of pixels + bstart=dstart+rstart*lenrow+begcol+estart*bytpix + call ftmbyt(iunit,bstart,.false.,status) + +C read the data + if (incre .eq. 16)then +C the data values are contiguous in the FITS file +C multiply itodo*2 because we are getting pairs of values + call ftgr8b(iunit,itodo*2,8,array(i1),status) + else +C have to read each complex double pair one by one + j=i1 + call ftgr8b(iunit,2,8,array(j),status) + j=j+2 + do 25 i=2,itodo + call ftmoff(iunit,incre-16,.false.,status) + call ftgr8b(iunit,2,8,array(j),status) + j=j+2 +25 continue + end if + +C find number of pixels left to do, and process them +30 ntodo=ntodo-itodo + + if (status .gt. 0)then + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error reading elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTGCLM.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error reading rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTGCLM).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error reading'//cp2//' elements from' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTGCLM).') + end if + return + end if + + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo*2 + estart=estart+itodo*eincr + rskip=estart/repeat + rstart=rstart+rskip + estart=estart-rskip*repeat + go to 20 + end if + +C check for null values and/or scale the values + if (nulchk .ne. 0 .or. scaled)then + call ftnulm(array,nelem,nulchk,nulval,flgval,anynul, + & scaled,scale,zero) + end if + end diff --git a/pkg/tbtables/fitsio/ftgcls.f b/pkg/tbtables/fitsio/ftgcls.f new file mode 100644 index 00000000..6457726e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcls.f @@ -0,0 +1,207 @@ +C---------------------------------------------------------------------- + subroutine ftgcls(iunit,colnum,frow,felem,nelem,nultyp,nulval, + & sray,flgval,anynul,status) + +C read an array of character string values from the specified column of +C the table. +C The binary or ASCII table column being read must have datatype 'A' +C This general purpose routine will handle null values in one +C of two ways: if nultyp=1, then undefined array elements will be +C set equal to the input value of NULVAL. Else if nultyp=2, then +C undefined array elements will have the corresponding FLGVAL element +C set equal to .TRUE. If NULTYP=1 and NULVAL=0, then no checks for +C undefined values will be made, for maximum efficiency. + +C iunit i fortran unit number +C colnum i number of the column to read from +C frow i first row to read +C felem i first element within row to read +C nelem i number of elements to read +C nultyp i input code indicating how to handle undefined values +C nulval c value that undefined pixels will be set to (if nultyp=1) +C sray c array of data values to be read +C flgval l set .true. if corresponding element undefined (if nultyp=2) +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,nultyp,status + logical flgval(*),anynul + character*(*) sray(*),nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,nulchk,twidth,tread,tcode,offset,repeat + integer ibuff,i1,ntodo,rstart,estart,lennul,strlen,nulfil + character snull*16, crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table read '// + & 'request is out of range:'//crow//' (FTGCLS).') + return + else if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLS).') + return + end if + + anynul=.false. + ibuff=bufnum(iunit) + i1=1 + +C column must be character string data type + + tcode=tdtype(colnum+tstart(ibuff)) + if (tcode .eq. 16)then +C for ASCII columns, TNULL actually stores the field width + twidth=tnull(colnum+tstart(ibuff)) + ntodo=nelem + rstart=frow-1 + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for read '// + & 'request is out of range:'//crow//' (FTGCLS).') + return + end if + estart=felem-1 + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*twidth + else if (tcode .eq. -16)then +C this is a variable length descriptor field + ntodo=1 +C read the string length and the starting offset: + call ftgdes(iunit,colnum,frow,twidth,offset,status) +C calc the i/o pointer position for the start of the string + bstart=dtstrt(ibuff)+offset+theap(ibuff) + else +C error: not a character string column + status=309 + call ftpmsg('Cannot to read character string'// + & ' from a non-character column of a table (FTGCLS).') + return + end if + +C define the max. number of charcters to be read: either +C the length of the variable length field, or the length +C of the character string variable, which ever is smaller + strlen=len(sray(1)) + tread=min(twidth,strlen) + +C move the i/o pointer to the start of the sequence of pixels + call ftmbyt(iunit,bstart,.false.,status) + + if (status .gt. 0)then + call ftpmsg('Failed to move to starting position '// + & 'to read character string(s) (FTGCLS).') + return + end if + + lennul=0 +C determine if we have to check for null values + if (nultyp .eq. 1 .and. nulval .eq. ' ')then +C user doesn't want to check for nulls + nulchk=0 + else + nulchk=nultyp + snull=cnull(colnum+tstart(ibuff)) +C lennul = length of the string to check for null values + lennul=min(len(sray(1)),8) + end if + +C process one string at a time +20 continue +C get the string of characters + sray(i1)=' ' + call ftgcbf(iunit,1,tread,sray(i1),status) + if (status .gt. 0)return + +C check for null value, if required + if (nulchk .ne. 0)then + if (ichar(sray(i1)(1:1)) .eq. 0 .or. + & sray(i1)(1:lennul) .eq. snull(1:lennul))then + if (nulchk .eq. 1)then + sray(i1)=nulval + anynul=.true. + else + flgval(i1)=.true. + anynul=.true. + end if + end if + end if + +C check for null terminated string; pad out with blanks if found + nulfil=index(sray(i1),char(0)) + if (nulfil .gt. 1)then + sray(i1)(nulfil:len(sray(1)))=' ' + end if + + if (status .gt. 0)then + write(cp1,2000)i1 + write(ccol,2001)colnum +2001 format(i4) + write(cp1,2000)rstart+1 + write(cp2,2000)estart+1 + if (felem .eq. 1)then + call ftpmsg('Error while reading ASCII string from '// + & 'column'//ccol//', row'//cp1//' (FTGCLS).') + else + call ftpmsg('Error reading string from '// + & 'column'//ccol//', row'//cp1 + & //', element'//cp2//' (FTGCLS).') + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-1 + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+1 + estart=estart+1 + if (estart .eq. repeat)then + rstart=rstart+1 + estart=0 + end if +C move to the start of the next string; need to do +C this every time in case we didn't read all the characters +C from the previous string. + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*twidth +C move the i/o pointer + call ftmbyt(iunit,bstart,.false.,status) + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftgcnn.f b/pkg/tbtables/fitsio/ftgcnn.f new file mode 100644 index 00000000..d8348147 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcnn.f @@ -0,0 +1,140 @@ +C-------------------------------------------------------------------------- + subroutine ftgcnn(iunit,casesn,templt,colnam,colnum,status) + +C determine the column name and number corresponding to an input +C column name template string. The template may contain the * and ? +C wildcards. Status = 237 is returned if match is not unique. +C One may call this routine again with input status=237 to +C get the next match. + +C iunit i Fortran i/o unit number +C casesn l true if an exact case match of the names is required +C templt c templt for column name +C colnam c name of (first) column that matchs the template +C colnum i number of the column (first column = 1) +C (a value of 0 is returned if the column is not found) +C status i returned error status + +C written by Wm Pence, HEASARC/GSFC, December 1994 + + integer iunit,colnum,status + character*(*) templt,colnam + logical casesn + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + integer colpnt,untpnt + common/ftname/colpnt,untpnt +C END OF COMMON BLOCK DEFINITIONS------------------------------------ + + integer ibuff,i,nfound,tstat,ival + logical match,exact,founde,foundw,unique + character*80 errmsg + character*68 tname(999) + save tname + + ibuff=bufnum(iunit) + +C load the common block with names, if not already defined + if (colpnt .eq. -999 .or. iunit .ne. untpnt)then + do 10 i=1,tfield(ibuff) + tname(i)=' ' +10 continue + call ftgkns(iunit,'TTYPE',1,nf,tname,nfound,status) + if (status .gt. 0)return + untpnt=iunit + colpnt=1 + end if + + if (status .le. 0)then + tstat=0 + colpnt=1 + else if (status .eq. 237)then +C search for next non-unique match, starting from the previous match + tstat=237 + status=0 + else + return + end if + + colnam=' ' + colnum=0 + + +C set the 'found exact' and 'found wildcard' flags to false + founde=.false. + foundw=.false. + + do 100 i=colpnt,tfield(ibuff) +C test for match between template and column name + call ftcmps(templt,tname(i),casesn,match,exact) + + if (match)then + if (founde .and. exact)then +C warning: this is the second exact match we've found +C reset pointer to first match so next search starts there + colpnt=colnum+1 + status=237 + return + else if (founde)then +C already found exact match so ignore this non-exact match + else if (exact)then +C this is the first exact match we have found, so save it. + colnam=tname(i) + colnum=i + founde=.true. + else if (foundw)then +C we have already found a wild card match, so not unique +C continue searching for other matches + unique=.false. + else +C this is the first wild card match we've found. save it + colnam=tname(i) + colnum=i + foundw=.true. + unique=.true. + end if + end if +100 continue + +C OK, we've checked all the names now see if we got any matches + if (founde)then +C we did find 1 exact match + if (tstat .eq. 237)status=237 + else if (foundw)then +C we found one or more wildcard matches +C report error if not unique + if (.not. unique .or. tstat .eq. 237)status=237 + else +C didn't find a match; check if template is a simple positive integer + call ftc2ii(templt,ival,tstat) + if (tstat .eq. 0 .and. ival .le. tfield(ibuff) + & .and. ival .gt. 0)then + colnum=ival + colnam=tname(ival) + else + status=219 + if (tstat .ne. 237)then + errmsg='FTGCNN: Could not find column: '//templt + call ftpmsg(errmsg) + end if + end if + end if + +C reset pointer so next search starts here if input status=237 + colpnt=colnum+1 + end diff --git a/pkg/tbtables/fitsio/ftgcno.f b/pkg/tbtables/fitsio/ftgcno.f new file mode 100644 index 00000000..d5c9ca03 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcno.f @@ -0,0 +1,22 @@ +C-------------------------------------------------------------------------- + subroutine ftgcno(iunit,casesn,templt,colnum,status) + +C determine the column number corresponding to an input column name. +C This supports the * and ? wild cards in the input template. + +C iunit i Fortran i/o unit number +C casesn l true if an exact case match of the names is required +C templt c name of column as specified in a TTYPE keyword +C colnum i number of the column (first column = 1) +C (a value of 0 is returned if the column is not found) +C status i returned error status + +C modified by Wm Pence, HEASARC/GSFC, December 1994 + + integer iunit,colnum,status + character*(*) templt + logical casesn + character*8 dummy + + call ftgcnn(iunit,casesn,templt,dummy,colnum,status) + end diff --git a/pkg/tbtables/fitsio/ftgcrd.f b/pkg/tbtables/fitsio/ftgcrd.f new file mode 100644 index 00000000..7332a066 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcrd.f @@ -0,0 +1,76 @@ +C-------------------------------------------------------------------------- + subroutine ftgcrd(iunit,keynam,card,status) + +C Read the 80 character card image of a specified header keyword record + +C iunit i Fortran I/O unit number +C keynam c name of keyword to be read +C OUTPUT PARAMETERS: +C card c 80 character card image that was read +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + character*(*) keynam + integer iunit,status,i,j,ibuff,maxkey,start + character*(*) card + character kname*8 + character*80 keybuf + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + card=' ' + if (status .gt. 0)go to 100 + +C get the number of the data buffer used for this unit + ibuff=bufnum(iunit) + +C make sure keyword name is in uppercase + kname=keynam + call ftupch(kname) + +C Start by searching for keyword from current pointer position to the end. +C Calculate the maximum number of keywords to be searched: + start=nxthdr(ibuff) + maxkey=(hdend(ibuff)-start)/80 + + do 20 j=1,2 +C position I/O pointer to the next header keyword + if (maxkey .gt. 0)then + call ftmbyt(iunit,start,.false.,status) + end if + + do 10 i=1,maxkey + call ftgcbf(iunit,1,80,keybuf,status) + if (status .gt. 0)go to 100 + if (keybuf(1:8) .eq. kname)then +C setheader pointer to the following keyword + nxthdr(ibuff)=start+i*80 + card=keybuf + return + end if +10 continue + +C didn't find keyword yet, so now search from top down to starting pt. +C calculate max number of keywords to be searched and reset nxthdr + maxkey=(start-hdstrt(ibuff,chdu(ibuff)))/80 + start=hdstrt(ibuff,chdu(ibuff)) +20 continue + +C keyword was not found + status=202 + +C don't write to error stack because this innoculous error happens a lot +C call ftpmsg('Could not find the '//kname//' keyword to read.') + +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgcvb.f b/pkg/tbtables/fitsio/ftgcvb.f new file mode 100644 index 00000000..2376861a --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvb.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftgcvb(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of byte values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval b value that undefined pixels will be set to +C array b returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + + character*1 array(*),nulval + + call ftgclb(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcvc.f b/pkg/tbtables/fitsio/ftgcvc.f new file mode 100644 index 00000000..de0a3e97 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvc.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftgcvc(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of complex values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval cmp value that undefined pixels will be set to +C array cmp returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + real array(*),nulval(2) + + call ftgclc(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcvd.f b/pkg/tbtables/fitsio/ftgcvd.f new file mode 100644 index 00000000..0c90d404 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvd.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftgcvd(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of r*8 values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval d value that undefined pixels will be set to +C array d returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + double precision array(*),nulval + + call ftgcld(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + + end diff --git a/pkg/tbtables/fitsio/ftgcve.f b/pkg/tbtables/fitsio/ftgcve.f new file mode 100644 index 00000000..694cf8e0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcve.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftgcve(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of R*4 values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval r value that undefined pixels will be set to +C array r returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + real array(*),nulval + + call ftgcle(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcvi.f b/pkg/tbtables/fitsio/ftgcvi.f new file mode 100644 index 00000000..2e032552 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvi.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftgcvi(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of I*2 values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval i*2 value that undefined pixels will be set to +C array i*2 returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + integer*2 array(*),nulval + + call ftgcli(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcvj.f b/pkg/tbtables/fitsio/ftgcvj.f new file mode 100644 index 00000000..de6340cc --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvj.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftgcvj(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of I*4 values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval i value that undefined pixels will be set to +C array i returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + integer array(*),nulval + + call ftgclj(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcvm.f b/pkg/tbtables/fitsio/ftgcvm.f new file mode 100644 index 00000000..c719850d --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvm.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftgcvm(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of double precision complex values from a specified +C column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=0, in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element within the row to read +C nelem i number of elements to read +C nulval dcmp value that undefined pixels will be set to +C array dcmp returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + double precision array(*),nulval(2) + + call ftgclm(iunit,colnum,frow,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcvs.f b/pkg/tbtables/fitsio/ftgcvs.f new file mode 100644 index 00000000..dbd92809 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcvs.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftgcvs(iunit,colnum,frow,felem,nelem,nulval,array, + & anynul,status) + +C read an array of string values from a specified column of the table. +C Any undefined pixels will be set equal to the value of NULVAL, +C unless NULVAL=' ', in which case no checks for undefined pixels +C will be made. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C felem i first element in the row to read +C nelem i number of elements to read +C nulval c value that undefined pixels will be set to +C array c returned array of data values that was read from FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,colnum,frow,felem,nelem,status + logical flgval,anynul + character*(*) array(*),nulval + + call ftgcls(iunit,colnum,frow,felem,nelem,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgcx.f b/pkg/tbtables/fitsio/ftgcx.f new file mode 100644 index 00000000..b4d9c65f --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcx.f @@ -0,0 +1,140 @@ +C---------------------------------------------------------------------- + subroutine ftgcx(iunit,colnum,frow,fbit,nbit,lray,status) + +C read an array of logical values from a specified bit or byte +C column of the binary table. A logical .true. value is returned +C if the corresponding bit is 1, and a logical .false. value is +C returned if the bit is 0. +C The binary table column being read from must have datatype 'B' +C or 'X'. This routine ignores any undefined values in the 'B' array. + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C fbit i first bit within the row to read +C nbit i number of bits to read +C lray l returned array of logical data values that is read +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Mar 1992 + + integer iunit,colnum,frow,fbit,nbit,status + logical lray(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,offset,tcode,fbyte,bitloc,ndone + integer ibuff,i,ntodo,repeat,rstart,estart,buffer + logical descrp,log8(8) + character*1 cbuff + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + tcode=tdtype(colnum+tstart(ibuff)) + +C check input parameters + if (nbit .le. 0)then + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + return + else if (fbit .lt. 1)then +C illegal element number + status=308 + return + end if + + fbyte=(fbit+7)/8 + bitloc=fbit-(fbit-1)/8*8 + ndone=0 + ntodo=nbit + rstart=frow-1 + estart=fbyte-1 + + if (tcode .eq. 11)then + repeat=trept(colnum+tstart(ibuff)) + if (fbyte .gt. repeat)then +C illegal element number + status=308 + return + end if + descrp=.false. +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + else if (tcode .eq. -11)then +C this is a variable length descriptor column + descrp=.true. +C read the number of elements and the starting offset: + call ftgdes(iunit,colnum,frow,repeat, + & offset,status) + repeat=(repeat+7)/8 + if (repeat .eq. 0)then +C error: null length vector + status=318 + return + else if ((fbit+nbit+6)/8 .gt. repeat)then +C error: trying to read beyond end of record + status=319 + return + end if + bstart=dtstrt(ibuff)+offset+ + & theap(ibuff)+estart + else +C column must be byte or bit data type + status=312 + return + end if + +C move the i/o pointer to the start of the pixel sequence + call ftmbyt(iunit,bstart,.false.,status) + +C get the next byte +20 call ftgcbf(iunit,0,1,cbuff,status) + buffer=ichar(cbuff) + if (buffer .lt. 0)buffer=buffer+256 + +C decode the bits within the byte into an array of logical values + call ftgbit(buffer,log8) + + do 10 i=bitloc,8 + ndone=ndone+1 + lray(ndone)=log8(i) + if (ndone .eq. ntodo)go to 100 +10 continue + +C not done, so get the next byte + if (.not. descrp)then + estart=estart+1 + if (estart .eq. repeat)then +C move the i/o pointer to the next row of pixels + estart=0 + rstart=rstart+1 + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + call ftmbyt(iunit,bstart,.false.,status) + end if + end if + bitloc=1 + go to 20 + +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgcxd.f b/pkg/tbtables/fitsio/ftgcxd.f new file mode 100644 index 00000000..9befb70d --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcxd.f @@ -0,0 +1,78 @@ +C---------------------------------------------------------------------- + subroutine ftgcxd(iunit,colnum,frow,nrow,fbit,nbit, + & dvalue,status) + +C read any consecutive bits from an 'X' or 'B' column as an unsigned +C n-bit integer + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C nrow i number of rows to read +C fbit i first bit within the row to read +C nbit i number of bits to read +C dvalue d returned value(s) +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Nov 1994 + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer iunit,colnum,fbit,nbit,frow,nrow,status + integer i,k,istart,itodo,ntodo,row,ibuff + double precision dvalue(*),power,dval + logical lray(64) + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + if ((fbit+nbit+6)/8 .gt. trept(colnum+tstart(ibuff)))then + call ftpmsg('Asked to read more bits than exist in'// + & ' the column (ftgcxd)') + status=308 + return + end if + + row=frow-1 + do 30 k=1,nrow + row=row+1 + dval=0. + power=1.0D+00 + istart=fbit+nbit + ntodo=nbit + +10 itodo=min(ntodo,64) + istart=istart-itodo + +C read up to 64 bits at a time +C get the individual bits + call ftgcx(iunit,colnum,row,istart,itodo,lray,status) + if (status .gt. 0)return + +C reconstruct the positive integer value + do 20 i=itodo,1,-1 + if (lray(i))dval=dval+power + power=power*2.0D+00 +20 continue + + ntodo=ntodo-itodo + if (itodo .gt. 0)go to 10 + dvalue(k)=dval +30 continue + end diff --git a/pkg/tbtables/fitsio/ftgcxi.f b/pkg/tbtables/fitsio/ftgcxi.f new file mode 100644 index 00000000..d545a372 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcxi.f @@ -0,0 +1,86 @@ +C---------------------------------------------------------------------- + subroutine ftgcxi(iunit,colnum,frow,nrow,fbit,nbit, + & ivalue,status) + +C read any consecutive bits from an 'X' or 'B' column as an unsigned +C n-bit integer, unless nbits=16 in which case the 16 bits +C are interpreted as a 16-bit signed 2s complement word + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C nrow i number of rows to read +C fbit i first bit within the row to read +C nbit i number of bits to read +C ivalue i*2 returned integer value(s) +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Nov 1994 + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer iunit,colnum,fbit,nbit,frow,nrow,status,i,j,k,row,ibuff + integer*2 ivalue(*),ival,power2(16) + logical lray(16) + save power2 + data power2/1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192, + & 16384,0/ + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + + if (nbit .gt. 16)then + call ftpmsg('Cannot read more than 16 bits (ftgcxi)') + status=308 + return + else if ((fbit+nbit+6)/8 .gt. trept(colnum+tstart(ibuff)))then + call ftpmsg('Asked to read more bits than exist in'// + & ' the column (ftgcxi)') + status=308 + return + end if + + + row=frow-1 + do 30 k=1,nrow + row=row+1 +C get the individual bits + call ftgcx(iunit,colnum,row,fbit,nbit,lray,status) + if (status .gt. 0)return + ival=0 + j=0 + if (nbit .eq. 16 .and. lray(1))then +C interprete this as a 16 bit negative integer + do 10 i=16,2,-1 + j=j+1 + if (.not. lray(i))ival=ival+power2(j) +10 continue +C make 2's complement + ivalue(k)=-ival-1 + else +C reconstruct the positive integer value + do 20 i=nbit,1,-1 + j=j+1 + if (lray(i))ival=ival+power2(j) +20 continue + ivalue(k)=ival + end if +30 continue + end diff --git a/pkg/tbtables/fitsio/ftgcxj.f b/pkg/tbtables/fitsio/ftgcxj.f new file mode 100644 index 00000000..6e2c7ad8 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgcxj.f @@ -0,0 +1,88 @@ +C---------------------------------------------------------------------- + subroutine ftgcxj(iunit,colnum,frow,nrow,fbit,nbit, + & jvalue,status) + +C read any consecutive bits from an 'X' or 'B' column as an unsigned +C n-bit integer, unless nbits=32 in which case the 32 bits +C are interpreted as a 32-bit signed 2s complement word + +C iunit i fortran unit number +C colnum i number of the column to read +C frow i first row to read +C nrow i number of rows to read +C fbit i first bit within the row to read +C nbit i number of bits to read +C jvalue i returned integer value(s) +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Nov 1994 + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer iunit,colnum,fbit,nbit,frow,nrow,status,i,j,k,row,jval + integer jvalue(*),power2(32),ibuff + logical lray(32) + save power2 + data power2/1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192, + & 16384,32768,65536,131072,262144,524288,1048576,2097152,4194304, + & 8388608,16777216,33554432,67108864,134217728,268435456,536870912 + & ,1073741824,0/ + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + + if (nbit .gt. 32)then + call ftpmsg('Cannot read more than 32 bits (ftgcxj)') + status=308 + return + else if ((fbit+nbit+6)/8 .gt. trept(colnum+tstart(ibuff)))then + call ftpmsg('Asked to read more bits than exist in'// + & ' the column (ftgcxj)') + status=308 + return + end if + + row=frow-1 + do 30 k=1,nrow + row=row+1 +C get the individual bits + call ftgcx(iunit,colnum,row,fbit,nbit,lray,status) + if (status .gt. 0)return + + jval=0 + j=0 + if (nbit .eq. 32 .and. lray(1))then +C interprete this as a 32 bit negative integer + do 10 i=32,2,-1 + j=j+1 + if (.not. lray(i))jval=jval+power2(j) +10 continue +C make 2's complement + jvalue(k)=-jval-1 + else +C reconstruct the positive integer value + do 20 i=nbit,1,-1 + j=j+1 + if (lray(i))jval=jval+power2(j) +20 continue + jvalue(k)=jval + end if +30 continue + end diff --git a/pkg/tbtables/fitsio/ftgdes.f b/pkg/tbtables/fitsio/ftgdes.f new file mode 100644 index 00000000..6cf28f12 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgdes.f @@ -0,0 +1,63 @@ +C---------------------------------------------------------------------- + subroutine ftgdes(iunit,colnum,rownum,nelem,offset,status) + +C read the descriptor values from a binary table. This is only +C used for column which have TFORMn = 'P', i.e., for variable +C length arrays. + +C iunit i fortran unit number +C colnum i number of the column to read +C rownum i number of the row to read +C nelem i output number of elements +C offset i output byte offset of the first element +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Nov 1991 + + integer iunit,colnum,rownum,nelem,offset,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bstart,iray(2) + + if (status .gt. 0)return + if (rownum .lt. 1)then +C error: illegal row number + status=307 + return + end if + + ibuff=bufnum(iunit) + +C check that this is really a 'P' type column + if (tdtype(colnum+tstart(ibuff)) .ge. 0)then + status=317 + return + end if + +C move to the specified column and row: + bstart=dtstrt(ibuff)+(rownum-1)*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff)) + call ftmbyt(iunit,bstart,.true.,status) + +C now read the number of elements and the offset to the table: + call ftgi4b(iunit,2,0,iray,status) + nelem=iray(1) + offset=iray(2) + end diff --git a/pkg/tbtables/fitsio/ftgerr.f b/pkg/tbtables/fitsio/ftgerr.f new file mode 100644 index 00000000..2e15a772 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgerr.f @@ -0,0 +1,173 @@ +C------------------------------------------------------------------------------ + subroutine ftgerr(errnum,text) + +C Return a descriptive error message corresponding to the error number + +C errnum i input symbolic error code presumably returned by another +C FITSIO subroutine +C text C*30 Descriptive error message + + integer errnum + character*(*) text + +C nerror specifies the maxinum number of different error messages + integer nerror + parameter (nerror=100) + character*30 errors(nerror) + character*30 er1(10),er2(10),er3(10),er4(10),er5(10),er6(10) + character*30 er7(10),er8(10),er9(10),er10(10) + integer i,errcod(nerror) + save errors + +C we equivalence the big array to several smaller ones, so that +C the DATA statements will not have too many continuation lines. + equivalence (errors(1), er1(1)) + equivalence (errors(11),er2(1)) + equivalence (errors(21),er3(1)) + equivalence (errors(31),er4(1)) + equivalence (errors(41),er5(1)) + equivalence (errors(51),er6(1)) + equivalence (errors(61),er7(1)) + equivalence (errors(71),er8(1)) + equivalence (errors(81),er9(1)) + equivalence (errors(91),er10(1)) + + data errcod/0,101,102,103,104,105,106,107,108,109,110,111, + & 201,202,203,204,205,206,207,208,209,211,212,213,214,215,216, + & 217,218,221,222,223,224,225,226,227,228,229,230,231,232, + & 241,251,252,261,262, + & 302,303,304,305,306,307,308,309,310,311,312,313,314,315,316, + & 317,318,319, 401,402,403,404,405,406,407,408,409,411,112, + & 210,233,220,219,301,320,321,322,263,323,113,114,234,253,254, + & 255,412,235,236,501,502,503,504,505,237/ + + data er1/ + & 'OK, no error', + & 'Bad logical unit number', + & 'Too many FITS files opened', + & 'File not found; not opened', + & 'Error opening existing file', + & 'Error creating new FITS file', + & 'Error writing to FITS file', + & 'EOF while reading FITS file', + & 'Error reading FITS file', + & 'Bad blocking factor (1-28800)'/ + + data er2/ + & 'Error closing FITS file', + & 'Too many columns in table', + & 'No room in header for keyword', + & 'Specified keyword not found', + & 'Bad keyword record number', + & 'Keyword value field is blank', + & 'Missing quote in string value', + & 'Could not construct NAMEnnn', + & 'Bad character in header record', + & 'Keywords out of order?'/ + + data er3/ + & 'Bad nnn value in NAMEnnn', + & 'Illegal BITPIX keyword value', + & 'Illegal NAXIS keyword value', + & 'Illegal NAXISnnn keyword value', + & 'Illegal PCOUNT keyword value', + & 'Illegal GCOUNT keyword value', + & 'Illegal TFIELDS keyword value', + & 'Illegal NAXIS1 keyword value', + & 'Illegal NAXIS2 keyword value', + & 'SIMPLE keyword not found'/ + + data er4/ + & 'BITPIX keyword not found', + & 'NAXIS keyword not found', + & 'NAXISnnn keyword(s) not found', + & 'XTENSION keyword not found', + & 'CHDU is not an ASCII table', + & 'CHDU is not a binary table', + & 'PCOUNT keyword not found', + & 'GCOUNT keyword not found', + & 'TFIELDS keyword not found', + & 'TBCOLnnn keywords not found'/ + + data er5/ + & 'TFORMnnn keywords not found', + & 'Row width not = field widths', + & 'Unknown extension type', + & 'Unknown FITS record type', + & 'Cannot parse TFORM keyword', + & 'Unknown TFORM datatype code', + & 'Column number out of range', + & 'Data structure not defined', + & 'Negative file record number', + & 'HDU start location is unknown'/ + + data er6/ + & 'Requested no. of bytes < 0', + & 'Illegal first row number', + & 'Illegal first element number', + & 'Bad TFORM for Character I/O', + & 'Bad TFORM for Logical I/O', + & 'Invalid ASCII table TFORM code', + & 'Invalid BINTABLE TFORM code', + & 'Error making formated string', + & 'Null value is undefined', + & 'Internal read error of string'/ + + data er7/ + & 'Illegal logical column value', + & 'Bad TFORM for descriptor I/O', + & 'Variable array has 0 length', + & 'End-of-rec in var. len. array', + & 'Int to Char conversion error', + & 'Real to Char conversion error', + & 'Illegal Char to Int conversion', + & 'Illegal Logical keyword value', + & 'Illegal Char to R*4 conversion', + & 'Illegal Char to R*8 conversion'/ + + data er8/ + & 'Char to Int conversion error', + & 'Char to Real conversion error', + & 'Char to R*8 conversion error', + & 'Illegal no. of decimal places', + & 'Cannot modify a READONLY file', + & 'END header keyword not found', + & 'CHDU is not an IMAGE extension', + & 'Illegal SIMPLE keyword value', + & 'Column name (TTYPE) not found', + & 'Out of bounds HDU number'/ + + data er9/ + & 'Bad no. of array dimensions', + & 'Max pixel less than min pixel', + & 'Illegal BSCALE or TSCALn = 0', + & 'Could not parse TDIMn keyword', + & 'Axis length less than 1', + & 'Incompatible FITSIO version', + & 'All LUNs have been allocated', + & 'TBCOLn value out of range', + & 'END keyword value not blank ', + & 'Header fill area not blank'/ + + data er10/ + & 'Data fill area invalid', + & 'Data type conversion overflow', + & 'CHDU must be a table/bintable', + & 'Column is too wide for table', + & 'celestial angle too large', + & 'bad celestial coordinate', + & 'error in celestial coord calc', + & 'unsupported projection', + & 'missing celestial coord keywrd', + & 'column name not unique'/ + +C find the matching error code number + do 10 i=1,nerror + if (errnum .eq. errcod(i))then + text=errors(i) + return + end if +10 continue + + text='Unknown FITSIO status code' + end diff --git a/pkg/tbtables/fitsio/ftgext.f b/pkg/tbtables/fitsio/ftgext.f new file mode 100644 index 00000000..66094d2f --- /dev/null +++ b/pkg/tbtables/fitsio/ftgext.f @@ -0,0 +1,62 @@ +C---------------------------------------------------------------------- + subroutine ftgext(iunit,extno,xtend,status) + +C 'Get Extension' +C move i/o pointer to another extension (or the primary HDU) and +C initialize all the common block parameters which describe the +C extension + +C iunit i fortran unit number +C extno i number of the extension to point to. +C xtend i type of extension: 0 = the primary HDU +C 1 = an ASCII table +C 2 = a binary table +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + integer iunit,extno,xtend,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,xchdu,xhdend,xmaxhd + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C move to the beginning of the desired extension + call ftmbyt(iunit,hdstrt(ibuff,extno),.false.,status) + if (status .le. 0)then + +C temporarily save parameters + xchdu=chdu(ibuff) + xmaxhd=maxhdu(ibuff) + xhdend=hdend(ibuff) + +C initialize various parameters about the CHDU + chdu(ibuff)=extno + maxhdu(ibuff)=max(extno,maxhdu(ibuff)) +C the location of the END record is currently unknown, so +C temporarily just set it to a very large number + hdend(ibuff)=2000000000 + +C determine the structure of the CHDU + call ftrhdu(iunit,xtend,status) + if (status .gt. 0)then +C couldn't read the extension so restore previous state + chdu(ibuff)= xchdu + maxhdu(ibuff)=xmaxhd + hdend(ibuff)= xhdend + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftggpb.f b/pkg/tbtables/fitsio/ftggpb.f new file mode 100644 index 00000000..a3fc10b1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftggpb.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftggpb(iunit,group,fparm,nparm,array,status) + +C Read an array of group parameter values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran unit number +C group i number of the data group, if any +C fparm i the first group parameter be read (starting with 1) +C nparm i number of group parameters to be read +C array b returned array of values that were read +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,fparm,nparm,status,row + character*1 nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself +C set nulval to blank to inhibit checking for undefined values + nulval=' ' + row=max(1,group) + call ftgclb(iunit,1,row,fparm,nparm,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftggpd.f b/pkg/tbtables/fitsio/ftggpd.f new file mode 100644 index 00000000..6857de98 --- /dev/null +++ b/pkg/tbtables/fitsio/ftggpd.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftggpd(iunit,group,fparm,nparm,array,status) + +C Read an array of group parameter values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran unit number +C group i number of the data group, if any +C fparm i the first group parameter be read (starting with 1) +C nparm i number of group parameters to be read +C array d returned array of values that were read +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,fparm,nparm,status,row + double precision nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself +C set nulval to blank to inhibit checking for undefined values + nulval=0 + row=max(1,group) + call ftgcld(iunit,1,row,fparm,nparm,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftggpe.f b/pkg/tbtables/fitsio/ftggpe.f new file mode 100644 index 00000000..db0e0656 --- /dev/null +++ b/pkg/tbtables/fitsio/ftggpe.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftggpe(iunit,group,fparm,nparm,array,status) + +C Read an array of group parameter values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran unit number +C group i number of the data group, if any +C fparm i the first group parameter be read (starting with 1) +C nparm i number of group parameters to be read +C array r returned array of values that were read +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,fparm,nparm,status,row + real nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself +C set nulval to blank to inhibit checking for undefined values + nulval=0 + row=max(1,group) + call ftgcle(iunit,1,row,fparm,nparm,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftggpi.f b/pkg/tbtables/fitsio/ftggpi.f new file mode 100644 index 00000000..7035b6d9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftggpi.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftggpi(iunit,group,fparm,nparm,array,status) + +C Read an array of group parameter values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran unit number +C group i number of the data group, if any +C fparm i the first group parameter be read (starting with 1) +C nparm i number of group parameters to be read +C array i*2 returned array of values that were read +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,fparm,nparm,status,row + integer*2 nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself +C set nulval to blank to inhibit checking for undefined values + nulval=0 + row=max(1,group) + call ftgcli(iunit,1,row,fparm,nparm,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftggpj.f b/pkg/tbtables/fitsio/ftggpj.f new file mode 100644 index 00000000..ce00a051 --- /dev/null +++ b/pkg/tbtables/fitsio/ftggpj.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftggpj(iunit,group,fparm,nparm,array,status) + +C Read an array of group parameter values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran unit number +C group i number of the data group, if any +C fparm i the first group parameter be read (starting with 1) +C nparm i number of group parameters to be read +C array i returned array of values that were read +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,fparm,nparm,status,row + integer nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself +C set nulval to blank to inhibit checking for undefined values + nulval=0 + row=max(1,group) + call ftgclj(iunit,1,row,fparm,nparm,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftghad.f b/pkg/tbtables/fitsio/ftghad.f new file mode 100644 index 00000000..5c64d01a --- /dev/null +++ b/pkg/tbtables/fitsio/ftghad.f @@ -0,0 +1,30 @@ +C---------------------------------------------------------------------- + subroutine ftghad(iunit,curhdu,nxthdu) + +C return the starting byte address of the CHDU and the next HDU. + +C curhdu i starting address of the CHDU +C nxthdu i starting address of the next HDU + +C written by Wm Pence, HEASARC/GSFC, May, 1995 + + integer iunit,curhdu,nxthdu + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,hdunum + + ibuff=bufnum(iunit) + hdunum=chdu(ibuff) + curhdu=hdstrt(ibuff,hdunum) + nxthdu=hdstrt(ibuff,hdunum+1) + end diff --git a/pkg/tbtables/fitsio/ftghbn.f b/pkg/tbtables/fitsio/ftghbn.f new file mode 100644 index 00000000..782a51f4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftghbn.f @@ -0,0 +1,59 @@ +C---------------------------------------------------------------------- + subroutine ftghbn(iunit,maxfld,nrows,nfield,ttype,tform, + & tunit,extnam,pcount,status) + +C read required standard header keywords from a binary table extension +C +C iunit i Fortran i/o unit number +C maxfld i maximum no. of fields to read; size of ttype array +C OUTPUT PARAMETERS: +C nrows i number of rows in the table +C nfield i number of fields in the table +C ttype c name of each field (array) +C tform c format of each field (array) +C tunit c units of each field (array) +C extnam c name of table (optional) +C pcount i size of special data area following the table (usually = 0) +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,maxfld,ncols,nrows,nfield,pcount,status,tstat + integer maxf,i,nfind + character*(*) ttype(*),tform(*),tunit(*),extnam + character comm*72 + +C check that this is a valid binary table and get parameters + call ftgtbn(iunit,ncols,nrows,pcount,nfield,status) + if (status .gt. 0)return + + if (maxfld .lt. 0)then + maxf=nfield + else if (maxfld .eq. 0)then + go to 20 + else + maxf=min(maxfld,nfield) + end if +C initialize optional keywords + do 10 i=1,maxf + ttype(i)=' ' + tunit(i)=' ' +10 continue + + call ftgkns(iunit,'TTYPE',1,maxf,ttype,nfind,status) + call ftgkns(iunit,'TUNIT',1,maxf,tunit,nfind,status) + + if (status .gt. 0)return + + call ftgkns(iunit,'TFORM',1,maxf,tform,nfind,status) + if (status .gt. 0 .or. nfind .ne. maxf)then + status=232 + return + end if + +20 extnam=' ' + tstat=status + call ftgkys(iunit,'EXTNAME',extnam,comm,status) +C this keyword is not required, so ignore status + if (status .eq. 202)status =tstat + end diff --git a/pkg/tbtables/fitsio/ftghdn.f b/pkg/tbtables/fitsio/ftghdn.f new file mode 100644 index 00000000..a93a4588 --- /dev/null +++ b/pkg/tbtables/fitsio/ftghdn.f @@ -0,0 +1,26 @@ +C---------------------------------------------------------------------- + subroutine ftghdn(iunit,hdunum) + +C return the number of the current header data unit. The +C first HDU (the primary array) is number 1. + +C iunit i fortran unit number +C hdunum i returned number of the current HDU +C +C written by Wm Pence, HEASARC/GSFC, March, 1993 + + integer iunit,hdunum + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + hdunum=chdu(bufnum(iunit)) + end diff --git a/pkg/tbtables/fitsio/ftghpr.f b/pkg/tbtables/fitsio/ftghpr.f new file mode 100644 index 00000000..e0360a19 --- /dev/null +++ b/pkg/tbtables/fitsio/ftghpr.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftghpr(iunit,maxdim,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,status) + +C get the required primary header or image extension keywords +C +C iunit i fortran unit number to use for reading +C maxdim i maximum no. of dimensions to read; dimension of naxes +C OUTPUT PARAMETERS: +C simple l does file conform to FITS standard? +C bitpix i number of bits per data value +C naxis i number of axes in the data array +C naxes i array giving the length of each data axis +C pcount i number of group parameters (usually 0) +C gcount i number of random groups (usually 1 or 0) +C extend l may extensions be present in the FITS file? +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,bitpix,naxis,naxes(*),pcount,gcount,blank,status + integer maxdim,nblank + logical simple,extend + double precision fill + + call ftgphx(iunit,maxdim,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,fill,fill,blank,nblank,status) + end diff --git a/pkg/tbtables/fitsio/ftghps.f b/pkg/tbtables/fitsio/ftghps.f new file mode 100644 index 00000000..6d92a1e2 --- /dev/null +++ b/pkg/tbtables/fitsio/ftghps.f @@ -0,0 +1,35 @@ +C-------------------------------------------------------------------------- + subroutine ftghps(iunit,nkeys,pos,status) + +C Get Header Position +C get the number of keywords in the header and the current position +C in the header, i.e., the number of the next keyword record that +C would be read. +C +C iunit i Fortran I/O unit number +C pos i current position in header (1 = beginning of header) +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Jan 1995 + + integer iunit,nkeys,pos,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + nkeys=(hdend(ibuff)-hdstrt(ibuff,chdu(ibuff)))/80 + pos=(nxthdr(ibuff)-hdstrt(ibuff,chdu(ibuff)))/80+1 + end diff --git a/pkg/tbtables/fitsio/ftghsp.f b/pkg/tbtables/fitsio/ftghsp.f new file mode 100644 index 00000000..0b9161fd --- /dev/null +++ b/pkg/tbtables/fitsio/ftghsp.f @@ -0,0 +1,40 @@ +C-------------------------------------------------------------------------- + subroutine ftghsp(ounit,nexist,nmore,status) + +C Get Header SPace +C return the number of additional keywords that will fit in the header +C +C ounit i Fortran I/O unit number +C nexist i number of keywords already present in the CHU +C nmore i number of additional keywords that will fit in header +C -1 indicates that there is no limit to the number of keywords +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,nexist,nmore,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + if (status .gt. 0)return + ibuff=bufnum(ounit) + + nexist=(hdend(ibuff)-hdstrt(ibuff,chdu(ibuff)))/80 + if (dtstrt(ibuff) .lt. 0)then +C the max size of the header has not been defined, so there +C is no limit to the number of keywords which may be written. + nmore=-1 + else + nmore=(dtstrt(ibuff)-hdend(ibuff))/80-1 + end if + end diff --git a/pkg/tbtables/fitsio/ftghtb.f b/pkg/tbtables/fitsio/ftghtb.f new file mode 100644 index 00000000..7f3aea90 --- /dev/null +++ b/pkg/tbtables/fitsio/ftghtb.f @@ -0,0 +1,70 @@ +C---------------------------------------------------------------------- + subroutine ftghtb(iunit,maxfld,ncols,nrows,nfield,ttype, + & tbcol,tform,tunit,extnam,status) + +C read required standard header keywords from an ASCII table extension +C +C iunit i Fortran i/o unit number +C maxfld i maximum no. of fields to read; dimension of ttype +C OUTPUT PARAMETERS: +C ncols i number of columns in the table +C nrows i number of rows in the table +C nfield i number of fields in the table +C ttype c name of each field (array) +C tbcol i beginning column of each field (array) +C tform c Fortran-77 format of each field (array) +C tunit c units of each field (array) +C extnam c name of table (optional) +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,maxfld,ncols,nrows,nfield,status,tbcol(*) + integer i,nfind,maxf,tstat + character*(*) ttype(*),tform(*),tunit(*),extnam + character comm*72 + + call ftgttb(iunit,ncols,nrows,nfield,status) + if (status .gt. 0)return + + if (maxfld .le. 0)then + maxf=nfield + else + maxf=min(maxfld,nfield) + end if + +C initialize optional keywords + do 10 i=1,maxf + ttype(i)=' ' + tunit(i)=' ' +10 continue + + call ftgkns(iunit,'TTYPE',1,maxf,ttype,nfind,status) + call ftgkns(iunit,'TUNIT',1,maxf,tunit,nfind,status) + + if (status .gt. 0)return + + call ftgknj(iunit,'TBCOL',1,maxf,tbcol,nfind,status) + if (status .gt. 0 .or. nfind .ne. maxf)then +C couldn't find the required TBCOL keywords + status=231 + call ftpmsg('Required TBCOL keyword(s) not found in ASCII'// + & ' table header (FTGHTB).') + return + end if + + call ftgkns(iunit,'TFORM',1,maxf,tform,nfind,status) + if (status .gt. 0 .or. nfind .ne. maxf)then +C couldn't find the required TFORM keywords + status=232 + call ftpmsg('Required TFORM keyword(s) not found in ASCII'// + & ' table header (FTGHTB).') + return + end if + + extnam=' ' + tstat=status + call ftgkys(iunit,'EXTNAME',extnam,comm,status) +C this keyword is not required, so ignore 'keyword not found' status + if (status .eq. 202)status=tstat + end diff --git a/pkg/tbtables/fitsio/ftgi1b.f b/pkg/tbtables/fitsio/ftgi1b.f new file mode 100644 index 00000000..c0d1e587 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgi1b.f @@ -0,0 +1,26 @@ +C---------------------------------------------------------------------- + subroutine ftgi1b(ounit,nvals,incre,chbuff,status) + +C Read an array of Integer*1 bytes from the input FITS file. + + integer nvals,incre,ounit,status,i,offset + character*1 chbuff(nvals) + +C ounit i fortran unit number +C nvals i number of pixels in the i2vals array +C incre i byte increment between values +C chbuff c*1 array of input byte values +C status i output error status + + if (incre .le. 1)then + call ftgcbf(ounit,0,nvals,chbuff,status) + else +C offset is the number of bytes to move between each value + offset=incre-1 + call ftgcbf(ounit,0,1,chbuff,status) + do 10 i=2,nvals + call ftmoff(ounit,offset,.false.,status) + call ftgcbf(ounit,0,1,chbuff(i),status) +10 continue + end if + end diff --git a/pkg/tbtables/fitsio/ftgics.f b/pkg/tbtables/fitsio/ftgics.f new file mode 100644 index 00000000..fc41266e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgics.f @@ -0,0 +1,47 @@ +C------------------------------------------------------------------------------ + subroutine ftgics(iunit,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + & type,status) + +C read the values of the celestial coordinate system keywords. +C These values may be used as input to the subroutines that +C calculate celestial coordinates. (FTXYPX, FTWLDP) + +C This routine assumes that the CHDU contains an image +C with the RA type coordinate running along the first axis +C and the DEC type coordinate running along the 2nd axis. + + double precision xrval,yrval,xrpix,yrpix,xinc,yinc,rot + integer iunit,status,tstat + character*(*) type + character comm*20,ctype*8 + + if (status .gt. 0)return + + call ftgkyd(iunit,'CRVAL1',xrval,comm,status) + call ftgkyd(iunit,'CRVAL2',yrval,comm,status) + + call ftgkyd(iunit,'CRPIX1',xrpix,comm,status) + call ftgkyd(iunit,'CRPIX2',yrpix,comm,status) + + call ftgkyd(iunit,'CDELT1',xinc,comm,status) + call ftgkyd(iunit,'CDELT2',yinc,comm,status) + + call ftgkys(iunit,'CTYPE1',ctype,comm,status) + + if (status .gt. 0)then + call ftpmsg('FTGICS could not find all the required'// + & 'celestial coordinate Keywords.') + status=505 + return + end if + + type=ctype(5:8) + + tstat=status + call ftgkyd(iunit,'CROTA2',rot,comm,status) + if (status .gt. 0)then +C CROTA2 is assumed to = 0 if keyword is not present + status=tstat + rot=0. + end if + end diff --git a/pkg/tbtables/fitsio/ftgiou.f b/pkg/tbtables/fitsio/ftgiou.f new file mode 100644 index 00000000..adf3881d --- /dev/null +++ b/pkg/tbtables/fitsio/ftgiou.f @@ -0,0 +1,11 @@ +C------------------------------------------------------------------------------ + subroutine ftgiou(iounit,status) + +C get an unallocated logical unit number + + integer iounit,status + + if (status .gt. 0)return + iounit=0 + call ftxiou(iounit,status) + end diff --git a/pkg/tbtables/fitsio/ftgkey.f b/pkg/tbtables/fitsio/ftgkey.f new file mode 100644 index 00000000..c473f8e2 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkey.f @@ -0,0 +1,24 @@ +C-------------------------------------------------------------------------- + subroutine ftgkey(iunit,keynam,value,comm,status) + +C Read value and comment of a header keyword from the keyword buffer + +C iunit i Fortran I/O unit number +C keynam c name of keyword to be read +C OUTPUT PARAMETERS: +C value c output value of the keyword, if any +C comm c output comment string, if any, of the keyword +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + integer iunit,status + character*(*) keynam,value,comm + character*80 keybuf + + call ftgcrd(iunit,keynam,keybuf,status) + if (status .le. 0)then +C parse the record to find value and comment strings + call ftpsvc(keybuf,value,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftgknd.f b/pkg/tbtables/fitsio/ftgknd.f new file mode 100644 index 00000000..682d1f36 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgknd.f @@ -0,0 +1,79 @@ +C-------------------------------------------------------------------------- + subroutine ftgknd(iunit,keywrd,nstart,nmax, + & dval,nfound,status) + +C read an array of real*8 values from header records +C +C iunit i fortran input unit number +C keywrd c keyword name +C nstart i starting sequence number (usually 1) +C nmax i number of keywords to read +C OUTPUT PARAMETERS: +C dval d array of output keyword values +C nfound i number of keywords found +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd + double precision dval(*) + integer iunit,nstart,nmax,nfound,status,tstat + integer nkeys,mkeys,i,ival,nend,namlen,indval + character inname*8,keynam*8 + character*80 rec,value,comm + + if (status .gt. 0)return + +C for efficiency, we want to search just once through the header +C for all the keywords which match the root. + + nfound=0 + nend=nstart+nmax-1 + inname=keywrd + call ftupch(inname) + +C find the length of the root name + namlen=0 + do 5 i=8,1,-1 + if (inname(i:i) .ne. ' ')then + namlen=i + go to 6 + end if +5 continue +6 if (namlen .eq. 0)return + +C get the number of keywords in the header + call ftghsp(iunit,nkeys,mkeys,status) + + do 10 i=3,nkeys + call ftgrec(iunit,i,rec,status) + if (status .gt. 0)return + keynam=rec(1:8) + if (keynam(1:namlen) .eq. inname(1:namlen))then + +C try to interpret the remainder of the name as an integer + tstat=status + call ftc2ii(keynam(namlen+1:8),ival,status) + if (status .le. 0)then + if (ival .le. nend .and. ival .ge. nstart)then + call ftpsvc(rec,value,comm,status) + indval=ival-nstart+1 + call ftc2dd(value,dval(indval),status) + if (status .gt. 0)then + call ftpmsg('Error in FTGKND evaluating '//keynam// + & ' as a Double: '//value) + return + else + nfound=max(nfound,indval) + end if + end if + else + if (status .eq. 407)then + status=tstat + else + return + end if + end if + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftgkne.f b/pkg/tbtables/fitsio/ftgkne.f new file mode 100644 index 00000000..3ec392a8 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkne.f @@ -0,0 +1,79 @@ +C-------------------------------------------------------------------------- + subroutine ftgkne(iunit,keywrd,nstart,nmax, + & rval,nfound,status) + +C read an array of real*4 values from header records +C +C iunit i fortran input unit number +C keywrd c keyword name +C nstart i starting sequence number (usually 1) +C nmax i number of keywords to read +C OUTPUT PARAMETERS: +C rval r array of output keyword values +C nfound i number of keywords found +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd + real rval(*) + integer iunit,nstart,nmax,nfound,status,tstat + integer nkeys,mkeys,i,ival,nend,namlen,indval + character inname*8,keynam*8 + character*80 rec,value,comm + + if (status .gt. 0)return + +C for efficiency, we want to search just once through the header +C for all the keywords which match the root. + + nfound=0 + nend=nstart+nmax-1 + inname=keywrd + call ftupch(inname) + +C find the length of the root name + namlen=0 + do 5 i=8,1,-1 + if (inname(i:i) .ne. ' ')then + namlen=i + go to 6 + end if +5 continue +6 if (namlen .eq. 0)return + +C get the number of keywords in the header + call ftghsp(iunit,nkeys,mkeys,status) + + do 10 i=3,nkeys + call ftgrec(iunit,i,rec,status) + if (status .gt. 0)return + keynam=rec(1:8) + if (keynam(1:namlen) .eq. inname(1:namlen))then + +C try to interpret the remainder of the name as an integer + tstat=status + call ftc2ii(keynam(namlen+1:8),ival,status) + if (status .le. 0)then + if (ival .le. nend .and. ival .ge. nstart)then + call ftpsvc(rec,value,comm,status) + indval=ival-nstart+1 + call ftc2rr(value,rval(indval),status) + if (status .gt. 0)then + call ftpmsg('Error in FTGKNE evaluating '//keynam// + & ' as a Real: '//value) + return + else + nfound=max(nfound,indval) + end if + end if + else + if (status .eq. 407)then + status=tstat + else + return + end if + end if + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftgknj.f b/pkg/tbtables/fitsio/ftgknj.f new file mode 100644 index 00000000..390b4216 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgknj.f @@ -0,0 +1,79 @@ +C-------------------------------------------------------------------------- + subroutine ftgknj(iunit,keywrd,nstart,nmax,intval, + & nfound,status) + +C read an array of integer values from header records +C +C iunit i fortran input unit number +C keywrd c keyword name +C nstart i starting sequence number (usually 1) +C nmax i number of keywords to read +C OUTPUT PARAMETERS: +C intval i array of output keyword values +C nfound i number of keywords found +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd + integer intval(*) + integer iunit,nstart,nmax,nfound,status,tstat + integer nkeys,mkeys,i,ival,nend,namlen,indval + character inname*8,keynam*8 + character*80 rec,value,comm + + if (status .gt. 0)return + +C for efficiency, we want to search just once through the header +C for all the keywords which match the root. + + nfound=0 + nend=nstart+nmax-1 + inname=keywrd + call ftupch(inname) + +C find the length of the root name + namlen=0 + do 5 i=8,1,-1 + if (inname(i:i) .ne. ' ')then + namlen=i + go to 6 + end if +5 continue +6 if (namlen .eq. 0)return + +C get the number of keywords in the header + call ftghsp(iunit,nkeys,mkeys,status) + + do 10 i=3,nkeys + call ftgrec(iunit,i,rec,status) + if (status .gt. 0)return + keynam=rec(1:8) + if (keynam(1:namlen) .eq. inname(1:namlen))then + +C try to interpret the remainder of the name as an integer + tstat=status + call ftc2ii(keynam(namlen+1:8),ival,status) + if (status .le. 0)then + if (ival .le. nend .and. ival .ge. nstart)then + call ftpsvc(rec,value,comm,status) + indval=ival-nstart+1 + call ftc2ii(value,intval(indval),status) + if (status .gt. 0)then + call ftpmsg('Error in FTGKNJ evaluating '//keynam// + & ' as an integer: '//value) + return + else + nfound=max(nfound,indval) + end if + end if + else + if (status .eq. 407)then + status=tstat + else + return + end if + end if + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftgknl.f b/pkg/tbtables/fitsio/ftgknl.f new file mode 100644 index 00000000..5c21077d --- /dev/null +++ b/pkg/tbtables/fitsio/ftgknl.f @@ -0,0 +1,73 @@ +C-------------------------------------------------------------------------- + subroutine ftgknl(iunit,keywrd,nstart,nmax,logval, + & nfound,status) + +C read an array of logical values from header records +C +C iunit i fortran input unit number +C keywrd c keyword name +C nstart i starting sequence number (usually 1) +C nmax i number of keywords to read +C OUTPUT PARAMETERS: +C logval l array of output keyword values +C nfound i number of keywords found +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd + logical logval(*) + integer iunit,nstart,nmax,nfound,status,tstat + integer nkeys,mkeys,i,ival,nend,namlen,indval + character inname*8,keynam*8 + character*80 rec,value,comm + + if (status .gt. 0)return + +C for efficiency, we want to search just once through the header +C for all the keywords which match the root. + + nfound=0 + nend=nstart+nmax-1 + inname=keywrd + call ftupch(inname) + +C find the length of the root name + namlen=0 + do 5 i=8,1,-1 + if (inname(i:i) .ne. ' ')then + namlen=i + go to 6 + end if +5 continue +6 if (namlen .eq. 0)return + +C get the number of keywords in the header + call ftghsp(iunit,nkeys,mkeys,status) + + do 10 i=3,nkeys + call ftgrec(iunit,i,rec,status) + if (status .gt. 0)return + keynam=rec(1:8) + if (keynam(1:namlen) .eq. inname(1:namlen))then + +C try to interpret the remainder of the name as an integer + tstat=status + call ftc2ii(keynam(namlen+1:8),ival,status) + if (status .le. 0)then + if (ival .le. nend .and. ival .ge. nstart)then + call ftpsvc(rec,value,comm,status) + indval=ival-nstart+1 + call ftc2ll(value,logval(indval),status) + nfound=max(nfound,indval) + end if + else + if (status .eq. 407)then + status=tstat + else + return + end if + end if + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftgkns.f b/pkg/tbtables/fitsio/ftgkns.f new file mode 100644 index 00000000..66194c38 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkns.f @@ -0,0 +1,94 @@ +C-------------------------------------------------------------------------- + subroutine ftgkns(iunit,keywrd,nstart,nmax,strval,nfound, + & status) + +C read an array of character string values from header records +C +C iunit i fortran input unit number +C keywrd c keyword name +C nstart i starting sequence number (usually 1) +C nmax i number of keywords to read +C OUTPUT PARAMETERS: +C strval i array of output keyword values +C nfound i number of keywords found +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,strval(*) + integer iunit,nstart,nmax,nfound,status,tstat + integer nkeys,mkeys,i,ival,nend,namlen,indval,ibuff + character inname*8,keynam*8 + character*80 value,comm + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(iunit) + +C for efficiency, we want to search just once through the header +C for all the keywords which match the root. + + nfound=0 + nend=nstart+nmax-1 + inname=keywrd + call ftupch(inname) + +C find the length of the root name + namlen=0 + do 5 i=8,1,-1 + if (inname(i:i) .ne. ' ')then + namlen=i + go to 6 + end if +5 continue +6 if (namlen .eq. 0)return + +C get the number of keywords in the header + call ftghsp(iunit,nkeys,mkeys,status) + + do 10 i=3,nkeys + call ftgrec(iunit,i,value,status) + if (status .gt. 0)return + keynam=value(1:8) + if (keynam(1:namlen) .eq. inname(1:namlen))then + +C try to interpret the remainder of the name as an integer + tstat=status + call ftc2ii(keynam(namlen+1:8),ival,status) + if (status .le. 0)then + if (ival .le. nend .and. ival .ge. nstart)then + +C OK, this looks like a valid keyword; Reset the +C next-header-keyword pointer by one record, then +C call ftgkys to read it. (This does support +C long continued string values) + + nxthdr(ibuff)=nxthdr(ibuff)-80 + indval=ival-nstart+1 + call ftgkys(iunit,keynam,strval(indval), + & comm,status) + + nfound=max(nfound,indval) + end if + else + if (status .eq. 407)then + status=tstat + else + return + end if + end if + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftgkyd.f b/pkg/tbtables/fitsio/ftgkyd.f new file mode 100644 index 00000000..b1ca4ccc --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkyd.f @@ -0,0 +1,26 @@ +C-------------------------------------------------------------------------- + subroutine ftgkyd(iunit,keywrd,dval,comm,status) + +C read a double precision value and comment string from a header record +C +C iunit i fortran input unit number +C keywrd c keyword name +C OUTPUT PARAMETERS: +C dval i output keyword value +C comm c output keyword comment +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer iunit,status + character value*35 + double precision dval + +C find the keyword and return value and comment as character strings + call ftgkey(iunit,keywrd,value,comm,status) + +C convert character string to double precision +C datatype conversion will be performed if necessary and if possible + call ftc2d(value,dval,status) + end diff --git a/pkg/tbtables/fitsio/ftgkye.f b/pkg/tbtables/fitsio/ftgkye.f new file mode 100644 index 00000000..9477ba34 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkye.f @@ -0,0 +1,26 @@ +C-------------------------------------------------------------------------- + subroutine ftgkye(iunit,keywrd,rval,comm,status) + +C read a real*4 value and the comment string from a header record +C +C iunit i fortran input unit number +C keywrd c keyword name +C OUTPUT PARAMETERS: +C rval r output keyword value +C comm c output keyword comment +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer iunit,status + character value*35 + real rval + +C find the keyword and return value and comment as character strings + call ftgkey(iunit,keywrd,value,comm,status) + +C convert character string to real +C datatype conversion will be performed if necessary and if possible + call ftc2r(value,rval,status) + end diff --git a/pkg/tbtables/fitsio/ftgkyj.f b/pkg/tbtables/fitsio/ftgkyj.f new file mode 100644 index 00000000..ff0b84da --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkyj.f @@ -0,0 +1,25 @@ +C-------------------------------------------------------------------------- + subroutine ftgkyj(iunit,keywrd,intval,comm,status) + +C read an integer value and the comment string from a header record +C +C iunit i fortran input unit number +C keywrd c keyword name +C OUTPUT PARAMETERS: +C intval i output keyword value +C comm c output keyword comment +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer iunit,intval,status + character value*35 + +C find the keyword and return value and comment as character strings + call ftgkey(iunit,keywrd,value,comm,status) + +C convert character string to integer +C datatype conversion will be performed if necessary and if possible + call ftc2i(value,intval,status) + end diff --git a/pkg/tbtables/fitsio/ftgkyl.f b/pkg/tbtables/fitsio/ftgkyl.f new file mode 100644 index 00000000..a4d355a5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkyl.f @@ -0,0 +1,25 @@ +C-------------------------------------------------------------------------- + subroutine ftgkyl(iunit,keywrd,logval,comm,status) + +C read a logical value and the comment string from a header record +C +C iunit i fortran input unit number +C keywrd c keyword name +C OUTPUT PARAMETERS: +C logval l output keyword value +C comm c output keyword comment +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer iunit,status + character value*20 + logical logval + +C find the keyword and return value and comment as character strings + call ftgkey(iunit,keywrd,value,comm,status) + +C convert character string to logical + call ftc2l(value,logval,status) + end diff --git a/pkg/tbtables/fitsio/ftgkyn.f b/pkg/tbtables/fitsio/ftgkyn.f new file mode 100644 index 00000000..09a95421 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkyn.f @@ -0,0 +1,49 @@ +C-------------------------------------------------------------------------- + subroutine ftgkyn(iunit,nkey,keynam,value,comm,status) + +C Read value and comment of the NKEYth header record +C This routine is useful for reading the entire header, one +C record at a time. + +C iunit i Fortran I/O unit number +C nkey i sequence number (starting with 1) of the keyword to read +C OUTPUT PARAMETERS: +C keynam c output name of the keyword +C value c output value of the keyword, if any +C comm c output comment string, if any, of the keyword +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,nkey,status + character*(*) keynam,value,comm + character keybuf*80,arec*8 + + if (status .gt. 0)return + + call ftgrec(iunit,nkey,keybuf,status) + if (status .gt. 0)return + + keynam=keybuf(1:8) + +C parse the value and comment fields from the record + call ftpsvc(keybuf,value,comm,status) + if (status .gt. 0)return + +C Test that keyword name contains only valid characters. +C This also serves as a check in case there was no END keyword and +C program continues to read on into the data unit + call fttkey(keybuf(1:8),status) + if (status .gt. 0)then + write(arec,1000)nkey +1000 format(i8) + call ftpmsg('Name of header keyword number'//arec// + & ' contains illegal character(s):') + call ftpmsg(keybuf) + +C see if we are at the beginning of FITS logical record + if (nkey-1 .eq. (nkey-1)/36*36 .and. nkey .gt. 1)then + call ftpmsg('(This may indicate a missing END keyword).') + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftgkys.f b/pkg/tbtables/fitsio/ftgkys.f new file mode 100644 index 00000000..22c8479a --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkys.f @@ -0,0 +1,68 @@ +C-------------------------------------------------------------------------- + subroutine ftgkys(iunit,keywrd,strval,comm,status) + +C read a character string value and comment string from a header record +C +C iunit i fortran input unit number +C keywrd c keyword name +C OUTPUT PARAMETERS: +C strval c output keyword value +C comm c output keyword comment +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 +C modified 6/93 to support long strings which are continued +C over several keywords. A string may be continued by putting +C a backslash as the last non-blank character in the keyword string, +C then continuing the string in the next keyword which must have +C a blank keyword name. +C Modified 9/94 to support the new OGIP continuation convention + + character*(*) keywrd,comm,strval + integer status,iunit + character value*70, comm2*70, bslash*1 + integer clen,i,bspos,lenval + +C find the keyword and return value and comment as character strings + call ftgkey(iunit,keywrd,value,comm,status) + +C convert character string to unquoted string + call ftc2s(value,strval,status) + + if (status .gt. 0)return + + clen=len(strval) + +C is last character a backslash or & ? +C have to use 2 \\'s because the SUN compiler treats 1 \ as an escape + bslash='\\' + do 10 i=70,1,-1 + if (value(i:i) .ne. ' ' .and. value(i:i).ne.'''')then + if (value(i:i) .eq. bslash .or. + & value(i:i) .eq. '&')then +C have to subtract 1 due to the leading quote char + bspos=i-1 + go to 20 + end if +C no continuation character, so just return + return + end if +10 continue +C value field was blank, so just return + return + +C try to get the string continuation, and new comment string +20 call ftgnst(iunit,value,lenval,comm2,status) + if (lenval .eq. 0)return + + if (bspos .le. clen)then + strval(bspos:)=value(1:lenval) + bspos=bspos+lenval-1 + end if + + if (comm2 .ne. ' ')comm=comm2 + +C see if there is another continuation line + if (value(lenval:lenval) .eq. bslash .or. + & value(lenval:lenval) .eq. '&')go to 20 + end diff --git a/pkg/tbtables/fitsio/ftgkyt.f b/pkg/tbtables/fitsio/ftgkyt.f new file mode 100644 index 00000000..3acaa846 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgkyt.f @@ -0,0 +1,53 @@ +C-------------------------------------------------------------------------- + subroutine ftgkyt(iunit,keywrd,jval,dval,comm,status) + +C read an integer value and fractional parts of a keyword value +C and the comment string from a header record +C +C iunit i fortran input unit number +C keywrd c keyword name +C OUTPUT PARAMETERS: +C jval i output integer part of keyword value +C dval d output fractional part of keyword value +C comm c output keyword comment +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, Sept 1992 + + character*(*) keywrd,comm + integer iunit,jval,status,i,dot + double precision dval + character value*35 + logical ed + +C find the keyword and return value and comment as character strings + call ftgkey(iunit,keywrd,value,comm,status) + +C read keyword in straight forward way first: +C just convert character string to double precision +C datatype conversion will be performed if necessary and if possible + call ftc2d(value,dval,status) + jval=dval + if (jval .ge. 0)then + dval=dval-jval + else + dval=dval+jval + end if + +C now see if we have to read the fractional part again, this time +C with more precision + +C find the decimal point, if any, and look for a D or E + dot=0 + ed=.false. + do 10 i=1,35 + if (value(i:i) .eq. '.')dot=i + if (value(i:i) .eq. 'E' .or. value(i:i) .eq. 'D')ed=.true. +10 continue + + if (.not. ed .and. dot .gt. 0)then +C convert fractional part to double precision + call ftc2d(value(dot:),dval,status) + end if + + end diff --git a/pkg/tbtables/fitsio/ftgmsg.f b/pkg/tbtables/fitsio/ftgmsg.f new file mode 100644 index 00000000..b8835dec --- /dev/null +++ b/pkg/tbtables/fitsio/ftgmsg.f @@ -0,0 +1,7 @@ +C------------------------------------------------------------------------------ + subroutine ftgmsg(text) + +C get error message from top of stack and shift the stack up one message + character*(*) text + call ftxmsg(-1,text) + end diff --git a/pkg/tbtables/fitsio/ftgnst.f b/pkg/tbtables/fitsio/ftgnst.f new file mode 100644 index 00000000..0d9ed966 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgnst.f @@ -0,0 +1,70 @@ +C-------------------------------------------------------------------------- + subroutine ftgnst(iunit,value,lenval,comm,status) + +C get the next string keyword. +C see if the next keyword in the header is the continuation +C of a long string keyword, and if so, return the value string, +C the number of characters in the string, and the associated comment +C string. + +C value c returned value of the string continuation +C lenval i number of non-blank characters in the continuation string +C comm C value of the comment string, if any, in this keyword. + + character*(*) value,comm + integer iunit,lenval,status + + integer i,length,tstat,nkeys,nextky + character record*80, strval*70 + + if (status .gt. 0)return + + tstat=status + value=' ' + comm=' ' + lenval=0 + +C get current header position + call ftghps(iunit,nkeys,nextky,status) + +C get the next keyword record + if (nextky .le. nkeys)then + call ftgrec(iunit,nextky,record,status) + else +C positioned at end of header, so there is no next keyword to read + return + end if + +C does this appear to be a continuation keyword (=blank keyword name +C or CONTINUE)? + if (record(1:10) .ne. ' ' .and. record(1:10) .ne. + & 'CONTINUE ')return + +C return if record is blank + if (record .eq. ' ')return + +C set a dummy keyword name + record(1:10)='DUMMYKEY= ' + +C parse the record to get the value string and comment + call ftpsvc(record,strval,comm,status) + +C convert character string to unquoted string + call ftc2s(strval,value,status) + if (status .gt. 0)then +C this must not be a continuation card; reset status and messages + status=tstat + call ftcmsg + value=' ' + comm=' ' + return + end if + + length=len(value) + do 10 i=length,1,-1 + if (value(i:i) .ne. ' ')then + lenval=i + return + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftgpfb.f b/pkg/tbtables/fitsio/ftgpfb.f new file mode 100644 index 00000000..62b4defb --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpfb.f @@ -0,0 +1,42 @@ +C---------------------------------------------------------------------- + subroutine ftgpfb(iunit,group,felem,nelem, + & array,flgval,anynul,status) + +C Read an array of byte values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will have the corresponding element of +C FLGVAL set equal to .true. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C array b returned array of values that were read +C flgval l set to .true. if the corresponding element is undefined +C anynul l set to .true. if any returned elements are undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + character*1 nulval,array(*) + logical anynul,flgval(*) + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgclb(iunit,2,row,felem,nelem,1,2,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpfd.f b/pkg/tbtables/fitsio/ftgpfd.f new file mode 100644 index 00000000..b92e8879 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpfd.f @@ -0,0 +1,42 @@ +C---------------------------------------------------------------------- + subroutine ftgpfd(iunit,group,felem,nelem, + & array,flgval,anynul,status) + +C Read an array of r*8 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will have the corresponding element of +C FLGVAL set equal to .true. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C array d returned array of values that were read +C flgval l set to .true. if the corresponding element is undefined +C anynul l set to .true. if any returned elements are undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + double precision nulval,array(*) + logical anynul,flgval(*) + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgcld(iunit,2,row,felem,nelem,1,2,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpfe.f b/pkg/tbtables/fitsio/ftgpfe.f new file mode 100644 index 00000000..715adc29 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpfe.f @@ -0,0 +1,42 @@ +C---------------------------------------------------------------------- + subroutine ftgpfe(iunit,group,felem,nelem, + & array,flgval,anynul,status) + +C Read an array of r*4 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will have the corresponding element of +C FLGVAL set equal to .true. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C array r returned array of values that were read +C flgval l set to .true. if the corresponding element is undefined +C anynul l set to .true. if any returned elements are undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + real nulval,array(*) + logical anynul,flgval(*) + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgcle(iunit,2,row,felem,nelem,1,2,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpfi.f b/pkg/tbtables/fitsio/ftgpfi.f new file mode 100644 index 00000000..5292eec2 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpfi.f @@ -0,0 +1,42 @@ +C---------------------------------------------------------------------- + subroutine ftgpfi(iunit,group,felem,nelem, + & array,flgval,anynul,status) + +C Read an array of I*2 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will have the corresponding element of +C FLGVAL set equal to .true. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C array i*2 returned array of values that were read +C flgval l set to .true. if the corresponding element is undefined +C anynul l set to .true. if any returned elements are undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + integer*2 nulval,array(*) + logical anynul,flgval(*) + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgcli(iunit,2,row,felem,nelem,1,2,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpfj.f b/pkg/tbtables/fitsio/ftgpfj.f new file mode 100644 index 00000000..091bf121 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpfj.f @@ -0,0 +1,42 @@ +C---------------------------------------------------------------------- + subroutine ftgpfj(iunit,group,felem,nelem, + & array,flgval,anynul,status) + +C Read an array of I*4 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will have the corresponding element of +C FLGVAL set equal to .true. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C array i returned array of values that were read +C flgval l set to .true. if the corresponding element is undefined +C anynul l set to .true. if any returned elements are undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + integer nulval,array(*) + logical anynul,flgval(*) + integer i + + do 10 i=1,nelem + flgval(i)=.false. +10 continue + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgclj(iunit,2,row,felem,nelem,1,2,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgphx.f b/pkg/tbtables/fitsio/ftgphx.f new file mode 100644 index 00000000..c625413d --- /dev/null +++ b/pkg/tbtables/fitsio/ftgphx.f @@ -0,0 +1,281 @@ +C---------------------------------------------------------------------- + subroutine ftgphx(iunit,maxdim,simple,bitpix,naxis,naxes,pcount + & ,gcount,extend,bscale,bzero,blank,nblank,status) + +C get the main primary header keywords which define the array structure +C +C iunit i fortran unit number to use for reading +C maxdim i maximum no. of dimensions to read; dimension of naxes +C OUTPUT PARAMETERS: +C simple l does file conform to FITS standard? +C bitpix i number of bits per data value +C naxis i number of axes in the data array +C naxes i array giving the length of each data axis +C pcount i number of group parameters (usually 0) +C gcount i number of random groups (usually 1 or 0) +C extend l may extensions be present in the FITS file? +C bscale d scaling factor +C bzero d scaling zero point +C blank i value used to represent undefined pixels +C nblank i number of trailing blank keywords immediately before the END +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,maxdim,bitpix,naxis + integer naxes(*),pcount,gcount,blank,status,tstat + logical simple,extend,unknow + character keynam*8,value*20,lngval*40,comm*72,extn*4,keybuf*80 + double precision bscale,bzero + integer nkey,nblank,i,ibuff,taxes,maxd + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check that the first keyword is valid + call ftgrec(iunit,1,keybuf,status) + + keynam=keybuf(1:8) +C parse the value and comment fields from the record + call ftpsvc(keybuf,value,comm,status) + + if (status .gt. 0)go to 900 + + simple=.true. + unknow=.false. + if (chdu(ibuff) .eq. 1)then + if (keynam .eq. 'SIMPLE')then + if (value .eq. 'F')then +C this is not a simple FITS file; try to process it anyway + simple=.false. + else if (value .ne. 'T')then +C illegal value for the SIMPLE keyword + status=220 + + if (keybuf(9:10) .ne. '= ')then + call ftpmsg('The SIMPLE keyword is missing "= " in '// + & 'columns 9-10.') + else + call ftpmsg('The SIMPLE keyword value is illegal:'//value + & // '. It must equal T or F:') + end if + + call ftpmsg(keybuf) + end if + else + status=221 + call ftpmsg('First keyword of the file is not SIMPLE: '//keynam) + call ftpmsg(keybuf) + go to 900 + end if + else + if (keynam .eq. 'XTENSION')then + if (value(2:9) .ne. 'IMAGE ' .and. + & value(2:9) .ne. 'IUEIMAGE')then +C I don't know what type of extension this is, but press on + unknow=.true. + + if (keybuf(9:10) .ne. '= ')then + call ftpmsg('The XTENSION keyword is missing "= " in '// + & 'columns 9-10.') + else + call ftpmsg('This is not an IMAGE extension: '//value) + end if + + call ftpmsg(keybuf) + end if + else + status=225 + write(extn,1000)chdu(ibuff) +1000 format(i4) + call ftpmsg('First keyword in extension '//extn// + & ' was not XTENSION: '//keynam) + call ftpmsg(keybuf) + end if + end if + if (status .gt. 0)go to 900 + +C check that BITPIX is the second keyword + call ftgrec(iunit,2,keybuf,status) + + keynam=keybuf(1:8) +C parse the value and comment fields from the record + call ftpsvc(keybuf,value,comm,status) + + if (status .gt. 0)go to 900 + if (keynam .ne. 'BITPIX')then + status=222 + call ftpmsg('Second keyword was not BITPIX: '//keynam) + call ftpmsg(keybuf) + go to 900 + end if +C convert character string to integer + call ftc2ii(value,bitpix,status) + if (status .gt. 0)then +C bitpix value must be an integer + if (keybuf(9:10) .ne. '= ')then + call ftpmsg('BITPIX keyword is missing "= "'// + & ' in columns 9-10.') + else + call ftpmsg('Value of BITPIX is not an integer: '//value) + end if + call ftpmsg(keybuf) + status=211 + go to 900 + end if + +C test that bitpix has a legal value + call fttbit(bitpix,status) + if (status .gt. 0)then + call ftpmsg(keybuf) + go to 900 + end if + +C check that the third keyword is NAXIS + call ftgtkn(iunit,3,'NAXIS',naxis,status) + if (status .eq. 208)then +C third keyword was not NAXIS + status=223 + else if (status .eq. 209)then +C NAXIS value was not an integer + status=212 + end if + if (status .gt. 0)go to 900 + + if (maxdim .le. 0)then + maxd=naxis + else + maxd=min(maxdim,naxis) + end if + + do 10 i=1,naxis +C construct keyword name + call ftkeyn('NAXIS',i,keynam,status) +C attempt to read the keyword + call ftgtkn(iunit,3+i,keynam,taxes,status) + if (status .gt. 0)then + status=224 + go to 900 + else if (taxes .lt. 0)then +C NAXISn keywords must not be negative + status=213 + go to 900 + else if (i .le. maxd)then + naxes(i)=taxes + end if +10 continue + +C now look for other keywords of interest: bscale, bzero, blank, and END +C and pcount, gcount, and extend +15 bscale=1. + bzero=0. + pcount=0 + gcount=1 + extend=.false. +C choose a special value to represent the absence of a blank value + blank=123454321 + + nkey=3+naxis +18 nblank=0 +20 nkey=nkey+1 + tstat=status + call ftgrec(iunit,nkey,keybuf,status) + if (status .gt. 0)then +C first, check for normal end-of-header status, and reset to 0 + if (status .eq. 203)status=tstat +C if we hit the end of file, then set status = no END card found + if (status .eq. 107)then + status=210 + call ftpmsg('FITS header has no END keyword!') + end if + go to 900 + end if + keynam=keybuf(1:8) + comm=keybuf(9:80) + + if (keynam .eq. 'BSCALE')then +C convert character string to floating pt. + call ftpsvc(keybuf,lngval,comm,status) + call ftc2dd(lngval,bscale,status) + if (status .gt. 0)then + call ftpmsg('Error reading BSCALE keyword value'// + & ' as a Double:'//lngval) + end if + else if (keynam .eq. 'BZERO')then +C convert character string to floating pt. + call ftpsvc(keybuf,lngval,comm,status) + call ftc2dd(lngval,bzero,status) + if (status .gt. 0)then + call ftpmsg('Error reading BZERO keyword value'// + & ' as a Double:'//lngval) + end if + else if (keynam .eq. 'BLANK')then +C convert character string to integer + call ftpsvc(keybuf,value,comm,status) + call ftc2ii(value,blank,status) + if (status .gt. 0)then + call ftpmsg('Error reading BLANK keyword value'// + & ' as an integer:'//value) + end if + else if (keynam .eq. 'PCOUNT')then +C convert character string to integer + call ftpsvc(keybuf,value,comm,status) + call ftc2ii(value,pcount,status) + if (status .gt. 0)then + call ftpmsg('Error reading PCOUNT keyword value'// + & ' as an integer:'//value) + end if + else if (keynam .eq. 'GCOUNT')then +C convert character string to integer + call ftpsvc(keybuf,value,comm,status) + call ftc2ii(value,gcount,status) + if (status .gt. 0)then + call ftpmsg('Error reading GCOUNT keyword value'// + & ' as an integer:'//value) + end if + else if (keynam .eq. 'EXTEND')then +C convert character string to logical + call ftpsvc(keybuf,value,comm,status) + call ftc2ll(value,extend,status) + if (status .gt. 0)then + call ftpmsg('Error reading EXTEND keyword value'// + & ' as a Logical:'//value) + end if + else if (keynam .eq. ' ' .and. comm .eq. ' ')then +C need to ignore trailing blank records before the END card + nblank=nblank+1 + go to 20 + else if (keynam .eq. 'END')then + go to 900 + end if + if (status .gt. 0)go to 900 + go to 18 + +900 continue + + if (status .gt. 0)then + if (chdu(ibuff) .eq. 1)then + call ftpmsg('Failed to parse the required keywords in '// + & 'the Primary Array header ') + else + call ftpmsg('Failed to parse the required keywords in '// + & 'the Image Extension header (FTGPHX).') + end if + + else if (unknow)then +C set status if this was an unknown type of extension + status=233 + end if + end diff --git a/pkg/tbtables/fitsio/ftgprh.f b/pkg/tbtables/fitsio/ftgprh.f new file mode 100644 index 00000000..6171cfa6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgprh.f @@ -0,0 +1,14 @@ +C---------------------------------------------------------------------- + subroutine ftgprh(iunit,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,status) + +C OBSOLETE routine: should call ftghpr instead + + integer iunit,bitpix,naxis,naxes(*),pcount,gcount,blank,status + integer nblank + logical simple,extend + double precision fill + + call ftgphx(iunit,0,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,fill,fill,blank,nblank,status) + end diff --git a/pkg/tbtables/fitsio/ftgpvb.f b/pkg/tbtables/fitsio/ftgpvb.f new file mode 100644 index 00000000..9c412ecf --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpvb.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftgpvb(iunit,group,felem,nelem,nulval, + & array,anynul,status) + +C Read an array of byte values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will be set equal to NULVAL, unless NULVAL=0 +C in which case no checking for undefined values will be performed. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C nulval b the value to be assigned to undefined pixels +C array b returned array of values that were read +C anynul l set to .true. if any returned elements were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + character nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgclb(iunit,2,row,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpvd.f b/pkg/tbtables/fitsio/ftgpvd.f new file mode 100644 index 00000000..7e5c3e79 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpvd.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftgpvd(iunit,group,felem,nelem,nulval, + & array,anynul,status) + +C Read an array of r*8 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will be set equal to NULVAL, unless NULVAL=0 +C in which case no checking for undefined values will be performed. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C nulval b the value to be assigned to undefined pixels +C array b returned array of values that were read +C anynul l set to .true. if any returned elements were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + double precision nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgcld(iunit,2,row,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpve.f b/pkg/tbtables/fitsio/ftgpve.f new file mode 100644 index 00000000..4a5433f4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpve.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftgpve(iunit,group,felem,nelem,nulval, + & array,anynul,status) + +C Read an array of r*4 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will be set equal to NULVAL, unless NULVAL=0 +C in which case no checking for undefined values will be performed. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C nulval r the value to be assigned to undefined pixels +C array r returned array of values that were read +C anynul l set to .true. if any returned elements were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + real nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgcle(iunit,2,row,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpvi.f b/pkg/tbtables/fitsio/ftgpvi.f new file mode 100644 index 00000000..397ec611 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpvi.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftgpvi(iunit,group,felem,nelem,nulval, + & array,anynul,status) + +C Read an array of i*2 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will be set equal to NULVAL, unless NULVAL=0 +C in which case no checking for undefined values will be performed. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C nulval i*2 the value to be assigned to undefined pixels +C array i*2 returned array of values that were read +C anynul l set to .true. if any returned elements were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + integer*2 nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgcli(iunit,2,row,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgpvj.f b/pkg/tbtables/fitsio/ftgpvj.f new file mode 100644 index 00000000..ea5802b1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgpvj.f @@ -0,0 +1,37 @@ +C---------------------------------------------------------------------- + subroutine ftgpvj(iunit,group,felem,nelem,nulval, + & array,anynul,status) + +C Read an array of i*4 values from the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). +C Undefined elements will be set equal to NULVAL, unless NULVAL=0 +C in which case no checking for undefined values will be performed. +C ANYNUL is return with a value of .true. if any pixels were undefined. + +C iunit i Fortran unit number +C group i number of the data group, if any +C felem i the first pixel to be read (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be read +C nulval i the value to be assigned to undefined pixels +C array i returned array of values that were read +C anynul l set to .true. if any returned elements were undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,group,felem,nelem,status,row + integer nulval,array(*) + logical anynul,flgval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(1,group) + call ftgclj(iunit,2,row,felem,nelem,1,1,nulval, + & array,flgval,anynul,status) + end diff --git a/pkg/tbtables/fitsio/ftgrec.f b/pkg/tbtables/fitsio/ftgrec.f new file mode 100644 index 00000000..d64aaa75 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgrec.f @@ -0,0 +1,71 @@ +C-------------------------------------------------------------------------- + subroutine ftgrec(iunit,nrec,record,status) + +C Read the Nth 80-byte header record +C This routine is useful for reading the entire header, one +C record at a time. + +C iunit i Fortran I/O unit number +C nrec i sequence number (starting with 1) of the record to read +C OUTPUT PARAMETERS: +C record c output 80-byte record +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,nrec,status + character*80 record + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,nbyte,endhd + character arec*8 + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(iunit) + +C calculate byte location of the record, and check if it is legal + nbyte=hdstrt(ibuff,chdu(ibuff))+(nrec-1)*80 + +C endhd=(hdend(ibuff)/2880+1)*2880 +C modified this on 4 Nov 1994 to allow for blanks before the END keyword + endhd=max(hdend(ibuff),dtstrt(ibuff)-2880) + + if (nbyte .gt. endhd .or. nrec .le. 0)then +C header record number is out of bounds + status=203 + write(arec,1000)nrec +1000 format(i8) + call ftpmsg('Cannot get Keyword number '//arec//'.'// + & ' It does not exist.') + go to 100 + end if + +C position the I/O pointer to the appropriate header keyword + call ftmbyt(iunit,nbyte,.false.,status) + +C read the 80 byte record + call ftgcbf(iunit,1,80,record,status) + if (status .gt. 0)then + write(arec,1000)nrec + call ftpmsg('FTGREC could not read header keyword'// + & ' number '//arec//'.') + return + end if + +C update the keyword pointer position + nxthdr(ibuff)=nbyte+80 + +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsfb.f b/pkg/tbtables/fitsio/ftgsfb.f new file mode 100644 index 00000000..365214cf --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsfb.f @@ -0,0 +1,142 @@ +C---------------------------------------------------------------------------- + subroutine ftgsfb(iunit,colnum,naxis,naxes,blc,trc,inc, + & array,flgval,anynul,status) + +C read a subsection of byte data values from an image or +C a table column. Returns an associated array of null value flags. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C array i array of data values that are read from the FITS file +C flgval l set to .true. if corresponding array element is undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + character*1 array(*),nulval + logical anynul,anyf,flgval(*) + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSFB ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=2 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSFB, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgclb(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),flgval(i1),anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsfd.f b/pkg/tbtables/fitsio/ftgsfd.f new file mode 100644 index 00000000..4bd9acbe --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsfd.f @@ -0,0 +1,142 @@ +C---------------------------------------------------------------------------- + subroutine ftgsfd(iunit,colnum,naxis,naxes,blc,trc,inc, + & array,flgval,anynul,status) + +C read a subsection of double precision data values from an image or +C a table column. Returns an associated array of null value flags. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C array i array of data values that are read from the FITS file +C flgval l set to .true. if corresponding array element is undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + double precision array(*),nulval + logical anynul,anyf,flgval(*) + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSFD ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=2 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSFD, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgcld(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),flgval(i1),anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsfe.f b/pkg/tbtables/fitsio/ftgsfe.f new file mode 100644 index 00000000..d7cf71d4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsfe.f @@ -0,0 +1,142 @@ +C---------------------------------------------------------------------------- + subroutine ftgsfe(iunit,colnum,naxis,naxes,blc,trc,inc, + & array,flgval,anynul,status) + +C read a subsection of real data values from an image or +C a table column. Returns an associated array of null value flags. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C array i array of data values that are read from the FITS file +C flgval l set to .true. if corresponding array element is undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + real array(*),nulval + logical anynul,anyf,flgval(*) + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSFE ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=2 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSFE, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgcle(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),flgval(i1),anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsfi.f b/pkg/tbtables/fitsio/ftgsfi.f new file mode 100644 index 00000000..7d106532 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsfi.f @@ -0,0 +1,142 @@ +C---------------------------------------------------------------------------- + subroutine ftgsfi(iunit,colnum,naxis,naxes,blc,trc,inc, + & array,flgval,anynul,status) + +C read a subsection of integer*2 data values from an image or +C a table column. Returns an associated array of null value flags. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C array i array of data values that are read from the FITS file +C flgval l set to .true. if corresponding array element is undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + integer*2 array(*),nulval + logical anynul,anyf,flgval(*) + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSFI ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=2 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSFI, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgcli(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),flgval(i1),anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsfj.f b/pkg/tbtables/fitsio/ftgsfj.f new file mode 100644 index 00000000..f873ffb0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsfj.f @@ -0,0 +1,142 @@ +C---------------------------------------------------------------------------- + subroutine ftgsfj(iunit,colnum,naxis,naxes,blc,trc,inc, + & array,flgval,anynul,status) + +C read a subsection of integer*4 data values from an image or +C a table column. Returns an associated array of null value flags. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C array i array of data values that are read from the FITS file +C flgval l set to .true. if corresponding array element is undefined +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + integer array(*),nulval + logical anynul,anyf,flgval(*) + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSFJ ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=2 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSFJ, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgclj(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),flgval(i1),anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsvb.f b/pkg/tbtables/fitsio/ftgsvb.f new file mode 100644 index 00000000..2c4882cc --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsvb.f @@ -0,0 +1,143 @@ +C---------------------------------------------------------------------------- + subroutine ftgsvb(iunit,colnum,naxis,naxes,blc,trc,inc, + & nulval,array,anynul,status) + +C read a subsection of byte data values from an image or +C a table column. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C nulval i value that undefined pixels will be set to +C array i array of data values that are read from the FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + character*1 array(*),nulval + logical anynul,anyf + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + logical ldummy + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSVB ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=1 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSVB, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgclb(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),ldummy,anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsvd.f b/pkg/tbtables/fitsio/ftgsvd.f new file mode 100644 index 00000000..c7e1d30b --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsvd.f @@ -0,0 +1,143 @@ +C---------------------------------------------------------------------------- + subroutine ftgsvd(iunit,colnum,naxis,naxes,blc,trc,inc, + & nulval,array,anynul,status) + +C read a subsection of double precision data values from an image or +C a table column. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C nulval i value that undefined pixels will be set to +C array i array of data values that are read from the FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + double precision array(*),nulval + logical anynul,anyf + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + logical ldummy + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSVD ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=1 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSVD, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgcld(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),ldummy,anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsve.f b/pkg/tbtables/fitsio/ftgsve.f new file mode 100644 index 00000000..c0024029 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsve.f @@ -0,0 +1,143 @@ +C---------------------------------------------------------------------------- + subroutine ftgsve(iunit,colnum,naxis,naxes,blc,trc,inc, + & nulval,array,anynul,status) + +C read a subsection of real data values from an image or +C a table column. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C nulval i value that undefined pixels will be set to +C array i array of data values that are read from the FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + real array(*),nulval + logical anynul,anyf + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + logical ldummy + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSVE ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=1 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSVE, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgcle(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),ldummy,anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsvi.f b/pkg/tbtables/fitsio/ftgsvi.f new file mode 100644 index 00000000..a72beda6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsvi.f @@ -0,0 +1,143 @@ +C---------------------------------------------------------------------------- + subroutine ftgsvi(iunit,colnum,naxis,naxes,blc,trc,inc, + & nulval,array,anynul,status) + +C read a subsection of integer*2 data values from an image or +C a table column. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C nulval i value that undefined pixels will be set to +C array i array of data values that are read from the FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + integer*2 array(*),nulval + logical anynul,anyf + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + logical ldummy + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSVI ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=1 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSVI, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgcli(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),ldummy,anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgsvj.f b/pkg/tbtables/fitsio/ftgsvj.f new file mode 100644 index 00000000..b4f798e6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgsvj.f @@ -0,0 +1,143 @@ +C---------------------------------------------------------------------------- + subroutine ftgsvj(iunit,colnum,naxis,naxes,blc,trc,inc, + & nulval,array,anynul,status) + +C read a subsection of integer*4 data values from an image or +C a table column. + +C iunit i fortran unit number +C colnum i number of the column to read from +C naxis i number of dimensions in the FITS array +C naxes i size of each dimension. +C blc i 'bottom left corner' of the subsection to be read +C trc i 'top right corner' of the subsection to be read +C inc i increment to be applied in each dimension +C nulval i value that undefined pixels will be set to +C array i array of data values that are read from the FITS file +C anynul l set to .true. if any of the returned values are undefined +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1993 + + integer iunit,colnum,naxis,naxes(*),blc(*),trc(*),inc(*),status + integer array(*),nulval + logical anynul,anyf + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer i,i1,i2,i3,i4,i5,i6,i7,i8,i9,row,rstr,rstp,rinc + integer str(9),stp(9),incr(9),dsize(10) + integer felem,nelem,nultyp,ninc,ibuff,numcol + logical ldummy + character caxis*20 + +C this routine is set up to handle a maximum of nine dimensions + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 9)then + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTGSVJ ' + & //'is illegal.') + return + end if + +C if this is a primary array, then the input COLNUM parameter should +C be interpreted as the row number, and we will alway read the image +C data from column 2 (any group parameters are in column 1). + + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array, or image extension + if (colnum .eq. 0)then + rstr=1 + rstp=1 + else + rstr=colnum + rstp=colnum + end if + rinc=1 + numcol=2 + else +C this is a table, so the row info is in the (naxis+1) elements + rstr=blc(naxis+1) + rstp=trc(naxis+1) + rinc=inc(naxis+1) + numcol=colnum + end if + + nultyp=1 + anynul=.false. + i1=1 + do 5 i=1,9 + str(i)=1 + stp(i)=1 + incr(i)=1 + dsize(i)=1 +5 continue + do 10 i=1,naxis + if (trc(i) .lt. blc(i))then + status=321 + write(caxis,1001)i + call ftpmsg('In FTGSVJ, the range specified for axis '// + & caxis(19:20)//' has the start greater than the end.') + return + end if + str(i)=blc(i) + stp(i)=trc(i) + incr(i)=inc(i) + dsize(i+1)=dsize(i)*naxes(i) +10 continue + + if (naxis .eq. 1 .and. naxes(1) .eq. 1)then +C This is not a vector column, so read all the rows at once + nelem=(rstp-rstr)/rinc+1 + ninc=rinc + rstp=rstr + else +C have to read each row individually, in all dimensions + nelem=(stp(1)-str(1))/inc(1)+1 + ninc=incr(1) + end if + + do 100 row=rstr,rstp,rinc + do 90 i9=str(9),stp(9),incr(9) + do 80 i8=str(8),stp(8),incr(8) + do 70 i7=str(7),stp(7),incr(7) + do 60 i6=str(6),stp(6),incr(6) + do 50 i5=str(5),stp(5),incr(5) + do 40 i4=str(4),stp(4),incr(4) + do 30 i3=str(3),stp(3),incr(3) + do 20 i2=str(2),stp(2),incr(2) + + felem=str(1)+(i2-1)*dsize(2)+(i3-1)*dsize(3)+(i4-1)*dsize(4) + & +(i5-1)*dsize(5)+(i6-1)*dsize(6)+(i7-1)*dsize(7) + & +(i8-1)*dsize(8)+(i9-1)*dsize(9) + + call ftgclj(iunit,numcol,row,felem,nelem,ninc, + & nultyp,nulval,array(i1),ldummy,anyf,status) + if (status .gt. 0)return + if (anyf)anynul=.true. + i1=i1+nelem + +20 continue +30 continue +40 continue +50 continue +60 continue +70 continue +80 continue +90 continue +100 continue + end diff --git a/pkg/tbtables/fitsio/ftgtbb.f b/pkg/tbtables/fitsio/ftgtbb.f new file mode 100644 index 00000000..7651d71e --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtbb.f @@ -0,0 +1,64 @@ +C---------------------------------------------------------------------- + subroutine ftgtbb(iunit,frow,fchar,nchars,value,status) + +C read a consecutive string of bytes from an ascii or binary +C table. This will span multiple rows of the table if NCHARS+FCHAR is +C greater than the length of a row. + +C iunit i fortran unit number +C frow i starting row number (1st row = 1) +C fchar i starting character/byte in the row to read (1st character=1) +C nchars i number of characters/bytes to read (can span multiple rows) +C value i returned string of bytes +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Dec 1991 + + integer iunit,frow,fchar,nchars,status + integer value(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bstart + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check for errors + if (nchars .le. 0)then +C zero or negative number of character requested + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + return + else if (fchar .lt. 1)then +C error: illegal starting character + status=308 + return + end if + +C move the i/o pointer to the start of the sequence of characters + bstart=dtstrt(ibuff)+(frow-1)*rowlen(ibuff)+fchar-1 + call ftmbyt(iunit,bstart,.false.,status) + +C get the string of bytes + call ftgbyt(iunit,nchars,value,status) + end diff --git a/pkg/tbtables/fitsio/ftgtbc.f b/pkg/tbtables/fitsio/ftgtbc.f new file mode 100644 index 00000000..c4f6307a --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtbc.f @@ -0,0 +1,81 @@ +C---------------------------------------------------------------------- + subroutine ftgtbc(tfld,tdtype,trept,tbcol,lenrow,status) + +C Get Table Beginning Columns +C determine the byte offset of the beginning of each field of a +C binary table + +C tfld i number of fields in the binary table +C tdtype i array of numerical datatype codes of each column +C trept i array of repetition factors for each column +C OUTPUT PARAMETERS: +C tbcol i array giving the byte offset to the start of each column +C lenrow i total width of the table, in bytes +C status i returned error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 +C modified 6/17/92 to deal with ASCII column trept values measured +C in units of characters rather than in terms of number of repeated +C strings. + + integer tfld,tdtype(*),trept(*),tbcol(*),lenrow + integer status,i,nbytes + character ifld*4 + + if (status .gt. 0)return + +C the first column always begins at the first byte of the row: + tbcol(1)=0 + + do 100 i=1,tfld-1 + if (tdtype(i) .eq. 16)then +C ASCII field; each character is 1 byte + nbytes=1 + else if (tdtype(i) .gt. 0)then + nbytes=tdtype(i)/10 + else if (tdtype(i) .eq. 0)then +C error: data type of column not defined! (no TFORM keyword) + status=232 + write(ifld,1000)i +1000 format(i4) + call ftpmsg('Field'//ifld//' of the binary'// + & ' table has no TFORMn keyword') + return + else +C this is a descriptor field: 2J + nbytes=8 + end if + + if (nbytes .eq. 0)then +C this is a bit array + tbcol(i+1)=tbcol(i)+(trept(i)+7)/8 + else + tbcol(i+1)=tbcol(i)+trept(i)*nbytes + end if +100 continue + +C determine the total row width + if (tdtype(tfld) .eq. 16)then +C ASCII field; each character is 1 byte + nbytes=1 + else if (tdtype(tfld) .gt. 0)then + nbytes=tdtype(tfld)/10 + else if (tdtype(i) .eq. 0)then +C error: data type of column not defined! (no TFORM keyword) + status=232 + write(ifld,1000)tfld + call ftpmsg('Field'//ifld//' of the binary'// + & ' table is missing required TFORMn keyword.') + return + else +C this is a descriptor field: 2J + nbytes=8 + end if + if (nbytes .eq. 0)then +C this is a bit array + lenrow=tbcol(tfld)+(trept(tfld)+7)/8 + else + lenrow=tbcol(tfld)+trept(tfld)*nbytes + end if + + end diff --git a/pkg/tbtables/fitsio/ftgtbh.f b/pkg/tbtables/fitsio/ftgtbh.f new file mode 100644 index 00000000..a07e29e6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtbh.f @@ -0,0 +1,12 @@ +C---------------------------------------------------------------------- + subroutine ftgtbh(iunit,ncols,nrows,nfield,ttype,tbcol, + & tform,tunit,extnam,status) + +C OBSOLETE routine: should call ftghtb instead + + integer iunit,ncols,nrows,nfield,status,tbcol(*) + character*(*) ttype(*),tform(*),tunit(*),extnam + + call ftghtb(iunit,0,ncols,nrows,nfield,ttype, + & tbcol,tform,tunit,extnam,status) + end diff --git a/pkg/tbtables/fitsio/ftgtbn.f b/pkg/tbtables/fitsio/ftgtbn.f new file mode 100644 index 00000000..cf3c73bc --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtbn.f @@ -0,0 +1,123 @@ +C---------------------------------------------------------------------- + subroutine ftgtbn(iunit,ncols,nrows,pcount,nfield,status) + +C check that this is a valid binary table and get parameters +C +C iunit i Fortran i/o unit number +C ncols i width of each row of the table, in bytes +C nrows i number of rows in the table +C pcount i size of special data area following the table (usually = 0) +C nfield i number of fields in the table +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,ncols,nrows,nfield,pcount,status + character keynam*8,value*10,comm*8,rec*80 + + if (status .gt. 0)return + +C check for correct type of extension + call ftgrec(iunit,1,rec,status) + if (status .gt. 0)go to 900 + + keynam=rec(1:8) + + if (keynam .eq. 'XTENSION')then + call ftpsvc(rec,value,comm,status) + if (status .gt. 0)go to 900 + + if (value(2:9) .ne. 'BINTABLE' .and. + & value(2:9) .ne. 'A3DTABLE' .and. + & value(2:9) .ne. '3DTABLE ')then +C this is not a binary table extension + status=227 + go to 900 + end if + else + status=225 + go to 900 + end if + +C check that the second keyword is BITPIX = 8 + call fttkyn(iunit,2,'BITPIX','8',status) + if (status .eq. 208)then +C BITPIX keyword not found + status=222 + else if (status .eq. 209)then +C illegal value of BITPIX + status=211 + end if + if (status .gt. 0)go to 900 + +C check that the third keyword is NAXIS = 2 + call fttkyn(iunit,3,'NAXIS','2',status) + if (status .eq. 208)then +C NAXIS keyword not found + status=223 + else if (status .eq. 209)then +C illegal NAXIS value + status=212 + end if + if (status .gt. 0)go to 900 + +C check that the 4th keyword is NAXIS1 and get it's value + call ftgtkn(iunit,4,'NAXIS1',ncols,status) + if (status .eq. 208)then +C NAXIS1 keyword not found + status=224 + else if (status .eq. 209)then +C illegal value of NAXISnnn + status=213 + end if + if (status .gt. 0)go to 900 + +C check that the 5th keyword is NAXIS2 and get it's value + call ftgtkn(iunit,5,'NAXIS2',nrows,status) + if (status .eq. 208)then +C NAXIS2 keyword not found + status=224 + else if (status .eq. 209)then +C illegal value of NAXISnnn + status=213 + end if + if (status .gt. 0)go to 900 + +C check that the 6th keyword is PCOUNT and get it's value + call ftgtkn(iunit,6,'PCOUNT',pcount,status) + if (status .eq. 208)then +C PCOUNT keyword not found + status=228 + else if (status .eq. 209)then +C illegal PCOUNT value + status=214 + end if + if (status .gt. 0)go to 900 + +C check that the 7th keyword is GCOUNT = 1 + call fttkyn(iunit,7,'GCOUNT','1',status) + if (status .eq. 208)then +C GCOUNT keyword not found + status=229 + else if (status .eq. 209)then +C illegal value of GCOUNT + status=215 + end if + if (status .gt. 0)go to 900 + +C check that the 8th keyword is TFIELDS and get it's value + call ftgtkn(iunit,8,'TFIELDS',nfield,status) + if (status .eq. 208)then +C TFIELDS keyword not found + status=230 + else if (status .eq. 209)then +C illegal value of TFIELDS + status=216 + end if + +900 continue + if (status .gt. 0)then + call ftpmsg('Failed to parse the required keywords in '// + & 'the binary BINTABLE header (FTGTTB).') + end if + end diff --git a/pkg/tbtables/fitsio/ftgtbs.f b/pkg/tbtables/fitsio/ftgtbs.f new file mode 100644 index 00000000..2a659b66 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtbs.f @@ -0,0 +1,71 @@ +C---------------------------------------------------------------------- + subroutine ftgtbs(iunit,frow,fchar,nchars,svalue,status) + +C read a consecutive string of characters from an ascii or binary +C table. This will span multiple rows of the table if NCHARS+FCHAR is +C greater than the length of a row. + +C iunit i fortran unit number +C frow i starting row number (1st row = 1) +C fchar i starting character/byte in the row to read (1st character=1) +C nchars i number of characters/bytes to read (can span multiple rows) +C svalue c returned string of characters +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,frow,fchar,nchars,status + character*(*) svalue + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bstart,nget + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check for errors + if (nchars .le. 0)then +C zero or negative number of character requested + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + return + else if (fchar .lt. 1)then +C error: illegal starting character + status=308 + return + end if + +C move the i/o pointer to the start of the sequence of characters + bstart=dtstrt(ibuff)+(frow-1)*rowlen(ibuff)+fchar-1 + call ftmbyt(iunit,bstart,.false.,status) + +C get the string of characters, (up to the length of the input string) + if (len(svalue) .ne. 1)then + svalue=' ' + nget=min(nchars,len(svalue)) + else +C assume svalue was dimensioned as: character*1 svalue(nchars) + nget=nchars + end if + call ftgcbf(iunit,1,nget,svalue,status) + end diff --git a/pkg/tbtables/fitsio/ftgtcl.f b/pkg/tbtables/fitsio/ftgtcl.f new file mode 100644 index 00000000..cbc680a1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtcl.f @@ -0,0 +1,64 @@ +C-------------------------------------------------------------------------- + subroutine ftgtcl(iunit,colnum,datcod,repeat,width,status) + +C get the datatype of the column, as well as the vector +C repeat count and (if it is an ASCII character column) the +C width of a unit string within the column. This supports the +C TFORMn = 'rAw' syntax for specifying arrays of substrings. + + +C iunit i Fortran i/o unit number +C colnum i number of the column (first column = 1) + +C datcod i returned datatype code +C repeat i number of elements in the vector column +C width i width of unit string in character columns +C status i returned error status +C +C written by Wm Pence, HEASARC/GSFC, November 1994 + + integer iunit,colnum,datcod,repeat,width,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS------------------------------------ + + integer ibuff,dummy + character keywrd*8,tform*24,comm*20 + + if (status .gt. 0)return + +C construct the keyword name + call ftkeyn('TFORM',colnum,keywrd,status) + +C get the keyword value + call ftgkys(iunit,keywrd,tform,comm,status) + if (status .gt. 0)then + call ftpmsg('Could not read the '//keywrd//' keyword.') + return + end if + +C parse the keyword value + ibuff=bufnum(iunit) + if (hdutyp(ibuff) .eq. 1)then +C this is an ASCII table + repeat=1 + call ftasfm(tform,datcod,width,dummy,status) + + else if (hdutyp(ibuff) .eq. 2)then +C this is a binary table + call ftbnfm(tform,datcod,repeat,width,status) + + else +C error: this HDU is not a table + status=235 + return + end if + end diff --git a/pkg/tbtables/fitsio/ftgtcs.f b/pkg/tbtables/fitsio/ftgtcs.f new file mode 100644 index 00000000..09e78618 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtcs.f @@ -0,0 +1,53 @@ +C------------------------------------------------------------------------------ + subroutine ftgtcs(iunit,xcol,ycol,xrval,yrval,xrpix,yrpix, + & xinc,yinc,rot,type,status) + +C read the values of the celestial coordinate system keywords +C from a FITS table where the X and Y or RA and DEC coordinates +C are stored in separate column. +C +C These values may be used as input to the subroutines that +C calculate celestial coordinates. (FTXYPX, FTWLDP) + +C xcol (integer) number of the column containing the RA type coordinate +C ycol (integer) number of the column containing the DEC type coordinate + + double precision xrval,yrval,xrpix,yrpix,xinc,yinc,rot + integer iunit,xcol,ycol,status + character*(*) type + character comm*20,ctype*8,keynam*8,xnum*3,ynum*3 + + if (status .gt. 0)return + + call ftkeyn('TCRVL',xcol,keynam,status) + xnum=keynam(6:8) + call ftgkyd(iunit,keynam,xrval,comm,status) + + call ftkeyn('TCRVL',ycol,keynam,status) + ynum=keynam(6:8) + call ftgkyd(iunit,keynam,yrval,comm,status) + + keynam='TCRPX'//xnum + call ftgkyd(iunit,keynam,xrpix,comm,status) + keynam='TCRPX'//ynum + call ftgkyd(iunit,keynam,yrpix,comm,status) + + keynam='TCDLT'//xnum + call ftgkyd(iunit,keynam,xinc,comm,status) + keynam='TCDLT'//ynum + call ftgkyd(iunit,keynam,yinc,comm,status) + + keynam='TCTYP'//xnum + call ftgkys(iunit,keynam,ctype,comm,status) + + if (status .gt. 0)then + call ftpmsg('FTGTCS could not find all the required'// + & ' celestial coordinate Keywords.') + status=505 + return + end if + + type=ctype(5:8) + + rot=0. + end diff --git a/pkg/tbtables/fitsio/ftgtdm.f b/pkg/tbtables/fitsio/ftgtdm.f new file mode 100644 index 00000000..49230faa --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtdm.f @@ -0,0 +1,99 @@ +C---------------------------------------------------------------------- + subroutine ftgtdm(iunit,colnum,maxdim,naxis,naxes,status) + +C parse the TDIMnnn keyword to get the dimensionality of a column + +C iunit i fortran unit number to use for reading +C colnum i column number to read +C maxdim i maximum no. of dimensions to read; dimension of naxes +C OUTPUT PARAMETERS: +C naxis i number of axes in the data array +C naxes i array giving the length of each data axis +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, October 1993 + + integer iunit,colnum,maxdim,naxis,naxes(*),status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,nfound,c1,c2,clast,dimval + logical last + character*120 tdim + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + + if (colnum .lt. 1 .or. colnum .gt. tfield(ibuff))then +C illegal column number + status=302 + return + end if + + nfound=0 +C try getting the TDIM keyword value + call ftgkns(iunit,'TDIM',colnum,1,tdim,nfound,status) + + if (nfound .ne. 1)then +C no TDIM keyword found + naxis=1 + naxes(1)=trept(colnum+tstart(ibuff)) + return + end if + + naxis=0 +C first, find the opening ( and closing ) + c1=index(tdim,'(')+1 + c2=index(tdim,')')-1 + if (c1 .eq. 1 .or. c2 .eq. -1)go to 900 + + last=.false. +C find first non-blank character +10 if (tdim(c1:c1) .ne. ' ')go to 20 + c1=c1+1 + go to 10 + +C find the comma separating the dimension sizes +20 clast=index(tdim(c1:c2),',')+c1-2 + if (clast .eq. c1-2)then + last=.true. + clast=c2 + end if + +C read the string of characters as the (integer) dimension size + call ftc2ii(tdim(c1:clast),dimval,status) + if (status .gt. 0)then + call ftpmsg('Error in FTGTDM parsing dimension string: ' + & //tdim) + go to 900 + end if + + naxis=naxis+1 + if (naxis .le. maxdim)naxes(naxis)=dimval + + if (last)return + + c1=clast+2 + go to 10 + +C could not parse the tdim value +900 status=263 + end diff --git a/pkg/tbtables/fitsio/ftgthd.f b/pkg/tbtables/fitsio/ftgthd.f new file mode 100644 index 00000000..ee4a3aa6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgthd.f @@ -0,0 +1,297 @@ +C-------------------------------------------------------------------------- + subroutine ftgthd(tmplat,card,hdtype,status) + +C 'Get Template HeaDer' +C parse a template header line and create a formated +C 80-character string which is suitable for appending to a FITS header + +C tmplat c input header template string +C card c returned 80-character string = FITS header record +C hdtype i type of operation that should be applied to this keyword: +C -2 = modify the name of a keyword; the new name +C is returned in characters 41:48 of CARD. +C -1 = delete this keyword +C 0 = append (if it doesn't already exist) or +C overwrite this keyword (if it does exist) +C 1 = append this comment keyword ('HISTORY', +C 'COMMENT', or blank keyword name) +C 2 = this is an END record; do not append it +C to a FITS header! +C status i returned error status +C if a positive error status is returned then the first +C 80 characters of the offending input line are returned +C by the CARD parameter + + integer hdtype,status,tstat + character*(*) tmplat + character*80 card + integer i1,i2,com1,strend,length + character inline*100,keynam*8,ctemp*80,qc*1 + logical number + double precision dvalue + + if (status .gt. 0)return + card=' ' + hdtype=0 + + inline=tmplat + +C test if columns 1-8 are blank; if so, this is a FITS comment record; +C just copy it verbatim to the FITS header + if (inline(1:8) .eq. ' ')then + card=inline(1:80) + go to 999 + end if + +C parse the keyword name = the first token separated by a space or a '=' +C 1st locate the first nonblank character (we know it is not all blank): + i1=0 +20 i1=i1+1 +C test for a leading minus sign which flags name of keywords to be deleted + if (inline(i1:i1) .eq. '-')then + hdtype=-1 +C test for a blank keyword name + if (inline(i1+1:i1+8) .eq. ' ')then + card=' ' + i2=i1+9 + go to 35 + end if + go to 20 + else if (inline(i1:i1) .eq. ' ')then + go to 20 + end if + +C now find the last character of the keyword name + i2=i1 +30 i2=i2+1 + if (inline(i2:i2) .ne. ' ' .and. inline(i2:i2) .ne. '=')go to 30 + +C test for legal keyword name length (max 8 characters) + if (i2-i1 .gt. 8)then + status=207 + card=inline(1:80) + go to 999 + end if + + keynam=inline(i1:i2-1) + +C convert to upper case and test for illegal characters in keyword name + call ftupch(keynam) + call fttkey(keynam,status) + if (status .gt. 0)then + card=inline(1:80) + go to 999 + end if + +C if this is the 'END' then this is the end of the input file + if (keynam .eq. 'END ')goto 998 + +C copy the keyword name to the output record string + card(1:8)=keynam + +C jump if this is just the name of keyword to be deleted + if (hdtype .lt. 0)go to 35 + +C test if this is a COMMENT or HISTORY record + if (keynam .eq. 'COMMENT' .or. keynam .eq. 'HISTORY')then +C append next 72 characters from input line to output record + card(9:80)=inline(i2:) + hdtype=1 + go to 999 + else +C this keyword must have a value, so append the '= ' to output + card(9:10)='= ' + end if + +C now locate the value token in the input line. If it includes +C embedded spaces it must be enclosed in single quotes. The value must +C be separated by at least one blank space from the comment string + +C find the first character of the value string +35 i1=i2-1 +40 i1=i1+1 + if (i1 .gt. 100)then +C no value is present in the input line + if (hdtype .lt. 0)then +C this is normal; just quit + go to 999 + else + status=204 + card=inline(1:80) + go to 999 + end if + end if + if (hdtype .lt. 0 .and. inline(i1:i1) .eq. '=')then +C The leading minus sign, plus the presence of an equal sign +C between the first 2 tokens is taken to mean that the +C keyword with the first token name is to be deleted. + go to 999 + else if (inline(i1:i1).eq. ' ' .or.inline(i1:i1).eq. '=')then + go to 40 + end if + +C is the value a quoted string? + if (inline(i1:i1) .eq. '''')then +C find the closing quote + i2=i1 +50 i2=i2+1 + if (i2 .gt. 100)then +C error: no closing quote on value string + status=205 + card=inline(1:80) + call ftpmsg('Keyword value string has no closing quote:') + call ftpmsg(card) + go to 999 + end if + if (inline(i2:i2) .eq. '''')then + if (inline(i2+1:i2+1) .eq. '''')then +C ignore 2 adjacent single quotes + i2=i2+1 + go to 50 + end if + else + go to 50 + end if +C value string can't be more than 70 characters long (cols 11-80) + length=i2-i1 + if (length .gt. 69)then + status=205 + card=inline(1:80) + call ftpmsg('Keyword value string is too long:') + call ftpmsg(card) + go to 999 + end if + +C append value string to output, left justified in column 11 + card(11:11+length)=inline(i1:i2) +C com1 is the starting position for the comment string + com1=max(32,13+length) + +C FITS string must be at least 8 characters long + if (length .lt. 9)then + card(11+length:11+length)=' ' + card(20:20)='''' + end if + else +C find the end of the value field + i2=i1 +60 i2=i2+1 + if (i2 .gt. 100)then +C error: value string is too long + status=205 + card=inline(1:80) + call ftpmsg('Keyword value string is too long:') + call ftpmsg(card) + go to 999 + end if + if (inline(i2:i2) .ne. ' ')go to 60 + +C test if this is a logical value + length=i2-i1 + if (length .eq. 1 .and. (inline(i1:i1) .eq. 'T' + & .or. inline(i1:i1) .eq. 'F'))then + card(30:30)=inline(i1:i1) + com1=32 + else +C test if this is a numeric value; try reading it as +C double precision value; if it fails, it must be a string + number=.true. + tstat=status + call ftc2dd(inline(i1:i2-1),dvalue,status) + if (status .gt. 0)then + status=tstat + number=.false. + else +C check the first character to make sure this is a number +C since certain non-numeric character strings pass the +C above test on SUN machines. + qc=inline(i1:i1) + if (qc .ne. '+' .and. qc .ne. '-' .and. qc .ne. + & '.' .and. (qc .lt. '0' .or. qc .gt. '9'))then +C This really was not a number! + number=.false. + end if + end if + + if (number)then + if (length .le. 20)then +C write the value right justified in col 30 + card(31-length:30)=inline(i1:i2-1) + com1=32 + else +C write the long value left justified in col 11 + card(11:10+length)=inline(i1:i2-1) + com1=max(32,12+length) + end if + else +C value is a character string datatype + card(11:11)='''' + strend=11+length + card(12:strend)=inline(i1:i2-1) +C need to expand any embedded single quotes into 2 quotes + i1=11 +70 i1=i1+1 + if (i1 .gt. strend) go to 80 + if (card(i1:i1) .eq. '''')then + i1=i1+1 + if (card(i1:i1) .ne. '''')then +C have to insert a 2nd quote into string + ctemp=card(i1:strend) + card(i1:i1)='''' + strend=strend+1 + i1=i1+1 + card(i1:strend)=ctemp + end if + end if + go to 70 + +80 strend=max(20,strend+1) + card(strend:strend)='''' + com1=max(32,strend+2) + end if + end if + end if + +C check if this was a request to modify a keyword name + if (hdtype .eq. -1)then + hdtype = -2 +C the keyword value is really the new keyword name +C return the new name in characters 41:48 of the output card + keynam=card(12:19) +C convert to upper case and test for illegal characters in name + call ftupch(keynam) + call fttkey(keynam,status) + if (status .gt. 0)then + card=inline(1:80) + go to 999 + else + card(9:80)=' ' + card(41:48)=keynam + go to 999 + end if + end if + +C is there room for a comment string? + if (com1 .lt. 79)then +C now look for the beginning of the comment string + i1=i2 +90 i1=i1+1 +C if no comment field then just quit + if (i1 .gt. 100)go to 999 + if (inline(i1:i1) .eq. ' ')go to 90 + +C append the comment field + if (inline(i1:i1) .eq. '/')then + card(com1:80)=inline(i1:) + else + card(com1:80)='/ '//inline(i1:) + end if + end if + + go to 999 + +C end of input file was detected +998 hdtype=2 + +999 continue + end diff --git a/pkg/tbtables/fitsio/ftgtkn.f b/pkg/tbtables/fitsio/ftgtkn.f new file mode 100644 index 00000000..83ddbac5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftgtkn.f @@ -0,0 +1,64 @@ +C-------------------------------------------------------------------------- + subroutine ftgtkn(iunit,nkey,keynam,ival,status) + +C test that keyword number NKEY has name = KEYNAM and get the +C integer value of the keyword. Return an error if the keyword +C name does not match the input KEYNAM, or if the value of the +C keyword is not a positive integer. +C +C iunit i Fortran I/O unit number +C nkey i sequence number of the keyword to test +C keynam c name that the keyword is supposed to have +C OUTPUT PARAMETERS: +C ival i returned value of the integer keyword +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 +C + integer iunit,nkey,status,ival + character*(*) keynam + character kname*8,value*30,comm*48,npos*8,keybuf*80 + + if (status .gt. 0)return + +C read the name and value of the keyword + call ftgrec(iunit,nkey,keybuf,status) + + kname=keybuf(1:8) +C parse the value and comment fields from the record + call ftpsvc(keybuf,value,comm,status) + + if (status .gt. 0)go to 900 + +C test if the keyword has the correct name + if (kname .ne. keynam)then + status=208 + go to 900 + end if + +C convert character string to integer + call ftc2ii(value,ival,status) + if (status .gt. 0 .or. ival .lt. 0 )then +C keyword value must be zero or positive integer + status=209 + end if + +900 continue + + if (status .gt. 0)then + write(npos,1000)nkey +1000 format(i8) + call ftpmsg('FTGTKN found unexpected keyword or value '// + & 'for header keyword number '//npos//'.') + call ftpmsg(' Was expecting positive integer keyword '// + & keynam(1:8)) + if (keybuf(9:10) .ne. '= ')then + call ftpmsg(' but found the keyword '//kname// + & ' with no value field (no "= " in cols. 9-10).') + else + call ftpmsg(' but instead found keyword = '//kname// + & ' with value = '//value) + end if + call ftpmsg(keybuf) + end if + end diff --git a/pkg/tbtables/fitsio/ftgttb.f b/pkg/tbtables/fitsio/ftgttb.f new file mode 100644 index 00000000..e675cc6a --- /dev/null +++ b/pkg/tbtables/fitsio/ftgttb.f @@ -0,0 +1,127 @@ +C---------------------------------------------------------------------- + subroutine ftgttb(iunit,ncols,nrows,nfield,status) + +C test that this is a legal ASCII table, and get some keywords +C +C iunit i Fortran i/o unit number +C OUTPUT PARAMETERS: +C ncols i number of columns in the table +C nrows i number of rows in the table +C nfield i number of fields in the table +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,ncols,nrows,nfield,status + character keynam*8,value*10,comm*8,keybuf*80 + + if (status .gt. 0)return + +C check for correct type of extension + call ftgrec(iunit,1,keybuf,status) + + keynam=keybuf(1:8) +C parse the value and comment fields from the record + call ftpsvc(keybuf,value,comm,status) + + if (status .gt. 0)go to 900 + + if (keynam .eq. 'XTENSION')then + if (value(2:9) .ne. 'TABLE ')then +C this is not a ASCII table extension + status=226 + call ftpmsg('Was expecting an ASCII table; instead got '// + & 'XTENSION= '//value) + call ftpmsg(keybuf) + go to 900 + end if + else + status=225 + call ftpmsg('First keyword of extension was not XTENSION:'// + & keynam) + call ftpmsg(keybuf) + go to 900 + end if + +C check that the second keyword is BITPIX = 8 + call fttkyn(iunit,2,'BITPIX','8',status) + if (status .eq. 208)then +C BITPIX keyword not found + status=222 + else if (status .eq. 209)then +C illegal value of BITPIX + status=211 + end if + if (status .gt. 0)go to 900 + +C check that the third keyword is NAXIS = 2 + call fttkyn(iunit,3,'NAXIS','2',status) + if (status .eq. 208)then +C NAXIS keyword not found + status=223 + else if (status .eq. 209)then +C illegal value of NAXIS + status=212 + end if + if (status .gt. 0)go to 900 + +C check that the 4th keyword is NAXIS1 and get it's value + call ftgtkn(iunit,4,'NAXIS1',ncols,status) + if (status .eq. 208)then +C NAXIS1 keyword not found + status=224 + else if (status .eq. 209)then +C illegal NAXIS1 value + status=213 + end if + if (status .gt. 0)go to 900 + +C check that the 5th keyword is NAXIS2 and get it's value + call ftgtkn(iunit,5,'NAXIS2',nrows,status) + if (status .eq. 208)then +C NAXIS2 keyword not found + status=224 + else if (status .eq. 209)then +C illegal NAXIS2 value + status=213 + end if + if (status .gt. 0)go to 900 + +C check that the 6th keyword is PCOUNT = 0 + call fttkyn(iunit,6,'PCOUNT','0',status) + if (status .eq. 208)then +C PCOUNT keyword not found + status=228 + else if (status .eq. 209)then +C illegal PCOUNT value + status=214 + end if + if (status .gt. 0)go to 900 + +C check that the 7th keyword is GCOUNT = 1 + call fttkyn(iunit,7,'GCOUNT','1',status) + if (status .eq. 208)then +C GCOUNT keyword not found + status=229 + else if (status .eq. 209)then +C illegal value of GCOUNT + status=215 + end if + if (status .gt. 0)go to 900 + +C check that the 8th keyword is TFIELDS + call ftgtkn(iunit,8,'TFIELDS',nfield,status) + if (status .eq. 208)then +C TFIELDS keyword not found + status=230 + else if (status .eq. 209)then +C illegal value of TFIELDS + status=216 + end if + +900 continue + if (status .gt. 0)then + call ftpmsg('Failed to parse the required keywords in '// + & 'the ASCII TABLE header (FTGTTB).') + end if + end diff --git a/pkg/tbtables/fitsio/fthdef.f b/pkg/tbtables/fitsio/fthdef.f new file mode 100644 index 00000000..2a0b5fe1 --- /dev/null +++ b/pkg/tbtables/fitsio/fthdef.f @@ -0,0 +1,40 @@ +C-------------------------------------------------------------------------- + subroutine fthdef(ounit,moreky,status) + +C Header DEFinition +C define the size of the current header unit; this simply lets +C us determine where the data unit will start +C +C ounit i Fortran I/O unit number +C moreky i number of additional keywords to reserve space for +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,moreky,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,mkeys + + if (status .gt. 0)return + +C based on the number of keywords which have already been written, +C plus the number of keywords to reserve space for, we then can +C define where the data unit should start (it must start at the +C beginning of a 2880-byte logical block). + + ibuff=bufnum(ounit) + + mkeys=max(moreky,0) + dtstrt(ibuff)=((hdend(ibuff)+mkeys*80)/2880+1)*2880 + end diff --git a/pkg/tbtables/fitsio/fthpdn.f b/pkg/tbtables/fitsio/fthpdn.f new file mode 100644 index 00000000..d95f092b --- /dev/null +++ b/pkg/tbtables/fitsio/fthpdn.f @@ -0,0 +1,92 @@ +C-------------------------------------------------------------------------- + subroutine fthpdn(ounit,nbytes,status) + +C shift the binary table heap down by nbyte bytes + +C ounit i fortran output unit number +C nbytes i number of bytes by which to move the heap +C status i returned error status (0=ok) + + integer ounit,nbytes,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer i,ibuff,ntodo,jpoint,nchar,tstat + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + + if (scount(ibuff) .gt. 0)then + ntodo=scount(ibuff) + +C set pointer to the end of the heap + jpoint=dtstrt(ibuff)+theap(ibuff)+scount(ibuff) + +10 nchar=min(ntodo,5760) + jpoint=jpoint-nchar + +C move to the read start position + call ftmbyt(ounit,jpoint,.false.,status) + +C read the heap + call ftgcbf(ounit,0,nchar,buff,status) + +C move forward to the write start postion + call ftmbyt(ounit,jpoint+nbytes,.true.,status) + +C write the heap + call ftpcbf(ounit,0,nchar,buff,status) + +C check for error + if (status .gt. 0)then + call ftpmsg('Error while moving heap down (FTDNHP)') + return + end if + +C check for more data in the heap + ntodo=ntodo-nchar + if (ntodo .gt. 0)go to 10 + +C now overwrite the old fill data with zeros + do 20 i=1,5760 + buff(i)=char(0) +20 continue + + jpoint=dtstrt(ibuff)+theap(ibuff) + call ftmbyt(ounit,jpoint,.false.,status) + + ntodo=nbytes +30 nchar=min(ntodo,5760) + call ftpcbf(ounit,0,nchar,buff,status) + ntodo=ntodo-nchar + if (ntodo .gt. 0)go to 30 + end if + +C update the heap starting address + theap(ibuff)=theap(ibuff)+nbytes + +C try updating the keyword value, if it exists + tstat=status + call ftmkyj(ounit,'THEAP',theap(ibuff),'&',status) + if (status .eq. 202)status=tstat + end diff --git a/pkg/tbtables/fitsio/fthpup.f b/pkg/tbtables/fitsio/fthpup.f new file mode 100644 index 00000000..6a1ac11a --- /dev/null +++ b/pkg/tbtables/fitsio/fthpup.f @@ -0,0 +1,92 @@ +C-------------------------------------------------------------------------- + subroutine fthpup(ounit,nbytes,status) + +C shift the binary table heap up by nbytes bytes + +C ounit i fortran output unit number +C nbytes i number of bytes by which to move the heap +C status i returned error status (0=ok) + + integer ounit,nbytes,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer i,ibuff,ntodo,jpoint,nchar,tstat + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + + if (scount(ibuff) .gt. 0)then + ntodo=scount(ibuff) + +C set pointer to the start of the heap + jpoint=dtstrt(ibuff)+theap(ibuff) + +10 nchar=min(ntodo,5760) + +C move to the read start position + call ftmbyt(ounit,jpoint,.false.,status) + +C read the heap + call ftgcbf(ounit,0,nchar,buff,status) + +C move back to the write start postion + call ftmbyt(ounit,jpoint-nbytes,.false.,status) + +C write the heap + call ftpcbf(ounit,0,nchar,buff,status) + +C check for error + if (status .gt. 0)then + call ftpmsg('Error while moving heap up (FTUPHP)') + return + end if + +C check for more data in the heap + ntodo=ntodo-nchar + jpoint=jpoint+nchar + if (ntodo .gt. 0)go to 10 + +C now overwrite the old fill data with zeros + do 20 i=1,5760 + buff(i)=char(0) +20 continue + + jpoint=dtstrt(ibuff)+theap(ibuff)+scount(ibuff)-nbytes + call ftmbyt(ounit,jpoint,.false.,status) + + ntodo=nbytes +30 nchar=min(ntodo,5760) + call ftpcbf(ounit,0,nchar,buff,status) + ntodo=ntodo-nchar + if (ntodo .gt. 0)go to 30 + end if + +C update the heap starting address + theap(ibuff)=theap(ibuff)-nbytes + +C try updating the keyword value, if it exists + tstat=status + call ftmkyj(ounit,'THEAP',theap(ibuff),'&',status) + if (status .eq. 202)status=tstat + end diff --git a/pkg/tbtables/fitsio/fti1i1.f b/pkg/tbtables/fitsio/fti1i1.f new file mode 100644 index 00000000..ba2f70a5 --- /dev/null +++ b/pkg/tbtables/fitsio/fti1i1.f @@ -0,0 +1,129 @@ +C---------------------------------------------------------------------- + subroutine fti1i1(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*1 values to output i*1 values, doing optional +C scaling and checking for null values + +C input c*1 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval c*1 value in the input array that is used to indicated nulls +C setval c*1 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output c*1 returned array of values +C status i output error status (0 = ok) + + character*1 input(*),chkval + character*1 output(*),setval + integer n,i,chktyp,status,itemp + double precision scale,zero,dval + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=(itemp-zero)/scale +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=itemp*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(int(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=itemp*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(int(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti1i2.f b/pkg/tbtables/fitsio/fti1i2.f new file mode 100644 index 00000000..b7a2df09 --- /dev/null +++ b/pkg/tbtables/fitsio/fti1i2.f @@ -0,0 +1,140 @@ +C---------------------------------------------------------------------- + subroutine fti1i2(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*1 values to output i*2 values, doing optional +C scaling and checking for null values + +C input c*1 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval c*1 value in the input array that is used to indicated nulls +C setval i*2 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i*2 returned array of values +C status i output error status (0 = ok) + + character*1 input(*),chkval + integer*2 output(*),setval,mini2,maxi2 + integer n,i,chktyp,status,itemp + double precision scale,zero,dval,i2max,i2min + logical tofits,flgray(*),anynul,noscal + + parameter (maxi2=32767) + parameter (mini2=-32768) + parameter (i2max=3.276749D+04) + parameter (i2min=-3.276849D+04) + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +10 continue + else + do 20 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=(itemp-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +30 continue + else + do 40 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=itemp*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=dval + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=itemp*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=dval + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti1i4.f b/pkg/tbtables/fitsio/fti1i4.f new file mode 100644 index 00000000..12b26153 --- /dev/null +++ b/pkg/tbtables/fitsio/fti1i4.f @@ -0,0 +1,141 @@ +C---------------------------------------------------------------------- + subroutine fti1i4(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*1 values to output i*4 values, doing optional +C scaling and checking for null values + +C input c*1 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval c*1 value in the input array that is used to indicated nulls +C setval i value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i returned array of values +C status i output error status (0 = ok) + + character*1 input(*),chkval + integer output(*),setval + integer n,i,chktyp,status,itemp + double precision scale,zero,dval,i4max,i4min + logical tofits,flgray(*),anynul,noscal + parameter (i4max=2.14748364749D+09) + parameter (i4min=-2.14748364849D+09) + integer maxi4,mini4 + parameter (maxi4=2147483647) +C work around for bug in the DEC Alpha VMS compiler + mini4=-2147483647 - 1 + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +10 continue + else + do 20 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=(itemp-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +30 continue + else + do 40 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=itemp*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=dval + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + dval=itemp*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=dval + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti1r4.f b/pkg/tbtables/fitsio/fti1r4.f new file mode 100644 index 00000000..a94cc551 --- /dev/null +++ b/pkg/tbtables/fitsio/fti1r4.f @@ -0,0 +1,104 @@ +C---------------------------------------------------------------------- + subroutine fti1r4(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*1 values to output r*4 values, doing optional +C scaling and checking for null values + +C input c*1 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval c*1 value in the input array that is used to indicated nulls +C setval r value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output r returned array of values + + character*1 input(*),chkval + real output(*),setval + integer n,i,chktyp,status,itemp + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +10 continue + else + do 20 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=(itemp-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +30 continue + else + do 40 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti1r8.f b/pkg/tbtables/fitsio/fti1r8.f new file mode 100644 index 00000000..7e0cdd5a --- /dev/null +++ b/pkg/tbtables/fitsio/fti1r8.f @@ -0,0 +1,104 @@ +C---------------------------------------------------------------------- + subroutine fti1r8(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*1 values to output r*8 values, doing optional +C scaling and checking for null values + +C input c*1 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval c*1 value in the input array that is used to indicated nulls +C setval d value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output d returned array of values + + character*1 input(*),chkval + double precision output(*),setval + integer n,i,chktyp,status,itemp + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +10 continue + else + do 20 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=(itemp-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp +30 continue + else + do 40 i=1,n + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + itemp=ichar(input(i)) + if (itemp .lt. 0)itemp=itemp+256 + output(i)=itemp*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti2c.f b/pkg/tbtables/fitsio/fti2c.f new file mode 100644 index 00000000..7ab4ac52 --- /dev/null +++ b/pkg/tbtables/fitsio/fti2c.f @@ -0,0 +1,15 @@ +C---------------------------------------------------------------------- + subroutine fti2c(ival,cval,status) +C convert an integer value to a C*20 character string, right justified + integer ival,status + character*20 cval + + if (status .gt. 0)return + + write(cval,1000,err=900)ival +1000 format(i20) + if (cval(1:1) .eq. '*')go to 900 + return +900 status=401 + call ftpmsg('Error in FTI2C converting integer to C*20 string.') + end diff --git a/pkg/tbtables/fitsio/fti2i1.f b/pkg/tbtables/fitsio/fti2i1.f new file mode 100644 index 00000000..6555f168 --- /dev/null +++ b/pkg/tbtables/fitsio/fti2i1.f @@ -0,0 +1,156 @@ +C---------------------------------------------------------------------- + subroutine fti2i1(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*2 values to output i*1 values, doing optional +C scaling and checking for null values + +C input i*2 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i*2 value in the input array that is used to indicated nulls +C setval c*1 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output c*1 returned array of values +C status i output error status (0 = ok) + + integer*2 input(*),chkval + character*1 output(*),setval + integer n,i,chktyp,itemp,status + double precision scale,zero,dval + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C have to use a temporary variable because of IBM mainframe + itemp=input(i) +C trap any values that overflow the I*1 range + if (itemp.le. 255 .and. itemp.ge. 0)then + output(i)=char(itemp) + else if (itemp .gt. 255)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C have to use a temporary variable because of IBM mainframe + itemp=input(i) +C trap any values that overflow the I*1 range + if (itemp.le. 255 .and. itemp.ge. 0)then + output(i)=char(itemp) + else if (itemp .gt. 255)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(int(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C have to use a temporary variable because of IBM mainframe + itemp=input(i) +C trap any values that overflow the I*1 range + if (itemp.le. 255 .and. itemp.ge. 0)then + output(i)=char(itemp) + else if (itemp .gt. 255)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(int(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti2i2.f b/pkg/tbtables/fitsio/fti2i2.f new file mode 100644 index 00000000..bab0b1a3 --- /dev/null +++ b/pkg/tbtables/fitsio/fti2i2.f @@ -0,0 +1,136 @@ +C---------------------------------------------------------------------- + subroutine fti2i2(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*2 values to output i*2 values, doing optional +C scaling and checking for null values + +C input i*2 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i*2 value in the input array that is used to indicated nulls +C setval i*2 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i*2 returned array of values +C status i output error status (0 = ok) + + integer*2 input(*),output(*),chkval,setval,j,mini2,maxi2 + integer n,i,chktyp,status + double precision scale,zero,dval,i2max,i2min + logical tofits,flgray(*),anynul,noscal + + parameter (maxi2=32767) + parameter (mini2=-32768) + parameter (i2max=3.276749D+04) + parameter (i2min=-3.276849D+04) + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits)then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C Have to use internal variable j to work around +C a bug in the Microsoft v5.0 compiler on IBM PCs + j=input(i) + output(i)=j +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C Have to use internal variable j to work around +C a bug in the Microsoft v5.0 compiler on IBM PCs + j=input(i) + output(i)=j +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=dval + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C Have to use internal variable j to work around +C a bug in the Microsoft v5.0 compiler on IBM PCs + j=input(i) + output(i)=j + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=dval + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti2i4.f b/pkg/tbtables/fitsio/fti2i4.f new file mode 100644 index 00000000..80bd1642 --- /dev/null +++ b/pkg/tbtables/fitsio/fti2i4.f @@ -0,0 +1,129 @@ +C---------------------------------------------------------------------- + subroutine fti2i4(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*2 values to output i*4 values, doing optional +C scaling and checking for null values + +C input i*2 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i*2 value in the input array that is used to indicated nulls +C setval i value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i returned array of values +C status i output error status (0 = ok) + + integer*2 input(*),chkval + integer output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval,i4max,i4min + logical tofits,flgray(*),anynul,noscal + parameter (i4max=2.14748364749D+09) + parameter (i4min=-2.14748364849D+09) + integer maxi4,mini4 + parameter (maxi4=2147483647) +C work around for bug in the DEC Alpha VMS compiler + mini4=-2147483647 - 1 + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=dval + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=dval + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti2r4.f b/pkg/tbtables/fitsio/fti2r4.f new file mode 100644 index 00000000..1c334358 --- /dev/null +++ b/pkg/tbtables/fitsio/fti2r4.f @@ -0,0 +1,92 @@ +C---------------------------------------------------------------------- + subroutine fti2r4(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*2 values to output r*4 values, doing optional +C scaling and checking for null values + +C input i*2 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i*2 value in the input array that is used to indicated nulls +C setval r value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output r returned array of values + + integer*2 input(*),chkval + real output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti2r8.f b/pkg/tbtables/fitsio/fti2r8.f new file mode 100644 index 00000000..98d17ed1 --- /dev/null +++ b/pkg/tbtables/fitsio/fti2r8.f @@ -0,0 +1,92 @@ +C---------------------------------------------------------------------- + subroutine fti2r8(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*2 values to output r*8 values, doing optional +C scaling and checking for null values + +C input i*2 input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i*2 value in the input array that is used to indicated nulls +C setval d value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output d returned array of values + + integer*2 input(*),chkval + double precision output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti4i1.f b/pkg/tbtables/fitsio/fti4i1.f new file mode 100644 index 00000000..2aef2654 --- /dev/null +++ b/pkg/tbtables/fitsio/fti4i1.f @@ -0,0 +1,151 @@ +C---------------------------------------------------------------------- + subroutine fti4i1(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*4 values to output i*1 values, doing optional +C scaling and checking for null values + +C input i input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i value in the input array that is used to indicated nulls +C setval c*1 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output c*1 returned array of values +C status i output error status (0 = ok) + + integer input(*),chkval + character*1 output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*1 range + if (input(i).le. 255 .and. input(i).ge. 0)then + output(i)=char(input(i)) + else if (input(i) .gt. 255)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*1 range + if (input(i).le. 255 .and. input(i).ge. 0)then + output(i)=char(input(i)) + else if (input(i) .gt. 255)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(int(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*1 range + if (input(i).le. 255 .and. + & input(i).ge. 0)then + output(i)=char(input(i)) + else if (input(i) .gt. 255)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(int(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti4i2.f b/pkg/tbtables/fitsio/fti4i2.f new file mode 100644 index 00000000..5d3b9873 --- /dev/null +++ b/pkg/tbtables/fitsio/fti4i2.f @@ -0,0 +1,157 @@ +C---------------------------------------------------------------------- + subroutine fti4i2(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*4 values to output i*2 values, doing optional +C scaling and checking for null values + +C input i input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i value in the input array that is used to indicated nulls +C setval i*2 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i*2 returned array of values +C status i output error status (0 = ok) + + integer input(*),chkval + integer*2 output(*),setval + integer n,i,chktyp,status,maxi2,mini2 + double precision scale,zero,dval,i2max,i2min + logical tofits,flgray(*),anynul,noscal + parameter (i2max=3.276749D+04) + parameter (i2min=-3.276849D+04) + parameter (maxi2=32767) + parameter (mini2=-32768) + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*2 range + if (input(i) .le. maxi2 .and. + & input(i) .ge. mini2)then + output(i)=input(i) + else if (input(i) .gt. maxi2)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*2 range + if (input(i) .le. maxi2 .and. + & input(i) .ge. mini2)then + output(i)=input(i) + else if (input(i) .gt. maxi2)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=dval + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*2 range + if (input(i) .le. maxi2 .and. + & input(i) .ge. mini2)then + output(i)=input(i) + else if (input(i) .gt. maxi2)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=dval + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti4i4.f b/pkg/tbtables/fitsio/fti4i4.f new file mode 100644 index 00000000..26807092 --- /dev/null +++ b/pkg/tbtables/fitsio/fti4i4.f @@ -0,0 +1,129 @@ +C---------------------------------------------------------------------- + subroutine fti4i4(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*4 values to output i*4 values, doing optional +C scaling and checking for null values + +C input i input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i value in the input array that is used to indicated nulls +C setval i value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i returned array of values +C status i output error status (0 = ok) + + integer input(*),chkval + integer output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval,i4max,i4min + logical tofits,flgray(*),anynul,noscal + parameter (i4max=2.14748364749D+09) + parameter (i4min=-2.14748364849D+09) + integer maxi4,mini4 + parameter (maxi4=2147483647) +C work around for bug in the DEC Alpha VMS compiler + mini4=-2147483647 - 1 + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=dval + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=dval + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti4r4.f b/pkg/tbtables/fitsio/fti4r4.f new file mode 100644 index 00000000..1b6a4291 --- /dev/null +++ b/pkg/tbtables/fitsio/fti4r4.f @@ -0,0 +1,92 @@ +C---------------------------------------------------------------------- + subroutine fti4r4(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*4 values to output r*4 values, doing optional +C scaling and checking for null values + +C input i input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i value in the input array that is used to indicated nulls +C setval r value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output r returned array of values + + integer input(*),chkval + real output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/fti4r8.f b/pkg/tbtables/fitsio/fti4r8.f new file mode 100644 index 00000000..62b1b76d --- /dev/null +++ b/pkg/tbtables/fitsio/fti4r8.f @@ -0,0 +1,92 @@ +C---------------------------------------------------------------------- + subroutine fti4r8(input,n,scale,zero,tofits, + & chktyp,chkval,setval,flgray,anynul,output,status) + +C copy input i*4 values to output r*8 values, doing optional +C scaling and checking for null values + +C input i input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C chkval i value in the input array that is used to indicated nulls +C setval d value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output d returned array of values + + integer input(*),chkval + double precision output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (input(i) .eq. chkval)then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftibin.f b/pkg/tbtables/fitsio/ftibin.f new file mode 100644 index 00000000..ad35abf3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftibin.f @@ -0,0 +1,108 @@ +C-------------------------------------------------------------------------- + subroutine ftibin(ounit,nrows,nfield,ttype,tform,tunit, + & extnam,pcount,status) + +C insert an binary table extension following the current HDU + +C ounit i fortran output unit number +C nrows i number of rows in the table +C nfield i number of fields in the table +C ttype c name of each field (array) (optional) +C tform c format of each field (array) +C tunit c units of each field (array) (optional) +C extnam c name of table extension (optional) +C pcount i size of special data area following the table (usually = 0) +C OUTPUT PARAMETERS: +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,nrows,nfield,pcount,status + character*(*) ttype(*),tform(*),tunit(*),extnam + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,nhdu,i,savstr,nblock,hsize,nkey + + if (status .gt. 0)return + ibuff=bufnum(ounit) + +C close the current HDU to make sure END and fill values are written + call ftchdu(ounit,status) + if (status .gt. 0)return + +C save the starting address of the next HDU + nhdu=chdu(ibuff)+1 + savstr=hdstrt(ibuff,nhdu) + +C count number of optional TUNITS keywords to be written + nkey=0 + do 5 i=1,nfield + if (tunit(i) .ne. ' ')nkey=nkey+1 +5 continue + if (extnam .ne. ' ')nkey=nkey+1 + +C calc min size of header + nblock=(9 + 2*nfield + nkey +35)/36 + hsize=nblock*2880 + +C define a fake CHDU with a minimum header + dtstrt(ibuff)=hdstrt(ibuff,chdu(ibuff))+hsize + +C define the size of the new HDU (this modifies hdstrt(ibuff,nhdu)) + call ftbdef(ounit,nfield,tform,pcount,nrows,status) + +C use start of next HDU to calc. how big this new HDU is + nblock=(hdstrt(ibuff,nhdu)-hdstrt(ibuff,nhdu-1))/2880 + +C reset the start of the next HDU back to it original value + hdstrt(ibuff,nhdu)=savstr + +C insert the required number of blocks at the end of the real CHDU +C (first define hdutyp so that the correct fill value will be used) + hdutyp(ibuff)=2 + call ftiblk(ounit,nblock,1,status) + if (status .gt. 0)return + +C increment the number of HDUs in the file and their starting address + maxhdu(ibuff)=maxhdu(ibuff)+1 + do 10 i=maxhdu(ibuff),nhdu,-1 + hdstrt(ibuff,i+1)=hdstrt(ibuff,i) +10 continue + +C again, reset the start of the next HDU back to it original value + hdstrt(ibuff,nhdu)=savstr + +C flush the buffers holding data for the old HDU + call ftflsh(ibuff,status) + +C recover common block space containing column descriptors for old HDU + call ftfrcl(ounit,status) + +C move to the new (empty) HDU + chdu(ibuff)=nhdu + +C set parameters describing an empty header + hdutyp(ibuff)=2 + nxthdr(ibuff)=hdstrt(ibuff,nhdu) + hdend(ibuff)= hdstrt(ibuff,nhdu) + dtstrt(ibuff)=hdstrt(ibuff,nhdu)+hsize + +C write the header keywords + call ftphbn(ounit,nrows,nfield,ttype,tform,tunit,extnam, + & pcount,status) + +C define the structure of the new HDU + call ftbdef(ounit,nfield,tform,pcount,nrows,status) + end diff --git a/pkg/tbtables/fitsio/ftiblk.f b/pkg/tbtables/fitsio/ftiblk.f new file mode 100644 index 00000000..9c61fd12 --- /dev/null +++ b/pkg/tbtables/fitsio/ftiblk.f @@ -0,0 +1,189 @@ +C-------------------------------------------------------------------------- + subroutine ftiblk(ounit,nblock,hdrdat,status) + +C insert a 2880-byte block at the end of the current header or data. + +C ounit i fortran output unit number +C nblock i number of blocks to insert +C hdrdat i insert space in header (0) or data (1) +C status i returned error status (0=ok) + + integer ounit,nblock,hdrdat,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 buff(2880,2) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,ipoint,jpoint,i,tstat,thdu,nshift,in,out,tin + character*1 cfill + + if (status .gt. 0)return + tstat=status + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + +C set the appropriate fill value + if (hdrdat .eq. 0 .or. hdutyp(ibuff) .eq. 1)then +C fill header or ASCII table with space + cfill=char(32) + else +C fill with Null (0) in image or bintable data area + cfill=char(0) + end if + +C find position in file to insert new block + if (hdrdat .eq. 0)then + ipoint=dtstrt(ibuff) + else + ipoint=hdstrt(ibuff,chdu(ibuff)+1) + end if + + + if (nblock .eq. 1 .and. hdrdat .eq. 0)then +C****************************************************************** +C Don't use this algoritm, even though it may be faster (but initial +C tests showed it didn't make any difference on a SUN) because it is +C less safe than the other more general algorithm. If there is +C not enough disk space available for the added block, this faster +C algorithm won't fail until it tries to move the last block, thus leaving +C the FITS file in a corrupted state. The other more general +C algorithm tries to add a new empty block to the file as the +C first step. If this fails, it still leaves the current FITS +C file unmodified, which is better for the user. +C****************************************************************** +C (Note added later:) +C Will use this algorithm anyway when inserting one block in a FITS +C header because the more general algorithm results in a status=252 error +C in cases where the number of rows in a table has not yet been defined +C****************************************************************** +C use this more efficient algorithm if just adding a single block +C initialize the first buffer + do 5 i=1,2880 + buff(i,1)=cfill +5 continue + + in=2 + out=1 + +C move to the read start position +10 call ftmbyt(ounit,ipoint,.false.,status) + +C read one 2880-byte FITS logical record into the input buffer + call ftgcbf(ounit,0,2880,buff(1,in),status) + +C check for End-Of-File + if (status .eq. 107)go to 20 + +C move back to the write start postion + call ftmbyt(ounit,ipoint,.false.,status) + +C write the 2880-byte FITS logical record stored in the output buffer + call ftpcbf(ounit,0,2880,buff(1,out),status) + +C check for error during write (the file may not have write access) + if (status .gt. 0)return + +C swap the input and output buffer pointers and move to next block + tin=in + in=out + out=tin + ipoint=ipoint+2880 + +C now repeat the process until we reach the End-Of-File + go to 10 + +C we have reached the end of file; now append the last block +20 status=tstat + +C move back to the write start postion + call ftmbyt(ounit,ipoint,.true.,status) + +C write the 2880-byte FITS logical record stored in the output buffer + call ftpcbf(ounit,0,2880,buff(1,out),status) + + else +C use this general algorithm for adding arbitrary number of blocks + +C first, find the end of file + thdu=chdu(ibuff) + +30 call ftmahd(ounit,maxhdu(ibuff)+1,i,status) + + if (status .eq. 107)then + status=tstat +C move back to the current extension + call ftmahd(ounit,thdu,i,status) + go to 100 + else if (status .le. 0)then + go to 30 + else + call ftpmsg('Error while seeking End of File (FTIBLK)') + return + end if + +C calculate number of 2880-byte blocks that have to be shifted down +100 continue + nshift=(hdstrt(ibuff,maxhdu(ibuff)+1)-ipoint)/2880 + jpoint=hdstrt(ibuff,maxhdu(ibuff)+1)-2880 + +C move all the blocks, one at a time, starting at end of file and +C working back to the insert position + do 110 i=1,nshift + +C move to the read start position + call ftmbyt(ounit,jpoint,.false.,status) + +C read one 2880-byte FITS logical record + call ftgcbf(ounit,0,2880,buff,status) + +C move forward to the write start postion + call ftmbyt(ounit,jpoint+nblock*2880,.true.,status) + +C write the 2880-byte FITS logical record + call ftpcbf(ounit,0,2880,buff,status) + +C check for error + if (status .gt. 0)then + call ftpmsg('Error inserting empty FITS block(s) '// + & '(FTIBLK)') + return + end if + jpoint=jpoint-2880 +110 continue + + do 120 i=1,2880 + buff(i,1)=cfill +120 continue + +C move back to the write start postion + call ftmbyt(ounit,ipoint,.true.,status) + + do 130 i=1,nblock +C write the 2880-byte FITS logical record + call ftpcbf(ounit,0,2880,buff,status) +130 continue + end if + + if (hdrdat .eq. 0)then +C recalculate the starting location of the current data unit + dtstrt(ibuff)=dtstrt(ibuff)+2880*nblock + end if + +C recalculate the starting location of all subsequent HDUs + do 140 i=chdu(ibuff)+1,maxhdu(ibuff)+1 + hdstrt(ibuff,i)=hdstrt(ibuff,i)+2880*nblock +140 continue + if (status .gt. 0)then + call ftpmsg('Error inserting FITS block(s) (FTIBLK)') + end if + end diff --git a/pkg/tbtables/fitsio/fticol.f b/pkg/tbtables/fitsio/fticol.f new file mode 100644 index 00000000..33582ea9 --- /dev/null +++ b/pkg/tbtables/fitsio/fticol.f @@ -0,0 +1,154 @@ +C-------------------------------------------------------------------------- + subroutine fticol(iunit,numcol,ttype,tform,status) + +C insert a new column into an existing table + +C iunit i Fortran I/O unit number +C numcol i number (position) for the new column; 1 = first column +C any existing columns will be moved up one position +C ttype c name of column (value for TTYPEn keyword) +C tform c column format (value for TFORMn keyword) +C status i returned error status (0=ok) + + integer iunit,numcol,status + character*(*) ttype,tform + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,colnum,typhdu,datcod,repeat,width,decims,delbyt + integer naxis1,naxis2,size,freesp,nblock,tflds,tbc,fstbyt,i + character comm*70,tfm*30,keynam*8 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C test that the CHDU is an ASCII table or BINTABLE + typhdu=hdutyp(ibuff) + if (typhdu .ne. 1 .and. typhdu .ne. 2)then + status=235 + call ftpmsg('Can only append column to TABLE or '// + & 'BINTABLE extension (FTICOL)') + return + end if + +C check that the column number is valid + tflds=tfield(ibuff) + if (numcol .lt. 1)then + status=302 + return + else if (numcol .gt. tflds)then + colnum=tflds+1 + else + colnum=numcol + end if + +C parse the tform value and calc number of bytes to add to each row +C make sure format characters are in upper case: + tfm=tform + call ftupch(tfm) + + if (typhdu .eq. 1)then + call ftasfm(tfm,datcod,width,decims,status) +C add one space between the columns + delbyt=width+1 + else + call ftbnfm(tfm,datcod,repeat,width,status) + if (datcod .eq. 1)then +C bit column; round up to a multiple of 8 bits + delbyt=(repeat+7)/8 + else if (datcod .eq. 16)then +C ASCII string column + delbyt=repeat + else +C numerical data type + delbyt=(datcod/10)*repeat + end if + end if + +C quit on error, or if column is zero byte wide (repeat=0) + if (status .gt. 0 .or. delbyt .eq. 0)return + +C get current size of the table + naxis1=rowlen(ibuff) + call ftgkyj(iunit,'NAXIS2',naxis2,comm,status) + +C Calculate how many more FITS blocks (2880 bytes) need to be added + size=theap(ibuff)+scount(ibuff) + freesp=(delbyt*naxis2) - ((size+2879)/2880)*2880 + size + nblock=(freesp+2879)/2880 + +C insert the needed number of new FITS blocks at the end of the HDU + if (nblock .gt. 0)call ftiblk(iunit,nblock,1,status) + +C shift the heap down, and update pointers to start of heap + size=delbyt*naxis2 + call fthpdn(iunit,size,status) + +C calculate byte position in the row where to insert the new column + if (colnum .gt. tflds)then + fstbyt=naxis1 + else + fstbyt=tbcol(colnum+tstart(ibuff)) + end if + +C insert DELBYT bytes in every row, at byte position FSTBYT + call ftcins(iunit,naxis1,naxis2,delbyt,fstbyt,status) + + if (typhdu .eq. 1)then +C adjust the TBCOL values of the existing columns + do 10 i=1,tflds + call ftkeyn('TBCOL',i,keynam,status) + call ftgkyj(iunit,keynam,tbc,comm,status) + if (tbc .gt. fstbyt)then + tbc=tbc+delbyt + call ftmkyj(iunit,keynam,tbc,'&',status) + end if +10 continue + end if + +C update the mandatory keywords + call ftmkyj(iunit,'TFIELDS',tflds+1,'&',status) + call ftmkyj(iunit,'NAXIS1',naxis1+delbyt,'&',status) + +C increment the index value on any existing column keywords + call ftkshf(iunit,colnum,tflds,1,status) + +C add the required keywords for the new column + comm='label for field' + call ftpkns(iunit,'TTYPE',colnum,1,ttype,comm,status) + + comm='format of field' + call ftpkns(iunit,'TFORM',colnum,1,tfm,comm,status) + + if (typhdu .eq. 1)then + comm='beginning column of field ' + if (colnum .eq. tflds+1)then +C allow for the space between preceding column + tbc=fstbyt+2 + else + tbc=fstbyt+1 + end if + call ftpknj(iunit,'TBCOL',colnum,1,tbc,comm,status) + end if + +C parse the header to initialize the new table structure + call ftrdef(iunit,status) + end diff --git a/pkg/tbtables/fitsio/ftiimg.f b/pkg/tbtables/fitsio/ftiimg.f new file mode 100644 index 00000000..b8952d76 --- /dev/null +++ b/pkg/tbtables/fitsio/ftiimg.f @@ -0,0 +1,87 @@ +C-------------------------------------------------------------------------- + subroutine ftiimg(ounit,bitpix,naxis,naxes,status) + +C insert an IMAGE extension following the current HDU + +C ounit i fortran output unit number +C bitpix i number of bits per data value +C naxis i number of axes in the data array +C naxes i array giving the length of each data axis +C status i returned error status (0=ok) + + integer ounit,bitpix,naxis,naxes(*),status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,nhdu,i,savstr,nblock + + if (status .gt. 0)return + ibuff=bufnum(ounit) + +C close the current HDU to make sure END and fill values are written + call ftchdu(ounit,status) + if (status .gt. 0)return + +C save the starting address of the next HDU + nhdu=chdu(ibuff)+1 + savstr=hdstrt(ibuff,nhdu) + +C define a fake CHDU with a one block header + dtstrt(ibuff)=hdstrt(ibuff,chdu(ibuff))+2880 + +C define the size of the new HDU (this modifies hdstrt(ibuff,nhdu)) + call ftpdef(ounit,bitpix,naxis,naxes,0,1,status) + +C use start of next HDU to calc. how big this new HDU is + nblock=(hdstrt(ibuff,nhdu)-hdstrt(ibuff,nhdu-1))/2880 + +C reset the start of the next HDU back to it original value + hdstrt(ibuff,nhdu)=savstr + +C insert the required number of blocks at the end of the real CHDU +C (first define hdutyp so that the correct fill value will be used) + hdutyp(ibuff)=0 + call ftiblk(ounit,nblock,1,status) + if (status .gt. 0)return + +C increment the number of HDUs in the file and their starting address + maxhdu(ibuff)=maxhdu(ibuff)+1 + do 10 i=maxhdu(ibuff),nhdu,-1 + hdstrt(ibuff,i+1)=hdstrt(ibuff,i) +10 continue + +C again, reset the start of the next HDU back to it original value + hdstrt(ibuff,nhdu)=savstr + +C flush the buffers holding data for the old HDU + call ftflsh(ibuff,status) + +C recover common block space containing column descriptors for old HDU + call ftfrcl(ounit,status) + +C move to the new (empty) HDU + chdu(ibuff)=nhdu + +C set parameters describing an empty 1 block header + hdutyp(ibuff)=0 + nxthdr(ibuff)=hdstrt(ibuff,nhdu) + hdend(ibuff)= hdstrt(ibuff,nhdu) + dtstrt(ibuff)=hdstrt(ibuff,nhdu)+2888 + +C write the header keywords + call ftphpr(ounit,.true.,bitpix,naxis,naxes,0,1,.true.,status) + +C define the structure of the new HDU + call ftpdef(ounit,bitpix,naxis,naxes,0,1,status) + end diff --git a/pkg/tbtables/fitsio/ftikyd.f b/pkg/tbtables/fitsio/ftikyd.f new file mode 100644 index 00000000..b1d8940f --- /dev/null +++ b/pkg/tbtables/fitsio/ftikyd.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftikyd(ounit,keywrd,dval,decim,comm,status) + +C insert a double E keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 + + character*(*) keywrd,comm + integer ounit,status,decim + double precision dval + + character value*35,key*8,com*47 + character*80 record + integer nkeys,keypos,vlen + + if (status .gt. 0)return + +C convert double to F format character string and construct the record + call ftd2e(dval,decim,value,vlen,status) + key=keywrd + com=comm + record=key//'= '//value(1:vlen)//' / '//com + + call ftghps(ounit,nkeys,keypos,status) + call ftirec(ounit,keypos,record,status) + end diff --git a/pkg/tbtables/fitsio/ftikye.f b/pkg/tbtables/fitsio/ftikye.f new file mode 100644 index 00000000..dfdf5ab3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftikye.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftikye(ounit,keywrd,rval,decim,comm,status) + +C insert a real*4 E keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 + + character*(*) keywrd,comm + integer ounit,status,decim + real rval + + character value*20,key*8,com*47 + character*80 record + integer nkeys,keypos + + if (status .gt. 0)return + +C convert real to F format character string and construct the full record + call ftr2e(rval,decim,value,status) + key=keywrd + com=comm + record=key//'= '//value//' / '//com + + call ftghps(ounit,nkeys,keypos,status) + call ftirec(ounit,keypos,record,status) + end diff --git a/pkg/tbtables/fitsio/ftikyf.f b/pkg/tbtables/fitsio/ftikyf.f new file mode 100644 index 00000000..a587b37c --- /dev/null +++ b/pkg/tbtables/fitsio/ftikyf.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftikyf(ounit,keywrd,rval,decim,comm,status) + +C insert a real*4 F keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 + + character*(*) keywrd,comm + integer ounit,status,decim + real rval + + character value*20,key*8,com*47 + character*80 record + integer nkeys,keypos + + if (status .gt. 0)return + +C convert real to F format character string and construct the full record + call ftr2f(rval,decim,value,status) + key=keywrd + com=comm + record=key//'= '//value//' / '//com + + call ftghps(ounit,nkeys,keypos,status) + call ftirec(ounit,keypos,record,status) + end diff --git a/pkg/tbtables/fitsio/ftikyg.f b/pkg/tbtables/fitsio/ftikyg.f new file mode 100644 index 00000000..7c448066 --- /dev/null +++ b/pkg/tbtables/fitsio/ftikyg.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftikyg(ounit,keywrd,dval,decim,comm,status) + +C insert a double F keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 + + character*(*) keywrd,comm + integer ounit,status,decim + double precision dval + + character value*20,key*8,com*47 + character*80 record + integer nkeys,keypos + + if (status .gt. 0)return + +C convert double to F format character string and construct the record + call ftd2f(dval,decim,value,status) + key=keywrd + com=comm + record=key//'= '//value//' / '//com + + call ftghps(ounit,nkeys,keypos,status) + call ftirec(ounit,keypos,record,status) + end diff --git a/pkg/tbtables/fitsio/ftikyj.f b/pkg/tbtables/fitsio/ftikyj.f new file mode 100644 index 00000000..0dd2d23b --- /dev/null +++ b/pkg/tbtables/fitsio/ftikyj.f @@ -0,0 +1,32 @@ +C-------------------------------------------------------------------------- + subroutine ftikyj(ounit,keywrd,intval,comm,status) + +C insert an integer keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C intval i keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 + + character*(*) keywrd,comm + integer ounit,status,intval + + character value*20,key*8,com*47 + character*80 record + integer nkeys,keypos + + if (status .gt. 0)return + +C convert integer to character string and construct the full record + call fti2c(intval,value,status) + key=keywrd + com=comm + record=key//'= '//value//' / '//com + + call ftghps(ounit,nkeys,keypos,status) + call ftirec(ounit,keypos,record,status) + end diff --git a/pkg/tbtables/fitsio/ftikyl.f b/pkg/tbtables/fitsio/ftikyl.f new file mode 100644 index 00000000..22b48d4b --- /dev/null +++ b/pkg/tbtables/fitsio/ftikyl.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftikyl(ounit,keywrd,logval,comm,status) + +C insert a logical keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C logval l keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 + + character*(*) keywrd,comm + integer ounit,status + logical logval + + character value*20,key*8,com*47 + character*80 record + integer nkeys,keypos + + if (status .gt. 0)return + +C convert logical to character string and construct the full record + call ftl2c(logval,value,status) + key=keywrd + com=comm + record=key//'= '//value//' / '//com + + call ftghps(ounit,nkeys,keypos,status) + call ftirec(ounit,keypos,record,status) + end diff --git a/pkg/tbtables/fitsio/ftikys.f b/pkg/tbtables/fitsio/ftikys.f new file mode 100644 index 00000000..7247cd2f --- /dev/null +++ b/pkg/tbtables/fitsio/ftikys.f @@ -0,0 +1,71 @@ +C-------------------------------------------------------------------------- + subroutine ftikys(ounit,keywrd,strval,comm,status) + +C insert a string keyword into the header at the current position +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C strval c keyword value +C comm c keyword comment +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, March 1993 +C Modifed 9/94 to call FTPKLS, supporting the OGIP long string convention + + character*(*) keywrd,comm,strval + integer ounit,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + integer lenval,length,i,nspace,ibuff,nexthd,endhd,nkeys,keypos + + if (status .gt. 0)return + +C find how many keywords are required to write the string, in case it +C cannot fit onto one keyword and has to be continued on multiple lines. + + lenval=len(strval) + length=0 + do 10 i=lenval,1,-1 + if (strval(i:i) .ne. ' ')then + length=i + go to 20 + end if +10 continue +20 nspace=max(1,(length-2)/67+1) + +C save current pointer values + ibuff=bufnum(ounit) + endhd=hdend(ibuff) + nexthd=nxthdr(ibuff) + +C insert enough spaces in the header at the current location + call ftghps(ounit,nkeys,keypos,status) + + do 30 i=1,nspace + call ftirec(ounit,keypos,' ',status) +30 continue + +C temporarily reset position of the end of header to force keyword +C to be written at the current header position. + hdend(ibuff)=nexthd + +C write the keyword (supporting the OGIP long string convention) + call ftpkls(ounit,keywrd,strval,comm,status) + +C reset the next keyword pointer to follow the inserted keyword + nxthdr(ibuff)=nexthd+80*nspace + +C reset the end-of-header pointer to its real location + hdend(ibuff)=endhd+80*nspace + end diff --git a/pkg/tbtables/fitsio/ftinit.f b/pkg/tbtables/fitsio/ftinit.f new file mode 100644 index 00000000..712638f9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftinit.f @@ -0,0 +1,43 @@ +C-------------------------------------------------------------------------- + subroutine ftinit(funit,fname,block,status) + +C open a new FITS file with write access +C +C funit i Fortran I/O unit number +C fname c name of file to be opened +C block i input record length blocking factor +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer funit,status,block,strlen,i + character*(*) fname + + if (status .gt. 0)return + +C ignore any leading blanks in the file name + strlen=len(fname) + do 10 i=1,strlen + if (fname(i:i) .ne. ' ')then + +C call the machine dependent routine which creates the file + call ftopnx(funit,fname(i:),1,1,block,status) + if (status .gt. 0)then + call ftpmsg('FTINIT failed to create the following new file:') + call ftpmsg(fname) + return + end if + +C set column descriptors as undefined + call ftfrcl(funit,-999) + +C set current column name buffer as undefined + call ftrsnm + return + end if +10 continue + +C if we got here, then the input filename was all blanks + status=105 + call ftpmsg('FTINIT: Name of file to create is blank.') + end diff --git a/pkg/tbtables/fitsio/ftirec.f b/pkg/tbtables/fitsio/ftirec.f new file mode 100644 index 00000000..a3c47d85 --- /dev/null +++ b/pkg/tbtables/fitsio/ftirec.f @@ -0,0 +1,72 @@ +C-------------------------------------------------------------------------- + subroutine ftirec(ounit,pos,record,status) + +C insert a 80-char keyword record into the header at the pos-th keyword +C position (i.e., immediately before the current keyword at position POS. +C +C ounit i fortran output unit number +C pos i keyword will be inserted at this position (1 = 1st keyword) +C record c*80 keyword record +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Jan 1995 + + character*(*) record + integer ounit,pos,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + character*80 outrec, inrec + integer ibuff, fkey, lkey, i, nexthd, nkey + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + +C calculate number of existing keywords + nkey=(hdend(ibuff)-hdstrt(ibuff,chdu(ibuff)))/80 + + if (pos .eq. nkey+1)then +C simply append the record to the header + call ftprec(ounit,record,status) + return + else if (pos .lt. 1 .or. pos .gt. nkey)then + status=203 + return + end if + + outrec=record + +C move to the insert position + nexthd=hdstrt(ibuff,chdu(ibuff))+(pos-1)*80 + call ftmbyt(ounit,nexthd,.false.,status) + nxthdr(ibuff)=nexthd + +C calculated the first and last keyword to be rewritten + fkey=pos + lkey=fkey + (hdend(ibuff)-nexthd)/80 - 1 + +C now sequentially read each keyword and overwrite it with the previous + do 10 i=fkey,lkey + call ftgrec(ounit,i,inrec,status) + call ftmodr(ounit,outrec,status) + outrec=inrec +10 continue + +C finally, write the last keyword + call ftprec(ounit,outrec,status) + +C reset the next keyword pointer to follow the inserted keyword + nxthdr(ibuff)=nexthd+80 + end diff --git a/pkg/tbtables/fitsio/ftirow.f b/pkg/tbtables/fitsio/ftirow.f new file mode 100644 index 00000000..66ef08e9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftirow.f @@ -0,0 +1,92 @@ +C-------------------------------------------------------------------------- + subroutine ftirow(iunit,frow,nrows,status) + +C insert NROWS blank rows immediated after row FROW + +C iunit i Fortran I/O unit number +C frow i row number after which the new rows will be inserted. +C Specify 0 to add rows to the beginning of the table. +C nrows i number of rows to add to the table (must be greater than 0) +C status i returned error status (0=ok) + + integer iunit,frow,nrows,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,naxis1,naxis2,size,freesp,nblock + character comm*8 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C test that the CHDU is an ASCII table or BINTABLE + if (hdutyp(ibuff) .ne. 1 .and. hdutyp(ibuff) .ne. 2)then + status=235 + call ftpmsg('Can only add rows to TABLE or BINTABLE '// + & 'extension (FTIROW)') + return + end if + + if (nrows .lt. 0)then + status=306 + call ftpmsg('Cannot insert negative number of ' // + & 'rows in the table (FTIROW)') + return + else if (nrows .eq. 0)then + return + end if + +C get current size of the table + call ftgkyj(iunit,'NAXIS1',naxis1,comm,status) + call ftgkyj(iunit,'NAXIS2',naxis2,comm,status) + + if (frow .gt. naxis2)then + status=307 + call ftpmsg('Insert position is greater than the '// + & 'number of rows in the table (FTIROW)') + return + else if (frow .lt. 0)then + status=307 + call ftpmsg('Insert starting row number is less than 0' + & //' (FTIROW)') + return + end if + +C Calculate how many more FITS blocks (2880 bytes) need to be added + size=theap(ibuff)+scount(ibuff) + freesp=((size+2879)/2880)*2880 - size + size=naxis1*nrows-freesp + nblock=(size+2879)/2880 + +C insert the needed number of new FITS blocks + if (nblock .gt. 0)call ftiblk(iunit,nblock,1,status) + +C shift the heap down, and update pointers to start of heap + size=naxis1*nrows + call fthpdn(iunit,size,status) + +C shift the rows down + call ftrwdn(iunit,frow,naxis2,nrows,status) + +C update the NAXIS2 keyword + naxis2=naxis2+nrows + call ftmkyj(iunit,'NAXIS2',naxis2,'&',status) + end diff --git a/pkg/tbtables/fitsio/ftitab.f b/pkg/tbtables/fitsio/ftitab.f new file mode 100644 index 00000000..18e209cf --- /dev/null +++ b/pkg/tbtables/fitsio/ftitab.f @@ -0,0 +1,108 @@ +C-------------------------------------------------------------------------- + subroutine ftitab(ounit,rowlen,nrows,nfield,ttype,tbcol, + & tform,tunit,extnam,status) + +C insert an ASCII table extension following the current HDU + +C ounit i fortran output unit number +C rowlen i width of a row, in characters +C nrows i number of rows in the table +C nfield i number of fields in the table +C ttype c name of each field (array) (optional) +C tform c format of each field (array) +C tunit c units of each field (array) (optional) +C extnam c name of table extension (optional) +C OUTPUT PARAMETERS: +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,rowlen,nrows,nfield,tbcol(*),status + character*(*) ttype(*),tform(*),tunit(*),extnam + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS:------------------------------------ + + integer ibuff,nhdu,i,savstr,nblock,hsize,nkey + + if (status .gt. 0)return + ibuff=bufnum(ounit) + +C close the current HDU to make sure END and fill values are written + call ftchdu(ounit,status) + if (status .gt. 0)return + +C save the starting address of the next HDU + nhdu=chdu(ibuff)+1 + savstr=hdstrt(ibuff,nhdu) + +C count number of optional TUNITS keywords to be written + nkey=0 + do 5 i=1,nfield + if (tunit(i) .ne. ' ')nkey=nkey+1 +5 continue + if (extnam .ne. ' ')nkey=nkey+1 + +C calc min size of header + nblock=(9 + 3*nfield + nkey +35)/36 + hsize=nblock*2880 + +C define a fake CHDU with minimum header + dtstrt(ibuff)=hdstrt(ibuff,chdu(ibuff))+hsize + +C define the size of the new HDU (this modifies hdstrt(ibuff,nhdu)) + call ftadef(ounit,rowlen,nfield,tbcol,tform,nrows,status) + +C use start of next HDU to calc. how big this new HDU is + nblock=(hdstrt(ibuff,nhdu)-hdstrt(ibuff,nhdu-1))/2880 + +C reset the start of the next HDU back to it original value + hdstrt(ibuff,nhdu)=savstr + +C insert the required number of blocks at the end of the real CHDU +C (first define hdutyp so that the correct fill value will be used) + hdutyp(ibuff)=1 + call ftiblk(ounit,nblock,1,status) + if (status .gt. 0)return + +C increment the number of HDUs in the file and their starting address + maxhdu(ibuff)=maxhdu(ibuff)+1 + do 10 i=maxhdu(ibuff),nhdu,-1 + hdstrt(ibuff,i+1)=hdstrt(ibuff,i) +10 continue + +C again, reset the start of the next HDU back to it original value + hdstrt(ibuff,nhdu)=savstr + +C flush the buffers holding data for the old HDU + call ftflsh(ibuff,status) + +C recover common block space containing column descriptors for old HDU + call ftfrcl(ounit,status) + +C move to the new (empty) HDU + chdu(ibuff)=nhdu + +C set parameters describing an empty header + hdutyp(ibuff)=1 + nxthdr(ibuff)=hdstrt(ibuff,nhdu) + hdend(ibuff)= hdstrt(ibuff,nhdu) + dtstrt(ibuff)=hdstrt(ibuff,nhdu)+hsize + +C write the header keywords + call ftphtb(ounit,rowlen,nrows,nfield,ttype,tbcol,tform,tunit, + & extnam,status) + +C define the structure of the new HDU + call ftadef(ounit,rowlen,nfield,tbcol,tform,nrows,status) + end diff --git a/pkg/tbtables/fitsio/ftkeyn.f b/pkg/tbtables/fitsio/ftkeyn.f new file mode 100644 index 00000000..8f020b94 --- /dev/null +++ b/pkg/tbtables/fitsio/ftkeyn.f @@ -0,0 +1,70 @@ +C-------------------------------------------------------------------------- + subroutine ftkeyn(keywrd,nseq,keyout,status) + +C Make a keyword name by concatinating the root name and a +C sequence number + +C keywrd c root keyword name +C nseq i sequence number +C OUTPUT PARAMETERS: +C keyout c output concatinated keyword name +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, February 1991 + + character*(*) keywrd + integer nseq,status,nspace,i + character keyout*8,value*20 + + keyout=keywrd + +C find end of keyword string + nspace=1 + do 10 i=1,8 + if (keyout(i:i) .eq. ' ')go to 15 + nspace=nspace+1 +10 continue +15 continue + +C append sequence number to keyword root only if there is room + if (nseq .lt. 0)then +C illegal value + go to 900 + else if (nseq .lt. 10 .and. nspace .le. 8)then + write(keyout(nspace:nspace),1001,err=900)nseq + else if (nseq .lt. 100 .and. nspace .le. 7)then + write(keyout(nspace:nspace+1),1002,err=900)nseq + else if (nseq .lt. 1000 .and. nspace .le. 6)then + write(keyout(nspace:nspace+2),1003,err=900)nseq + else if (nseq .lt. 10000 .and. nspace .le. 5)then + write(keyout(nspace:nspace+3),1004,err=900)nseq + else if (nseq .lt. 100000 .and. nspace .le. 4)then + write(keyout(nspace:nspace+4),1005,err=900)nseq + else if (nseq .lt. 1000000 .and. nspace .le. 3)then + write(keyout(nspace:nspace+5),1006,err=900)nseq + else if (nseq .lt. 10000000 .and. nspace .le. 2)then + write(keyout(nspace:nspace+6),1007,err=900)nseq + else +C number too big to fit in keyword + go to 900 + end if + +1001 format(i1) +1002 format(i2) +1003 format(i3) +1004 format(i4) +1005 format(i5) +1006 format(i6) +1007 format(i7) + + return +C come here if error concatinating the seq. no. to the root string +900 continue + + if (status .gt. 0)return + status=206 + write(value,1008)nseq +1008 format(i20) + call ftpmsg('Could not concatinate the integer '//value// + & ' to the root keyword named: '//keyout) + end diff --git a/pkg/tbtables/fitsio/ftkshf.f b/pkg/tbtables/fitsio/ftkshf.f new file mode 100644 index 00000000..2e40aef8 --- /dev/null +++ b/pkg/tbtables/fitsio/ftkshf.f @@ -0,0 +1,118 @@ +C-------------------------------------------------------------------------- + subroutine ftkshf(iunit,colmin,colmax,incre,status) + +C shift the index value on any existing column keywords +C This routine will modify the name of any keyword that begins with 'T' +C and has an index number in the range COLMIN - COLMAX, inclusive. + +C if incre is positive, then the index values will be incremented. +C if incre is negative, then the kewords with index = COLMIN +C will be deleted and the index of higher numbered keywords will +C be decremented. + +C iunit i Fortran I/O unit number +C colmin i starting column number to be incremented +C colmax i maximum column number to be increment +C incre i amount by which the index value should be shifted +C status i returned error status (0=ok) + + integer iunit,colmin,colmax,incre,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,typhdu,tflds,nkeys,nmore,nrec,ival,tstat,i1 + character rec*80,newkey*8,q*4 + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C test that the CHDU is an ASCII table or BINTABLE + typhdu=hdutyp(ibuff) + if (typhdu .ne. 1 .and. typhdu .ne. 2)then + status=235 + call ftpmsg('Can only operate on TABLE or '// + & 'BINTABLE extension (FTKSHF)') + return + end if + +C test column number limits + tflds=tfield(ibuff) + if (colmin .lt. 1 .or. colmax .lt. 1)then + status=302 + return + else if (colmin .gt. colmax .or. colmin .gt. tflds)then + return + end if + +C get the number of keywords in the header + call ftghsp(iunit,nkeys,nmore,status) + +C go thru header starting with the 9th keyword looking for 'TxxxxNNN' + + nrec=9 +100 call ftgrec(iunit,nrec,rec,status) + + if (rec(1:1) .eq. 'T')then + q=rec(2:5) + i1=6 + +C search list of 5-character 'official' indexed keywords + if ( q .eq. 'BCOL' .or. q .eq. 'FORM' .or. q .eq. 'TYPE' + & .or. q .eq. 'UNIT' .or. q .eq. 'NULL' .or. q .eq. 'SCAL' + & .or. q .eq. 'ZERO' .or. q .eq. 'DISP')go to 20 + +C search list of 5-character 'local' indexed keywords + if ( q .eq. 'LMIN' .or. q .eq. 'LMAX' .or. q .eq. 'DMIN' + & .or. q .eq. 'DMAX' .or. q .eq. 'CTYP' .or. q .eq. 'CRPX' + & .or. q .eq. 'CRVL' .or. q .eq. 'CDLT' .or. q .eq. 'CROT' + & .or. q .eq. 'CUNI')go to 20 + + q=rec(1:4) + i1=5 +C search list of 4-character 'official' indexed keywords + if (q .eq. 'TDIM')go to 20 + +C no match so go on to next keyword + go to 90 + +20 continue +C try reading the index number suffix + tstat=0 + call ftc2ii(rec(i1:8),ival,tstat) + if (tstat .eq. 0 .and. ival .ge. colmin .and. + & ival .le. colmax)then + if (incre .le. 0 .and. ival .eq. colmin)then +C delete keyword related to this column + call ftdrec(iunit,nrec,status) + nkeys=nkeys-1 + nrec=nrec-1 + else + ival=ival+incre + i1=i1-1 + call ftkeyn(rec(1:i1),ival,newkey,status) + rec(1:8)=newkey +C modify the index number of this keyword + call ftmrec(iunit,nrec,rec,status) + end if + end if + end if + +90 nrec=nrec+1 + if (nrec .le. nkeys)go to 100 + end diff --git a/pkg/tbtables/fitsio/ftl2c.f b/pkg/tbtables/fitsio/ftl2c.f new file mode 100644 index 00000000..f919e021 --- /dev/null +++ b/pkg/tbtables/fitsio/ftl2c.f @@ -0,0 +1,15 @@ +C---------------------------------------------------------------------- + subroutine ftl2c(lval,cval,status) +C convert a logical value to a C*20 right justified character string + integer status + logical lval + character*20 cval + + if (status .gt. 0)return + + if (lval)then + cval=' T' + else + cval=' F' + end if + end diff --git a/pkg/tbtables/fitsio/ftmahd.f b/pkg/tbtables/fitsio/ftmahd.f new file mode 100644 index 00000000..58e45342 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmahd.f @@ -0,0 +1,73 @@ +C---------------------------------------------------------------------- + subroutine ftmahd(iunit,extno,xtend,status) + +C Move to Absolute Header Data unit +C move the i/o pointer to the specified HDU and initialize all +C the common block parameters which describe the extension + +C iunit i fortran unit number +C extno i number of the extension to point to. +C xtend i returned type of extension: 0 = the primary HDU +C 1 = an ASCII table +C 2 = a binary table +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + integer iunit,extno,xtend,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,movto,tstat + + if (status .gt. 0)then + return + else if (extno .le. 0 .or. extno .ge. ne)then + status=301 + return + end if + + ibuff=bufnum(iunit) + +C check if we are already positioned to the correct HDU + if (extno .eq. chdu(ibuff))then +C just return the type of extension + xtend=hdutyp(ibuff) + else + +C now move to the extension, or the highest one we know about +10 movto=min(extno,maxhdu(ibuff)+1) + +C before closing out the CHDU, make sure the new extension exists + call ftmbyt(iunit,hdstrt(ibuff,movto),.false.,status) + if (status .gt. 0)return + +C close out the current HDU before moving to the new one + call ftchdu(iunit,status) + if (status .gt. 0)then + call ftpmsg('FTMAHD could not close the'// + & ' current HDU before moving to the new HDU.') + return + end if + + call ftgext(iunit,movto,xtend,status) + if (status .gt. 0)then +C failed to move to new extension, so restore previous extension + tstat=0 + call ftrhdu(iunit,movto,tstat) + return + end if + +C continue reading extensions until we get to the one we want + if (movto .lt. extno)go to 10 + end if + end diff --git a/pkg/tbtables/fitsio/ftmcom.f b/pkg/tbtables/fitsio/ftmcom.f new file mode 100644 index 00000000..b455344b --- /dev/null +++ b/pkg/tbtables/fitsio/ftmcom.f @@ -0,0 +1,41 @@ +C-------------------------------------------------------------------------- + subroutine ftmcom(ounit,keywrd,comm,status) + +C modify a the comment string in a header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C comm c new keyword comment (max of 72 characters long) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + character*(*) keywrd,comm + integer ounit,status,lenval,ncomm + character value*80,knam*8,cmnt*72 + + if (status .gt. 0)return + + knam=keywrd + +C find the old keyword + value string + call ftgcrd(ounit,knam,value,status) + if (status .eq. 202)then + call ftpmsg('FTMCOM Could not find the '//knam//' keyword.') + return + end if + + call ftprsv(value,lenval,status) + + cmnt=comm + +C find amount of space left for comment string (3 spaces needed for ' / ') + ncomm=77-lenval + +C write the keyword record if there is space + if (ncomm .gt. 0)then + call ftmodr(ounit, + & value(1:lenval)//' / '//cmnt(1:ncomm),status) + end if + end diff --git a/pkg/tbtables/fitsio/ftmcrd.f b/pkg/tbtables/fitsio/ftmcrd.f new file mode 100644 index 00000000..67567b55 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmcrd.f @@ -0,0 +1,35 @@ +C-------------------------------------------------------------------------- + subroutine ftmcrd(ounit,keywrd,card,status) + +C modify (overwrite) a given header record specified by keyword name. +C This can be used to overwrite the name of the keyword as well as +C the value and comment fields. +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C card c new 80-character card image to be written +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + character*(*) keywrd,card + integer ounit,status + character value*80 + + if (status .gt. 0)return + +C find the old keyword string + call ftgcrd(ounit,keywrd,value,status) + + value=card + +C make sure new keyword name is in upper case + call ftupch(value(1:8)) + +C test that keyword name contains only legal characters + call fttkey(value(1:8),status) + +C write the new keyword record + call ftmodr(ounit,value,status) + end diff --git a/pkg/tbtables/fitsio/ftmkey.f b/pkg/tbtables/fitsio/ftmkey.f new file mode 100644 index 00000000..b7d05c26 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkey.f @@ -0,0 +1,28 @@ +C-------------------------------------------------------------------------- + subroutine ftmkey(ounit,keywrd,value,comm,status) + +C modify an existing simple FITS keyword record with format: +C "KEYWORD = VALUE / COMMENT" +C VALUE is assumed to be 20 characters long +C COMMENT is assumed to be 47 characters long +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C value c keyword value (20 characters, cols. 11-30) +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,value,comm + integer ounit,status + character key*8, val*20, com*47 + + key=keywrd + val=value + com=comm + +C overwrite the preceeding 80 characters to the output buffer: + call ftmodr(ounit,key//'= '//val//' / '//com,status) + end diff --git a/pkg/tbtables/fitsio/ftmkyd.f b/pkg/tbtables/fitsio/ftmkyd.f new file mode 100644 index 00000000..77012ab3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkyd.f @@ -0,0 +1,38 @@ +C-------------------------------------------------------------------------- + subroutine ftmkyd(ounit,keywrd,dval,decim,comm,status) + +C modify a double precision value header record in E format +C If it will fit, the value field will be 20 characters wide; +C otherwise it will be expanded to up to 35 characters, left +C justified. +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (max. 47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + double precision dval + integer ounit,status,decim,vlen + character value*35,key*8,cmnt*48 + +C find the old keyword + call ftgkey(ounit,keywrd,value,cmnt,status) + + key=keywrd +C check for special symbol indicating that comment should not be changed + if (comm .ne. '&')then + cmnt=comm + end if + +C convert double precision to E format character string + call ftd2e(dval,decim,value,vlen,status) + +C write the keyword record + call ftmodr(ounit,key//'= '//value(1:vlen)//' / '//cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftmkye.f b/pkg/tbtables/fitsio/ftmkye.f new file mode 100644 index 00000000..5d75ca9b --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkye.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftmkye(ounit,keywrd,rval,decim,comm,status) + +C modify a real*4 value header record in E format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + real rval + integer ounit,status,decim + character value*20,cmnt*48 + +C find the old keyword + call ftgkey(ounit,keywrd,value,cmnt,status) + +C check for special symbol indicating that comment should not be changed + if (comm .ne. '&')then + cmnt=comm + end if + +C convert real to E format character string + call ftr2e(rval,decim,value,status) + +C modify the keyword record + call ftmkey(ounit,keywrd,value,cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftmkyf.f b/pkg/tbtables/fitsio/ftmkyf.f new file mode 100644 index 00000000..9b655665 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkyf.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftmkyf(ounit,keywrd,rval,decim,comm,status) + +C modify a real*4 value header record in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + real rval + integer ounit,status,decim + character value*20,cmnt*48 + +C find the old keyword + call ftgkey(ounit,keywrd,value,cmnt,status) + +C check for special symbol indicating that comment should not be changed + if (comm .ne. '&')then + cmnt=comm + end if + +C convert real to F format character string + call ftr2f(rval,decim,value,status) + +C write the keyword record + call ftmkey(ounit,keywrd,value,cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftmkyg.f b/pkg/tbtables/fitsio/ftmkyg.f new file mode 100644 index 00000000..b0db38f5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkyg.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftmkyg(ounit,keywrd,dval,decim,comm,status) + +C modify a double precision value header record in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + double precision dval + integer ounit,status,decim + character value*20,cmnt*48 + +C find the old keyword + call ftgkey(ounit,keywrd,value,cmnt,status) + +C check for special symbol indicating that comment should not be changed + if (comm .ne. '&')then + cmnt=comm + end if + +C convert double precision to F format character string + call ftd2f(dval,decim,value,status) + +C modify the keyword record + call ftmkey(ounit,keywrd,value,cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftmkyj.f b/pkg/tbtables/fitsio/ftmkyj.f new file mode 100644 index 00000000..4e117241 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkyj.f @@ -0,0 +1,32 @@ +C-------------------------------------------------------------------------- + subroutine ftmkyj(ounit,keywrd,intval,comm,status) + +C modify an integer value header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C intval i keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer ounit,status,intval + character value*20,cmnt*48 + +C find the old keyword + call ftgkey(ounit,keywrd,value,cmnt,status) + +C check for special symbol indicating that comment should not be changed + if (comm .ne. '&')then + cmnt=comm + end if + +C convert integer to character string + call fti2c(intval,value,status) + +C modify the keyword record + call ftmkey(ounit,keywrd,value,cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftmkyl.f b/pkg/tbtables/fitsio/ftmkyl.f new file mode 100644 index 00000000..e7395b90 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkyl.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftmkyl(ounit,keywrd,logval,comm,status) + +C modify a logical value header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C logval l keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer ounit,status + logical logval + character value*20,cmnt*48 + +C find the old keyword + call ftgkey(ounit,keywrd,value,cmnt,status) + +C check for special symbol indicating that comment should not be changed + if (comm .ne. '&')then + cmnt=comm + end if + +C convert logical to character string + call ftl2c(logval,value,status) + +C modify the keyword record + call ftmkey(ounit,keywrd,value,cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftmkys.f b/pkg/tbtables/fitsio/ftmkys.f new file mode 100644 index 00000000..82b3ec1a --- /dev/null +++ b/pkg/tbtables/fitsio/ftmkys.f @@ -0,0 +1,121 @@ +C-------------------------------------------------------------------------- + subroutine ftmkys(ounit,keywrd,strval,comm,status) + +C modify a character string value header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C strval c keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 +C modifed 7/93 to support string keywords continued over multiple cards +C modified 9/94 to support the OGIP long string convention + + character*(*) keywrd,strval,comm + integer ounit,status + + integer clen,i,nvalue,ncomm + character keynam*8,value*70,cmnt*48,bslash + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + if (status .gt. 0)return + +C check if the new value is too long to fit in a single 'card image' + clen=len(strval) + if (clen .le. 68)go to 20 + + do 10 i=clen,69,-1 + if (strval(i:i) .ne. ' ')go to 100 +10 continue + +C now check that the old keyword is not continued over multiple cards +C read the (first line) of the existing keyword + +20 call ftgkey(ounit,keywrd,value,cmnt,status) + if (status .gt. 0)go to 900 + +C is last character of the value a backslash or & ? +C have to use 2 \\'s because the SUN compiler treats 1 \ as an escape + bslash='\\' + do 30 i=70,1,-1 + if (value(i:i) .ne. ' '.and. value(i:i).ne.'''')then + if (value(i:i) .eq. bslash .or. + & value(i:i) .eq. '&')then +C backspace the current header pointer by one record + nxthdr(bufnum(ounit))=nxthdr(bufnum(ounit))-80 + go to 100 + else + go to 40 + end if + end if +30 continue + +C OK, we can simply overwrite the old keyword with the new +40 continue + +C overwrite the old comment unless user supplied the magic value + if (comm .ne. '&')then + cmnt=comm + end if +C convert string to quoted character string (max length = 70 characters) + call fts2c(strval,value,clen,status) + if (status .gt. 0)go to 900 + +C find amount of space left for comment string +C (assume 10 char. for 'keyword = ', and 3 between value and comment) +C which leaves 67 spaces for the value string + comment string + nvalue=max(20,clen) + ncomm=67-nvalue + +C write the keyword record + keynam=keywrd + if (ncomm .gt. 0)then +C there is space for a comment + call ftmodr(ounit, + & keynam//'= '//value(1:nvalue)//' / '//cmnt(1:ncomm),status) + else +C no room for a comment + call ftmodr(ounit, + & keynam//'= '//value(1:nvalue)//' ',status) + end if + go to 900 + +100 continue + +C Either the old or new keyword is continued over multiple +C header card images, so have to use a less efficient way to modify +C the keyword by completely deleting the old and inserting the new. + +C read the old comment, if we need to preserve it + if (comm .eq. '&')then + call ftgkys(ounit,keywrd,value,cmnt,status) + if (status .gt. 0)go to 900 +C reset the current header pointer by 2 records to make +C it faster (usually) to find and delete the keyword + nxthdr(bufnum(ounit))=nxthdr(bufnum(ounit))-160 + else + cmnt=comm + end if + +C delete the old keyword + call ftdkey(ounit,keywrd,status) + if (status .gt. 0)go to 900 + +C insert the new keyword + call ftikys(ounit,keywrd,strval,cmnt,status) + +900 continue + end diff --git a/pkg/tbtables/fitsio/ftmnam.f b/pkg/tbtables/fitsio/ftmnam.f new file mode 100644 index 00000000..02774a69 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmnam.f @@ -0,0 +1,34 @@ +C-------------------------------------------------------------------------- + subroutine ftmnam(ounit,oldkey,newkey,status) + +C modify (overwrite) the name of an existing keyword, preserving +C the current value and comment fields +C +C ounit i fortran output unit number +C oldkey c old keyword name ( 8 characters, cols. 1- 8) +C newkey c new keyword name to be written +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + character*(*) oldkey,newkey + integer ounit,status + character card*80 + + if (status .gt. 0)return + +C find the old keyword string + call ftgcrd(ounit,oldkey,card,status) + + card(1:8)=newkey + +C make sure new keyword name is in upper case + call ftupch(card(1:8)) + +C test that keyword name contains only legal characters + call fttkey(card(1:8),status) + +C write the new keyword record + call ftmodr(ounit,card,status) + end diff --git a/pkg/tbtables/fitsio/ftmodr.f b/pkg/tbtables/fitsio/ftmodr.f new file mode 100644 index 00000000..97336703 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmodr.f @@ -0,0 +1,46 @@ +C-------------------------------------------------------------------------- + subroutine ftmodr(ounit,record,status) + +C modify the preceeding 80 character record in the FITS header +C +C ounit i fortran output unit number +C record c input 80 character header record +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) record + character*80 rec + integer ounit,status,ibuff + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + + rec=record + +C make sure keyword name is in upper case + call ftupch(rec(1:8)) + +C test that keyword name contains only legal characters + call fttkey(rec(1:8),status) + +C move the I/O pointer back to the beginning of the preceeding keyword + call ftmbyt(ounit,nxthdr(ibuff)-80,.false.,status) + +C overwrite the 80 characters to the output buffer: + call ftpcbf(ounit,1,80,rec,status) + end diff --git a/pkg/tbtables/fitsio/ftmrec.f b/pkg/tbtables/fitsio/ftmrec.f new file mode 100644 index 00000000..aee11a60 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmrec.f @@ -0,0 +1,25 @@ +C-------------------------------------------------------------------------- + subroutine ftmrec(ounit,nkey,record,status) + +C modify the nth keyword in the CHU, by replacing it with the +C input 80 character string. +C +C ounit i fortran output unit number +C nkey i sequence number (starting with 1) of the keyword to read +C record c 80-character string to replace the record with +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,nkey,status + character*(*) record + character rec*80 + +C find the old keyword; just use REC as a temporary variable + call ftgrec(ounit,nkey,rec,status) + + rec=record +C overwrite the keyword with the new record + call ftmodr(ounit,rec,status) + end diff --git a/pkg/tbtables/fitsio/ftmrhd.f b/pkg/tbtables/fitsio/ftmrhd.f new file mode 100644 index 00000000..c84d04c9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftmrhd.f @@ -0,0 +1,39 @@ +C---------------------------------------------------------------------- + subroutine ftmrhd(iunit,extmov,xtend,status) + +C Move Relative Header Data unit +C move the i/o pointer to the specified HDU and initialize all +C the common block parameters which describe the extension + +C iunit i fortran unit number +C extmov i number of the extension to point to, relative to the CHDU +C xtend i returned type of extension: 0 = the primary HDU +C 1 = an ASCII table +C 2 = a binary table +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1991 + + integer iunit,extmov,xtend,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,extno + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C calculate the absolute HDU number, then move to it + extno=chdu(ibuff)+extmov + call ftmahd(iunit,extno,xtend,status) + end diff --git a/pkg/tbtables/fitsio/ftnkey.f b/pkg/tbtables/fitsio/ftnkey.f new file mode 100644 index 00000000..365d509e --- /dev/null +++ b/pkg/tbtables/fitsio/ftnkey.f @@ -0,0 +1,70 @@ +C-------------------------------------------------------------------------- + subroutine ftnkey(nseq,keywrd,keyout,status) + +C Make a keyword name by concatinating a sequence number and +C the root name. (Sequence number is prepended to the name) + +C nseq i sequence number +C keywrd c root keyword name +C OUTPUT PARAMETERS: +C keyout c output concatinated keyword name +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Aug 1994 + + character*(*) keywrd + integer nseq,status,nspace,i + character keyout*8,value*20,work*8 + + work=keywrd + +C find end of keyword string + nspace=0 + do 10 i=8,1,-1 + if (work(i:i) .ne. ' ')go to 15 + nspace=nspace+1 +10 continue +15 continue + +C prepend sequence number to keyword root only if there is room + if (nseq .lt. 0)then +C illegal value + go to 900 + else if (nseq .lt. 10 .and. nspace .ge. 1)then + write(keyout,1001,err=900)nseq,work(1:7) + else if (nseq .lt. 100 .and. nspace .ge. 2)then + write(keyout,1002,err=900)nseq,work(1:6) + else if (nseq .lt. 1000 .and. nspace .ge. 3)then + write(keyout,1003,err=900)nseq,work(1:5) + else if (nseq .lt. 10000 .and. nspace .ge. 4)then + write(keyout,1004,err=900)nseq,work(1:4) + else if (nseq .lt. 100000 .and. nspace .ge. 5)then + write(keyout,1005,err=900)nseq,work(1:3) + else if (nseq .lt. 1000000 .and. nspace .ge. 6)then + write(keyout,1006,err=900)nseq,work(1:2) + else if (nseq .lt. 10000000 .and. nspace .ge. 7)then + write(keyout,1007,err=900)nseq,work(1:1) + else +C number too big to fit in keyword + go to 900 + end if + +1001 format(i1,a7) +1002 format(i2,a6) +1003 format(i3,a5) +1004 format(i4,a4) +1005 format(i5,a3) +1006 format(i6,a2) +1007 format(i7,a1) + + return +C come here if error concatinating the seq. no. to the root string +900 continue + + if (status .gt. 0)return + status=206 + write(value,1008)nseq +1008 format(i20) + call ftpmsg('Could not concatinate the integer '//value// + & ' and the root keyword named: '//work) + end diff --git a/pkg/tbtables/fitsio/ftnulc.f b/pkg/tbtables/fitsio/ftnulc.f new file mode 100644 index 00000000..bb07ffd4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftnulc.f @@ -0,0 +1,78 @@ +C-------------------------------------------------------------------------- + subroutine ftnulc(input,np,chktyp,setval,flgray,anynul, + & scaled,scale,zero) + +C check input complex array for nulls and apply scaling +C if chktyp=1 then set the undefined pixel = SETVAL +C if chktyp=2 then set the corresponding FLGRAY = .true. + +C When scaling complex data values, both the real and imaginary +C components of the value are scaled by SCALE, but the offset +C given by ZERO is only applied to the real part of the complex number + +C input r input array of values +C np i number of pairs of values +C chktyp i type of null value checking to be done if TOFITS=.false. +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval r value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C scaled l does data need to be scaled? +C scale d scale factor +C zero d offset + + real input(*),setval(2) + integer np,i,chktyp,j + double precision scale,zero + logical flgray(*),anynul,scaled + logical fttrnn + external fttrnn + + if (chktyp .eq. 2)then +C initialize the null flag values + do 5 i=1,np + flgray(i)=.false. +5 continue + end if + + j=1 + do 10 i=1,np +C do the real part of the complex number + if (chktyp .ne. 0 .and. fttrnn(input(j)))then + anynul=.true. + if (chktyp .eq. 1)then +C set both parts of the complex number to the +C specified special value + input(j)=setval(1) + input(j+1)=setval(2) + else +C set the corresponding flag value to true + flgray(i)=.true. + end if + j=j+2 + else if (scaled)then + input(j)=input(j)*scale+zero + j=j+1 + +C do the imaginary part of the complex number + if (chktyp .ne. 0 .and. fttrnn(input(j)))then + anynul=.true. + if (chktyp .eq. 1)then +C set both parts of the complex number to the +C specified special value + input(j-1)=setval(1) + input(j)=setval(2) + else +C set the corresponding flag value to true + flgray(i)=.true. + end if + else if (scaled)then + input(j)=input(j)*scale + end if + j=j+1 + else + j=j+2 + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftnulm.f b/pkg/tbtables/fitsio/ftnulm.f new file mode 100644 index 00000000..c3aa7461 --- /dev/null +++ b/pkg/tbtables/fitsio/ftnulm.f @@ -0,0 +1,78 @@ +C-------------------------------------------------------------------------- + subroutine ftnulm(input,np,chktyp,setval,flgray,anynul, + & scaled,scale,zero) + +C check input double complex array for nulls and apply scaling +C if chktyp=1 then set the undefined pixel = SETVAL +C if chktyp=2 then set the corresponding FLGRAY = .true. + +C When scaling complex data values, both the real and imaginary +C components of the value are scaled by SCALE, but the offset +C given by ZERO is only applied to the real part of the complex number + +C input d input array of values +C np i number of pairs of values +C chktyp i type of null value checking to be done if TOFITS=.false. +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval d value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C scaled l does data need to be scaled? +C scale d scale factor +C zero d offset + + double precision input(*),setval(2) + integer np,i,chktyp,j + double precision scale,zero + logical flgray(*),anynul,scaled + logical fttdnn + external fttdnn + + if (chktyp .eq. 2)then +C initialize the null flag values + do 5 i=1,np + flgray(i)=.false. +5 continue + end if + + j=1 + do 10 i=1,np +C do the real part of the complex number + if (chktyp .ne. 0 .and. fttdnn(input(j)))then + anynul=.true. + if (chktyp .eq. 1)then +C set both parts of the complex number to the +C specified special value + input(j)=setval(1) + input(j+1)=setval(2) + else +C set the corresponding flag value to true + flgray(i)=.true. + end if + j=j+2 + else if (scaled)then + input(j)=input(j)*scale+zero + j=j+1 + +C do the imaginary part of the complex number + if (chktyp .ne. 0 .and. fttdnn(input(j)))then + anynul=.true. + if (chktyp .eq. 1)then +C set both parts of the complex number to the +C specified special value + input(j-1)=setval(1) + input(j)=setval(2) + else +C set the corresponding flag value to true + flgray(i)=.true. + end if + else if (scaled)then + input(j)=input(j)*scale + end if + j=j+1 + else + j=j+2 + end if +10 continue + end diff --git a/pkg/tbtables/fitsio/ftopen.f b/pkg/tbtables/fitsio/ftopen.f new file mode 100644 index 00000000..c1c78a04 --- /dev/null +++ b/pkg/tbtables/fitsio/ftopen.f @@ -0,0 +1,58 @@ +C-------------------------------------------------------------------------- + subroutine ftopen(funit,fname,rwmode,block,status) + +C open an existing FITS file with readonly or read/write access +C +C funit i Fortran I/O unit number +C fname c name of file to be opened +C rwmode i file access mode: 0 = readonly; else = read and write +C block i returned record length blocking factor +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer funit,rwmode,block,status,strlen,i,xtend + character*(*) fname + + if (status .gt. 0)return + +C ignore any leading blanks in the file name + strlen=len(fname) + do 10 i=1,strlen + if (fname(i:i) .ne. ' ')then + +C call the machine dependent routine which opens the file + call ftopnx(funit,fname(i:),0,rwmode,block,status) + if (status .gt. 0)then + call ftpmsg('FTOPEN failed to Find and/or Open'// + & ' the following file:') + call ftpmsg(fname) + return + end if + +C set column descriptors as undefined + call ftfrcl(funit,-999) + +C determine the structure and size of the primary HDU + call ftrhdu(funit,xtend,status) + if (status .gt. 0)then + call ftpmsg('FTOPEN could not interpret primary ' + & //'array header keywords of file:') + call ftpmsg(fname) + if (status .eq. 252)then + call ftpmsg('Is this a FITS file??') + end if + end if + +C set current column name buffer as undefined + call ftrsnm + return + end if +10 continue + +C if we got here, then the input filename was all blanks + status=104 + call ftpmsg('FTOPEN: Name of file to open is blank.') + return + + end diff --git a/pkg/tbtables/fitsio/ftp2db.f b/pkg/tbtables/fitsio/ftp2db.f new file mode 100644 index 00000000..d09670a5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp2db.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftp2db(ounit,group,dim1,nx,ny,array,status) + +C Write a 2-d image of byte values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array c*1 the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + character*1 array(dim1,*) + integer fpixel,row + + fpixel=1 + do 10 row = 1,ny + call ftpprb(ounit,group,fpixel,nx,array(1,row),status) + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftp2dd.f b/pkg/tbtables/fitsio/ftp2dd.f new file mode 100644 index 00000000..359e70b9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp2dd.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftp2dd(ounit,group,dim1,nx,ny,array,status) + +C Write a 2-d image of r*8 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array d the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + double precision array(dim1,*) + integer fpixel,row + + fpixel=1 + do 10 row = 1,ny + call ftpprd(ounit,group,fpixel,nx,array(1,row),status) + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftp2de.f b/pkg/tbtables/fitsio/ftp2de.f new file mode 100644 index 00000000..f5ef23cf --- /dev/null +++ b/pkg/tbtables/fitsio/ftp2de.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftp2de(ounit,group,dim1,nx,ny,array,status) + +C Write a 2-d image of r*4 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array r the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + real array(dim1,*) + integer fpixel,row + + fpixel=1 + do 10 row = 1,ny + call ftppre(ounit,group,fpixel,nx,array(1,row),status) + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftp2di.f b/pkg/tbtables/fitsio/ftp2di.f new file mode 100644 index 00000000..5c59e2b5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp2di.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftp2di(ounit,group,dim1,nx,ny,array,status) + +C Write a 2-d image of i*2 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array i*2 the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + integer*2 array(dim1,*) + integer fpixel,row + + fpixel=1 + do 10 row = 1,ny + call ftppri(ounit,group,fpixel,nx,array(1,row),status) + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftp2dj.f b/pkg/tbtables/fitsio/ftp2dj.f new file mode 100644 index 00000000..5d0f6e25 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp2dj.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftp2dj(ounit,group,dim1,nx,ny,array,status) + +C Write a 2-d image of i*4 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C nx i size of the image in the x direction +C ny i size of the image in the y direction +C array i the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,nx,ny,status + integer array(dim1,*) + integer fpixel,row + + fpixel=1 + do 10 row = 1,ny + call ftpprj(ounit,group,fpixel,nx,array(1,row),status) + fpixel=fpixel+nx +10 continue + + end diff --git a/pkg/tbtables/fitsio/ftp3db.f b/pkg/tbtables/fitsio/ftp3db.f new file mode 100644 index 00000000..bf38e6f6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp3db.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftp3db(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +C Write a 3-d cube of byte values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array c*1 the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + character*1 array(dim1,dim2,*) + integer fpixel,row,band + + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftpprb(ounit,group,fpixel,nx,array(1,row,band),status) + fpixel=fpixel+nx +10 continue +20 continue + + end diff --git a/pkg/tbtables/fitsio/ftp3dd.f b/pkg/tbtables/fitsio/ftp3dd.f new file mode 100644 index 00000000..469fbfc3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp3dd.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftp3dd(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +C Write a 3-d cube of r*8 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array r*8 the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + double precision array(dim1,dim2,*) + integer fpixel,row,band + + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftpprd(ounit,group,fpixel,nx,array(1,row,band),status) + fpixel=fpixel+nx +10 continue +20 continue + + end diff --git a/pkg/tbtables/fitsio/ftp3de.f b/pkg/tbtables/fitsio/ftp3de.f new file mode 100644 index 00000000..6bcb9cd3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp3de.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftp3de(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +C Write a 3-d cube of r*4 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array r the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + real array(dim1,dim2,*) + integer fpixel,row,band + + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftppre(ounit,group,fpixel,nx,array(1,row,band),status) + fpixel=fpixel+nx +10 continue +20 continue + + end diff --git a/pkg/tbtables/fitsio/ftp3di.f b/pkg/tbtables/fitsio/ftp3di.f new file mode 100644 index 00000000..0f1e8eea --- /dev/null +++ b/pkg/tbtables/fitsio/ftp3di.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftp3di(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +C Write a 3-d cube of i*2 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array i*2 the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + integer*2 array(dim1,dim2,*) + integer fpixel,row,band + + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftppri(ounit,group,fpixel,nx,array(1,row,band),status) + fpixel=fpixel+nx +10 continue +20 continue + + end diff --git a/pkg/tbtables/fitsio/ftp3dj.f b/pkg/tbtables/fitsio/ftp3dj.f new file mode 100644 index 00000000..3c191672 --- /dev/null +++ b/pkg/tbtables/fitsio/ftp3dj.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftp3dj(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +C Write a 3-d cube of i*4 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C dim1 i actual first dimension of ARRAY +C dim2 i actual second dimension of ARRAY +C nx i size of the cube in the x direction +C ny i size of the cube in the y direction +C nz i size of the cube in the z direction +C array i the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,dim1,dim2,nx,ny,nz,status + integer array(dim1,dim2,*) + integer fpixel,row,band + + fpixel=1 + do 20 band=1,nz + do 10 row = 1,ny + call ftpprj(ounit,group,fpixel,nx,array(1,row,band),status) + fpixel=fpixel+nx +10 continue +20 continue + + end diff --git a/pkg/tbtables/fitsio/ftpbit.f b/pkg/tbtables/fitsio/ftpbit.f new file mode 100644 index 00000000..793a8509 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpbit.f @@ -0,0 +1,111 @@ +C---------------------------------------------------------------------- + subroutine ftpbit(setbit,wrbit,buffer) + +C encode the individual bits within the byte as specified by +C the input logical array. The corresponding bit is set to +C 1 if the logical array element is true. Only the bits +C between begbit and endbit, inclusive, are set or reset; +C the remaining bits, if any, remain unchanged. + +C setbit l input array of logical data values corresponding +C to the bits to be set in the output buffer +C TRUE means corresponding bit is to be set. +C wrbit l input array of logical values indicating which +C bits in the byte are to be modified. If FALSE, +C then the corresponding bit should remain unchanged. +C buffer i output integer containing the encoded byte +C +C written by Wm Pence, HEASARC/GSFC, May 1992 + + integer buffer,tbuff,outbit + logical setbit(8),wrbit(8) + + outbit=0 + tbuff=buffer + +C test each of the 8 bits, starting with the most significant + if (tbuff .gt. 127)then +C the bit is currently set in the word + if (wrbit(1) .and. (.not.setbit(1)))then +C only in this case do we reset the bit + else +C in all other cases we want the bit to be set + outbit=outbit+128 + end if + tbuff=tbuff-128 + else +C bit is currently not set; set it only if requested to + if (wrbit(1) .and. setbit(1))outbit=outbit+128 + end if + + if (tbuff .gt. 63)then + if (wrbit(2) .and. (.not.setbit(2)))then + else + outbit=outbit+64 + end if + tbuff=tbuff-64 + else + if (wrbit(2) .and. setbit(2))outbit=outbit+64 + end if + + if (tbuff .gt. 31)then + if (wrbit(3) .and. (.not.setbit(3)))then + else + outbit=outbit+32 + end if + tbuff=tbuff-32 + else + if (wrbit(3) .and. setbit(3))outbit=outbit+32 + end if + + if (tbuff .gt. 15)then + if (wrbit(4) .and. (.not.setbit(4)))then + else + outbit=outbit+16 + end if + tbuff=tbuff-16 + else + if (wrbit(4) .and. setbit(4))outbit=outbit+16 + end if + + if (tbuff .gt. 7)then + if (wrbit(5) .and. (.not.setbit(5)))then + else + outbit=outbit+8 + end if + tbuff=tbuff-8 + else + if (wrbit(5) .and. setbit(5))outbit=outbit+8 + end if + + if (tbuff .gt. 3)then + if (wrbit(6) .and. (.not.setbit(6)))then + else + outbit=outbit+4 + end if + tbuff=tbuff-4 + else + if (wrbit(6) .and. setbit(6))outbit=outbit+4 + end if + + if (tbuff .gt. 1)then + if (wrbit(7) .and. (.not.setbit(7)))then + else + outbit=outbit+2 + end if + tbuff=tbuff-2 + else + if (wrbit(7) .and. setbit(7))outbit=outbit+2 + end if + + if (tbuff .eq. 1)then + if (wrbit(8) .and. (.not.setbit(8)))then + else + outbit=outbit+1 + end if + else + if (wrbit(8) .and. setbit(8))outbit=outbit+1 + end if + + buffer=outbit + end diff --git a/pkg/tbtables/fitsio/ftpbnh.f b/pkg/tbtables/fitsio/ftpbnh.f new file mode 100644 index 00000000..ed03adff --- /dev/null +++ b/pkg/tbtables/fitsio/ftpbnh.f @@ -0,0 +1,12 @@ +C---------------------------------------------------------------------- + subroutine ftpbnh(ounit,nrows,nfield,ttype,tform,tunit, + & extnam,pcount,status) + +C OBSOLETE routine: should call ftphbn instead + + integer ounit,nrows,nfield,pcount,status + character*(*) ttype(*),tform(*),tunit(*),extnam + + call ftphbn(ounit,nrows,nfield,ttype,tform,tunit, + & extnam,pcount,status) + end diff --git a/pkg/tbtables/fitsio/ftpcks.f b/pkg/tbtables/fitsio/ftpcks.f new file mode 100644 index 00000000..f09bbdd6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcks.f @@ -0,0 +1,170 @@ +C---------------------------------------------------------------------- + subroutine ftpcks(iunit,status) + +C Create or update the checksum keywords in the CHU. These keywords +C provide a checksum verification of the FITS HDU based on the ASCII +C coded 1's complement checksum algorithm developed by Rob Seaman at NOAO. + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Sept, 1994 + + integer iunit,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nf = 3000) + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + double precision sum,dsum,odsum + integer ibuff,nrec,dd,mm,yy,dummy,i,tstat + character datstr*8,string*16,comm*40,oldcks*16,datsum*20 + logical complm + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C generate current date string to put into the keyword comment + call ftgsdt(dd,mm,yy,status) + if (status .gt. 0)return + + datstr=' / / ' + write(datstr(1:2),1001)dd + write(datstr(4:5),1001)mm + write(datstr(7:8),1001)yy +1001 format(i2) + +C replace blank with leading 0 in each field if required + if (datstr(1:1) .eq. ' ')datstr(1:1)='0' + if (datstr(4:4) .eq. ' ')datstr(4:4)='0' + if (datstr(7:7) .eq. ' ')datstr(7:7)='0' + +C get the checksum keyword, if it exists, otherwise initialize it + tstat=status + call ftgkys(iunit,'CHECKSUM',oldcks,comm,status) + if (status .eq. 202)then + status=tstat + oldcks=' ' + comm='encoded HDU checksum updated on '//datstr + call ftpkys(iunit,'CHECKSUM','0000000000000000',comm,status) + end if + +C get the DATASUM keyword and convert it to a double precision value +C if it exists, otherwise initialize it + tstat=status + call ftgkys(iunit,'DATASUM',datsum,comm,status) + if (status .eq. 202)then + status=tstat + odsum=0. +C set the CHECKSUM keyword as undefined + oldcks=' ' + comm='data unit checksum updated on '//datstr + call ftpkys(iunit,'DATASUM',' 0',comm,status) + else +C decode the datasum into a double precision variable + do 10 i=1,20 + if (datsum(i:i) .ne. ' ')then + call ftc2dd(datsum(i:20),odsum,status) + if (status .eq. 409)then +C couldn't read the keyword; assume it is out of date + status=tstat + odsum=-1. + end if + go to 15 + end if +10 continue + odsum=0. + end if + +C rewrite the header END card, and following blank fill +15 call ftwend(iunit,status) + if (status .gt. 0)return + +C now re-read the required keywords to determine the structure + call ftrhdu(iunit,dummy,status) + +C write the correct data fill values, if they are not already correct + call ftpdfl(iunit,status) + +C calc. checksum of the data records; first, calc number of data records + nrec=(hdstrt(ibuff,chdu(ibuff)+1)-dtstrt(ibuff))/2880 + dsum=0. + + if (nrec .gt. 0)then +C move to the start of the data + call ftmbyt(iunit,dtstrt(ibuff),.true.,status) + +C accumulate the 32-bit 1's complement checksum + call ftcsum(iunit,nrec,dsum,status) + end if + + if (dsum .ne. odsum)then +C modify the DATASUM keyword with the correct value + comm='data unit checksum updated on '//datstr +C write the datasum into an I10 integer string + write(datsum,2000)dsum +2000 format(f11.0) + call ftmkys(iunit,'DATASUM',datsum(1:10),comm,status) +C set the CHECKSUM keyword as undefined + oldcks=' ' + end if + +C if DATASUM was correct, check if CHECKSUM is still OK + if (oldcks .ne. ' ')then + +C move to the start of the header + call ftmbyt(iunit,hdstrt(ibuff,chdu(ibuff)),.true.,status) + +C accumulate the header checksum into the previous data checksum + nrec= (dtstrt(ibuff)-hdstrt(ibuff,chdu(ibuff)))/2880 + sum=dsum + call ftcsum(iunit,nrec,sum,status) + +C encode the COMPLEMENT of the checksum into a 16-character string + complm=.true. + call ftesum(sum,complm,string) + +C return if the checksum is correct + if (string .eq. '0000000000000000')then + return + else if (oldcks .eq. '0000000000000000')then +C update the CHECKSUM keyword value with the checksum string + call ftmkys(iunit,'CHECKSUM',string,'&',status) + return + end if + end if + +C Zero the checksum and compute the new value + comm='encoded HDU checksum updated on '//datstr + call ftmkys(iunit,'CHECKSUM','0000000000000000',comm,status) + +C move to the start of the header + call ftmbyt(iunit,hdstrt(ibuff,chdu(ibuff)),.true.,status) + +C accumulate the header checksum into the previous data checksum + nrec= (dtstrt(ibuff)-hdstrt(ibuff,chdu(ibuff)))/2880 + sum=dsum + call ftcsum(iunit,nrec,sum,status) + +C encode the COMPLEMENT of the checksum into a 16-character string + complm=.true. + call ftesum(sum,complm,string) + +C update the CHECKSUM keyword value with the checksum string + call ftmkys(iunit,'CHECKSUM',string,'&',status) + end diff --git a/pkg/tbtables/fitsio/ftpclb.f b/pkg/tbtables/fitsio/ftpclb.f new file mode 100644 index 00000000..f8f045ec --- /dev/null +++ b/pkg/tbtables/fitsio/ftpclb.f @@ -0,0 +1,318 @@ +C---------------------------------------------------------------------- + subroutine ftpclb(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of unsigned byte data values to the +C specified column of the table. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array i array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + character*1 array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + double precision scale,zero,dval + real rval + character sval*40,wform*10,crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,lval,descrp + integer*2 i2val + character*1 i1val + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLB).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) +C the data are being scaled from internal format to FITS: + tofits=.true. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) + maxpix=bufdim/bytpix*4 + +C incre is the byte offset between consecutive pixels + incre=0 + if (tcode .eq. 16)then +C this is an ASCII table; table elements cannot be vectors + repeat=1 + estart=0 + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLB).') + return + else + estart=felem-1 + end if + + if (tcode .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C if this is a primary array or image extension, then +C set repeat as large as needed to write all +C the pixels. This prevents an error message if +C array size is not yet known. The actual array +C dimension must be defined by the NAXISn keywords +C before closing this HDU. + repeat=estart+nelem + else + repeat=trept(colnum+tstart(ibuff)) + end if + + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLB).') + return + end if + + if (repeat .eq. 1 .and. nelem .gt. 1)then +C write multiple rows of data at one time + incre=rowlen(ibuff) + repeat=maxpix + estart=0 + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + end if + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C copy data to buffer, doing scaling and datatype conversion, if required + if (tcode .eq. 11)then +C column data type is B (byte) + call fti1i1(array(i1),itodo,scale,zero,tofits, + & ival,i1val,i1val,lval,lval,chbuff,status) +C do any machine dependent conversion and write the byte data + call ftpi1b(ounit,itodo,incre,chbuff,status) + else if (tcode .eq. 21)then +C column data type is I (I*2) + call fti1i2(array(i1),itodo,scale,zero,tofits, + & ival,i1val,i2val,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*2 data + call ftpi2b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 41)then +C column data type is J (I*4) + call fti1i4(array(i1),itodo,scale,zero,tofits, + & ival,i1val,ival,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*4 data + call ftpi4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 42)then +C column data type is E (R*4) + call fti1r4(array(i1),itodo,scale,zero,tofits, + & ival,i1val,rval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*4 data + call ftpr4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 82)then +C column data type is D (R*8) + call fti1r8(array(i1),itodo,scale,zero,tofits, + & ival,i1val,dval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*8 data + call ftpr8b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column + wform='( )' + wform(2:9)=cform(colnum+tstart(ibuff)) + if (cform(colnum+tstart(ibuff))(1:1) .eq. 'I')then +C column data type is integer + call fti1i4(array(i1),itodo,scale,zero,tofits, + & ival,i1val,ival,lval,lval,ival,status) +C create the formated character string + write(sval,wform,err=900)ival +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'F' + & .or. cform(colnum+tstart(ibuff))(1:1) .eq. 'E')then +C column data type is real + call fti1r4(array(i1),itodo,scale,zero,tofits, + & ival,i1val,rval,lval,lval,rval,status) +C create the formated character string + write(sval,wform,err=900)rval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'D')then +C column data type is double precision + call fti1r8(array(i1),itodo,scale,zero,tofits, + & ival,i1val,dval,lval,lval,dval,status) +C create the formated character string + write(sval,wform,err=900)dval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot write byte (I*1) values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLB).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot write byte (I*1) values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLB).') + return + end if + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing pixels'//cp1//' to'//cp2 + & // ' to the FITS image array (FTPCLB).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while writing group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLB.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLB).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLB).') + end if + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + if (incre .eq. 0)then + rstart=rstart+1 + else + rstart=rstart+repeat + end if + end if + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred writing '// + & 'Byte data to FITS file.') + end if + return + +900 continue +C error writing formatted data value to ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error writing colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to write value'// + & '" with format '//wform//' (FTPCLB).') + status=313 + end diff --git a/pkg/tbtables/fitsio/ftpclc.f b/pkg/tbtables/fitsio/ftpclc.f new file mode 100644 index 00000000..a83af536 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpclc.f @@ -0,0 +1,188 @@ +C---------------------------------------------------------------------- + subroutine ftpclc(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of single precision complex data values to the +C specified column of the table. +C The binary table column being written to must have datatype 'C' +C and no datatype conversion will be perform if it is not. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array cmp array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status +C the input array is really complex data type + real array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 200) + integer bytpix,bstart,tcode + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix + real buffer(bufdim) + double precision scale,zero + logical descrp,scaled + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLC).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + i1=1 +C multiply by 2, because the complex data type has pairs of values + ntodo=nelem*2 + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + if (scale .eq. 1. .and. zero .eq. 0.)then + scaled=.false. + else + scaled=.true. + end if + tcode=tdtype(colnum+tstart(ibuff)) + + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLC).') + return + else +C multiply by 2 because the complex data type has pairs of values + estart=(felem-1)*2 + end if + +C calculate the maximum number of column pixels which fit in buffer + bytpix=4 + maxpix=bufdim/bytpix*4 + + if (tcode .eq. 83)then + repeat=trept(colnum+tstart(ibuff))*2 + if (felem*2 .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLC).') + return + end if + descrp=.false. + else if (tcode .eq. -83)then +C this is a variable length descriptor column + descrp=.true. + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) + repeat=repeat*2 +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + else +C error illegal table data type code + status=312 + return + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C scale data into buffer, + call ftuscc(array(i1),itodo,scaled,scale,zero,buffer) + +C do any machine dependent data conversion and write the R*4 data + call ftpr4b(ounit,itodo,0,buffer,status) + + if (status .gt. 0)then + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLC.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLC).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLC).') + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftpcld.f b/pkg/tbtables/fitsio/ftpcld.f new file mode 100644 index 00000000..83a47f11 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcld.f @@ -0,0 +1,320 @@ +C---------------------------------------------------------------------- + subroutine ftpcld(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of double precision data values to the specified column +C of the table. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array d array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + double precision array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,incre + double precision dbuffr(50) + equivalence (buffer,dbuffr) + + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + real rval + double precision scale,zero,dval + character sval*40,wform*10,crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,lval,descrp + integer*2 i2val + character*1 i1val + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLD).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) +C the data are being scaled from internal format to FITS: + tofits=.true. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) + maxpix=bufdim/bytpix*4 + +C incre is the byte offset between consecutive pixels + incre=0 + if (tcode .eq. 16)then +C this is an ASCII table; table elements cannot be vectors + repeat=1 + estart=0 + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLD).') + return + else + estart=felem-1 + end if + + if (tcode .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C if this is a primary array or image extension, then +C set repeat as large as needed to write all +C the pixels. This prevents an error message if +C array size is not yet known. The actual array +C dimension must be defined by the NAXISn keywords +C before closing this HDU. + repeat=estart+nelem + else + repeat=trept(colnum+tstart(ibuff)) + end if + + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLD).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C write multiple rows of data at one time + incre=rowlen(ibuff) + repeat=maxpix + estart=0 + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + end if + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C copy data to buffer, doing scaling and datatype conversion, if required + if (tcode .eq. 21)then +C column data type is I (I*2) + call ftr8i2(array(i1),itodo,scale,zero,tofits, + & ival,i2val,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*2 data + call ftpi2b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 41)then +C column data type is J (I*4) + call ftr8i4(array(i1),itodo,scale,zero,tofits, + & ival,ival,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*4 data + call ftpi4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 42)then +C column data type is E (R*4) + call ftr8r4(array(i1),itodo,scale,zero,tofits, + & ival,rval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*4 data + call ftpr4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 82)then +C column data type is D (R*8) + call ftr8r8(array(i1),itodo,scale,zero,tofits, + & ival,dval,lval,lval,dbuffr,status) +C do any machine dependent conversion and write the R*8 data + call ftpr8b(ounit,itodo,incre,dbuffr,status) + else if (tcode .eq. 11)then +C column data type is B (byte) + call ftr8i1(array(i1),itodo,scale,zero,tofits, + & ival,i1val,lval,lval,chbuff,status) +C do any machine dependent data conversion and write the byte data + call ftpi1b(ounit,itodo,incre,chbuff,status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column + wform='( )' + wform(2:9)=cform(colnum+tstart(ibuff)) + if (cform(colnum+tstart(ibuff))(1:1) .eq. 'I')then +C column data type is integer + call ftr8i4(array(i1),itodo,scale,zero,tofits, + & ival,ival,lval,lval,ival,status) +C create the formated character string + write(sval,wform,err=900)ival +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'F' + & .or. cform(colnum+tstart(ibuff))(1:1) .eq. 'E')then +C column data type is real + call ftr8r4(array(i1),itodo,scale,zero,tofits, + & ival,rval,lval,lval,rval,status) +C create the formated character string + write(sval,wform,err=900)rval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'D')then +C column data type is double precision + call ftr8r8(array(i1),itodo,scale,zero,tofits, + & ival,dval,lval,lval,dval,status) +C create the formated character string + write(sval,wform,err=900)dval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot write Double values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLD).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot write Double values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLD).') + return + end if + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing pixels'//cp1//' to'//cp2 + & // ' to the FITS image array (FTPCLD).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while writing group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLD.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLD).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLD).') + end if + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + if (incre .eq. 0)then + rstart=rstart+1 + else + rstart=rstart+repeat + end if + end if + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred writing '// + & 'Real*8 data to FITS file.') + end if + return + +900 continue +C error writing formatted data value to ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error writing colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to write value'// + & '" with format '//wform//' (FTPCLE).') + status=313 + end diff --git a/pkg/tbtables/fitsio/ftpcle.f b/pkg/tbtables/fitsio/ftpcle.f new file mode 100644 index 00000000..47649460 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcle.f @@ -0,0 +1,317 @@ +C---------------------------------------------------------------------- + subroutine ftpcle(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of real data values to the specified column of +C the table. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array r array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + real array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + real rval + double precision scale,zero,dval + character sval*40,wform*10,crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,lval,descrp + integer*2 i2val + character*1 i1val + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLE).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) +C the data are being scaled from internal format to FITS: + tofits=.true. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) + maxpix=bufdim/bytpix*4 + +C incre is the byte offset between consecutive pixels + incre=0 + if (tcode .eq. 16)then +C this is an ASCII table; table elements cannot be vectors + repeat=1 + estart=0 + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLE).') + return + else + estart=felem-1 + end if + + if (tcode .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C if this is a primary array or image extension, then +C set repeat as large as needed to write all +C the pixels. This prevents an error message if +C array size is not yet known. The actual array +C dimension must be defined by the NAXISn keywords +C before closing this HDU. + repeat=estart+nelem + else + repeat=trept(colnum+tstart(ibuff)) + end if + + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLE).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C write multiple rows of data at one time + incre=rowlen(ibuff) + repeat=maxpix + estart=0 + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + end if + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C copy data to buffer, doing scaling and datatype conversion, if required + if (tcode .eq. 21)then +C column data type is I (I*2) + call ftr4i2(array(i1),itodo,scale,zero,tofits, + & ival,i2val,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*2 data + call ftpi2b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 41)then +C column data type is J (I*4) + call ftr4i4(array(i1),itodo,scale,zero,tofits, + & ival,ival,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*4 data + call ftpi4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 42)then +C column data type is E (R*4) + call ftr4r4(array(i1),itodo,scale,zero,tofits, + & ival,rval,lval,lval,buffer,status) +C do any machine dependent conversion and write the R*4 data + call ftpr4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 82)then +C column data type is D (R*8) + call ftr4r8(array(i1),itodo,scale,zero,tofits, + & ival,dval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*8 data + call ftpr8b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 11)then +C column data type is B (byte) + call ftr4i1(array(i1),itodo,scale,zero,tofits, + & ival,i1val,lval,lval,chbuff,status) +C do any machine dependent data conversion and write the byte data + call ftpi1b(ounit,itodo,incre,chbuff,status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column + wform='( )' + wform(2:9)=cform(colnum+tstart(ibuff)) + if (cform(colnum+tstart(ibuff))(1:1) .eq. 'I')then +C column data type is integer + call ftr4i4(array(i1),itodo,scale,zero,tofits, + & ival,ival,lval,lval,ival,status) +C create the formated character string + write(sval,wform,err=900)ival +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'F' + & .or. cform(colnum+tstart(ibuff))(1:1) .eq. 'E')then +C column data type is real + call ftr4r4(array(i1),itodo,scale,zero,tofits, + & ival,rval,lval,lval,rval,status) +C create the formated character string + write(sval,wform,err=900)rval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'D')then +C column data type is double precision + call ftr4r8(array(i1),itodo,scale,zero,tofits, + & ival,dval,lval,lval,dval,status) +C create the formated character string + write(sval,wform,err=900)dval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot write Real values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLE).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot write Real values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLE).') + return + end if + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing pixels'//cp1//' to'//cp2 + & // ' to the FITS image array (FTPCLE).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while writing group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLE.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLE).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLE).') + end if + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + if (incre .eq. 0)then + rstart=rstart+1 + else + rstart=rstart+repeat + end if + end if + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred writing '// + & 'Real*4 data to FITS file.') + end if + return + +900 continue +C error writing formatted data value to ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error writing colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to write value'// + & '" with format '//wform//' (FTPCLE).') + status=313 + end diff --git a/pkg/tbtables/fitsio/ftpcli.f b/pkg/tbtables/fitsio/ftpcli.f new file mode 100644 index 00000000..cbed853a --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcli.f @@ -0,0 +1,316 @@ +C---------------------------------------------------------------------- + subroutine ftpcli(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of integer*2 data values to the specified column of +C the table. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array i*2 array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + integer*2 array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + real rval + double precision scale,zero,dval + character sval*40,wform*10,crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,lval,descrp + integer*2 i2val + character*1 i1val + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLI).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) +C the data are being scaled from internal format to FITS: + tofits=.true. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) + maxpix=bufdim/bytpix*4 + +C incre is the byte offset between consecutive pixels + incre=0 + if (tcode .eq. 16)then +C this is an ASCII table; table elements cannot be vectors + repeat=1 + estart=0 + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLI).') + return + else + estart=felem-1 + end if + + if (tcode .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C if this is a primary array or image extension, then +C set repeat as large as needed to write all +C the pixels. This prevents an error message if +C array size is not yet known. The actual array +C dimension must be defined by the NAXISn keywords +C before closing this HDU. + repeat=estart+nelem + else + repeat=trept(colnum+tstart(ibuff)) + end if + + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLI).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C write multiple rows of data at one time + incre=rowlen(ibuff) + repeat=maxpix + estart=0 + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + end if + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C copy data to buffer, doing scaling and datatype conversion, if required + if (tcode .eq. 21)then + call fti2i2(array(i1),itodo,scale,zero,tofits, + & ival,i2val,i2val,lval,lval,buffer,status) +C do any machine dependent conversion and write the I*2 data + call ftpi2b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 41)then +C column data type is J (I*4) + call fti2i4(array(i1),itodo,scale,zero,tofits, + & ival,i2val,ival,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*4 data + call ftpi4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 42)then +C column data type is E (R*4) + call fti2r4(array(i1),itodo,scale,zero,tofits, + & ival,i2val,rval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*4 data + call ftpr4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 82)then +C column data type is D (R*8) + call fti2r8(array(i1),itodo,scale,zero,tofits, + & ival,i2val,dval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*8 data + call ftpr8b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 11)then +C column data type is B (byte) + call fti2i1(array(i1),itodo,scale,zero,tofits, + & ival,i2val,i1val,lval,lval,chbuff,status) +C do any machine dependent data conversion and write the byte data + call ftpi1b(ounit,itodo,incre,chbuff,status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column + wform='( )' + wform(2:9)=cform(colnum+tstart(ibuff)) + if (cform(colnum+tstart(ibuff))(1:1) .eq. 'I')then +C column data type is integer + call fti2i4(array(i1),itodo,scale,zero,tofits, + & ival,i2val,ival,lval,lval,ival,status) +C create the formated character string + write(sval,wform,err=900)ival +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'F' + & .or. cform(colnum+tstart(ibuff))(1:1) .eq. 'E')then +C column data type is real + call fti2r4(array(i1),itodo,scale,zero,tofits, + & ival,i2val,rval,lval,lval,rval,status) +C create the formated character string + write(sval,wform,err=900)rval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'D')then +C column data type is double precision + call fti2r8(array(i1),itodo,scale,zero,tofits, + & ival,i2val,dval,lval,lval,dval,status) +C create the formated character string + write(sval,wform,err=900)dval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot write Integer*2 values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLI).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot write Integer*2 values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLI).') + return + end if + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing pixels'//cp1//' to'//cp2 + & // ' to the FITS image array (FTPCLI).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while writing group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLI.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLI).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLI).') + end if + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + if (incre .eq. 0)then + rstart=rstart+1 + else + rstart=rstart+repeat + end if + end if + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred writing '// + & 'Integer*2 data to FITS file.') + end if + return + +900 continue +C error writing formatted data value to ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error writing colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to write value'// + & '" with format '//wform//' (FTPCLI).') + status=313 + end diff --git a/pkg/tbtables/fitsio/ftpclj.f b/pkg/tbtables/fitsio/ftpclj.f new file mode 100644 index 00000000..a3c86a61 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpclj.f @@ -0,0 +1,320 @@ +C---------------------------------------------------------------------- + subroutine ftpclj(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of integer data values to the specified column of +C the table. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array i array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + integer array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character*1 chbuff(400),xdummy(5360) + common/ftheap/chbuff,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bufdim + parameter (bufdim = 100) + integer buffer(bufdim),bytpix,bstart,tcode,incre + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix,ival + real rval + double precision scale,zero,dval,align + character sval*40,wform*10,crow*9,cp1*9,cp2*9,ccol*4 + logical tofits,lval,descrp + integer*2 i2val + character*1 i1val +C the following equivalence is required for the HP/UX PA-RISC complier +C to force the buffer to be double word aligned. + equivalence (align,buffer(1)) + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLJ).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + descrp=.false. + i1=1 + ntodo=nelem + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + tcode=tdtype(colnum+tstart(ibuff)) +C the data are being scaled from internal format to FITS: + tofits=.true. + +C calculate the maximum number of column pixels which fit in buffer + bytpix=max(abs(tcode)/10,1) + maxpix=bufdim/bytpix*4 + +C incre is the byte offset between consecutive pixels + incre=0 + if (tcode .eq. 16)then +C this is an ASCII table; table elements cannot be vectors + repeat=1 + estart=0 + else +C this is a binary table + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLJ).') + return + else + estart=felem-1 + end if + + if (tcode .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C if this is a primary array or image extension, then +C set repeat as large as needed to write all +C the pixels. This prevents an error message if +C array size is not yet known. The actual array +C dimension must be defined by the NAXISn keywords +C before closing this HDU. + repeat=estart+nelem + else + repeat=trept(colnum+tstart(ibuff)) + end if + + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLJ).') + return + end if + if (repeat .eq. 1 .and. nelem .gt. 1)then +C write multiple rows of data at one time + incre=rowlen(ibuff) + repeat=maxpix + estart=0 + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + end if + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C copy data to buffer, doing scaling and datatype conversion, if required + if (tcode .eq. 21)then +C column data type is I (I*2) + call fti4i2(array(i1),itodo,scale,zero,tofits, + & ival,ival,i2val,lval,lval,buffer,status) +C do any machine dependent data conversion and write the I*2 data + call ftpi2b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 41)then +C column data type is J (I*4) + call fti4i4(array(i1),itodo,scale,zero,tofits, + & ival,ival,ival,lval,lval,buffer,status) +C do any machine dependent conversion and write the I*4 data + call ftpi4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 42)then +C column data type is E (R*4) + call fti4r4(array(i1),itodo,scale,zero,tofits, + & ival,ival,rval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*4 data + call ftpr4b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 82)then +C column data type is D (R*8) + call fti4r8(array(i1),itodo,scale,zero,tofits, + & ival,ival,dval,lval,lval,buffer,status) +C do any machine dependent data conversion and write the R*8 data + call ftpr8b(ounit,itodo,incre,buffer,status) + else if (tcode .eq. 11)then +C column data type is B (byte) + call fti4i1(array(i1),itodo,scale,zero,tofits, + & ival,ival,i1val,lval,lval,chbuff,status) +C do any machine dependent data conversion and write the byte data + call ftpi1b(ounit,itodo,incre,chbuff,status) + else if (tcode .eq. 16 .and. hdutyp(ibuff) .eq. 1)then +C this is an ASCII table column + wform='( )' + wform(2:9)=cform(colnum+tstart(ibuff)) + if (cform(colnum+tstart(ibuff))(1:1) .eq. 'I')then +C column data type is integer + call fti4i4(array(i1),itodo,scale,zero,tofits, + & ival,ival,ival,lval,lval,ival,status) +C create the formated character string + write(sval,wform,err=900)ival +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'F' + & .or. cform(colnum+tstart(ibuff))(1:1) .eq. 'E')then +C column data type is real + call fti4r4(array(i1),itodo,scale,zero,tofits, + & ival,ival,rval,lval,lval,rval,status) +C create the formated character string + write(sval,wform,err=900)rval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else if (cform(colnum+tstart(ibuff))(1:1) .eq. 'D')then +C column data type is double precision + call fti4r8(array(i1),itodo,scale,zero,tofits, + & ival,ival,dval,lval,lval,dval,status) +C create the formated character string + write(sval,wform,err=900)dval +C write the character string to the FITS file + call ftpcbf(ounit,1,tnull(colnum+tstart(ibuff)),sval, + & status) + else +C error: illegal ASCII table format code + status=311 + write(ccol,2001)colnum + call ftpmsg('Cannot write Integer*4 values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLJ).') + return + end if + else +C error illegal binary table data type code + status=312 + write(ccol,2001)colnum + call ftpmsg('Cannot write Integer*4 values to column'//ccol + & //' with TFORM = '//cform(colnum+tstart(ibuff))//' (FTPCLJ).') + return + end if + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing pixels'//cp1//' to'//cp2 + & // ' to the FITS image array (FTPCLJ).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while writing group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLJ.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLJ).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLJ).') + end if + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + if (incre .eq. 0)then + rstart=rstart+1 + else + rstart=rstart+repeat + end if + end if + go to 20 + end if + +C check for any overflows + if (status .eq. -11)then + status=412 + call ftpmsg('Numeric overflow error occurred writing '// + & 'Integer*4 data to FITS file.') + end if + return + +900 continue +C error writing formatted data value to ASCII table + write(ccol,2001)colnum + write(cp1,2000)rstart+1 + call ftpmsg('Error writing colunm'//ccol//', row'//cp1// + & ' of the ASCII Table.') + call ftpmsg('Tried to write value'// + & '" with format '//wform//' (FTPCLJ).') + status=313 + end diff --git a/pkg/tbtables/fitsio/ftpcll.f b/pkg/tbtables/fitsio/ftpcll.f new file mode 100644 index 00000000..43209d90 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcll.f @@ -0,0 +1,162 @@ +C---------------------------------------------------------------------- + subroutine ftpcll(ounit,colnum,frow,felem,nelem,lray,status) + +C write an array of logical values to the specified column of the table. +C The binary table column being written to must have datatype 'L' +C and no datatype conversion will be perform if it is not. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C lray l array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + logical lray(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,maxpix,i + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,tcode + character*1 buffer(80) + character crow*9,cp1*9,cp2*9,ccol*4 + logical descrp + + if (status .gt. 0)return + +C check for zero length array + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLL).') + return + end if + + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLL).') + return + else + estart=felem-1 + end if + + ibuff=bufnum(ounit) +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + i1=1 + ntodo=nelem + rstart=frow-1 + maxpix=80 + +C column must be logical data type + tcode=tdtype(colnum+tstart(ibuff)) + if (tcode .eq. 14)then + descrp=.false. + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLL).') + return + end if + else if (tcode .eq. -14)then + descrp=.true. + repeat=nelem+estart +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat + else +C error illegal data type code + status=310 + return + end if + +C process as many contiguous pixels as possible +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + call ftmbyt(ounit,bstart,.true.,status) + end if + +C create the buffer of logical bytes + do 10 i=1,itodo + if (lray(i1))then + buffer(i)='T' + else + buffer(i)='F' + end if + i1=i1+1 +10 continue + +C write out the buffer + call ftpcbf(ounit,1,itodo,buffer,status) + + if (status .gt. 0)then + write(cp1,2000)i1 + write(cp2,2000)i1+itodo-1 + call ftpmsg('Error while writing values'//cp1//' to'//cp2) + write(ccol,2001)colnum +2001 format(i4) + write(cp1,2000)frow + write(cp2,2000)felem + if (felem .eq. 1)then + call ftpmsg('of column'//ccol//', starting at row'//cp1 + & //' (FTPCLL).') + else + call ftpmsg('of column'//ccol//', starting at row'//cp1 + & //', element'//cp2//' (FTPCLL).') + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftpclm.f b/pkg/tbtables/fitsio/ftpclm.f new file mode 100644 index 00000000..6508bf98 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpclm.f @@ -0,0 +1,186 @@ +C---------------------------------------------------------------------- + subroutine ftpclm(ounit,colnum,frow,felem,nelem,array,status) + +C write an array of double precision complex data values to the +C specified column of the table. +C The binary table column being written to must have datatype 'M' +C and no datatype conversion will be perform if it is not. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array dcmp array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status +C array is really double precison complex + double precision array(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + double precision buffer(100) + integer bytpix,bstart,tcode + integer ibuff,i1,ntodo,itodo,repeat,rstart,estart,maxpix + double precision scale,zero + logical descrp,scaled + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array or bad first row number + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLM).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + i1=1 +C multiply by 2, because the complex data type has pairs of values + ntodo=nelem*2 + rstart=frow-1 + scale=tscale(colnum+tstart(ibuff)) + zero=tzero(colnum+tstart(ibuff)) + if (scale .eq. 1. .and. zero .eq. 0.)then + scaled=.false. + else + scaled=.true. + end if + tcode=tdtype(colnum+tstart(ibuff)) + + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLM).') + return + else +C multiply by 2 because the complex data type has pairs of values + estart=(felem-1)*2 + end if + +C calculate the maximum number of column pixels which fit in buffer + bytpix=8 + maxpix=100 + + if (tcode .eq. 163)then + repeat=trept(colnum+tstart(ibuff))*2 + if (felem*2 .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLM).') + return + end if + descrp=.false. + else if (tcode .eq. -163)then +C this is a variable length descriptor column + descrp=.true. + repeat=nelem+felem-1 +C write the number of elements and the starting offset: + call ftpdes(ounit,colnum,frow,repeat, + & nxheap(ibuff),status) + repeat=repeat*2 +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+nxheap(ibuff)+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+repeat*bytpix + else +C error illegal binary table data type code + status=312 + return + end if + +C process as many contiguous pixels as possible, up to buffer size +20 itodo=min(ntodo,repeat-estart,maxpix) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C scale data into buffer, + call ftuscm(array(i1),itodo,scaled,scale,zero,buffer) + +C do any machine dependent data conversion and write the R*8 data + call ftpr8b(ounit,itodo,0,buffer,status) + + if (status .gt. 0)then + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem+i1-1 + write(cp2,2000)felem+i1+itodo-2 + call ftpmsg('Error writing elements'//cp1//' to'//cp2 + & //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLM.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow+i1-1 + write(cp2,2000)frow+i1+itodo-2 + call ftpmsg('Error writing rows'//cp1//' to'//cp2 + & //' of column'//ccol//' (FTPCLM).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLM).') + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+itodo + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftpcls.f b/pkg/tbtables/fitsio/ftpcls.f new file mode 100644 index 00000000..0588b780 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcls.f @@ -0,0 +1,196 @@ +C---------------------------------------------------------------------- + subroutine ftpcls(ounit,colnum,frow,felem,nelem,sray,status) + +C write an array of character string values to the specified column of +C the table. +C The binary or ASCII table column being written to must have datatype 'A' + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C sray c array of data values to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + character*(*) sray(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,strlen,c1,c2,repeat,twidth + integer ibuff,i1,ntodo,rstart,estart,nchars,clen,tcode + character sbuff*80,blank*80,crow*9,cp1*9,cp2*9,ccol*4 + logical small,fill + + if (status .gt. 0)return + +C check for zero length array + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLS).') + return + end if + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLS).') + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + blank=' ' + i1=1 + +C column must be character string data type + tcode=tdtype(colnum+tstart(ibuff)) + if (tcode .eq. 16)then +C for ASCII columns, TNULL actually stores the field width + twidth=tnull(colnum+tstart(ibuff)) + ntodo=nelem + rstart=frow-1 + repeat=trept(colnum+tstart(ibuff)) + estart=felem-1 + if (estart .ge. repeat)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLS).') + return + end if + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*twidth + else if (tcode .eq. -16)then +C this is a variable length descriptor field +C the length of the output string is defined by nelem + twidth=nelem + ntodo=1 + repeat=1 +C write the number of string length and the starting offset: + call ftpdes(ounit,colnum,frow,twidth, + & nxheap(ibuff),status) +C calc the i/o pointer position for the start of the string + bstart=dtstrt(ibuff)+nxheap(ibuff)+theap(ibuff) +C increment the empty heap starting address: + nxheap(ibuff)=nxheap(ibuff)+twidth + else +C error: not a character string column + status=309 + return + end if + +C move the i/o pointer to the start of the sequence of pixels + call ftmbyt(ounit,bstart,.true.,status) + +C is the input string short enough to completely fit in buffer? + strlen=len(sray(1)) + if (strlen .gt. 80 .and. twidth .gt. 80)then + small=.false. + else + small=.true. + end if + +C do we need to pad the FITS string field with trailing blanks? + if (twidth .gt. strlen)then + fill=.true. + else + fill=.false. + end if + +C process one string at a time +20 continue + nchars=min(strlen,twidth) + if (small)then +C the whole input string fits in the temporary buffer + sbuff=sray(i1) +C output the string + call ftpcbf(ounit,1,nchars,sbuff,status) + else +C have to write the string in several pieces + c1=1 + c2=80 +30 sbuff=sray(i1)(c1:c2) +C output the string + clen=c2-c1+1 + call ftpcbf(ounit,1,clen,sbuff,status) + nchars=nchars-clen + if (nchars .gt. 0)then + c1=c1+80 + c2=min(c2+80,c1+nchars-1) + go to 30 + end if + end if + +C pad any remaining space in the column with blanks + if (fill)then + nchars=twidth-strlen +40 clen=min(nchars,80) + call ftpcbf(ounit,1,clen,blank,status) + nchars=nchars-80 + if (nchars .gt. 0)go to 40 + end if + + if (status .gt. 0)then + write(cp1,2000)i1 + call ftpmsg('Error while writing ASCII string to ') + write(ccol,2001)colnum +2001 format(i4) + write(cp1,2000)rstart+1 + write(cp2,2000)estart+1 + if (felem .eq. 1)then + call ftpmsg('column'//ccol//', row'//cp1 + & //' (FTPCLS).') + else + call ftpmsg('column'//ccol//', row'//cp1 + & //', element'//cp2//' (FTPCLS).') + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-1 + if (ntodo .gt. 0)then +C increment the pointers + i1=i1+1 + estart=estart+1 + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff)) +C move the i/o pointer + call ftmbyt(ounit,bstart,.true.,status) + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftpclu.f b/pkg/tbtables/fitsio/ftpclu.f new file mode 100644 index 00000000..84e8f5f6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpclu.f @@ -0,0 +1,279 @@ +C---------------------------------------------------------------------- + subroutine ftpclu(ounit,colnum,frow,felem,nelem,status) + +C set elements of a table to be undefined + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,frow,felem,nelem,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) + character snull*500 + character*1 xdummy(5260) + common/ftheap/snull,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bytpix,bstart,i4null,tcode,nchars,i,offset,nulval + integer ibuff,ntodo,itodo,repeat,rstart,estart + integer*2 i2null,l1null + real r4null + double precision r8null + logical descrp + character*1 i1null + character crow*9,cp1*9,cp2*9,ccol*4 + + if (status .gt. 0)return + +C check for zero length array + if (nelem .le. 0)return + if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLU).') + return + end if + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + + tcode=tdtype(colnum+tstart(ibuff)) + bytpix=max(abs(tcode)/10,1) + + descrp=.false. + ntodo=nelem + rstart=frow-1 + + if (felem .lt. 1)then +C illegal element number + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLU).') + return + else + estart=felem-1 + end if + + if (tcode .eq. 16)then +C this is an ASCII field + repeat=trept(colnum+tstart(ibuff)) + if (felem .gt. repeat)then + status=308 + write(crow,2000)felem + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLU).') + return + end if + + if (cnull(colnum+tstart(ibuff))(1:1) .eq. char(1))then +C error: null value has not been defined + status=314 + call ftpmsg('Null value string for ASCII table'// + & ' column has not yet been defined (FTPCLU).') + return + end if +C the TNULL parameter stores the width of the character field + bytpix=tnull(colnum+tstart(ibuff)) + else +C this is a binary table + nulval=tnull(colnum+tstart(ibuff)) + + if (tcode .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C if this is a primary array or image extension, then +C set repeat as large as needed to write all +C the pixels. This prevents an error message if +C array size is not yet known. The actual array +C dimension must be defined by the NAXISn keywords +C before closing this HDU. + repeat=estart+nelem + else + repeat=trept(colnum+tstart(ibuff)) + end if + + if (felem .gt. repeat)then +C illegal element number + status=308 + return + end if + else +C this is a variable length descriptor column + descrp=.true. + tcode=-tcode +C read the number of elements and the starting offset: + call ftgdes(ounit,colnum,frow,repeat, + & offset,status) + if (ntodo+estart .gt. repeat)then +C error: tried to write past end of record + status=319 + return + end if + +C move the i/o pointer to the start of the pixel sequence + bstart=dtstrt(ibuff)+offset+ + & theap(ibuff)+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + + if (tcode.eq.11 .or. tcode.eq.21 .or. tcode.eq.41)then + if (nulval .eq. 123454321)then +C error: null value has not been defined + status=314 + call ftpmsg('Null value for integer'// + & ' column has not yet been defined (FTPCLU).') + return + end if + else +C set the floating point Not-a-Number values + call ftsrnn(r4null) + call ftsdnn(r8null) + end if + + end if + +C process as many contiguous pixels as possible +20 itodo=min(ntodo,repeat-estart) + + if (.not. descrp)then +C move the i/o pointer to the start of the sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff))+estart*bytpix + call ftmbyt(ounit,bstart,.true.,status) + end if + +C write the appropriate null value to the pixels + if (tcode .eq. 21)then +C column data type is I (I*2) + do 5 i=1,itodo + i2null=nulval + call ftpi2b(ounit,1,0,i2null,status) +5 continue + else if (tcode .eq. 41)then +C column data type is J (I*4) + do 15 i=1,itodo + i4null=nulval + call ftpi4b(ounit,1,0,i4null,status) +15 continue + else if (tcode .eq. 42)then +C column data type is E (R*4) + do 25 i=1,itodo + call ftpbyt(ounit,4,r4null,status) +25 continue + else if (tcode .eq. 82 .or. tcode .eq. 83)then +C column data type is D (R*8), or C complex 2 x R*4 + do 35 i=1,itodo + call ftpbyt(ounit,8,r8null,status) +35 continue + else if (tcode .eq. 16)then +C this is an ASCII table column + snull=cnull(colnum+tstart(ibuff)) +C write up to 500 characters in the column, remainder unchanged +C (500 is the maximum size string allowed in IBM AIX compiler) + nchars=min(bytpix,500) + do 45 i=1,itodo + call ftpcbf(ounit,1,nchars,snull,status) +45 continue + else if (tcode .eq. 11)then +C column data type is B (byte) + i1null=char(nulval) + do 55 i=1,itodo + call ftpcbf(ounit,0,1,i1null,status) +55 continue + else if (tcode .eq. 163)then +C column data type is double complex (M) + do 65 i=1,itodo*2 + call ftpbyt(ounit,8,r8null,status) +65 continue + else if (tcode .eq. 14)then +C column data type is logical (L) + l1null=0 + do 85 i=1,itodo + call ftpbyt(ounit,1,l1null,status) +85 continue + end if + + + if (status .gt. 0)then + if (hdutyp(ibuff) .eq. 0)then +C this is a primary array or image extension + write(cp1,2000)felem+nelem-ntodo + write(cp2,2000)felem+nelem-ntodo+itodo-1 + call ftpmsg('Error writing Nulls to pixels' + & //cp1//' to'//cp2//' in the FITS array (FTPCLU).') + if (frow .ne. 1)then + write(cp1,2000)frow + call ftpmsg('Error while writing group'//cp1// + & ' of the multigroup primary array.') + end if + else + write(ccol,2001)colnum +2001 format(i4) + if (descrp)then +C this is a variable length descriptor column + write(crow,2000)frow + write(cp1,2000)felem + write(cp2,2000)felem+nelem-1 + call ftpmsg('Error writing Nulls to elements'//cp1// + & ' to'//cp2 //' in row'//crow) + call ftpmsg(' of variable length vector column'//ccol + & //' (FTPCLU.') + else if (trept(colnum+tstart(ibuff)) .eq. 1)then +C this is not a vector column (simple case) + write(cp1,2000)frow + write(cp2,2000)frow+nelem-1 + call ftpmsg('Error writing Nulls to rows'//cp1//' to' + & //cp2//' of column'//ccol//' (FTPCLU).') + else +C this is a vector column (more complicated case) + write(crow,2000)rstart+1 + write(cp1,2000)estart+1 + write(cp2,2000)itodo + call ftpmsg('Error writing'//cp2//' Null elements to' + & //' column'//ccol) + call ftpmsg(' starting at row'//crow + & //', element'//cp1//' (FTPCLU).') + end if + end if + return + end if + +C find number of pixels left to do, and quit if none left + ntodo=ntodo-itodo + if (ntodo .gt. 0)then +C increment the pointers + estart=estart+itodo + if (estart .eq. repeat)then + estart=0 + rstart=rstart+1 + end if + go to 20 + end if + end diff --git a/pkg/tbtables/fitsio/ftpclx.f b/pkg/tbtables/fitsio/ftpclx.f new file mode 100644 index 00000000..67b82e27 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpclx.f @@ -0,0 +1,189 @@ +C---------------------------------------------------------------------- + subroutine ftpclx(iunit,colnum,frow,fbit,nbit,lray,status) + +C write an array of logical values to a specified bit or byte +C column of the binary table. If the LRAY parameter is .true., +C then the corresponding bit is set to 1, otherwise it is set +C to 0. +C The binary table column being written to must have datatype 'B' +C or 'X'. + +C iunit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C fbit i first bit within the row to write +C nbit i number of bits to write +C lray l array of logical data values corresponding to the bits +C to be written +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Mar 1992 +C modified by Wm Pence May 1992 to remove call to system dependent +C bit testing and setting routines. + + integer iunit,colnum,frow,fbit,nbit,status + logical lray(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer bstart,offset,tcode,fbyte,bitloc,ndone,tstat + integer ibuff,i,ntodo,repeat,rstart,estart,buffer + logical descrp,wrbit(8),setbit(8) + character*1 cbuff + character crow*9 + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + tcode=tdtype(colnum+tstart(ibuff)) + +C check input parameters + if (nbit .le. 0)then + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + write(crow,2000)frow +2000 format(i9) + call ftpmsg('Starting row number for table write '// + & 'request is out of range:'//crow//' (FTPCLX).') + return + else if (fbit .lt. 1)then +C illegal element number + status=308 + write(crow,2000)fbit + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLX).') + return + end if + + fbyte=(fbit+7)/8 + bitloc=fbit-(fbit-1)/8*8 + ndone=0 + ntodo=nbit + rstart=frow-1 + estart=fbyte-1 + + if (tcode .eq. 11)then + descrp=.false. +C N.B: REPEAT is the number of bytes, not number of bits + repeat=trept(colnum+tstart(ibuff)) + if (fbyte .gt. repeat)then +C illegal element number + status=308 + write(crow,2000)fbit + call ftpmsg('Starting element number for write '// + & 'request is out of range:'//crow//' (FTPCLX).') + return + end if +C calc the i/o pointer location to start of sequence of pixels + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + else if (tcode .eq. -11)then +C this is a variable length descriptor column + descrp=.true. +C only bit arrays (tform = 'X') are supported for variable +C length arrays. REPEAT is the number of BITS in the array. + repeat=estart+ntodo + offset=nxheap(ibuff) +C write the number of elements and the starting offset: + call ftpdes(iunit,colnum,frow,repeat, + & offset,status) +C calc the i/o pointer location to start of sequence of pixels + bstart=dtstrt(ibuff)+offset+ + & theap(ibuff)+estart +C increment the empty heap starting address (in bytes): + repeat=(repeat+7)/8 + nxheap(ibuff)=nxheap(ibuff)+repeat + else +C column must be byte or bit data type + status=310 + return + end if + +C move the i/o pointer to the start of the pixel sequence + call ftmbyt(iunit,bstart,.true.,status) + tstat=0 + +C read the next byte (we may only be modifying some of the bits) +20 call ftgcbf(iunit,0,1,cbuff,status) + if (status .eq. 107)then +C hit end of file trying to read the byte, so just set byte = 0 + status=tstat + cbuff=char(0) + end if + + buffer=ichar(cbuff) + if (buffer .lt. 0)buffer=buffer+256 +C move back, to be able to overwrite the byte + call ftmbyt(iunit,bstart,.true.,status) + +C reset flags indicating which bits are to be set + wrbit(1)=.false. + wrbit(2)=.false. + wrbit(3)=.false. + wrbit(4)=.false. + wrbit(5)=.false. + wrbit(6)=.false. + wrbit(7)=.false. + wrbit(8)=.false. + +C flag the bits that are to be set + do 10 i=bitloc,8 + wrbit(i)=.true. + ndone=ndone+1 + if(lray(ndone))then + setbit(i)=.true. + else + setbit(i)=.false. + end if + if (ndone .eq. ntodo)go to 100 +10 continue + +C set or reset the bits within the byte + call ftpbit(setbit,wrbit,buffer) + +C write the new byte + cbuff=char(buffer) + call ftpcbf(iunit,0,1,cbuff,status) + +C not done, so get the next byte + bstart=bstart+1 + if (.not. descrp)then + estart=estart+1 + if (estart .eq. repeat)then +C move the i/o pointer to the next row of pixels + estart=0 + rstart=rstart+1 + bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+ + & tbcol(colnum+tstart(ibuff))+estart + call ftmbyt(iunit,bstart,.true.,status) + end if + end if + bitloc=1 + go to 20 + +100 continue +C set or reset the bits within the byte + call ftpbit(setbit,wrbit,buffer) + +C write the new byte + cbuff=char(buffer) + call ftpcbf(iunit,0,1,cbuff,status) + end diff --git a/pkg/tbtables/fitsio/ftpcnb.f b/pkg/tbtables/fitsio/ftpcnb.f new file mode 100644 index 00000000..89c965da --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcnb.f @@ -0,0 +1,96 @@ +C---------------------------------------------------------------------- + subroutine ftpcnb(ounit,colnum,frow,felem,nelem,array,nulval, + & status) + +C write array of character*1 (byte) pixels to the specified column +C of a table. Any input pixels equal to the value of NULVAL will +C be replaced by the appropriate null value in the output FITS file. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array c*1 array of data values to be written +C nulval c*1 pixel value used to represent an undefine pixel +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,colnum,frow,felem,nelem,status + character*1 array(*),nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,repeat,first,ngood,nbad,i,fstelm,fstrow + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C get the column repeat count and calculate the absolute position within +C the column of the first element to be written + repeat=trept(colnum+tstart(ibuff)) + first=(frow-1)*repeat+felem-1 + + ngood=0 + nbad=0 + do 10 i=1,nelem + if (array(i) .ne. nulval)then + ngood=ngood+1 + if (nbad .gt. 0)then +C write the previous consecutive set of null pixels + fstelm=i-nbad+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + nbad=0 + end if + else + nbad=nbad+1 + if (ngood .gt. 0)then +C write the previous consecutive set of good pixels + fstelm=i-ngood+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclb(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + ngood=0 + end if + end if +10 continue + +C finished; now just write the last set of pixels + if (nbad .gt. 0)then +C write the consecutive set of null pixels + fstelm=i-nbad+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + else +C write the consecutive set of good pixels + fstelm=i-ngood+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclb(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpcnd.f b/pkg/tbtables/fitsio/ftpcnd.f new file mode 100644 index 00000000..f390a8ca --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcnd.f @@ -0,0 +1,96 @@ +C---------------------------------------------------------------------- + subroutine ftpcnd(ounit,colnum,frow,felem,nelem,array,nulval, + & status) + +C write array of double precision pixels to the specified column +C of a table. Any input pixels equal to the value of NULVAL will +C be replaced by the appropriate null value in the output FITS file. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array d array of data values to be written +C nulval d pixel value used to represent an undefine pixel +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,colnum,frow,felem,nelem,status + double precision array(*),nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,repeat,first,ngood,nbad,i,fstelm,fstrow + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C get the column repeat count and calculate the absolute position within +C the column of the first element to be written + repeat=trept(colnum+tstart(ibuff)) + first=(frow-1)*repeat+felem-1 + + ngood=0 + nbad=0 + do 10 i=1,nelem + if (array(i) .ne. nulval)then + ngood=ngood+1 + if (nbad .gt. 0)then +C write the previous consecutive set of null pixels + fstelm=i-nbad+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + nbad=0 + end if + else + nbad=nbad+1 + if (ngood .gt. 0)then +C write the previous consecutive set of good pixels + fstelm=i-ngood+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpcld(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + ngood=0 + end if + end if +10 continue + +C finished; now just write the last set of pixels + if (nbad .gt. 0)then +C write the consecutive set of null pixels + fstelm=i-nbad+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + else +C write the consecutive set of good pixels + fstelm=i-ngood+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpcld(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpcne.f b/pkg/tbtables/fitsio/ftpcne.f new file mode 100644 index 00000000..d30031af --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcne.f @@ -0,0 +1,96 @@ +C---------------------------------------------------------------------- + subroutine ftpcne(ounit,colnum,frow,felem,nelem,array,nulval, + & status) + +C write array of floating point pixels to the specified column +C of a table. Any input pixels equal to the value of NULVAL will +C be replaced by the appropriate null value in the output FITS file. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array r array of data values to be written +C nulval r pixel value used to represent an undefine pixel +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,colnum,frow,felem,nelem,status + real array(*),nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,repeat,first,ngood,nbad,i,fstelm,fstrow + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C get the column repeat count and calculate the absolute position within +C the column of the first element to be written + repeat=trept(colnum+tstart(ibuff)) + first=(frow-1)*repeat+felem-1 + + ngood=0 + nbad=0 + do 10 i=1,nelem + if (array(i) .ne. nulval)then + ngood=ngood+1 + if (nbad .gt. 0)then +C write the previous consecutive set of null pixels + fstelm=i-nbad+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + nbad=0 + end if + else + nbad=nbad+1 + if (ngood .gt. 0)then +C write the previous consecutive set of good pixels + fstelm=i-ngood+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpcle(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + ngood=0 + end if + end if +10 continue + +C finished; now just write the last set of pixels + if (nbad .gt. 0)then +C write the consecutive set of null pixels + fstelm=i-nbad+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + else +C write the consecutive set of good pixels + fstelm=i-ngood+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpcle(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpcni.f b/pkg/tbtables/fitsio/ftpcni.f new file mode 100644 index 00000000..408fdfa7 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcni.f @@ -0,0 +1,96 @@ +C---------------------------------------------------------------------- + subroutine ftpcni(ounit,colnum,frow,felem,nelem,array,nulval, + & status) + +C write array of integer*2 pixels to the specified column +C of a table. Any input pixels equal to the value of NULVAL will +C be replaced by the appropriate null value in the output FITS file. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array i*2 array of data values to be written +C nulval i*2 pixel value used to represent an undefine pixel +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,colnum,frow,felem,nelem,status + integer*2 array(*),nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,repeat,first,ngood,nbad,i,fstelm,fstrow + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C get the column repeat count and calculate the absolute position within +C the column of the first element to be written + repeat=trept(colnum+tstart(ibuff)) + first=(frow-1)*repeat+felem-1 + + ngood=0 + nbad=0 + do 10 i=1,nelem + if (array(i) .ne. nulval)then + ngood=ngood+1 + if (nbad .gt. 0)then +C write the previous consecutive set of null pixels + fstelm=i-nbad+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + nbad=0 + end if + else + nbad=nbad+1 + if (ngood .gt. 0)then +C write the previous consecutive set of good pixels + fstelm=i-ngood+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpcli(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + ngood=0 + end if + end if +10 continue + +C finished; now just write the last set of pixels + if (nbad .gt. 0)then +C write the consecutive set of null pixels + fstelm=i-nbad+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + else +C write the consecutive set of good pixels + fstelm=i-ngood+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpcli(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpcnj.f b/pkg/tbtables/fitsio/ftpcnj.f new file mode 100644 index 00000000..45d8ea1c --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcnj.f @@ -0,0 +1,96 @@ +C---------------------------------------------------------------------- + subroutine ftpcnj(ounit,colnum,frow,felem,nelem,array,nulval, + & status) + +C write array of integer pixels to the specified column +C of a table. Any input pixels equal to the value of NULVAL will +C be replaced by the appropriate null value in the output FITS file. + +C ounit i fortran unit number +C colnum i number of the column to write to +C frow i first row to write +C felem i first element within the row to write +C nelem i number of elements to write +C array i array of data values to be written +C nulval i pixel value used to represent an undefine pixel +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,colnum,frow,felem,nelem,status + integer array(*),nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,repeat,first,ngood,nbad,i,fstelm,fstrow + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C get the column repeat count and calculate the absolute position within +C the column of the first element to be written + repeat=trept(colnum+tstart(ibuff)) + first=(frow-1)*repeat+felem-1 + + ngood=0 + nbad=0 + do 10 i=1,nelem + if (array(i) .ne. nulval)then + ngood=ngood+1 + if (nbad .gt. 0)then +C write the previous consecutive set of null pixels + fstelm=i-nbad+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + nbad=0 + end if + else + nbad=nbad+1 + if (ngood .gt. 0)then +C write the previous consecutive set of good pixels + fstelm=i-ngood+first +C calculate the row and element of the first pixel to write + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclj(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + ngood=0 + end if + end if +10 continue + +C finished; now just write the last set of pixels + if (nbad .gt. 0)then +C write the consecutive set of null pixels + fstelm=i-nbad+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclu(ounit,colnum,fstrow,fstelm,nbad,status) + else +C write the consecutive set of good pixels + fstelm=i-ngood+first + fstrow=(fstelm-1)/repeat+1 + fstelm=fstelm-(fstrow-1)*repeat + call ftpclj(ounit,colnum,fstrow,fstelm,ngood, + & array(i-ngood),status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpcom.f b/pkg/tbtables/fitsio/ftpcom.f new file mode 100644 index 00000000..f056eea2 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpcom.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftpcom(ounit,commnt,status) + +C write a COMMENT record to the FITS header +C +C ounit i fortran output unit number +C commnt c input comment string +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,status,strlen,actlen,i,nkeys,c1,c2 + character*(*) commnt + character*80 rec + + if (status .gt. 0)return + +C find the length of the string, and write it out 70 characters at a time + nkeys=1 + strlen=len(commnt) + actlen=strlen + do 10 i=strlen,1,-1 + if (commnt(i:i) .ne. ' ')then + actlen=i + go to 20 + end if +10 continue + +20 c1=1 + c2=min(actlen,70) + nkeys=(actlen-1)/70+1 + do 30 i=1,nkeys + rec='COMMENT '//commnt(c1:c2) + call ftprec(ounit,rec,status) + c1=c1+70 + c2=min(actlen,c2+70) +30 continue + end diff --git a/pkg/tbtables/fitsio/ftpdat.f b/pkg/tbtables/fitsio/ftpdat.f new file mode 100644 index 00000000..091922d4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpdat.f @@ -0,0 +1,33 @@ +C-------------------------------------------------------------------------- + subroutine ftpdat(ounit,status) + +C write the current date to the DATE keyword in the ounit CHU +C +C ounit i fortran output unit number +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Jan 1992 + + integer ounit,status,dd,mm,yy + character datstr*8 + +C call the system dependent routine to get the current date + call ftgsdt(dd,mm,yy,status) + if (status .gt. 0)return + + datstr=' / / ' + write(datstr(1:2),1001)dd + write(datstr(4:5),1001)mm + write(datstr(7:8),1001)yy +1001 format(i2) + +C replace blank with leading 0 in each field if required + if (datstr(1:1) .eq. ' ')datstr(1:1)='0' + if (datstr(4:4) .eq. ' ')datstr(4:4)='0' + if (datstr(7:7) .eq. ' ')datstr(7:7)='0' + +C update the DATE keyword + call ftukys(ounit,'DATE',datstr, + & 'FITS file creation date (dd/mm/yy)',status) + end diff --git a/pkg/tbtables/fitsio/ftpdef.f b/pkg/tbtables/fitsio/ftpdef.f new file mode 100644 index 00000000..a8ebb140 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpdef.f @@ -0,0 +1,156 @@ +C-------------------------------------------------------------------------- + subroutine ftpdef(ounit,bitpix,naxis,naxes,pcount,gcount, + & status) + +C Primary data DEFinition +C define the structure of the primary data unit or an IMAGE extension +C +C ounit i Fortran I/O unit number +C bitpix i bits per pixel value +C naxis i number of data axes +C naxes i length of each data axis (array) +C pcount i number of group parameters +C gcount i number of 'random groups' +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,bitpix,naxis,naxes(*),pcount,gcount,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,ttype,bytlen,npix,i,pcnt,gcnt + character caxis*20 + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + + if (dtstrt(ibuff) .lt. 0)then +C freeze the header at its current size + call fthdef(ounit,0,status) + if (status .gt. 0)return + end if + +C check for error conditions + if (naxis .lt. 0)then + status=212 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPDEF ' + & //'is illegal.') + + else if (pcount .lt. 0)then + status=214 + else if (gcount .lt. 0)then + status=215 + else + go to 5 + end if + return + +C test that bitpix has a legal value and set the datatype code value +5 if (bitpix .eq. 8)then + ttype=11 + bytlen=1 + else if (bitpix .eq. 16)then + ttype=21 + bytlen=2 + else if (bitpix .eq. 32)then + ttype=41 + bytlen=4 + else if (bitpix .eq. -32)then + ttype=42 + bytlen=4 + else if (bitpix .eq. -64)then + ttype=82 + bytlen=8 + else +C illegal value of bitpix + status=211 + return + end if + +C calculate the number of pixels in the array + if (naxis .eq. 0)then +C no data + npix=0 + gcnt=0 + pcnt=0 + else +C make sure that the gcount is not zero + gcnt=max(gcount,1) + pcnt=pcount + npix=1 + do 10 i=1,naxis + if (naxes(i) .ge. 0)then +C The convension used by 'random groups' with NAXIS1 = 0 is not +C directly supported here. If one wants to write a 'random group' +C FITS file, then one should call FTPDEF with naxes(1) = 1, but +C then write the required header keywords (with FTPHPR) with +C naxes(1) = 0. + npix=npix*naxes(i) + else if (naxes(i) .lt. 0)then + status=213 + return + end if +10 continue + end if +C the next HDU begins in the next logical block after the data + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+((pcnt+npix)*bytlen*gcnt+2879)/2880*2880 + +C the primary array is actually interpreted as a binary table. There +C are two columns: the first column contains the +C group parameters, if any, and the second column contains the +C primary array of data. Each group is a separate row in the table. +C The scaling and null values are set to the default values. + + hdutyp(ibuff)=0 + tfield(ibuff)=2 + + if (nxtfld + 2 .gt. nf)then +C too many columns open at one time; exceeded array dimensions + status=111 + else + tstart(ibuff)=nxtfld + nxtfld=nxtfld+2 + tdtype(1+tstart(ibuff))=ttype + tdtype(2+tstart(ibuff))=ttype + trept(1+tstart(ibuff))=pcnt + trept(2+tstart(ibuff))=npix +C choose a special value to represent the absence of a blank value + tnull(1+tstart(ibuff))=123454321 + tnull(2+tstart(ibuff))=123454321 + tscale(1+tstart(ibuff))=1. + tscale(2+tstart(ibuff))=1. + tzero(1+tstart(ibuff))=0. + tzero(2+tstart(ibuff))=0. + tbcol(1+tstart(ibuff))=0 + tbcol(2+tstart(ibuff))=pcnt*bytlen + rowlen(ibuff)=(pcnt+npix)*bytlen + end if + +C initialize the fictitious heap starting address (immediately following +C the array data) and a zero length heap. This is used to find the +C end of the data when checking the fill values in the last block. + scount(ibuff)=0 + theap(ibuff)=(pcnt+npix)*bytlen*gcnt + nxheap(ibuff)=0 + end diff --git a/pkg/tbtables/fitsio/ftpdes.f b/pkg/tbtables/fitsio/ftpdes.f new file mode 100644 index 00000000..f81c79bf --- /dev/null +++ b/pkg/tbtables/fitsio/ftpdes.f @@ -0,0 +1,63 @@ +C---------------------------------------------------------------------- + subroutine ftpdes(ounit,colnum,rownum,nelem,offset,status) + +C write the descriptor values to a binary table. This is only +C used for column which have TFORMn = 'P', i.e., for variable +C length arrays. + +C ounit i fortran unit number +C colnum i number of the column to write to +C rownum i number of the row to write +C nelem i input number of elements +C offset i input byte offset of the first element +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Nov 1991 + + integer ounit,colnum,rownum,nelem,offset,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bstart,iray(2) + + if (status .gt. 0)return + if (rownum .lt. 1)then +C error: illegal row number + status=307 + return + end if + + ibuff=bufnum(ounit) + +C check that this is really a 'P' type column + if (tdtype(colnum+tstart(ibuff)) .ge. 0)then + status=317 + return + end if + +C move to the specified column and row: + bstart=dtstrt(ibuff)+(rownum-1)*rowlen(ibuff) + & +tbcol(colnum+tstart(ibuff)) + call ftmbyt(ounit,bstart,.true.,status) + +C now write the number of elements and the offset to the table: + iray(1)=nelem + iray(2)=offset + call ftpi4b(ounit,2,0,iray,status) + end diff --git a/pkg/tbtables/fitsio/ftpdfl.f b/pkg/tbtables/fitsio/ftpdfl.f new file mode 100644 index 00000000..33d7eeec --- /dev/null +++ b/pkg/tbtables/fitsio/ftpdfl.f @@ -0,0 +1,94 @@ +C---------------------------------------------------------------------- + subroutine ftpdfl(iunit,status) + +C Write the Data Unit Fill values if they are not already correct +C Fill the data unit with zeros or blanks depending on the type of HDU +C from the end of the data to the end of the current FITS 2880 byte block + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, June, 1994 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nf = 3000) + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 chbuff(2880),chfill,xdummy(2879) + common/ftheap/chbuff,chfill,xdummy +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,filpos,nfill,i,tstat + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check if the data unit is null + + if (theap(ibuff) .eq. 0)return + + filpos=dtstrt(ibuff)+theap(ibuff)+scount(ibuff) + nfill=(filpos+2879)/2880*2880-filpos + +C return if there are no fill bytes + if (nfill .eq. 0)return + +C set the correct fill value to be checked + if (hdutyp(ibuff) .eq. 1)then +C this is an ASCII table; should be filled with blanks + chfill=char(32) + else + chfill=char(0) + end if + +C move to the beginning of the fill bytes and read them + tstat=status + call ftmbyt(iunit,filpos,.true.,status) + call ftgcbf(iunit,0,nfill,chbuff,status) + + if (status .gt. 0)then +C fill bytes probably haven't been written yet so have to write them + status=tstat + go to 100 + end if + +C check if all the fill values are correct + do 10 i=1,nfill + if (chbuff(i) .ne. chfill)go to 100 +10 continue + +C fill bytes were correct, so just return + return + +100 continue + +C fill the buffer with the correct fill value + do 20 i=1,nfill + chbuff(i)=chfill +20 continue + +C move to the beginning of the fill bytes + call ftmbyt(iunit,filpos,.true.,status) + +C write all the fill bytes + call ftpcbf(iunit,0,nfill,chbuff,status) + + if (status .gt. 0)then + call ftpmsg('Error writing Data Unit fill bytes (FTPDFL).') + end if + end diff --git a/pkg/tbtables/fitsio/ftpgpb.f b/pkg/tbtables/fitsio/ftpgpb.f new file mode 100644 index 00000000..2cc4ffef --- /dev/null +++ b/pkg/tbtables/fitsio/ftpgpb.f @@ -0,0 +1,28 @@ +C---------------------------------------------------------------------- + subroutine ftpgpb(ounit,group,fparm,nparm,array,status) + +C Write an array of group parmeters into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C fparm i the first group parameter to be written (starting with 1) +C nparm i number of group parameters to be written +C array b the array of group parameters to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,fparm,nparm,status,row + + character*1 array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpclb(ounit,1,row,fparm,nparm,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpgpd.f b/pkg/tbtables/fitsio/ftpgpd.f new file mode 100644 index 00000000..186df96c --- /dev/null +++ b/pkg/tbtables/fitsio/ftpgpd.f @@ -0,0 +1,27 @@ +C---------------------------------------------------------------------- + subroutine ftpgpd(ounit,group,fparm,nparm,array,status) + +C Write an array of group parmeters into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C fparm i the first group parameter to be written (starting with 1) +C nparm i number of group parameters to be written +C array d the array of group parameters to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,fparm,nparm,status,row + double precision array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcld(ounit,1,row,fparm,nparm,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpgpe.f b/pkg/tbtables/fitsio/ftpgpe.f new file mode 100644 index 00000000..506c238d --- /dev/null +++ b/pkg/tbtables/fitsio/ftpgpe.f @@ -0,0 +1,27 @@ +C---------------------------------------------------------------------- + subroutine ftpgpe(ounit,group,fparm,nparm,array,status) + +C Write an array of group parmeters into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C fparm i the first group parameter to be written (starting with 1) +C nparm i number of group parameters to be written +C array r the array of group parameters to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,fparm,nparm,status,row + real array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcle(ounit,1,row,fparm,nparm,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpgpi.f b/pkg/tbtables/fitsio/ftpgpi.f new file mode 100644 index 00000000..c07a7294 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpgpi.f @@ -0,0 +1,27 @@ +C---------------------------------------------------------------------- + subroutine ftpgpi(ounit,group,fparm,nparm,array,status) + +C Write an array of group parmeters into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C fparm i the first group parameter to be written (starting with 1) +C nparm i number of group parameters to be written +C array i*2 the array of group parameters to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,fparm,nparm,status,row + integer*2 array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcli(ounit,1,row,fparm,nparm,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpgpj.f b/pkg/tbtables/fitsio/ftpgpj.f new file mode 100644 index 00000000..15dc670e --- /dev/null +++ b/pkg/tbtables/fitsio/ftpgpj.f @@ -0,0 +1,27 @@ +C---------------------------------------------------------------------- + subroutine ftpgpj(ounit,group,fparm,nparm,array,status) + +C Write an array of group parmeters into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C fparm i the first group parameter to be written (starting with 1) +C nparm i number of group parameters to be written +C array i the array of group parameters to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,fparm,nparm,status,row + integer array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpclj(ounit,1,row,fparm,nparm,array,status) + end diff --git a/pkg/tbtables/fitsio/ftphbn.f b/pkg/tbtables/fitsio/ftphbn.f new file mode 100644 index 00000000..712dd37c --- /dev/null +++ b/pkg/tbtables/fitsio/ftphbn.f @@ -0,0 +1,130 @@ +C---------------------------------------------------------------------- + subroutine ftphbn(ounit,nrows,nfield,ttype,tform,tunit, + & extnam,pcount,status) + +C write required standard header keywords for a binary table extension +C +C ounit i fortran output unit number +C nrows i number of rows in the table +C nfield i number of fields in the table +C ttype c name of each field (array) (optional) +C tform c format of each field (array) +C tunit c units of each field (array) (optional) +C extnam c name of table extension (optional) +C pcount i size of special data area following the table (usually = 0) +C OUTPUT PARAMETERS: +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,nrows,nfield,pcount,status + integer i,lenrow,dtype,rcount,xbcol,length,width + character*(*) ttype(*),tform(*),tunit(*),extnam + character comm*48,tfm*40 + + comm='binary table extension' + call ftpkys(ounit,'XTENSION','BINTABLE',comm,status) + + comm='8-bit bytes' + call ftpkyj(ounit,'BITPIX',8,comm,status) + + comm='2-dimensional binary table' + call ftpkyj(ounit,'NAXIS',2,comm,status) + + if (status .gt. 0)return + +C calculate the total width of each row, in bytes + lenrow=0 + do 10 i=1,nfield +C get the numerical datatype and repeat count of the field + call ftbnfm(tform(i),dtype,rcount,width,status) + if (dtype .eq. 1)then +C treat Bit datatype as if it were a Byte datatype + dtype=11 + rcount=(rcount+7)/8 + end if +C get the width of the field + call ftgtbc(1,dtype,rcount,xbcol,length,status) + lenrow=lenrow+length +10 continue + + comm='width of table in bytes' + call ftpkyj(ounit,'NAXIS1',lenrow,comm,status) + + if (status .gt. 0)return + + if (nrows .ge. 0)then + comm='number of rows in table' + call ftpkyj(ounit,'NAXIS2',nrows,comm,status) + else + status=218 + end if + + if (status .gt. 0)return + + if (pcount .ge. 0)then + comm='size of special data area' + call ftpkyj(ounit,'PCOUNT',pcount,comm,status) + else + status=214 + end if + + comm='one data group (required keyword)' + call ftpkyj(ounit,'GCOUNT',1,comm,status) + + comm='number of fields in each row' + call ftpkyj(ounit,'TFIELDS',nfield,comm,status) + + if (status .gt. 0)return + + do 20 i=1,nfield + if (ttype(i) .ne. ' ' .and. ichar(ttype(i)(1:1)).ne.0)then + comm='label for field ' + write(comm(17:19),1000)i +1000 format(i3) + call ftpkns(ounit,'TTYPE',i,1,ttype(i),comm,status) + end if + + comm='data format of the field' +C make sure format characters are in upper case: + tfm=tform(i) + call ftupch(tfm) + +C Add datatype to the comment string: + call ftbnfm(tfm,dtype,rcount,width,status) + if (dtype .eq. 21)then + comm(25:)=': 2-byte INTEGER' + else if(dtype .eq. 41)then + comm(25:)=': 4-byte INTEGER' + else if(dtype .eq. 42)then + comm(25:)=': 4-byte REAL' + else if(dtype .eq. 82)then + comm(25:)=': 8-byte DOUBLE' + else if(dtype .eq. 16)then + comm(25:)=': ASCII Character' + else if(dtype .eq. 14)then + comm(25:)=': 1-byte LOGICAL' + else if(dtype .eq. 11)then + comm(25:)=': BYTE' + else if(dtype .eq. 1)then + comm(25:)=': BIT' + else if(dtype .eq. 83)then + comm(25:)=': COMPLEX' + else if(dtype .eq. 163)then + comm(25:)=': DOUBLE COMPLEX' + end if + + call ftpkns(ounit,'TFORM',i,1,tfm,comm,status) + + if (tunit(i) .ne. ' ' .and. ichar(tunit(i)(1:1)).ne.0)then + comm='physical unit of field' + call ftpkns(ounit,'TUNIT',i,1,tunit(i),comm,status) + end if + if (status .gt. 0)return +20 continue + + if (extnam .ne. ' ' .and. ichar(extnam(1:1)) .ne. 0)then + comm='name of this binary table extension' + call ftpkys(ounit,'EXTNAME',extnam,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftphis.f b/pkg/tbtables/fitsio/ftphis.f new file mode 100644 index 00000000..2ca86c88 --- /dev/null +++ b/pkg/tbtables/fitsio/ftphis.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftphis(ounit,histry,status) + +C write a HISTORY record to the FITS header +C +C ounit i fortran output unit number +C histry c input history string +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,status,strlen,actlen,i,nkeys,c1,c2 + character*(*) histry + character*80 rec + + if (status .gt. 0)return + +C find the length of the string, and write it out 70 characters at a time + nkeys=1 + strlen=len(histry) + actlen=strlen + do 10 i=strlen,1,-1 + if (histry(i:i) .ne. ' ')then + actlen=i + go to 20 + end if +10 continue + +20 c1=1 + c2=min(actlen,70) + nkeys=(actlen-1)/70+1 + do 30 i=1,nkeys + rec='HISTORY '//histry(c1:c2) + call ftprec(ounit,rec,status) + c1=c1+70 + c2=min(actlen,c2+70) +30 continue + end diff --git a/pkg/tbtables/fitsio/ftphpr.f b/pkg/tbtables/fitsio/ftphpr.f new file mode 100644 index 00000000..b6ac4340 --- /dev/null +++ b/pkg/tbtables/fitsio/ftphpr.f @@ -0,0 +1,122 @@ +C---------------------------------------------------------------------- + subroutine ftphpr(ounit,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,status) + +C write required primary header keywords +C +C ounit i fortran output unit number +C simple l does file conform to FITS standard? +C bitpix i number of bits per data value +C naxis i number of axes in the data array +C naxes i array giving the length of each data axis +C pcount i number of group parameters +C gcount i number of random groups +C extend l may extensions be present in the FITS file? +C OUTPUT PARAMETERS: +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,bitpix,naxis,naxes(*),pcount,gcount,status,i,ibuff + character comm*50,caxis*20,clen*3 + logical simple,extend + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + + if (chdu(ibuff) .eq. 1)then + if (simple)then + comm='file does conform to FITS standard' + else + comm='file does not conform to FITS standard' + end if + call ftpkyl(ounit,'SIMPLE',simple,comm,status) + else + comm='IMAGE extension' + call ftpkys(ounit,'XTENSION','IMAGE',comm,status) + end if + +C test for legal value of bitpix + call fttbit(bitpix,status) + comm='number of bits per data pixel' + call ftpkyj(ounit,'BITPIX',bitpix,comm,status) + if (status .gt. 0)go to 900 + + if (naxis .ge. 0 .and. naxis .le. 999)then + comm='number of data axes' + call ftpkyj(ounit,'NAXIS',naxis,comm,status) + else +C illegal value of naxis + status=212 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPHPR ' + & //'is illegal.') + go to 900 + end if + + comm='length of data axis' + do 10 i=1,naxis + if (naxes(i) .ge. 0)then + write(comm(21:23),1000)i +1000 format(i3) + call ftpknj(ounit,'NAXIS',i,1,naxes(i),comm, + & status) + else +C illegal NAXISnnn keyword value + status=213 + write(clen,1000)i + write(caxis,1001)naxes(i) + call ftpmsg('In call to FTPHPR, axis '//clen// + & ' has illegal negative size: '//caxis) + go to 900 + end if +10 continue + + if (chdu(ibuff) .eq. 1)then +C only write the EXTEND keyword to primary header if true + if (extend)then + comm='FITS dataset may contain extensions' + call ftpkyl(ounit,'EXTEND',extend,comm,status) + end if + +C write the PCOUNT and GCOUNT values if nonstandard + if (pcount .gt. 0 .or. gcount .gt. 1)then + comm='random group records are present' + call ftpkyl(ounit,'GROUPS',.true.,comm,status) + comm='number of random group parameters' + call ftpkyj(ounit,'PCOUNT',pcount,comm,status) + comm='number of random groups' + call ftpkyj(ounit,'GCOUNT',gcount,comm,status) + end if + + call ftpcom(ounit,'FITS (Flexible Image Transport '// + & 'System) format defined in Astronomy and',status) + call ftpcom(ounit,'Astrophysics Supplement Series '// + & 'v44/p363, v44/p371, v73/p359, v73/p365.',status) + call ftpcom(ounit,'Contact the NASA Science '// + & 'Office of Standards and Technology for the',status) + call ftpcom(ounit,'FITS Definition document '// + & '#100 and other FITS information.',status) + + else + comm='number of random group parameters' + call ftpkyj(ounit,'PCOUNT',pcount,comm,status) + comm='number of random groups' + call ftpkyj(ounit,'GCOUNT',gcount,comm,status) + end if + +900 continue + end diff --git a/pkg/tbtables/fitsio/ftphtb.f b/pkg/tbtables/fitsio/ftphtb.f new file mode 100644 index 00000000..febe1916 --- /dev/null +++ b/pkg/tbtables/fitsio/ftphtb.f @@ -0,0 +1,110 @@ +C---------------------------------------------------------------------- + subroutine ftphtb(ounit,ncols,nrows,nfield,ttype,tbcol, + & tform,tunit,extnam,status) + +C write required standard header keywords for an ASCII table extension +C +C ounit i fortran output unit number +C ncols i number of columns in the table +C nrows i number of rows in the table +C nfield i number of fields in the table +C ttype c name of each field (array) (optional) +C tbcol i beginning column of each field (array) +C tform c Fortran-77 format of each field (array) +C tunit c units of each field (array) (optional) +C extnam c name of table extension (optional) +C OUTPUT PARAMETERS: +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,ncols,nrows,nfield,tbcol(*),status,i + character*(*) ttype(*),tform(*),tunit(*),extnam + character comm*48,tfm*20 + + comm='ASCII table extension' + call ftpkys(ounit,'XTENSION','TABLE',comm,status) + + comm='8-bit ASCII characters' + call ftpkyj(ounit,'BITPIX',8,comm,status) + + comm='2-dimensional ASCII table' + call ftpkyj(ounit,'NAXIS',2,comm,status) + + if (status .gt. 0)return + + if (ncols .ge. 0)then + comm='width of table in characters' + call ftpkyj(ounit,'NAXIS1',ncols,comm,status) + else +C illegal table width + status=217 + call ftpmsg('ASCII table has negative width (NAXIS1) in'// + & ' call to FTPHTB') + return + end if + + if (status .gt. 0)return + + if (nrows .ge. 0)then + comm='number of rows in table' + call ftpkyj(ounit,'NAXIS2',nrows,comm,status) + else +C illegal number of rows in table + status=218 + call ftpmsg('ASCII table has negative number of rows in'// + & ' call to FTPHTB') + end if + + if (status .gt. 0)return + + comm='no group parameters (required keyword)' + call ftpkyj(ounit,'PCOUNT',0,comm,status) + + comm='one data group (required)' + call ftpkyj(ounit,'GCOUNT',1,comm,status) + + if (status .gt. 0)return + + if (nfield .ge. 0)then + comm='number of fields in each row' + call ftpkyj(ounit,'TFIELDS',nfield,comm,status) + else +C illegal number of fields + status=216 + call ftpmsg('ASCII table has negative number of fields in'// + & ' call to FTPHTB') + end if + + if (status .gt. 0)return + + do 10 i=1,nfield + if (ttype(i) .ne. ' ' .and. ichar(ttype(i)(1:1)).ne.0)then + comm='label for field ' + write(comm(17:19),1000)i +1000 format(i3) + call ftpkns(ounit,'TTYPE',i,1,ttype(i),comm,status) + end if + + comm='beginning column of field ' + write(comm(27:29),1000)i + call ftpknj(ounit,'TBCOL',i,1,tbcol(i),comm,status) + + comm='Fortran-77 format of field' +C make sure format characters are in upper case: + tfm=tform(i) + call ftupch(tfm) + call ftpkns(ounit,'TFORM',i,1,tfm,comm,status) + + if (tunit(i) .ne. ' ' .and. ichar(tunit(i)(1:1)).ne.0)then + comm='physical unit of field' + call ftpkns(ounit,'TUNIT',i,1,tunit(i),comm,status) + end if + if (status .gt. 0)return +10 continue + + if (extnam .ne. ' ' .and. ichar(extnam(1:1)) .ne. 0)then + comm='name of this ASCII table extension' + call ftpkys(ounit,'EXTNAME',extnam,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpi1b.f b/pkg/tbtables/fitsio/ftpi1b.f new file mode 100644 index 00000000..dc97b8b4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpi1b.f @@ -0,0 +1,26 @@ +C---------------------------------------------------------------------- + subroutine ftpi1b(ounit,nvals,incre,chbuff,status) + +C Write an array of Integer*1 bytes to the output FITS file. + + integer nvals,incre,ounit,status,i,offset + character*1 chbuff(nvals) + +C ounit i fortran unit number +C nvals i number of pixels in the i2vals array +C incre i byte increment between values +C chbuff c*1 array of input byte values +C status i output error status + + if (incre .le. 1)then + call ftpcbf(ounit,0,nvals,chbuff,status) + else +C offset is the number of bytes to move between each value + offset=incre-1 + call ftpcbf(ounit,0,1,chbuff,status) + do 10 i=2,nvals + call ftmoff(ounit,offset,.true.,status) + call ftpcbf(ounit,0,1,chbuff(i),status) +10 continue + end if + end diff --git a/pkg/tbtables/fitsio/ftpini.f b/pkg/tbtables/fitsio/ftpini.f new file mode 100644 index 00000000..60b96438 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpini.f @@ -0,0 +1,167 @@ +C-------------------------------------------------------------------------- + subroutine ftpini(iunit,status) + +C initialize the parameters defining the structure of the primary data + +C iunit i Fortran I/O unit number +C OUTPUT PARAMETERS: +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bitpix,naxis,naxes(99),pcnt,gcnt,ttype + integer blank,bytlen,npix,i,nblank,tstat + double precision bscale,bzero + logical simple,extend,groups + character*8 comm + + if (status .gt. 0)return + groups=.false. + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C store the type of HDU (0=primary array or image extension) + hdutyp(ibuff)=0 + +C temporarily set the location of the end of the header to a huge number + hdend(ibuff)=2000000000 + hdstrt(ibuff,chdu(ibuff)+1)=2000000000 + +C get the standard header keywords + tstat=status + call ftgphx(iunit,99,simple,bitpix,naxis,naxes, + & pcnt,gcnt,extend,bscale,bzero,blank,nblank,status) + if (status .eq. 251)then +C ignore 'unknown extension type' error, and go on + status=tstat + else if (status .gt. 0)then + return + end if + + if (naxis .gt. 99)then +C the image array has too many dimensions for me to handle + status=111 + call ftpmsg('This FITS image has too many dimensions (FTPINI)') + return + end if + +C the 'END' record is 80 bytes before the current position, ignoring +C any trailing blank keywords just before the END keyword. + hdend(ibuff)=nxthdr(ibuff)-80*(nblank+1) + +C the data unit begins at the beginning of the next logical block + dtstrt(ibuff)=((nxthdr(ibuff)-80)/2880+1)*2880 + +C test for the presence of 'random groups' structure + if (naxis .gt. 0 .and. naxes(1) .eq. 0)then + tstat=status + call ftgkyl(iunit,'GROUPS',groups,comm,status) + if (status .gt. 0)then + status=tstat + groups=.false. + end if + end if + +C test bitpix and set the datatype code value + if (bitpix .eq. 8)then + ttype=11 + bytlen=1 + else if (bitpix .eq. 16)then + ttype=21 + bytlen=2 + else if (bitpix .eq. 32)then + ttype=41 + bytlen=4 + else if (bitpix .eq. -32)then + ttype=42 + bytlen=4 + else if (bitpix .eq. -64)then + ttype=82 + bytlen=8 + end if + +C calculate the size of the primary array + if (naxis .eq. 0)then + npix=0 + else + if (groups)then +C NAXIS1 = 0 is a special flag for 'random groups' + npix=1 + else + npix=naxes(1) + end if + + do 10 i=2,naxis + npix=npix*naxes(i) +10 continue + end if + +C now we know everything about the array; just fill in the parameters: +C the next HDU begins in the next logical block after the data + hdstrt(ibuff,chdu(ibuff)+1)= + & dtstrt(ibuff)+((pcnt+npix)*bytlen*gcnt+2879)/2880*2880 + +C initialize the fictitious heap starting address (immediately following +C the array data) and a zero length heap. This is used to find the +C end of the data when checking the fill values in the last block. + scount(ibuff)=0 + theap(ibuff)=(pcnt+npix)*bytlen*gcnt + nxheap(ibuff)=0 + +C quit if there is no data + if (naxis .eq. 0)then + tfield(ibuff)=0 + rowlen(ibuff)=0 + go to 900 + end if + +C the primary array is actually interpreted as a binary table. There +C are two columns: the first column contains the +C group parameters, if any, and the second column contains the +C primary array of data. Each group is in a separate row of the table. + + tfield(ibuff)=2 + if (nxtfld + 2 .gt. nf)then +C too many columns open at one time; exceeded array dimensions + status=111 + else + tstart(ibuff)=nxtfld + nxtfld=nxtfld+2 + tdtype(1+tstart(ibuff))=ttype + tdtype(2+tstart(ibuff))=ttype + trept(1+tstart(ibuff))=pcnt + trept(2+tstart(ibuff))=npix + tnull(1+tstart(ibuff))=blank + tnull(2+tstart(ibuff))=blank + tscale(1+tstart(ibuff))=1. + tscale(2+tstart(ibuff))=bscale + tzero(1+tstart(ibuff))=0. + tzero(2+tstart(ibuff))=bzero + tbcol(1+tstart(ibuff))=0 + tbcol(2+tstart(ibuff))=pcnt*bytlen + rowlen(ibuff)=(pcnt+npix)*bytlen + end if + +900 continue + end diff --git a/pkg/tbtables/fitsio/ftpkey.f b/pkg/tbtables/fitsio/ftpkey.f new file mode 100644 index 00000000..b4ce180b --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkey.f @@ -0,0 +1,28 @@ +C-------------------------------------------------------------------------- + subroutine ftpkey(ounit,keywrd,value,comm,status) + +C write a simple FITS keyword record with format: +C "KEYWORD = VALUE / COMMENT" +C VALUE is assumed to be 20 characters long +C COMMENT is assumed to be 47 characters long +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C value c keyword value (20 characters, cols. 11-30) +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,value,comm + integer ounit,status + character key*8, val*20, com*47 + + key=keywrd + val=value + com=comm + +C append the 80 characters to the output buffer: + call ftprec(ounit,key//'= '//val//' / '//com,status) + end diff --git a/pkg/tbtables/fitsio/ftpkls.f b/pkg/tbtables/fitsio/ftpkls.f new file mode 100644 index 00000000..0e7d52c5 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkls.f @@ -0,0 +1,103 @@ +C-------------------------------------------------------------------------- + subroutine ftpkls(ounit,keywrd,strval,comm,status) + +C write a character string value to a header record, supporting +C the OGIP long string convention. If the keyword string value +C is longer than 68 characters (which is the maximum that will fit +C on a single 80 character keyword record) then the value string will +C be continued over multiple keywords. This OGIP convention uses the +C '&' character at the end of a string to indicate that it is continued +C on the next keyword. The name of all the continued keywords is +C 'CONTINUE'. +C +C The FTPLSW subroutine should be called prior to using this +C subroutine, to write a warning message in the header +C describing how the convention works. + +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C strval c keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Sept 1994 + + character*(*) keywrd,comm,strval + integer ounit,status,lenval,ncomm,nvalue + integer clen,i,strlen,nseg,c1,c2 + character value*70,keynam*10,cmnt*48 + + if (status .gt. 0)return + + keynam=keywrd + keynam(9:10)='= ' + cmnt=comm + +C find the number of characters in the input string + clen=len(strval) + do 10 i=clen,1,-1 + if (strval(i:i) .ne. ' ')then + strlen=i + go to 20 + end if +10 continue + strlen=1 + +C calculate the number of keywords needed to write the whole string +20 nseg=max(1,(strlen-2)/67+1) + + c1=1 + do 30 i=1,nseg + c2=min(c1+67,strlen) +C convert string to quoted character string + +C fts2c was modified on 29 Nov 1994, so this code is no longer needed +C (remember to declare character*70 ctemp if this code is used) +C if (i .gt. 1 .and. strval(c1:c1) .eq. ' ')then +CC have to preserve leading blanks on continuation cards +C ctemp='A'//strval(c1+1:c2) +C call fts2c(ctemp,value,lenval,status) +CC now reset the first character of the string back to a blank +C value(2:2)=' ' +C else + + call fts2c(strval(c1:c2),value,lenval,status) + +C end if + + if (i .ne. nseg .and. lenval .ne. 70)then +C if the string is continued, preserve trailing blanks + value(lenval:69)=' ' + value(70:70)='''' + lenval=70 + end if + +C overwrite last character with a '&' if string is continued. + if (i .lt. nseg)then + value(69:69)='&' + end if + +C find amount of space left for comment string (assume +C 10 char. for 'keyword = ', and 3 between value and comment) +C which leaves 67 spaces for the value + comment strings + + nvalue=max(20,lenval) + ncomm=67-nvalue + +C write the keyword record + if (ncomm .gt. 0)then +C there is space for a comment + call ftprec(ounit,keynam// + & value(1:nvalue)//' / '//cmnt(1:ncomm),status) + else +C no room for a comment + call ftprec(ounit,keynam// + & value(1:nvalue)//' ',status) + end if + +C initialize for the next segment of the string, if any + c1=c1+67 + keynam='CONTINUE ' +30 continue + end diff --git a/pkg/tbtables/fitsio/ftpknd.f b/pkg/tbtables/fitsio/ftpknd.f new file mode 100644 index 00000000..289fc370 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpknd.f @@ -0,0 +1,45 @@ +C-------------------------------------------------------------------------- + subroutine ftpknd(ounit,keywrd,nstart,nkey,dval,decim,comm, + & status) + +C write an array of real*8 values to header records in E format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C dval d array of keyword values +C decim i number of decimal places to display in the value field +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm(*) + integer nstart,nkey,decim,ounit,status,i,j + double precision dval(*) + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkyd(ounit,keynam,dval(i),decim,comm1,status) + else + call ftpkyd(ounit,keynam,dval(i),decim,comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpkne.f b/pkg/tbtables/fitsio/ftpkne.f new file mode 100644 index 00000000..36f13add --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkne.f @@ -0,0 +1,45 @@ +C-------------------------------------------------------------------------- + subroutine ftpkne(ounit,keywrd,nstart,nkey,rval,decim,comm, + & status) + +C write an array of real*4 values to header records in E format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C rval r array of keyword values +C decim i number of decimal places to display in the value field +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm(*) + integer nstart,nkey,decim,ounit,status,i,j + real rval(*) + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkye(ounit,keynam,rval(i),decim,comm1,status) + else + call ftpkye(ounit,keynam,rval(i),decim,comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpknf.f b/pkg/tbtables/fitsio/ftpknf.f new file mode 100644 index 00000000..89ffab7f --- /dev/null +++ b/pkg/tbtables/fitsio/ftpknf.f @@ -0,0 +1,45 @@ +C-------------------------------------------------------------------------- + subroutine ftpknf(ounit,keywrd,nstart,nkey,rval,decim,comm, + & status) + +C write an array of real*4 values to header records in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C rval r array of keyword values +C decim i number of decimal places to display in the value field +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm(*) + integer nstart,nkey,decim,ounit,status,i,j + real rval(*) + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkyf(ounit,keynam,rval(i),decim,comm1,status) + else + call ftpkyf(ounit,keynam,rval(i),decim,comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpkng.f b/pkg/tbtables/fitsio/ftpkng.f new file mode 100644 index 00000000..ad8f3592 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkng.f @@ -0,0 +1,45 @@ +C-------------------------------------------------------------------------- + subroutine ftpkng(ounit,keywrd,nstart,nkey,dval,decim,comm, + & status) + +C write an array of real*8 values to header records in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C dval d array of keyword values +C decim i number of decimal places to display in the value field +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm(*) + integer nstart,nkey,decim,ounit,status,i,j + double precision dval(*) + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkyg(ounit,keynam,dval(i),decim,comm1,status) + else + call ftpkyg(ounit,keynam,dval(i),decim,comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpknj.f b/pkg/tbtables/fitsio/ftpknj.f new file mode 100644 index 00000000..d6d23834 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpknj.f @@ -0,0 +1,43 @@ +C-------------------------------------------------------------------------- + subroutine ftpknj(ounit,keywrd,nstart,nkey,intval,comm, + & status) + +C write an array of integer values to header records +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C intval i array of keyword values +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm(*) + integer nstart,nkey,ounit,status,intval(*),i,j + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkyj(ounit,keynam,intval(i),comm1,status) + else + call ftpkyj(ounit,keynam,intval(i),comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpknl.f b/pkg/tbtables/fitsio/ftpknl.f new file mode 100644 index 00000000..d23350ac --- /dev/null +++ b/pkg/tbtables/fitsio/ftpknl.f @@ -0,0 +1,44 @@ +C-------------------------------------------------------------------------- + subroutine ftpknl(ounit,keywrd,nstart,nkey,logval,comm, + & status) + +C write an array of logical values to header records +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C logval l array of keyword values +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm(*) + integer nstart,nkey,ounit,status,i,j + logical logval(*) + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords +C (if the last non-blank character is '&', then it is to be repeated) + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkyl(ounit,keynam,logval(i),comm1,status) + else + call ftpkyl(ounit,keynam,logval(i),comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpkns.f b/pkg/tbtables/fitsio/ftpkns.f new file mode 100644 index 00000000..588a5738 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkns.f @@ -0,0 +1,42 @@ +C-------------------------------------------------------------------------- + subroutine ftpkns(ounit,keywrd,nstart,nkey,strval,comm, + & status) + +C write an array of character string values to header records +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C nstart i starting sequence number (usually 1) +C nkey i number of keywords to write +C strval c array of keyword values +C comm c array of keyword comments (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,strval(*),comm(*) + integer nstart,nkey,ounit,status,i,j + character keynam*8,comm1*48 + logical repeat + + if (status .gt. 0)return + +C check if the first comment string is to be repeated for all keywords + call ftcrep(comm(1),comm1,repeat) + + j=nstart + do 10 i=1,nkey +C construct keyword name: + call ftkeyn(keywrd,j,keynam,status) + +C write the keyword record + if (repeat)then + call ftpkys(ounit,keynam,strval(i),comm1,status) + else + call ftpkys(ounit,keynam,strval(i),comm(i),status) + end if + if (status .gt. 0)return + j=j+1 +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpkyd.f b/pkg/tbtables/fitsio/ftpkyd.f new file mode 100644 index 00000000..560222ea --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkyd.f @@ -0,0 +1,32 @@ +C-------------------------------------------------------------------------- + subroutine ftpkyd(ounit,keywrd,dval,decim,comm,status) + +C write a double precision value to a header record in E format +C If it will fit, the value field will be 20 characters wide; +C otherwise it will be expanded to up to 35 characters, left +C justified. +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (max. 47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + double precision dval + integer ounit,status,decim,vlen + character value*35,key*8,cmnt*48 + + key=keywrd + cmnt=comm + +C convert double precision to E format character string + call ftd2e(dval,decim,value,vlen,status) + +C write the keyword record + call ftprec(ounit,key//'= '//value(1:vlen)//' / '//cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftpkye.f b/pkg/tbtables/fitsio/ftpkye.f new file mode 100644 index 00000000..a74200b9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkye.f @@ -0,0 +1,26 @@ +C-------------------------------------------------------------------------- + subroutine ftpkye(ounit,keywrd,rval,decim,comm,status) + +C write a real*4 value to a header record in E format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + real rval + integer ounit,status,decim + character value*20 + +C convert real to E format character string + call ftr2e(rval,decim,value,status) + +C write the keyword record + call ftpkey(ounit,keywrd,value,comm,status) + end diff --git a/pkg/tbtables/fitsio/ftpkyf.f b/pkg/tbtables/fitsio/ftpkyf.f new file mode 100644 index 00000000..a67312bd --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkyf.f @@ -0,0 +1,26 @@ +C-------------------------------------------------------------------------- + subroutine ftpkyf(ounit,keywrd,rval,decim,comm,status) + +C write a real*4 value to a header record in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + real rval + integer ounit,status,decim + character value*20 + +C convert real to F format character string + call ftr2f(rval,decim,value,status) + +C write the keyword record + call ftpkey(ounit,keywrd,value,comm,status) + end diff --git a/pkg/tbtables/fitsio/ftpkyg.f b/pkg/tbtables/fitsio/ftpkyg.f new file mode 100644 index 00000000..b9ee55e2 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkyg.f @@ -0,0 +1,26 @@ +C-------------------------------------------------------------------------- + subroutine ftpkyg(ounit,keywrd,dval,decim,comm,status) + +C write a double precision value to a header record in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + double precision dval + integer ounit,status,decim + character value*20 + +C convert double precision to F format character string + call ftd2f(dval,decim,value,status) + +C write the keyword record + call ftpkey(ounit,keywrd,value,comm,status) + end diff --git a/pkg/tbtables/fitsio/ftpkyj.f b/pkg/tbtables/fitsio/ftpkyj.f new file mode 100644 index 00000000..330d9447 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkyj.f @@ -0,0 +1,24 @@ +C-------------------------------------------------------------------------- + subroutine ftpkyj(ounit,keywrd,intval,comm,status) + +C write an integer value to a header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C intval i keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer ounit,status,intval + character value*20 + +C convert integer to character string + call fti2c(intval,value,status) + +C write the keyword record + call ftpkey(ounit,keywrd,value,comm,status) + end diff --git a/pkg/tbtables/fitsio/ftpkyl.f b/pkg/tbtables/fitsio/ftpkyl.f new file mode 100644 index 00000000..1cf1cb75 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkyl.f @@ -0,0 +1,25 @@ +C-------------------------------------------------------------------------- + subroutine ftpkyl(ounit,keywrd,logval,comm,status) + +C write a logical value to a header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C logval l keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) keywrd,comm + integer ounit,status + logical logval + character value*20 + +C convert logical to character string + call ftl2c(logval,value,status) + +C write the keyword record + call ftpkey(ounit,keywrd,value,comm,status) + end diff --git a/pkg/tbtables/fitsio/ftpkys.f b/pkg/tbtables/fitsio/ftpkys.f new file mode 100644 index 00000000..d68e5add --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkys.f @@ -0,0 +1,58 @@ +C-------------------------------------------------------------------------- + subroutine ftpkys(ounit,keywrd,strval,comm,status) + +C write a character string value to a header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C strval c keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 +C modified 6/93 to handle long string values by continuing the +C string onto subsequent comment keywords (with a blank keyword name) + +C Modified again in 9/94 to remove support for long string values; +C Now, one must call ftpkls to write a long string values. + + character*(*) keywrd,comm,strval + integer ounit,status,lenval,ncomm,nvalue + character strtmp*68,value*70,keynam*8,cmnt*48 + + if (status .gt. 0)return + + strtmp=strval + keynam=keywrd + cmnt=comm + +C convert string to quoted character string (max length = 70 characters) + call fts2c(strtmp,value,lenval,status) + + if (lenval .gt. 70)then +C truncate the string to 70 characters (if the input string contained +C apostrophies, then it could get expanded to more than 70 characters) + value(70:70)='''' + lenval=70 +C N.B. there could be a problem here if character 69 is also a '. +C Then the closing quote would be considered a literal appostrophy. + end if + +C find amount of space left for comment string +C (assume 10 char. for 'keyword = ', and 3 between value and comment) +C which leaves 67 spaces for the value string + comment string + nvalue=max(20,lenval) + ncomm=67-nvalue + +C write the keyword record + if (ncomm .gt. 0)then +C there is space for a comment + call ftprec(ounit, + & keynam//'= '//value(1:nvalue)//' / '//cmnt(1:ncomm),status) + else +C no room for a comment + call ftprec(ounit, + & keynam//'= '//value(1:nvalue)//' ',status) + end if + end diff --git a/pkg/tbtables/fitsio/ftpkyt.f b/pkg/tbtables/fitsio/ftpkyt.f new file mode 100644 index 00000000..766fee96 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpkyt.f @@ -0,0 +1,41 @@ +C-------------------------------------------------------------------------- + subroutine ftpkyt(ounit,keywrd,jval,dval,comm,status) + +C concatinate a integer value with a double precision fraction +C and write it to the FITS header along with the comment string +C The value will be displayed in F28.16 format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C jval i integer part of the keyword value +C dval d fractional part of the keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Sept 1992 + + character*(*) keywrd,comm + double precision dval + integer ounit,jval,status,dlen + character dstr*35,jstr*20,key*8,cmnt*48 + + if (status .gt. 0)return + + if (dval .ge. 1.0 .or. dval .lt. 0.)then + status = 402 + end if + + key=keywrd + cmnt=comm + +C convert integer to C*20 character string + call fti2c(jval,jstr,status) + +C convert double precision to E23.16 format character string + call ftd2e(dval,20,dstr,dlen,status) + +C write the concatinated keyword record + call ftprec(ounit,key//'= '//jstr(10:20)//'.'// + 1 dstr(2:2)//dstr(4:18)//' / '//cmnt,status) + end diff --git a/pkg/tbtables/fitsio/ftplsw.f b/pkg/tbtables/fitsio/ftplsw.f new file mode 100644 index 00000000..58d3d5d7 --- /dev/null +++ b/pkg/tbtables/fitsio/ftplsw.f @@ -0,0 +1,39 @@ +C-------------------------------------------------------------------------- + subroutine ftplsw(ounit,status) + +C Put Long String Warning: +C write the LONGSTRN keyword and a few COMMENT keywords to the header +C (if they don't already exist) to warn users that this FITS file +C may use the OGIP long string convention. + +C This subroutine should be called whenever FTPKLS is called. + + integer ounit,status,tstat + character value*8,comm*8 + + if (status .gt. 0)return + + tstat=status + call ftgkys(ounit,'LONGSTRN',value,comm,status) + if (status .eq. 0)then +C The keyword already exists so just exit + return + end if + + status=tstat + call ftpkys(ounit,'LONGSTRN','OGIP 1.0', + & 'The OGIP Long String Convention may be used.',status) + + call ftpcom(ounit, + & 'This FITS file may contain long string keyword values that are' + & ,status) + call ftpcom(ounit, + & 'continued over multiple keywords. The OGIP convention uses the' + & //' &',status) + call ftpcom(ounit, + & 'character at the end of each substring which is then continued' + & ,status) + call ftpcom(ounit, + & 'on the next keyword which has the name CONTINUE.' + & ,status) + end diff --git a/pkg/tbtables/fitsio/ftpmsg.f b/pkg/tbtables/fitsio/ftpmsg.f new file mode 100644 index 00000000..0cf605b1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpmsg.f @@ -0,0 +1,7 @@ +C------------------------------------------------------------------------------ + subroutine ftpmsg(text) + +C put error message onto stack. + character*(*) text + call ftxmsg(1,text) + end diff --git a/pkg/tbtables/fitsio/ftpnul.f b/pkg/tbtables/fitsio/ftpnul.f new file mode 100644 index 00000000..c46152b9 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpnul.f @@ -0,0 +1,58 @@ +C-------------------------------------------------------------------------- + subroutine ftpnul(ounit,blank,status) + +C Primary Null value definition +C Define the null value for an integer primary array. +C +C ounit i Fortran I/O unit number +C blank i the value to be use to signify undefined data +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,blank,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,i,ngroup + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + if (status .gt. 0)return + +C test for proper HDU type + if (hdutyp(ibuff) .ne. 0)then + status=233 + return + end if + +C the primary array is actually interpreted as a binary table. There +C are two columns for each group: the first column contains the +C group parameters, if any, and the second column contains the +C primary array of data. + + ngroup=tfield(ibuff)/2 + do 10 i=1,ngroup + tnull(i*2+tstart(ibuff))=blank +10 continue + end diff --git a/pkg/tbtables/fitsio/ftppnb.f b/pkg/tbtables/fitsio/ftppnb.f new file mode 100644 index 00000000..9f6cd175 --- /dev/null +++ b/pkg/tbtables/fitsio/ftppnb.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftppnb(ounit,group,felem,nelem,array,nulval,status) + +C Write an array of c*1 (byte) values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same as the +C array being written). Any input pixels equal to the value of NULVAL +C will be replaced by the appropriate null value in the output FITS file. + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array c*1 the array of values to be written +C nulval c*1 pixel value used to represent an undefine pixel +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,group,felem,nelem,status,row + character*1 array(*),nulval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcnb(ounit,2,row,felem,nelem,array,nulval,status) + end diff --git a/pkg/tbtables/fitsio/ftppnd.f b/pkg/tbtables/fitsio/ftppnd.f new file mode 100644 index 00000000..836b6a62 --- /dev/null +++ b/pkg/tbtables/fitsio/ftppnd.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftppnd(ounit,group,felem,nelem,array,nulval,status) + +C Write an array of double precision values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same as the +C array being written). Any input pixels equal to the value of NULVAL +C will be replaced by the appropriate null value in the output FITS file. + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array d the array of values to be written +C nulval d pixel value used to represent an undefine pixel +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,group,felem,nelem,status,row + double precision array(*),nulval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcnd(ounit,2,row,felem,nelem,array,nulval,status) + end diff --git a/pkg/tbtables/fitsio/ftppne.f b/pkg/tbtables/fitsio/ftppne.f new file mode 100644 index 00000000..ca87a68b --- /dev/null +++ b/pkg/tbtables/fitsio/ftppne.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftppne(ounit,group,felem,nelem,array,nulval,status) + +C Write an array of real values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same as the +C array being written). Any input pixels equal to the value of NULVAL +C will be replaced by the appropriate null value in the output FITS file. + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array r the array of values to be written +C nulval r pixel value used to represent an undefine pixel +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,group,felem,nelem,status,row + real array(*),nulval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcne(ounit,2,row,felem,nelem,array,nulval,status) + end diff --git a/pkg/tbtables/fitsio/ftppni.f b/pkg/tbtables/fitsio/ftppni.f new file mode 100644 index 00000000..0fd71641 --- /dev/null +++ b/pkg/tbtables/fitsio/ftppni.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftppni(ounit,group,felem,nelem,array,nulval,status) + +C Write an array of i*2 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same as the +C array being written). Any input pixels equal to the value of NULVAL +C will be replaced by the appropriate null value in the output FITS file. + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array i*2 the array of values to be written +C nulval i*2 pixel value used to represent an undefine pixel +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,group,felem,nelem,status,row + integer*2 array(*),nulval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcni(ounit,2,row,felem,nelem,array,nulval,status) + end diff --git a/pkg/tbtables/fitsio/ftppnj.f b/pkg/tbtables/fitsio/ftppnj.f new file mode 100644 index 00000000..c8bac808 --- /dev/null +++ b/pkg/tbtables/fitsio/ftppnj.f @@ -0,0 +1,31 @@ +C---------------------------------------------------------------------- + subroutine ftppnj(ounit,group,felem,nelem,array,nulval,status) + +C Write an array of i values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same as the +C array being written). Any input pixels equal to the value of NULVAL +C will be replaced by the appropriate null value in the output FITS file. + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array i the array of values to be written +C nulval i pixel value used to represent an undefine pixel +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1994 + + integer ounit,group,felem,nelem,status,row + integer array(*),nulval + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcnj(ounit,2,row,felem,nelem,array,nulval,status) + end diff --git a/pkg/tbtables/fitsio/ftpprb.f b/pkg/tbtables/fitsio/ftpprb.f new file mode 100644 index 00000000..60ff91e1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpprb.f @@ -0,0 +1,30 @@ +C---------------------------------------------------------------------- + subroutine ftpprb(ounit,group,felem,nelem,array,status) + +C Write an array of byte values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array b the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,felem,nelem,status,row + + character*1 array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpclb(ounit,2,row,felem,nelem,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpprd.f b/pkg/tbtables/fitsio/ftpprd.f new file mode 100644 index 00000000..bfb15d05 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpprd.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftpprd(ounit,group,felem,nelem,array,status) + +C Write an array of r*8 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array d the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,felem,nelem,status,row + double precision array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcld(ounit,2,row,felem,nelem,array,status) + end diff --git a/pkg/tbtables/fitsio/ftppre.f b/pkg/tbtables/fitsio/ftppre.f new file mode 100644 index 00000000..c6b9827b --- /dev/null +++ b/pkg/tbtables/fitsio/ftppre.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftppre(ounit,group,felem,nelem,array,status) + +C Write an array of r*4 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array r the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,felem,nelem,status,row + real array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcle(ounit,2,row,felem,nelem,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpprh.f b/pkg/tbtables/fitsio/ftpprh.f new file mode 100644 index 00000000..f452cd2a --- /dev/null +++ b/pkg/tbtables/fitsio/ftpprh.f @@ -0,0 +1,12 @@ +C---------------------------------------------------------------------- + subroutine ftpprh(ounit,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,status) + +C OBSOLETE routine: should call ftphpr instead + + integer ounit,bitpix,naxis,naxes(*),pcount,gcount,status + logical simple,extend + + call ftphpr(ounit,simple,bitpix,naxis,naxes, + & pcount,gcount,extend,status) + end diff --git a/pkg/tbtables/fitsio/ftppri.f b/pkg/tbtables/fitsio/ftppri.f new file mode 100644 index 00000000..691ac191 --- /dev/null +++ b/pkg/tbtables/fitsio/ftppri.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftppri(ounit,group,felem,nelem,array,status) + +C Write an array of i*2 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array i*2 the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,felem,nelem,status,row + integer*2 array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpcli(ounit,2,row,felem,nelem,array,status) + end diff --git a/pkg/tbtables/fitsio/ftpprj.f b/pkg/tbtables/fitsio/ftpprj.f new file mode 100644 index 00000000..a9b1aa45 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpprj.f @@ -0,0 +1,29 @@ +C---------------------------------------------------------------------- + subroutine ftpprj(ounit,group,felem,nelem,array,status) + +C Write an array of i*4 values into the primary array. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being written). + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be written +C array i the array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,felem,nelem,status,row + integer array(*) + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpclj(ounit,2,row,felem,nelem,array,status) + end diff --git a/pkg/tbtables/fitsio/ftppru.f b/pkg/tbtables/fitsio/ftppru.f new file mode 100644 index 00000000..3c0f6f3a --- /dev/null +++ b/pkg/tbtables/fitsio/ftppru.f @@ -0,0 +1,24 @@ +C---------------------------------------------------------------------- + subroutine ftppru(ounit,group,felem,nelem,status) + +C set elements of the primary array equal to the undefined value + +C ounit i Fortran output unit number +C group i number of the data group, if any +C felem i the first pixel to be written (this routine treats +C the primary array a large one dimensional array of +C values, regardless of the actual dimensionality). +C nelem i number of data elements to be set to undefined +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,group,felem,nelem,status,row + +C the primary array is represented as a binary table: +C each group of the primary array is a row in the table, +C where the first column contains the group parameters +C and the second column contains the image itself + row=max(group,1) + call ftpclu(ounit,2,row,felem,nelem,status) + end diff --git a/pkg/tbtables/fitsio/ftprec.f b/pkg/tbtables/fitsio/ftprec.f new file mode 100644 index 00000000..febc78b8 --- /dev/null +++ b/pkg/tbtables/fitsio/ftprec.f @@ -0,0 +1,67 @@ +C-------------------------------------------------------------------------- + subroutine ftprec(ounit,record,status) + +C write a 80 character record to the FITS header +C +C ounit i fortran output unit number +C record c input 80 character header record +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*(*) record + character*80 rec + integer ounit,status,ibuff + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C-------END OF COMMON BLOCK DEFINITIONS:------- ----------------------------- + + if (status .gt. 0)return + +C get the number of the data buffer used for this unit + ibuff=bufnum(ounit) + + if (dtstrt(ibuff) .gt. 0 + & .and.(dtstrt(ibuff)-hdend(ibuff)) .le. 80)then +C not enough room in the header for another keyword + +C try getting more header space + call ftiblk(ounit,1,0,status) + if (status .gt. 0)then + go to 900 + end if + end if + + rec=record + +C make sure keyword name is in upper case + call ftupch(rec(1:8)) + +C test that keyword name contains only legal characters + call fttkey(rec(1:8),status) + +C test that the rest of the record contains only legal values + call fttrec(rec(9:80),status) + +C position the I/O pointer to the end of the header + call ftmbyt(ounit,hdend(ibuff),.true.,status) + +C append the 80 characters to the output buffer: + call ftpcbf(ounit,1,80,rec,status) + if (status .gt. 0)go to 900 + +C increment the pointer to the last header record + hdend(ibuff)=hdend(ibuff)+80 + nxthdr(ibuff)=hdend(ibuff) + +900 continue + end diff --git a/pkg/tbtables/fitsio/ftprsv.f b/pkg/tbtables/fitsio/ftprsv.f new file mode 100644 index 00000000..ba87cde1 --- /dev/null +++ b/pkg/tbtables/fitsio/ftprsv.f @@ -0,0 +1,82 @@ +C-------------------------------------------------------------------------- + subroutine ftprsv(keyrec,lenval,status) + +C find the total length of the keyword+value string in a keyword record + +C keyrec c 80 column header record +C OUTPUT PARAMETERS: +C lenval i output length of keyword+value string +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*80 keyrec + integer lenval,status,j,c1 + + if (status .gt. 0)return + + if (keyrec(1:8) .eq.'COMMENT ' .or. keyrec(1:8).eq.'HISTORY ' + & .or. keyrec(1:8).eq.'END ' .or. keyrec(1:8).eq.' ') + & then +C this is a COMMENT or HISTORY record, with no value + lenval=8 + else if (keyrec(9:10) .eq. '= ')then +C this keyword has a value field; now find the first character: + do 10 j=10,80 + if (keyrec(j:j) .ne. ' ')then + c1=j + go to 15 + end if +10 continue +C error: value is blank + status=204 + call ftpmsg('The keyword '//keyrec(1:8)// + & ' has no value string after the equal sign:') + call ftpmsg(keyrec) + return + +15 if (keyrec(c1:c1) .eq. '''')then +C This is a string value. +C Work forward to find a single quote. Two single quotes +C in succession is to be interpreted as a literal single +C quote character as part of the character string, not as +C the end of the character string. Everything to the right +C of the closing quote is assumed to be the comment. + do 20 j=c1+1,80 + if (keyrec(j:j) .eq. '''')then + if (j.lt.80 .and. keyrec(j+1:j+1).eq.'''')then +C found 2 successive quote characters; this is +C interpreted as a literal quote character + else + lenval=max(30,j) + go to 30 + end if + end if +20 continue +C error: no closing quote character + status=205 + call ftpmsg('The following Keyword value string has '// + & 'no closing quote:') + call ftpmsg(keyrec) + return + else +C This is either an integer, floating point, or logical value. +C Extract the first token as the value; remainder = comment + do 25 j=c1,80 + if (keyrec(j:j) .eq. ' ')then + lenval=j-1 + go to 30 + end if +25 continue +C the first token went all the way to column 80: + lenval=80 + end if + else +C illegal keyword record format; must have '= ' in columns 9-10 +C status=210 +C Modified July 1993: this is actually not an error. The +C keyword should simply be interpreted as a comment. + lenval=8 + end if +30 continue + end diff --git a/pkg/tbtables/fitsio/ftpscl.f b/pkg/tbtables/fitsio/ftpscl.f new file mode 100644 index 00000000..af0505c8 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpscl.f @@ -0,0 +1,66 @@ +C-------------------------------------------------------------------------- + subroutine ftpscl(ounit,bscale,bzero,status) + +C Primary SCaLing factor definition +C Define the scaling factor for the primary header data. +C +C ounit i Fortran I/O unit number +C bscale d scaling factor +C bzero d scaling zero point +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,status + double precision bscale,bzero + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,i,ngroup + + if (status .gt. 0)return + + if (bscale .eq. 0.)then +C illegal bscale value + status=322 + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + if (status .gt. 0)return + +C test for proper HDU type + if (hdutyp(ibuff) .ne. 0)then + status=233 + return + end if + +C the primary array is actually interpreted as a binary table. There +C are two columns for each group: the first column contains the +C group parameters, if any, and the second column contains the +C primary array of data. + ngroup=tfield(ibuff)/2 + do 10 i=1,ngroup + tscale(i*2+tstart(ibuff))=bscale + tzero(i*2+tstart(ibuff))=bzero +10 continue + end diff --git a/pkg/tbtables/fitsio/ftpssb.f b/pkg/tbtables/fitsio/ftpssb.f new file mode 100644 index 00000000..5c65ef7c --- /dev/null +++ b/pkg/tbtables/fitsio/ftpssb.f @@ -0,0 +1,114 @@ +C-------------------------------------------------------------------------- + subroutine ftpssb(iunit,group,naxis,naxes,fpixel,lpixel, + & array,status) + +C Write a subsection of byte values to the primary array. +C A subsection is defined to be any contiguous rectangular +C array of pixels within the n-dimensional FITS data file. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran input unit number +C group i number of the data group to be written, if any +C naxis i number of data axes in the FITS array +C naxes i (array) size of each FITS axis +C fpixel i (array) the first pixel in each dimension to be included +C in the subsection (first pixel = 1) +C lpixel i (array) the last pixel in each dimension to be included +C in the subsection +C array c*1 array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + integer iunit,group,naxis,naxes(*),fpixel(*),lpixel(*),status + character*1 array(*) + integer fpix(7),irange(7),dimen(7),astart,pstart + integer off2,off3,off4,off5,off6,off7 + integer st10,st20,st30,st40,st50,st60,st70 + integer st1,st2,st3,st4,st5,st6,st7 + integer i,i1,i2,i3,i4,i5,i6,i7 + character caxis*20 + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 7)then +C this routine only supports up to 7 dimensions + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPSSB ' + & //'is illegal.') + return + end if + +C calculate the sizes and number of loops to perform in each dimension + do 10 i=1,7 + fpix(i)=1 + irange(i)=1 + dimen(i)=1 +10 continue + + do 20 i=1,naxis + fpix(i)=fpixel(i) + irange(i)=lpixel(i)-fpixel(i)+1 + dimen(i)=naxes(i) +20 continue + i1=irange(1) + +C compute the pixel offset between each dimension + off2= dimen(1) + off3=off2*dimen(2) + off4=off3*dimen(3) + off5=off4*dimen(4) + off6=off5*dimen(5) + off7=off6*dimen(6) + + st10=fpix(1) + st20=(fpix(2)-1)*off2 + st30=(fpix(3)-1)*off3 + st40=(fpix(4)-1)*off4 + st50=(fpix(5)-1)*off5 + st60=(fpix(6)-1)*off6 + st70=(fpix(7)-1)*off7 + +C store the initial offset in each dimension + st1=st10 + st2=st20 + st3=st30 + st4=st40 + st5=st50 + st6=st60 + st7=st70 + + astart=1 + + do 170 i7=1,irange(7) + do 160 i6=1,irange(6) + do 150 i5=1,irange(5) + do 140 i4=1,irange(4) + do 130 i3=1,irange(3) + pstart=st1+st2+st3+st4+st5+st6+st7 + do 120 i2=1,irange(2) + call ftpprb(iunit,group,pstart,i1, + & array(astart),status) + astart=astart+i1 + pstart=pstart+off2 +120 continue + st2=st20 + st3=st3+off3 +130 continue + st3=st30 + st4=st4+off4 +140 continue + st4=st40 + st5=st5+off5 +150 continue + st5=st50 + st6=st6+off6 +160 continue + st6=st60 + st7=st7+off7 +170 continue + end diff --git a/pkg/tbtables/fitsio/ftpssd.f b/pkg/tbtables/fitsio/ftpssd.f new file mode 100644 index 00000000..b2269e94 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpssd.f @@ -0,0 +1,114 @@ +C-------------------------------------------------------------------------- + subroutine ftpssd(iunit,group,naxis,naxes,fpixel,lpixel, + & array,status) + +C Write a subsection of double precision values to the primary array. +C A subsection is defined to be any contiguous rectangular +C array of pixels within the n-dimensional FITS data file. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran input unit number +C group i number of the data group to be written, if any +C naxis i number of data axes in the FITS array +C naxes i (array) size of each FITS axis +C fpixel i (array) the first pixel in each dimension to be included +C in the subsection (first pixel = 1) +C lpixel i (array) the last pixel in each dimension to be included +C in the subsection +C array d array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + integer iunit,group,naxis,naxes(*),fpixel(*),lpixel(*),status + double precision array(*) + integer fpix(7),irange(7),dimen(7),astart,pstart + integer off2,off3,off4,off5,off6,off7 + integer st10,st20,st30,st40,st50,st60,st70 + integer st1,st2,st3,st4,st5,st6,st7 + integer i,i1,i2,i3,i4,i5,i6,i7 + character caxis*20 + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 7)then +C this routine only supports up to 7 dimensions + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPSSD ' + & //'is illegal.') + return + end if + +C calculate the sizes and number of loops to perform in each dimension + do 10 i=1,7 + fpix(i)=1 + irange(i)=1 + dimen(i)=1 +10 continue + + do 20 i=1,naxis + fpix(i)=fpixel(i) + irange(i)=lpixel(i)-fpixel(i)+1 + dimen(i)=naxes(i) +20 continue + i1=irange(1) + +C compute the pixel offset between each dimension + off2= dimen(1) + off3=off2*dimen(2) + off4=off3*dimen(3) + off5=off4*dimen(4) + off6=off5*dimen(5) + off7=off6*dimen(6) + + st10=fpix(1) + st20=(fpix(2)-1)*off2 + st30=(fpix(3)-1)*off3 + st40=(fpix(4)-1)*off4 + st50=(fpix(5)-1)*off5 + st60=(fpix(6)-1)*off6 + st70=(fpix(7)-1)*off7 + +C store the initial offset in each dimension + st1=st10 + st2=st20 + st3=st30 + st4=st40 + st5=st50 + st6=st60 + st7=st70 + + astart=1 + + do 170 i7=1,irange(7) + do 160 i6=1,irange(6) + do 150 i5=1,irange(5) + do 140 i4=1,irange(4) + do 130 i3=1,irange(3) + pstart=st1+st2+st3+st4+st5+st6+st7 + do 120 i2=1,irange(2) + call ftpprd(iunit,group,pstart,i1, + & array(astart),status) + astart=astart+i1 + pstart=pstart+off2 +120 continue + st2=st20 + st3=st3+off3 +130 continue + st3=st30 + st4=st4+off4 +140 continue + st4=st40 + st5=st5+off5 +150 continue + st5=st50 + st6=st6+off6 +160 continue + st6=st60 + st7=st7+off7 +170 continue + end diff --git a/pkg/tbtables/fitsio/ftpsse.f b/pkg/tbtables/fitsio/ftpsse.f new file mode 100644 index 00000000..55a79a73 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpsse.f @@ -0,0 +1,114 @@ +C-------------------------------------------------------------------------- + subroutine ftpsse(iunit,group,naxis,naxes,fpixel,lpixel, + & array,status) + +C Write a subsection of real values to the primary array. +C A subsection is defined to be any contiguous rectangular +C array of pixels within the n-dimensional FITS data file. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran input unit number +C group i number of the data group to be written, if any +C naxis i number of data axes in the FITS array +C naxes i (array) size of each FITS axis +C fpixel i (array) the first pixel in each dimension to be included +C in the subsection (first pixel = 1) +C lpixel i (array) the last pixel in each dimension to be included +C in the subsection +C array r array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + integer iunit,group,naxis,naxes(*),fpixel(*),lpixel(*),status + real array(*) + integer fpix(7),irange(7),dimen(7),astart,pstart + integer off2,off3,off4,off5,off6,off7 + integer st10,st20,st30,st40,st50,st60,st70 + integer st1,st2,st3,st4,st5,st6,st7 + integer i,i1,i2,i3,i4,i5,i6,i7 + character caxis*20 + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 7)then +C this routine only supports up to 7 dimensions + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPSSE ' + & //'is illegal.') + return + end if + +C calculate the sizes and number of loops to perform in each dimension + do 10 i=1,7 + fpix(i)=1 + irange(i)=1 + dimen(i)=1 +10 continue + + do 20 i=1,naxis + fpix(i)=fpixel(i) + irange(i)=lpixel(i)-fpixel(i)+1 + dimen(i)=naxes(i) +20 continue + i1=irange(1) + +C compute the pixel offset between each dimension + off2= dimen(1) + off3=off2*dimen(2) + off4=off3*dimen(3) + off5=off4*dimen(4) + off6=off5*dimen(5) + off7=off6*dimen(6) + + st10=fpix(1) + st20=(fpix(2)-1)*off2 + st30=(fpix(3)-1)*off3 + st40=(fpix(4)-1)*off4 + st50=(fpix(5)-1)*off5 + st60=(fpix(6)-1)*off6 + st70=(fpix(7)-1)*off7 + +C store the initial offset in each dimension + st1=st10 + st2=st20 + st3=st30 + st4=st40 + st5=st50 + st6=st60 + st7=st70 + + astart=1 + + do 170 i7=1,irange(7) + do 160 i6=1,irange(6) + do 150 i5=1,irange(5) + do 140 i4=1,irange(4) + do 130 i3=1,irange(3) + pstart=st1+st2+st3+st4+st5+st6+st7 + do 120 i2=1,irange(2) + call ftppre(iunit,group,pstart,i1, + & array(astart),status) + astart=astart+i1 + pstart=pstart+off2 +120 continue + st2=st20 + st3=st3+off3 +130 continue + st3=st30 + st4=st4+off4 +140 continue + st4=st40 + st5=st5+off5 +150 continue + st5=st50 + st6=st6+off6 +160 continue + st6=st60 + st7=st7+off7 +170 continue + end diff --git a/pkg/tbtables/fitsio/ftpssi.f b/pkg/tbtables/fitsio/ftpssi.f new file mode 100644 index 00000000..a1179c94 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpssi.f @@ -0,0 +1,114 @@ +C-------------------------------------------------------------------------- + subroutine ftpssi(iunit,group,naxis,naxes,fpixel,lpixel, + & array,status) + +C Write a subsection of integer*2 values to the primary array. +C A subsection is defined to be any contiguous rectangular +C array of pixels within the n-dimensional FITS data file. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran input unit number +C group i number of the data group to be written, if any +C naxis i number of data axes in the FITS array +C naxes i (array) size of each FITS axis +C fpixel i (array) the first pixel in each dimension to be included +C in the subsection (first pixel = 1) +C lpixel i (array) the last pixel in each dimension to be included +C in the subsection +C array i*2 array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + integer iunit,group,naxis,naxes(*),fpixel(*),lpixel(*),status + integer*2 array(*) + integer fpix(7),irange(7),dimen(7),astart,pstart + integer off2,off3,off4,off5,off6,off7 + integer st10,st20,st30,st40,st50,st60,st70 + integer st1,st2,st3,st4,st5,st6,st7 + integer i,i1,i2,i3,i4,i5,i6,i7 + character caxis*20 + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 7)then +C this routine only supports up to 7 dimensions + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPSSI ' + & //'is illegal.') + return + end if + +C calculate the sizes and number of loops to perform in each dimension + do 10 i=1,7 + fpix(i)=1 + irange(i)=1 + dimen(i)=1 +10 continue + + do 20 i=1,naxis + fpix(i)=fpixel(i) + irange(i)=lpixel(i)-fpixel(i)+1 + dimen(i)=naxes(i) +20 continue + i1=irange(1) + +C compute the pixel offset between each dimension + off2= dimen(1) + off3=off2*dimen(2) + off4=off3*dimen(3) + off5=off4*dimen(4) + off6=off5*dimen(5) + off7=off6*dimen(6) + + st10=fpix(1) + st20=(fpix(2)-1)*off2 + st30=(fpix(3)-1)*off3 + st40=(fpix(4)-1)*off4 + st50=(fpix(5)-1)*off5 + st60=(fpix(6)-1)*off6 + st70=(fpix(7)-1)*off7 + +C store the initial offset in each dimension + st1=st10 + st2=st20 + st3=st30 + st4=st40 + st5=st50 + st6=st60 + st7=st70 + + astart=1 + + do 170 i7=1,irange(7) + do 160 i6=1,irange(6) + do 150 i5=1,irange(5) + do 140 i4=1,irange(4) + do 130 i3=1,irange(3) + pstart=st1+st2+st3+st4+st5+st6+st7 + do 120 i2=1,irange(2) + call ftppri(iunit,group,pstart,i1, + & array(astart),status) + astart=astart+i1 + pstart=pstart+off2 +120 continue + st2=st20 + st3=st3+off3 +130 continue + st3=st30 + st4=st4+off4 +140 continue + st4=st40 + st5=st5+off5 +150 continue + st5=st50 + st6=st6+off6 +160 continue + st6=st60 + st7=st7+off7 +170 continue + end diff --git a/pkg/tbtables/fitsio/ftpssj.f b/pkg/tbtables/fitsio/ftpssj.f new file mode 100644 index 00000000..3ee5b208 --- /dev/null +++ b/pkg/tbtables/fitsio/ftpssj.f @@ -0,0 +1,114 @@ +C-------------------------------------------------------------------------- + subroutine ftpssj(iunit,group,naxis,naxes,fpixel,lpixel, + & array,status) + +C Write a subsection of integer values to the primary array. +C A subsection is defined to be any contiguous rectangular +C array of pixels within the n-dimensional FITS data file. +C Data conversion and scaling will be performed if necessary +C (e.g, if the datatype of the FITS array is not the same +C as the array being read). + +C iunit i Fortran input unit number +C group i number of the data group to be written, if any +C naxis i number of data axes in the FITS array +C naxes i (array) size of each FITS axis +C fpixel i (array) the first pixel in each dimension to be included +C in the subsection (first pixel = 1) +C lpixel i (array) the last pixel in each dimension to be included +C in the subsection +C array i array of values to be written +C status i returned error stataus + +C written by Wm Pence, HEASARC/GSFC, Feb 1992 + + integer iunit,group,naxis,naxes(*),fpixel(*),lpixel(*),status + integer array(*) + integer fpix(7),irange(7),dimen(7),astart,pstart + integer off2,off3,off4,off5,off6,off7 + integer st10,st20,st30,st40,st50,st60,st70 + integer st1,st2,st3,st4,st5,st6,st7 + integer i,i1,i2,i3,i4,i5,i6,i7 + character caxis*20 + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 7)then +C this routine only supports up to 7 dimensions + status=320 + write(caxis,1001)naxis +1001 format(i20) + call ftpmsg('NAXIS ='//caxis//' in the call to FTPSSJ ' + & //'is illegal.') + return + end if + +C calculate the sizes and number of loops to perform in each dimension + do 10 i=1,7 + fpix(i)=1 + irange(i)=1 + dimen(i)=1 +10 continue + + do 20 i=1,naxis + fpix(i)=fpixel(i) + irange(i)=lpixel(i)-fpixel(i)+1 + dimen(i)=naxes(i) +20 continue + i1=irange(1) + +C compute the pixel offset between each dimension + off2= dimen(1) + off3=off2*dimen(2) + off4=off3*dimen(3) + off5=off4*dimen(4) + off6=off5*dimen(5) + off7=off6*dimen(6) + + st10=fpix(1) + st20=(fpix(2)-1)*off2 + st30=(fpix(3)-1)*off3 + st40=(fpix(4)-1)*off4 + st50=(fpix(5)-1)*off5 + st60=(fpix(6)-1)*off6 + st70=(fpix(7)-1)*off7 + +C store the initial offset in each dimension + st1=st10 + st2=st20 + st3=st30 + st4=st40 + st5=st50 + st6=st60 + st7=st70 + + astart=1 + + do 170 i7=1,irange(7) + do 160 i6=1,irange(6) + do 150 i5=1,irange(5) + do 140 i4=1,irange(4) + do 130 i3=1,irange(3) + pstart=st1+st2+st3+st4+st5+st6+st7 + do 120 i2=1,irange(2) + call ftpprj(iunit,group,pstart,i1, + & array(astart),status) + astart=astart+i1 + pstart=pstart+off2 +120 continue + st2=st20 + st3=st3+off3 +130 continue + st3=st30 + st4=st4+off4 +140 continue + st4=st40 + st5=st5+off5 +150 continue + st5=st50 + st6=st6+off6 +160 continue + st6=st60 + st7=st7+off7 +170 continue + end diff --git a/pkg/tbtables/fitsio/ftpsvc.f b/pkg/tbtables/fitsio/ftpsvc.f new file mode 100644 index 00000000..92e36d3e --- /dev/null +++ b/pkg/tbtables/fitsio/ftpsvc.f @@ -0,0 +1,117 @@ +C-------------------------------------------------------------------------- + subroutine ftpsvc(keyrec,value,comm,status) + +C parse the header record to find value and comment strings + +C keyrec c 80 column header record +C OUTPUT PARAMETERS: +C value c output keyword value string +C comm c output keyword comment string +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + character*80 keyrec,keytmp + character*(*) value,comm + character*80 ctemp + integer status,j,c1 + + if (status .gt. 0)return + + if (keyrec(1:8) .eq.'COMMENT ' .or. keyrec(1:8).eq.'HISTORY ' + & .or. keyrec(1:8).eq.'END ' .or. keyrec(1:8).eq.' ') + & then +C this is a COMMENT or HISTORY record, with no value + value=' ' + comm=keyrec(9:80) + else if (keyrec(9:10) .eq. '= ')then +C this keyword has a value field; now find the first character: + do 10 j=10,80 + if (keyrec(j:j) .ne. ' ')then + c1=j + go to 15 + end if +10 continue +C error: value is blank + status=204 + call ftpmsg('The keyword '//keyrec(1:8)// + & ' has no value string after the equal sign:') + call ftpmsg(keyrec) + return + +15 if (keyrec(c1:c1) .eq. '''')then +C This is a string value. +C Work forward to find a single quote. Two single quotes +C in succession is to be interpreted as a literal single +C quote character as part of the character string, not as +C the end of the character string. Everything to the right +C of the closing quote is assumed to be the comment. +C First, copy input to temporary string variable + keytmp=keyrec + do 20 j=c1+1,80 + if (keytmp(j:j) .eq. '''')then + if (j.lt.80 .and. keytmp(j+1:j+1).eq.'''')then +C found 2 successive quote characters; this is +C interpreted as a literal quote character; remove +C one of the quotes from the string, and continue +C searching for the closing quote character: + keytmp(j+1:80)=keytmp(j+2:80) + else + value=keytmp(c1:j) + if (j .lt. 80)then + ctemp=keytmp(j+1:80) + else + ctemp=' ' + end if + go to 30 + end if + end if +20 continue +C error: no closing quote character + status=205 + call ftpmsg('The following Keyword value string has '// + & 'no closing quote:') + call ftpmsg(keyrec) + return + else +C This is either an integer, floating point, or logical value. +C Extract the first token as the value; remainder = comment + do 25 j=c1,80 + if (keyrec(j:j) .eq. ' ')then + value=keyrec(c1:j-1) + ctemp=keyrec(j+1:80) + go to 30 + end if +25 continue +C the first token went all the way to column 80: + value=keyrec(c1:80) + ctemp=' ' + end if + +30 comm=' ' +C look for first character in the comment string + do 40 j=1,78 + if (ctemp(j:j).ne.' ')then + if (ctemp(j:j).eq.'/')then +C ignore first space, if it exists + if (ctemp(j+1:j+1) .eq. ' ')then + comm=ctemp(j+2:80) + else + comm=ctemp(j+1:80) + end if + else + comm=ctemp(j:80) + end if + go to 50 + end if +40 continue + else +C illegal keyword record format; must have '= ' in columns 9-10 +C status=210 +C Modified July 1993: this is actually not an error. The +C keyword should simply be interpreted as a comment. + value=' ' + comm=keyrec(9:80) + end if +50 continue + end diff --git a/pkg/tbtables/fitsio/ftptbb.f b/pkg/tbtables/fitsio/ftptbb.f new file mode 100644 index 00000000..11b96776 --- /dev/null +++ b/pkg/tbtables/fitsio/ftptbb.f @@ -0,0 +1,64 @@ +C---------------------------------------------------------------------- + subroutine ftptbb(iunit,frow,fchar,nchars,value,status) + +C write a consecutive string of bytes to an ascii or binary +C table. This will span multiple rows of the table if NCHARS+FCHAR is +C greater than the length of a row. + +C iunit i fortran unit number +C frow i starting row number (1st row = 1) +C fchar i starting byte in the row to write (1st character=1) +C nchars i number of bytes to write (can span multiple rows) +C value i array of bytes to write +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Dec 1991 + + integer iunit,frow,fchar,nchars,status + integer value(*) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bstart + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check for errors + if (nchars .le. 0)then +C zero or negative number of character requested + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + return + else if (fchar .lt. 1)then +C error: illegal starting character + status=308 + return + end if + +C move the i/o pointer to the start of the sequence of characters + bstart=dtstrt(ibuff)+(frow-1)*rowlen(ibuff)+fchar-1 + call ftmbyt(iunit,bstart,.true.,status) + +C put the string of bytes + call ftpbyt(iunit,nchars,value,status) + end diff --git a/pkg/tbtables/fitsio/ftptbh.f b/pkg/tbtables/fitsio/ftptbh.f new file mode 100644 index 00000000..6ed2e91b --- /dev/null +++ b/pkg/tbtables/fitsio/ftptbh.f @@ -0,0 +1,12 @@ +C---------------------------------------------------------------------- + subroutine ftptbh(ounit,ncols,nrows,nfield,ttype,tbcol, + & tform,tunit,extnam,status) + +C OBSOLETE routine: should call ftphtb instead + + integer ounit,ncols,nrows,nfield,tbcol(*),status + character*(*) ttype(*),tform(*),tunit(*),extnam + + call ftphtb(ounit,ncols,nrows,nfield,ttype,tbcol, + & tform,tunit,extnam,status) + end diff --git a/pkg/tbtables/fitsio/ftptbs.f b/pkg/tbtables/fitsio/ftptbs.f new file mode 100644 index 00000000..d25fc853 --- /dev/null +++ b/pkg/tbtables/fitsio/ftptbs.f @@ -0,0 +1,64 @@ +C---------------------------------------------------------------------- + subroutine ftptbs(iunit,frow,fchar,nchars,svalue,status) + +C write a consecutive string of characters to an ascii or binary +C table. This will span multiple rows of the table if NCHARS+FCHAR is +C greater than the length of a row. + +C iunit i fortran unit number +C frow i starting row number (1st row = 1) +C fchar i starting character/byte in the row to write (1st character=1) +C nchars i number of characters/bytes to write (can span multiple rows) +C svalue c string of characters to write +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Dec 1991 + + integer iunit,frow,fchar,nchars,status + character*(*) svalue + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,bstart + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C check for errors + if (nchars .le. 0)then +C zero or negative number of character requested + return + else if (frow .lt. 1)then +C error: illegal first row number + status=307 + return + else if (fchar .lt. 1)then +C error: illegal starting character + status=308 + return + end if + +C move the i/o pointer to the start of the sequence of characters + bstart=dtstrt(ibuff)+(frow-1)*rowlen(ibuff)+fchar-1 + call ftmbyt(iunit,bstart,.true.,status) + +C put the string of characters + call ftpcbf(iunit,1,nchars,svalue,status) + end diff --git a/pkg/tbtables/fitsio/ftptdm.f b/pkg/tbtables/fitsio/ftptdm.f new file mode 100644 index 00000000..1b3464d3 --- /dev/null +++ b/pkg/tbtables/fitsio/ftptdm.f @@ -0,0 +1,60 @@ +C---------------------------------------------------------------------- + subroutine ftptdm(iunit,colnum,naxis,naxes,status) + +C write the TDIMnnn keyword describing the dimensionality of a column + +C iunit i fortran unit number to use for reading +C colnum i column number to read +C naxis i number of axes in the data array +C naxes i array giving the length of each data axis +C OUTPUT PARAMETERS: +C status i output error status (0=OK) +C +C written by Wm Pence, HEASARC/GSFC, October 1993 + + integer iunit,colnum,naxis,naxes(*),status + + integer i,j,nextsp + character tdim*120, cval*20 + + if (status .gt. 0)return + + if (naxis .lt. 1 .or. naxis .gt. 100)then +C illegal number of axes + status=320 + return + else if (colnum .lt. 1 .or. colnum .gt. 999)then +C illegal column number + status=302 + return + end if + +C construct the keyword value + tdim='(' + + nextsp=2 + do 100 i=1,naxis + if (naxes(i) .lt. 1)then + status=323 + return + end if + +C convert integer to right justified C*20 string + call fti2c(naxes(i),cval,status) + if (status .gt. 0)return + + do 20 j=20,1,-1 + if (cval(j:j) .eq. ' ')then + tdim(nextsp:)=cval(j+1:20) + nextsp=nextsp+21-j + tdim(nextsp-1:)=',' + go to 100 + end if +20 continue +100 continue + + tdim(nextsp-1:)=')' + + call ftpkns(iunit,'TDIM',colnum,1,tdim, + & 'size of the multidimensional array',status) + end diff --git a/pkg/tbtables/fitsio/ftpthp.f b/pkg/tbtables/fitsio/ftpthp.f new file mode 100644 index 00000000..c6e82bde --- /dev/null +++ b/pkg/tbtables/fitsio/ftpthp.f @@ -0,0 +1,46 @@ +C-------------------------------------------------------------------------- + subroutine ftpthp(ounit,heap,status) + +C Define the starting address for the heap for a binary table. +C The default address is NAXIS1 * NAXIS2. It is in units of +C bytes relative to the beginning of the regular binary table data. +C This subroutine also writes the appropriate THEAP keyword to the +C FITS header. + +C ounit i Fortran I/O unit number +C heap i starting address of the heap +C OUTPUT PARAMETERS: +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, Nov 1991 + + integer ounit,heap,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + ibuff=bufnum(ounit) + theap(ibuff)=heap + +C write the keyword + call ftukyj(ounit,'THEAP',heap,'Byte offset of heap area', + & status) + end diff --git a/pkg/tbtables/fitsio/ftr2e.f b/pkg/tbtables/fitsio/ftr2e.f new file mode 100644 index 00000000..d85cca43 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr2e.f @@ -0,0 +1,36 @@ +C---------------------------------------------------------------------- + subroutine ftr2e(val,dec,cval,status) + +C convert real value to E20.* format character string +C val r input value to be converted +C dec i number of decimal places to display in output string +C cval c output character string +C status i output error status (0 = OK) + + real val + integer dec,status + character*20 cval,form*10 + + if (status .gt. 0)return + + if (dec .ge. 1 .and. dec .le. 9)then + write(form,2000)dec +2000 format('(1pe20.',i1,')') + else if (dec .ge. 10 .and. dec .le. 13)then + write(form,2001)dec +2001 format('(1pe20.',i2,')') + else +C illegal number of decimal places were specified + status=411 + call ftpmsg('Error in FTR2E: number of decimal places ' + & //'is less than 1 or greater than 13.') + return + endif + + write(cval,form,err=900)val + if (cval(1:1) .eq. '*')go to 900 + return + +900 status=402 + call ftpmsg('Error in FTR2E converting real to E20. string.') + end diff --git a/pkg/tbtables/fitsio/ftr2f.f b/pkg/tbtables/fitsio/ftr2f.f new file mode 100644 index 00000000..09e151fd --- /dev/null +++ b/pkg/tbtables/fitsio/ftr2f.f @@ -0,0 +1,34 @@ +C---------------------------------------------------------------------- + subroutine ftr2f(val,dec,cval,status) + +C convert real value to F20.* format character string +C val r input value to be converted +C dec i number of decimal places to display in output string +C cval c output character string +C status i output error status (0 = OK) + + real val + integer dec,status + character*20 cval,form*8 + + if (status .gt. 0)return + + if (dec .ge. 0 .and. dec .le. 9)then + write(form,2000)dec +2000 format('(f20.',i1,')') + else if (dec .ge. 10 .and. dec .lt.18)then + write(form,2001)dec +2001 format('(f20.',i2,')') + else + status=411 + call ftpmsg('Error in FTR2F: number of decimal places ' + & //'is less than 0 or greater than 18.') + return + endif + + write(cval,form,err=900)val + if (cval(1:1) .eq. '*')go to 900 + return +900 status=402 + call ftpmsg('Error in FTR2F converting real to F20. string.') + end diff --git a/pkg/tbtables/fitsio/ftr4i1.f b/pkg/tbtables/fitsio/ftr4i1.f new file mode 100644 index 00000000..6954b9ff --- /dev/null +++ b/pkg/tbtables/fitsio/ftr4i1.f @@ -0,0 +1,154 @@ +C---------------------------------------------------------------------- + subroutine ftr4i1(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*4 values to output i*1 values, doing optional +C scaling and checking for null values + +C input r input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval c*1 value to set array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output c*1 returned array of values +C status i output error status (0 = ok) + + real input(*) + character*1 output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval + logical tofits,flgray(*),anynul,noscal + logical fttrnn + external fttrnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*1 range + if (input(i).lt. 255.49 .and. + & input(i).gt. -.49)then + output(i)=char(nint(input(i))) + else if (input(i) .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*1 range + if (input(i).lt. 255.49 .and. + & input(i).gt. -.49)then + output(i)=char(nint(input(i))) + else if (input(i) .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*1 range + if (input(i).lt. 255.49 .and. + & input(i).gt. -.49)then + output(i)=char(nint(input(i))) + else if (input(i) .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +50 continue + else + do 60 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr4i2.f b/pkg/tbtables/fitsio/ftr4i2.f new file mode 100644 index 00000000..937fd658 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr4i2.f @@ -0,0 +1,161 @@ +C---------------------------------------------------------------------- + subroutine ftr4i2(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*4 values to output i*2 values, doing optional +C scaling and checking for null values + +C input r input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval i*2 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i*2 returned array of values +C status i output error status (0 = ok) + + real input(*) + integer*2 output(*),setval,mmini2,mmaxi2 + integer n,i,chktyp,status + double precision scale,zero,dval,i2max,i2min + logical tofits,flgray(*),anynul,noscal + logical fttrnn + parameter (i2max=3.276749D+04) + parameter (i2min=-3.276849D+04) + real mini2,maxi2 + parameter (maxi2=32767.49) + parameter (mini2=-32768.49) + parameter (mmaxi2=32767) + parameter (mmini2=-32768) + external fttrnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*2 range + if (input(i) .le. maxi2 .and. + & input(i) .ge. mini2)then + output(i)=nint(input(i)) + else if (input(i) .gt. maxi2)then + status=-11 + output(i)=mmaxi2 + else + status=-11 + output(i)=mmini2 + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=mmaxi2 + else + status=-11 + output(i)=mmini2 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*2 range + if (input(i) .le. maxi2 .and. + & input(i) .ge. mini2)then + output(i)=nint(input(i)) + else if (input(i) .gt. maxi2)then + status=-11 + output(i)=mmaxi2 + else + status=-11 + output(i)=mmini2 + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=mmaxi2 + else + status=-11 + output(i)=mmini2 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*2 range + if (input(i) .le. maxi2 .and. + & input(i) .ge. mini2)then + output(i)=nint(input(i)) + else if (input(i) .gt. maxi2)then + status=-11 + output(i)=mmaxi2 + else + status=-11 + output(i)=mmini2 + end if + end if +50 continue + else + do 60 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=mmaxi2 + else + status=-11 + output(i)=mmini2 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr4i4.f b/pkg/tbtables/fitsio/ftr4i4.f new file mode 100644 index 00000000..51f4c5a2 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr4i4.f @@ -0,0 +1,165 @@ +C---------------------------------------------------------------------- + subroutine ftr4i4(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*4 values to output i*4 values, doing optional +C scaling and checking for null values + +C input r input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval i value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i returned array of values +C status i output error status (0 = ok) + + real input(*) + integer output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval,i4min,i4max + logical tofits,flgray(*),anynul,noscal + logical fttrnn + parameter (i4max= 2.14748364749D+09) + parameter (i4min=-2.14748364849D+09) + real mini4,maxi4 +C Warning: only have about 7 digits of precision, so don't try +C to set the maxi4 and mini4 limits any closer to the I*4 range. + parameter (maxi4= 2.1474835E+09) + parameter (mini4=-2.1474835E+09) + integer mmaxi4,mmini4 + parameter (mmaxi4=2147483647) + external fttrnn +C work around for bug in the DEC Alpha VMS compiler + mmini4=-2147483647 - 1 + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*4 range + if (input(i) .le. maxi4 .and. + & input(i) .ge. mini4)then + output(i)=nint(input(i)) + else if (input(i) .gt. maxi4)then + status=-11 + output(i)=mmaxi4 + else + status=-11 + output(i)=mmini4 + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=mmaxi4 + else + status=-11 + output(i)=mmini4 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*4 range + if (input(i) .le. maxi4 .and. + & input(i) .ge. mini4)then + output(i)=nint(input(i)) + else if (input(i) .gt. maxi4)then + status=-11 + output(i)=mmaxi4 + else + status=-11 + output(i)=mmini4 + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=mmaxi4 + else + status=-11 + output(i)=mmini4 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*4 range + if (input(i) .le. maxi4 .and. + & input(i) .ge. mini4)then + output(i)=nint(input(i)) + else if (input(i) .gt. maxi4)then + status=-11 + output(i)=mmaxi4 + else + status=-11 + output(i)=mmini4 + end if + end if +50 continue + else + do 60 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=mmaxi4 + else + status=-11 + output(i)=mmini4 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr4r4.f b/pkg/tbtables/fitsio/ftr4r4.f new file mode 100644 index 00000000..71950759 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr4r4.f @@ -0,0 +1,93 @@ +C---------------------------------------------------------------------- + subroutine ftr4r4(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*4 values to output r*4 values, doing optional +C scaling and checking for null values + +C input r input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval r value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output r returned array of values + + real input(*) + real output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + logical fttrnn + external fttrnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr4r8.f b/pkg/tbtables/fitsio/ftr4r8.f new file mode 100644 index 00000000..adf4f8e6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr4r8.f @@ -0,0 +1,93 @@ +C---------------------------------------------------------------------- + subroutine ftr4r8(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*4 values to output r*8 values, doing optional +C scaling and checking for null values + +C input r input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval d value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output d returned array of values + + real input(*) + double precision output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + logical fttrnn + external fttrnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (fttrnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr8i1.f b/pkg/tbtables/fitsio/ftr8i1.f new file mode 100644 index 00000000..10666519 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr8i1.f @@ -0,0 +1,154 @@ +C---------------------------------------------------------------------- + subroutine ftr8i1(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*8 values to output i*1 values, doing optional +C scaling and checking for null values + +C input d input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval c*1 value to set array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output c*1 returned array of values +C status i output error status (0 = ok) + + double precision input(*) + character*1 output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval + logical tofits,flgray(*),anynul,noscal + logical fttdnn + external fttdnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*1 range + if (input(i).lt. 255.49 .and. + & input(i).gt. -.49)then + output(i)=char(nint(input(i))) + else if (input(i) .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*1 range + if (input(i).lt. 255.49 .and. + & input(i).gt. -.49)then + output(i)=char(nint(input(i))) + else if (input(i) .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*1 range + if (input(i).lt. 255.49 .and. + & input(i).gt. -.49)then + output(i)=char(nint(input(i))) + else if (input(i) .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +50 continue + else + do 60 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*1 range + if (dval.lt. 255.49 .and. dval.gt. -.49)then + output(i)=char(nint(dval)) + else if (dval .ge. 255.49)then + status=-11 + output(i)=char(255) + else + status=-11 + output(i)=char(0) + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr8i2.f b/pkg/tbtables/fitsio/ftr8i2.f new file mode 100644 index 00000000..529dce48 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr8i2.f @@ -0,0 +1,159 @@ +C---------------------------------------------------------------------- + subroutine ftr8i2(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*8 values to output i*2 values, doing optional +C scaling and checking for null values + +C input d input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval i*2 value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i*2 returned array of values +C status i output error status (0 = ok) + + double precision input(*) + integer*2 output(*),setval,maxi2,mini2 + integer n,i,chktyp,status + double precision scale,zero,dval,i2max,i2min + logical tofits,flgray(*),anynul,noscal + logical fttdnn + parameter (i2max=3.276749D+04) + parameter (i2min=-3.276849D+04) + + parameter (maxi2=32767) + parameter (mini2=-32768) + external fttdnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*2 range + if (input(i) .le. i2max .and. + & input(i) .ge. i2min)then + output(i)=nint(input(i)) + else if (input(i) .gt. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*2 range + if (input(i) .le. i2max .and. + & input(i) .ge. i2min)then + output(i)=nint(input(i)) + else if (input(i) .gt. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*2 range + if (input(i) .le. i2max .and. + & input(i) .ge. i2min)then + output(i)=nint(input(i)) + else if (input(i) .gt. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if + end if +50 continue + else + do 60 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*2 range + if (dval.lt.i2max .and. dval.gt.i2min)then + output(i)=nint(dval) + else if (dval .ge. i2max)then + status=-11 + output(i)=maxi2 + else + status=-11 + output(i)=mini2 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr8i4.f b/pkg/tbtables/fitsio/ftr8i4.f new file mode 100644 index 00000000..235b15fe --- /dev/null +++ b/pkg/tbtables/fitsio/ftr8i4.f @@ -0,0 +1,160 @@ +C---------------------------------------------------------------------- + subroutine ftr8i4(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*8 values to output i*4 values, doing optional +C scaling and checking for null values + +C input d input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval i value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output i returned array of values +C status i output error status (0 = ok) + + double precision input(*) + integer output(*),setval + integer n,i,chktyp,status + double precision scale,zero,dval,i4min,i4max + logical tofits,flgray(*),anynul,noscal + logical fttdnn + parameter (i4max=2.14748364749D+09) + parameter (i4min=-2.14748364849D+09) + integer maxi4,mini4 + parameter (maxi4=2147483647) + external fttdnn +C work around for bug in the DEC Alpha VMS compiler + mini4=-2147483647 - 1 + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n +C trap any values that overflow the I*4 range + if (input(i) .le. i4max .and. + & input(i) .ge. i4min)then + output(i)=nint(input(i)) + else if (input(i) .gt. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +10 continue + else + do 20 i=1,n + dval=(input(i)-zero)/scale +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n +C trap any values that overflow the I*4 range + if (input(i) .le. i4max .and. + & input(i) .ge. i4min)then + output(i)=nint(input(i)) + else if (input(i) .gt. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +30 continue + else + do 40 i=1,n + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else +C trap any values that overflow the I*4 range + if (input(i) .le. i4max .and. + & input(i) .ge. i4min)then + output(i)=nint(input(i)) + else if (input(i) .gt. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if + end if +50 continue + else + do 60 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + dval=input(i)*scale+zero +C trap any values that overflow the I*4 range + if (dval.lt.i4max .and. dval.gt.i4min)then + output(i)=nint(dval) + else if (dval .ge. i4max)then + status=-11 + output(i)=maxi4 + else + status=-11 + output(i)=mini4 + end if + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr8r4.f b/pkg/tbtables/fitsio/ftr8r4.f new file mode 100644 index 00000000..f5f2bbbb --- /dev/null +++ b/pkg/tbtables/fitsio/ftr8r4.f @@ -0,0 +1,93 @@ +C---------------------------------------------------------------------- + subroutine ftr8r4(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*8 values to output r*4 values, doing optional +C scaling and checking for null values + +C input d input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval r value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output r returned array of values + + double precision input(*) + real output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + logical fttdnn + external fttdnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftr8r8.f b/pkg/tbtables/fitsio/ftr8r8.f new file mode 100644 index 00000000..36424121 --- /dev/null +++ b/pkg/tbtables/fitsio/ftr8r8.f @@ -0,0 +1,93 @@ +C---------------------------------------------------------------------- + subroutine ftr8r8(input,n,scale,zero,tofits, + & chktyp,setval,flgray,anynul,output,status) + +C copy input r*8 values to output r*8 values, doing optional +C scaling and checking for null values + +C input d input array of values +C n i number of values +C scale d scaling factor to be applied +C zero d scaling zero point to be applied +C tofits l true if converting from internal format to FITS +C chktyp i type of null value checking to be done if TOFITS=.false. +C =0 no checking for null values +C =1 set null values = SETVAL +C =2 set corresponding FLGRAY value = .true. +C setval d value to set output array to if value is undefined +C flgray l array of logicals indicating if corresponding value is null +C anynul l set to true if any nulls were set in the output array +C output d returned array of values + + double precision input(*) + double precision output(*),setval + integer n,i,chktyp,status + double precision scale,zero + logical tofits,flgray(*),anynul,noscal + logical fttdnn + external fttdnn + + if (status .gt. 0)return + + if (scale .eq. 1. .and. zero .eq. 0)then + noscal=.true. + else + noscal=.false. + end if + + if (tofits) then +C we don't have to worry about null values when writing to FITS + if (noscal)then + do 10 i=1,n + output(i)=input(i) +10 continue + else + do 20 i=1,n + output(i)=(input(i)-zero)/scale +20 continue + end if + else +C converting from FITS to internal format; may have to check nulls + if (chktyp .eq. 0)then +C don't have to check for nulls + if (noscal)then + do 30 i=1,n + output(i)=input(i) +30 continue + else + do 40 i=1,n + output(i)=input(i)*scale+zero +40 continue + end if + else +C must test for null values + if (noscal)then + do 50 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i) + end if +50 continue + else + do 60 i=1,n + if (fttdnn(input(i)))then + anynul=.true. + if (chktyp .eq. 1)then + output(i)=setval + else + flgray(i)=.true. + end if + else + output(i)=input(i)*scale+zero + end if +60 continue + end if + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftrdef.f b/pkg/tbtables/fitsio/ftrdef.f new file mode 100644 index 00000000..db200a00 --- /dev/null +++ b/pkg/tbtables/fitsio/ftrdef.f @@ -0,0 +1,41 @@ +C-------------------------------------------------------------------------- + subroutine ftrdef(ounit,status) + +C ReDEFine the structure of a data unit. This routine re-reads +C the CHDU header keywords to determine the structure and length of the +C current data unit. This redefines the start of the next HDU. +C +C ounit i Fortran I/O unit number +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1993 + + integer ounit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,dummy + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C see if we have write access to this file (no need to go on, if not) + if (wrmode(ibuff))then +C rewrite the header END card, and following blank fill + call ftwend(ounit,status) + if (status .gt. 0)return + +C now re-read the required keywords to determine the structure + call ftrhdu(ounit,dummy,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftrhdu.f b/pkg/tbtables/fitsio/ftrhdu.f new file mode 100644 index 00000000..ac8a291b --- /dev/null +++ b/pkg/tbtables/fitsio/ftrhdu.f @@ -0,0 +1,108 @@ +C-------------------------------------------------------------------------- + subroutine ftrhdu(iunit,xtend,status) + +C read the CHDU structure by reading the header keywords which define +C the size and structure of the header and data units. + +C iunit i Fortran I/O unit number +C OUTPUT PARAMETERS: +C xtend i returned type of extension: 0 = the primary HDU +C 1 = an ASCII table +C 2 = a binary table +C -1 = unknown +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer iunit,xtend,status,i,ic,tstat + character keynam*8,exttyp*10,comm*30,keybuf*80 + logical endof + + if (status .gt. 0)return + +C read first keyword to determine the type of the CHDU + call ftgrec(iunit,1,keybuf,status) + + if (status .gt. 0)then + call ftpmsg('Cannot read first keyword in header (FTRHDU)') + return + end if + +C release any current column descriptors for this unit + call ftfrcl(iunit,status) + + keynam=keybuf(1:8) +C parse the value and comment fields from the record + call ftpsvc(keybuf,exttyp,comm,status) + + if (status .gt. 0)then +C unknown type of FITS record; can't read it + call ftpmsg('Cannot parse value of first keyword; unknown ' + & //'type of FITS record (FTRHDU):') + + else if (keynam .eq. 'SIMPLE')then +C initialize the parameters describing the primay HDU + call ftpini(iunit,status) + xtend=0 + else if (keynam.eq.'XTENSION')then + if (exttyp(1:1) .ne. '''')then +C value of XTENSION is not a quoted character string! + if (keybuf(9:10) .ne. '= ')then + call ftpmsg('XTENSION keyword does not ' + & //'have "= " in cols 9-10.') + else + call ftpmsg('Unknown type of extension; value' + & //' of XTENSION keyword is not a quoted string:') + end if + status=251 + call ftpmsg(keybuf) + else if (exttyp(2:9) .eq. 'TABLE ')then +C initialize the parameters for the ASCII table extension + call ftaini(iunit,status) + xtend=1 + else if (exttyp(2:9) .eq. 'BINTABLE' .or. exttyp(2:9) + & .eq. 'A3DTABLE' .or. exttyp(2:9) .eq. '3DTABLE ')then +C initialize the parameters for the binary table extension + call ftbini(iunit,status) + xtend=2 + else +C try to initialize the parameters describing extension + tstat=status + call ftpini(iunit,status) + xtend=0 + if (status .eq. 251)then +C unknown type of extension + xtend=-1 + status=tstat + end if + end if + else +C unknown record +C If file is created on a VAX with 512-byte records, then +C the FITS file may have fill bytes (ASCII NULs) at the end. +C Also, if file has been editted on a SUN, an extra ASCII 10 +C character may appear at the end of the file. Finally, if +C file is not a multiple of the record length long, then +C the last truncated record may be filled with ASCII blanks. +C So, if the record only contains NULS, LF, and blanks, then +C assume we found the end of file. Otherwise report an error. + + endof=.true. + do 10 i=1,80 + ic=ichar(keybuf(i:i)) + if (ic .ne. 0 .and .ic .ne. 10 .and. ic .ne. 32) + & endof=.false. +10 continue + if (endof)then + status=107 + call ftpmsg('ASCII 0s, 10s, or 32s at start of ' + & //'extension are treated as EOF (FTRHDU):') + else + status=252 + call ftpmsg('Extension does not start with SIMPLE' + & //' or XTENSION keyword (FTRHDU):') + end if + xtend=-1 + call ftpmsg(keybuf) + end if + end diff --git a/pkg/tbtables/fitsio/ftrsnm.f b/pkg/tbtables/fitsio/ftrsnm.f new file mode 100644 index 00000000..f9f4eb38 --- /dev/null +++ b/pkg/tbtables/fitsio/ftrsnm.f @@ -0,0 +1,15 @@ +C-------------------------------------------------------------------------- + subroutine ftrsnm + +C simply reset the column names as undefined +C this will force ftgcnn to read the column names from the +C file the next time it is called + +C written by Wm Pence, HEASARC/GSFC, Feb 1995 + + integer colpnt,untpnt + common/ftname/colpnt,untpnt + + colpnt= -999 + untpnt=0 + end diff --git a/pkg/tbtables/fitsio/ftrwdn.f b/pkg/tbtables/fitsio/ftrwdn.f new file mode 100644 index 00000000..86bb17f4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftrwdn.f @@ -0,0 +1,183 @@ +C-------------------------------------------------------------------------- + subroutine ftrwdn(iunit,frow,lrow,nshift,status) + +C shift rows in a table down by NROWS rows, inserting blank rows + +C iunit i Fortran I/O unit number +C frow i rows *AFTER* this one are to be moved down +C lrow i last row to be moved down (last row of the table) +C nshift i how far to shift the rows +C status i returned error status (0=ok) + + integer iunit,frow,lrow,nshift,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 buff(2880,2) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,kshift,nchar,fchar,in,out,i,j,irow,tin,jrow + integer lstptr,inptr,outptr,nseg + character cfill*1 + + if (status .gt. 0)return + +C don't have to do anything if inserting blank rows at end of the table + if (frow .eq. lrow)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C select appropriate fill value + if (hdutyp(ibuff) .eq. 1)then +C fill header or ASCII table with space + cfill=char(32) + else +C fill image or bintable data area with Null (0) + cfill=char(0) + end if + +C how many rows will fit in the single buffer? + kshift=2880/rowlen(ibuff) + +C ********************************************************************** +C CASE #1: optimal case where the NSHIFT number of rows will all +C fit in the 2880-byte work buffer simultaneously. The rows can +C be shifted down in one efficient pass through the table. +C ********************************************************************** + if (kshift .ge. nshift)then + + kshift=nshift + nchar=kshift*rowlen(ibuff) + fchar=1 + +C initialize the first buffer + in=2 + out=1 + + do 5 i=1,2880 + buff(i,1)=cfill +5 continue + + do 10 irow=frow+1,lrow,kshift + +C read the row(s) to be shifted + call ftgtbs(iunit,irow,fchar,nchar,buff(1,in),status) + +C overwrite these row(s) with the previous row(s) + call ftptbs(iunit,irow,fchar,nchar,buff(1,out),status) + +C swap the input and output buffer pointers and move to next rows + tin=in + in=out + out=tin + jrow=irow +10 continue + +C write the last row(s) out + irow=jrow+kshift + nchar=(lrow-jrow+1)*rowlen(ibuff) + + call ftptbs(iunit,irow,fchar,nchar,buff(1,out),status) + return + +C ********************************************************************** +C CASE #2: One or more rows of the table will fit in the work buffer, +C but cannot fit all NSHIFT rows in the buffer at once. Note that +C since we do not need 2 buffers, as in the previous case, we can +C combine both buffers into one single 2880*2 byte buffer, to handle +C wider tables. This algorithm copies then moves blocks of contiguous +C rows at one time, working upwards from the bottom of the table. +C ********************************************************************** + else if (rowlen(ibuff) .le. 5760)then + +C how many rows can we move at one time? + kshift=5760/rowlen(ibuff) + fchar=1 + +C initialize pointers + lstptr=lrow + inptr=lrow-kshift+1 + +20 if (inptr .le. frow)inptr=frow+1 + nchar=(lstptr-inptr+1)*rowlen(ibuff) + outptr=inptr+nshift + +C read the row(s) to be shifted + call ftgtbs(iunit,inptr,fchar,nchar,buff,status) + +C write the row(s) to the new location + call ftptbs(iunit,outptr,fchar,nchar,buff,status) + +C If there are more rows, update pointers and repeat + if (inptr .gt. frow+1)then + lstptr=lstptr-kshift + inptr =inptr -kshift + go to 20 + end if + +C initialize the buffer with the fill value + do 25 i=1,2880 + buff(i,1)=cfill + buff(i,2)=cfill +25 continue + +C fill the empty rows with blanks or nulls + nchar=rowlen(ibuff) + do 30 i=1,nshift + outptr=frow+i + call ftptbs(iunit,outptr,fchar,nchar,buff,status) +30 continue + return + +C ********************************************************************** +C CASE #3: Cannot fit a whole row into the work buffer, so have +C to move each row in pieces. +C ********************************************************************** + else + + nseg=(rowlen(ibuff)+5759)/5760 + nchar=5760 + + do 60 j=1,nseg + fchar=(j-1)*5760+1 + if (j .eq. nseg)nchar=rowlen(ibuff)-(nseg-1)*5760 + + do 40 i=lrow,frow+1,-1 +C read the row to be shifted + call ftgtbs(iunit,i,fchar,nchar,buff,status) + +C write the row(s) to the new location + call ftptbs(iunit,i+nshift,fchar,nchar,buff,status) +40 continue + +C initialize the buffer with the fill value + do 45 i=1,2880 + buff(i,1)=cfill + buff(i,2)=cfill +45 continue + +C fill the empty rows with blanks or nulls + do 50 i=1,nshift + outptr=frow+i + call ftptbs(iunit,outptr,fchar,nchar,buff,status) +50 continue +60 continue + + end if + end diff --git a/pkg/tbtables/fitsio/ftrwup.f b/pkg/tbtables/fitsio/ftrwup.f new file mode 100644 index 00000000..9239ead0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftrwup.f @@ -0,0 +1,136 @@ +C-------------------------------------------------------------------------- + subroutine ftrwup(iunit,frow,lrow,nshift,status) + +C shift rows in a table up by NROWS rows, overwriting the rows above + +C iunit i Fortran I/O unit number +C frow i first row to be moved up +C lrow i last row to be moved up (last row of the table) +C nshift i how far to shift the rows (number of rows) +C status i returned error status (0=ok) + + integer iunit,frow,lrow,nshift,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nb = 20) + parameter (nf = 3000) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character*1 buff(5760) + common/ftheap/buff +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,kshift,nchar,fchar,i,j + integer lstptr,inptr,outptr,nseg + character cfill*1 + + if (status .gt. 0)return + +C define the number of the buffer used for this file + ibuff=bufnum(iunit) + +C select appropriate fill value + if (hdutyp(ibuff) .eq. 1)then +C fill header or ASCII table with space + cfill=char(32) + else +C fill image or bintable data area with Null (0) + cfill=char(0) + end if + +C ********************************************************************** +C CASE #1: One or more rows of the table will fit in the work buffer, +C ********************************************************************** + if (rowlen(ibuff) .le. 5760)then + +C how many rows can we move at one time? + kshift=5760/rowlen(ibuff) + fchar=1 + +C check if we just need to clear the last NSHIFT rows of the table + if (frow .eq. lrow+1)go to 25 + +C initialize pointers + inptr=frow + lstptr=inptr+kshift + +20 if (lstptr .gt. lrow)lstptr=lrow + nchar=(lstptr-inptr+1)*rowlen(ibuff) + outptr=inptr-nshift + +C read the row(s) to be shifted + call ftgtbs(iunit,inptr,fchar,nchar,buff,status) + +C write the row(s) to the new location + call ftptbs(iunit,outptr,fchar,nchar,buff,status) + +C If there are more rows, update pointers and repeat + if (lstptr .lt. lrow)then + inptr =inptr +kshift + lstptr=lstptr+kshift + go to 20 + end if + +C initialize the buffer with the fill value +25 continue + do 30 i=1,5760 + buff(i)=cfill +30 continue + +C fill the empty rows at the bottom of the table with blanks or nulls + nchar=rowlen(ibuff) + do 35 i=1,nshift + outptr=lrow-nshift+i + call ftptbs(iunit,outptr,fchar,nchar,buff,status) +35 continue + return + +C ********************************************************************** +C CASE #2: Cannot fit a whole row into the work buffer, so have +C to move each row in pieces. +C ********************************************************************** + else + + nseg=(rowlen(ibuff)+5759)/5760 + nchar=5760 + + do 60 j=1,nseg + fchar=(j-1)*5760+1 + if (j .eq. nseg)nchar=rowlen(ibuff)-(nseg-1)*5760 + +C check if we just need to clear the last NSHIFT rows of the table + if (frow .eq. lrow+1)go to 45 + + do 40 i=frow,lrow +C read the row to be shifted + call ftgtbs(iunit,i,fchar,nchar,buff,status) + +C write the row(s) to the new location + call ftptbs(iunit,i-nshift,fchar,nchar,buff,status) +40 continue + +C initialize the buffer with the fill value +45 continue + do 50 i=1,5760 + buff(i)=cfill +50 continue + +C fill the empty rows with blanks or nulls + do 55 i=1,nshift + outptr=lrow-nshift+i + call ftptbs(iunit,outptr,fchar,nchar,buff,status) +55 continue +60 continue + end if + end diff --git a/pkg/tbtables/fitsio/fts2c.f b/pkg/tbtables/fitsio/fts2c.f new file mode 100644 index 00000000..2bceee6b --- /dev/null +++ b/pkg/tbtables/fitsio/fts2c.f @@ -0,0 +1,57 @@ +C---------------------------------------------------------------------- + subroutine fts2c(in,cval,lenval,status) +C convert an input string to a left justified quoted string +C The minimum length FITS string is 8 characters, so +C pad the quoted string with spaces if necessary. +C cval = returned quoted string +C lenval = length of the cval string, including the 2 quote characters + character*(*) in,cval + integer length,i,j,i1,i2,lenval,status + + if (status .gt. 0)return + + i1=1 + i2=1 +C test for blank input string + if (in .eq. ' ')then + cval=''' ''' + lenval=10 + return + end if + + length=len(in) +C find first and last non-blank characters + +C modified 29 Nov 1994 to treat leading spaces as significant +C do 5 i=1,length +C i1=i +C if (in(i:i) .ne. ' ')go to 10 +C5 continue +C10 continue + + do 15 i=length,1,-1 + i2=i + if (in(i:i) .ne. ' ')go to 20 +15 continue +20 continue + + cval=''''//in(i1:i2) + +C test if there are any single quotes in the string; if so, replace +C them with two successive single quotes + lenval=i2-i1+2 + do 30 i=lenval,2,-1 + if (cval(i:i) .eq. '''')then +C shift all the characters over 1 space + do 40 j=len(cval),i+1,-1 + cval(j:j)=cval(j-1:j-1) +40 continue + i2=i2+1 + end if +30 continue + +C find location of closing quote + lenval=max(10,i2-i1+3) + lenval=min(lenval,len(cval)) + cval(lenval:lenval)='''' + end diff --git a/pkg/tbtables/fitsio/ftsdnn.f b/pkg/tbtables/fitsio/ftsdnn.f new file mode 100644 index 00000000..9bd41107 --- /dev/null +++ b/pkg/tbtables/fitsio/ftsdnn.f @@ -0,0 +1,15 @@ +C---------------------------------------------------------------------- + subroutine ftsdnn(value) + +C set a 64-bit pattern equal to an IEEE Not-a-Number value +C A NaN has all the exponent bits=1, and the fractional part +C not=0. +C +C written by Wm Pence, HEASARC/GSFC, February 1991 + + integer value(2) + +C there are many NaN values; choose a simple one in which all bits=1 + value(1)=-1 + value(2)=-1 + end diff --git a/pkg/tbtables/fitsio/ftsnul.f b/pkg/tbtables/fitsio/ftsnul.f new file mode 100644 index 00000000..6ef34ecb --- /dev/null +++ b/pkg/tbtables/fitsio/ftsnul.f @@ -0,0 +1,59 @@ +C-------------------------------------------------------------------------- + subroutine ftsnul(ounit,colnum,nulval,status) + +C ascii table Column NULl value definition +C Define the null value for an ASCII table column. +C +C ounit i Fortran I/O unit number +C colnum i number of the column to be defined +C nulval c the string to be use to signify undefined data +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,status + character*(*) nulval + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) + character cnull*16, cform*8 + common/ft0003/cnull(nf),cform(nf) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + if (status .gt. 0)return + +C test for proper HDU type + if (hdutyp(ibuff) .ne. 1)then + status=226 + return + end if + + if (colnum .gt. tfield(ibuff) .or. colnum .lt. 1)then + status=302 + return + end if + + cnull(colnum+tstart(ibuff))=nulval + end diff --git a/pkg/tbtables/fitsio/ftsrnn.f b/pkg/tbtables/fitsio/ftsrnn.f new file mode 100644 index 00000000..5ba489bc --- /dev/null +++ b/pkg/tbtables/fitsio/ftsrnn.f @@ -0,0 +1,14 @@ +C---------------------------------------------------------------------- + subroutine ftsrnn(value) + +C set a 32-bit pattern equal to an IEEE Not-a-Number value +C A NaN has all the exponent bits=1, and the fractional part +C not=0. +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer value + +C there are many NaN values; choose a simple one in which all bits=1 + value=-1 + end diff --git a/pkg/tbtables/fitsio/fttbit.f b/pkg/tbtables/fitsio/fttbit.f new file mode 100644 index 00000000..3733f100 --- /dev/null +++ b/pkg/tbtables/fitsio/fttbit.f @@ -0,0 +1,18 @@ +C---------------------------------------------------------------------- + subroutine fttbit(bitpix,status) + +C test that bitpix has a legal value + + integer bitpix,status + character value*20 + + if (status .gt. 0)return + + if (bitpix .ne. 8 .and. bitpix .ne. 16 .and. bitpix .ne. 32 + & .and. bitpix .ne. -32 .and. bitpix .ne. -64)then + status=211 + write(value,1000)bitpix +1000 format(i20) + call ftpmsg('Illegal BITPIX value: '//value) + end if + end diff --git a/pkg/tbtables/fitsio/fttdnn.f b/pkg/tbtables/fitsio/fttdnn.f new file mode 100644 index 00000000..287d32ea --- /dev/null +++ b/pkg/tbtables/fitsio/fttdnn.f @@ -0,0 +1,96 @@ +C---------------------------------------------------------------------- + logical function fttdnn(value) + +C test if a R*8 value has a IEEE Not-a-Number value +C A NaN has all the exponent bits=1, and the fractional part +C not=0. +C Exponent field is in bits 20-30 in the most significant 4-byte word +C Mantissa field is in bits 0-19 of most sig. word and entire 2nd word +C +C written by Wm Pence, HEASARC/GSFC, May 1992 +C modified Aug 1994 to handle all IEEE special values. + + integer value(2) + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer compid + common/ftcpid/compid +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer word1,word2 + +C COMPID specifies what type of floating point word structure +C is used on this machine, and determines how to test for NaNs. + +C COMPID value: +C 1 generic machine: simply test for NaNs with all bits set +C 2 like a decstation or alpha OSF/1, or IBM PC +C 3 SUN workstation, or IBM mainframe +C -2305843009213693952 Cray (64-bit) machine + + fttdnn=.false. + return + + if (compid .eq. 1)then +C on the VAX we can assume that all NaNs will be set to all bits on +C (which is equivalent to an integer with a value of -1) because +C this is what the IEEE to VAX conversion MACRO program returns + if (value(1) .eq. -1 .and. value(2) .eq. -1)fttdnn=.true. + + else if (compid .gt. 1)then + if (compid .ge. 3)then +C this is for SUN-like machines, or IBM main frames + word1=value(1) + word2=value(2) + else +C this is for DECstation and IBM PCs. The 2 32 bit integer words +C are reversed from what you get on the SUN. + word1=value(2) + word2=value(1) + end if + +C efficiently search the number space for NaNs and underflows + if (word2 .eq. -1)then + if ((word1 .ge. -1048577 .and. word1 .le. -1) + & .or. (word1 .ge. 2146435071))then + fttdnn=.true. + else if ((word1 .lt. -2146435072) .or. + & (word1 .ge. 0 .and. word1 .lt. 1048576))then + value(1)=0 + value(2)=0 + end if + else if (word2 .eq. 0)then + if ((word1 .gt. -1048577 .and. word1 .le. -1) + & .or. (word1 .gt. 2146435071))then + fttdnn=.true. + else if ((word1 .le. -2146435072) .or. + & (word1 .ge. 0 .and. word1 .le. 1048576))then + value(1)=0 + value(2)=0 + end if + else + if ((word1 .gt. -1048577 .and. word1 .le. -1) + & .or. (word1 .gt. 2146435071))then + fttdnn=.true. + else if ((word1 .lt. -2146435072) .or. + & (word1 .ge. 0 .and. word1 .lt. 1048576))then + value(1)=0 + value(2)=0 + end if + end if + else +C branch for the Cray: COMPID stores the negative integer +C which corresponds to the 3 most sig digits set to 1. If these +C 3 bits are set in a floating point number, then it represents +C a reserved value (i.e., a NaN) + if (value(1).lt. 0 .and. value(1) .ge. compid)fttdnn=.true. + end if + end diff --git a/pkg/tbtables/fitsio/fttkey.f b/pkg/tbtables/fitsio/fttkey.f new file mode 100644 index 00000000..048510df --- /dev/null +++ b/pkg/tbtables/fitsio/fttkey.f @@ -0,0 +1,50 @@ +C---------------------------------------------------------------------- + subroutine fttkey(keynam,status) + +C test that keyword name contains only legal characters: +C uppercase letters, numbers, hyphen, underscore, or space +C (but no embedded spaces) + +C keynam c*8 keyword name +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) + + character keynam*(*) + integer status,i + character*1 c1,pos + logical spaces + + if (status .gt. 0)return + + spaces=.false. + do 20 i=1,8 + c1=keynam(i:i) + if ((c1 .ge. 'A' .and. c1 .le. 'Z') .or. + & (c1 .ge. '0' .and. c1 .le. '9') .or. + & c1 .eq. '-' .or. c1 .eq. '_')then + if (spaces)then +C error: name contains embedded space + status=207 + call ftpmsg('Keyword name contains embedded '// + & 'space(s): '//keynam(1:8)) + return + end if + else if (c1 .eq. ' ')then + spaces=.true. + else +C illegal character found + status=207 + write(pos,1000)i +1000 format(i1) + call ftpmsg('Character '//pos//' in this keyword name' + & //' is illegal: "'//keynam(1:8)//'"') +C explicitly test for the 2 most common cases: + if (ichar(c1) .eq. 0)then + call ftpmsg('(This is an ASCII NUL (0) character).') + else if (ichar(c1) .eq. 9)then + call ftpmsg('(This is an ASCII TAB (9) character).') + end if + return + end if +20 continue + end diff --git a/pkg/tbtables/fitsio/fttkyn.f b/pkg/tbtables/fitsio/fttkyn.f new file mode 100644 index 00000000..967f6cbc --- /dev/null +++ b/pkg/tbtables/fitsio/fttkyn.f @@ -0,0 +1,65 @@ +C-------------------------------------------------------------------------- + subroutine fttkyn(iunit,nkey,keynam,keyval,status) + +C test that the keyword number NKEY has name = KEYNAM +C and has value = KEYVAL +C +C iunit i Fortran I/O unit number +C nkey i sequence number of the keyword to test +C keynam c name that the keyword is supposed to have +C keyval c value that the keyword is supposed to have +C OUTPUT PARAMETERS: +C status i returned error status (0=ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 +C + integer iunit,nkey,status + character*(*) keynam,keyval + character kname*8,value*30,comm*48,npos*8,keybuf*80 + character errmsg*80 + + if (status .gt. 0)return + +C read the name and value of the keyword + +C get the whole record + call ftgrec(iunit,nkey,keybuf,status) + + kname=keybuf(1:8) +C parse the value and comment fields from the record + call ftpsvc(keybuf,value,comm,status) + if (status .gt. 0)go to 900 + +C test if the keyword has the correct name + if (kname .ne. keynam)then + status=208 + go to 900 + end if + +C check that the keyword has the correct value + if (value .ne. keyval)then + status=209 + end if + +900 continue + if (status .gt. 0)then + + write(npos,1000)nkey +1000 format(i8) + errmsg='FTTKYN found unexpected keyword or value '// + & 'for header keyword number '//npos//'.' + call ftpmsg(errmsg) + errmsg=' Was expecting keyword '//keynam// + & ' with value = '//keyval + call ftpmsg(errmsg) + if (keybuf(9:10) .ne. '= ')then + errmsg=' but found keyword '//kname// + & ' with no "= " in cols. 9-10.' + else + errmsg=' but found keyword '//kname// + & ' with value = '//value + end if + call ftpmsg(errmsg) + call ftpmsg(keybuf) + end if + end diff --git a/pkg/tbtables/fitsio/fttnul.f b/pkg/tbtables/fitsio/fttnul.f new file mode 100644 index 00000000..a1fa6be9 --- /dev/null +++ b/pkg/tbtables/fitsio/fttnul.f @@ -0,0 +1,56 @@ +C-------------------------------------------------------------------------- + subroutine fttnul(ounit,colnum,inull,status) + +C Table column NULl value definition +C Define the null value for a table column +C +C ounit i Fortran I/O unit number +C colnum i number of the column to be defined +C inull i the value to be use to signify undefined data +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,inull,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + if (status .gt. 0)return + +C test for proper HDU type + if (hdutyp(ibuff) .eq. 0)then + status=235 + return + end if + + if (colnum .gt. tfield(ibuff) .or. colnum .lt. 1)then + status=302 + return + end if + + tnull(colnum+tstart(ibuff))=inull + end diff --git a/pkg/tbtables/fitsio/fttrec.f b/pkg/tbtables/fitsio/fttrec.f new file mode 100644 index 00000000..e7376891 --- /dev/null +++ b/pkg/tbtables/fitsio/fttrec.f @@ -0,0 +1,44 @@ +C---------------------------------------------------------------------- + subroutine fttrec(string,status) + +C test the remaining characters in a header record to insure that +C it contains only pri-ntable ASCII characters, +C i.e., with ASCII codes greater than or equal to 32 (a blank) +C Note: this will not detect the delete character (ASCII 127) +C because of the difficulties in also supporting this check +C on IBM mainframes, where the collating sequence is entirely +C different. + +C string c*72 keyword name +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) + +C optimized in 7/93 to compare "ichar(string(i:i)) .lt. space" +C rather than "(string(i:i)) .lt. ' ' " +C This is much faster on SUNs and DECstations, +C and decreases the time needed to write a keywor (ftprec) by 10%. +C This change made no difference on a VAX + + integer space +C The following line won't compile with the Lahey compiler on a PC +C parameter(space = ichar(' ')) + character string*(*) + integer status,i + character pos*2 + + if (status .gt. 0)return + space=ichar(' ') + + do 20 i=1,72 + if (ichar(string(i:i)) .lt. space)then +C illegal character found + status=207 + write(pos,1000)i +1000 format(i2) + call ftpmsg('Character #'//pos//' in this keyword value or '// + & 'comment string is illegal:') + call ftpmsg(string) + return + end if +20 continue + end diff --git a/pkg/tbtables/fitsio/fttrnn.f b/pkg/tbtables/fitsio/fttrnn.f new file mode 100644 index 00000000..56338a36 --- /dev/null +++ b/pkg/tbtables/fitsio/fttrnn.f @@ -0,0 +1,65 @@ +C---------------------------------------------------------------------- + logical function fttrnn(value) + +C test if a R*4 value has a IEEE Not-a-Number (NaN) value +C A NaN has all the exponent bits=1, and the fractional part not=0. +C The exponent field occupies bits 23-30, (least significant bit = 0) +C The mantissa field occupies bits 0-22 + +C This routine also sets any underflow values to zero. + +C written by Wm Pence, HEASARC/GSFC, May 1992 +C modified Aug 1994 to handle all IEEE special values. + + integer value + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer compid + common/ftcpid/compid +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + +C COMPID specifies what type of floating point word structure +C is used on this machine, and determines how to test for NaNs. + +C COMPID value: +C 1 VAX or generic machine: simply test for NaNs with all bits set +C 2 like a decstation or alpha OSF/1, or IBM PC +C 3 SUN workstation, or IBM mainframe +C -2305843009213693952 Cray (64-bit) machine + + fttrnn=.false. + return + + if (compid .eq. 1)then +C on the VAX we can assume that all NaNs will be set to all bits on +C (which is equivalent to an integer with a value of -1) because +C this is what the IEEE to VAX conversion MACRO program returns + if (value .eq. -1)fttrnn=.true. + else if (compid .gt. 1)then +C the following test works on all other machines (except Cray) +C the sign bit may be either 1 or 0 so have to test both possibilites. +C Note: overflows and infinities are also flagged as NaNs. + if (value .ge. 2139095039 .or. (value .lt. 0 .and. + 1 value .ge. -8388609))then + fttrnn=.true. + else if ((value .gt. 0 .and. value .le. 8388608) .or. + 1 value .le. -2139095040)then +C set underflows and denormalized values to zero + value=0 + end if + else +C branch for the Cray: COMPID stores the negative integer +C which corresponds to the 3 most sig digits set to 1. If these +C 3 bits are set in a floating point number, then it represents +C a reserved value (i.e., a NaN) + if (value .lt. 0 .and. value .ge. compid)fttrnn=.true. + end if + end diff --git a/pkg/tbtables/fitsio/fttscl.f b/pkg/tbtables/fitsio/fttscl.f new file mode 100644 index 00000000..8a12b43c --- /dev/null +++ b/pkg/tbtables/fitsio/fttscl.f @@ -0,0 +1,65 @@ +C-------------------------------------------------------------------------- + subroutine fttscl(ounit,colnum,bscale,bzero,status) + +C Table column SCaLing factor definition +C Define the scaling factor for a table column. +C +C ounit i Fortran I/O unit number +C colnum i number of the column to be defined +C bscale d scaling factor +C bzero d scaling zero point +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, June 1991 + + integer ounit,colnum,status + double precision bscale,bzero + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne,nf + parameter (nb = 20) + parameter (ne = 200) + parameter (nf = 3000) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff + + if (status .gt. 0)return + + if (bscale .eq. 0.)then +C illegal bscale value + status=322 + return + end if + + ibuff=bufnum(ounit) + +C if HDU structure is not defined then scan the header keywords + if (dtstrt(ibuff) .lt. 0)call ftrdef(ounit,status) + if (status .gt. 0)return + +C test for proper HDU type + if (hdutyp(ibuff) .eq. 0)then + status=235 + return + end if + + if (colnum .gt. tfield(ibuff) .or. colnum .lt. 1)then + status=302 + return + end if + + tscale(colnum+tstart(ibuff))=bscale + tzero(colnum+tstart(ibuff))=bzero + end diff --git a/pkg/tbtables/fitsio/ftucks.f b/pkg/tbtables/fitsio/ftucks.f new file mode 100644 index 00000000..71c3aba0 --- /dev/null +++ b/pkg/tbtables/fitsio/ftucks.f @@ -0,0 +1,124 @@ +C---------------------------------------------------------------------- + subroutine ftucks(iunit,status) + +C Update the CHECKSUM keyword value. This assumes that the DATASUM +C keyword exists and has the correct value. + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, May, 1995 + + integer iunit,status + +C-------COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nf,nb,ne + parameter (nf = 3000) + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld + integer tfield,tstart,tbcol,rowlen,tdtype,trept,tnull,scount + integer theap,nxheap + double precision tscale,tzero + common/ft0002/tfield(nb),tstart(nb),tbcol(nf),rowlen(nb), + & tdtype(nf),trept(nf),tscale(nf),tzero(nf),tnull(nf),scount(nb) + & ,theap(nb),nxheap(nb) +C-------END OF COMMON BLOCK DEFINITIONS----------------------------------- + + double precision sum,dsum + integer ibuff,nrec,dd,mm,yy,i,tstat + character datstr*8,string*16,comm*40,datsum*20,oldcks*16 + logical complm + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C get the DATASUM keyword value + call ftgkys(iunit,'DATASUM',datsum,comm,status) + if (status .eq. 202)then + call ftpmsg('DATASUM keyword not found (FTUCKS)') + return + end if + +C decode the datasum string into a double precision variable + do 10 i=1,20 + if (datsum(i:i) .ne. ' ')then + call ftc2dd(datsum(i:20),dsum,status) + go to 15 + end if +10 continue + dsum=0. + +C generate current date string to put into the keyword comment +15 call ftgsdt(dd,mm,yy,status) + if (status .gt. 0)return + + datstr=' / / ' + write(datstr(1:2),1001)dd + write(datstr(4:5),1001)mm + write(datstr(7:8),1001)yy +1001 format(i2) + +C replace blank with leading 0 in each field if required + if (datstr(1:1) .eq. ' ')datstr(1:1)='0' + if (datstr(4:4) .eq. ' ')datstr(4:4)='0' + if (datstr(7:7) .eq. ' ')datstr(7:7)='0' + +C get the CHECKSUM keyword value if it exists + tstat=status + call ftgkys(iunit,'CHECKSUM',oldcks,comm,status) + if (status .eq. 202)then + status=tstat + oldcks='0000000000000000' + comm='encoded HDU checksum updated on '//datstr + call ftpkys(iunit,'CHECKSUM','0000000000000000',comm,status) + end if + +C rewrite the header END card, and following blank fill + call ftwend(iunit,status) + if (status .gt. 0)return + +C move to the start of the header + call ftmbyt(iunit,hdstrt(ibuff,chdu(ibuff)),.true.,status) + +C accumulate the header checksum into the previous data checksum + nrec= (dtstrt(ibuff)-hdstrt(ibuff,chdu(ibuff)))/2880 + sum=dsum + call ftcsum(iunit,nrec,sum,status) + +C encode the COMPLEMENT of the checksum into a 16-character string + complm=.true. + call ftesum(sum,complm,string) + +C return if the checksum is correct + if (string .eq. '0000000000000000')return + + if (oldcks .eq. '0000000000000000')then +C update the CHECKSUM keyword value with the checksum string + call ftmkys(iunit,'CHECKSUM',string,'&',status) + else + +C Zero the checksum and compute the new value + comm='encoded HDU checksum updated on '//datstr + call ftmkys(iunit,'CHECKSUM','0000000000000000',comm,status) + +C move to the start of the header + call ftmbyt(iunit,hdstrt(ibuff,chdu(ibuff)),.true.,status) + +C accumulate the header checksum into the previous data checksum + sum=dsum + call ftcsum(iunit,nrec,sum,status) + +C encode the COMPLEMENT of the checksum into a 16-character string + complm=.true. + call ftesum(sum,complm,string) + +C update the CHECKSUM keyword value with the checksum string + call ftmkys(iunit,'CHECKSUM',string,'&',status) + end if + end diff --git a/pkg/tbtables/fitsio/ftucrd.f b/pkg/tbtables/fitsio/ftucrd.f new file mode 100644 index 00000000..5f525c42 --- /dev/null +++ b/pkg/tbtables/fitsio/ftucrd.f @@ -0,0 +1,28 @@ +C-------------------------------------------------------------------------- + subroutine ftucrd(ounit,keywrd,card,status) + +C update a 80-character FITS header card/record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C card c 80-character FITS card image +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, May 1995 + + character*(*) keywrd,card + integer ounit,status,tstat + + if (status .gt. 0)return + tstat=status + +C try modifying the card, if it exists + call ftmcrd(ounit,keywrd,card,status) + + if (status .eq. 202)then +C card doesn't exist, so create it + status=tstat + call ftprec(ounit,card,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukyd.f b/pkg/tbtables/fitsio/ftukyd.f new file mode 100644 index 00000000..b9a8558d --- /dev/null +++ b/pkg/tbtables/fitsio/ftukyd.f @@ -0,0 +1,31 @@ +C-------------------------------------------------------------------------- + subroutine ftukyd(ounit,keywrd,dval,decim,comm,status) + +C update a double precision value header record in E format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (max. 47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,comm + double precision dval + integer ounit,status,decim,tstat + + if (status .gt. 0)return + tstat=status + +C try modifying the keyword, if it exists + call ftmkyd(ounit,keywrd,dval,decim,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat + call ftpkyd(ounit,keywrd,dval,decim,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukye.f b/pkg/tbtables/fitsio/ftukye.f new file mode 100644 index 00000000..f2296597 --- /dev/null +++ b/pkg/tbtables/fitsio/ftukye.f @@ -0,0 +1,31 @@ +C-------------------------------------------------------------------------- + subroutine ftukye(ounit,keywrd,rval,decim,comm,status) + +C update a real*4 value header record in E format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,comm + real rval + integer ounit,status,decim,tstat + + if (status .gt. 0)return + tstat=status + +C try modifying the keyword, if it exists + call ftmkye(ounit,keywrd,rval,decim,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat + call ftpkye(ounit,keywrd,rval,decim,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukyf.f b/pkg/tbtables/fitsio/ftukyf.f new file mode 100644 index 00000000..ed9acf83 --- /dev/null +++ b/pkg/tbtables/fitsio/ftukyf.f @@ -0,0 +1,31 @@ +C-------------------------------------------------------------------------- + subroutine ftukyf(ounit,keywrd,rval,decim,comm,status) + +C update a real*4 value header record in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C rval r keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,comm + real rval + integer ounit,status,decim,tstat + + if (status .gt. 0)return + tstat=status + +C try modifying the keyword, if it exists + call ftmkyf(ounit,keywrd,rval,decim,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat + call ftpkyf(ounit,keywrd,rval,decim,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukyg.f b/pkg/tbtables/fitsio/ftukyg.f new file mode 100644 index 00000000..a0d01680 --- /dev/null +++ b/pkg/tbtables/fitsio/ftukyg.f @@ -0,0 +1,31 @@ +C-------------------------------------------------------------------------- + subroutine ftukyg(ounit,keywrd,dval,decim,comm,status) + +C update a double precision value header record in F format +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C dval d keyword value +C decim i number of decimal places to display in value field +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,comm + double precision dval + integer ounit,status,decim,tstat + + if (status .gt. 0)return + tstat=status + +C try modifying the keyword, if it exists + call ftmkyg(ounit,keywrd,dval,decim,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat + call ftpkyg(ounit,keywrd,dval,decim,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukyj.f b/pkg/tbtables/fitsio/ftukyj.f new file mode 100644 index 00000000..bf55fd93 --- /dev/null +++ b/pkg/tbtables/fitsio/ftukyj.f @@ -0,0 +1,29 @@ +C-------------------------------------------------------------------------- + subroutine ftukyj(ounit,keywrd,intval,comm,status) + +C update an integer value header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C intval i keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,comm + integer ounit,status,intval,tstat + + if (status .gt. 0)return + tstat=status + +C try modifying the keyword, if it exists + call ftmkyj(ounit,keywrd,intval,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat + call ftpkyj(ounit,keywrd,intval,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukyl.f b/pkg/tbtables/fitsio/ftukyl.f new file mode 100644 index 00000000..ce6bf3a6 --- /dev/null +++ b/pkg/tbtables/fitsio/ftukyl.f @@ -0,0 +1,30 @@ +C-------------------------------------------------------------------------- + subroutine ftukyl(ounit,keywrd,logval,comm,status) + +C update a logical value header record +C +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C logval l keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,comm + integer ounit,status,tstat + logical logval + + if (status .gt. 0)return + tstat=status + +C try modifying the keyword, if it exists + call ftmkyl(ounit,keywrd,logval,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat + call ftpkyl(ounit,keywrd,logval,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftukys.f b/pkg/tbtables/fitsio/ftukys.f new file mode 100644 index 00000000..6c070d1a --- /dev/null +++ b/pkg/tbtables/fitsio/ftukys.f @@ -0,0 +1,30 @@ +C-------------------------------------------------------------------------- + subroutine ftukys(ounit,keywrd,strval,comm,status) + +C update a character string value header record + +C ounit i fortran output unit number +C keywrd c keyword name ( 8 characters, cols. 1- 8) +C strval c keyword value +C comm c keyword comment (47 characters, cols. 34-80) +C OUTPUT PARAMETERS: +C status i output error status (0 = ok) +C +C written by Wm Pence, HEASARC/GSFC, Oct 1994 + + character*(*) keywrd,strval,comm + integer ounit,status,tstat + + if (status .gt. 0)return + + tstat=status +C try modifying the keyword, if it exists + call ftmkys(ounit,keywrd,strval,comm,status) + + if (status .eq. 202)then +C keyword doesn't exist, so create it + status=tstat +C note that this supports the HEASARC long-string conventions + call ftpkls(ounit,keywrd,strval,comm,status) + end if + end diff --git a/pkg/tbtables/fitsio/ftuscc.f b/pkg/tbtables/fitsio/ftuscc.f new file mode 100644 index 00000000..2a45abf4 --- /dev/null +++ b/pkg/tbtables/fitsio/ftuscc.f @@ -0,0 +1,32 @@ +C---------------------------------------------------------------------- + subroutine ftuscc(input,np,scaled,scale,zero,output) + +C unscale the array of complex numbers, prior to writing to the FITS file + +C input r array of complex numbers (pairs of real/imaginay numbers) +C np i total number of values to scale (no. of pairs times 2) +C scaled l is the data scaled? +C scale d scale factor +C zero d offset +C output r output array + + integer np,i,j + logical scaled + real input(np),output(np) + double precision scale,zero + + j=1 + if (scaled)then + do 10 i=1,np/2 + output(j)=(input(j)-zero)/scale + j=j+1 +C the imaginary part of the number is not offset!! + output(j)=input(j)/scale + j=j+1 +10 continue + else + do 20 i=1,np + output(i)=input(i) +20 continue + end if + end diff --git a/pkg/tbtables/fitsio/ftuscm.f b/pkg/tbtables/fitsio/ftuscm.f new file mode 100644 index 00000000..1d05cf49 --- /dev/null +++ b/pkg/tbtables/fitsio/ftuscm.f @@ -0,0 +1,32 @@ +C---------------------------------------------------------------------- + subroutine ftuscm(input,np,scaled,scale,zero,output) + +C unscale the array of complex numbers, prior to writing to the FITS file + +C input d array of complex numbers (pairs of real/imaginay numbers) +C np i total number of values to scale (no. of pairs times 2) +C scaled l is the data scaled? +C scale d scale factor +C zero d offset +C output d output array + + integer np,i,j + logical scaled + double precision input(np),output(np) + double precision scale,zero + + j=1 + if (scaled)then + do 10 i=1,np/2 + output(j)=(input(j)-zero)/scale + j=j+1 +C the imaginary part of the number is not offset!! + output(j)=input(j)/scale + j=j+1 +10 continue + else + do 20 i=1,np + output(i)=input(i) +20 continue + end if + end diff --git a/pkg/tbtables/fitsio/ftvcks.f b/pkg/tbtables/fitsio/ftvcks.f new file mode 100644 index 00000000..4b3a991b --- /dev/null +++ b/pkg/tbtables/fitsio/ftvcks.f @@ -0,0 +1,83 @@ +C---------------------------------------------------------------------- + subroutine ftvcks(iunit,dataok,hduok,status) + +C Verify the HDU by comparing the value of the computed checksums against +C the values of the DATASUM and CHECKSUM keywords if they are present. + +C iunit i fortran unit number +C dataok i output verification code for the data unit alone +C hduok i output verification code for the entire HDU +C the code values = 1 verification is correct +C = 0 checksum keyword is not present +C = -1 verification not correct +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Dec, 1994 + + integer iunit,dataok,hduok,status,tstat,i + double precision datsum,chksum,dsum + character keyval*20,comm*8 + logical cexist,dexist + + if (status .gt. 0)return + +C check if the CHECKSUM keyword exists + tstat=status + call ftgkys(iunit,'CHECKSUM',keyval,comm,status) + if (status .le. 0)then + cexist=.true. + else + hduok=0 + cexist=.false. + status=tstat + end if + +C check if the DATASUM keyword exists and get its value + call ftgkys(iunit,'DATASUM',keyval,comm,status) + if (status .le. 0)then + dexist=.true. + else + dataok=0 + dexist=.false. + status=tstat + end if + +C return if neither keyword exists + if (.not. cexist .and. .not. dexist)return + +C calculate the data checksum and the HDU checksum + call ftgcks(iunit,datsum,chksum,status) + if (status .gt. 0)return + + if (dexist)then + +C decode the datasum string into a double precision variable + do 10 i=1,20 + if (keyval(i:i) .ne. ' ')then + call ftc2dd(keyval(i:20),dsum,status) + if (status .eq. 409)then +C couldn't read the keyword; assume it is out of date + status=tstat + dsum=-1. + end if + go to 15 + end if +10 continue + dsum=0. +15 continue + + if (dsum .eq. datsum)then + dataok=1 + else + dataok=-1 + end if + end if + + if (cexist)then + if (chksum .eq. 0 .or. chksum .eq. 4.294967295D+09)then + hduok=1 + else + hduok=-1 + end if + end if + end diff --git a/pkg/tbtables/fitsio/ftvers.f b/pkg/tbtables/fitsio/ftvers.f new file mode 100644 index 00000000..acc430ab --- /dev/null +++ b/pkg/tbtables/fitsio/ftvers.f @@ -0,0 +1,72 @@ +C------------------------------------------------------------------------------ +C This software was prepared by High Energy Astrophysic Science Archive +C Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +C shall not, without prior written permission of the U.S. Government, +C establish a claim to statutory copyright. The Government and others acting +C on its behalf, shall have a royalty-free, non-exclusive, irrevocable, +C worldwide license for Government purposes to publish, distribute, +C translate, copy, exhibit, and perform such material. +C------------------------------------------------------------------------------ + subroutine ftvers(vernum) + +C Returns the current revision number of the FITSIO package. +C The revision number will be incremented whenever any modifications, +C bug fixes, or enhancements are made to the package + + real vernum +C version 4.06 18 Aug 1995 ftdelt bug; ftpmsg saves latest errors +C version 4.05 2 Aug 1995 another bug in ftfrcl in reseting tstart +C version 4.04 12 Jul 1995 bug in ftfrcl in resetting tstart +C version 4.03 3 Jul 1995 bug in restoring CHDU when moving to EOF +C version 4.02 20 Jun 1995 modified checksum algorithm +C version 4.01 30 May 1995 many changes +C version 3.711 30 Jan 1995 ftgphx was cutting BSCALE to 20 chars +C version 3.710 27 Jan 1995 fix ftgcnn, fitsmac; add ftirec, ftdrec +C version 3.700 29 Dec 1994 public release +C version 3.623 8 Nov 1994 ftgkys, ftgnst, checksum +C version 3.622 7 Nov 1994 ftgclj R*8 alignment; I*2 overflow fti4i2 +C version 3.621 4 Nov 1994 fixed endhd position in ftgrec +C version 3.62 2 Nov 1994 ftgcx[ijd] routines added +C version 3.612 31 Oct 1994 restored previous FTIBLK algorithm +C version 3.61 26 Oct 1994 ftirow and ftdrow to modify tables +C version 3.6 18 Oct 1994 ftukyX, range checking, new EOF checks +C version 3.512 20 Sep 1994 fixed writing header fill in FTWEND +C version 3.511 20 Sep 1994 removed '=' from CONTINUE on long strings +C version 3.51 14 Sep 1994 long string convention and IEEE support +C version 3.504 22 Aug 1994 fixed bug in ftcopy making files too big +C version 3.503 8 Aug 1994 fixed bug in ftcopy making files too big +C version 3.502 26 Jul 1994 explicitly write data fill bytes +C version 3.501 19 Jul 1994 minor changes for FTOOLS release +C version 3.500 29 Jun 1994 added error message stack +C version 3.415 07 Jun 1994 fixed ftmahd and ftgrec +C version 3.414 18 May 1994 modify ftmoff and ftpbyt for status 112 +C version 3.413 18 Mar 1994 Cray port added +C version 3.412 01 Mar 1994 SUN internal read problem in ftgthd +C version 3.411 25 Feb 1994 fixed 107 error when reading byte column +C version 3.410 21 Jan 1994 bug fixes in Alpha VMS version +C version 3.409 21 Dec 1993 long string bug; HP support +C version 3.408 09 Nov 1993 Alpha VMS open; ftgthd -; 210 status +C version 3.407 02 Nov 1993 initialize TABLEs with blanks; ftrdef +C version 3.406 26 Oct 1993 ftgtdm bug - last not initialized +C modified to read unknown extenstions +C version 3.405 21 Oct 1993 ftpini bug with GROUP format files +C version 3.404 7 Oct 1993 new TDIM subroutines, new error status +C version 3.403 1 Sept 1993 initialize strlen in ftpkys +C version 3.402 23 Aug 1993 bug in ftgcno +C version 3.401 20 Aug 1993 minor change to ftpi1b +C version 3.4 - 11 Aug 1993 +C version 3.31 - 2 Feb 1993 +C version 3.3 - 28 Oct 1992 +C version 3.21 - 8 July 1992 +C version 3.20 - 30 Mar 1992 +C version 3.10 - 4 Nov 1991 +C version 3.01 - 27 Sept 1991 +C version 3.00 - 12 Sept 1991 +C version 2.99 - 24 July 1991 +C version 2.0 - 1 May 1991 +C version 1.3 - 2 April 1991 +C version 1.22 - 22 March 1991 +C version 1.21 - 20 March 1991 + + vernum=4.06 + end diff --git a/pkg/tbtables/fitsio/ftwend.f b/pkg/tbtables/fitsio/ftwend.f new file mode 100644 index 00000000..7245a4ca --- /dev/null +++ b/pkg/tbtables/fitsio/ftwend.f @@ -0,0 +1,67 @@ +C---------------------------------------------------------------------- + subroutine ftwend(iunit,status) + +C write the END card, and following fill values in the CHDU + +C iunit i fortran unit number +C status i output error status +C +C written by Wm Pence, HEASARC/GSFC, Aug 1994 + + integer iunit,status + +C COMMON BLOCK DEFINITIONS:-------------------------------------------- + integer nb,ne + parameter (nb = 20) + parameter (ne = 200) + integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt + integer nxtfld + logical wrmode + common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), + & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld +C END OF COMMON BLOCK DEFINITIONS----------------------------------- + + integer ibuff,nblank,i,endpos + character*80 rec + + if (status .gt. 0)return + + ibuff=bufnum(iunit) + +C calc the data starting position if not currently defined + if (dtstrt(ibuff) .lt. 0)then + dtstrt(ibuff)=(hdend(ibuff)/2880 + 1)*2880 + end if + +C calculate the number of blank keyword slots in the header + endpos=hdend(ibuff) + nblank=(dtstrt(ibuff)-endpos)/80 +C move the i/o pointer to the end of the header keywords + call ftmbyt(iunit,endpos,.true.,status) + +C fill all the slots with blanks + rec=' ' + do 10 i=1,nblank + call ftpcbf(iunit,1,80,rec,status) +10 continue + +C The END keyword must either be placed +C immediately after the last keyword that was written +C (as indicated by the HDEND parameter), or must be in the +C first 80 bytes of the FITS record immediately preceeding +C the data unit, whichever is further in the file. +C The latter will occur if the user reserved room for more +C header keywords which have not (yet) been filled. + +C move pointer to where the END card should be + endpos=max(endpos,dtstrt(ibuff)-2880) + call ftmbyt(iunit,endpos,.true.,status) + +C write the END record to the output buffer: + rec='END' + call ftpcbf(iunit,1,80,rec,status) + + if (status .gt. 0)then + call ftpmsg('Error while writing END card (FTWEND).') + end if + end diff --git a/pkg/tbtables/fitsio/ftwldp.f b/pkg/tbtables/fitsio/ftwldp.f new file mode 100644 index 00000000..69f78137 --- /dev/null +++ b/pkg/tbtables/fitsio/ftwldp.f @@ -0,0 +1,289 @@ +C------------------------------------------------------------------------------ + subroutine ftwldp(xpix,ypix,xref,yref,xrefpix,yrefpix, + & xinc,yinc,rot,type,xpos,ypos,status) + +C Fortran version of worldpos.c -- WCS Algorithms from Classic AIPS +C Translated by James Kent Blackburn -- HEASARC/GSFC/NASA -- November 1994 +C routine to determine accurate position from pixel coordinates +C does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections +C returns 0 = good, +C 501 = angle too large for projection; +C Input: +C dbl xpix x pixel number (RA or long without rotation) +C dbl ypiy y pixel number (dec or lat without rotation) +C dbl xref x reference coordinate value (deg) +C dbl yref y reference coordinate value (deg) +C dbl xrefpix x reference pixel +C dbl yrefpix y reference pixel +C dbl xinc x coordinate increment (deg) +C dbl yinc y coordinate increment (deg) +C dbl rot rotation (deg) (from N through E) +C chr type projection type code e.g. "-SIN" +C Output: +C dbl xpos x (RA) coordinate (deg) +C dbl ypos y (dec) coordinate (deg) +C int status error status flag, zero + + integer status + double precision xpix,ypix,xref,yref,xrefpix,yrefpix + double precision xinc,yinc,rot,xpos,ypos + character*(*) type + integer error1,error4 + parameter (error1=501) + parameter (error4=504) + + double precision cosr,sinr,dx,dy,dz,temp + double precision sins,coss,dect,rat,dt,l,m,mg,da,dd,cos0,sin0 + double precision dec0,ra0,decout,raout + double precision geo1,geo2,geo3 + double precision cond2r + parameter (cond2r=1.745329252d-2) + double precision twopi,deps + parameter (twopi = 6.28318530717959) + parameter (deps = 1.0d-5) + integer i,itype + character*4 ctypes(8) + data ctypes/ '-SIN', '-TAN', '-ARC', '-NCP', + & '-GLS', '-MER', '-AIT', '-STG' / + + if (status .gt. 0) return +C *** Offset from ref pixel + dx = (xpix-xrefpix) * xinc + dy = (ypix-yrefpix) * yinc +C *** Take out rotation + cosr = dcos(rot*cond2r) + sinr = dsin(rot*cond2r) + if (rot .ne. 0.0) then + temp = dx * cosr - dy * sinr + dy = dy * cosr + dx * sinr + dx = temp + end if +C *** Find type of coordinate transformation (0 is linear) + itype = 0 + do 10 i = 1, 8 + if (ctypes(i) .eq. type) itype = i + 10 continue +C *** default, linear result for error return + xpos = xref + dx + ypos = yref + dy +C *** Convert to radians + ra0 = xref * cond2r + dec0 = yref * cond2r + l = dx * cond2r + m = dy * cond2r + sins = l*l + m*m + decout = 0.0 + raout = 0.0 + cos0 = dcos(dec0) + sin0 = dsin(dec0) +C *** Process by case + if (itype .eq. 0) then +C *** LINEAR + rat = ra0 + l + dect = dec0 + m + else if (itype .eq. 1) then +C *** SINE from '-SIN' type + if (sins .gt. 1.0) then + status = error1 + goto 30 + end if + coss = dsqrt(1.0 - sins) + dt = sin0 * coss + cos0 * m + if ((dt .gt. 1.0) .or. (dt .lt. -1.0)) then + status = error1 + goto 30 + end if + dect = dasin(dt) + rat = cos0 * coss - sin0 * m + if ((rat .eq. 0.0) .and. (l .eq. 0.0)) then + status = error1 + goto 30 + end if + rat = datan2 (l, rat) + ra0 + else if (itype .eq. 2) then +C *** TANGENT from '-TAN' type + if (sins .gt. 1.0) then + status = error1 + goto 30 + end if + dect = cos0 - m * sin0 + if (dect .eq. 0.0) then + status = error1 + goto 30 + end if + rat = ra0 + datan2(l, dect) + dect = datan(dcos(rat-ra0) * (m * cos0 + sin0) / dect) + else if (itype .eq. 3) then +C *** Arc from '-ARC' type + if (sins .ge. twopi * twopi / 4.0) then + status = error1 + goto 30 + end if + sins = dsqrt(sins) + coss = dcos(sins) + if (sins .ne. 0.0) then + sins = dsin(sins) / sins + else + sins = 1.0 + end if + dt = m * cos0 * sins + sin0 * coss + if ((dt .gt. 1.0) .or. (dt .lt. -1.0)) then + status = error1 + goto 30 + end if + dect = dasin(dt) + da = coss - dt * sin0 + dt = l * sins * cos0 + if ((da .eq. 0.0) .and. (dt .eq. 0.0)) then + status = error1 + goto 30 + end if + rat = ra0 + datan2(dt, da) + else if (itype .eq. 4) then +C *** North Celestial Pole from '-NCP' type + dect = cos0 - m * sin0 + if (dect .eq. 0.0) then + status = error1 + goto 30 + end if + rat = ra0 + datan2(l, dect) + dt = dcos(rat-ra0) + if (dt .eq. 0.0) then + status = error1 + goto 30 + end if + dect = dect / dt + if ((dect .gt. 1.0) .or. (dect .lt. -1.0)) then + status = error1 + goto 30 + end if + dect = dacos(dect) + if (dec0 .lt. 0.0) dect = -dect + else if (itype .eq. 5) then +C *** Global Sinusoid from '-GLS' type + dect = dec0 + m + if (dabs(dect) .gt. twopi/4.0) then + status = error1 + goto 30 + end if + coss = dcos(dect) + if (dabs(l) .gt. twopi*coss/2.0) then + status = error1 + goto 30 + end if + rat = ra0 + if (coss .gt. deps) rat = rat + l / coss + else if (itype .eq. 6) then +C *** Mercator from '-MER' type + dt = yinc * cosr + xinc * sinr + if (dt .eq. 0.0) dt = 1.0 + dy = (yref/2.0 + 45.0) * cond2r + dx = dy + dt / 2.0 * cond2r + dy = dlog(dtan(dy)) + dx = dlog(dtan(dx)) + geo2 = dt * cond2r / (dx - dy) + geo3 = geo2 * dy + geo1 = dcos(yref * cond2r) + if (geo1 .le. 0.0) geo1 = 1.0 + rat = l / geo1 + ra0 + if (dabs(rat - ra0) .gt. twopi) then + status = error1 + goto 30 + end if + dt = 0.0 + if (geo2 .ne. 0.0) dt = (m + geo3) / geo2 + dt = dexp(dt) + dect = 2.0 * datan(dt) - twopi / 4.0 + else if (itype .eq. 7) then +C *** Aitoff from '-AIT' type + dt = yinc * cosr + xinc * sinr + if (dt .eq. 0.0) dt = 1.0 + dt = dt * cond2r + dy = yref * cond2r + dx = dsin(dy+dt)/dsqrt((1.0+dcos(dy+dt))/2.0) - + & dsin(dy)/dsqrt((1.0+dcos(dy))/2.0) + if (dx .eq. 0.0) dx = 1.0 + geo2 = dt / dx + dt = xinc * cosr - yinc * sinr + if (dt .eq. 0.0) dt = 1.0 + dt = dt * cond2r + dx = 2.0 * dcos(dy) * dsin(dt/2.0) + if (dx .eq. 0.0) dx = 1.0 + geo1 = dt * dsqrt((1.0+dcos(dy)*dcos(dt/2.0))/2.0) / dx + geo3 = geo2 * dsin(dy) / dsqrt((1.0+dcos(dy))/2.0) + rat = ra0 + dect = dec0 + if ((l .eq. 0.0) .and. (m .eq. 0.0)) goto 20 + dz = 4.0-l*l/(4.0*geo1*geo1)-((m+geo3)/geo2)*((m+geo3)/geo2) + if ((dz .gt. 4.0) .or. (dz .lt. 2.0)) then + status = error1 + goto 30 + end if + dz = 0.5 * dsqrt(dz) + dd = (m+geo3) * dz / geo2 + if (dabs(dd) .gt. 1.0) then + status = error1 + goto 30 + end if + dd = dasin(dd) + if (dabs(dcos(dd)) .lt. deps) then + status = error1 + goto 30 + end if + da = l * dz / (2.0 * geo1 * dcos(dd)) + if (dabs(da) .gt. 1.0) then + status = error1 + goto 30 + end if + da = dasin(da) + rat = ra0 + 2.0 * da + dect = dd + else if (itype .eq. 8) then +C *** Stereographic from '-STG' type + dz = (4.0 - sins) / (4.0 + sins) + if (dabs(dz) .gt. 1.0) then + status = error1 + goto 30 + end if + dect = dz * sin0 + m * cos0 * (1.0+dz) / 2.0 + if (dabs(dect) .gt. 1.0) then + status = error1 + goto 30 + end if + dect = dasin(dect) + rat = dcos(dect) + if (dabs(rat) .lt. deps) then + status = error1 + goto 30 + end if + rat = l * (1.0+dz) / (2.0 * rat) + if (dabs(rat) .gt. 1.0) then + status = error1 + goto 30 + end if + rat = dasin(rat) + mg = 1.0 + dsin(dect)*sin0 + dcos(dect)*cos0*dcos(rat) + if (dabs(mg) .lt. deps) then + status = error1 + goto 30 + end if + mg = 2.0 * (dsin(dect)*cos0 - dcos(dect)*sin0*dcos(rat)) / mg + if (dabs(mg-m) .gt. deps) rat = twopi/2.0 - rat + rat = ra0 + rat + else +C *** Unsupported Projection + status = error4 + goto 30 + end if + 20 continue +C *** Return RA in range + raout = rat + decout = dect + if (raout-ra0 .gt. twopi/2.0) raout = raout - twopi + if (raout-ra0 .lt. -twopi/2.0) raout = raout + twopi + if (raout .lt. 0.0) raout = raout + twopi +C *** Correct units back to degrees + xpos = raout / cond2r + ypos = decout / cond2r + 30 continue + end diff --git a/pkg/tbtables/fitsio/ftxiou.f b/pkg/tbtables/fitsio/ftxiou.f new file mode 100644 index 00000000..f75a1808 --- /dev/null +++ b/pkg/tbtables/fitsio/ftxiou.f @@ -0,0 +1,37 @@ +C------------------------------------------------------------------------------ + subroutine ftxiou(iounit,status) + +C generic routine to manage logical unit numbers in the range 50-99 + + integer iounit,status,i + integer*2 array(50) + save array + data array/50*0/ + + if (iounit .eq. 0)then +C get an unused logical unit number + do 10 i=50,1,-1 + if (array(i) .eq. 0)then + array(i)=1 + iounit=i+49 + return + end if +10 continue +C error: all units are allocated + iounit=-1 + status=114 + call ftpmsg('FTGIOU has no more available unit numbers.') + + else if (iounit .eq. -1)then +C deallocate all the unit numbers + do 20 i=1,50 + array(i)=0 +20 continue + + else +C deallocat a specific unit number + if (iounit .ge. 50 .and. iounit .le. 99)then + array(iounit-49)=0 + end if + endif + end diff --git a/pkg/tbtables/fitsio/ftxmsg.f b/pkg/tbtables/fitsio/ftxmsg.f new file mode 100644 index 00000000..bd5b9006 --- /dev/null +++ b/pkg/tbtables/fitsio/ftxmsg.f @@ -0,0 +1,47 @@ +C------------------------------------------------------------------------------ + subroutine ftxmsg(action,text) + +C get, put, or clear the error message stack + + integer action + character*(*) text + + integer nbuff,i + parameter (nbuff=50) + character*80 txbuff(nbuff) + save txbuff + data txbuff/nbuff * ' '/ + + if (action .eq. -1)then + +C get error message from top of stack and shift the stack up one + text=txbuff(1) + do 10 i=1,nbuff-1 + txbuff(i) = txbuff(i+1) + 10 continue + txbuff(nbuff)=' ' + + else if (action .eq. 1)then + +C put error message onto stack. + do 20 i=1,nbuff + if (txbuff(i) .eq. ' ')then + txbuff(i)=text + return + end if +20 continue +C stack is full so discard oldest message + do 25 i=1,nbuff-1 + txbuff(i) = txbuff(i+1) +25 continue + txbuff(nbuff)=text + + else if (action .eq. 0)then + +C clear the error message stack + do 30 i=1,nbuff + txbuff(i) = ' ' +30 continue + + end if + end diff --git a/pkg/tbtables/fitsio/ftxypx.f b/pkg/tbtables/fitsio/ftxypx.f new file mode 100644 index 00000000..4a21e55f --- /dev/null +++ b/pkg/tbtables/fitsio/ftxypx.f @@ -0,0 +1,230 @@ +C------------------------------------------------------------------------------ + subroutine ftxypx(xpos,ypos,xref,yref,xrefpix,yrefpix, + & xinc,yinc,rot,type,xpix,ypix,status) + +C Fortran version of worldpos.c -- WCS Algorithms from Classic AIPS +C Translated by James Kent Blackburn -- HEASARC/GSFC/NASA -- November 1994 +C routine to determine accurate pixel coordinates from an RA and Dec +C does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections +C returns 0 = good, +C 501 = angle too large for projection; +C 502 = bad values +C 503 = ???undocumented error - looks like an underflow??? +C Input: +C dbl xpos x (RA) coordinate (deg) +C dbl ypos y (dec) coordinate (deg) +C dbl xref x reference coordinate value (deg) +C dbl yref y reference coordinate value (deg) +C dbl xrefpix x reference pixel +C dbl yrefpix y reference pixel +C dbl xinc x coordinate increment (deg) +C dbl yinc y coordinate increment (deg) +C dbl rot rotation (deg) (from N through E) +C chr type projection type code e.g. "-SIN" +C Output: +C dbl xpix x pixel number (RA or long without rotation) +C dbl ypiy y pixel number (dec or lat without rotation) +C int status error status flag, zero + + integer status + double precision xpos,ypos,xref,yref,xrefpix,yrefpix + double precision xinc,yinc,rot,xpix,ypix + character*(*) type + integer error1,error2,error3,error4 + parameter (error1=501) + parameter (error2=502) + parameter (error3=503) + parameter (error4=504) + double precision dx,dy,dz,r,ra0,dec0,ra,dec + double precision coss,sins,dt,da,dd,sint,oldxpos + double precision l,m,geo1,geo2,geo3,sinr,cosr + double precision cond2r + parameter (cond2r=1.745329252d-2) + double precision twopi,deps + parameter (twopi = 6.28318530717959) + parameter (deps = 1.0d-5) + integer i,itype + character*4 ctypes(8) + data ctypes/ '-SIN', '-TAN', '-ARC', '-NCP', + & '-GLS', '-MER', '-AIT', '-STG' / + + if (status .gt. 0) return +C *** 0 hour wrap around test + oldxpos = xpos + dt = (xpos - xref) + if (dt .gt. +180) xpos = xpos - 360 + if (dt .lt. -180) xpos = xpos + 360 +C *** Default values - Linear + dx = xpos - xref + dy = ypos - yref + dz = 0.0 +C *** Correct for rotation + r = rot * cond2r + cosr = dcos(r) + sinr = dsin(r) + dz = dx * cosr + dy * sinr + dy = dy * cosr - dx * sinr + dx = dz +C *** Check axis increments - bail out if either 0 + if ((xinc .eq. 0.0) .or. (yinc .eq. 0.0)) then + xpix = 0.0 + ypix = 0.0 + status = error2 + goto 30 + end if + xpix = dx / xinc + xrefpix + ypix = dy / yinc + yrefpix +C *** Find type of coordinate transformation (0 is linear) + itype = 0 + do 10 i = 1, 8 + if (ctypes(i) .eq. type) itype = i + 10 continue +C *** Done if linear + if (itype .eq. 0) goto 30 +C *** Non-Linear position + ra0 = xref * cond2r + dec0 = yref * cond2r + ra = xpos * cond2r + dec = ypos * cond2r +C *** Compute directional cosine + coss = dcos(dec) + sins = dsin(dec) + l = dsin(ra-ra0) * coss + sint = sins * dsin(dec0) + coss * dcos(dec0) * dcos(ra-ra0) +C *** Process by case + if (itype .eq. 1) then +C *** SINE from '-SIN' type + if (sint .lt. 0.0) then + status = error1 + goto 30 + end if + m = sins * dcos(dec0) - coss * dsin(dec0) * dcos(ra-ra0) + else if (itype .eq. 2) then +C *** TANGENT from '-TAN' type + if (sint .le. 0.0) then + status = error1 + goto 30 + end if + m = sins * dsin(dec0) + coss * dcos(dec0) * dcos(ra-ra0) + l = l / m + m = (sins*dcos(dec0) - coss*dsin(dec0)*dcos(ra-ra0)) / m + else if (itype .eq. 3) then +C *** Arc from '-ARC' type + m = sins*dsin(dec0) + coss*dcos(dec0)*dcos(ra-ra0) + if (m .lt. -1.0) m = -1.0 + if (m .gt. 1.0) m = 1.0 + m = dacos(m) + if (m .ne. 0) then + m = m / dsin(m) + else + m = 1.0 + end if + l = l * m + m = (sins*dcos(dec0) - coss*dsin(dec0)*dcos(ra-ra0)) * m + else if (itype .eq. 4) then +C *** North Celestial Pole from '-NCP' type + if (dec0 .eq. 0.0) then + status = error1 + goto 30 + else + m = (dcos(dec0) - coss * dcos(ra-ra0)) / dsin(dec0) + end if + else if (itype .eq. 5) then +C *** Global Sinusoid from '-GLS' type + dt = ra - ra0 + if (dabs(dec) .gt. twopi/4.0) then + status = error1 + goto 30 + end if + if (dabs(dec0) .gt. twopi/4.0) then + status = error1 + goto 30 + end if + m = dec - dec0 + l = dt * coss + else if (itype .eq. 6) then +C *** Mercator from '-MER' type + dt = yinc * cosr + xinc * sinr + if (dt .eq. 0.0) dt = 1.0 + dy = (yref/2.0 + 45.0) * cond2r + dx = dy + dt / 2.0 * cond2r + dy = dlog(dtan(dy)) + dx = dlog(dtan (dx)) + geo2 = dt * cond2r / (dx - dy) + geo3 = geo2 * dy + geo1 = cos (yref * cond2r) + if (geo1 .le. 0.0) geo1 = 1.0 + dt = ra - ra0 + l = geo1 * dt + dt = dec / 2.0 + twopi / 8.0 + dt = dtan(dt) + if (dt .lt. deps) then + status = error2 + goto 30 + end if + m = geo2 * dlog(dt) - geo3 + else if (itype .eq. 7) then +C *** Aitoff from '-AIT' type + l = 0.0 + m = 0.0 + da = (ra - ra0) / 2.0 + if (dabs(da) .gt. twopi/4.0) then + status = error1 + goto 30 + end if + dt = yinc * cosr + xinc * sinr + if (dt .eq. 0.0) dt = 1.0 + dt = dt * cond2r + dy = yref * cond2r + dx = dsin(dy+dt)/dsqrt((1.0+dcos(dy+dt))/2.0) - + & dsin(dy)/dsqrt((1.0+dcos(dy))/2.0) + if (dx .eq. 0.0) dx = 1.0 + geo2 = dt / dx + dt = xinc * cosr - yinc * sinr + if (dt .eq. 0.0) dt = 1.0 + dt = dt * cond2r + dx = 2.0 * dcos(dy) * dsin(dt/2.0) + if (dx .eq. 0.0) dx = 1.0 + geo1 = dt*dsqrt((1.0+dcos(dy)*dcos(dt/2.0))/2.0)/dx + geo3 = geo2 * dsin(dy) / dsqrt((1.0+dcos(dy))/2.0) + dt = dsqrt ((1.0 + dcos(dec) * dcos(da))/2.0) + if (dabs(dt) .lt. deps) then + status = error3 + goto 30 + end if + l = 2.0 * geo1 * dcos(dec) * dsin(da) / dt + m = geo2 * dsin(dec) / dt - geo3 + else if (itype .eq. 8) then +C *** Stereographic from '-STG' type + da = ra - ra0 + if (dabs(dec) .gt. twopi/4.0) then + status = error1 + goto 30 + end if + dd = 1.0 + sins*dsin(dec0) + coss*dcos(dec0)*dcos(da) + if (dabs(dd) .lt. deps) then + status = error1 + goto 30 + end if + dd = 2.0 / dd + l = l * dd + m = dd * (sins*dcos(dec0) - coss*dsin(dec0)*dcos(da)) + else +C *** Unsupported Projection + status = error4 + goto 30 + end if +C *** Convert back to degrees + dx = l / cond2r + dy = m / cond2r +C *** Correct for rotation + dz = dx * cosr + dy * sinr + dy = dy * cosr - dx * sinr + dx = dz +C *** Convert to PIXELS ... yeah! + xpix = dx / xinc + xrefpix + ypix = dy / yinc + yrefpix + 30 continue +C *** reset xpos to correct for in place modification + xpos = oldxpos + end diff --git a/pkg/tbtables/fitsio/mkpkg b/pkg/tbtables/fitsio/mkpkg new file mode 100644 index 00000000..cefd89a6 --- /dev/null +++ b/pkg/tbtables/fitsio/mkpkg @@ -0,0 +1,374 @@ +# FITSIO -- This IRAF mkpkg file updates the TBTABLES library to include +# the FITSIO interface. + +tbtables: +$checkout libtbtables.a ../ +$update libtbtables.a +$checkin libtbtables.a ../ +$exit + +libtbtables.a: + ftadef.f + ftaini.f + ftarch.f + ftas2c.f + ftasfm.f + ftbdef.f + ftbini.f + ftbnfm.f + ftc2as.f + ftc2d.f + ftc2dd.f + ftc2i.f + ftc2ii.f + ftc2l.f + ftc2ll.f + ftc2r.f + ftc2rr.f + ftc2s.f + ftc2x.f + ftcdel.f + ftcdfl.f + ftchdu.f + ftchfl.f + ftcins.f + ftclos.f + ftcmps.f + ftcmsg.f + ftcopy.f + ftcpdt.f + ftcrep.f + ftcrhd.f + ftcsum.f + ftd2e.f + ftd2f.f + ftdblk.f + ftdcol.f + ftddef.f + ftdelt.f + ftdhdu.f + ftdkey.f + ftdrec.f + ftdrow.f + ftdsum.f + ftdtyp.f + ftesum.f + ftfiou.f + ftfrcl.f + ftg2db.f + ftg2dd.f + ftg2de.f + ftg2di.f + ftg2dj.f + ftg3db.f + ftg3dd.f + ftg3de.f + ftg3di.f + ftg3dj.f + ftgabc.f + ftgacl.f + ftgatp.f + ftgbcl.f + ftgbit.f + ftgbnh.f + ftgbtp.f + ftgcfb.f + ftgcfc.f + ftgcfd.f + ftgcfe.f + ftgcfi.f + ftgcfj.f + ftgcfl.f + ftgcfm.f + ftgcfs.f + ftgcks.f + ftgcl.f + ftgclb.f + ftgclc.f + ftgcld.f + ftgcle.f + ftgcli.f + ftgclj.f + ftgclm.f + ftgcls.f + ftgcnn.f + ftgcno.f + ftgcrd.f + ftgcvb.f + ftgcvc.f + ftgcvd.f + ftgcve.f + ftgcvi.f + ftgcvj.f + ftgcvm.f + ftgcvs.f + ftgcx.f + ftgcxd.f + ftgcxi.f + ftgcxj.f + ftgdes.f + ftgerr.f + ftgext.f + ftggpb.f + ftggpd.f + ftggpe.f + ftggpi.f + ftggpj.f + ftghad.f + ftghbn.f + ftghdn.f + ftghpr.f + ftghps.f + ftghsp.f + ftghtb.f + ftgi1b.f + ftgics.f + ftgiou.f + ftgkey.f + ftgknd.f + ftgkne.f + ftgknj.f + ftgknl.f + ftgkns.f + ftgkyd.f + ftgkye.f + ftgkyj.f + ftgkyl.f + ftgkyn.f + ftgkys.f + ftgkyt.f + ftgmsg.f + ftgnst.f + ftgpfb.f + ftgpfd.f + ftgpfe.f + ftgpfi.f + ftgpfj.f + ftgphx.f + ftgprh.f + ftgpvb.f + ftgpvd.f + ftgpve.f + ftgpvi.f + ftgpvj.f + ftgrec.f + ftgsfb.f + ftgsfd.f + ftgsfe.f + ftgsfi.f + ftgsfj.f + ftgsvb.f + ftgsvd.f + ftgsve.f + ftgsvi.f + ftgsvj.f + ftgtbb.f + ftgtbc.f + ftgtbh.f + ftgtbn.f + ftgtbs.f + ftgtcl.f + ftgtcs.f + ftgtdm.f + ftgthd.f + ftgtkn.f + ftgttb.f + fthdef.f + fthpdn.f + fthpup.f + fti1i1.f + fti1i2.f + fti1i4.f + fti1r4.f + fti1r8.f + fti2c.f + fti2i1.f + fti2i2.f + fti2i4.f + fti2r4.f + fti2r8.f + fti4i1.f + fti4i2.f + fti4i4.f + fti4r4.f + fti4r8.f + ftibin.f + ftiblk.f + fticol.f + ftiimg.f + ftikyd.f + ftikye.f + ftikyf.f + ftikyg.f + ftikyj.f + ftikyl.f + ftikys.f + ftinit.f + ftirec.f + ftirow.f + ftitab.f + ftkeyn.f + ftkshf.f + ftl2c.f + ftmahd.f + ftmcom.f + ftmcrd.f + ftmkey.f + ftmkyd.f + ftmkye.f + ftmkyf.f + ftmkyg.f + ftmkyj.f + ftmkyl.f + ftmkys.f + ftmnam.f + ftmodr.f + ftmrec.f + ftmrhd.f + ftnkey.f + ftnulc.f + ftnulm.f + ftopen.f + ftp2db.f + ftp2dd.f + ftp2de.f + ftp2di.f + ftp2dj.f + ftp3db.f + ftp3dd.f + ftp3de.f + ftp3di.f + ftp3dj.f + ftpbit.f + ftpbnh.f + ftpcks.f + ftpclb.f + ftpclc.f + ftpcld.f + ftpcle.f + ftpcli.f + ftpclj.f + ftpcll.f + ftpclm.f + ftpcls.f + ftpclu.f + ftpclx.f + ftpcnb.f + ftpcnd.f + ftpcne.f + ftpcni.f + ftpcnj.f + ftpcom.f + ftpdat.f + ftpdef.f + ftpdes.f + ftpdfl.f + ftpgpb.f + ftpgpd.f + ftpgpe.f + ftpgpi.f + ftpgpj.f + ftphbn.f + ftphis.f + ftphpr.f + ftphtb.f + ftpi1b.f + ftpini.f + ftpkey.f + ftpkls.f + ftpknd.f + ftpkne.f + ftpknf.f + ftpkng.f + ftpknj.f + ftpknl.f + ftpkns.f + ftpkyd.f + ftpkye.f + ftpkyf.f + ftpkyg.f + ftpkyj.f + ftpkyl.f + ftpkys.f + ftpkyt.f + ftplsw.f + ftpmsg.f + ftpnul.f + ftppnb.f + ftppnd.f + ftppne.f + ftppni.f + ftppnj.f + ftpprb.f + ftpprd.f + ftppre.f + ftpprh.f + ftppri.f + ftpprj.f + ftppru.f + ftprec.f + ftprsv.f + ftpscl.f + ftpssb.f + ftpssd.f + ftpsse.f + ftpssi.f + ftpssj.f + ftpsvc.f + ftptbb.f + ftptbh.f + ftptbs.f + ftptdm.f + ftpthp.f + ftr2e.f + ftr2f.f + ftr4i1.f + ftr4i2.f + ftr4i4.f + ftr4r4.f + ftr4r8.f + ftr8i1.f + ftr8i2.f + ftr8i4.f + ftr8r4.f + ftr8r8.f + ftrdef.f + ftrhdu.f + ftrsnm.f + ftrwdn.f + ftrwup.f + fts2c.f + ftsdnn.f + ftsnul.f + ftsrnn.f + fttbit.f + fttdnn.f + fttkey.f + fttkyn.f + fttnul.f + fttrec.f + fttrnn.f + fttscl.f + ftucks.f + ftucrd.f + ftukyd.f + ftukye.f + ftukyf.f + ftukyg.f + ftukyj.f + ftukyl.f + ftukys.f + ftuscc.f + ftuscm.f + ftvcks.f + ftvers.f + ftwend.f + ftwldp.f + ftxiou.f + ftxmsg.f + ftxypx.f + @fitssppb +# @$(FITSIO_HOST_DEP) + @unix + fitsspp.x fitsspp.com + ; diff --git a/pkg/tbtables/fitsio/unix/README b/pkg/tbtables/fitsio/unix/README new file mode 100644 index 00000000..b3d8619b --- /dev/null +++ b/pkg/tbtables/fitsio/unix/README @@ -0,0 +1,15 @@ +# These routines are part of the FITSIO library and are designed to run in +# the IRAF/SPP environment. +#------------------------------------------------------------------------------ +# This software was prepared by High Energy Astrophysics Science Archive +# Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +# shall not, without prior written permission of the U.S. Government, +# establish a claim to statutory copyright. The Government and others acting +# on its behalf shall have a royalty-free, non-exclusive, irrevocable, +# worldwide license for Government purposes to publish, distribute, +# translate, copy, exhibit, and perform such material. +#------------------------------------------------------------------------------ +# +# The two files ftgcbf.x and ftpcbf.x were extracted from ../fitsspp.x +# into this directory because they are system dependent. There is +# another version in the ../vms/ directory which uses the %ref function. diff --git a/pkg/tbtables/fitsio/unix/ftgcbf.x b/pkg/tbtables/fitsio/unix/ftgcbf.x new file mode 100644 index 00000000..20cf860a --- /dev/null +++ b/pkg/tbtables/fitsio/unix/ftgcbf.x @@ -0,0 +1,17 @@ +# FTGCBF -- Read a sequence of characters from a file into the output +# character string buffer. The sequence may begin on any byte boundary and +# may be any number of bytes long. An error status is returned if less than +# the requested amount of data is read. + +procedure ftgcbf (iunit, convrt, nbytes, array, status) + +int iunit #I fortran unit number +int convrt #I convert to ASCII? (not used in SPP version) +int nbytes #I number of bytes to be transferred +% character*(*) array +int status #U output error status + +begin + # Get the data. Won't work on VAX. + call ftgbyt (iunit, nbytes, array, status) +end diff --git a/pkg/tbtables/fitsio/unix/ftpcbf.x b/pkg/tbtables/fitsio/unix/ftpcbf.x new file mode 100644 index 00000000..4f830011 --- /dev/null +++ b/pkg/tbtables/fitsio/unix/ftpcbf.x @@ -0,0 +1,20 @@ +# This is the non-VMS version. A character string variable is passed +# to an integer array argument. +# +# FTPCBF -- Write a sequence of characters to a file. + +# FTPCBF -- Write a sequence of characters to a file. The sequence may begin +# on any byte boundary and may be any number of bytes long. + +procedure ftpcbf (iunit, convrt, nbytes, array, status) + +int iunit #I fortran unit number +int convrt #I convert to ASCII? (not used in SPP version) +int nbytes #I number of bytes to be transferred +% character*(*) array +int status #U output error status + +begin + # Write the data. Won't work on a VAX. + call ftpbyt (iunit, nbytes, array, status) +end diff --git a/pkg/tbtables/fitsio/unix/mkpkg b/pkg/tbtables/fitsio/unix/mkpkg new file mode 100644 index 00000000..5a284614 --- /dev/null +++ b/pkg/tbtables/fitsio/unix/mkpkg @@ -0,0 +1,11 @@ +# FITSIO -- Update the system-dependent subroutines in the FITSIO library. + +$checkout libtbtables.a ../ +$update libtbtables.a +$checkin libtbtables.a ../ +$exit + +libtbtables.a: + ftpcbf.x + ftgcbf.x + ; diff --git a/pkg/tbtables/fitsio/vms/README b/pkg/tbtables/fitsio/vms/README new file mode 100644 index 00000000..8c54270f --- /dev/null +++ b/pkg/tbtables/fitsio/vms/README @@ -0,0 +1,15 @@ +# These routines are part of the FITSIO library and are designed to run in +# the IRAF/SPP environment. +#------------------------------------------------------------------------------ +# This software was prepared by High Energy Astrophysics Science Archive +# Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +# shall not, without prior written permission of the U.S. Government, +# establish a claim to statutory copyright. The Government and others acting +# on its behalf shall have a royalty-free, non-exclusive, irrevocable, +# worldwide license for Government purposes to publish, distribute, +# translate, copy, exhibit, and perform such material. +#------------------------------------------------------------------------------ +# +# The two files ftgcbf.x and ftpcbf.x were extracted from [-]fitsspp.x +# into this directory because they are system dependent. There is +# another version in the [-.unix] directory. diff --git a/pkg/tbtables/fitsio/vms/ftgcbf.x b/pkg/tbtables/fitsio/vms/ftgcbf.x new file mode 100644 index 00000000..709f5eb0 --- /dev/null +++ b/pkg/tbtables/fitsio/vms/ftgcbf.x @@ -0,0 +1,20 @@ +# This is the VMS version. A character string variable is passed +# to an integer array argument using %ref. +# +# FTGCBF -- Read a sequence of characters from a file into the output +# character string buffer. The sequence may begin on any byte boundary and +# may be any number of bytes long. An error status is returned if less than +# the requested amount of data is read. + +procedure ftgcbf (iunit, convrt, nbytes, array, status) + +int iunit #I fortran unit number +int convrt #I convert to ASCII? (not used in SPP version) +int nbytes #I number of bytes to be transferred +% character*(*) array +int status #U output error status + +begin + # Get the data. Note that we use %ref. + call ftgbyt (iunit, nbytes, %ref (array), status) +end diff --git a/pkg/tbtables/fitsio/vms/ftpcbf.x b/pkg/tbtables/fitsio/vms/ftpcbf.x new file mode 100644 index 00000000..bba325b2 --- /dev/null +++ b/pkg/tbtables/fitsio/vms/ftpcbf.x @@ -0,0 +1,18 @@ +# This is the VMS version. A character string variable is passed +# to an integer array argument using %ref. + +# FTPCBF -- Write a sequence of characters to a file. The sequence may begin +# on any byte boundary and may be any number of bytes long. + +procedure ftpcbf (iunit, convrt, nbytes, array, status) + +int iunit #I fortran unit number +int convrt #I convert to ASCII? (not used in SPP version) +int nbytes #I number of bytes to be transferred +% character*(*) array +int status #U output error status + +begin + # Write the data. Note that we use %ref. + call ftpbyt (iunit, nbytes, %ref (array), status) +end diff --git a/pkg/tbtables/fitsio/vms/mkpkg b/pkg/tbtables/fitsio/vms/mkpkg new file mode 100644 index 00000000..5a284614 --- /dev/null +++ b/pkg/tbtables/fitsio/vms/mkpkg @@ -0,0 +1,11 @@ +# FITSIO -- Update the system-dependent subroutines in the FITSIO library. + +$checkout libtbtables.a ../ +$update libtbtables.a +$checkin libtbtables.a ../ +$exit + +libtbtables.a: + ftpcbf.x + ftgcbf.x + ; diff --git a/pkg/tbtables/fitsio_spp.h b/pkg/tbtables/fitsio_spp.h new file mode 100644 index 00000000..d291863f --- /dev/null +++ b/pkg/tbtables/fitsio_spp.h @@ -0,0 +1,20 @@ +/* This header file is included only by tbfxff.c. + +There are three SPP FITSIO subroutines that have arrays of character strings +in their calling sequences. The subroutines are fsibin, fsicol, and fsphbn, +and they are called by tbfdef and tbfnew. The declared lengths of the +character strings must be the same in each of these subroutines, and the +macros for the declared lengths are defined in three separate header files. +These header files are: + + fitsio_spp.h (this file, for the SPP/C interface) + tblfits.h (used by tbfdef.x and tbfnew.x, and others) + fitsio/fitssppb/fitsio.h (used by the SPP FITSIO interface) + +The extra char for end-of-string is added transparently for SPP code, +and it is added explicitly in tbfxff.c. +*/ + +# define SZ_FTTYPE 70 /* length of column name string */ +# define SZ_FTFORM 70 /* len of col datatype and display fmt str */ +# define SZ_FTUNIT 70 /* length of column units string */ diff --git a/pkg/tbtables/mkpkg b/pkg/tbtables/mkpkg new file mode 100644 index 00000000..0bc2200c --- /dev/null +++ b/pkg/tbtables/mkpkg @@ -0,0 +1,250 @@ +# MKPKG file for the STSDAS TABLES I/O routines. +# Author: HODGE, 15-JUL-1987 +# Phil Hodge, 14-AUG-1987, add tbhad[] +# Phil Hodge, 11-SEP-1987, use relative location for object library +# Phil Hodge, 30-SEP-1987, add tbrcpy, tbrswp +# Phil Hodge, 28-DEC-1987, routines for different data types are +# combined into single files +# Phil Hodge, 16-Jun-1992, update for text tables +# Phil Hodge, 7-Jun-1994, include tbzd2t, tbzi2d, tbzi2t, tbzt2t. +# Phil Hodge, 2-Oct-1995, include fitsio. +# Phil Hodge, 26-Mar-1998, include tbcdes.x, tbfchp.x, tbs*.x; +# delete tbtszd.x, tbxwsk.x, tbytsz.x. +# Phil Hodge, 14-Apr-1998, delete tbcftg.x and tbcftp.x. +# Ellyne Kinney, 30-Sep-1998, added line for cfitsio. +# Phil Hodge, 18-Jan-1999, include tbfpri.x. +# Phil Hodge, 22-Mar-1999, include SPPFITSIO switch; +# add -Inolibc to XFLAGS for running mkpkg from this directory. +# Phil Hodge, 19-Apr-1999, add tbttyp. +# Phil Hodge, 7-Jun-1999, add tbzrds.x, tbzrdx.x and tbzsub.x. +# Phil Hodge, 5-Aug-1999, delete tbalen.x. +# Phil Hodge, 24-Sep-1999, add tbztyp.x. +# Phil Hodge, 23-Jun-2000, add tbcscal.x and tbfscal.x. +# Phil Hodge, 31-Aug-2000, add tbfhp_f.x to the section for SPPFITSIO, +# and move tbfhp.x to the non-SPPFITSIO section. +# Phil Hodge, 31-July-2001, move @cfitsio. + + + +update: + $checkout libtbtables.a lib$ + $update libtbtables.a + $checkin libtbtables.a lib$ + $purge lib$ + ; + + +libtbtables.a: + $set XFLAGS = "-Inolibc $(XFLAGS)" + + tbagt.x tbtables.h + tbapt.x tbtables.h + tbbadf.x + tbbaln.x tbtables.h tblerr.h + tbbcmt.x tbtables.h + tbbftp.x + tbbnll.x tbtables.h + tbbptf.x + tbbtyp.x tblerr.h + tbbwrd.x + tbcadd.x tbtables.h + tbcchg.x tbtables.h tblerr.h + tbcdef.x tbtables.h tblerr.h + tbcdef1.x + tbcdes.x tbtables.h + tbcfmt.x tbtables.h + tbcfnd.x tbtables.h + tbcfnd1.x + tbcftl.x tbtables.h + tbcgt.x tbtables.h tblerr.h + tbciga.x tbtables.h + tbcigi.x tbtables.h tblerr.h + tbcigt.x tbtables.h tblerr.h + tbcinf.x tbtables.h + tbcnam.x tbtables.h + tbcnit.x tbtables.h + tbcnum.x tbtables.h + tbcpt.x tbtables.h tblerr.h + tbcrcd.x tbtables.h tblerr.h + tbcscal.x tbtables.h + tbctpe.x tbtables.h + tbcwcd.x tbtables.h + tbdsav.x tbtables.h + tbegp.x tbtables.h + tbegt.x tbtables.h tblerr.h + tbeoff.x tbtables.h tblerr.h + tbepp.x tbtables.h + tbept.x tbtables.h tblerr.h + tbeszt.x tbtables.h + tbfag.x tbtables.h + tbfanp.x tbtables.h + tbfap.x tbtables.h + tbfcal.x tbtables.h + tbfchp.x tbtables.h + tbfckn.x tbtables.h + tbfclo.x tbtables.h + tbfdef.x tbtables.h tblfits.h + tbfdel.x tbtables.h + tbferr.x + tbffkw.x tbtables.h + tbffmt.x tbtables.h tblfits.h + tbffnd.x tbtables.h tblfits.h + tbfgcm.x tbtables.h + tbfgnp.x tbtables.h + tbfhdl.x tbtables.h + tbfhg.x tbtables.h + tbfiga.x tbtables.h + tbfopn.x tbtables.h tblfits.h + tbfnam.x tbtables.h tblfits.h + tbfnew.x tbtables.h tblfits.h + tbfnit.x tbtables.h tblfits.h + tbfnll.x tbtables.h + tbfpcm.x tbtables.h + tbfpnp.x tbtables.h + tbfpri.x + tbfptf.x + tbfrcd.x tbtables.h tblfits.h + tbfres.x + tbfrsi.x tbtables.h + tbfscal.x tbtables.h + tbfsiz.x tbtables.h + tbfsft.x tbtables.h + tbftya.x tbtables.h + tbftyb.x tbtables.h + tbfudf.x tbtables.h + tbfwcd.x tbtables.h + tbfwer.x tbtables.h tblfits.h + tbfwsi.x tbtables.h + tbhad.x tbtables.h tblerr.h + tbhanp.x tbtables.h + tbhcal.x tbtables.h tblerr.h + tbhckn.x tbtables.h + tbhdel.x tbtables.h tblerr.h + tbhfcm.x + tbhfkr.x tbtables.h + tbhfkw.x tbtables.h + tbhgcm.x tbtables.h + tbhgnp.x tbtables.h + tbhgt.x tblerr.h tbtables.h + tbhisc.x + tbhkeq.x + tbhpcm.x tbtables.h + tbhpnp.x tbtables.h tblerr.h + tbhpt.x tbtables.h tblerr.h + tbhrpr.x tbtables.h + tbhwpr.x tbtables.h + tbnopen.x + tbpset.x tbtables.h tblerr.h + tbpsta.x tbtables.h tblerr.h + tbrchg.x tbtables.h tblerr.h + tbrcmp.x tbtables.h + tbrcpy.x tbtables.h tblerr.h + tbrcsc.x tbtables.h tblerr.h + tbrdel.x tbtables.h tblerr.h + tbrgt.x tbtables.h tblerr.h + tbrnll.x tbtables.h tblerr.h + tbrpt.x tbtables.h tblerr.h + tbrsft.x tbtables.h tblerr.h + tbrswp.x tbtables.h tblerr.h + tbrudf.x tbtables.h tblerr.h + tbscol.x tbtables.h + tbsirow.x tbtables.h tblerr.h + tbsopn.x tbtables.h + tbsrow.x tbtables.h + tbswer.x tbtables.h tblerr.h + tbswer1.x tbtables.h + tbtacc.x + tbtbod.x tbtables.h + tbtchs.x tbtables.h tblerr.h + tbtclo.x tbtables.h tblerr.h + tbtcpy.x tbtables.h + tbtcre.x tbtables.h tblerr.h + tbtdel.x tbtables.h + tbtext.x tblerr.h + tbtflu.x tbtables.h tblerr.h + tbtfst.x tbtables.h tblerr.h + tbtnam.x tbtables.h + tbtopn.x tbtables.h tblerr.h + tbtopns.x tbtables.h tblerr.h + tbtren.x tbtables.h + tbtrsi.x tbtables.h tblerr.h + tbtscd.x tbtables.h + tbtscu.x tbtables.h + tbtsrt.x + tbttyp.x tbtables.h + tbtwer.x tbtables.h + tbtwsi.x tbtables.h + tbuopn.x tbtables.h tblerr.h + tbxag.x tbtables.h + tbxap.x tbtables.h tblerr.h + tbxcg.x tbtables.h tblerr.h + tbxcp.x tbtables.h tblerr.h + tbxncn.x tbtables.h + tbxnew.x tbtables.h + tbxnll.x tbtables.h + tbxoff.x tbtables.h + tbxrg.x tbtables.h tblerr.h + tbxrp.x tbtables.h tblerr.h + tbxscp.x tbtables.h + tbxsft.x tbtables.h + tbxsiz.x tbtables.h + tbxudf.x tbtables.h + tbxwnc.x tbtables.h + tbxwer.x tbtables.h + tbycg.x tbtables.h tblerr.h + tbycp.x tbtables.h tblerr.h + tbyncn.x tbtables.h + tbynew.x tbtables.h + tbynll.x tbtables.h + tbyoff.x tbtables.h + tbyrg.x tbtables.h tblerr.h + tbyrp.x tbtables.h tblerr.h + tbyscn.x tbtables.h + tbyscp.x tbtables.h + tbysft.x tbtables.h tblerr.h + tbysiz.x tbtables.h + tbyudf.x tbtables.h + tbywer.x tbtables.h + tbywnc.x tbtables.h + tbzadd.x tbtables.h + tbzcg.x tbtables.h + tbzclo.x tbtables.h + tbzcol.x tbtables.h + tbzcp.x tbtables.h + tbzd2t.x tbtables.h + tbzgt.x tbtables.h + tbzi2d.x tbtables.h + tbzi2t.x tbtables.h + tbzt2t.x tbtables.h + tbzkey.x tbtables.h tbltext.h + tbzlin.x tbltext.h + tbzmem.x tbtables.h + tbznew.x tbtables.h tbltext.h + tbznll.x tbtables.h tblerr.h + tbzopn.x tbtables.h tbltext.h + tbzpt.x tbtables.h + tbzrds.x tbtables.h tbltext.h + tbzrdx.x tbtables.h tbltext.h + tbzsft.x tbtables.h tblerr.h + tbzsiz.x tbtables.h + tbzsub.x tbtables.h tbltext.h + tbztyp.x tblerr.h + tbzudf.x tbtables.h tblerr.h + tbzwer.x tbtables.h + tbzwrt.x tbtables.h tbltext.h + tbparse.x + tbnparse.x + @selector + +# $ifdef (SPPFITSIO) + $echo "NOTE: SPP FITSIO will be used for FITS tables." + tbfhp_f.x tbtables.h tblfits.h + @fitsio +# $else +# $echo "NOTE: CFITSIO will be used for FITS tables." +# $echo "NOTE: CFITSIO does not support IRAF networking." +# tbfhp.x tbtables.h tblfits.h +# tbfxff.c "cfitsio/fitsio.h" fitsio_spp.h underscore.h +# @cfitsio +# $endif + ; diff --git a/pkg/tbtables/selector/generic/mkpkg b/pkg/tbtables/selector/generic/mkpkg new file mode 100644 index 00000000..eaa97971 --- /dev/null +++ b/pkg/tbtables/selector/generic/mkpkg @@ -0,0 +1,16 @@ +# Update the generic routines in selector + +default: + $checkout libtbtables.a ../../ + $update libtbtables.a + $checkin libtbtables.a ../../ +$exit + +libtbtables.a: + tcsrdaryb.x ../tcs.h + tcsrdaryc.x ../tcs.h + tcsrdaryd.x ../tcs.h + tcsrdaryi.x ../tcs.h + tcsrdaryr.x ../tcs.h + tcsrdarys.x ../tcs.h + ; diff --git a/pkg/tbtables/selector/generic/tcsrdaryb.x b/pkg/tbtables/selector/generic/tcsrdaryb.x new file mode 100644 index 00000000..b951ecf0 --- /dev/null +++ b/pkg/tbtables/selector/generic/tcsrdaryb.x @@ -0,0 +1,116 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +procedure tcs_rdaryb (tp, descrip, irow, maxbuf, nbuf, buffer) + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +bool buffer[ARB] # o: array of values +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +int tbagtb() + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + call tbegtb (tp, TCS_COLUMN(descrip), irow, buffer) + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + psize = tbagtb (tp, TCS_COLUMN(descrip), irow, + buffer[nbuf], off, psize) + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/generic/tcsrdaryc.x b/pkg/tbtables/selector/generic/tcsrdaryc.x new file mode 100644 index 00000000..33a2b610 --- /dev/null +++ b/pkg/tbtables/selector/generic/tcsrdaryc.x @@ -0,0 +1,117 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +procedure tcs_rdaryt (tp, descrip, irow, maxch, maxbuf, nbuf, buffer) + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +int maxch # i: max length of string +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +char buffer[maxch,ARB] # o: array of values +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +int tbagtt() + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + call tbegtt (tp, TCS_COLUMN(descrip), irow, buffer, maxch) + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + psize = tbagtt (tp, TCS_COLUMN(descrip), irow, + buffer[1,nbuf], maxch, off, psize) + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/generic/tcsrdaryd.x b/pkg/tbtables/selector/generic/tcsrdaryd.x new file mode 100644 index 00000000..de054a3b --- /dev/null +++ b/pkg/tbtables/selector/generic/tcsrdaryd.x @@ -0,0 +1,116 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +procedure tcs_rdaryd (tp, descrip, irow, maxbuf, nbuf, buffer) + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +double buffer[ARB] # o: array of values +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +int tbagtd() + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + call tbegtd (tp, TCS_COLUMN(descrip), irow, buffer) + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + psize = tbagtd (tp, TCS_COLUMN(descrip), irow, + buffer[nbuf], off, psize) + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/generic/tcsrdaryi.x b/pkg/tbtables/selector/generic/tcsrdaryi.x new file mode 100644 index 00000000..ee05ee36 --- /dev/null +++ b/pkg/tbtables/selector/generic/tcsrdaryi.x @@ -0,0 +1,116 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +procedure tcs_rdaryi (tp, descrip, irow, maxbuf, nbuf, buffer) + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +int buffer[ARB] # o: array of values +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +int tbagti() + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + call tbegti (tp, TCS_COLUMN(descrip), irow, buffer) + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + psize = tbagti (tp, TCS_COLUMN(descrip), irow, + buffer[nbuf], off, psize) + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/generic/tcsrdaryr.x b/pkg/tbtables/selector/generic/tcsrdaryr.x new file mode 100644 index 00000000..27a5ed13 --- /dev/null +++ b/pkg/tbtables/selector/generic/tcsrdaryr.x @@ -0,0 +1,116 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +procedure tcs_rdaryr (tp, descrip, irow, maxbuf, nbuf, buffer) + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +real buffer[ARB] # o: array of values +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +int tbagtr() + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + call tbegtr (tp, TCS_COLUMN(descrip), irow, buffer) + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + psize = tbagtr (tp, TCS_COLUMN(descrip), irow, + buffer[nbuf], off, psize) + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/generic/tcsrdarys.x b/pkg/tbtables/selector/generic/tcsrdarys.x new file mode 100644 index 00000000..1ae34565 --- /dev/null +++ b/pkg/tbtables/selector/generic/tcsrdarys.x @@ -0,0 +1,116 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +procedure tcs_rdarys (tp, descrip, irow, maxbuf, nbuf, buffer) + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +short buffer[ARB] # o: array of values +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +int tbagts() + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + call tbegts (tp, TCS_COLUMN(descrip), irow, buffer) + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + psize = tbagts (tp, TCS_COLUMN(descrip), irow, + buffer[nbuf], off, psize) + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/mkpkg b/pkg/tbtables/selector/mkpkg new file mode 100644 index 00000000..85a6b7ba --- /dev/null +++ b/pkg/tbtables/selector/mkpkg @@ -0,0 +1,50 @@ +# Update the selector library. +# Author: Bernie Simon, 18-Mar-96 +# +# Modified: 11/21/96, to be part of threed package (I.Busko) +# Modified: 103/17/97, added selrows function (I.Busko) +# Modified: 04/22/97, incorporated into sgraph package (W. Hack) +# 4 Dec 1997, added "$call generic" after "libtbtables.a" (Phil Hodge) +# 26 Mar 1998, added tbcga.x and tbcnel.x (Phil Hodge). + +$checkout libtbtables.a ../ +$update libtbtables.a +$checkin libtbtables.a ../ +$exit + +generic: + $ifnfile (generic/tcsrdaryi.x) + $generic -k -p generic/ -t bcsird tcsrdary.gx + $endif + $ifolder (generic/tcsrdaryi.x, tcsrdary.gx) + $generic -k -p generic/ -t bcsird tcsrdary.gx + $endif + ; + +libtbtables.a: + $call generic + @generic + omniread.x + rdselect.x + rst.x + selrows.x + tcsaddcol.x + tcsclose.x + tcscolumn.x "tcs.h" + tcsintinfo.x "tcs.h" + tcslinesize.x "tcs.h" + tcsopen.x "tcs.h" + tcsshape.x "tcs.h" + tcstotsize.x "tcs.h" + tcstxtinfo.x "tcs.h" + tbcga.x + tbcnel.x + trsclose.x "trs.h" + trseval.x "trs.h" + trsgencode.x "trs.h" + trsopen.x "trs.h" "trsopen.com" + trsrows.x "trs.h" + trstree.x "trs.h" + trstrim.x + whatfile.x "whatfile.h" + ; diff --git a/pkg/tbtables/selector/omniread.x b/pkg/tbtables/selector/omniread.x new file mode 100644 index 00000000..71615a89 --- /dev/null +++ b/pkg/tbtables/selector/omniread.x @@ -0,0 +1,625 @@ +include +include +include + +# OMNIREAD -- High level routine to read columns from image or table + +procedure omniread (file, dtype, data, nelem, ncol, maxcol) + +char file[ARB] # i: file name, including sections or selectors +int dtype # i: data type of data to be read +pointer data[ARB] # o: pointers to columns of output data +int nelem # o: length of output columns +int ncol # o: number of output columns +int maxcol # i: maximum number of columns +#-- +pointer sp, project + +errchk omniproject + +begin + # Allocate dummy projection array and set to zero, + # indicating projection should not be done + + call smark (sp) + call salloc (project, maxcol, TY_INT) + call aclri (Memi[project], maxcol) + + call omniproject (file, dtype, Memi[project], + data, nelem, ncol, maxcol) + + call sfree (sp) +end + +# OMNIPROJECT -- Read with optional projection of multi-dimensional columns + +procedure omniproject (file, dtype, project, data, nelem, ncol, maxcol) + +char file[ARB] # i: file name, including sections or selectors +int dtype # i: data type of data to be read +int project # i: axis to project multi-dimensional data on +pointer data[ARB] # o: pointers to columns of output data +int nelem # o: length of output columns +int ncol # o: number of output columns +int maxcol # i: maximum number of columns +#-- +string badtype "Unrecognized file type" + +int is_image() +errchk is_image, om_rdimage, om_rdtable, om_error + +begin + switch (is_image (file)) { + case YES: + if (maxcol > 0) { + ncol = 1 + call om_rdimage (file, dtype, project, data[1], nelem) + } else { + ncol = 0 + nelem = 0 + } + + case NO: + call om_rdtable (file, dtype, project, data, nelem, ncol, maxcol) + + default: + call om_error (file, badtype) + } + +end + +# -------------------------------------------------------------- +# The routines beyond this point are not in the public interface +# -------------------------------------------------------------- + +# OM_ERROR -- Error exit routine + +procedure om_error (file, message) + +char file[ARB] # i: file name +char message[ARB] # i: error message +#-- +pointer sp, text + +begin + call smark (sp) + call salloc (text, SZ_LINE, TY_CHAR) + + call sprintf (Memc[text], SZ_LINE, "%s (%s)\n") + call pargstr (message) + call pargstr (file) + + call error (1, Memc[text]) + + call sfree (sp) +end + +# OM_PROJIM -- Project a multi-dimensional image onto one dimension + +procedure om_projim (im, dtype, project, data, nelem) + +pointer im # i: image descriptor +int dtype # i: data type of data to be read +int project # i: axis to project multi-dimensional data on +pointer data # o: pointers to columns of output data +int nelem # o: length of output columns +#-- +int axis, nline +pointer sp, sum, vec, buf + +string badaxis "Cannot project data on axis" +string badtype "Unrecognized input datatype" + +double asumd() +int imgnld() +errchk om_error + +begin + # The projection is the average of the data along the + # non-included axes + + if (project <= 0 || project > IM_NDIM(im)) { + call om_error (IM_NAME(im), badaxis) + } + + # All calculations are done in double precision and then + # converted to the output type + + nelem = IM_LEN(im,project) + + call smark (sp) + call salloc (sum, nelem, TY_DOUBLE) + call salloc (vec, IM_MAXDIM, TY_LONG) + + call aclrd (Memd[sum], nelem) + call amovkl (long(1), Meml[vec], IM_MAXDIM) + + # Sum the data. In the general case, we read each line, + # get the index of the projected axis, compute the sum of + # that line and add the summed line to the indexed element + # of the sum. In the case where the projection is onto the + # first axis, we simply accumulate each line into the sum. + + if (project == 1) { + while (imgnld (im, buf, Meml[vec]) != EOF) + call aaddd (Memd[buf], Memd[sum], Memd[sum], nelem) + + } else { + axis = Meml[vec+project-1] + + while (imgnld (im, buf, Meml[vec]) != EOF) { + Memd[sum+axis-1] = Memd[sum+axis-1] + + asumd (Memd[buf], IM_LEN(im,1)) + axis = Meml[vec+project-1] + } + } + + # Divide sum by number of lines to get average + + nline = 1 + do axis = 1, IM_NDIM(im) { + if (axis != project) + nline = nline * IM_LEN(im,axis) + } + + call adivkd (Memd[sum], double(nline), Memd[sum], nelem) + + # Copy the result to an array of the proper data type + + call malloc (data, nelem, dtype) + + switch (dtype) { + case TY_SHORT: + call achtds (Memd[sum], Mems[data], nelem) + case TY_INT: + call achtdi (Memd[sum], Memi[data], nelem) + case TY_LONG: + call achtdl (Memd[sum], Meml[data], nelem) + case TY_REAL: + call achtdr (Memd[sum], Memr[data], nelem) + case TY_DOUBLE: + call amovd (Memd[sum], Memd[data], nelem) + default: + call om_error (IM_NAME(im), badtype) + } + + call sfree (sp) + +end + +# OM_PROJTAB -- Project a multidimensional array on a line + +procedure om_projtab (array, length, ndim, project, dtype, line) + +double array[ARB] # i: input array +int length[ARB] # i: array shape +int ndim # i: number of array dimensions +int project # i: axis to project onto +int dtype # i: datatype of output line +pointer line # o: output line +#-- +int linelen, elem, axis, idim +pointer sp, sum, nsum, vec + +string badtype "om_projtab: illegal datatype" + +begin + # Allocate temporary arrays for computing sums + + linelen = length[project] + + call smark (sp) + call salloc (sum, linelen, TY_DOUBLE) + call salloc (nsum, linelen, TY_INT) + call salloc (vec, ndim, TY_INT) + + # Initialize arrays + + call amovkd (double(0.0), Memd[sum], linelen) + call amovki (0, Memi[nsum], linelen) + call amovki (1, Memi[vec], ndim) + + elem = 1 + repeat { + # Determine which line element the array element is projected + # onto and add it to the sum + + axis = Memi[vec+project-1] + Memd[sum+axis-1] = Memd[sum+axis-1] + array[elem] + Memi[nsum+axis-1] = Memi[nsum+axis-1] + 1 + + # Increment array and line element + + elem = elem + 1 + for (idim = 1; idim <= ndim; idim = idim +1) { + Memi[vec+idim-1] = Memi[vec+idim-1] + 1 + if (Memi[vec+idim-1] > length[idim]) { + Memi[vec+idim-1] = 1 + } else { + break + } + } + + } until (idim > ndim) + + # Compute average + + do axis = 1, linelen { + if (Memi[nsum+axis-1] > 0) + Memd[sum+axis-1] = Memd[sum+axis-1] / Memi[nsum+axis-1] + } + + # Copy to output array of correct datatype + + switch (dtype) { + case TY_SHORT: + call achtds (Memd[sum], Mems[line], linelen) + case TY_INT: + call achtdi (Memd[sum], Memi[line], linelen) + case TY_LONG: + call achtdl (Memd[sum], Meml[line], linelen) + case TY_REAL: + call achtdr (Memd[sum], Memr[line], linelen) + case TY_DOUBLE: + call amovd (Memd[sum], Memd[line], linelen) + default: + call error (1, badtype) + } + + call sfree (sp) +end + +# OM_RDARRAY -- Read array data from a table + +procedure om_rdarray (tp, col, rcode, dtype, project, data, nelem, ncol) + +pointer tp # i: table descriptor +pointer col[ARB] # i: column selectors +pointer rcode # i: row selector +int dtype # i: data type of output columns +int project # i: axis to project multi-dimensional data on +pointer data[ARB] # o: pointers to output columns +int nelem # o: length of each output column +int ncol # i: number of columns +#-- +bool done +int irow, nrow, icol, coltype, osize, size, ndim +pointer sp, length, file, olddata + +string ambiguous "More than one row matches in file" +string badtype "Unrecognized input datatype" +string badsize "All arrays are not the same length" + +bool trseval() +int tbpsta(), tcs_totsize() +errchk trseval, om_error, tcs_rdarys, tcs_rdaryi, tcs_rdaryr, tcsrdaryd + +begin + # Allocate temporary arrays + + call smark (sp) + call salloc (length, IM_MAXDIM, TY_INT) + call salloc (file, SZ_PATHNAME, TY_CHAR) + + # Get table name for error messages + + call tbtnam (tp, Memc[file], SZ_PATHNAME) + + # Find the row which matches the row selector + # It is an error to have more than one row match + + done = false + nrow = tbpsta (tp, TBL_NROWS) + do irow = 1, nrow { + if (trseval (tp, irow, rcode)) { + if (done) + call om_error (Memc[file], ambiguous) + + done = true + do icol = 1, ncol { + # Determine which datatype is use to read the array + + if (project > 0) { + coltype = TY_DOUBLE + } else if (dtype == TY_LONG) { + coltype = TY_INT + } else { + coltype = dtype + } + + # Read the array from the table + + osize = tcs_totsize (col[icol]) + call malloc (data[icol], osize, coltype) + + switch (coltype) { + case TY_SHORT: + call tcs_rdarys (tp, col[icol], irow, osize, + size, Mems[data[icol]]) + case TY_INT, TY_LONG: + call tcs_rdaryi (tp, col[icol], irow, osize, + size, Memi[data[icol]]) + case TY_REAL: + call tcs_rdaryr (tp, col[icol], irow, osize, + size, Memr[data[icol]]) + case TY_DOUBLE: + call tcs_rdaryd (tp, col[icol], irow, osize, + size, Memd[data[icol]]) + default: + call om_error (Memc[file], badtype) + } + + + if (project > 0) { + # Project a multi-dimensional array onto + # a single dimension + + call tcs_shape (col[icol], Memi[length], + ndim, IM_MAXDIM) + + size = Memi[length+project-1] + + olddata = data[icol] + call malloc (data[icol], size, dtype) + + call om_projtab (Memd[olddata], Memi[length], ndim, + project, dtype, data[icol]) + + call mfree (olddata, TY_DOUBLE) + + } else if (dtype == TY_LONG) { + # Copy integer data to a long array + + olddata = data[icol] + call malloc (data[icol], size, dtype) + call achtil (Memi[olddata], Meml[data[icol]], size) + call mfree (olddata, TY_INT) + } + + # Check array lengths to make sure they are equal + + if (icol == 1) { + nelem = size + } else if (nelem != size) { + call om_error (Memc[file], badsize) + } + } + } + } + + call sfree (sp) +end + +# OM_RDIMAGE -- Read a line from an image + +procedure om_rdimage (file, dtype, project, data, nelem) + +char file[ARB] # i: file name, including sections or selectors +int dtype # i: data type of data to be read +int project # i: axis to project multi-dimensional data on +pointer data # o: pointers to columns of output data +int nelem # o: length of output columns +#-- +pointer im, buf + +string notline "Cannot read multi-dimensional data" +string badtype "Unrecognized input datatype" +string badaxis "Cannot project data on axis" + +pointer immap(), imgl1s(), imgl1i(), imgl1l(), imgl1r(), imgl1d() + +errchk immap, om_error, om_projim + +begin + data = NULL + nelem = 0 + + im = immap (file, READ_ONLY, NULL) + + if (project == 0 || IM_NDIM(im) == 1) { + # No projection, so check to see if the image is really + # one dimensional and read the line with the routine of + # the appropriate datatype + + if (IM_NDIM(im) > 1) + call om_error (file, notline) + + if (project > 1) + call om_error (file, badaxis) + + nelem = IM_LEN(im,1) + call malloc (data, nelem, dtype) + + switch (dtype) { + case TY_SHORT: + buf = imgl1s (im) + call amovs (Mems[buf], Mems[data], nelem) + case TY_INT: + buf = imgl1i (im) + call amovi (Memi[buf], Memi[data], nelem) + case TY_LONG: + buf = imgl1l (im) + call amovl (Meml[buf], Meml[data], nelem) + case TY_REAL: + buf = imgl1r (im) + call amovr (Memr[buf], Memr[data], nelem) + case TY_DOUBLE: + buf = imgl1d (im) + call amovd (Memd[buf], Memd[data], nelem) + default: + call om_error (file, badtype) + } + + } else { + call om_projim (im, dtype, project, data, nelem) + } + + call imunmap (im) +end + +# OM_RDSCALAR -- Read scalar data from a table + +procedure om_rdscalar (tp, col, rcode, dtype, data, nelem, ncol) + +pointer tp # i: table descriptor +pointer col[ARB] # i: column selectors +pointer rcode # i: row selector +int dtype # i: data type of output columns +pointer data[ARB] # o: pointers to output columns +int nelem # o: length of each output column +int ncol # i: number of columns +#-- +int irow, nrow, icol, ival +pointer sp, cp + +bool trseval() +int tbpsta() +pointer tcs_column() +errchk trseval, tbegts, tbegti, tbegtr, tbegtd + +begin + # Allocate arrays to read data and + # get column pointers from selectors + + nrow = tbpsta (tp, TBL_NROWS) + + call smark (sp) + call salloc (cp, ncol, TY_INT) + + do icol = 1, ncol { + Memi[cp+icol-1] = tcs_column (col[icol]) + call malloc (data[icol], nrow, dtype) + } + + # Look at each row and read values from rows where + # row selector expression is true. Use appropriate + # routine for the data type. + + nelem = 0 + do irow = 1, nrow { + if (trseval (tp, irow, rcode)) { + switch (dtype) { + case TY_SHORT: + do icol = 1, ncol + call tbegts (tp, Memi[cp+icol-1], irow, + Mems[data[icol]+nelem]) + case TY_INT: + do icol = 1, ncol + call tbegti (tp, Memi[cp+icol-1], irow, + Memi[data[icol]+nelem]) + case TY_LONG: + do icol = 1, ncol { + call tbegti (tp, Memi[cp+icol-1], irow, ival) + Memi[data[icol]+nelem] = ival + } + case TY_REAL: + do icol = 1, ncol + call tbegtr (tp, Memi[cp+icol-1], irow, + Memr[data[icol]+nelem]) + case TY_DOUBLE: + do icol = 1, ncol + call tbegtd (tp, Memi[cp+icol-1], irow, + Memd[data[icol]+nelem]) + } + + nelem = nelem + 1 + } + } + + # Reallocate memory to fit number of elements read + # Free memory if no elements were read + + do icol = 1, ncol { + if (nelem > 0) { + call realloc (data[icol], nelem, dtype) + } else { + call mfree (data[icol], dtype) + } + } + + call sfree (sp) +end + +# OM_RDTABLE -- Read data from table columns or arrays + +procedure om_rdtable (file, dtype, project, data, nelem, ncol, maxcol) + +char file[ARB] # i: file name, including sections or selectors +int dtype # i: data type of data to be read +int project # i: axis to project multi-dimensional data on +pointer data[ARB] # o: pointers to columns of output data +int nelem # o: length of output columns +int ncol # o: number of output columns +int maxcol # i: maximum number of columns +#-- +int nscalar, icol, length, ndim +pointer tp, sp, col, root, rowselect, colselect, rcode + +string nodata "Could not read data from file" +string norows "No rows read from file" +string mixtype "Cannot read both scalar and array columns" +string badaxis "Cannot project data on axis" + +pointer tbtopn(), trsopen() + +errchk rdselect, tbtopn, tcs_open, trsopen, om_error + +begin + # Break the table name into its various parts + + call smark (sp) + call salloc (col, maxcol, TY_INT) + call salloc (root, SZ_PATHNAME, TY_CHAR) + call salloc (rowselect, SZ_PATHNAME, TY_CHAR) + call salloc (colselect, SZ_PATHNAME, TY_CHAR) + + call rdselect (file, Memc[root], Memc[rowselect], + Memc[colselect], SZ_PATHNAME) + + # Open then table + + tp = tbtopn (Memc[root], READ_ONLY, NULL) + + # Check to see if we are dealing with scalar or array columns + # It is an error to mix scalar and array columns in one call. + + call tcs_open (tp, Memc[colselect], Memi[col], ncol, maxcol) + + if (ncol == 0) + call om_error (file, nodata) + + nscalar = 0 + do icol = 1, ncol { + call tcs_shape (Memi[col+icol-1], length, ndim, 1) + if (ndim == 0) + nscalar = nscalar + 1 + } + + # Process the row selector + + rcode = trsopen (tp, Memc[rowselect]) + + # Call the appropriate + if (nscalar == ncol) { + do icol = 1, ncol { + if (project > 1) + call om_error (file, badaxis) + } + + call om_rdscalar (tp, Memi[col], rcode, dtype, + data, nelem, ncol) + if (nelem == 0) + call om_error (file, norows) + + } else if (nscalar == 0) { + call om_rdarray (tp, Memi[col], rcode, dtype, + project, data, nelem, ncol) + + } else { + call om_error (file, mixtype) + } + + call trsclose (rcode) + call tcs_close (Memi[col], ncol) + call tbtclo (tp) +end diff --git a/pkg/tbtables/selector/rdselect.x b/pkg/tbtables/selector/rdselect.x new file mode 100644 index 00000000..22b25db5 --- /dev/null +++ b/pkg/tbtables/selector/rdselect.x @@ -0,0 +1,152 @@ +define MAXSECT 3 + +# RDSELECT -- Break a filename into root and selectors + +procedure rdselect (file, root, rowselect, colselect, maxch) + +char file[ARB] # i: filename +char root[ARB] # o: filename minus any selectors +char rowselect[ARB] # o: row selector +char colselect[ARB] # o: column selector +int maxch # i: max length of output strings +#-- +char colon +int ic, nc, isect, nsect, idtype +pointer sp, ident, extend, errmsg, bracket[MAXSECT] + +data colon / ':' / +string idlist "|row|column|" +string badtype "Unrecognized selector (%s)" + +bool nextbrak() +int stridx(), strdic() + +errchk nextbrak + +begin + call smark (sp) + call salloc (ident, SZ_FNAME, TY_CHAR) + call salloc (extend, SZ_FNAME, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Search for the first unescaped bracket + # Copy all chars prior to bracket into root + + for (ic = 1; file[ic] != EOS; ic = ic + 1) { + if (file[ic] == '\\' && file[ic+1] != EOS) { + ic = ic + 1 + } else if (file[ic] == '['){ + break + } + } + + nc = min (ic-1, maxch) + call strcpy (file, root, nc) + + # Get bracketed sections from file name + + for (isect = 1; isect <= MAXSECT; isect = isect + 1) { + + call salloc (bracket[isect], SZ_FNAME, TY_CHAR) + if (! nextbrak (file, ic, Memc[bracket[isect]], maxch)) + break + } + + nsect = isect - 1 + + rowselect[1] = EOS + colselect[1] = EOS + + # Use leading identifier to determine type of selector + + do isect = 1, nsect { + ic = stridx (colon, Memc[bracket[isect]]) + if (ic == 0) { + # Append bracketed sections with no identifier to the root + + call sprintf (Memc[extend], SZ_FNAME, "[%s]") + call pargstr (Memc[bracket[isect]]) + + call strcat (Memc[extend], root, maxch) + + } else if (ic > 0) { + call strcpy (Memc[bracket[isect]], Memc[ident], ic-1) + idtype = strdic (Memc[ident], Memc[ident], SZ_FNAME, idlist) + + if (idtype == 0) { + call sprintf (Memc[extend], SZ_FNAME, "[%s]") + call pargstr (Memc[bracket[isect]]) + + call strcat (Memc[extend], root, maxch) + + } else if (idtype == 1 && rowselect[1] == EOS) { + call strcpy (Memc[bracket[isect]+ic], rowselect, maxch) + + } else if (idtype == 2 && colselect[1] == EOS) { + call strcpy (Memc[bracket[isect]+ic], colselect, maxch) + + } else { + call sprintf (Memc[errmsg], SZ_LINE, badtype) + call pargstr (file) + + call error (1, Memc[errmsg]) + } + } + } + + call sfree (sp) +end + +# NEXTBRAK -- Get next bracketed section from file name + +bool procedure nextbrak (file, ic, section, maxch) + +char file[ARB] # i: file name +int ic # u: index to char within name +char section[ARB] # o: section extracted from name +int maxch # i: maximum length of section +#-- +int jc, level +pointer sp, errmsg + +string badsect "No closing bracket (%s)" + +begin + if (file[ic] != '[') { + section[1] = EOS + return (false) + } else { + level = 1 + ic = ic + 1 + } + + call smark (sp) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + jc = 1 + while (level > 0 && file[ic] != EOS) { + if (file[ic] == '[' && file[ic-1] != '\\') { + level = level + 1 + } else if (file[ic] == ']' && file[ic-1] != '\\') { + level = level - 1 + } + + if (level > 0 && jc <= maxch) { + section[jc] = file[ic] + jc = jc + 1 + } + + ic = ic + 1 + } + + section[jc] = EOS + + if (level > 0) { + call sprintf (Memc[errmsg], SZ_LINE, badsect) + call pargstr (file) + call error (1, Memc[errmsg]) + } + + call sfree (sp) + return (true) +end diff --git a/pkg/tbtables/selector/rst.x b/pkg/tbtables/selector/rst.x new file mode 100644 index 00000000..315c18df --- /dev/null +++ b/pkg/tbtables/selector/rst.x @@ -0,0 +1,1067 @@ +.help ----------------------------------------------------------------- +RST -- Functions used to manipulate row sets + +A row set is a structure used to represent some boolean condition over +the rows of a table. Rows for which the condition is true are included +in the set. The structure stores row numbers as an array of +ranges. The structure also contains the cumulative number of rows up +to the end of the range for each range in order to assist in searching +for the i-th row in the set. + +.nf +Create and destroy a row set + +set = rst_create (loval, hival) +set2 = rst_copy (set1) +call rst_free (set) + +Add or delete a row from the set + +call rst_addval (set, value) +call rst_delval (set, value) + +Update set to match insertion or deletions to table + +call rst_addtab (set, loval, nval) +call rst_deltab (set, loval, nval) + +Logical operations on a set + +set3 = rst_and (set1, set2) +set3 = rst_or (set1, set2) +set2 = rst_not (nrow, set1) + +Check to see if a row is in the set + +found = rst_inset (set, value) + +Get number of rows in the set + +count = rst_nelem (set) + +Retrieve the i-th row from the set + +row = rst_rownum (set, index) + +Make a string representation of a set + +call rst_show (set, str, maxch) + +.fi + +See the comments in the source for more information on the use of +these functions. Or ask Bernie Simon (bsimon@stsci.edu). + +.endhelp --------------------------------------------------------------- + +define LEN_RST 6 # length of row set structure +define LEN_TAIL 5 # length of tail structure + +define RST_LAST Memi[$1] # last element in row set +define RST_MAX Memi[$1+1] # max elements in row set +define RST_CURRENT Memi[$1+2] # current element in row set +define RST_LOARY Memi[$1+3] # array of low range ends +define RST_HIARY Memi[$1+4] # array of high range ends +define RST_NUMARY Memi[$1+5] # array of cumulative number of rows + +define RST_LOVAL Memi[RST_LOARY($1)+($2)-1] +define RST_HIVAL Memi[RST_HIARY($1)+($2)-1] +define RST_NROW Memi[RST_NUMARY($1)+($2)-1] + +# RST_ADDTAB -- Update set to reflect inserted rows in underlying table +# +# The important point is rows are inserted *after* loval and loval is +# not modified. All inserted rows are added to the set. Values after +# the range are increased by the number of values in the range. + +procedure rst_addtab (set, loval, nval) + +pointer set # i: row set +int loval # i: rows are inserted after this row +int nval # i: number of rows inserted +#-- +int idx, ndx, hival, range[2] +pointer tail + +int rst_findloc() +pointer rst_tail() + +begin + # Find range where new rows are inserted in the table + + idx = rst_findloc (set, loval + 1) + + # Handle the simple case where new rows are beyond rows already in set + + if (idx > RST_LAST(set)) { + call rst_addrange (set, loval + 1, loval + nval) + return + } + + # Check for union with existing range + + hival = loval + nval + + if (loval + 1 < RST_LOVAL(set,idx)) { + range[1] = loval + 1 + range[2] = hival + ndx = 0 + + } else { + range[1] = RST_LOVAL(set,idx) + range[2] = RST_HIVAL(set,idx) + nval + ndx = 1 + } + + # Save tail of set and truncate set + + tail = rst_tail (set, idx + ndx) + RST_LAST(set) = idx - 1 + + # Add range + + call rst_addrange (set, range[1], range[2]) + + # Add tail of set, shifting rows by number of inserted rows + + call rst_concat (set, tail, nval) + call rst_notail (tail) +end + +# RST_ADDVAL -- Add a value to a set +# +# Modify the set by adding a single row. The set is modified in place. +# If this function is called more than once in succession, it will be +# most efficient to order the values before adding them. + +procedure rst_addval (set, value) + +pointer set # i: row set +int value # i:value to add +#-- +int idx +pointer tail + +int rst_findloc() +pointer rst_tail() + +begin + # Find the location of the value in the set + + idx = rst_findloc (set, value) + + # Handle values past the end of the set as a special case + + if (idx > RST_LAST(set)) { + call rst_addrange (set, value, value) + return + } + + # Return if the value is already in the set + + if (value >= RST_LOVAL(set,idx)) + return + + # Save the tail of the current set and then truncate it + + tail = rst_tail (set, idx) + RST_LAST(set) = idx - 1 + + # Add value to the set + + call rst_addrange (set, value, value) + + # Restore the tail to the set + + call rst_concat (set, tail, 0) + call rst_notail (tail) + +end + +# RST_AND -- Intersection of two row sets +# +# Do a logical AND, or intersection, of two sets producing a third set. + +pointer procedure rst_and (set1, set2) + +pointer set1 # i: first row set +pointer set2 # i: second row set +#-- +int idx1, idx2, loval3, loval4, hival3, hival4 +pointer set3 + +pointer rst_create() + +begin + # Create output row set + + set3 = rst_create (0, 0) + + # Main loop: intersection of two sets + + idx1 = 1 + idx2 = 1 + loval3 = 0 + + while (idx1 <= RST_LAST(set1) && idx2 <= RST_LAST(set2)) { + + # If the output range is not set yet, set it + # Otherwise take the intesection of the input range + # with the input range that starts at the lower + # value. Add the intersection to the output set. + # When the output range is disjoint with both + # input ranges, discard it. + + if (loval3 == 0) { + if (RST_LOVAL(set1,idx1) <= RST_LOVAL(set2,idx2)) { + loval3 = RST_LOVAL(set1,idx1) + hival3 = RST_HIVAL(set1,idx1) + idx1 = idx1 + 1 + + } else { + loval3 = RST_LOVAL(set2,idx2) + hival3 = RST_HIVAL(set2,idx2) + idx2 = idx2 + 1 + } + + } else if (RST_LOVAL(set1,idx1) <= RST_LOVAL(set2,idx2)) { + if (RST_LOVAL(set1,idx1) <= hival3) { + loval4 = max (loval3, RST_LOVAL(set1,idx1)) + hival4 = min (hival3, RST_HIVAL(set1,idx1)) + + call rst_addrange (set3, loval4, hival4) + + if (RST_HIVAL(set1,idx1) <= hival3) { + idx1 = idx1 + 1 + } else { + loval3 = RST_LOVAL(set2,idx2) + hival3 = RST_HIVAL(set2,idx2) + idx2 = idx2 + 1 + } + + } else { + loval3 = 0 + } + + } else { + if (RST_LOVAL(set2,idx2) <= hival3) { + loval4 = max (loval3, RST_LOVAL(set2,idx2)) + hival4 = min (hival3, RST_HIVAL(set2,idx2)) + + call rst_addrange (set3, loval4, hival4) + + if (RST_HIVAL(set2,idx2) <= hival3) { + idx2 = idx2 + 1 + } else { + loval3 = RST_LOVAL(set1,idx1) + hival3 = RST_HIVAL(set1,idx1) + idx1 = idx1 + 1 + } + + } else { + loval3 = 0 + } + } + } + + # Take the intersection of the output range + # with the remaining input range + + while (idx1 <= RST_LAST(set1)) { + if (loval3 == 0 || RST_LOVAL(set1,idx1) > hival3) { + loval3 = 0 + break + } + + if (loval3 <= RST_HIVAL(set1,idx1)) { + loval4 = max (loval3, RST_LOVAL(set1,idx1)) + hival4 = min (hival3, RST_HIVAL(set1,idx1)) + call rst_addrange (set3, loval4, hival4) + } + + idx1 = idx1 + 1 + } + + while (idx2 <= RST_LAST(set2)) { + if (loval3 == 0 || RST_LOVAL(set2,idx2) > hival3) { + loval3 = 0 + break + } + + if (loval3 <= RST_HIVAL(set2,idx2)) { + loval4 = max (loval3, RST_LOVAL(set2,idx2)) + hival4 = min (hival3, RST_HIVAL(set2,idx2)) + call rst_addrange (set3, loval4, hival4) + } + + idx2 = idx2 + 1 + } + + return (set3) +end + +# RST_COPY -- Create a copy of an existing row set + +pointer procedure rst_copy (set1) + +pointer set1 # i: row set +#-- +int last, max +pointer set2 + +begin + call malloc (set2, LEN_RST, TY_INT) + + last = RST_LAST(set1) + max = RST_MAX(set1) + + call malloc (RST_LOARY(set2), max, TY_INT) + call malloc (RST_HIARY(set2), max, TY_INT) + call malloc (RST_NUMARY(set2), max, TY_INT) + + RST_LAST(set2) = last + RST_MAX(set2) = max + RST_CURRENT(set2) = 0 + + call amovi (RST_LOVAL(set1,1), RST_LOVAL(set2,1), last) + call amovi (RST_HIVAL(set1,1), RST_HIVAL(set2,1), last) + call amovi (RST_NROW(set1,1), RST_NROW(set2,1), last) + + return (set2) +end + +# RST_CREATE -- Create and initialize a new row set +# +# Create a new set containg a single range. To create an empty set, +# make the range (0,0). If the range limits are out of order, the +# procedure will swap them. + +pointer procedure rst_create (loval, hival) + +int loval # i: low end of range +int hival # i: high end of range +#-- +int temp +pointer set + +begin + call malloc (set, LEN_RST, TY_INT) + + call malloc (RST_LOARY(set), 1, TY_INT) + call malloc (RST_HIARY(set), 1, TY_INT) + call malloc (RST_NUMARY(set), 1, TY_INT) + + RST_MAX(set) = 1 + RST_CURRENT(set) = 0 + + if (loval > hival) { + temp = loval + loval = hival + hival = temp + } + + if (loval == 0) { + RST_LAST(set) = 0 + + } else { + RST_LAST(set) = 1 + RST_LOVAL(set,1) = loval + RST_HIVAL(set,1) = hival + RST_NROW(set,1) = hival - loval + 1 + } + + return (set) +end + +# RST_DELTAB -- Update set to reflect deleted rows in underlying table +# +# Update a set after rows have been deleted from the underlying table. +# All values within the deleted range are removed and values above the +# range are decreased by the number of rows in the range. + +procedure rst_deltab (set, loval, nval) + +pointer set # u: row set +int loval # i: first row deleted in underlying table +int nval # i: number of rows deleted in underlying table +#-- +int idx, jdx, ndx, hival, range[2,2] +pointer tail + +int rst_findloc() +pointer rst_tail() + +begin + # Find lower end of intersection of deleted rows with row set + + idx = rst_findloc (set, loval) + + if (idx > RST_LAST(set)) + return + + # If deleted rows intesect a range in the set, take the intersection + + ndx = 0 + if (loval > RST_LOVAL(set,idx)) { + ndx = 1 + range[1,1] = RST_LOVAL(set,idx) + range[2,1] = loval - 1 + } + + # Find the upper end of intersection of deleted rows with the row set + # hival is the first element past the deleted range + + hival = loval + nval + jdx = rst_findloc (set, hival) + + # If deleted rows intesect a range in the set, take the intersection + # Shift row numbers to account for deleted rows + + if (jdx <= RST_LAST(set)) { + if (hival > RST_LOVAL(set,jdx)) { + ndx = ndx + 1 + range[1,ndx] = hival - nval + range[2,ndx] = RST_HIVAL(set,jdx) - nval + jdx = jdx + 1 + } + } + + # Save the tail of the row set and truncate the set + + tail = rst_tail (set, jdx) + RST_LAST(set) = idx - 1 + + # Add the modified ranges to the table + + do jdx = 1, ndx + call rst_addrange (set, range[1,jdx], range[2,jdx]) + + # Add the ranges past the deleted range to the table, + # shifting row number to account for deleted rows + + call rst_concat (set, tail, - nval) + call rst_notail (tail) + +end + +# RST_DELVAL -- Delete a value from a set +# +# Remove a single value from the set. The set is updated in place. If +# this procedure is called several times, it is most effcient to order +# the values before deleting them. + +procedure rst_delval (set, value) + +pointer set # u: row set +int value # i:value to add +#-- +int idx, jdx, ndx, range[2,2] +pointer tail + +int rst_findloc() +pointer rst_tail() + +begin + # Find the location of the value in the set + + idx = rst_findloc (set, value) + + # Return if the value is not in the set + + if (idx < 1 || idx > RST_LAST(set)) + return + + if (value < RST_LOVAL(set,idx)) + return + + # Modify the range containing the element, + # which may split the range in two + + if (RST_LOVAL(set,idx) == RST_HIVAL(set, idx)) { + ndx = 0 + + } else if (value == RST_LOVAL(set,idx)) { + range[1,1] = value + 1 + range[2,1] = RST_HIVAL(set,idx) + ndx = 1 + + } else if (value == RST_HIVAL(set,idx)) { + range[1,1] = RST_LOVAL(set,idx) + range[2,1] = value - 1 + ndx = 1 + + } else { + range[1,1] = RST_LOVAL(set,idx) + range[2,1] = value - 1 + + range[1,2] = value + 1 + range[2,2] = RST_HIVAL(set,idx) + ndx = 2 + } + + # Save the tail of the current set and then truncate it + + tail = rst_tail (set, idx + 1) + RST_LAST(set) = idx - 1 + + # Add the modified ranges to the set + + do jdx = 1, ndx + call rst_addrange (set, range[1,jdx], range[2,jdx]) + + # Restore the tail to the set + + call rst_concat (set, tail, 0) + call rst_notail (tail) + +end + +# RST_FREE -- Free row set structure +# +# Release memory used by the row set + +procedure rst_free (set) + +pointer set # i: row set +#-- + +begin + call mfree (RST_NUMARY(set), TY_INT) + call mfree (RST_HIARY(set), TY_INT) + call mfree (RST_LOARY(set), TY_INT) + + call mfree (set, TY_INT) +end + +# RST_INSET -- Return true if value is in set + +bool procedure rst_inset (set, value) + +pointer set # i: row set +int value # i: value to be checked +#-- +bool result +int idx + +int rst_findloc() + +begin + idx = rst_findloc (set, value) + + if (idx > RST_LAST(set)) { + result = false + } else { + result = value >= RST_LOVAL(set,idx) + } + + return (result) +end + +# RST_NELEM -- Number of elements in a set + +int procedure rst_nelem (set) + +pointer set # i: row set +#-- +int nelem + +begin + if (RST_LAST(set) == 0) { + nelem = 0 + } else { + nelem = RST_NROW(set,RST_LAST(set)) + } + + return (nelem) +end + +# RST_NOT -- Complement of a row set +# +# Do a logical NOT, or complement of a set, producing a second set. +# the procedure requires the number of rows in the underlying table to +# know where to stop adding rows. This is the only procedure in this +# file where information about the underlying table is required. + +pointer procedure rst_not (nrow, set1) + +int nrow # i: largest possible value in set +pointer set1 # i: set to be negated +#-- +int idx1, loval2, hival2 +pointer set2 + +pointer rst_create() + +begin + set2 = rst_create (0,0) + + loval2 = 1 + do idx1 = 1, RST_LAST(set1) { + if (loval2 < RST_LOVAL(set1,idx1)) { + hival2 = RST_LOVAL(set1,idx1) - 1 + call rst_addrange (set2, loval2, hival2) + } + + loval2 = RST_HIVAL(set1,idx1) + 1 + } + + if (loval2 <= nrow) { + hival2 = nrow + call rst_addrange (set2, loval2, hival2) + } + + return (set2) +end + +# RST_OR -- Union of two row sets +# +# Do the logical OR, or union,of two sets, producing a third set. + +pointer procedure rst_or (set1, set2) + +pointer set1 # i: first row set +pointer set2 # i: second row set +#-- +int idx1, idx2, loval3, hival3 +pointer set3 + +pointer rst_create() + +begin + # Create output row set + + set3 = rst_create (0, 0) + + # Main loop: union of two sets + + idx1 = 1 + idx2 = 1 + loval3 = 0 + + while (idx1 <= RST_LAST(set1) && idx2 <= RST_LAST(set2)) { + + # Set the output range if not yet set, otherwise + # take the union of it with the set range that starts + # at the lowest value. If the output range is disjoint + # with the lower input range, add the output range to + # the output set and push back the input range + + if (loval3 == 0) { + if (RST_LOVAL(set1,idx1) <= RST_LOVAL(set2,idx2)) { + loval3 = RST_LOVAL(set1,idx1) + hival3 = RST_HIVAL(set1,idx1) + idx1 = idx1 + 1 + + } else { + loval3 = RST_LOVAL(set2,idx2) + hival3 = RST_HIVAL(set2,idx2) + idx2 = idx2 + 1 + } + + } else if (RST_LOVAL(set1,idx1) <= RST_LOVAL(set2,idx2)) { + if (RST_LOVAL(set1,idx1) <= hival3) { + loval3 = min (loval3, RST_LOVAL(set1,idx1)) + hival3 = max (hival3, RST_HIVAL(set1,idx1)) + idx1 = idx1 + 1 + + } else { + call rst_addrange (set3, loval3, hival3) + loval3 = 0 + } + + } else { + if (RST_LOVAL(set2,idx2) <= hival3) { + loval3 = min (loval3, RST_LOVAL(set2,idx2)) + hival3 = max (hival3, RST_HIVAL(set2,idx2)) + idx2 = idx2 + 1 + + } else { + call rst_addrange (set3, loval3, hival3) + loval3 = 0 + } + } + } + + # After comparison of two sets is finished, take union + # of output range with remaining input set. + + while (loval3 != 0 && idx1 <= RST_LAST(set1)) { + if (RST_LOVAL(set1,idx1) <= hival3) { + loval3 = min (loval3, RST_LOVAL(set1,idx1)) + hival3 = max (hival3, RST_HIVAL(set1,idx1)) + idx1 = idx1 + 1 + + } else { + call rst_addrange (set3, loval3, hival3) + loval3 = 0 + } + } + + while (loval3 != 0 && idx2 <= RST_LAST(set2)) { + if (RST_LOVAL(set2,idx2) <= hival3) { + loval3 = min (loval3, RST_LOVAL(set2,idx2)) + hival3 = max (hival3, RST_HIVAL(set2,idx2)) + idx2 = idx2 + 1 + + } else { + call rst_addrange (set3, loval3, hival3) + loval3 = 0 + } + } + + if (loval3 != 0) + call rst_addrange (set3, loval3, hival3) + + # When the two are disjoint, copy the remainder of the input set + # to the output set. + + while (idx1 <= RST_LAST(set1)) { + call rst_addrange(set3, RST_LOVAL(set1,idx1), RST_HIVAL(set1,idx1)) + idx1 = idx1 + 1 + } + + while (idx2 <= RST_LAST(set2)) { + call rst_addrange(set3, RST_LOVAL(set2,idx2), RST_HIVAL(set2,idx2)) + idx2 = idx2 + 1 + } + + return (set3) +end + +# RST_ROWNUM -- Convert an index into the set into a row number +# +# The row number is returned as the function value. If the index is not +# in the set, the row number is set to zero. The search method used is +# a compromise between sequential and binary search. The procedure uses +# the current row pointer as hint on where to locate the new row. + +int procedure rst_rownum (set, index) + +pointer set # i: row set +int index # i: index into the set +#-- +int inc, hi, lo, mid, irow + +begin + # Search for a bracket containing the element + # we are looking for + + if (RST_CURRENT(set) < 1 || RST_CURRENT(set) > RST_LAST(set)) { + # If range is undefined, set the bracket to the entire array + + lo = 0 + hi = RST_LAST(set) + 1 + + } else { + # Do we have the low end of the bracket or the high end? + + inc = 1 + if (index <= RST_NROW(set,RST_CURRENT(set))) { + # Have high end, search for low end + + hi = RST_CURRENT(set) + repeat { + lo = hi - inc + if (lo < 1) { + lo = 0 + break + } + + if (index > RST_NROW(set,lo)) + break + + hi = lo + inc = 2 * inc + } + + } else { + # Have low, end, search for high end + lo = RST_CURRENT(set) + repeat { + hi = lo + inc + if (hi > RST_LAST(set)) { + hi = RST_LAST(set) + 1 + break + } + + if (index <= RST_NROW(set,hi)) + break + + lo = hi + inc = 2 * inc + } + } + } + + # Now that we have a bracket, do a binary search + # to locate the range within the bracket + + while (hi > lo + 1) { + mid = (lo + hi) / 2 + if (index > RST_NROW(set,mid)) { + lo = mid + } else { + hi = mid + } + } + + # Find the row within the range + + if (hi < 1 || hi > RST_LAST(set)) { + irow = 0 + + } else { + irow = RST_HIVAL(set,hi) - (RST_NROW(set,hi) - index) + if (irow < 1) { + irow = 0 + hi = 0 + } + } + + RST_CURRENT(set) = hi + return (irow) +end + +# RST_SHOW -- Produce a string representation of the set +# +# Ranges are separated by commas and ranges with more than one value +# are represented by their endpoints separated by a colon. The notation +# is meant to match that used by trseval. + +procedure rst_show (set, str, maxch) + +pointer set # i: row set +char str[ARB] # o: string representation of set +int maxch # i: maximum length of string +#-- +int ic, idx +int itoc() + +begin + ic = 1 + do idx = 1, RST_LAST(set) { + ic = ic + itoc (RST_LOVAL(set,idx), str[ic], maxch-ic) + + if (RST_LOVAL(set,idx) != RST_HIVAL(set,idx)) { + str[ic] = ':' + ic = ic + 1 + + ic = ic + itoc (RST_HIVAL(set,idx), str[ic], maxch-ic) + } + + str[ic] = ',' + ic = ic + 1 + } + + if (ic > 1) + ic = ic - 1 + + str[ic] = EOS +end + +# ---------------------------------------------------------------------- +# Functions below this line are internal and not part of the public +# interface +# ---------------------------------------------------------------------- + +# RST_ADDRANGE -- Add a range at the end of a row set (low level) + +procedure rst_addrange (set, loval, hival) + +pointer set # u: row set +int loval # i: low end of range +int hival # i: high end of range +#-- +int last, nrow + +begin + + last = RST_LAST(set) + + if (last == 0) { + nrow = 0 + + } else { + nrow = RST_NROW(set,last) + + # Check for union with previous range + + if (RST_HIVAL(set,last) + 1 == loval) { + + RST_HIVAL(set,last) = hival + RST_NROW(set,last) = nrow + hival - loval + 1 + return + } + } + + # Increment number of values in arrays + + last = last + 1 + RST_LAST(set) = last + + # Allocate more space if arrays are full + + if (last > RST_MAX(set)) { + RST_MAX(set) = 2 * RST_MAX(set) + + call realloc (RST_LOARY(set), RST_MAX(set), TY_INT) + call realloc (RST_HIARY(set), RST_MAX(set), TY_INT) + call realloc (RST_NUMARY(set), RST_MAX(set), TY_INT) + } + + # Set array values + + RST_LOVAL(set,last) = loval + RST_HIVAL(set,last) = hival + RST_NROW(set,last) = nrow + hival - loval + 1 +end + +# RST_CONCAT -- Concatenate a tail structure onto a row set (low level) + +procedure rst_concat (set, tail, shift) + +pointer set # u: row set +pointer tail # i: tail structure +int shift # i: Amount to shift each value by +#-- +int idx + +begin + do idx = 1, RST_LAST(tail) + call rst_addrange (set, RST_LOVAL(tail,idx) + shift, + RST_HIVAL(tail,idx) + shift) + +end + +# RST_FINDLOC -- Find the location of an element within the set (low level) + +int procedure rst_findloc (set, value) + +pointer set # i: row set +int value # i: value whose location is sought +#-- +int inc, hi, lo, mid + +begin + # Search for a bracket containing the element + # we are looking for + + if (RST_CURRENT(set) < 1 || RST_CURRENT(set) > RST_LAST(set)) { + # If range is undefined, set the bracket to the entire array + + lo = 0 + hi = RST_LAST(set) + 1 + + } else { + # Do we have the low end of the bracket or the high end? + + inc = 1 + if (value <= RST_HIVAL(set,RST_CURRENT(set))) { + # Have high end, search for low end + + hi = RST_CURRENT(set) + repeat { + lo = hi - inc + if (lo < 1) { + lo = 0 + break + } + + if (value > RST_HIVAL(set,lo)) + break + + hi = lo + inc = 2 * inc + } + + } else { + # Have low, end, search for high end + lo = RST_CURRENT(set) + repeat { + hi = lo + inc + if (hi > RST_LAST(set)) { + hi = RST_LAST(set) + 1 + break + } + + if (value <= RST_HIVAL(set,hi)) + break + + lo = hi + inc = 2 * inc + } + } + } + + # Now that we have a bracket, do a binary search + # to locate the range within the bracket + + while (hi > lo + 1) { + mid = (lo + hi) / 2 + if (value > RST_HIVAL(set,mid)) { + lo = mid + } else { + hi = mid + } + } + + RST_CURRENT(set) = hi + return (hi) +end + +# RST_NOTAIL -- Free structure allocated to hold tail (low level) + +procedure rst_notail (tail) + +pointer tail # u: tail structure +#-- + +begin + if (RST_HIARY(tail) != NULL) + call mfree (RST_HIARY(tail), TY_INT) + + if (RST_LOARY(tail) != NULL) + call mfree (RST_LOARY(tail), TY_INT) + + call mfree (tail, TY_INT) +end + +# RST_TAIL -- Copy the tail of a row set into another structure (low level) + +pointer procedure rst_tail (set, idx) + +pointer set # i: row set +int idx # i: index of where copy starts +#-- +pointer tail + +begin + # Allocate and initialize structure + + call malloc (tail, LEN_TAIL, TY_INT) + + RST_LAST(tail) = max (RST_LAST(set) - idx + 1, 0) + RST_MAX(tail) = RST_LAST(tail) + RST_CURRENT(tail) = 0 + + if (RST_LAST(tail) == 0) { + # Tail is zero length, don't bother to allocate arrays + + RST_LOARY(tail) = NULL + RST_HIARY(tail) = NULL + + } else { + # Allocate memory for data arrays + + call malloc (RST_LOARY(tail), RST_LAST(tail), TY_INT) + call malloc (RST_HIARY(tail), RST_LAST(tail), TY_INT) + + # Copy data from old structure to data arrays + + call amovi (RST_LOVAL(set,idx), RST_LOVAL(tail,1), RST_LAST(tail)) + call amovi (RST_HIVAL(set,idx), RST_HIVAL(tail,1), RST_LAST(tail)) + } + + # Return + return (tail) +end diff --git a/pkg/tbtables/selector/selrows.x b/pkg/tbtables/selector/selrows.x new file mode 100644 index 00000000..2a82e9e7 --- /dev/null +++ b/pkg/tbtables/selector/selrows.x @@ -0,0 +1,30 @@ +#* HISTORY * +#* 17-Mar-97 I.Busko created +#* 15-Jan-97 B.Simon modified to call trsrows + +# SELROWS -- Count how many rows are selected by an expression + +int procedure selrows (tp, expr) + +pointer tp # i: table descriptor +char expr[ARB] # i: expression to be evaluated +#-- +int nrow +pointer set + +int rst_nelem() +pointer trsrows() +errchk trsrows + +begin + # Compute set of rows matching expression + + set = trsrows (tp, expr) + + # Count number of rows in set + + nrow = rst_nelem (set) + + call rst_free (set) + return (nrow) +end diff --git a/pkg/tbtables/selector/tbcga.x b/pkg/tbtables/selector/tbcga.x new file mode 100644 index 00000000..3076539e --- /dev/null +++ b/pkg/tbtables/selector/tbcga.x @@ -0,0 +1,110 @@ +include + +# tbcga[] -- get an array of elements +# This routine gets an array of values, all elements from all selected rows. +# The number of elements in one row may have been reduced by the use of an +# array section, however, in which case only elements in the section will +# be copied to output. +# +# The function value will be the actual number of elements returned +# in the output buffer. It is an error if the output buffer is not +# large enough to contain all of the values. +# +# Phil Hodge, 5-Mar-1998 Function created. +# Phil Hodge, 18-Jun-1998 Error check the subroutines. + +int procedure tbcgad (tp, cp, buffer, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +double buffer[ARB] # o: values read from table +int nelem # i: maximum number of elements to read +#-- +pointer descrip # column selector descriptor +int nrows # number of selected rows +int row # loop index for selected row number +int nvals # number of elements in one cell +int nret # number returned, should be the same as nvals +int i +int tbagtd() +errchk tbagtd(), tbegtd(), tcs_rdaryd() + +begin + # Get descrip, nvals, and nrows. + call tbcnel1 (tp, cp, descrip, nvals, nrows) + + # Set nret because tbegtd doesn't return it. + if (nvals == 1) + nret = 1 + + if (nvals * nrows > nelem) + call error (1, "tbcgad: output buffer is too small") + + i = 1 + do row = 1, nrows { + + if (descrip == NULL) { + if (nvals == 1) + call tbegtd (tp, cp, row, buffer[i]) + else + nret = tbagtd (tp, cp, row, buffer[i], 1, nvals) + } else { + call tcs_rdaryd (tp, descrip, row, nelem-i+1, nret, buffer[i]) + } + + if (nret != nvals) + call error (1, "tbcgad: not all elements read from column") + + i = i + nvals + } + + return (i - 1) +end + +int procedure tbcgar (tp, cp, buffer, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +real buffer[ARB] # o: values read from table +int nelem # i: maximum number of elements to read +#-- +pointer descrip # column selector descriptor +int nrows # number of selected rows +int row # loop index for selected row number +int nvals # number of elements in one cell +int nret # number returned, should be the same as nvals +int i +int tbagtr() +errchk tbagtr(), tbegtr(), tcs_rdaryr() + +begin + # Get descrip, nvals, and nrows. + call tbcnel1 (tp, cp, descrip, nvals, nrows) + + # Set nret because tbegtd doesn't return it. + if (nvals == 1) + nret = 1 + + if (nvals * nrows > nelem) + call error (1, "tbcgar: output buffer is too small") + + i = 1 + do row = 1, nrows { + + if (descrip == NULL) { + if (nvals == 1) + call tbegtr (tp, cp, row, buffer[i]) + else + nret = tbagtr (tp, cp, row, buffer[i], 1, nvals) + } else { + call tcs_rdaryr (tp, descrip, row, nelem-i+1, nret, buffer[i]) + } + + if (nret != nvals) + call error (1, "tbcgar: not all elements read from column") + + i = i + nvals + } + + return (i - 1) +end diff --git a/pkg/tbtables/selector/tbcnel.x b/pkg/tbtables/selector/tbcnel.x new file mode 100644 index 00000000..9173a1ff --- /dev/null +++ b/pkg/tbtables/selector/tbcnel.x @@ -0,0 +1,52 @@ +include + +# This file contains tbcnel and tbcnel1. + +# tbcnel -- get the total number of elements for a column +# This function multiplies the number of selected rows by the number of +# elements in one row, for the specified column. The column may contain +# scalars or arrays. +# +# If the column was listed in a column selector string, and if this +# included an array section, the number of elements for one row will be +# the number in the array section. +# +# Phil Hodge, 5-Mar-1998 Function created. + +int procedure tbcnel (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +pointer descrip # column selector descriptor (ignored) +int nrows # number of selected rows +int nelem # number of elements in one cell + +begin + call tbcnel1 (tp, cp, descrip, nelem, nrows) + + return (nrows * nelem) +end + +procedure tbcnel1 (tp, cp, descrip, nelem, nrows) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +pointer descrip # o: column selector descriptor +int nelem # o: number of elements in one cell +int nrows # o: number of selected rows +#-- +pointer tbcdes() +int tcs_totsize() +int tbpsta(), tbalen() + +begin + descrip = tbcdes (tp, cp) + + if (descrip == NULL) + nelem = tbalen (cp) # cp is not a selected column + else + nelem = tcs_totsize (descrip) + + nrows = tbpsta (tp, TBL_NROWS) # number of selected rows +end diff --git a/pkg/tbtables/selector/tcs.h b/pkg/tbtables/selector/tcs.h new file mode 100644 index 00000000..884cf716 --- /dev/null +++ b/pkg/tbtables/selector/tcs.h @@ -0,0 +1,12 @@ +# TCS.H --Descriptor for a table column array selector + +define MAXDIM 7 # max dimensions in table array + +define TCS_COLUMN Memi[$1] # table column pointer +define TCS_DIMEN Memi[$1+1] # dimensionality of array, + # zero for scalars +define TCS_FIRST Memi[3*($2)+$1-1] # first value in array +define TCS_LAST Memi[3*($2)+$1] # last value in array +define TCS_INC Memi[3*($2)+$1+1] # increment between values + +define TCS_LENGTH (3*($1)+2) diff --git a/pkg/tbtables/selector/tcsaddcol.x b/pkg/tbtables/selector/tcsaddcol.x new file mode 100644 index 00000000..c17f2cb9 --- /dev/null +++ b/pkg/tbtables/selector/tcsaddcol.x @@ -0,0 +1,26 @@ +# TCS_ADDCOL -- Add a single column to the list of descriptors + +procedure tcs_addcol (tp, cp, descrip, ndescrip, maxdescrip) + +pointer tp # i: table descriptor +pointer cp # i: column descriptor +pointer descrip[ARB] # u: list of column array selectors +int ndescrip # u: number of column array selectors +int maxdescrip # i: length of descrip array +#-- +string toomany "Overflow in descriptor array" + +begin + # Check for descriptor array overflow + + if (ndescrip >= maxdescrip) + call error (1, toomany) + + # Convert the column pointer to a table column descriptor + # Function tcs_fillstruct can be found in tcs_open + + ndescrip = ndescrip + 1 + call tcs_fillstruct (tp, cp, "", descrip[ndescrip]) + +end + diff --git a/pkg/tbtables/selector/tcsclose.x b/pkg/tbtables/selector/tcsclose.x new file mode 100644 index 00000000..3aa934ea --- /dev/null +++ b/pkg/tbtables/selector/tcsclose.x @@ -0,0 +1,14 @@ +# TCS_CLOSE -- Free memory associated with column selectors + +procedure tcs_close (descrip, ndescrip) + +pointer descrip[ARB] # i: column selectors +int ndescrip # i: number of descriptors +#-- +int id + +begin + do id = 1, ndescrip + call mfree (descrip[id], TY_INT) + +end diff --git a/pkg/tbtables/selector/tcscolumn.x b/pkg/tbtables/selector/tcscolumn.x new file mode 100644 index 00000000..4038cc8d --- /dev/null +++ b/pkg/tbtables/selector/tcscolumn.x @@ -0,0 +1,12 @@ +include "tcs.h" + +# TCS_COLUMN -- Get column pointer from column selector + +pointer procedure tcs_column (descrip) + +pointer descrip # i: column descriptor +#-- + +begin + return (TCS_COLUMN(descrip)) +end diff --git a/pkg/tbtables/selector/tcsintinfo.x b/pkg/tbtables/selector/tcsintinfo.x new file mode 100644 index 00000000..f6a62c74 --- /dev/null +++ b/pkg/tbtables/selector/tcsintinfo.x @@ -0,0 +1,14 @@ +include "tcs.h" + +# TCS_INTINFO -- Integer information about a column + +int procedure tcs_intinfo (descrip, what) + +pointer descrip # i: column selector +int what # i: parameter +#-- +int tbcigi() + +begin + return (tbcigi (TCS_COLUMN(descrip), what)) +end diff --git a/pkg/tbtables/selector/tcslinesize.x b/pkg/tbtables/selector/tcslinesize.x new file mode 100644 index 00000000..80d8309f --- /dev/null +++ b/pkg/tbtables/selector/tcslinesize.x @@ -0,0 +1,26 @@ +include "tcs.h" + +# TCS_LINESIZE -- Size of a single line in a column array + +int procedure tcs_linesize (descrip) + +pointer descrip # i: column selector +#-- +int size, ndim +pointer sp, length + +begin + call smark (sp) + call salloc (length, MAXDIM, TY_INT) + + # Get length of each axis + + call tcs_shape (descrip, Memi[length], ndim, MAXDIM) + + # Return length of first + + size = Memi[length] + call sfree (sp) + + return (size) +end diff --git a/pkg/tbtables/selector/tcsopen.x b/pkg/tbtables/selector/tcsopen.x new file mode 100644 index 00000000..f50ba282 --- /dev/null +++ b/pkg/tbtables/selector/tcsopen.x @@ -0,0 +1,818 @@ +include +include "tcs.h" + +define MAX_STACK 8 # max file depth in column list +define DELIM ',' # column name separator +define COMMENT '#' # comment character +define ESCAPE '\\' # escape character +define SQUOTE '\'' # single quote +define DQUOTE '"' # double quote +define LPAREN '(' # left parenthesis +define RPAREN ')' # right parenthesis +define NEWLINE '\n' # end of line character +define NOTWHITE ($1 > ' ') # private definition of white space + +.help tcs_open +.nf___________________________________________________________________________ +Table column selector + +This file contains procedures to expand a list of column names into an +array of column descriptors which match the list. The list is a list +of column patterns separated by commas. The column pattern is either +a column name, a file name containing a list of column names, or a +pattern using the usual IRAF pattern matching syntax. For example, the +string + + a[1-9], b, time*, @column.lis + +would be expanded as the column names a1 through a9, b, any column +name beginning with "time", and all the column names in the file +column.lis. If the column list is entirely whitespace, the array of +column descriptors will include all the columns in the table, as this +seems the most reasonable default. If the first non-white character is +the negation character (either ~ or !), the array of column descriptors +will include all columns not matched by the list. The negation character +only has this meaning at the beginning of the list. + +Column names may also contain array sections having the same format +as image sections. The sections are surrounded by parentheses. For example + + spec(1:200:2) image(*,30) spec (20:*) + +are valid array sections. + +.endhelp______________________________________________________________________ + +# TCS_OPEN -- Convert a list of column names to a list of descriptors + +procedure tcs_open (tp, columns, descrip, ndescrip, maxdescrip) + +pointer tp # i: table descriptor +char columns[ARB] # i: list of column names +pointer descrip[ARB] # o: list of column array selectors +int ndescrip # o: number of column array selectors +int maxdescrip # i: length of descrip array +#-- +bool negate, file +int ncols, top, fd_stack[MAX_STACK] +pointer sp, token, pattern, section, errmsg + +string overflow "Column list has too many nested files" + +bool tcs_hasmeta() +int tcs_token(), strlen(), stropen(), open() + +errchk tcs_patmatch + +begin + # Allocate memory for temporary strings + + call smark (sp) + call salloc (token, SZ_FNAME, TY_CHAR) + call salloc (pattern, SZ_FNAME, TY_CHAR) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Keep track of the number of column patterns and the negation + # pattern. At the end of the procedure, if no patterns were read, + # the list is blank, which signifies all columns should be used. + # If the negation character is encountered, the list of columns + # to use is inverted. + + ncols = 0 + negate = false + + # Initialize the number of columns matched to zero + + ndescrip = 0 + + # Since the column list may contain filenames, which in turn will + # contain other lists, we use a stack of file descriptors to keep + # track of the current file. The column list is also opened as a + # file, for the sake of generality in the code. + + top = 1 + file = false + fd_stack[1] = stropen (columns, strlen(columns), READ_ONLY) + + while (top > 0) { + # The tokenizer either returns a negation character (! or ~) + # a filename (preceded by a @) or a column name. Tokens, + # except for the negation character, are separated by commas. + + while (tcs_token (fd_stack[top], file, Memc[token], SZ_FNAME) > 0){ + ncols = ncols + 1 + + if (Memc[token] == '!') { + # Negation character. Only is significant as first + # character in the column list. + + negate = (ncols == 1) + ncols = ncols - 1 + + } else if (Memc[token] == '@') { + # Filename. Open the file and push it on the stack. + + if (top == MAX_STACK) + call error (1, overflow) + + top = top + 1 + fd_stack[top] = open (Memc[token+1], READ_ONLY, TEXT_FILE) + + ncols = ncols - 1 + + } else { + # Column pattern. Remove the section from the pattern + + call tcs_breakname (Memc[token], Memc[pattern], + Memc[section]) + + # Look for metacode characters. If found, call the + # pattern matching routine, otherwise call the string + # matching routine. The division between the routines + # is for reasons of efficiency. + + call strlwr (Memc[pattern]) + + if (tcs_hasmeta (Memc[pattern], SZ_FNAME)) { + call tcs_patmatch (tp, Memc[pattern], Memc[section], + descrip, ndescrip, maxdescrip) + } else { + call tcs_strmatch (tp, Memc[pattern], Memc[section], + descrip, ndescrip, maxdescrip) + } + } + + file = top > 1 + } + + # All columns have been read from this file, + # so pop it from the stack + + call close (fd_stack[top]) + top = top - 1 + } + + # A blank list signifies select all columns from the table + + if (ncols == 0) + call tcs_allcols (tp, descrip, ndescrip, maxdescrip) + + # The negation character signifies those columns not in the list + # should be selected + + if (negate) + call tcs_invert (tp, descrip, ndescrip, maxdescrip) + + call sfree (sp) +end + +# TCS_TOKEN -- Extract the next token from a column list + +int procedure tcs_token (fd, file, token, maxch) + +int fd # i: descriptor of file containing column list +bool file # i: is the read coming from a file? +char token[ARB] # o: token string +int maxch # i: declared length of token string +#-- +char ch +int nc, endch, paren + +char getc() + +begin + # Eat leading whitespace and delimeters + + repeat { + ch = getc (fd, ch) + + # Eat comment if we are reading from a file + + if (ch == COMMENT && file) { + repeat { + ch = getc (fd, ch) + } until (ch == EOF || ch == NEWLINE) + } + + } until (ch == EOF || (NOTWHITE(ch) && ch != DELIM)) + + + # Leading character determines rest of processing + + if (ch == EOF) { + # End of file. Return null string + token[1] = EOS + return (0) + + } else if (ch == '!' || ch == '~') { # ~ added on 1999 Jan 29 + # Negation character. Return the character. + + token[1] = '!' # same token for both negation characters + token[2] = EOS + return (1) + + } else if (ch == '@') { + # A filename. Return all characters up to whitespace or + # the next delimeter. + + nc = 1 + while (NOTWHITE(ch) && ch != DELIM) { + if (nc <= maxch) { + token[nc] = ch + nc = nc + 1 + } + + ch = getc (fd, ch) + } + + token[nc] = EOS + return (nc - 1) + + } else if (ch == SQUOTE || ch == DQUOTE){ + # A quoted string. Return all characters up to and including + # the closing quote. + + endch = ch + + nc = 1 + repeat { + if (nc < maxch) { + token[nc] = ch + nc = nc + 1 + } + + ch = getc (fd, ch) + } until (ch == EOF || ch == endch) + + token[nc] = endch + token[nc+1] = EOS + return (nc) + + } else { + # An ordinary column name. Return all characters up to the next + # whitespace or delimeter. Delimeters inside parentheses + # are part of the column section and are not treated as delimeters. + + nc = 1 + paren = 0 + while (NOTWHITE(ch) && (paren > 0 || ch != DELIM)) { + if (nc <= maxch) { + token[nc] = ch + nc = nc + 1 + } + + if (ch == LPAREN) { + paren = paren + 1 + } else if (ch == RPAREN) { + paren = paren - 1 + } + + ch = getc (fd, ch) + } + + token[nc] = EOS + return (nc - 1) + } + +end + +# TCS_BREAKNAME -- Break a column name into root and section + +procedure tcs_breakname (name, root, section) + +char name[ARB] # i: column name +char root[ARB] # o: root (everything up to the parentheses) +char section[ARB] # o: section (everything in the parentheses) +#-- +int ic, jc, kc, paren, state + +begin + jc = 1 + kc = 1 + paren = 0 + state = 1 + + # There are three states: Before the first parenthesis + # where characters are copied to the root, inside the + # parentheses where characters are copied to the section + # and after the parentheses where characters are again + # copied to the root. The variable paren keeps track of + # parentheses so we can transition between the second and + # third state at the parenthesis that matches the first. + + for (ic = 1; name[ic] != EOS; ic = ic + 1) { + if (state == 1) { + if (name[ic] == LPAREN) { + section[kc] = name[ic] + kc = kc + 1 + + state = 2 + paren = 1 + } else { + root[jc] = name[ic] + jc = jc + 1 + } + + } else if (state == 2) { + if (paren == 0) { + state = 3 + } else { + # Whitespace is not copied to the section + + if (NOTWHITE(name[ic])) { + section[kc] = name[ic] + kc = kc + 1 + } + + if (name[ic] == LPAREN) { + paren = paren + 1 + } else if (name[ic] == RPAREN) { + paren = paren - 1 + } + } + } else if (state == 3) { + root[jc] = name[ic] + jc = jc +1 + } + } + + root[jc] = EOS + section[kc] = EOS + +end + +# TCS_HASMETA -- Check for presence of metacharacters + +bool procedure tcs_hasmeta (pattern, maxch) + +char pattern[ARB] # u: character string +int maxch # i: declared length of pattern +#-- +bool meta +int ic, jc +pointer sp, buffer + +int stridx() + +begin + # If the pattern is enclosed in quotes, all characters are + # interpreted as literals. Strip quotes from the pattern and + # return false. + + if (pattern[1] == SQUOTE || pattern[1] == DQUOTE) { + for (ic = 1; pattern[ic] != EOS; ic = ic + 1) + pattern[ic] = pattern[ic+1] + + pattern[ic-2] = EOS + return (false) + } + + # Copy the pattern to a temporary buffer + + call smark (sp) + call salloc (buffer, maxch, TY_CHAR) + + jc = 0 + meta = false + for (ic = 1; pattern[ic] != EOS; ic = ic + 1) { + + if (pattern[ic] == ESCAPE && pattern[ic+1] != EOS) { + # Copy escape sequences but do not count as metacharacters + + ic = ic + 1 + if (jc <= maxch) { + Memc[buffer+jc] = ESCAPE + jc = jc + 1 + } + + } else if (pattern[ic] == '*') { + # Convert '*' to '?*', count as metacharacter + + meta = true + if (jc <= maxch) { + Memc[buffer+jc] = '?' + jc = jc + 1 + } + + } else if (stridx (pattern[ic], "[?{") > 0) { + # Check for other metacharacters + + meta = true + } + + if (jc <= maxch) { + Memc[buffer+jc] = pattern[ic] + jc = jc + 1 + } + } + + Memc[buffer+jc] = EOS + + if (meta) { + # Enclose pattern in "^pattern$" to force match + # of entire column name + + call sprintf (pattern, maxch, "^%s$") + call pargstr (Memc[buffer]) + + } else { + # Remove escape characters from pattern + # if there are no metacharacters + + jc = 1 + for (ic = 0; Memc[buffer+ic] != EOS; ic = ic + 1) { + if (Memc[buffer+ic] == ESCAPE && Memc[buffer+ic+1] != EOS) + ic = ic + 1 + + pattern[jc] = Memc[buffer+ic] + jc = jc + 1 + } + + pattern[jc] = EOS + } + + call sfree (sp) + return (meta) +end + +# TCS_PATMATCH -- Match column names containing metacharacters + +procedure tcs_patmatch (tp, pattern, section, descrip, ndescrip, maxdescrip) + +pointer tp # i: table descriptor +char pattern[ARB] # i: pattern to match +char section[ARB] # i: array section +pointer descrip[ARB] # u: list of column array selectors +int ndescrip # u: number of column array selectors +int maxdescrip # i: length of descrip array +#-- +int icol, ncols, id +pointer sp, buffer, colname, errmsg, cp + +string badpattern "Syntax error in wildcard pattern (%s)" + +int tbpsta(), patmake(), patmatch() +pointer tbcnum() + +errchk tcs_fillstruct + +begin + # Allocate temporary strings + + call smark (sp) + call salloc (buffer, SZ_LINE, TY_CHAR) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Compile the pattern + + if (patmake (pattern, Memc[buffer], SZ_LINE) == ERR) { + call sprintf (Memc[errmsg], SZ_LINE, badpattern) + call pargstr (pattern) + call error (1, Memc[errmsg]) + } + + # Look at each column name to see if it matches the pattern. + # If the pattern matches, add it to the list if the column + # has not already been matched. + + ncols = tbpsta (tp, TBL_NCOLS) + + do icol = 1, ncols { + # Get column name from column number + + cp = tbcnum (tp, icol) + call tbcigt (cp, TBL_COL_NAME, Memc[colname], SZ_COLNAME) + call strlwr (Memc[colname]) + + # Pattern matching test + + if (patmatch (Memc[colname], Memc[buffer]) > 0) { + # Check to see if already matched + + for (id = 1; id <= ndescrip; id = id + 1) { + if (cp == TCS_COLUMN(descrip[id])) + break + } + + # Add to array if not already matched and array not full + + if (id > ndescrip && ndescrip < maxdescrip) { + ndescrip = ndescrip + 1 + call tcs_fillstruct (tp, cp, section, descrip[ndescrip]) + } + } + } + + call sfree (sp) +end + +# TCS_STRMATCH -- Match column names to table columns + +procedure tcs_strmatch (tp, pattern, section, descrip, ndescrip, maxdescrip) + +pointer tp # i: table descriptor +char pattern[ARB] # i: pattern to match +char section[ARB] # i: array section +pointer descrip[ARB] # u: list of column array selectors +int ndescrip # u: number of column array selectors +int maxdescrip # i: length of descrip array +#-- +int id +pointer cp + +errchk tcs_fillstruct + +begin + # Find column pointer corresponding to column name + + call tbcfnd (tp, pattern, cp, 1) + + if (cp == NULL) + return + + # Check to see if already matched + + for (id = 1; id <= ndescrip; id = id + 1) { + if (cp == TCS_COLUMN(descrip[id])) + break + } + + # Add to array if not already matched and array not full + + if (id > ndescrip && ndescrip < maxdescrip) { + ndescrip = ndescrip + 1 + call tcs_fillstruct (tp, cp, section, descrip[ndescrip]) + } +end + +# TCS_FILLSTRUCT -- Fill structure with info about the column + +procedure tcs_fillstruct (tp, cp, section, descrip) + +pointer tp # i: table descriptor +pointer cp # i: column descriptor +char section[ARB] # i: column array section +pointer descrip # i: column array selector +#-- +int ic, idim, ndim, first, last, inc, axlen[MAXDIM] + +string baddimen "Dimension of section does not match column" + +int tcs_getsect() +errchk tcs_getsect + +begin + # Get dimension of array and length of each axis + + call tbciga (tp, cp, ndim, axlen, MAXDIM) + + # Allocate column selector descriptor + + call malloc (descrip, TCS_LENGTH(ndim), TY_INT) + + if (section[1] == EOS) { + # If there is no section, copy the array dimensions + # to the descriptor + + + do idim = 1, ndim { + TCS_FIRST(descrip,idim) = 1 + TCS_LAST(descrip,idim) = axlen[idim] + TCS_INC(descrip,idim) = 1 + } + + } else { + # If there is a section, parse it and copy it to descriptor + + ic = 2 + do idim = 1, ndim { + if (tcs_getsect (section, ic, first, last, inc) <= 0){ + # Not enough dimensions in section + + call mfree (descrip, TY_INT) + call error (1, baddimen) + } + + TCS_FIRST(descrip,idim) = first + TCS_INC(descrip,idim) = inc + + # Indef indicates an asterisk in the section, for which + # we substitute the actual array dimension + + if (IS_INDEFI (last)) { + TCS_LAST(descrip,idim) = axlen[idim] + } else { + TCS_LAST(descrip,idim) = last + } + } + + # It is an error if the section has more dimensions than the array + + if (section[ic] != EOS) { + call mfree (descrip, TY_INT) + call error (1, baddimen) + } + } + + # Eliminate spurious dimensions from the array + + for (idim = ndim; idim > 0; idim = idim - 1) { + if (axlen[idim] > 1) + break + } + + ndim = idim + + # Save the column pointer and number of dimensions in the descriptor + + TCS_COLUMN(descrip) = cp + TCS_DIMEN(descrip) = ndim + +end + +# TCS_GETSECT -- Parse the array section string + +int procedure tcs_getsect (section, ic, first, last, inc) + +char section[ARB] # i: section string +int ic # u: starting character in string +int first # o: first element in array +int last # o: last element in array +int inc # o: array increment +#-- +bool done +int jc, nc, ival, old_ic, value +pointer sp, number + +bool streq() +int stridx(), ctoi() + +string badsect "Syntax error in array section" + +begin + # Temporary string to hold numeric token + + call smark (sp) + call salloc (number, SZ_FNAME, TY_CHAR) + + # Set defaults for outputs + + first = 1 + last = 1 + inc = 1 + + # Read charcaters from section until a delimeter is found. + # Then check to see if it is a wildcard. If not, convert it + # to a number and set the appropriate output. + + jc = 0 + ival = 1 + old_ic = ic + done = false + + while (! done && section[ic] != EOS) { + if (stridx (section[ic], "(),:") == 0) { + # Copy characters until delimeter + + Memc[number+jc] = section[ic] + jc = jc + 1 + + } else { + Memc[number+jc] = EOS + + if (streq (Memc[number], "*")) { + last = INDEFI + + } else { + # Convert string to number + + jc = 1 + nc = ctoi (Memc[number], jc, value) + + # Check for trailing non-numeric chars + + if (Memc[number+nc] != EOS) + call error (1, badsect) + + # Set appropriate output + + switch (ival) { + case 1: + first = value + case 2: + last = value + if (last < first) + call error (1, badsect) + case 3: + inc = value + default: + call error (1, badsect) + } + + ival = ival + 1 + } + + # Reset to read next string + + jc = 0 + + # Exit loop when delimeter or closing parenthesis seen + + done = (section[ic] == DELIM || section[ic] == RPAREN) + } + + ic = ic + 1 + } + + # A single number indicates one element in the array + + if (last == 1 && first > 1) + last = first + + call sfree (sp) + return (ic - old_ic) + +end + +# TCS_ALLCOLS -- Get descriptors for all columns in the table + +procedure tcs_allcols (tp, descrip, ndescrip, maxdescrip) + +pointer tp # i: table descriptor +pointer descrip[ARB] # o: list of column array selectors +int ndescrip # o: number of column array selectors +int maxdescrip # i: length of descrip array +#-- +int icol, ncols +pointer cp + +int tbpsta() +pointer tbcnum() + +begin + ncols = tbpsta (tp, TBL_NCOLS) + ncols = min (ncols, maxdescrip) + + do icol = 1, ncols { + cp = tbcnum (tp, icol) + + ndescrip = ndescrip + 1 + call tcs_fillstruct (tp, cp, "", descrip[ndescrip]) + } + +end + +# TCS_INVERT -- Get descriptors for all columns not currently in list + +procedure tcs_invert (tp, descrip, ndescrip, maxdescrip) + +pointer tp # i: table descriptor +pointer descrip[ARB] # o: list of column array selectors +int ndescrip # o: number of column array selectors +int maxdescrip # i: length of descrip array +#-- +int id, icol, jcol, ncols +pointer cp, sp, clist + +int tbpsta() +pointer tbcnum() + +begin + # Allocate temporary array for column list + + ncols = tbpsta (tp, TBL_NCOLS) + + call smark (sp) + call salloc (clist, ncols, TY_INT) + + # Get each column pointer and search column selectors for a match + # If none is, found, copy the pointer to the column list + + jcol = 0 + do icol = 1, ncols { + cp = tbcnum (tp, icol) + for (id = 1; id <= ndescrip; id = id + 1) { + if (TCS_COLUMN(descrip[id]) == cp) + break + } + + if (id > ndescrip) { + Memi[clist+jcol] = cp + jcol = jcol + 1 + } + } + + # Free the old descriptors + + call tcs_close (descrip, ndescrip) + + # Get the column descriptors for the columns in the list + + ndescrip = min (jcol, maxdescrip) + do id = 1, ndescrip + call tcs_fillstruct (tp, Memi[clist+id-1], "", descrip[id]) + + call sfree (sp) +end diff --git a/pkg/tbtables/selector/tcsrdary.gx b/pkg/tbtables/selector/tcsrdary.gx new file mode 100644 index 00000000..324e96aa --- /dev/null +++ b/pkg/tbtables/selector/tcsrdary.gx @@ -0,0 +1,140 @@ +include "../tcs.h" + +# TCS_RDARY -- Read an array using the column selector + +$if (datatype == c) +procedure tcs_rdaryt (tp, descrip, irow, maxch, maxbuf, nbuf, buffer) +$else +procedure tcs_rdary$t (tp, descrip, irow, maxbuf, nbuf, buffer) +$endif + +pointer tp # i: table descriptor +pointer descrip # i: column selector +int irow # i: table row number +$if (datatype == c) +int maxch # i: max length of string +$endif +int maxbuf # i: declared length of buffer +int nbuf # o: length of output array +$if (datatype == c) +char buffer[maxch,ARB] # o: array of values +$else +PIXEL buffer[ARB] # o: array of values +$endif +#-- +int idim, ndim, pdim, plen, psize, off +int axsize, axlen[MAXDIM], axpos[MAXDIM] + +$if (datatype == c) +int tbagtt() +$else +int tbagt$t() +$endif + +begin + if (TCS_DIMEN(descrip) == 0) { + # Column is a scalar, use a scalar read routine + + if (maxbuf > 0) { + nbuf = 1 + $if (datatype == c) + call tbegtt (tp, TCS_COLUMN(descrip), irow, buffer, maxch) + $else + call tbegt$t (tp, TCS_COLUMN(descrip), irow, buffer) + $endif + } else { + nbuf = 0 + } + + } else { + # Compute size and dimensionality of the largest contigous + # piece that can be read from the array + + call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM) + + pdim = 0 + psize = 1 + do idim = 1, TCS_DIMEN(descrip) { + if (TCS_INC(descrip,idim) > 1) + break + + pdim = pdim + 1 + plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1) + psize = psize * plen + + if (plen < axlen[idim]) + break + } + + # Compute offset to first element to be read into array + + off = 0 + do idim = ndim-1, 1, -1 + off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim] + + off = off + TCS_FIRST(descrip,1) + + # Save position of first element to be read in array + + do idim = 1 , ndim + axpos[idim] = TCS_FIRST(descrip,idim) + + nbuf = 1 + + repeat { + + # Adjust piece size for possible overflow + + if (nbuf + psize > maxbuf) + psize = maxbuf - (nbuf - 1) + + # Read chunk from array + + $if (datatype == c) + psize = tbagtt (tp, TCS_COLUMN(descrip), irow, + buffer[1,nbuf], maxch, off, psize) + $else + psize = tbagt$t (tp, TCS_COLUMN(descrip), irow, + buffer[nbuf], off, psize) + $endif + + # Exit if array is full + + nbuf = nbuf + psize + if (nbuf > maxbuf) + break + + # Compute offset to next piece to read into array + + axsize = 1 + for (idim = 1; idim <= ndim; idim = idim + 1) { + if (idim > pdim) { + axpos[idim] = axpos[idim] + TCS_INC(descrip,idim) + + if (axpos[idim] + TCS_INC(descrip,idim) <= + TCS_LAST(descrip,idim)) { + + off = off + axsize * TCS_INC(descrip,idim) + break + + } else { + axpos[idim] = TCS_FIRST(descrip,idim) + + off = off - axsize * (TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) + } + } + + axsize = axsize * axlen[idim] + } + + # Exit if array has been traversed + + if (idim > ndim) + break + } + + nbuf = nbuf - 1 + } +end + diff --git a/pkg/tbtables/selector/tcsshape.x b/pkg/tbtables/selector/tcsshape.x new file mode 100644 index 00000000..0a25ce2b --- /dev/null +++ b/pkg/tbtables/selector/tcsshape.x @@ -0,0 +1,24 @@ +include "tcs.h" + +# TCS_SHAPE -- Shape of column array + +procedure tcs_shape (descrip, length, ndim, maxdimen) + +pointer descrip # i: column selector +int length[ARB] # o: dimension lengths +int ndim # o: number of dimensions +int maxdimen # i: max number of dimensions +#-- +int idim + +begin + ndim = TCS_DIMEN(descrip) + do idim = 1, ndim { + if (idim > maxdimen) + break + + length[idim] = (((TCS_LAST(descrip,idim) - + TCS_FIRST(descrip,idim)) / + TCS_INC(descrip,idim)) + 1) + } +end diff --git a/pkg/tbtables/selector/tcstotsize.x b/pkg/tbtables/selector/tcstotsize.x new file mode 100644 index 00000000..e20c1b67 --- /dev/null +++ b/pkg/tbtables/selector/tcstotsize.x @@ -0,0 +1,28 @@ +include "tcs.h" + +# TCS_TOTSIZE -- Get total length of array from column selector + +int procedure tcs_totsize (descrip) + +pointer descrip #i: column selector +#-- +int size, idim, ndim +pointer sp, length + +begin + call smark (sp) + call salloc (length, MAXDIM, TY_INT) + + # Get length of each axis + + call tcs_shape (descrip, Memi[length], ndim, MAXDIM) + + # Multiply lengths together for total length + + size = 1 + do idim = 1, ndim + size = size * Memi[length+idim-1] + + call sfree (sp) + return (size) +end diff --git a/pkg/tbtables/selector/tcstxtinfo.x b/pkg/tbtables/selector/tcstxtinfo.x new file mode 100644 index 00000000..585bf78e --- /dev/null +++ b/pkg/tbtables/selector/tcstxtinfo.x @@ -0,0 +1,15 @@ +include "tcs.h" + +# TCS_TXTINFO -- Get text information about a column + +procedure tcs_txtinfo (descrip, what, str, maxch) + +pointer descrip # i: column selector +int what # i: parameter +char str[ARB] # o: text information +int maxch # i: length of string +#-- + +begin + call tbcigt (TCS_COLUMN(descrip), what, str, maxch) +end diff --git a/pkg/tbtables/selector/trs.h b/pkg/tbtables/selector/trs.h new file mode 100644 index 00000000..325b967f --- /dev/null +++ b/pkg/tbtables/selector/trs.h @@ -0,0 +1,55 @@ +# TRS.H -- Constants used by trs procedures + +define TRS_MAGIC 5526099 + +define MAXDEPTH 32 +define MAXSTACK 8 + +define SZ_BUFFER 600 +define SZ_INSTR 6 +define SZ_NODE 5 +define SZ_TOKEN 32 + +define LEN_TRSBUF 4 + +define TRS_IDENT Memi[$1] # Structure identifier +define TRS_CODE Memi[$1+1] # Code buffer +define TRS_VALUE Memi[$1+2] # Value buffer +define TRS_ROWS Memi[$1+3] # Row set + +define OCODE 0 +define OCOLUMN 1 +define OTJUMP 2 +define OFJUMP 3 +define OLOVAL 4 +define OHIVAL 5 + +define CODE Memi[$1+OCODE] +define COLUMN Memi[$1+OCOLUMN] +define TJUMP Memi[$1+OTJUMP] +define FJUMP Memi[$1+OFJUMP] +define LOVAL Memi[$1+OLOVAL] +define HIVAL Memi[$1+OHIVAL] + +define TREE_OPER Memi[$1] # operation to be performed +define TREE_INST Memi[$1+1] # index of op in code buffer +define TREE_LEFT Memi[$1+2] # first argument of op +define TREE_RIGHT Memi[$1+3] # second argument of op +define TREE_UP Memi[$1+4] # back link in tree + +define YDONE 1 +define YRANGE 2 +define YAND 3 +define YOR 4 +define YNOT 5 +define YEQN 6 +define YEQS 7 +define YLEN 8 +define YLES 9 +define YINN 10 +define YINS 11 +define YGEN 12 +define YGES 13 +define YMSK 14 + +define YLOGICAL ($1 <= YNOT) diff --git a/pkg/tbtables/selector/trsclose.x b/pkg/tbtables/selector/trsclose.x new file mode 100644 index 00000000..4a6ae000 --- /dev/null +++ b/pkg/tbtables/selector/trsclose.x @@ -0,0 +1,25 @@ +include "trs.h" + +#* HISTORY * +#* B.Simon 04-Nov-94 original + +# TRSCLOSE - Free table row selector code buffer + +procedure trsclose (trs) + +pointer trs # i: Pseudocode structure +#-- +string notcode "trsclose: not pointer to code" + +begin + if (TRS_IDENT(trs) != TRS_MAGIC) + call error (1, notcode) + + call rst_free (TRS_ROWS(trs)) + + call mfree (TRS_VALUE(trs), TY_DOUBLE) + call mfree (TRS_CODE(trs), TY_INT) + call mfree (trs, TY_INT) +end + + diff --git a/pkg/tbtables/selector/trseval.x b/pkg/tbtables/selector/trseval.x new file mode 100644 index 00000000..eae7db8e --- /dev/null +++ b/pkg/tbtables/selector/trseval.x @@ -0,0 +1,292 @@ +include "trs.h" + +#* HISTORY * +#* B.Simon 04-Nov-94 original +#* B.Simon 29-Dec-97 revised to use row set + +.help trseval +.nf______________________________________________________________________ + +This is one of a set of three procedures to select rows of a table +according to a qpoe filter. This procedure evaluates the filter, i.e., +determines whether it is true or false for a specified row of the +table. The other two procedures are trsopen(), which compiles the +qpoe filter into the pseudocode used by trseval() and trsclose() which +frees the memory held by the pseudocode arrays. Here is an typical +example of the use of these three routines: + + tp = tbtopn (table, READ_ONLY, NULL) + numrow = tbpsta (tp, TBL_NROWS) + pcode = trsopen (tp, filter) + do irow = 1, numrow { + if (trseval (tp, irow, pcode)) { + # Do something neat here + } + } + call trsclose (pcode) + call tbtclo (tp) + +For sake of an example, suppose we have a star catalog with the +columns Name, Ra, Dec, V, B-V, and U-B. The simplest sort of filter is +the equality test. The name of the column appears on the left of an +equals sign and the column value appears on the right. For example, +[name=eta_uma]. (The brackets in this and the following example are +not actually part of the filter.) Column numbers can be used in place +of the column name. This is especially useful for ascii +tables. Values can be either numbers or strings. It is usually not +necessary to place strings in quotes. However, any string (including +a column name) contains embedded blanks or characters significant to +the qpoe filter, such a equal signs, commas, or colons, it should be +placed in quotes. + +Ranges of values can be specified by giving the endpoints of the +ranges separated by a colon. For example, [v=10:15] selects all rows +with visual magnitude between 10 and 15. Ranges include their +endpoints. Ranges can also be used with strings as well as +numbers. Ranges can also be one sided. The filter [dec=80:] selects +all rows with declination greater than or equal to eighty degress and +the filter [dec=:-40] selects all declinations less than or equal to +forty degrees south. A filter can contain a list of single values and +ranges. The values in the list should be enclosed in parentheses. For +example, [name=(eta_uma,alpha_lyr)] or [b-v=(-1:0,0.5:1)]. + +Individual values or ranges can be negated by placing a ! in front of +them. For example, [name=!eta_uma] selects every row except the star +named eta_uma and [ra=!0:6] selects all rows except those with right +ascension between zero and six hours. An entire list can be negated by +placing a ! in front of the column name or the parentheses enclosing +the list. The filters [!name=(eta_uma,alpha_lyr)] and +[name=!(eta_uma,alpha_lyr)] and [name=(!eta_uma,!alpha_lyr)] are all +equivalent. + +Filters can test more than one column in a table. The individual tests +are separated by commas or semicolons. All tests in the filter must +succeed for the filter to be accepted. For example, +[ra=1.3:1.4,dec=40:42] selects a rectangular region in the catalog. A +range of row numbers can also be selected by placing the word row on +the left side of the equals sign. For example, [row=10:20] selects +rows from ten to twenty inclusive and [row=50:] selects all rows from +fifty on. Row selection can be combined with any other test in a +filter. A filter, can also be placed in an include file, for example +[@filter.lis]. Include files can be a part of a larger expression +and include files can contain other files, up to seven levels deep. + +.endhelp _________________________________________________________________ + +# TRSEVAL -- Evaluate a table row selector on a row of a table + +bool procedure trseval (tp, irow, pcode) + +pointer tp # i: table descriptor +int irow # i: table row number +pointer pcode # i: pseudocode +#-- +string notcode "trseval: not pointer to code" + +bool rst_inset(), trscalc() +errchk trscalc + +begin + # Make sure this is a valid trs descriptor + + if (TRS_IDENT(pcode) != TRS_MAGIC) + call error (1, notcode) + + # Check to see if the row is in the set first + # if it is, calculate the result of the pseudocode + + if (rst_inset (TRS_ROWS(pcode),irow)) + if (trscalc (tp,irow, TRS_CODE(pcode))) + return (true) + + return (false) +end + +# TRSCALC -- Calculate the result of the pseudocode embedded in the descriptor + +bool procedure trscalc (tp, irow, codebuf) + +pointer tp # i: table descriptor +int irow # i: table row number +pointer codebuf # i: pseudocode + +#-- +bool jump, stack[MAXSTACK] +double val +int itop, icode,junk, mask1, mask2 +pointer sp, str + +string ovflow "trscalc: stack overflow" +string badcode "trscalc: bad instruction" + +errchk trsgetd, trsgett +bool streq(), strle(), strge() +int trstrim() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + itop = 0 + icode = 0 + jump = false + + repeat { + if (itop == MAXSTACK) + call error (1, ovflow) + + switch (CODE(codebuf+icode)) { + case YDONE: # end instruction + break + + case YRANGE: # range instruction, no-op + ; + + case YAND: # logical and + if (! jump) { + stack[itop-1] = stack[itop-1] && stack[itop] + itop = itop - 1 + } + + case YOR: # logical or + if (! jump) { + stack[itop-1] = stack[itop-1] || stack[itop] + itop = itop - 1 + } + + case YNOT: # logical not + stack[itop] = ! stack[itop] + + case YEQN: # numeric equality test + call trsgetd (tp, COLUMN(codebuf+icode), irow, val) + itop = itop + 1 + stack[itop] = val == Memd[LOVAL(codebuf+icode)] + + case YEQS: # string equality check + call trsgett (tp, COLUMN(codebuf+icode), irow, + Memc[str], SZ_LINE) + junk = trstrim (Memc[str]) + + itop = itop + 1 + stack[itop] = streq (Memc[str], Memc[LOVAL(codebuf+icode)]) + + case YLEN: # numeric less than or equal check + call trsgetd (tp, COLUMN(codebuf+icode), irow, val) + itop = itop + 1 + stack[itop] = val <= Memd[LOVAL(codebuf+icode)] + + case YLES: # string less than or equal check + call trsgett (tp, COLUMN(codebuf+icode), irow, + Memc[str], SZ_LINE) + junk = trstrim (Memc[str]) + + itop = itop + 1 + stack[itop] = strle (Memc[str], Memc[LOVAL(codebuf+icode)]) + + case YINN: # numeric inclusion check + call trsgetd (tp, COLUMN(codebuf+icode), irow, val) + itop = itop + 1 + stack[itop] = val >= Memd[LOVAL(codebuf+icode)] && + val <= Memd[HIVAL(codebuf+icode)] + + case YINS: # string inclusion check + call trsgett (tp, COLUMN(codebuf+icode), irow, + Memc[str], SZ_LINE) + junk = trstrim (Memc[str]) + + itop = itop + 1 + stack[itop] = strge (Memc[str], Memc[LOVAL(codebuf+icode)]) && + strle (Memc[str], Memc[HIVAL(codebuf+icode)]) + + case YGEN: # numeric greater than or equal check + call trsgetd (tp, COLUMN(codebuf+icode), irow, val) + itop = itop + 1 + stack[itop] = val >= Memd[LOVAL(codebuf+icode)] + + case YGES: # string greater than or equal check + call trsgett (tp, COLUMN(codebuf+icode), irow, + Memc[str], SZ_LINE) + junk = trstrim (Memc[str]) + + itop = itop + 1 + stack[itop] = strge (Memc[str], Memc[LOVAL(codebuf+icode)]) + + case YMSK: # bit mask + call trsgetd (tp, COLUMN(codebuf+icode), irow, val) + mask1 = val + mask2 = Memd[LOVAL(codebuf+icode)] + itop = itop + 1 + stack[itop] = and (mask1, mask2) == mask2 + + default: + call error (1, badcode) + } + + # Set instruction pointer. Peform a jump if the jump field + # corresponding to the result is not NULL. Otherwise, + # increment the pointer. + + if (TJUMP(codebuf+icode) != NULL && stack[itop]) { + jump = true + icode = TJUMP(codebuf+icode) + } else if (FJUMP(codebuf+icode) != NULL && ! stack[itop]) { + jump = true + icode = FJUMP(codebuf+icode) + } else { + jump = false + icode = icode + SZ_INSTR + } + } + + # This handles the case of an empty program + + if (itop == 0) + stack[1] = true + + # Return result + + call sfree (sp) + return (stack[1]) +end + +# TRSGETD -- Read double value from table + +procedure trsgetd (tp, cp, irow, val) + +pointer tp # i: table descriptor +pointer cp # i: column descriptor +int irow # i: column number +double val # o: value read from table +#-- +errchk tbegtd + +begin + if (cp == NULL) { + val = irow + } else { + call tbegtd (tp, cp, irow, val) + } +end + +# TRSGETT -- Read string value from table + +procedure trsgett (tp, cp, irow, str, maxch) + +pointer tp # i: table descriptor +pointer cp # i: column descriptor +int irow # i: column number +char str[ARB] # o: value read from table +int maxch # i: maximum string length +#-- +int junk + +errchk itoc, tbgett +int itoc() + +begin + if (cp == NULL) { + junk = itoc (irow, str, maxch) + } else { + call tbegtt (tp, cp, irow, str, maxch) + } +end diff --git a/pkg/tbtables/selector/trsgencode.x b/pkg/tbtables/selector/trsgencode.x new file mode 100644 index 00000000..4499fac8 --- /dev/null +++ b/pkg/tbtables/selector/trsgencode.x @@ -0,0 +1,414 @@ +include +include "trs.h" + +#* HISTORY * +#* B.Simon 02-Jan-98 original + +# TRSGENCODE -- Generate pseudocode from binary tree + +procedure trsgencode (tp, root, pcode) + +pointer tp # i: table descriptor +int root # i: root node of binary tree +pointer pcode # u: pseudocode structure +#-- +int nrow + +bool trshasrow() +int tbpsta() +pointer trsoptimize(), rst_create() +errchk trshasrow, trsputcode, trsoptimze + +begin + nrow = tbpsta (tp, TBL_NROWS) + + if (trshasrow (root)) { + TRS_ROWS(pcode) = trsoptimize (root, nrow) + + } else { + TRS_ROWS(pcode) = rst_create (1, nrow) + } + + call trsputcode (root, pcode) + call trsputjump (root, pcode) + +end + +# TRSHASROW -- Does code contains a row expression that can be optimized? + +bool procedure trshasrow (root) + +pointer root # i: root of binary tree +#-- +bool result, hasrow +pointer node, child + +bool trs_over_tree() +pointer trs_first_tree(), trs_next_tree() +errchk trs_xcg_tree + +begin + # Expressions without row ranges cannot be optimized. Also + # expressions with YNOT outside of YRANGE cannot be optimized. + # However, if the YNOT operates on a single range, the order + # of the YRANGE and YNOT can be flipped + + result = true + hasrow = false + node = trs_first_tree (root) + + while (node != NULL) { + if (TREE_OPER(node) == YRANGE && TREE_RIGHT(node) == NULL) { + hasrow = true + + } else if (TREE_OPER(node) == YNOT) { + + # If a YNOT is found outside a YRANGE controlling a row, + # it is not optimizable unless the two can be swapped + + child = TREE_LEFT(node) + + if (TREE_OPER(child) == YRANGE) { + # YNOT and YRANGE can be swapped, so do it + call trs_xcg_tree (child) + + } else if (trs_over_tree (node)) { + # Can't be swapped and over row range, + # so not optimizable + result = false + } + } + + node = trs_next_tree (node) + } + + # No row range, so not optimizable + + if (! hasrow) + result = false + + return (result) +end + +# TRSOPTIMIZE -- Optimize an expression by evaluting its row ranges + +pointer procedure trsoptimize (root, nrow) + +pointer root # i: root of binary tree +int nrow # i: number of rows in table +#-- +int top, istack, nstack +pointer sp, eval, node, prev, set + +bool trs_under_tree() +pointer trs_first_tree(), trs_next_tree() +errchk trsroweval, trs_snip_tree + +begin + # Allocate arrays used in traversing binary tree + + call smark (sp) + call salloc (eval, MAXDEPTH, TY_INT) + + # Traverse the binary tree, looking for row expressions + # when one is found, evaluate it and remove it from the tree + + top = 0 + node = trs_first_tree (root) + + while(node != NULL) { + # Evaluate row expressions + + if (trs_under_tree (node)) + call trsroweval (TREE_OPER(node), -TREE_LEFT(node), + -TREE_RIGHT(node), nrow, Memi[eval], + top) + + prev = node + node = trs_next_tree (node) + + # After complete evaluation of the row expression + # snip it out of the binary tree. If both branches + # of a logical have been snipped, also snip it out + # of the tree. Don't have to worry about YNOT as it + # was already buried beneath YRANGE in trshasrow + + if (TREE_OPER(prev) == YRANGE && TREE_RIGHT(prev) == NULL) { + call trs_snip_tree (prev) + + } else if ((TREE_OPER(prev) == YAND || TREE_OPER(prev) == YOR) && + (TREE_RIGHT(prev) == NULL && TREE_LEFT(prev) == NULL)) { + call trs_snip_tree (prev) + } + + } + + # If there is more than one row expression, they are + # combined with ands + + nstack = top - 1 + do istack = 1, nstack + call trsroweval (YAND, NULL, NULL, nrow, Memi[eval], top) + + # Return the row set evaluated + + set = Memi[eval] + + call sfree (sp) + return (set) + +end + +# TRSPUTCODE -- Convert binary tree into pseudocode instructions + +procedure trsputcode (root, pcode) + +pointer root # i: root of binary tree +pointer pcode # u: pseudocode structure +#-- +int icode, oper +pointer codebuf, node, col, loval, hival + +string noroom "Table row selection expression too complex" + +pointer trs_first_tree(), trs_next_tree(), trs_col_tree() + +begin + icode = 0 + codebuf = TRS_CODE(pcode) + + node = trs_first_tree (root) + + while (node != NULL) { + oper = TREE_OPER(node) + + if ((oper == YAND || oper == YOR) && + (TREE_LEFT(node) == NULL || + TREE_RIGHT(node) == NULL)) { + + # Skip encoding if one branch of a logical + # has been snipped + + TREE_INST(node) = ERR + + } else { + # Check for buffer overflow + + if (icode + SZ_INSTR >= SZ_BUFFER) + call error (1, noroom) + + # Set instruction field in tree + + TREE_INST(node) = icode + + # Retrieve column value + + if (YLOGICAL(oper)) + col = NULL + else + col = trs_col_tree (node) + + # Retrieve field values + + call trsvalue (node, loval, hival) + + # Add instruction to code buffer + + Memi[codebuf+icode+OCODE] = oper + Memi[codebuf+icode+OCOLUMN] = col + Memi[codebuf+icode+OTJUMP] = NULL + Memi[codebuf+icode+OFJUMP] = NULL + Memi[codebuf+icode+OLOVAL] = loval + Memi[codebuf+icode+OHIVAL] = hival + + # Increment code buffer index + + icode = icode + SZ_INSTR + } + + node = trs_next_tree (node) + } + +end + +# TRSPUTJUMP -- Add jumps to pseudocode + +procedure trsputjump (root, pcode) + +pointer root # i: root of binary tree +pointer pcode # u: pseudocode structure +#-- +int icode, inst +pointer codebuf, node, jump, child + +pointer trs_first_tree(), trs_next_tree() + +begin + codebuf = TRS_CODE(pcode) + node = trs_first_tree (root) + + while (node != NULL) { + if (TREE_INST(node) != ERR) { + inst = TREE_OPER(node) + jump = TREE_INST(node) + + child = TREE_LEFT(node) + if (child > 0) { + icode = TREE_INST(child) + + if (inst == YOR) + Memi[codebuf+icode+OTJUMP] = jump + + if (inst == YAND) + Memi[codebuf+icode+OFJUMP] = jump + } + } + + node = trs_next_tree (node) + } + +end + +# TRSROWEVAL -- Evaluate an operation in a row expression + +procedure trsroweval (code, loval, hival, nrow, eval, top) + +int code # i: pseudocode instruction +pointer loval # i: low end of range +pointer hival # i: high end of range +int nrow # i: number of rows in table +pointer eval[MAXDEPTH] # u: stack of pending results +int top # u: index to top of stack +#-- +int narg, iarg, lo, hi + +string ovflow "trs_roweval: stack overflow" +string badcode "trs_roweval: bad instruction" + +pointer rst_create(), rst_and(), rst_or(), rst_not() + +begin + if (top == MAXDEPTH) + call error (1, ovflow) + + switch (code) { + case YRANGE: # range operation, really a no-op + narg = 0 + + case YAND: # logical and + narg = 2 + top = top + 1 + eval[top] = rst_and (eval[top-1], eval[top-2]) + + case YOR: # logical or + narg = 2 + top = top + 1 + eval[top] = rst_or (eval[top-1], eval[top-2]) + + case YNOT: # logical not + narg = 1 + top = top + 1 + eval[top] = rst_not (nrow, eval[top-1]) + + case YEQN: # numerical equality test + narg = 0 + top = top + 1 + + lo = max (1, int(Memd[loval])) + eval[top] = rst_create (lo, lo) + + case YLEN: # numeric less than or equal check + narg = 0 + top = top + 1 + + lo = max (1, int(Memd[loval])) + eval[top] = rst_create (1, lo) + + case YINN: # numeric inclusion check + narg = 0 + top = top + 1 + + lo = min (Memd[loval], Memd[hival]) + hi = max (Memd[loval], Memd[hival]) + + lo = max (1, lo) + hi = min (nrow, hi) + eval[top] = rst_create (lo, hi) + + + case YGEN: # numeric greater than or equal check + narg = 0 + top = top + 1 + + hi = min (nrow, int(Memd[loval])) + eval[top] = rst_create (hi, nrow) + + default: + call error (1, badcode) + } + + # Free used stack elements + + if (narg > 0) { + do iarg = 1, narg + call rst_free (eval[top-iarg]) + + eval[top-narg] = eval[top] + top = top - narg + } +end + +# TRSVALUE -- Extract field values from a node of a binary tree + +procedure trsvalue (node, loval, hival) + +pointer node # i: binary tree node +pointer loval # o: smaller of the two values +pointer hival # o: larger of the two values +#-- +bool strgt() + +begin + + if (TREE_RIGHT(node) == NULL) { + # Duplicate left value if right value is NULL + + loval = -TREE_LEFT(node) + hival = -TREE_LEFT(node) + + } else { + # Flip high and low values if out of order + + if (TREE_OPER(node) == YINN) { + if (Memd[-TREE_RIGHT(node)] > + Memd[-TREE_LEFT(node)]) { + + loval = -TREE_LEFT(node) + hival = -TREE_RIGHT(node) + } else { + loval = -TREE_RIGHT(node) + hival = -TREE_LEFT(node) + } + + } else if (TREE_OPER(node) == YINS) { + if (strgt (Memc[-TREE_RIGHT(node)], + Memc[-TREE_LEFT(node)])) { + + loval = -TREE_LEFT(node) + hival = -TREE_RIGHT(node) + } else { + loval = -TREE_RIGHT(node) + hival = -TREE_LEFT(node) + } + } + } + + # Set values to null if the value is actually a node address + + if (loval < 0) + loval = NULL + + if (hival < 0) + hival = NULL + +end diff --git a/pkg/tbtables/selector/trsopen.com b/pkg/tbtables/selector/trsopen.com new file mode 100644 index 00000000..44d71a50 --- /dev/null +++ b/pkg/tbtables/selector/trsopen.com @@ -0,0 +1,15 @@ +# TRSOPEN.COM -- Common block holding global variables for trsopen + +pointer tabptr # table descriptor +pointer tokbuf # buffer to hold last tokens +pointer errbuf # token to hold error message +pointer treebuf # buffer to hold intermediate tree representation +pointer pcode # pseudocode structure +int itop # top of stack index +int itok # end of token index +int ival # next available location in value buffer +int itree # next available node in tree +int stack[MAXSTACK] # stack of pending file descriptors + +common / trscom / tabptr, tokbuf, errbuf, treebuf, pcode, + itop, itok, ival, itree, stack diff --git a/pkg/tbtables/selector/trsopen.x b/pkg/tbtables/selector/trsopen.x new file mode 100644 index 00000000..7c6e22d8 --- /dev/null +++ b/pkg/tbtables/selector/trsopen.x @@ -0,0 +1,926 @@ +include "trs.h" + +#* HISTORY * +#* B.Simon 04-Nov-94 original +#* B.Simon 23-Dec-97 row optimization added +# Phil Hodge 12-Jul-2005 In trsopen, declare 'debug' to be bool rather +# than int, and add 'int trslex()' + +define YYMAXDEPTH 64 +define YYOPLEN 1 +define yyparse trsparse + +define YNIL 257 +define YBANG 258 +define YCOMMA 259 +define YCOLON 260 +define YEQUAL 261 +define YERR 262 +define YEOF 263 +define YLPAR 264 +define YINC 265 +define YNUM 266 +define YPER 267 +define YRPAR 268 +define YSEMI 269 +define YSTR 270 +define yyclearin yychar = -1 +define yyerrok yyerrflag = 0 +define YYMOVE call amovi (Memi[$1], Memi[$2], YYOPLEN) +define YYERRCODE 256 + +# line 131 "trsopen.y" + + +# TRSOPEN -- Compile a table row selection expression + +pointer procedure trsopen (tp, expr) + +pointer tp # i: table descriptor +char expr[ARB] # i: expression to be parsed +#-- +include "trsopen.com" + +char nil +int fd, jtop +bool debug +pointer sp, root + +data nil / EOS / +data debug / false / +string syntax "syntax error" + +errchk stropen, trsparse, trserr + +int trslex() +extern trslex +pointer trsinit(), trsparse() +int stropen(), strlen() + +begin + # Initialize common block used by parser + + tabptr = tp + + call smark (sp) + call salloc (tokbuf, SZ_TOKEN, TY_CHAR) + call salloc (errbuf, SZ_LINE, TY_CHAR) + call salloc (treebuf, SZ_BUFFER, TY_INT) + + call amovkc (nil, Memc[tokbuf], SZ_TOKEN) + call strcpy (syntax, Memc[errbuf], SZ_LINE) + + itree = 0 + itop = 0 + itok = 0 + ival = 0 + + # Convert expression to pseudocode + + fd = stropen (expr, strlen(expr), READ_ONLY) + pcode = trsinit () + + root = trsparse (fd, debug, trslex) + if (root != NULL) { + call trsgencode (tp, root, pcode) + + } else { + # Error exit: free memory and close open files + + do jtop = 1, itop + call close (stack[jtop]) + call close (fd) + + call trserr + } + + # Free memory and close files + + call close (fd) + call sfree (sp) + return (pcode) +end + +# TRSADDNODE -- Add a node to the binary tree + +pointer procedure trsaddnode (oper, lfield, rfield) + +int oper # i: pseudocode operation +pointer lfield # i: left field of operation +pointer rfield # i: right field of operation +#-- +include "trsopen.com" + +pointer ptr + +string noroom "Table row selection expression too complex" + +begin + if (itree >= SZ_BUFFER) + call error (1, noroom) + + ptr = treebuf + itree + + TREE_OPER(ptr) = oper + TREE_INST(ptr) = ERR + TREE_LEFT(ptr) = lfield + TREE_RIGHT(ptr) = rfield + TREE_UP(ptr) = NULL + + if (lfield > 0) + TREE_UP(lfield) = ptr + + if (rfield > 0) + TREE_UP(rfield) = ptr + + itree = itree + SZ_NODE + return (ptr) +end + +# TRSCNAME -- Retrieve a column pointer, given its name + +bool procedure trscname (cname, cptr) + +pointer cname # i: column name +pointer cptr # o: column pointer +#-- +include "trsopen.com" + +bool streq() + +begin + call tbcfnd (tabptr, Memc[cname], cptr, 1) + + # "row" is a special filter indicating column number + + if (cptr == NULL) { + return (streq (Memc[cname], "row")) + } else { + return (true) + } + +end + +# TRSCNUM -- Retrieve a column pointer, given its number + +bool procedure trscnum (cnum, cptr) + +pointer cnum # i: column number +pointer cptr # o: column pointer +#-- +include "trsopen.com" + +int col +pointer tbcnum() + +begin + col = Memd[cnum] + cptr = tbcnum (tabptr, col) + + return (cptr != NULL) +end + +# TRSERR -- Print error message from table row selector parser + +procedure trserr + +#-- +include "trsopen.com" + +int nc +pointer sp, token, errmsg + +string errfmt "Error in table row selector, %s. Last read: %s" + +begin + # Allocate memory to hold token + + call smark (sp) + call salloc (token, SZ_TOKEN, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Copy token from token buffer. Since token buffer is maintained + # as a queue, the copy is in two parts, after and before the + # queue pointer. + + nc = 0 + if (Memc[tokbuf+itok] != EOS) { + nc = SZ_TOKEN - itok + call amovc (Memc[tokbuf+itok], Memc[token], nc) + } + + itok = mod (itok - 1, SZ_TOKEN) + call amovc (Memc[tokbuf], Memc[token+nc], itok) + + nc = nc + itok + Memc[token+nc] = EOS + + # Exit with error message + + call sprintf (Memc[errmsg], SZ_LINE, errfmt) + call pargstr (Memc[errbuf]) + call pargstr (Memc[token]) + + call error (1, Memc[errmsg]) + call sfree (sp) +end + +# TRSINIT -- Allocate and intialize the trs pseudocode data structure + +pointer procedure trsinit () + +#-- +pointer buf + +begin + call malloc (buf, LEN_TRSBUF, TY_INT) + + TRS_IDENT(buf) = TRS_MAGIC + TRS_ROWS(buf) = NULL + + call malloc (TRS_CODE(buf), SZ_BUFFER, TY_INT) + call malloc (TRS_VALUE(buf), SZ_BUFFER, TY_DOUBLE) + + return (buf) +end + +# TRSLEX -- Lexical analyzer for table row selector + +int procedure trslex (fd, value) + +int fd # u: file descriptor of currently open file +pointer value # i: Pointer to current token value +#-- +include "trsopen.com" + +int type + +string badfile "bad file name" +string maxfile "files nested too deep" + +errchk open +int open() + +begin + # This procedure sits on top of the procedure that fetches + # the next token and handles file openings and closings + + type = YNIL + while (type == YNIL) { + call trstok (fd, value, type) + + if (type == YEOF) { + # End of file token. Pop deferred file off of stack + # if no deferred file, return end of file token + + if (itop != 0) { + call amovkc (EOS, Memc[tokbuf], SZ_TOKEN) + itok = 0 + + call close (fd) + fd = stack[itop] + itop = itop - 1 + type = YNIL + } + + } else if (type == YINC) { + # Include file token. Next token should be file name + # Push current file descriptor on deferred file stack + # and open new file + + call trstok (fd, value, type) + + if (type != YSTR) { + call strcpy (badfile, Memc[errbuf], SZ_LINE) + type = YERR + + } else if (itop == MAXSTACK) { + call strcpy (maxfile, Memc[errbuf], SZ_LINE) + type = YERR + + } else { + itop = itop + 1 + stack[itop] = fd + + ifnoerr { + fd = open (Memc[Memi[value]], READ_ONLY, TEXT_FILE) + } then { + call amovkc (EOS, Memc[tokbuf], SZ_TOKEN) + itok = 0 + type = YNIL + + } else { + fd = stack[itop] + itop = itop - 1 + + call strcpy (badfile, Memc[errbuf], SZ_LINE) + type = YERR + } + } + } + } + + return (type) +end + +# TRSNEXTCH -- Read next character from input stram, save in buffer + +int procedure trsnextch (fd, ch) + +int fd # i: input file descriptor +char ch # o: character read from input +#-- +include "trsopen.com" + +int getc() + +begin + Memc[tokbuf+itok] = getc (fd, ch) + itok = mod (itok+1, SZ_TOKEN) + + return (ch) +end + +# TRSTOK -- Read next token from current file + +procedure trstok (fd, value, type) + +int fd # u: file descriptor of currently open file +pointer value # i: Pointer to current token value +int type # i: Token type +#-- +include "trsopen.com" + +char ch, stop +double dval +int stoptype[10] +int nc, ic, index, delta, size + +pointer sp, token, ptr, valbuf + +string notnum "not a number" +string noroom "expression too complex" +string nostop "trailing quote not found" + +string stopset " ,;:%=!()@" + +data stoptype / YNIL, YCOMMA, YSEMI, YCOLON, YPER, + YEQUAL, YBANG, YLPAR, YRPAR, YINC / + +int trsnextch(),trstrim(), stridx(), ctod() + +begin + # Eat leading whitespace, watch for end of file + + while (trsnextch (fd, ch) <= ' ') { + if (ch == EOF) { + Memi[value] = NULL + type = YEOF + return + } + + } + + # Check if first character is a delimeter + # if so, return the corresponding token + + index = stridx (ch, stopset) + if (index > 0) { + Memi[value] = NULL + type = stoptype[index] + return + } + + # The tougher case: token is a number or string + # First, gather all characters in token + + call smark (sp) + call salloc (token, SZ_LINE, TY_CHAR) + + if (ch == '\'' || ch == '"') { + # First case: token is a quoted string + # gather characters until matching quote is found + + nc = 0 + stop = ch + + while (trsnextch (fd, ch) != EOF) { + if (ch == stop) + break + + Memc[token+nc] = ch + nc = nc + 1 + } + + # Handle situation where trailing quote is missing + + if (ch == EOF) { + call strcpy (nostop, Memc[errbuf], SZ_LINE) + Memi[value] = NULL + type = YERR + + call sfree (sp) + return + } + + } else { + # Second case: no quotes + # gather characters until delimeter or whitespace + + nc = 1 + Memc[token] = ch + stop = ' ' + + while (trsnextch (fd, ch) != EOF) { + if (ch < ' ') + ch = ' ' + + if (stridx (ch, stopset) > 0) { + itok = itok - 1 + if (itok < 0) + itok = SZ_TOKEN - 1 + + call ungetc (fd, ch) + break + } + + Memc[token+nc] = ch + nc = nc + 1 + } + } + + Memc[token+nc] = EOS + nc = trstrim (Memc[token]) + + ic = 1 + valbuf = TRS_VALUE(pcode) + + if (stop == ' ' && ctod (Memc[token], ic, dval) == nc) { + # Token is a number. Convert it to a double + # and store in the value buffer + + if (ival + 1 >= SZ_BUFFER) { + call strcpy (noroom, Memc[errbuf], SZ_LINE) + Memi[value] = NULL + type = YERR + + } else { + ptr = valbuf + ival + ival = ival + 1 + + Memd[ptr] = dval + Memi[value] = ptr + type = YNUM + } + + } else { + # Token is a string. Find how much space it will take + # and store in the value buffer + + size = nc + 1 + delta = mod (size, SZ_DOUBLE) + if (delta != 0) + size = size + (SZ_DOUBLE - delta) + size = size / SZ_DOUBLE + + if (ival + size >= SZ_BUFFER) { + call strcpy (noroom, Memc[errbuf], SZ_LINE) + Memi[value] = NULL + type = YERR + + } else { + ptr = ((valbuf + ival - 1) * SZ_DOUBLE) + 1 + ival = ival + size + + call strcpy (Memc[token], Memc[ptr], size*SZ_DOUBLE-1) + Memi[value] = ptr + type = YSTR + } + } + + call sfree (sp) +end + +define YYNPROD 22 +define YYLAST 60 +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Parser for yacc output, translated to the IRAF SPP language. The contents +# of this file form the bulk of the source of the parser produced by Yacc. +# Yacc recognizes several macros in the yaccpar input source and replaces +# them as follows: +# A user suppled "global" definitions and declarations +# B parser tables +# C user supplied actions (reductions) +# The remainder of the yaccpar code is not changed. + +define yystack_ 10 # statement labels for gotos +define yynewstate_ 20 +define yydefault_ 30 +define yyerrlab_ 40 +define yyabort_ 50 + +define YYFLAG (-1000) # defs used in user actions +define YYERROR goto yyerrlab_ +define YYACCEPT return (OK) +define YYABORT return (ERR) + + +# YYPARSE -- Parse the input stream, returning OK if the source is +# syntactically acceptable (i.e., if compilation is successful), +# otherwise ERR. The parameters YYMAXDEPTH and YYOPLEN must be +# supplied by the caller in the %{ ... %} section of the Yacc source. +# The token value stack is a dynamically allocated array of operand +# structures, with the length and makeup of the operand structure being +# application dependent. + +int procedure yyparse (fd, yydebug, yylex) + +int fd # stream to be parsed +bool yydebug # print debugging information? +int yylex() # user-supplied lexical input function +extern yylex() + +short yys[YYMAXDEPTH] # parser stack -- stacks tokens +pointer yyv # pointer to token value stack +pointer yyval # value returned by action +pointer yylval # value of token +int yyps # token stack pointer +pointer yypv # value stack pointer +int yychar # current input token number +int yyerrflag # error recovery flag +int yynerrs # number of errors + +short yyj, yym # internal variables +pointer yysp, yypvt +short yystate, yyn +int yyxi, i +errchk salloc, yylex + + +include "trsopen.com" + +int cptr + +errchk trslex, trsaddnode +bool trscname(), trscnum() +pointer trsaddnode + +string badcol "column not found" + +short yyexca[6] +data (yyexca(i),i= 1, 6) / -1, 1, 0, -1, -2, 0/ +short yyact[60] +data (yyact(i),i= 1, 8) / 20, 37, 23, 3, 36, 5, 19, 33/ +data (yyact(i),i= 9, 16) / 21, 24, 5, 4, 22, 6, 9, 31/ +data (yyact(i),i= 17, 24) / 4, 7, 6, 32, 26, 9, 7, 17/ +data (yyact(i),i= 25, 32) / 10, 8, 14, 13, 30, 35, 29, 10/ +data (yyact(i),i= 33, 40) / 18, 2, 1, 0, 0, 0, 11, 12/ +data (yyact(i),i= 41, 48) / 0, 0, 0, 15, 16, 0, 0, 25/ +data (yyact(i),i= 49, 56) / 0, 0, 0, 0, 27, 28, 0, 0/ +data (yyact(i),i= 57, 60) / 0, 0, 0, 34/ +short yypact[38] +data (yypact(i),i= 1, 8) /-253,-1000,-238,-1000,-248,-248,-234,-235/ +data (yypact(i),i= 9, 16) /-1000,-248,-248,-245,-1000,-258,-258,-1000/ +data (yypact(i),i= 17, 24) /-1000,-1000,-1000,-258,-258,-230,-232,-251/ +data (yypact(i),i= 25, 32) /-259,-1000,-258,-239,-1000,-262,-269,-1000/ +data (yypact(i),i= 33, 38) /-1000,-1000,-1000,-1000,-1000,-1000/ +short yypgo[4] +data (yypgo(i),i= 1, 4) / 0, 34, 33, 32/ +short yyr1[22] +data (yyr1(i),i= 1, 8) / 0, 1, 1, 2, 2, 2, 2, 2/ +data (yyr1(i),i= 9, 16) / 2, 2, 3, 3, 3, 3, 3, 3/ +data (yyr1(i),i= 17, 22) / 3, 3, 3, 3, 3, 3/ +short yyr2[22] +data (yyr2(i),i= 1, 8) / 0, 2, 1, 0, 3, 3, 3, 2/ +data (yyr2(i),i= 9, 16) / 3, 3, 3, 3, 2, 1, 1, 2/ +data (yyr2(i),i= 17, 22) / 2, 3, 3, 2, 2, 2/ +short yychk[38] +data (yychk(i),i= 1, 8) /-1000, -1, -2, 256, 264, 258, 266, 270/ +data (yychk(i),i= 9, 16) / 263, 259, 269, -2, -2, 261, 261, -2/ +data (yychk(i),i= 17, 24) / -2, 268, -3, 264, 258, 266, 270, 260/ +data (yychk(i),i= 25, 32) / 267, -3, 259, -3, -3, 260, 260, 266/ +data (yychk(i),i= 33, 38) / 270, 266, -3, 268, 266, 270/ +short yydef[38] +data (yydef(i),i= 1, 8) / 3, -2, 0, 2, 3, 3, 0, 0/ +data (yydef(i),i= 9, 16) / 1, 3, 3, 0, 7, 0, 0, 5/ +data (yydef(i),i= 17, 24) / 6, 4, 8, 0, 0, 13, 14, 0/ +data (yydef(i),i= 25, 32) / 0, 9, 0, 0, 12, 19, 20, 15/ +data (yydef(i),i= 33, 38) / 16, 21, 11, 10, 17, 18/ + +begin + call smark (yysp) + call salloc (yyv, (YYMAXDEPTH+2) * YYOPLEN, TY_STRUCT) + + # Initialization. The first element of the dynamically allocated + # token value stack (yyv) is used for yyval, the second for yylval, + # and the actual stack starts with the third element. + + yystate = 0 + yychar = -1 + yynerrs = 0 + yyerrflag = 0 + yyps = 0 + yyval = yyv + yylval = yyv + YYOPLEN + yypv = yylval + +yystack_ + # SHIFT -- Put a state and value onto the stack. The token and + # value stacks are logically the same stack, implemented as two + # separate arrays. + + if (yydebug) { + call printf ("state %d, char 0%o\n") + call pargs (yystate) + call pargi (yychar) + } + yyps = yyps + 1 + yypv = yypv + YYOPLEN + if (yyps > YYMAXDEPTH) { + call sfree (yysp) + call eprintf ("yacc stack overflow\n") + return (ERR) + } + yys[yyps] = yystate + YYMOVE (yyval, yypv) + +yynewstate_ + # Process the new state. + yyn = yypact[yystate+1] + + if (yyn <= YYFLAG) + goto yydefault_ # simple state + + # The variable "yychar" is the lookahead token. + if (yychar < 0) { + yychar = yylex (fd, yylval) + if (yychar < 0) + yychar = 0 + } + yyn = yyn + yychar + if (yyn < 0 || yyn >= YYLAST) + goto yydefault_ + + yyn = yyact[yyn+1] + if (yychk[yyn+1] == yychar) { # valid shift + yychar = -1 + YYMOVE (yylval, yyval) + yystate = yyn + if (yyerrflag > 0) + yyerrflag = yyerrflag - 1 + goto yystack_ + } + +yydefault_ + # Default state action. + + yyn = yydef[yystate+1] + if (yyn == -2) { + if (yychar < 0) { + yychar = yylex (fd, yylval) + if (yychar < 0) + yychar = 0 + } + + # Look through exception table. + yyxi = 1 + while ((yyexca[yyxi] != (-1)) || (yyexca[yyxi+1] != yystate)) + yyxi = yyxi + 2 + for (yyxi=yyxi+2; yyexca[yyxi] >= 0; yyxi=yyxi+2) { + if (yyexca[yyxi] == yychar) + break + } + + yyn = yyexca[yyxi+1] + if (yyn < 0) { + call sfree (yysp) + return (OK) # ACCEPT -- all done + } + } + + + # SYNTAX ERROR -- resume parsing if possible. + + if (yyn == 0) { + switch (yyerrflag) { + case 0, 1, 2: + if (yyerrflag == 0) { # brand new error + call eprintf ("syntax error\n") +yyerrlab_ + yynerrs = yynerrs + 1 + # fall through... + } + + # case 1: + # case 2: incompletely recovered error ... try again + yyerrflag = 3 + + # Find a state where "error" is a legal shift action. + while (yyps >= 1) { + yyn = yypact[yys[yyps]+1] + YYERRCODE + if ((yyn >= 0) && (yyn < YYLAST) && + (yychk[yyact[yyn+1]+1] == YYERRCODE)) { + # Simulate a shift of "error". + yystate = yyact[yyn+1] + goto yystack_ + } + yyn = yypact[yys[yyps]+1] + + # The current yyps has no shift on "error", pop stack. + if (yydebug) { + call printf ("error recovery pops state %d, ") + call pargs (yys[yyps]) + call printf ("uncovers %d\n") + call pargs (yys[yyps-1]) + } + yyps = yyps - 1 + yypv = yypv - YYOPLEN + } + + # ABORT -- There is no state on the stack with an error shift. +yyabort_ + call sfree (yysp) + return (ERR) + + + case 3: # No shift yet; clobber input char. + + if (yydebug) { + call printf ("error recovery discards char %d\n") + call pargi (yychar) + } + + if (yychar == 0) + goto yyabort_ # don't discard EOF, quit + yychar = -1 + goto yynewstate_ # try again in the same state + } + } + + + # REDUCE -- Reduction by production yyn. + + if (yydebug) { + call printf ("reduce %d\n") + call pargs (yyn) + } + yyps = yyps - yyr2[yyn+1] + yypvt = yypv + yypv = yypv - yyr2[yyn+1] * YYOPLEN + YYMOVE (yypv + YYOPLEN, yyval) + yym = yyn + + # Consult goto table to find next state. + yyn = yyr1[yyn+1] + yyj = yypgo[yyn+1] + yys[yyps] + 1 + if (yyj >= YYLAST) + yystate = yyact[yypgo[yyn+1]+1] + else { + yystate = yyact[yyj+1] + if (yychk[yystate+1] != -yyn) + yystate = yyact[yypgo[yyn+1]+1] + } + + # Perform action associated with the grammar rule, if any. + switch (yym) { + +case 1: +# line 34 "trsopen.y" +{ + # Normal exit. Code a stop instruction. + Memi[yyval] = trsaddnode (YDONE, Memi[yypvt-YYOPLEN], NULL) + return (Memi[yyval]) + } +case 2: +# line 39 "trsopen.y" +{ + # Parser error + return (NULL) + } +case 3: +# line 44 "trsopen.y" +{ + # Empty filter + Memi[yyval] = NULL + } +case 4: +# line 48 "trsopen.y" +{ + # Parentheses for grouping + Memi[yyval] = Memi[yypvt-YYOPLEN] + } +case 5: +# line 52 "trsopen.y" +{ + # And instruction + Memi[yyval] = trsaddnode (YAND, Memi[yypvt-2*YYOPLEN], Memi[yypvt]) + } +case 6: +# line 56 "trsopen.y" +{ + # And instruction + Memi[yyval] = trsaddnode (YAND, Memi[yypvt-2*YYOPLEN], Memi[yypvt]) + } +case 7: +# line 60 "trsopen.y" +{ + # Not instruction + Memi[yyval] = trsaddnode (YNOT, Memi[yypvt], NULL) + } +case 8: +# line 64 "trsopen.y" +{ + # Filter with singleton range + if (! trscnum (Memi[yypvt-2*YYOPLEN], cptr)) { + call strcpy (badcol, Memc[errbuf], SZ_LINE) + return (NULL) + } + + Memi[yyval] = trsaddnode (YRANGE, Memi[yypvt], -cptr) + } +case 9: +# line 73 "trsopen.y" +{ + # Filter with singleton range + if (! trscname (Memi[yypvt-2*YYOPLEN], cptr)) { + call strcpy (badcol, Memc[errbuf], SZ_LINE) + return (NULL) + } + Memi[yyval] = trsaddnode (YRANGE, Memi[yypvt], -cptr) + } +case 10: +# line 82 "trsopen.y" +{ + # Parentheses for grouping + Memi[yyval] = Memi[yypvt-YYOPLEN] + } +case 11: +# line 86 "trsopen.y" +{ + # Or instruction + Memi[yyval] = trsaddnode (YOR, Memi[yypvt-2*YYOPLEN], Memi[yypvt]) + } +case 12: +# line 90 "trsopen.y" +{ + # Not instruction + Memi[yyval] = trsaddnode (YNOT, Memi[yypvt], NULL) + } +case 13: +# line 94 "trsopen.y" +{ + # Numeric equality instruction + Memi[yyval] = trsaddnode (YEQN, -Memi[yypvt], NULL) + } +case 14: +# line 98 "trsopen.y" +{ + # String equality instruction + Memi[yyval] = trsaddnode (YEQS, -Memi[yypvt], NULL) + } +case 15: +# line 102 "trsopen.y" +{ + # Numeric less than or equal instruction + Memi[yyval] = trsaddnode (YLEN, -Memi[yypvt], NULL) + } +case 16: +# line 106 "trsopen.y" +{ + # String less than or equal instruction + Memi[yyval] = trsaddnode (YLES, -Memi[yypvt], NULL) + } +case 17: +# line 110 "trsopen.y" +{ + # Numeric inside instruction + Memi[yyval] = trsaddnode (YINN, -Memi[yypvt-2*YYOPLEN], -Memi[yypvt]) + } +case 18: +# line 114 "trsopen.y" +{ + # String inside instruction + Memi[yyval] = trsaddnode (YINS, -Memi[yypvt-2*YYOPLEN], -Memi[yypvt]) + } +case 19: +# line 118 "trsopen.y" +{ + # Numeric greater than or equal instruction + Memi[yyval] = trsaddnode (YGEN, -Memi[yypvt-YYOPLEN], NULL) + } +case 20: +# line 122 "trsopen.y" +{ + # Numeric greater than or equal instruction + Memi[yyval] = trsaddnode (YGES, -Memi[yypvt-YYOPLEN], NULL) + } +case 21: +# line 126 "trsopen.y" +{ + # Bit mask instruction + Memi[yyval] = trsaddnode (YMSK, -Memi[yypvt], NULL) + } } + + goto yystack_ # stack new state and value +end diff --git a/pkg/tbtables/selector/trsopen.y b/pkg/tbtables/selector/trsopen.y new file mode 100644 index 00000000..6e6e9c17 --- /dev/null +++ b/pkg/tbtables/selector/trsopen.y @@ -0,0 +1,601 @@ +%{ +include "trs.h" + +#* HISTORY * +#* B.Simon 04-Nov-94 original +#* B.Simon 23-Dec-97 row optimization added + +define YYMAXDEPTH 64 +define YYOPLEN 1 +define yyparse trsparse + +%L +include "trsopen.com" + +int cptr + +errchk trslex, trsaddnode +bool trscname(), trscnum() +pointer trsaddnode + +string badcol "column not found" + +%} + +%token YNIL, YBANG, YCOMMA, YCOLON, YEQUAL, YERR, YEOF +%token YLPAR, YINC, YNUM, YPER, YRPAR, YSEMI, YSTR + +%left YSEMI, YCOMMA +%nonassoc YEQUAL +%right YBANG + +%% + +expr : filter YEOF { + # Normal exit. Code a stop instruction. + Memi[$$] = trsaddnode (YDONE, Memi[$1], NULL) + return (Memi[$$]) + } + | error { + # Parser error + return (NULL) + } + ; +filter : { + # Empty filter + Memi[$$] = NULL + } + | YLPAR filter YRPAR { + # Parentheses for grouping + Memi[$$] = Memi[$2] + } + | filter YCOMMA filter { + # And instruction + Memi[$$] = trsaddnode (YAND, Memi[$1], Memi[$3]) + } + | filter YSEMI filter { + # And instruction + Memi[$$] = trsaddnode (YAND, Memi[$1], Memi[$3]) + } + | YBANG filter { + # Not instruction + Memi[$$] = trsaddnode (YNOT, Memi[$2], NULL) + } + | YNUM YEQUAL range { + # Filter with singleton range + if (! trscnum (Memi[$1], cptr)) { + call strcpy (badcol, Memc[errbuf], SZ_LINE) + return (NULL) + } + + Memi[$$] = trsaddnode (YRANGE, Memi[$3], -cptr) + } + | YSTR YEQUAL range { + # Filter with singleton range + if (! trscname (Memi[$1], cptr)) { + call strcpy (badcol, Memc[errbuf], SZ_LINE) + return (NULL) + } + Memi[$$] = trsaddnode (YRANGE, Memi[$3], -cptr) + } + ; +range : YLPAR range YRPAR { + # Parentheses for grouping + Memi[$$] = Memi[$2] + } + | range YCOMMA range { + # Or instruction + Memi[$$] = trsaddnode (YOR, Memi[$1], Memi[$3]) + } + | YBANG range { + # Not instruction + Memi[$$] = trsaddnode (YNOT, Memi[$2], NULL) + } + | YNUM { + # Numeric equality instruction + Memi[$$] = trsaddnode (YEQN, -Memi[$1], NULL) + } + | YSTR { + # String equality instruction + Memi[$$] = trsaddnode (YEQS, -Memi[$1], NULL) + } + | YCOLON YNUM { + # Numeric less than or equal instruction + Memi[$$] = trsaddnode (YLEN, -Memi[$2], NULL) + } + | YCOLON YSTR { + # String less than or equal instruction + Memi[$$] = trsaddnode (YLES, -Memi[$2], NULL) + } + | YNUM YCOLON YNUM { + # Numeric inside instruction + Memi[$$] = trsaddnode (YINN, -Memi[$1], -Memi[$3]) + } + | YSTR YCOLON YSTR { + # String inside instruction + Memi[$$] = trsaddnode (YINS, -Memi[$1], -Memi[$3]) + } + | YNUM YCOLON { + # Numeric greater than or equal instruction + Memi[$$] = trsaddnode (YGEN, -Memi[$1], NULL) + } + | YSTR YCOLON { + # Numeric greater than or equal instruction + Memi[$$] = trsaddnode (YGES, -Memi[$1], NULL) + } + | YPER YNUM { + # Bit mask instruction + Memi[$$] = trsaddnode (YMSK, -Memi[$2], NULL) + } + ; +%% + +# TRSOPEN -- Compile a table row selection expression + +pointer procedure trsopen (tp, expr) + +pointer tp # i: table descriptor +char expr[ARB] # i: expression to be parsed +#-- +include "trsopen.com" + +char nil +int fd, jtop +bool debug +pointer sp, root + +data nil / EOS / +data debug / false / +string syntax "syntax error" + +errchk stropen, trsparse, trserr, trsgencode + +int trslex() +extern trslex +pointer trsinit(), trsparse() +int stropen(), strlen() + +begin + # Initialize common block used by parser + + tabptr = tp + + call smark (sp) + call salloc (tokbuf, SZ_TOKEN, TY_CHAR) + call salloc (errbuf, SZ_LINE, TY_CHAR) + call salloc (treebuf, SZ_BUFFER, TY_INT) + + call amovkc (nil, Memc[tokbuf], SZ_TOKEN) + call strcpy (syntax, Memc[errbuf], SZ_LINE) + + itree = 0 + itop = 0 + itok = 0 + ival = 0 + + # Convert expression to pseudocode + + fd = stropen (expr, strlen(expr), READ_ONLY) + pcode = trsinit () + + root = trsparse (fd, debug, trslex) + if (root != NULL) { + call trsgencode (tp, root, pcode) + + } else { + # Error exit: free memory and close open files + + do jtop = 1, itop + call close (stack[jtop]) + call close (fd) + + call trserr + } + + # Free memory and close files + + call close (fd) + call sfree (sp) + return (pcode) +end + +# TRSADDNODE -- Add a node to the binary tree + +pointer procedure trsaddnode (oper, lfield, rfield) + +int oper # i: pseudocode operation +pointer lfield # i: left field of operation +pointer rfield # i: right field of operation +#-- +include "trsopen.com" + +pointer ptr + +string noroom "Table row selection expression too complex" + +begin + if (itree >= SZ_BUFFER) + call error (1, noroom) + + ptr = treebuf + itree + + TREE_OPER(ptr) = oper + TREE_INST(ptr) = ERR + TREE_LEFT(ptr) = lfield + TREE_RIGHT(ptr) = rfield + TREE_UP(ptr) = NULL + + if (lfield > 0) + TREE_UP(lfield) = ptr + + if (rfield > 0) + TREE_UP(rfield) = ptr + + itree = itree + SZ_NODE + return (ptr) +end + +# TRSCNAME -- Retrieve a column pointer, given its name + +bool procedure trscname (cname, cptr) + +pointer cname # i: column name +pointer cptr # o: column pointer +#-- +include "trsopen.com" + +bool streq() + +begin + call tbcfnd (tabptr, Memc[cname], cptr, 1) + + # "row" is a special filter indicating column number + + if (cptr == NULL) { + return (streq (Memc[cname], "row")) + } else { + return (true) + } + +end + +# TRSCNUM -- Retrieve a column pointer, given its number + +bool procedure trscnum (cnum, cptr) + +pointer cnum # i: column number +pointer cptr # o: column pointer +#-- +include "trsopen.com" + +int col +pointer tbcnum() + +begin + col = Memd[cnum] + cptr = tbcnum (tabptr, col) + + return (cptr != NULL) +end + +# TRSERR -- Print error message from table row selector parser + +procedure trserr + +#-- +include "trsopen.com" + +int nc +pointer sp, token, errmsg + +string errfmt "Error in table row selector, %s. Last read: %s\n" + +begin + # Allocate memory to hold token + + call smark (sp) + call salloc (token, SZ_TOKEN, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Copy token from token buffer. Since token buffer is maintained + # as a queue, the copy is in two parts, after and before the + # queue pointer. + + nc = 0 + if (Memc[tokbuf+itok] != EOS) { + nc = SZ_TOKEN - itok + call amovc (Memc[tokbuf+itok], Memc[token], nc) + } + + itok = mod (itok - 1, SZ_TOKEN) + call amovc (Memc[tokbuf], Memc[token+nc], itok) + + nc = nc + itok + Memc[token+nc] = EOS + + # Exit with error message + + call sprintf (Memc[errmsg], SZ_LINE, errfmt) + call pargstr (Memc[errbuf]) + call pargstr (Memc[token]) + + call error (1, Memc[errmsg]) + call sfree (sp) +end + +# TRSINIT -- Allocate and intialize the trs pseudocode data structure + +pointer procedure trsinit () + +#-- +pointer buf + +begin + call malloc (buf, LEN_TRSBUF, TY_INT) + + TRS_IDENT(buf) = TRS_MAGIC + TRS_ROWS(buf) = NULL + + call malloc (TRS_CODE(buf), SZ_BUFFER, TY_INT) + call malloc (TRS_VALUE(buf), SZ_BUFFER, TY_DOUBLE) + + return (buf) +end + +# TRSLEX -- Lexical analyzer for table row selector + +int procedure trslex (fd, value) + +int fd # u: file descriptor of currently open file +pointer value # i: Pointer to current token value +#-- +include "trsopen.com" + +int type + +string badfile "bad file name" +string maxfile "files nested too deep" + +errchk open +int open() + +begin + # This procedure sits on top of the procedure that fetches + # the next token and handles file openings and closings + + type = YNIL + while (type == YNIL) { + call trstok (fd, value, type) + + if (type == YEOF) { + # End of file token. Pop deferred file off of stack + # if no deferred file, return end of file token + + if (itop != 0) { + call amovkc (EOS, Memc[tokbuf], SZ_TOKEN) + itok = 0 + + call close (fd) + fd = stack[itop] + itop = itop - 1 + type = YNIL + } + + } else if (type == YINC) { + # Include file token. Next token should be file name + # Push current file descriptor on deferred file stack + # and open new file + + call trstok (fd, value, type) + + if (type != YSTR) { + call strcpy (badfile, Memc[errbuf], SZ_LINE) + type = YERR + + } else if (itop == MAXSTACK) { + call strcpy (maxfile, Memc[errbuf], SZ_LINE) + type = YERR + + } else { + itop = itop + 1 + stack[itop] = fd + + ifnoerr { + fd = open (Memc[Memi[value]], READ_ONLY, TEXT_FILE) + } then { + call amovkc (EOS, Memc[tokbuf], SZ_TOKEN) + itok = 0 + type = YNIL + + } else { + fd = stack[itop] + itop = itop - 1 + + call strcpy (badfile, Memc[errbuf], SZ_LINE) + type = YERR + } + } + } + } + + return (type) +end + +# TRSNEXTCH -- Read next character from input stram, save in buffer + +int procedure trsnextch (fd, ch) + +int fd # i: input file descriptor +char ch # o: character read from input +#-- +include "trsopen.com" + +int getc() + +begin + Memc[tokbuf+itok] = getc (fd, ch) + itok = mod (itok+1, SZ_TOKEN) + + return (ch) +end + +# TRSTOK -- Read next token from current file + +procedure trstok (fd, value, type) + +int fd # u: file descriptor of currently open file +pointer value # i: Pointer to current token value +int type # i: Token type +#-- +include "trsopen.com" + +char ch, stop +double dval +int stoptype[10] +int nc, ic, index, delta, size + +pointer sp, token, ptr, valbuf + +string notnum "not a number" +string noroom "expression too complex" +string nostop "trailing quote not found" + +string stopset " ,;:%=!()@" + +data stoptype / YNIL, YCOMMA, YSEMI, YCOLON, YPER, + YEQUAL, YBANG, YLPAR, YRPAR, YINC / + +int trsnextch(),trstrim(), stridx(), ctod() + +begin + # Eat leading whitespace, watch for end of file + + while (trsnextch (fd, ch) <= ' ') { + if (ch == EOF) { + Memi[value] = NULL + type = YEOF + return + } + + } + + # Check if first character is a delimeter + # if so, return the corresponding token + + index = stridx (ch, stopset) + if (index > 0) { + Memi[value] = NULL + type = stoptype[index] + return + } + + # The tougher case: token is a number or string + # First, gather all characters in token + + call smark (sp) + call salloc (token, SZ_LINE, TY_CHAR) + + if (ch == '\'' || ch == '"') { + # First case: token is a quoted string + # gather characters until matching quote is found + + nc = 0 + stop = ch + + while (trsnextch (fd, ch) != EOF) { + if (ch == stop) + break + + Memc[token+nc] = ch + nc = nc + 1 + } + + # Handle situation where trailing quote is missing + + if (ch == EOF) { + call strcpy (nostop, Memc[errbuf], SZ_LINE) + Memi[value] = NULL + type = YERR + + call sfree (sp) + return + } + + } else { + # Second case: no quotes + # gather characters until delimeter or whitespace + + nc = 1 + Memc[token] = ch + stop = ' ' + + while (trsnextch (fd, ch) != EOF) { + if (ch < ' ') + ch = ' ' + + if (stridx (ch, stopset) > 0) { + itok = itok - 1 + if (itok < 0) + itok = SZ_TOKEN - 1 + + call ungetc (fd, ch) + break + } + + Memc[token+nc] = ch + nc = nc + 1 + } + } + + Memc[token+nc] = EOS + nc = trstrim (Memc[token]) + + ic = 1 + valbuf = TRS_VALUE(pcode) + + if (stop == ' ' && ctod (Memc[token], ic, dval) == nc) { + # Token is a number. Convert it to a double + # and store in the value buffer + + if (ival + 1 >= SZ_BUFFER) { + call strcpy (noroom, Memc[errbuf], SZ_LINE) + Memi[value] = NULL + type = YERR + + } else { + ptr = valbuf + ival + ival = ival + 1 + + Memd[ptr] = dval + Memi[value] = ptr + type = YNUM + } + + } else { + # Token is a string. Find how much space it will take + # and store in the value buffer + + size = nc + 1 + delta = mod (size, SZ_DOUBLE) + if (delta != 0) + size = size + (SZ_DOUBLE - delta) + size = size / SZ_DOUBLE + + if (ival + size >= SZ_BUFFER) { + call strcpy (noroom, Memc[errbuf], SZ_LINE) + Memi[value] = NULL + type = YERR + + } else { + ptr = ((valbuf + ival - 1) * SZ_DOUBLE) + 1 + ival = ival + size + + call strcpy (Memc[token], Memc[ptr], size*SZ_DOUBLE-1) + Memi[value] = ptr + type = YSTR + } + } + + call sfree (sp) +end + diff --git a/pkg/tbtables/selector/trsrows.x b/pkg/tbtables/selector/trsrows.x new file mode 100644 index 00000000..64fc9395 --- /dev/null +++ b/pkg/tbtables/selector/trsrows.x @@ -0,0 +1,99 @@ +include "trs.h" + +.help --------------------------------------------------------------------- + +TRSROWS -- Return a set of rows for which an expression is true + +This procedure evalutes a row selection expression and returns a set +containing the row numbers for which the expression is true. The set +can be accessed and maniputlauted using the functions in rst.x, which +are further described in the help block in that file. One example of +how to use this function is: + +.nf + set = trsrows (tp, expr) + nset = rst_nelem (set) + do iset = 1, nset { + irow = rst_rownum (set, iset) + # do something with the row here + } + call rst_free (set) +.fi + +In the above example, we create the set, query to get the number of +rows in the set, and then access the rows in sequential order. This +approach is useful when it is necessary to determine the number of +rows matched before doing any processing, so that one can allocate +arrays or take error actions based on the number of rows returned. If +neither of these is necessary, one can alternatively use a repeat +loop. + +.nf + set = trsrows (tp, expr) + iset = 1 + repeat { + irow = rst_rownum (set, iset) + if (irow == 0) + break + # do something with the row here + iset = iset + 1 + } + call rst_free (set) +.fi + +The loop ends because rst_rownum returns zero when asked for an +element less than one or greater than the number of rows in the set. +While both of these examples access the set sequentially, rst_rownum +also supports random access. + +.endhelp ------------------------------------------------------------------ + +pointer procedure trsrows (tp, expr) + +pointer tp # i: table descriptor +char expr[ARB] # i: expression to be evaluated +#-- +int iset, irow +pointer pcode, code, set + +bool trscalc() +int rst_rownum() +pointer trsopen(), rst_copy(), rst_create() +errchk trsopen, trscalc, trsclose + +begin + # Compile the expression into pseudocode + + pcode = trsopen (tp, expr) + + # If the code is a null program, just return the set, otherwise + # calculate the result for each element in the set + + code = TRS_CODE (pcode) + if (Memi[code] == YDONE) { + set = rst_copy (TRS_ROWS(pcode)) + + } else { + # Start with an empty set. Calculate the result for each + # element in the row set and if true, add it to the output set + + set = rst_create (0, 0) + + iset = 1 + repeat { + irow = rst_rownum (TRS_ROWS(pcode), iset) + if (irow == 0) + break + + if (trscalc (tp, irow, code)) + call rst_addval (set, irow) + + iset = iset + 1 + } + } + + # Release the pseudocode structure, return the set + + call trsclose (pcode) + return (set) +end diff --git a/pkg/tbtables/selector/trstree.x b/pkg/tbtables/selector/trstree.x new file mode 100644 index 00000000..d52b08e4 --- /dev/null +++ b/pkg/tbtables/selector/trstree.x @@ -0,0 +1,211 @@ +include "trs.h" + +#* HISTORY * +#* B.Simon 02-Jan-98 original + +# This tree traversal code assumes the tree has links to the left and right +# subtrees, as well as a link to the parent node. The parent node of the root +# node is NULL. Leaf nodes contain pointers to other information. To +# distinguish these pointers from tree links, the pointers are negative +# numbers. All procedures are non-recursive as SPP does not support recursion. +# The tree contains information parsed from the row selection expression. +# It is used as an intermediate data structure for optimization before +# the information is converted to pseudocode instructions. + +# TRS_COL_TREE -- Retrieve column pointer from range node above it in the tree + +pointer procedure trs_col_tree (current) + +pointer current # i: current node in tree +#-- +pointer col, node + +begin + col = NULL + node = current + + while (node != NULL) { + if (TREE_OPER(node) == YRANGE) { + col = - TREE_RIGHT(node) + break + } + + node = TREE_UP(node) + } + + return (col) +end + +# TRS_FIRST_TREE -- Get first (deepest leftmost) node in binary tree + +pointer procedure trs_first_tree (root) + +pointer root # i: root of binary tree +#-- +pointer node + +begin + node = root + + repeat { + while (TREE_LEFT(node) > 0) + node = TREE_LEFT(node) + + if (TREE_RIGHT(node) <= 0) + break + + node = TREE_RIGHT(node) + } + + return (node) +end + +# TRS_NEXT_TREE -- Get next node in binary tree in postfix order + +# After looking at the left subtree, look at the leftmost node of the right +# subtree. After looking at the right subtree, look at its immediate parent +# The root node has an UP node of NULL, which signals an end to the traverse + +pointer procedure trs_next_tree (current) + +pointer current # i: currently visited node +#-- +pointer node + +begin + node = TREE_UP(current) + + if (node > 0) { + # right nodes only need to back up one + # left nodes need to get right subtree + + if (current == TREE_LEFT(node)) { + if (TREE_RIGHT(node) > 0) { + + # Get right node of parent + node = TREE_RIGHT(node) + + # Get deepest leftmost subtree + repeat { + while (TREE_LEFT(node) > 0) + node = TREE_LEFT(node) + + if (TREE_RIGHT(node) <= 0) + break + + node = TREE_RIGHT(node) + } + } + } + } + + return (node) +end + +# TRS_OVER_TREE -- Determine if current node is over a row range node + +bool procedure trs_over_tree (current) + +pointer current # i: node to be checked +#-- +bool over +pointer node + +pointer trs_first_tree(), trs_next_tree() + +begin + over = false + node = trs_first_tree (current) + + while (node != TREE_UP(current)) { + if (TREE_OPER(node) == YRANGE && TREE_RIGHT(node) == NULL) { + over = true + break + } + + node = trs_next_tree (node) + } + + return (over) +end + +# TRS_SNIP_TREE -- Remove node and its children from the binary tree + +procedure trs_snip_tree (current) + +pointer current # i: currently visited node +#-- +pointer node + +string badlink "trs_snip_tree: bad links in binary tree" + +begin + node = TREE_UP(current) + TREE_UP(current) = NULL + + if (TREE_LEFT(node) == current) { + TREE_LEFT(node) = NULL + } else if (TREE_RIGHT(node) == current) { + TREE_RIGHT(node) = NULL + } else { + call error (1, badlink) + } + +end + +# TRS_UNDER_TREE -- Determine if current node is under a row range node + +bool procedure trs_under_tree (current) + +pointer current # i: node to be checked +#-- +bool under +pointer node + +begin + under = false + node = TREE_UP(current) + + while (node != NULL) { + if (TREE_OPER(node) == YRANGE && TREE_RIGHT(node) == NULL) { + under = true + break + } + + node = TREE_UP(node) + } + + return (under) +end + +# TRS_XCG_TREE -- Exchange position of node with its parent in binary tree + +procedure trs_xcg_tree (current) + +pointer current # i: node to be exchanged +#-- +pointer child, parent, grandparent + +string badlink "trs_xcg_tree: bad links in binary tree" + +begin + child = TREE_LEFT(current) + parent = TREE_UP(current) + grandparent = TREE_UP(parent) + + if (TREE_LEFT(grandparent) == parent) { + TREE_LEFT(grandparent) = current + } else if (TREE_RIGHT(grandparent) == parent) { + TREE_RIGHT(grandparent) = current + } else { + call error (1, badlink) + } + + TREE_LEFT(parent) = TREE_LEFT(current) + TREE_UP(parent) = current + + TREE_LEFT(current) = parent + TREE_UP(current) = grandparent + + TREE_UP(child) = parent +end diff --git a/pkg/tbtables/selector/trstrim.x b/pkg/tbtables/selector/trstrim.x new file mode 100644 index 00000000..dfcf9d55 --- /dev/null +++ b/pkg/tbtables/selector/trstrim.x @@ -0,0 +1,54 @@ +define BLANK ' ' + +#* HISTORY * +#* B.Simon 24-Jul-92 Original +#* B.Simon 17-Dec-97 Copied from old cdbs for use in row selector + +# This procedure removes leading and trailing whitespace and compresses +# interior whitepace to a single blank. Whitespace is defined to be any +# character with an ascii value less than or equal to that of the blank. +# + +# TRSTRIM -- Remove non-significant whitespace from string + +int procedure trstrim (str) + +char str[ARB] # u: String to be modified +#-- +bool flag +int ic, jc + +begin + # Initialize flag to true so that leading blanks are skipped + + jc = 1 + flag = true + + # Convert control characters to blanks, skip multiple blanks + + for (ic = 1; str[ic] != EOS; ic = ic + 1) { + + if (str[ic] > BLANK) { + flag = false + if (jc < ic) + str[jc] = str[ic] + jc = jc + 1 + + } else { + if (! flag) { + flag = true + str[jc] = ' ' + jc = jc + 1 + } + } + } + + # Remove trailing blanks + + if (flag && jc > 1) + jc = jc - 1 + + str[jc] = EOS + return (jc - 1) + +end diff --git a/pkg/tbtables/selector/whatfile.h b/pkg/tbtables/selector/whatfile.h new file mode 100644 index 00000000..b8691739 --- /dev/null +++ b/pkg/tbtables/selector/whatfile.h @@ -0,0 +1,6 @@ +# WHATFILE.H -- Symbolic constants representing file types + +define IS_UNKNOWN 0 +define IS_IMAGE 1 +define IS_TABLE 2 + diff --git a/pkg/tbtables/selector/whatfile.x b/pkg/tbtables/selector/whatfile.x new file mode 100644 index 00000000..cc03cd77 --- /dev/null +++ b/pkg/tbtables/selector/whatfile.x @@ -0,0 +1,63 @@ +include +include "whatfile.h" + +# WHATFILE -- Return integer code indicating type of image +# +# B. Simon, Original. +# Phil Hodge, 22-Feb-2002 Use tbtacc instead of tbtopn to test for a table. +# Phil Hodge, 19-Sep-2002 Simplify is_image(), just use tbtacc or imaccess. + + +int procedure whatfile (file) + +char file[ARB] # i: file name +#-- +int flag + +int is_image() + +begin + # This function exists mostly for backwards compatibility. + # The recommended function to use is is_image, as it does + # not need special macros + + switch (is_image(file)) { + case ERR: + flag = IS_UNKNOWN + case NO: + flag = IS_TABLE + case YES: + flag = IS_IMAGE + } + + return (flag) +end + +# IS_IMAGE -- Return YES if file is image, NO if table, and ERR if can't decide +# +# Note that a function value of NO does not just mean that the file is not +# an image, it means that it _is_ a table. Note also that while a FITS +# primary header or IMAGE extension can be opened as a table (for access +# to the header), tbtacc will return NO for such an extension. +# +# The 'file' argument to this function should be the complete image or +# table name, i.e. including FITS extension number or name, or STF group +# number. + +int procedure is_image (file) + +char file[ARB] # i: file name +#-- +int image +int imaccess(), tbtacc() + +begin + if (tbtacc (file) == YES) + image = NO + else if (imaccess (file, READ_ONLY) == YES) + image = YES + else + image = ERR + + return image +end diff --git a/pkg/tbtables/tbagt.x b/pkg/tbtables/tbagt.x new file mode 100644 index 00000000..1f54557b --- /dev/null +++ b/pkg/tbtables/tbagt.x @@ -0,0 +1,238 @@ +include # for MAX_INT and MAX_SHORT +include +include "tbtables.h" + +# tbagt[tbirds] -- get an array of values +# +# Phil Hodge, 12-Sep-1994 Subroutines created. +# Phil Hodge, 9-Jun-1995 Modify for FITS tables. +# Phil Hodge, 2-Mar-1998 Map selected row number to actual row number. + +int procedure tbagtd (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +double buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int row # actual row number +int nret # actual number of elements read +int tbxagd(), tbfagd() +errchk tbsirow, tbegtd, tbfagd, tbxagd + +begin + if (selrow < 1 || first < 1) + call error (1, "tbagtd: invalid row or element number") + + if (nelem < 1) + return (0) + + if (first == 1 && nelem == 1) { + call tbegtd (tp, cp, selrow, buffer) + return (1) + } + + call tbsirow (tp, selrow, row) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + nret = tbxagd (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + nret = tbfagd (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't read an array from this type of table") + + return (nret) +end + +int procedure tbagtr (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +real buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int row # actual row number +int nret # actual number of elements read +int tbxagr(), tbfagr() +errchk tbsirow, tbegtr, tbfagr, tbxagr, tbxagr + +begin + if (selrow < 1 || first < 1) + call error (1, "tbagtr: invalid row or element number") + + if (nelem < 1) + return (0) + + if (first == 1 && nelem == 1) { + call tbegtr (tp, cp, selrow, buffer) + return (1) + } + + call tbsirow (tp, selrow, row) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + nret = tbxagr (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + nret = tbfagr (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't read an array from this type of table") + + return (nret) +end + +int procedure tbagti (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +int buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int row # actual row number +int nret # actual number of elements read +int tbxagi(), tbfagi() +errchk tbsirow, tbegti, tbfagi, tbxagi + +begin + if (selrow < 1 || first < 1) + call error (1, "tbagti: invalid row or element number") + + if (nelem < 1) + return (0) + + if (first == 1 && nelem == 1) { + call tbegti (tp, cp, selrow, buffer) + return (1) + } + + call tbsirow (tp, selrow, row) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + nret = tbxagi (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + nret = tbfagi (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't read an array from this type of table") + + return (nret) +end + +int procedure tbagts (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +short buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int row # actual row number +int nret # actual number of elements read +int tbxags(), tbfags() +errchk tbsirow, tbegts, tbfags, tbxags + +begin + if (selrow < 1 || first < 1) + call error (1, "tbagts: invalid row or element number") + + if (nelem < 1) + return (0) + + if (first == 1 && nelem == 1) { + call tbegts (tp, cp, selrow, buffer) + return (1) + } + + call tbsirow (tp, selrow, row) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + nret = tbxags (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + nret = tbfags (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't read an array from this type of table") + + return (nret) +end + +int procedure tbagtb (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +bool buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int row # actual row number +int nret # actual number of elements read +int tbxagb(), tbfagb() +errchk tbsirow, tbegtb, tbfagb, tbxagb + +begin + if (selrow < 1 || first < 1) + call error (1, "tbagtb: invalid row or element number") + + if (nelem < 1) + return (0) + + if (first == 1 && nelem == 1) { + call tbegtb (tp, cp, selrow, buffer) + return (1) + } + + call tbsirow (tp, selrow, row) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + nret = tbxagb (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + nret = tbfagb (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't read an array from this type of table") + + return (nret) +end + +int procedure tbagtt (tp, cp, selrow, cbuf, maxch, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +char cbuf[maxch,ARB] # o: values read from table +int maxch # i: size of first dimension of cbuf +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int row # actual row number +int nret # actual number of elements read +int tbxagt(), tbfagt() +errchk tbsirow, tbegtt, tbfagt, tbxagt + +begin + if (selrow < 1 || first < 1) + call error (1, "tbagtt: invalid row or element number") + + if (nelem < 1) + return (0) + + if (first == 1 && nelem == 1) { + call tbegtt (tp, cp, selrow, cbuf, maxch) + return (1) + } + + call tbsirow (tp, selrow, row) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + nret = tbxagt (tp, cp, row, cbuf, maxch, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + nret = tbfagt (tp, cp, row, cbuf, maxch, first, nelem) + else + call error (1, "can't read an array from this type of table") + + return (nret) +end diff --git a/pkg/tbtables/tbapt.x b/pkg/tbtables/tbapt.x new file mode 100644 index 00000000..3c30b1db --- /dev/null +++ b/pkg/tbtables/tbapt.x @@ -0,0 +1,214 @@ +include +include "tbtables.h" + +# tbapt[tbirds] -- put an array of values +# +# Phil Hodge, 12-Sep-1994 Subroutines created. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 14-Jun-1995 Modify for FITS tables. +# Phil Hodge, 3-Mar-1998 Call tbswer1, to allow for row selector. + +procedure tbaptd (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +double buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: number of elements to write +#-- +int row # actual row number +errchk tbeptd, tbfapd, tbswer1, tbxapd, tbwapd + +begin + if (selrow < 1 || first < 1) + call error (1, "tbaptd: invalid row or element number") + + if (nelem < 1) + return + + if (first == 1 && nelem == 1) { + call tbeptd (tp, cp, selrow, buffer) + } else { + call tbswer1 (tp, selrow, row) + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxapd (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfapd (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't write an array to this type of table") + } + + TB_MODIFIED(tp) = true +end + +procedure tbaptr (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +real buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: number of elements to write +#-- +int row # actual row number +errchk tbeptr, tbfapr, tbswer1, tbxapr, tbwapr + +begin + if (selrow < 1 || first < 1) + call error (1, "tbaptr: invalid row or element number") + + if (nelem < 1) + return + + if (first == 1 && nelem == 1) { + call tbeptr (tp, cp, selrow, buffer) + } else { + call tbswer1 (tp, selrow, row) + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxapr (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfapr (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't write an array to this type of table") + } + + TB_MODIFIED(tp) = true +end + +procedure tbapti (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +int buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: number of elements to write +#-- +int row # actual row number +errchk tbepti, tbfapi, tbswer1, tbxapi, tbwapi + +begin + if (selrow < 1 || first < 1) + call error (1, "tbapti: invalid row or element number") + + if (nelem < 1) + return + + if (first == 1 && nelem == 1) { + call tbepti (tp, cp, selrow, buffer) + } else { + call tbswer1 (tp, selrow, row) + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxapi (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfapi (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't write an array to this type of table") + } + + TB_MODIFIED(tp) = true +end + +procedure tbapts (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +short buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: number of elements to write +#-- +int row # actual row number +errchk tbepts, tbfaps, tbswer1, tbxaps, tbwaps + +begin + if (selrow < 1 || first < 1) + call error (1, "tbapts: invalid row or element number") + + if (nelem < 1) + return + + if (first == 1 && nelem == 1) { + call tbepts (tp, cp, selrow, buffer) + } else { + call tbswer1 (tp, selrow, row) + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxaps (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfaps (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't write an array to this type of table") + } + + TB_MODIFIED(tp) = true +end + +procedure tbaptb (tp, cp, selrow, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +bool buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: number of elements to write +#-- +int row # actual row number +errchk tbeptb, tbfapb, tbswer1, tbxapb, tbwapb + +begin + if (selrow < 1 || first < 1) + call error (1, "tbaptb: invalid row or element number") + + if (nelem < 1) + return + + if (first == 1 && nelem == 1) { + call tbeptb (tp, cp, selrow, buffer) + } else { + call tbswer1 (tp, selrow, row) + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxapb (tp, cp, row, buffer, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfapb (tp, cp, row, buffer, first, nelem) + else + call error (1, "can't write an array to this type of table") + } + + TB_MODIFIED(tp) = true +end + +procedure tbaptt (tp, cp, selrow, cbuf, maxch, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int selrow # i: row number (or selected row number) +char cbuf[maxch,ARB] # i: values to write to table +int maxch # i: size of first dimension of cbuf +int first # i: number of first array element to write +int nelem # i: number of elements to write +#-- +int row # actual row number +errchk tbeptt, tbfapt, tbswer1, tbxapt, tbwapt + +begin + if (selrow < 1 || first < 1) + call error (1, "tbaptt: invalid row or element number") + + if (nelem < 1) + return + + if (first == 1 && nelem == 1) { + call tbeptt (tp, cp, selrow, cbuf) + } else { + call tbswer1 (tp, selrow, row) + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxapt (tp, cp, row, cbuf, maxch, first, nelem) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfapt (tp, cp, row, cbuf, maxch, first, nelem) + else + call error (1, "can't write an array to this type of table") + } + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbbadf.x b/pkg/tbtables/tbbadf.x new file mode 100644 index 00000000..5f341b94 --- /dev/null +++ b/pkg/tbtables/tbbadf.x @@ -0,0 +1,47 @@ +include + +# tbbadf -- assign default format +# This procedure assigns a default print format if none was given or if +# the first character is not '%'. +# The actual arguments corresponding to colfmt and pformat may be the same. +# +# Phil Hodge, 12-Aug-1987 Lendata is now number of char in table. +# Phil Hodge, 12-Oct-1987 Change defaults for double, boolean, and string. +# Phil Hodge, 6-Mar-1989 Accept datatype < 0. +# Phil Hodge, 30-Mar-1993 Include short datatype. + +procedure tbbadf (colfmt, datatype, lendata, pformat, maxchar) + +char colfmt[ARB] # i: the print format for the column or null +int datatype # i: the SPP data type of the column +int lendata # i: storage requirement in table (unit=char) +char pformat[maxchar] # o: the print format for the column +int maxchar # i: maximum length of the string pformat +#-- +begin + if (colfmt[1] != '%') { # bad format; assign default + switch (datatype) { + case TY_REAL: + call strcpy ("%15.7g", pformat, maxchar) + case TY_DOUBLE: + call strcpy ("%25.16g", pformat, maxchar) + case TY_INT: + call strcpy ("%11d", pformat, maxchar) + case TY_BOOL: + call strcpy ("%6b", pformat, maxchar) + case TY_SHORT: + call strcpy ("%11d", pformat, maxchar) + case TY_CHAR: + pformat[1] = '%' + call sprintf (pformat[2], maxchar-1, "-%ds") + call pargi (lendata * SZB_CHAR) + default: + # datatype < 0 for character type + pformat[1] = '%' + call sprintf (pformat[2], maxchar-1, "-%ds") + call pargi (-datatype) + } + } else { # just copy it + call strcpy (colfmt, pformat, maxchar) + } +end diff --git a/pkg/tbtables/tbbaln.x b/pkg/tbtables/tbbaln.x new file mode 100644 index 00000000..cdb06ead --- /dev/null +++ b/pkg/tbtables/tbbaln.x @@ -0,0 +1,71 @@ +include # for SZB_CHAR +include +include "tbtables.h" +include "tblerr.h" + +define WIDEST_CHAR_COLUMN (SZ_LINE / SZB_CHAR * SZB_CHAR) + +# tbbaln -- assign data length +# This routine assigns a value for dlen, the number of char required +# for storing one element of type datatype in a table. This is trivial +# for numerical data types. Character strings are packed, however, and +# the allocated space is rounded up to a multiple of SZB_CHAR. +# The input datatype is given as -N for a string of length N, and the +# output dtype will be the same with dlen = N/SZB_CHAR (with N rounded up +# as required). This routine also checks that N is no larger than the +# space provided by the maximum number of SZ_CHARs that fit in SZ_LINE +# (e.g. 160 if SZ_LINE is 161 and SZB_CHAR is 2). +# The output dtype is TBL_TY_REAL if datatype is TY_REAL, etc. These +# are currently the same. +# +# Phil Hodge, 10-Aug-1987 Replace input lendata with output dtype. +# Phil Hodge, 10-Nov-1987 Include check on width of char column. +# Phil Hodge, 7-Mar-1989 Set dtype = TBL_TY_... (except =datatype for char) +# Phil Hodge, 30-Mar-1993 Include short datatype; allow increments of SZB_CHAR +# instead of just SZ_REAL*SZB_CHAR for character columns. + +procedure tbbaln (datatype, dtype, dlen) + +int datatype # i: data type of column +int dtype # o: table data type (= SPP except -n for char) +int dlen # o: number of char for storage in table +#-- +begin + if (datatype >= 0) { + + # Data type is a numeric or Boolean SPP data type. + switch (datatype) { + case TY_REAL: + dtype = TBL_TY_REAL + dlen = SZ_REAL + case TY_DOUBLE: + dtype = TBL_TY_DOUBLE + dlen = SZ_DOUBLE + case TY_INT: + dtype = TBL_TY_INT + dlen = SZ_INT32 + case TY_BOOL: + dtype = TBL_TY_BOOL + dlen = SZ_BOOL + case TY_SHORT: + dtype = TBL_TY_SHORT + dlen = SZ_SHORT + default: + call error (ER_TBBADTYPE, + "invalid data type for a table column") + } + } else { + + # datatype = -N implies a string of length N char. + # Check to make sure it's not too long. + if (-datatype > WIDEST_CHAR_COLUMN) + call error (ER_TBBADTYPE, + "char string column can't be that wide") + + # Round up to a multiple of SZB_CHAR; the unit for dlen + # is SZ_CHAR, even though the string will be packed. + # NOTE: no additional space is reserved for the EOS. + dlen = (-datatype + SZB_CHAR-1) / SZB_CHAR * SZ_CHAR + dtype = datatype + } +end diff --git a/pkg/tbtables/tbbcmt.x b/pkg/tbtables/tbbcmt.x new file mode 100644 index 00000000..15010291 --- /dev/null +++ b/pkg/tbtables/tbbcmt.x @@ -0,0 +1,69 @@ +include # for IS_WHITE +include "tbtables.h" +define INCR_BUFFSIZE 1024 # minimum amount by which buffer is increased + +# tbbcmt -- append comment line to buffer +# This routine takes a line of text and appends it to the comment buffer for +# the current text table. If the line of text does not begin with "#", then +# "# " will first be appended to the comment buffer. If the line is not +# terminated with a newline, a newline will be appended to the comment buffer +# after appending the line. Since each comment line ends with a newline, +# if we print (or write to a file) the full comment buffer, it should come out +# on several lines. +# If the comment buffer is not long enough it will be reallocated. + +# Phil Hodge, 6-Mar-1992 Subroutine created. +# Phil Hodge, 22-Apr-1994 Check to be sure TB_COMMENT is not NULL; +# prefix with # and/or append newline if necessary. +# Phil Hodge, 11-May-1994 Just return if input string is empty. + +procedure tbbcmt (tp, buf) + +pointer tp # i: pointer to table descriptor +char buf[ARB] # i: string to be appended to comment buffer +#-- +int len1 # length of string to be appended +int len2 # length of comment buffer +int ip # for ignoring leading whitespace +int new_sz_comment # new value of allocated buffer length +int strlen() + +begin + if (buf[1] == EOS) + return + + len1 = strlen (buf) + + if (TB_COMMENT(tp) == NULL) { + + # Allocate the comment buffer. + new_sz_comment = len1 + INCR_BUFFSIZE + call malloc (TB_COMMENT(tp), new_sz_comment, TY_CHAR) + TB_SZ_COMMENT(tp) = new_sz_comment + + } else { + + len2 = strlen (Memc[TB_COMMENT(tp)]) + + # If the combined length is too long, reallocate the comment buffer. + if (len1 + len2 > TB_SZ_COMMENT(tp)) { + new_sz_comment = TB_SZ_COMMENT(tp) + len1 + INCR_BUFFSIZE + call realloc (TB_COMMENT(tp), new_sz_comment, TY_CHAR) + TB_SZ_COMMENT(tp) = new_sz_comment + } + } + + # Does the line of text begin with "#"? + ip = 1 + while (IS_WHITE(buf[ip])) + ip = ip + 1 + if (buf[ip] != '#' && buf[ip] != EOS && buf[ip] != '\n') + call strcat ("# ", Memc[TB_COMMENT(tp)], TB_SZ_COMMENT(tp)) + + # Append the string to the comment buffer. + call strcat (buf, Memc[TB_COMMENT(tp)], TB_SZ_COMMENT(tp)) + + # Not newline terminated? + if (buf[len1] != '\n') + call strcat ("\n", Memc[TB_COMMENT(tp)], TB_SZ_COMMENT(tp)) +end diff --git a/pkg/tbtables/tbbftp.x b/pkg/tbtables/tbbftp.x new file mode 100644 index 00000000..050dcd42 --- /dev/null +++ b/pkg/tbtables/tbbftp.x @@ -0,0 +1,90 @@ +include + +# tbbftp -- convert format to SPP +# This procedure converts a Fortran-style format for display to an SPP +# format. The input may be in upper or lower case. If the input is +# not valid, the output will be a null string (which will result in the +# default print format being assigned if when tbcdef is called.) +# If the input begins with a "%" then it will simply be copied to output. +# The input is assumed to be a single letter followed by a number; the +# number may contain a decimal point in some cases. +# The following table shows examples of equivalences between Fortran and +# SPP formats: +# ftnfmt sppfmt comments +# f12.5 %12.5f floating-point value +# e12.5 %12.5e floating-point value +# d12.5 %12.5e floating-point value +# g12.5 %12.5g general floating-point value +# i12 %12d integer +# i12.12 %012d integer padded with '0' on the left +# l12 %12b logical (Boolean) +# a17 %-17s character string, left justified +# a-17 %-17s character string, explicitly left justified +# h12.2 %12.2h hh:mm:ss.dd +# m12.2 %12.2m mm:ss.dd +# z12 %12x hexadecimal integer +# +# Phil Hodge, 17-Jun-1987 Subroutine created. +# B. Simon, 10-Nov-1987 Rewritten. +# Phil Hodge, 29-Apr-1997 Left justify character strings and boolean. +# Phil Hodge, 19-Mar-2003 Check for '.' in Z format, and zero fill at +# left if '.' is found. + +procedure tbbftp (infmt, sppfmt) + +char infmt[ARB] # i: print format in Fortran style +char sppfmt[ARB] # o: the corresponding SPP format +#-- +char ftnfmt[SZ_COLFMT] # copy of print format in Fortran style +char dot # '.' +int fmtlen # length of string ftnfmt +int index # index of character in format string +int i + +string ftnchr "fgiedhmlaz" +string sppchr "fgdeehmbsx" + +int strlen(), stridx() + +begin + fmtlen = strlen (infmt) + + if (fmtlen < 1) { + sppfmt[1] = EOS # empty string in, empty out + return + } else if (infmt[1] == '%') { # already in SPP style + call strcpy (infmt, sppfmt, SZ_COLFMT) + return + } + + # Make a local copy of the input format. + do i = 1, SZ_COLFMT + ftnfmt[i] = EOS + call strcpy (infmt, ftnfmt, SZ_COLFMT) + call strlwr (ftnfmt) + + # Set sppfmt to % followed by the numerical specification. + dot = '.' + index = stridx (dot, ftnfmt) + if ((ftnfmt[1] == 'i' || ftnfmt[1] == 'z') && index > 0) { + call strcpy ("%0", sppfmt, SZ_COLFMT) # zero fill at left + call strcat (ftnfmt[2], sppfmt, index) + } else { + call strcpy ("%", sppfmt, SZ_COLFMT) + if (ftnfmt[2] != '-') { + if (ftnfmt[1] == 'a' || ftnfmt[1] == 'l') + call strcat ("-", sppfmt, SZ_COLFMT) # left justify + } + call strcat (ftnfmt[2], sppfmt, SZ_COLFMT) + } + + # Append spp type character corresponding to fortran type character + index = stridx (ftnfmt[1], ftnchr) + if (index == 0) { + sppfmt[1] = EOS + } else { + fmtlen = strlen (sppfmt) + sppfmt[fmtlen+1] = sppchr[index] + sppfmt[fmtlen+2] = EOS + } +end diff --git a/pkg/tbtables/tbbnll.x b/pkg/tbtables/tbbnll.x new file mode 100644 index 00000000..c1988445 --- /dev/null +++ b/pkg/tbtables/tbbnll.x @@ -0,0 +1,162 @@ +include "tbtables.h" + +# tbbnll -- indef record null +# Set a specific element in the INDEF record buffer to undefined. +# +# Phil Hodge, 10-Nov-1987 Pass Memi instead of Memr to tbbeqd. +# Phil Hodge, 2-Aug-1990 The data type for char was assumed to be TY_CHAR. +# Phil Hodge, 30-Mar-1993 Include short datatype. +# Phil Hodge, 29-Jul-1994 Include array option. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. + +procedure tbbnll (tp, colptr) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to column descriptor +#-- +pointer locn # Location in INDEF record (unit = SZ_CHAR) +int nchar # number of char in entry for current column +short sbuf +bool bbuf +int k + +begin + locn = TB_INDEF(tp) + COL_OFFSET(colptr) + nchar = COL_LEN(colptr) + + switch (COL_DTYPE(colptr)) { + + case TY_REAL: + do k = locn, locn+nchar-SZ_REAL, SZ_REAL + call tbbeqr (INDEFR, Memc[k]) + + case TY_DOUBLE: + do k = locn, locn+nchar-SZ_DOUBLE, SZ_DOUBLE + call tbbeqd (TBL_INDEFD, Memc[k]) + + case TY_INT: + do k = locn, locn+nchar-SZ_INT32, SZ_INT32 + call tbbeqi (INDEFI, Memc[k]) + + case TY_SHORT: + sbuf = INDEFS + do k = locn, locn+nchar-SZ_SHORT, SZ_SHORT + call tbbeqs (sbuf, Memc[k]) + + case TY_BOOL: + bbuf = false + do k = locn, locn+nchar-SZ_BOOL, SZ_BOOL + call tbbeqb (bbuf, Memc[k]) + + case TY_CHAR: + Memc[locn] = EOS + + default: # datatype < 0 implies character + do k = 0, nchar-1 # zero indexed + Memc[locn+k] = EOS + } +end + +# tbbeqd -- assign a double-precision value +# The purpose of this is to assign the input value of type double to +# a character output buffer. + +procedure tbbeqd (input, output) + +double input # i: input double-precision value +char output[ARB] # o: same as input, bit for bit +#-- +double buf # local copy of input +char cbuf[SZ_DOUBLE] # will be copied to output +int i +#equivalence (buf, cbuf) + +begin + buf = input + do i = 1, SZ_DOUBLE + output[i] = cbuf[i] +end + +# tbbeqr -- assign a single-precision value +# The purpose of this is to assign the input value of type real to +# a character output buffer. + +procedure tbbeqr (input, output) + +real input # i: input single-precision value +char output[ARB] # o: same as input, bit for bit +#-- +real buf # local copy of input +char cbuf[SZ_REAL] # will be copied to output +int i +#equivalence (buf, cbuf) + +begin + buf = input + do i = 1, SZ_REAL + output[i] = cbuf[i] +end + +# tbbeqi -- assign an integer value +# The purpose of this is to assign the input value of type integer to +# a character output buffer. + +procedure tbbeqi (input, output) + +int input # i: input integer value +char output[ARB] # o: same as input, bit for bit +#-- +int buf # local copy of input +char cbuf[SZ_INT32] # will be copied to output +int i +#equivalence (buf, cbuf) + +begin + buf = input + do i = 1, SZ_INT32 + output[i] = cbuf[i] +end + +# tbbeqs -- assign a short integer value +# The purpose of this is to assign the input value of type short integer to +# a character output buffer. + +procedure tbbeqs (input, output) + +short input # i: input integer value +char output[ARB] # o: same as input, bit for bit +#-- +short buf # local copy of input +char cbuf[SZ_SHORT] # will be copied to output +int i +#equivalence (buf, cbuf) + +begin + if (SZ_SHORT == SZ_CHAR) { + output[1] = input + } else { + buf = input + do i = 1, SZ_SHORT + output[i] = cbuf[i] + } +end + +# tbbeqb -- assign a boolean value +# The purpose of this is to assign the input value of type boolean to +# a character output buffer. + +procedure tbbeqb (input, output) + +bool input # i: input integer value +char output[ARB] # o: same as input, bit for bit +#-- +bool buf # local copy of input +char cbuf[SZ_BOOL] # will be copied to output +int i +#equivalence (buf, cbuf) + +begin + buf = input + do i = 1, SZ_BOOL + output[i] = cbuf[i] +end diff --git a/pkg/tbtables/tbbptf.x b/pkg/tbtables/tbbptf.x new file mode 100644 index 00000000..be511db2 --- /dev/null +++ b/pkg/tbtables/tbbptf.x @@ -0,0 +1,71 @@ +include + +# tbbptf -- convert format to Fortran format +# This procedure converts an SPP-stype format for display to a Fortran +# format. The input is case sensitive, but the output will +# be in upper case. The input and output may be the same string. +# The output may not be a legal Fortran format, but it will be valid as +# input to utcdef. +# +# Bug: Note that "H" and "h" are both converted to "H", and "M" and "m" +# are both converted to "M". That is, the option to divide by 15 is lost. +# +# The following table shows examples of equivalences between Fortran and +# SPP formats: +# ftnfmt sppfmt comments +# f12.5 %12.5f floating-point value +# e12.5 %12.5e floating-point value +# d12.5 %12.5e floating-point value +# g12.5 %12.5g general floating-point value +# i12 %12d integer +# i12.12 %012d integer padded with '0' on the left +# l12 %12b logical (Boolean) +# a17 %17s character string +# h12.2 %12.2h hh:mm:ss.dd +# m12.2 %12.2m mm:ss.dd +# z12 %12x hexadecimal integer +# +# Phil Hodge, 7-Aug-1987 Subroutine created. +# B. Simon, 10-Nov-1987 Rewritten. +# Phil Hodge, 18-Jan-1995 Add "H" and "M" for SPP. + +procedure tbbptf (sppfmt, ftnfmt) + +char sppfmt[ARB] # i: Print format in SPP style +char ftnfmt[ARB] # o: The corresponding Fortran format +#-- +char numpart[SZ_COLFMT] # Copy of numerical portion of print format +int fmtlen # Length of string sppfmt +int numlen # Number of digits in numerical portion +int index # Position of character in format string + +string sppchr "fgdeHhMmbsx" +string ftnchr "FGIEHHMMLAZ" + +int strlen(), stridx() + +begin + fmtlen = strlen (sppfmt) + numlen = fmtlen - 2 # may be zero + call strcpy (sppfmt[2], numpart, numlen) # copy numerical portion + + # Get fortran type character corresponding to spp type character + index = stridx (sppfmt[fmtlen], sppchr) + if (index == 0) { + call strcpy (" ", ftnfmt, SZ_COLFMT) + return + } else { + ftnfmt[1] = ftnchr[index] + ftnfmt[2] = EOS + } + + # Append numerical portion of format + if (numpart[1] == '0' && sppfmt[fmtlen] == 'd') { + call strcat (numpart[2], ftnfmt, SZ_COLFMT) + call strcat (".", ftnfmt, SZ_COLFMT) + call strcat (numpart[2], ftnfmt, SZ_COLFMT) # e.g. I4.4 + } else { + call strcat (numpart, ftnfmt, SZ_COLFMT) # e.g. A10 + } + +end diff --git a/pkg/tbtables/tbbtyp.x b/pkg/tbtables/tbbtyp.x new file mode 100644 index 00000000..16ec1a28 --- /dev/null +++ b/pkg/tbtables/tbbtyp.x @@ -0,0 +1,52 @@ +include "tblerr.h" + +define SZ_SH_STR 21 # local buffer size + +# Convert a data type expressed as a character string to an integer. +# The input string may be in upper or lower case. The recognized data +# types are as follows: +# "r" --> real; "d" --> double; "i" --> int; "s" --> short; "b" --> bool; +# "ch*n" --> char string of length n (output datatype is -n). +# +# Phil Hodge, 10-Aug-1987 Delete third argument (datalen); ch*n --> -n. +# Phil Hodge, 28-Dec-1987 Use fixed size for local buffer str. +# Phil Hodge, 30-Mar-1993 Include short datatype. + +procedure tbbtyp (chdtype, datatype) + +char chdtype[ARB] # i: data type expressed as a string +int datatype # o: data type expressed as an int +#-- +char str[SZ_SH_STR] # scratch space for copy of chdtype +char asterisk # ASCII equivalent of '*' +int dlen # number in char type, e.g. 12 in ch*12 +int ip, nchar # for reading number from string, e.g. "ch*12" +int stridx(), strncmp(), ctoi() + +begin + call strcpy (chdtype, str, SZ_SH_STR) + call strlwr (str) + + if (str[1] == 'r') { + datatype = TY_REAL + } else if (str[1] == 'd') { + datatype = TY_DOUBLE + } else if (str[1] == 'i') { + datatype = TY_INT + } else if (str[1] == 's') { + datatype = TY_SHORT + } else if (str[1] == 'b') { + datatype = TY_BOOL + } else if ((strncmp (str, "ch", 2) == 0) || + (strncmp (str, "c*", 2) == 0)) { + asterisk = '*' + ip = stridx (asterisk, str) + 1 # go past the '*' + nchar = ctoi (str, ip, dlen) + if ((nchar < 1) || (dlen < 1)) { + call error (ER_TBBADTYPE, "tbbtyp: bad data type") + } + datatype = -dlen # NOTE: not an SPP data type + } else { + call error (ER_TBBADTYPE, "tbbtyp: bad data type") + } +end diff --git a/pkg/tbtables/tbbwrd.x b/pkg/tbtables/tbbwrd.x new file mode 100644 index 00000000..024fe242 --- /dev/null +++ b/pkg/tbtables/tbbwrd.x @@ -0,0 +1,219 @@ +include # for IS_DIGIT + +define LEFT_MARGIN 0 # extra space at left of first column + +# tbbwrd -- read a word from the input buffer +# This routine extracts the next word from the input buffer, returning +# the word itself and the number of characters that it contains. +# The function value is the number of char converted, as returned by +# ctowrd. If the value is a string (i.e. not numeric), then trailing +# blanks will be truncated. If the value is a single blank, however, +# that blank will not be deleted. +# +# If the word is numeric, PREC is the number of digits of precision +# in the word; for HH:MM:SS.d or HH:MM.d format PREC is the number of +# digits after the decimal point. The idea is that the values of WIDTH +# and PREC returned by this routine can go directly into a format code. +# +# The format code FCODE and precision PREC are really only used if the +# data type is double. + +# Phil Hodge, 3-Mar-1992 Subroutine created. +# Phil Hodge, 7-Aug-1992 Include checks on string beginning with number; +# add fcode to the calling sequence. +# Phil Hodge, 10-Sep-1992 Set datatype to double if word is INDEF. +# Phil Hodge, 7-Jun-1994 Set type to char if more than one decimal point. +# Phil Hodge, 27-Jul-1994 Change LEFT_MARGIN from 3 to 0 (no longer needed). + +int procedure tbbwrd (buf, ip, word, maxch, width, prec, datatype, fcode) + +char buf[ARB] # i: buffer containing line from file +int ip # io: starting location in buffer +char word[ARB] # o: word extracted from buffer +int maxch # i: max size of word +int width # o: width of column +int prec # o: digits of precision in this word +int datatype # o: TY_DOUBLE, TY_INT, or TY_CHAR +int fcode # o: format code for print format +#-- +char cval # one character in the word +int ip_start # ip before calling ctowrd +int word_width # width of extracted word (value of ctowrd) +int i # loop index +int num_colon # number of ':' found in word +bool quote # true if value begins with ' or " +bool exponent # true if there's an exponent in the word +bool dec_point # true if there's a decimal point in the word +int ctowrd(), strlen(), strncmp() +bool streq() + +define chartype_ 91 +define finished_ 93 + +begin + ip_start = ip + datatype = 0 + fcode = 's' + + word_width = ctowrd (buf, ip, word, maxch) + if (word_width < 1) + return (0) + + # These may be updated later. + width = word_width + prec = width + + # Check whether column begins with a quote, indicating that it's + # a string, even if the word itself is numeric, e.g. "3.14159". + quote = false + do i = ip_start, ip { + if (buf[i] != ' ') { + if (buf[i] == '"' || buf[i] == '\'') + quote = true + break + } + } + + # Get a first estimate of the data type. We may change this later. + if (quote) { + datatype = TY_CHAR + + } else if (IS_DIGIT(word[1])) { + datatype = TY_DOUBLE + + } else if (word[1] == '-' || word[1] == '+' || word[1] == '.') { + if (IS_DIGIT(word[2])) + datatype = TY_DOUBLE + else + datatype = TY_CHAR + + } else if (word[1] == 'I') { + if (streq (word, "INDEFI")) { + datatype = TY_INT + width = 6 + fcode = 'd' + goto finished_ + } else if (strncmp (word, "INDEF", 5) == 0) { + datatype = TY_DOUBLE + width = 5 + prec = 5 + fcode = 'g' + goto finished_ + } else { + datatype = TY_CHAR + } + + } else { + datatype = TY_CHAR + } + + if (quote) { + # The value is enclosed in quotes; don't include them in the width. + width = word_width - 2 + + # Trim trailing blanks. width is unchanged. + do i = strlen (word), 1, -1 { + if (word[i] != ' ') { + word[i+1] = EOS + break + } + } + } + + if (datatype != TY_CHAR) { + # So far, the word appears to be a number. Check each character, + # and change the type if we find that it's not numeric. + + num_colon = 0 # initial values + exponent = false + dec_point = false + prec = 0 # incremented in loop + do i = 1, maxch { + cval = word[i] + if (IS_DIGIT(cval)) { + if (!exponent) + prec = prec + 1 # count it + } else if (cval == '.') { + # There can't be two decimal points, or even one in + # an exponent. + if (dec_point || exponent) { + datatype = TY_CHAR + goto chartype_ + } + dec_point = true + if (num_colon > 0) + prec = 0 + } else if (cval == '+' || cval == '-') { + # A sign must be the first character or in an exponent. + if (i > 1 && !exponent) { + datatype = TY_CHAR + goto chartype_ + } + } else if (cval == ':') { + num_colon = num_colon + 1 + if (exponent || num_colon > 2) { + datatype = TY_CHAR + goto chartype_ + } + } else if (cval == 'E' || cval == 'e' || + cval == 'D' || cval == 'd') { + # There can't be more than one exponent in a number. + if (exponent) { + datatype = TY_CHAR + goto chartype_ + } exponent = true # it looks like an exponent + } else if (cval == EOS) { + break + } else { + datatype = TY_CHAR # not numeric + goto chartype_ + } + } + prec = max (prec, 1) + + # We need this test for HMS format because there might have been + # no decimal point in the value (e.g. 3:17:42), so the digits + # would have been counted in the precision and not reset to zero + # by a decimal point. We could in principle have prec=0, but + # that prints incorrect values due to truncation. + if (num_colon > 0 && !dec_point) + prec = 1 # should be zero for HH:MM:SS + + # Now make sure the field width is sufficient, and set format code. + if (num_colon == 2) { # HH:MM:SS.d + width = prec + 10 + fcode = 'h' + } else if (num_colon == 1) { # HH:MM.d + width = prec + 7 + fcode = 'm' + } else if (exponent) { + width = prec + 6 + fcode = 'g' + } else if (dec_point) { + width = prec + 2 + fcode = 'g' + } else { # no decimal point, colon, or exponent + width = prec + 1 + datatype = TY_INT # reset datatype to int + fcode = 'd' + } + + } + +chartype_ + if (datatype == TY_CHAR && !quote) { + # It's a string, but we don't need to check for trailing blanks + # because the string is not enclosed in quotes. + width = word_width + } + +finished_ + # If this is the first column and the value is left-justified, + # add a little extra space. + if (ip_start == 1) { + if (buf[1] != ' ' && buf[1] != '\t') + width = width + LEFT_MARGIN + } + + return (word_width) +end diff --git a/pkg/tbtables/tbcadd.x b/pkg/tbtables/tbcadd.x new file mode 100644 index 00000000..21bda299 --- /dev/null +++ b/pkg/tbtables/tbcadd.x @@ -0,0 +1,120 @@ +include +include "tbtables.h" + +# tbcadd -- add new columns +# Allocate column descriptors for new columns. +# Note that TB_COLINFO, the array of pointers to column descriptors, +# is assumed to be long enough already to contain the new pointers. +# This would have been taken care of by tbcdef or by tbzcol. +# +# Phil Hodge, 10-Aug-1987 Datatype for char string specified as -n; +# lendata is currently ignored. +# Phil Hodge, 8-Oct-1987 TB_COLPTR is of type TY_POINTER. +# Phil Hodge, 6-Mar-1989 Pass datatype[k] instead of dtype to tbbadf. +# Phil Hodge, 1-May-1989 Call tbtchs. +# Phil Hodge, 15-Jan-1992 Add option for text table type; +# move the call to tbtchs to tbcdef. +# Phil Hodge, 5-Mar-1993 Only call tbzadd if table is actually open. +# Phil Hodge, 29-Jul-1994 Rename lendata to lenarray, and use the value. +# Phil Hodge, 14-Apr-1998 Use strcpy instead of strpak or tbcftp for +# column name, units, and print format. +# Phil Hodge, 7-Jun-1999 Reallocate TB_MAXCOLS, if necessary. +# Phil Hodge, 5-Aug-1999 Assign a value to COL_NELEM. +# Phil Hodge, 23-Jun-2000 Assign values to COL_TDTYPE, COL_TSCAL, COL_TZERO. +# Phil Hodge, 29-Mar-2001 Set TB_COLUSED equal to TB_ROWLEN for text table. + +procedure tbcadd (tp, colptr, + colname, colunits, colfmt, datatype, lenarray, numcols) + +pointer tp # i: Pointer to table descriptor +char colname[SZ_COLNAME,numcols] # i: Names of columns +char colunits[SZ_COLUNITS,numcols] # i: Units for columns +char colfmt[SZ_COLFMT,numcols] # i: Print formats for columns +int datatype[numcols] # i: Data types (-n for string) +int lenarray[numcols] # i: number of elements for each col +int numcols # i: Number of columns to be defined +pointer colptr[ARB] # o: Pointers to the new columns +#-- +pointer cp # pointer to column descriptor +pointer prevcol # pointer to descriptor for previous column +char pformat[SZ_COLFMT] # local copy of format for printing a column +int dtype # SPP data type of column +int dlen # number of char used by a column in table +int k # loop index +int ncols # current number of columns +int new_maxcols # new maximum number of columns +errchk tbbaln, calloc + +begin + # Reallocate the space for column descriptors if necessary. + ncols = TB_NCOLS(tp) + numcols # total + if (ncols > TB_MAXCOLS(tp)) { + new_maxcols = ncols + DEFMAXCOLS + call realloc (TB_COLPTR(tp), new_maxcols, TY_POINTER) + TB_MAXCOLS(tp) = new_maxcols + } + + do k = 1, numcols { + + # Assign value for SPP data type and for data length (of one + # element) in table. + call tbbaln (datatype[k], dtype, dlen) + + # Assign default print format if none given; pformat is output. + call tbbadf (colfmt[1,k], datatype[k], dlen, pformat, SZ_COLFMT) + + # Allocate space for column descriptor + call calloc (cp, LEN_COLSTRUCT, TY_STRUCT) + ncols = TB_NCOLS(tp) + 1 + TB_NCOLS(tp) = ncols + TB_COLINFO(tp,ncols) = cp # save pointer to col descr + + COL_NUMBER(cp) = ncols + COL_DTYPE(cp) = dtype + COL_NELEM(cp) = max (1, lenarray[k]) + COL_LEN(cp) = dlen * COL_NELEM(cp) + # COL_TDTYPE, COL_TSCAL, COL_TZERO are only needed for FITS tables. + COL_TDTYPE(cp) = COL_DTYPE(cp) + COL_TSCAL(cp) = 1.d0 + COL_TZERO(cp) = 0.d0 + + # Copy name, units, print format into column descriptor. + call strcpy (colname[1,k], COL_NAME(cp), SZ_COLNAME) + call strcpy (colunits[1,k], COL_UNITS(cp), SZ_COLUNITS) + call strcpy (pformat, COL_FMT(cp), SZ_COLFMT) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + + # Assign COL_OFFSET(cp) to be a pointer to allocated memory + # for column values. Also change the data type if necessary. + # If the table is not open yet, set col_offset in case the + # table type will be changed to non-text type. + if (TB_IS_OPEN(tp)) { + call tbzadd (tp, cp) + TB_COLUSED(tp) = TB_ROWLEN(tp) + } else { + if (ncols > 1) { + prevcol = TB_COLINFO(tp,ncols-1) + COL_OFFSET(cp) = COL_OFFSET(prevcol) + COL_LEN(prevcol) + } else { + COL_OFFSET(cp) = 0 + } + TB_COLUSED(tp) = COL_OFFSET(cp) + COL_LEN(cp) + } + + } else { + + # Assign COL_OFFSET(cp) to be the sum of the lengths + # (unit = char) of all previous columns. + if (ncols > 1) { + prevcol = TB_COLINFO(tp,ncols-1) + COL_OFFSET(cp) = COL_OFFSET(prevcol) + COL_LEN(prevcol) + } else { + COL_OFFSET(cp) = 0 # no previous column + } + TB_COLUSED(tp) = COL_OFFSET(cp) + COL_LEN(cp) + } + + colptr[k] = cp + } +end diff --git a/pkg/tbtables/tbcchg.x b/pkg/tbtables/tbcchg.x new file mode 100644 index 00000000..5b381adc --- /dev/null +++ b/pkg/tbtables/tbcchg.x @@ -0,0 +1,35 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbcchg -- change allocated row length +# This procedure is for changing the number of allocated columns, i.e. +# the row length. +# The allocated space for column descriptors will also be increased, if +# necessary, to allow defining a single-precision column for each SZ_REAL +# added to the row length. +# For column-ordered tables this procedure does nothing. +# +# Phil Hodge, 6-Feb-1992 Include only section for row ordered. + +procedure tbcchg (tp, rowlen) + +pointer tp # Pointer to table descriptor +int rowlen # The new value for the row length in SZ_CHAR + +int maxcols # New value for TB_MAXCOLS +errchk tbtchs + +begin + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + if (TB_IS_OPEN(tp)) { + maxcols = TB_NCOLS(tp) + (rowlen - TB_COLUSED(tp)) / SZ_REAL + # maxcols < 0 means that tbtchs should not change TB_MAXCOLS. + if (maxcols <= TB_MAXCOLS(tp)) + maxcols = -1 + call tbtchs (tp, -1, maxcols, rowlen, -1) + } else { + TB_ROWLEN(tp) = rowlen + } + } +end diff --git a/pkg/tbtables/tbcdef.x b/pkg/tbtables/tbcdef.x new file mode 100644 index 00000000..d63c1a4f --- /dev/null +++ b/pkg/tbtables/tbcdef.x @@ -0,0 +1,162 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +# tbcdef -- define columns +# Define a set of columns for a table. If the table is new then it does +# not need to be open. The names in the array colname will be checked +# against the columns that have already been defined in the table, but +# the calling routine should make sure there are not any duplicate names +# within colname itself. +# +# The values in the DATATYPE array may be TY_BOOL, TY_INT, TY_SHORT, +# TY_REAL, TY_DOUBLE; for a character-type column the value should be +# a negative integer, the absolute value of which is the maximum number +# of characters for that column. +# +# If this procedure increases the space for column-descriptor pointers, the +# new size will be made DEFMAXCOLS larger than required to hold all those that +# that be defined when this routine returns. +# +# This routine may reallocate the array of pointers to column descriptors, +# and the values of TB_FILE(tp), TB_ROWLEN(tp) and TB_MAXCOLS(tp) may also +# be changed. +# +# The LENARRAY argument is the array size, or one for a scalar column. +# +# Phil Hodge, 16-Jan-1989 Flush the buffer after defining the column. +# Phil Hodge, 7-Mar-1989 Eliminate TB_MODSIZE. +# Phil Hodge, 1-May-1989 Change calling sequences of tbxwnc, tbywnc. +# Phil Hodge, 14-Jan-1992 Add option for text table type; +# call tbtchs here instead of in tbcadd. +# Phil Hodge, 29-Jul-1994 Change lendata to lenarray, and use it. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 20-Jun-1995 Modify for FITS tables. +# Phil Hodge, 2-Mar-1998 Call tbscol to allow a column selector. +# Phil Hodge, 12-Sep-2000 Initialize TB_INDEF_IS_CURRENT to false. + +procedure tbcdef (tp, colptr, + colname, colunits, colfmt, datatype, lenarray, numcols) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # o: pointers to new columns +char colname[SZ_COLNAME,numcols] # i: names of columns +char colunits[SZ_COLUNITS,numcols] # i: units for columns +char colfmt[SZ_COLFMT,numcols] # i: print formats for columns +int datatype[numcols] # i: data types of columns +int lenarray[numcols] # i: number of elements for each column +int numcols # i: number of columns to be defined +#-- +int ntotal # number of columns including new ones +int old_ncols # TB_NCOLS before adding new columns +int old_colused # TB_COLUSED before increasing size +int new_maxcols # new maximum number of columns +int new_colused # new value for row length used +int new_rowlen # new value for row length allocated +int dtype # SPP data type of column +int dlen # number of char used by a column in table +int larray # max (lenarray, 1) +int k # Loop index +errchk tbbaln, tbcadd, tbfdef, tbtchs, tbtflu + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, + "can't define new columns in readonly table") + + # Save current values (in case table is open). + old_ncols = TB_NCOLS(tp) + old_colused = TB_COLUSED(tp) + + # Check whether columns already exist. + call tbcfnd (tp, colname, colptr, numcols) + do k = 1, numcols { + if (colptr[k] != NULL) { + call eprintf ("Warning: column `%s' already exists.\n") + call pargstr (colname[1,k]) + } + } + + # Make sure we're not trying to create array columns for + # a table type that doesn't support it. + if (TB_TYPE(tp) != TBL_TYPE_S_ROW && TB_TYPE(tp) != TBL_TYPE_FITS) { + do k = 1, numcols { + if (lenarray[k] > 1) + call error (1, "This table type doesn't support arrays.") + } + } + + # Get the new total number of columns. + ntotal = TB_NCOLS(tp) + numcols + if (ntotal > TB_MAXCOLS(tp)) + new_maxcols = ntotal + DEFMAXCOLS + else + new_maxcols = -1 # i.e. don't change current value + + # Get the new row length used (actually needed only if row ordered). + new_colused = TB_COLUSED(tp) + do k = 1, numcols { + call tbbaln (datatype[k], dtype, dlen) + larray = max (1, lenarray[k]) + new_colused = new_colused + dlen * larray + } + new_rowlen = max (TB_ROWLEN(tp), new_colused) + + # Update the values in the table struct and, if the table is open, + # update the table size. + call tbtchs (tp, -1, new_maxcols, new_rowlen, -1) + + # Create descriptors for the new columns. + # For a text table, allocate memory for the column values. + call tbcadd (tp, colptr, colname, colunits, colfmt, + datatype, lenarray, numcols) + + if (TB_IS_OPEN(tp)) { + + # If a column selector is in effect, add all new columns. + if (TB_COLUMN_SELECT(tp) == YES) { + do k = 1, numcols + call tbscol (tp, colptr[k]) + } + + # Save new descriptors in table. + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + iferr { + call tbxwnc (tp, colptr, numcols, old_colused) + } then { + TB_NCOLS(tp) = old_ncols + TB_COLUSED(tp) = old_colused + call erract (EA_ERROR) + } + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + iferr { + call tbywnc (tp, colptr, numcols) + } then { + TB_NCOLS(tp) = old_ncols + TB_COLUSED(tp) = old_colused + call erract (EA_ERROR) + } + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + ; + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + iferr { + do k = 1, numcols + call tbfdef (tp, colptr[k]) + } then { + TB_NCOLS(tp) = old_ncols + TB_COLUSED(tp) = old_colused + call erract (EA_ERROR) + } + } else { + TB_NCOLS(tp) = old_ncols + TB_COLUSED(tp) = old_colused + call error (ER_TBCORRUPTED, "tbcdef: table type is messed up") + } + + call tbtflu (tp) # flush the buffer + } + + TB_MODIFIED(tp) = true + TB_INDEF_IS_CURRENT(tp) = false +end diff --git a/pkg/tbtables/tbcdef1.x b/pkg/tbtables/tbcdef1.x new file mode 100644 index 00000000..0844ddf9 --- /dev/null +++ b/pkg/tbtables/tbcdef1.x @@ -0,0 +1,36 @@ +include + +# tbcdef1 -- define a column +# Define (create) one table column. This just calls tbcdef. +# +# Phil Hodge, 21-Aug-1995 Subroutine created. + +procedure tbcdef1 (tp, colptr, colname, colunits, colfmt, datatype, nelem) + +pointer tp # i: pointer to table descriptor +pointer colptr # o: pointer to new column +char colname[SZ_COLNAME] # i: name of column +char colunits[SZ_COLUNITS] # i: units for column +char colfmt[SZ_COLFMT] # i: print format for column +int datatype # i: data types of column +int nelem # i: number of elements for column +#-- +pointer cp[1] # pointer to new column +char cname[SZ_COLNAME,1] # name of column +char cunits[SZ_COLUNITS,1] # units for column +char cfmt[SZ_COLFMT,1] # print format for column +int dtype[1] # datatype +int larray[1] # nelem +errchk tbcdef + +begin + call strcpy (colname[1], cname[1,1], SZ_COLNAME) + call strcpy (colunits[1], cunits[1,1], SZ_COLUNITS) + call strcpy (colfmt[1], cfmt[1,1], SZ_COLFMT) + dtype[1] = datatype + larray[1] = nelem + + call tbcdef (tp, cp, cname, cunits, cfmt, dtype, larray, 1) + + colptr = cp[1] +end diff --git a/pkg/tbtables/tbcdes.x b/pkg/tbtables/tbcdes.x new file mode 100644 index 00000000..aa6ffc88 --- /dev/null +++ b/pkg/tbtables/tbcdes.x @@ -0,0 +1,35 @@ +include +include "tbtables.h" + +# tbcdes -- get the column selector descriptor +# This function returns the column selector descriptor corresponding to +# the input column pointer. NULL will be returned if the column pointer +# does not match any selected column, or if there is no column selector. +# +# Phil Hodge, 3-Oct-1997 Function created. + +pointer procedure tbcdes (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +pointer descrip # column selector descriptor +int colnum # loop index for selected column number +pointer tcs_column() # column pointer as function of descriptor + +begin + descrip = NULL + + if (TB_COLUMN_SELECT(tp) == YES) { # column selector was used + + do colnum = 1, TB_NSEL_COLS(tp) { # all selected columns + descrip = TB_SELCOL(tp,colnum) + if (cp == tcs_column (descrip)) + break # found it + else + descrip = NULL + } + } + + return (descrip) +end diff --git a/pkg/tbtables/tbcfmt.x b/pkg/tbtables/tbcfmt.x new file mode 100644 index 00000000..a8b7dbcd --- /dev/null +++ b/pkg/tbtables/tbcfmt.x @@ -0,0 +1,39 @@ +include +include "tbtables.h" + +# tbcfmt -- change column print format +# This procedure replaces the print format for a column. The column +# descriptor is updated, and if the table is not read-only the modified +# column descriptor is also written back into the table. +# +# Phil Hodge, 19-Oct-1989 allow changing format for a read-only table +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 9-Apr-1995 Modify for FITS tables. +# Phil Hodge, 14-Apr-1998 Change calling sequence of tbcwcd; +# just copy to COL_FMT, instead of using tbcftp. + +procedure tbcfmt (tp, cp, colfmt) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to a column descriptor +char colfmt[ARB] # i: print format for column +#-- +char pformat[SZ_COLFMT] # local copy of format + +errchk tbcwcd, tbffmt + +begin + # If the format for display is blank, assign a default. + call tbbadf (colfmt, COL_DTYPE(cp), COL_LEN(cp), + pformat, SZ_COLFMT) + call strcpy (pformat, COL_FMT(cp), SZ_COLFMT) + + if (!TB_READONLY(tp)) { + # Save modified column descriptor in table file. + if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbffmt (tp, cp, pformat) + else + call tbcwcd (tp, cp) + TB_MODIFIED(tp) = true + } +end diff --git a/pkg/tbtables/tbcfnd.x b/pkg/tbtables/tbcfnd.x new file mode 100644 index 00000000..4b267a77 --- /dev/null +++ b/pkg/tbtables/tbcfnd.x @@ -0,0 +1,69 @@ +include +include "tbtables.h" + +# tbcfnd -- find columns +# Get column-descriptor pointers from column names. For each column that +# is not found, the corresponding colptr will be NULL. +# For a text table, a column name should be "c" followed by the column +# number. If just the number was specified, we will return the pointer +# to that column rather than requiring the name to begin with "c". +# +# Phil Hodge, 1-Jun-1989 Find columns without regard to case. +# Phil Hodge, 24-Jun-1992 For text table, name can be cN or just N. +# Phil Hodge, 2-Mar-1993 For text table, if the name is just a number, +# check that nothing follows the number. +# Phil Hodge, 14-Apr-1998 Use strcpy instead of strupk. + +procedure tbcfnd (tp, colname, colptr, numcols) + +pointer tp # i: pointer to table descriptor +char colname[SZ_COLNAME,numcols] # i: array of column names +pointer colptr[numcols] # o: array of ptrs to column descriptors +int numcols # i: length of arrays colname & colptr +#-- +pointer cp # pointer to column descriptor +char icname[SZ_COLNAME] # a column name to be found +char tcname[SZ_COLNAME] # a name of a column in the table +int j, k, col # loop indexes; current column number +int cnum # column number if name is a number +int ip, ctoi() +bool streq() + +begin + col = 1 # start searching with first column + + do j = 1, numcols { # do for each column to be found + + colptr[j] = NULL # not found yet + + call strcpy (colname[1,j], icname, SZ_COLNAME) + call strlwr (icname) + + # For a text table, if the column name is just a number, + # return the pointer for that column number. + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + ip = 1 + if (ctoi (icname, ip, cnum) > 0) { + if (icname[ip] == EOS) { # nothing follows number + colptr[j] = TB_COLINFO(tp,cnum) + next + } + } + } + + do k = 1, TB_NCOLS(tp) { # do for each column in the table + if (col > TB_NCOLS(tp)) + col = 1 + cp = TB_COLINFO(tp,col) + # Copy column name from column descriptor to scratch. + call strcpy (COL_NAME(cp), tcname, SZ_COLNAME) + call strlwr (tcname) + if (streq (icname, tcname)) { + colptr[j] = cp # found it + break + } else { + col = col + 1 + } + } + } +end diff --git a/pkg/tbtables/tbcfnd1.x b/pkg/tbtables/tbcfnd1.x new file mode 100644 index 00000000..db789c0d --- /dev/null +++ b/pkg/tbtables/tbcfnd1.x @@ -0,0 +1,25 @@ +include + +# tbcfnd1 -- find a column +# Find a column in a table. This just calls tbcfnd. +# If the column is not found in the table, colptr will be set to NULL. +# +# Phil Hodge, 21-Aug-1995 Subroutine created. + +procedure tbcfnd1 (tp, colname, colptr) + +pointer tp # i: pointer to table descriptor +char colname[SZ_COLNAME] # i: name of column +pointer colptr # o: pointer to column, or NULL +#-- +pointer cp[1] # pointer to column, or NULL +char cname[SZ_COLNAME,1] # name of column +errchk tbcfnd + +begin + call strcpy (colname[1], cname[1,1], SZ_COLNAME) + + call tbcfnd (tp, cname, cp, 1) + + colptr = cp[1] +end diff --git a/pkg/tbtables/tbcftl.x b/pkg/tbtables/tbcftl.x new file mode 100644 index 00000000..c8386031 --- /dev/null +++ b/pkg/tbtables/tbcftl.x @@ -0,0 +1,23 @@ +include +include "tbtables.h" + +# tbcftl -- length of print format +# This procedure reads from the column print format the number of char +# necessary to print an element from the column using that format. +# +# Phil Hodge, 14-Apr-1998 Use strcpy instead of strupk; remove pformat. + +procedure tbcftl (colptr, lenfmt) + +pointer colptr # i: pointer to column descriptor +int lenfmt # o: number of char to print using colfmt +#-- +int ip, ival # stuff for using ctoi to get lenfmt +int ctoi() + +begin + ip = 2 # set ip to skip over the leading '%' + if (ctoi (COL_FMT(colptr), ip, ival) <= 0) + ival = 25 # a default value + lenfmt = abs (ival) # be careful of e.g. "%-12s" +end diff --git a/pkg/tbtables/tbcgt.x b/pkg/tbtables/tbcgt.x new file mode 100644 index 00000000..e21e8d8a --- /dev/null +++ b/pkg/tbtables/tbcgt.x @@ -0,0 +1,272 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Read values for one column from a range of rows. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 3-Feb-1992 Add option for text table type. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 Include check on row number less than one. +# Phil Hodge, 17-May-1995 Change declaration of buffer in tbcgtt to 2-D array. +# Phil Hodge, 9-Apr-1995 Modify for FITS tables. +# Phil Hodge, 2-Mar-1998 Map selected row number to actual row number. +# Phil Hodge, 18-Jun-1998 Use tbfagi instead of tbfagb to get boolean. +# Phil Hodge, 28-Aug-2002 Use strsearch to check for INDEF in tbcgtt. + +# tbcgtd -- getcol double +# Read values for one column from a range of rows. This is for data type +# double precision. + +procedure tbcgtd (tp, cp, buffer, nullflag, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +double buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int sel_firstrow # i: first row from which to get values +int sel_lastrow # i: last row from which to get values +#-- +int firstrow, lastrow # actual range of row numbers +int i, row # loop indexes +int nret # for fits tables +int tbfagd() +errchk tbsirow, tbxcgd, tbycgd, tbzcgd, tbfagd + +begin + call tbsirow (tp, sel_firstrow, firstrow) + call tbsirow (tp, sel_lastrow, lastrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcgd (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycgd (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcgd (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + nret = tbfagd (tp, cp, row, buffer[i], 1, 1) + nullflag[i] = (IS_INDEFD (buffer[i])) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcgtd: table type is messed up") + } +end + +# tbcgtr -- getcol real +# Read values for one column from a range of rows. This is for data type real. + +procedure tbcgtr (tp, cp, buffer, nullflag, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +real buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int sel_firstrow # i: first row from which to get values +int sel_lastrow # i: last row from which to get values +#-- +int firstrow, lastrow # actual range of row numbers +int i, row # loop indexes +int nret # for fits tables +int tbfagr() +errchk tbsirow, tbxcgr, tbycgr, tbzcgr, tbfagr + +begin + call tbsirow (tp, sel_firstrow, firstrow) + call tbsirow (tp, sel_lastrow, lastrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcgr (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycgr (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcgr (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + nret = tbfagr (tp, cp, row, buffer[i], 1, 1) + nullflag[i] = (IS_INDEFR (buffer[i])) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcgtr: table type is messed up") + } +end + +# tbcgti -- getcol integer +# Read values for one column from a range of rows. This is for data type +# integer. + +procedure tbcgti (tp, cp, buffer, nullflag, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +int buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int sel_firstrow # i: first row from which to get values +int sel_lastrow # i: last row from which to get values +#-- +int firstrow, lastrow # actual range of row numbers +int i, row # loop indexes +int nret # for fits tables +int tbfagi() +errchk tbsirow, tbxcgi, tbycgi, tbzcgi, tbfagi + +begin + call tbsirow (tp, sel_firstrow, firstrow) + call tbsirow (tp, sel_lastrow, lastrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcgi (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycgi (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcgi (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + nret = tbfagi (tp, cp, row, buffer[i], 1, 1) + nullflag[i] = (IS_INDEFI (buffer[i])) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcgti: table type is messed up") + } +end + +# tbcgts -- getcol short +# Read values for one column from a range of rows. This is for data type +# short integer. + +procedure tbcgts (tp, cp, buffer, nullflag, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +short buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int sel_firstrow # i: first row from which to get values +int sel_lastrow # i: last row from which to get values +#-- +int firstrow, lastrow # actual range of row numbers +int i, row # loop indexes +int nret # for fits tables +int tbfags() +errchk tbsirow, tbxcgs, tbycgs, tbzcgs, tbfags + +begin + call tbsirow (tp, sel_firstrow, firstrow) + call tbsirow (tp, sel_lastrow, lastrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcgs (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycgs (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcgs (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + nret = tbfags (tp, cp, row, buffer[i], 1, 1) + nullflag[i] = (IS_INDEFS (buffer[i])) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcgts: table type is messed up") + } +end + +# tbcgtb -- getcol Boolean +# This is for data type Boolean. + +procedure tbcgtb (tp, cp, buffer, nullflag, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +bool buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int sel_firstrow # i: first row from which to get values +int sel_lastrow # i: last row from which to get values +#-- +int firstrow, lastrow # actual range of row numbers +int i, row # loop indexes +int nret # for fits tables +int ival # for getting from a fits table +int tbfagi() +errchk tbsirow, tbxcgb, tbycgb, tbzcgb, tbfagi + +begin + call tbsirow (tp, sel_firstrow, firstrow) + call tbsirow (tp, sel_lastrow, lastrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcgb (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycgb (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcgb (tp, cp, buffer, nullflag, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + nret = tbfagi (tp, cp, row, ival, 1, 1) + if (IS_INDEFI(ival)) { + buffer[i] = false + nullflag[i] = true + } else { + buffer[i] = (ival == 1) + nullflag[i] = false + } + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcgtb: table type is messed up") + } +end + +# tbcgtt -- getcol text +# Read values for one column from a range of rows. This is for character +# strings. + +procedure tbcgtt (tp, cp, buffer, nullflag, lenstr, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +char buffer[lenstr,ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int lenstr # i: length of each element of buffer +int sel_firstrow # i: first row from which to get values +int sel_lastrow # i: last row from which to get values +#-- +int firstrow, lastrow # actual range of row numbers +int i, row # loop indexes +int nret # for fits tables +int tbfagt() +int strsearch() +errchk tbsirow, tbxcgt, tbycgt, tbzcgt, tbfagt + +begin + call tbsirow (tp, sel_firstrow, firstrow) + call tbsirow (tp, sel_lastrow, lastrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcgt (tp, cp, buffer, nullflag, lenstr, + firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycgt (tp, cp, buffer, nullflag, lenstr, + firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcgt (tp, cp, buffer, nullflag, lenstr, + firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + nret = tbfagt (tp, cp, row, buffer[1,i], lenstr, 1, 1) + nullflag[i] = (buffer[1,i] == EOS || + (strsearch (buffer[1,i], "INDEF") > 0)) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcgtt: table type is messed up") + } +end diff --git a/pkg/tbtables/tbciga.x b/pkg/tbtables/tbciga.x new file mode 100644 index 00000000..aad3c6a1 --- /dev/null +++ b/pkg/tbtables/tbciga.x @@ -0,0 +1,95 @@ +include +include "tbtables.h" + +# This define is here only temporarily. +define TBL_MAXDIM 7 # maximum dimension of array in table + +# This file contains tbciga and tbcisa. For a column that contains arrays, +# the dimension of the array and the length of each axis may be gotten or +# specified using these routines. +# +# For table types other than FITS, these routines just get or set the +# total array length. +# +# Phil Hodge, 18-Nov-1994 Subroutines created. +# Phil Hodge, 5-Jul-1995 Modify for FITS tables; change calling sequence. +# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length. + +# tbciga -- get dimension of array and length of each axis + +procedure tbciga (tp, cp, ndim, axlen, maxdim) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int ndim # o: dimension of array +int axlen[maxdim] # o: length of each axis +int maxdim # i: size of axlen array +#-- +errchk tbfiga + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfiga (tp, cp, ndim, axlen, maxdim) + } else { + ndim = 1 + axlen[1] = COL_NELEM(cp) + } +end + +# tbcisa -- set dimension of array and length of each axis + +procedure tbcisa (tp, cp, ndim, axlen) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int ndim # i: dimension of array +int axlen[ARB] # i: length of each axis +#-- +pointer sp +pointer errmess # scratch for possible error message +pointer colname # scratch for column name +int nelem # actual total number of elements in array +int nvals # total number specified as input +int i +errchk tbfisa + +begin + # Compare actual array size of column with the total number of + # elements specified as input. + nelem = COL_NELEM(cp) + nvals = 1 + do i = 1, ndim + nvals = nvals * axlen[i] + + if (nelem != nvals) { + call smark (sp) + call salloc (errmess, SZ_LINE, TY_CHAR) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call tbcigt (cp, TBL_COL_NAME, Memc[colname], SZ_COLNAME) + call sprintf (Memc[errmess], SZ_LINE, + "tbcisa: column `%s', actual array size=%d, specified size=%d") + call pargstr (Memc[colname]) + call pargi (nelem) + call pargi (nvals) + call error (1, Memc[errmess]) + } + + # Check whether dimension is too large. + if (ndim > TBL_MAXDIM) { + call smark (sp) + call salloc (errmess, SZ_LINE, TY_CHAR) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call tbcigt (cp, TBL_COL_NAME, Memc[colname], SZ_COLNAME) + call sprintf (Memc[errmess], SZ_LINE, + "tbcisa: column `%s', dimension %d is too large") + call pargstr (Memc[colname]) + call pargi (ndim) + call error (1, Memc[errmess]) + } + + # Assign values in column descriptor. + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfisa (tp, cp, ndim, axlen) + } + # else nothing +end diff --git a/pkg/tbtables/tbcigi.x b/pkg/tbtables/tbcigi.x new file mode 100644 index 00000000..45564d7d --- /dev/null +++ b/pkg/tbtables/tbcigi.x @@ -0,0 +1,70 @@ +include # defines SZB_CHAR +include +include "tbtables.h" +include "tblerr.h" + +# tbcigi -- get integer info about a column +# This function returns information of type integer about a column: +# either the column number, data type, length of its print format, +# or the number of elements if it's an array. +# The corresponding routine for text-string information is tbcigt. +# +# Phil Hodge, 2-Oct-1987 Subroutine created +# Phil Hodge, 7-Mar-1989 Check for TBL_TY_REAL, etc for data type. +# Phil Hodge, 30-Mar-1993 Include short datatype. +# Phil Hodge, 2-Aug-1994 Return actual array length using tbalen. +# Phil Hodge, 29-Apr-1997 TBL_COL_FMTLEN for format "%s" is string length. +# Phil Hodge, 14-Apr-1998 Use strcpy instead of strpak. +# Phil Hodge, 5-Aug-1999 For TBL_COL_LENDATA, use COL_NELEM to get the +# array length instead of calling tbalen. + +int procedure tbcigi (cptr, get_what) + +pointer cptr # i: pointer to column descriptor +int get_what # i: indicates what column info to get +#-- +int value # value that will be returned +char pformat[SZ_COLFMT] # format for printing the column +int ip, ctoi() # for getting lenfmt + +begin + switch (get_what) { + case TBL_COL_DATATYPE: # get data type of column + switch (COL_DTYPE(cptr)) { + case TBL_TY_REAL: + value = TY_REAL + case TBL_TY_DOUBLE: + value = TY_DOUBLE + case TBL_TY_INT: + value = TY_INT + case TBL_TY_SHORT: + value = TY_SHORT + case TBL_TY_BOOL: + value = TY_BOOL + case TBL_TY_CHAR: + value = -COL_LEN(cptr) * SZB_CHAR + default: + value = COL_DTYPE(cptr) + } + case TBL_COL_FMTLEN: # get length for printing + call strcpy (COL_FMT(cptr), pformat, SZ_COLFMT) + ip = 1 + if (pformat[ip] == '%') + ip = ip + 1 # skip over the leading '%' + if (pformat[ip] == '-') + ip = ip + 1 # skip over the minus sign + if (ctoi (pformat, ip, value) <= 0) { # no field width? + if (COL_DTYPE(cptr) < 0) + value = COL_LEN(cptr) * SZB_CHAR # max string length + else + value = 25 # a default value + } + case TBL_COL_NUMBER: # get column number + value = COL_NUMBER(cptr) + case TBL_COL_LENDATA: # get length of data array + value = COL_NELEM(cptr) + default: + call error (ER_TBUNKPARAM, "tbcigi: unknown parameter") + } + return (value) +end diff --git a/pkg/tbtables/tbcigt.x b/pkg/tbtables/tbcigt.x new file mode 100644 index 00000000..7f096a5c --- /dev/null +++ b/pkg/tbtables/tbcigt.x @@ -0,0 +1,32 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbcigt -- get text info about a column +# This procedure returns information of type string about a column: +# either column name, units, or print format. The corresponding +# routine for integer information is tbcigi. +# +# Phil Hodge, 2-Oct-1987 Subroutine created +# Phil Hodge, 14-Apr-1998 Use strcpy instead of strpak; remove pformat. + +procedure tbcigt (cptr, get_what, outstr, maxch) + +pointer cptr # i: pointer to column descriptor +int get_what # i: indicates what string to get +char outstr[maxch] # o: column name, units, or print format +int maxch # i: maximum length of output string +#-- + +begin + switch (get_what) { + case (TBL_COL_NAME): # get column name + call strcpy (COL_NAME(cptr), outstr, maxch) + case (TBL_COL_UNITS): # get units for column + call strcpy (COL_UNITS(cptr), outstr, maxch) + case (TBL_COL_FMT): # get print format + call strcpy (COL_FMT(cptr), outstr, maxch) + default: + call error (ER_TBUNKPARAM, "tbcigt: unknown parameter") + } +end diff --git a/pkg/tbtables/tbcinf.x b/pkg/tbtables/tbcinf.x new file mode 100644 index 00000000..30194984 --- /dev/null +++ b/pkg/tbtables/tbcinf.x @@ -0,0 +1,36 @@ +include +include "tbtables.h" + +# tbcinf -- get info about a column +# This procedure finds information about a column. For numeric and Boolean +# data types the value of datatype will be the SPP data type, but for a +# character string of length N the datatype will be -N. +# For the time being the value of lendata is just one. +# +# Phil Hodge, 10-Aug-87 Set lendata=1 and datatype = -n for char string. +# Phil Hodge, 7-Oct-87 Call tbcig[it] for each item. +# Phil Hodge, 8-Jun-92 Change order of declarations, and get colnum first. + +procedure tbcinf (colptr, + colnum, colname, colunits, colfmt, datatype, lendata, lenfmt) + +pointer colptr # i: Pointer to a column descriptor +int colnum # o: Column number +char colname[ARB] # o: Column name +char colunits[ARB] # o: Units for column +char colfmt[ARB] # o: Print format for display of column +int datatype # o: Data type of column (SPP type or -n) +int lendata # o: Number of elements (=1) +int lenfmt # o: Bytes for print format +#-- +int tbcigi() + +begin + colnum = tbcigi (colptr, TBL_COL_NUMBER) + call tbcigt (colptr, TBL_COL_NAME, colname, SZ_COLNAME) + call tbcigt (colptr, TBL_COL_UNITS, colunits, SZ_COLUNITS) + call tbcigt (colptr, TBL_COL_FMT, colfmt, SZ_COLFMT) + datatype = tbcigi (colptr, TBL_COL_DATATYPE) + lendata = tbcigi (colptr, TBL_COL_LENDATA) + lenfmt = tbcigi (colptr, TBL_COL_FMTLEN) +end diff --git a/pkg/tbtables/tbcnam.x b/pkg/tbtables/tbcnam.x new file mode 100644 index 00000000..9c0ab180 --- /dev/null +++ b/pkg/tbtables/tbcnam.x @@ -0,0 +1,33 @@ +include +include "tbtables.h" + +# tbcnam -- change column name +# This procedure replaces the column name. The column descriptor is +# updated, and if the table is not read-only the modified descriptor +# is also written back into the table. +# +# Phil Hodge, 19-Oct-1989 allow changing column name for a read-only table +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 9-Apr-1995 Modify for FITS tables. +# Phil Hodge, 14-Apr-1998 Change calling sequence of tbcwcd. + +procedure tbcnam (tp, cp, colname) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to a column descriptor +char colname[ARB] # i: column name +#-- +errchk tbcwcd, tbfnam + +begin + call strcpy (colname, COL_NAME(cp), SZ_COLNAME) + + if (!TB_READONLY(tp)) { + # Save modified column descriptor in table file. + if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfnam (tp, cp, colname) + else + call tbcwcd (tp, cp) + TB_MODIFIED(tp) = true + } +end diff --git a/pkg/tbtables/tbcnit.x b/pkg/tbtables/tbcnit.x new file mode 100644 index 00000000..142f6cc8 --- /dev/null +++ b/pkg/tbtables/tbcnit.x @@ -0,0 +1,33 @@ +include +include "tbtables.h" + +# tbcnit -- change column units +# This procedure replaces the units for a column. The column descriptor +# is updated, and if the table is not read-only the descriptor is also +# written back into the table. +# +# Phil Hodge, 19-Oct-1989 allow changing units for a read-only table +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 9-Apr-1995 Modify for FITS tables. +# Phil Hodge, 14-Apr-1998 Change calling sequence of tbcwcd. + +procedure tbcnit (tp, cp, colunits) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to a column descriptor +char colunits[ARB] # i: new value of units for column +#-- +errchk tbcwcd, tbfnit + +begin + call strcpy (colunits, COL_UNITS(cp), SZ_COLUNITS) + + if (!TB_READONLY(tp)) { + # Save modified column descriptor in table file. + if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfnit (tp, cp, colunits) + else + call tbcwcd (tp, cp) + TB_MODIFIED(tp) = true + } +end diff --git a/pkg/tbtables/tbcnum.x b/pkg/tbtables/tbcnum.x new file mode 100644 index 00000000..1bf6b90c --- /dev/null +++ b/pkg/tbtables/tbcnum.x @@ -0,0 +1,35 @@ +include "tbtables.h" + +# tbcnum -- get column pointer from number +# This function returns the column pointer corresponding to a given +# column number, or NULL if the column number is out of range. +# +# Phil Hodge, 2-Mar-1998 Map selected column descriptor to actual descriptor. + +pointer procedure tbcnum (tp, colnum) + +pointer tp # i: pointer to table descriptor +int colnum # i: column number (not pointer) +#-- +pointer cp +pointer tcs_column() + +begin + # Value to be returned if column number is out of range. + cp = NULL + + if (colnum < 1) + return (cp) + + if (TB_COLUMN_SELECT(tp) == YES) { # column selector was used + if (colnum <= TB_NSEL_COLS(tp)) { + cp = tcs_column (TB_SELCOL(tp,colnum)) + } + } else { # column selector not used + if (colnum <= TB_NCOLS(tp)) { + cp = TB_COLINFO(tp,colnum) + } + } + + return (cp) +end diff --git a/pkg/tbtables/tbcpt.x b/pkg/tbtables/tbcpt.x new file mode 100644 index 00000000..6db79d5e --- /dev/null +++ b/pkg/tbtables/tbcpt.x @@ -0,0 +1,301 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Write values for one column to a range of rows. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 3-Feb-1992 Add option for text table type. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 Include check that row is > 0. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 23-Jun-1995 Modify for FITS tables; +# change declaration of buffer in tbcptt to 2-D array. +# Phil Hodge, 29-Jul-1997 Call tbtwer for fits tables. +# Phil Hodge, 3-Mar-1998 Modify to allow for row selector. + +# tbcptd -- putcol double +# Write values for one column to a range of rows. This is for data type +# double precision. + +procedure tbcptd (tp, cp, buffer, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +double buffer[ARB] # i: array of values to be put into column +int sel_firstrow # i: first row into which to put values +int sel_lastrow # i: last row into which to put values +#-- +int firstrow, lastrow # range of actual row numbers +int row, i +errchk tbswer, tbxcpd, tbycpd, tbzcpd, tbfapd + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (sel_lastrow < sel_firstrow) + call error (1, "tbcptd: lastrow is less than firstrow") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # Also convert to actual row numbers. + call tbswer (tp, sel_lastrow, lastrow) + call tbswer (tp, sel_firstrow, firstrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcpd (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycpd (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcpd (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + call tbfapd (tp, cp, row, buffer[i], 1, 1) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcptd: table type is messed up") + } + + TB_MODIFIED(tp) = true +end + + +# tbcptr -- putcol real +# Write values for one column to a range of rows. This is for data type real. + +procedure tbcptr (tp, cp, buffer, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +real buffer[ARB] # i: array of values to be put into column +int sel_firstrow # i: first row into which to put values +int sel_lastrow # i: last row into which to put values +#-- +int firstrow, lastrow # range of actual row numbers +int row, i +errchk tbswer, tbxcpr, tbycpr, tbzcpr, tbfapr + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (sel_lastrow < sel_firstrow) + call error (1, "tbcptr: lastrow is less than firstrow") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # Also convert to actual row numbers. + call tbswer (tp, sel_lastrow, lastrow) + call tbswer (tp, sel_firstrow, firstrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcpr (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycpr (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcpr (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + call tbfapr (tp, cp, row, buffer[i], 1, 1) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcptr: table type is messed up") + } + + TB_MODIFIED(tp) = true +end + + +# tbcpti -- putcol integer +# Write values for one column to a range of rows. This is for data type +# integer. + +procedure tbcpti (tp, cp, buffer, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +int buffer[ARB] # i: array of values to be put into column +int sel_firstrow # i: first row into which to put values +int sel_lastrow # i: last row into which to put values +#-- +int firstrow, lastrow # range of actual row numbers +int row, i +errchk tbswer, tbxcpi, tbycpi, tbzcpi, tbfapi + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (sel_lastrow < sel_firstrow) + call error (1, "tbcpti: lastrow is less than firstrow") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # Also convert to actual row numbers. + call tbswer (tp, sel_lastrow, lastrow) + call tbswer (tp, sel_firstrow, firstrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcpi (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycpi (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcpi (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + call tbfapi (tp, cp, row, buffer[i], 1, 1) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcpti: table type is messed up") + } + + TB_MODIFIED(tp) = true +end + + +# tbcpts -- putcol short +# Write values for one column to a range of rows. This is for data type +# short integer. + +procedure tbcpts (tp, cp, buffer, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +short buffer[ARB] # i: array of values to be put into column +int sel_firstrow # i: first row into which to put values +int sel_lastrow # i: last row into which to put values +#-- +int firstrow, lastrow # range of actual row numbers +int row, i +errchk tbswer, tbxcps, tbycps, tbzcps, tbfaps + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (sel_lastrow < sel_firstrow) + call error (1, "tbcpts: lastrow is less than firstrow") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # Also convert to actual row numbers. + call tbswer (tp, sel_lastrow, lastrow) + call tbswer (tp, sel_firstrow, firstrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcps (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycps (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcps (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + call tbfaps (tp, cp, row, buffer[i], 1, 1) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcpts: table type is messed up") + } + + TB_MODIFIED(tp) = true +end + + +# tbcptb -- putcol Boolean +# This is for data type boolean. + +procedure tbcptb (tp, cp, buffer, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +bool buffer[ARB] # i: array of values to be put into column +int sel_firstrow # i: first row into which to put values +int sel_lastrow # i: last row into which to put values +#-- +int firstrow, lastrow # range of actual row numbers +int row, i +errchk tbswer, tbxcpb, tbycpb, tbzcpb, tbfapb + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (sel_lastrow < sel_firstrow) + call error (1, "tbcptb: lastrow is less than firstrow") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # Also convert to actual row numbers. + call tbswer (tp, sel_lastrow, lastrow) + call tbswer (tp, sel_firstrow, firstrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcpb (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycpb (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcpb (tp, cp, buffer, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + call tbfapb (tp, cp, row, buffer[i], 1, 1) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcptb: table type is messed up") + } + + TB_MODIFIED(tp) = true +end + + +# tbcptt -- putcol text +# Write values for one column to a range of rows. This is for character +# strings. + +procedure tbcptt (tp, cp, buffer, lenstr, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor of the column +char buffer[lenstr,ARB] # i: array of values to be put into column +int lenstr # i: number of char in each element of buffer +int sel_firstrow # i: first row into which to put values +int sel_lastrow # i: last row into which to put values +#-- +int firstrow, lastrow # range of actual row numbers +int row, i +errchk tbswer, tbxcpt, tbycpt, tbzcpt, tbfapt + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (sel_lastrow < sel_firstrow) + call error (1, "tbcptt: lastrow is less than firstrow") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # Also convert to actual row numbers. + call tbswer (tp, sel_lastrow, lastrow) + call tbswer (tp, sel_firstrow, firstrow) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxcpt (tp, cp, buffer, lenstr, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbycpt (tp, cp, buffer, lenstr, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzcpt (tp, cp, buffer, lenstr, firstrow, lastrow) + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + i = 1 + do row = firstrow, lastrow { + call tbfapt (tp, cp, row, buffer[1,i], lenstr, 1, 1) + i = i + 1 + } + } else { + call error (ER_TBCORRUPTED, "tbcptt: table type is messed up") + } + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbcrcd.x b/pkg/tbtables/tbcrcd.x new file mode 100644 index 00000000..2de1e961 --- /dev/null +++ b/pkg/tbtables/tbcrcd.x @@ -0,0 +1,211 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbcrcd -- read column descriptor +# This procedure reads a column descriptor from the table file. +# The same routine is used for both row-ordered and column-ordered tables. +# +# Note that it is assumed that SZ_COLNAME is larger than SZ_CD_COLNAME, etc. +# +# Phil Hodge, 21-Jun-1995 Check for text or FITS tables; check for TY_CHAR. +# Phil Hodge, 14-Apr-1998 Change calling sequence; +# change SZ_COLSTRUCT to SZ_COLDEF; +# EOS may be absent in table, to allow one more char. +# Phil Hodge, 5-Aug-1999 Assign a value to COL_NELEM; +# include tbalen in this file, since nothing else calls it. +# Phil Hodge, 23-Jun-2000 Assign values to COL_TDTYPE, COL_TSCAL, COL_TZERO. + +procedure tbcrcd (tp, cp, colnum) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int colnum # i: column number +#-- +pointer sp +pointer coldef # column descriptor read from table +pointer pformat # scratch for print format +pointer temp # scratch +long offset # location of column descriptor in table file +int stat # status from read operation +int read() +int tbalen() + +errchk seek, read + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT || TB_TYPE(tp) == TBL_TYPE_FITS) + call error (1, "tbcrcd: internal error") + + call smark (sp) + call salloc (coldef, LEN_COLDEF, TY_STRUCT) + call salloc (pformat, SZ_COLFMT, TY_CHAR) + call salloc (temp, SZ_COLNAME, TY_CHAR) + + offset = SZ_SIZINFO + + TB_MAXPAR(tp) * SZ_PACKED_REC + + (colnum-1) * SZ_COLDEF + 1 + call seek (TB_FILE(tp), offset) + + if (SZ_INT == SZ_INT32) { + + stat = read (TB_FILE(tp), Memi[coldef], SZ_COLDEF) + if (stat == EOF) + call error (ER_TBCINFMISSING, + "tbcrcd: EOF while reading column info for table") + + # Copy the column definition that we just read from the file into + # the column descriptor in memory. + COL_NUMBER(cp) = CD_COL_NUMBER(coldef) + COL_OFFSET(cp) = CD_COL_OFFSET(coldef) + COL_LEN(cp) = CD_COL_LEN(coldef) + COL_DTYPE(cp) = CD_COL_DTYPE(coldef) + + COL_NELEM(cp) = tbalen (cp) + # COL_TDTYPE, COL_TSCAL, COL_TZERO are only relevant for FITS tables + COL_TDTYPE(cp) = COL_DTYPE(cp) + COL_TSCAL(cp) = 1.d0 + COL_TZERO(cp) = 0.d0 + + # Check for and correct data type TY_CHAR. + if (COL_DTYPE(cp) == TBL_TY_CHAR) + COL_DTYPE(cp) = -COL_LEN(cp) * SZB_CHAR + + call tbbncp1 (CD_COL_NAME(coldef), COL_NAME(cp), + SZ_CD_COLNAME / SZB_CHAR) + call strupk (COL_NAME(cp), COL_NAME(cp), SZ_COLNAME) + + call tbbncp1 (CD_COL_UNITS(coldef), COL_UNITS(cp), + SZ_CD_COLUNITS / SZB_CHAR) + call strupk (COL_UNITS(cp), COL_UNITS(cp), SZ_COLUNITS) + + # include a leading '%' in the print format + Memc[pformat] = '%' + call tbbncp1 (CD_COL_FMT(coldef), Memc[pformat+1], + SZ_CD_COLFMT / SZB_CHAR) + call strupk (Memc[pformat+1], Memc[pformat+1], SZ_COLFMT-1) + call strcpy (Memc[pformat], COL_FMT(cp), SZ_COLFMT) + + } else { + # Read the first four int values. + stat = read (TB_FILE(tp), Memi[coldef], 4 * SZ_INT32) + call iupk32 (Memi[coldef], Memi[coldef], 4 * SZ_INT32) + + # Copy the column definition that we just read from the file into + # the column descriptor in memory. + COL_NUMBER(cp) = CD_COL_NUMBER(coldef) + COL_OFFSET(cp) = CD_COL_OFFSET(coldef) + COL_LEN(cp) = CD_COL_LEN(coldef) + COL_DTYPE(cp) = CD_COL_DTYPE(coldef) + + COL_NELEM(cp) = tbalen (cp) + COL_TDTYPE(cp) = COL_DTYPE(cp) + COL_TSCAL(cp) = 1.d0 + COL_TZERO(cp) = 0.d0 + + # Check for and correct data type TY_CHAR. + if (COL_DTYPE(cp) == TBL_TY_CHAR) + COL_DTYPE(cp) = -COL_LEN(cp) * SZB_CHAR + + call aclrc (Memc[temp], SZ_COLNAME) + call aclrc (COL_NAME(cp), SZ_COLNAME) + stat = read (TB_FILE(tp), Memc[temp], SZ_CD_COLNAME/SZB_CHAR) + call strupk (Memc[temp], COL_NAME(cp), SZ_COLNAME) + + call aclrc (Memc[temp], SZ_COLUNITS) + call aclrc (COL_UNITS(cp), SZ_COLUNITS) + stat = read (TB_FILE(tp), Memc[temp], SZ_CD_COLUNITS/SZB_CHAR) + call strupk (Memc[temp], COL_UNITS(cp), SZ_COLUNITS) + + call aclrc (Memc[temp], SZ_COLFMT) + call aclrc (Memc[pformat], SZ_COLFMT) + call aclrc (COL_FMT(cp), SZ_COLFMT) + # include a leading '%' in the print format + Memc[pformat] = '%' + stat = read (TB_FILE(tp), Memc[temp], SZ_CD_COLFMT/SZB_CHAR) + call strupk (Memc[temp], Memc[temp], SZ_COLFMT) + call strcpy ("%", COL_FMT(cp), SZ_COLFMT) + call strcat (Memc[temp], COL_FMT(cp), SZ_COLFMT) + } + + call sfree (sp) +end + +# tbbncp1 -- string copy +# This routine just copies ncopy characters to the output string. It is +# used because some of the strings to be copied are macros that would not +# allow using a subscript. +# +# Note that exactly ncopy characters are copied, regardless of whether +# there's an EOS or not. An end-of-string will be added at ncopy+1; this +# distinguishes tbbncp1 from tbbncp0. + +procedure tbbncp1 (in, out, ncopy) + +char in[ARB] # i: input string +char out[ARB] # o: output string +int ncopy # i: number of char to copy to out +#-- +int k + +begin + do k = 1, ncopy + out[k] = in[k] + + out[ncopy+1] = EOS +end + +# tbalen -- number of elements in array +# This routine returns the number of elements in a table entry. + +int procedure tbalen (cptr) + +pointer cptr # i: pointer to column descriptor +#-- +int clen # length in char of entire entry +int value # this will be returned +int tbeszt() # size in char of one element of type text + +begin + clen = COL_LEN(cptr) + + switch (COL_DTYPE(cptr)) { + case TBL_TY_REAL: + if (clen > SZ_REAL) + value = clen / SZ_REAL + else + value = 1 + + case TBL_TY_DOUBLE: + if (clen > SZ_DOUBLE) + value = clen / SZ_DOUBLE + else + value = 1 + + case TBL_TY_INT: + if (clen > SZ_INT32) + value = clen / SZ_INT32 + else + value = 1 + + case TBL_TY_SHORT: + if (clen > SZ_SHORT) + value = clen / SZ_SHORT + else + value = 1 + + case TBL_TY_BOOL: + if (clen > SZ_BOOL) + value = clen / SZ_BOOL + else + value = 1 + + default: + value = clen / tbeszt (cptr) # char string + } + + return (value) +end diff --git a/pkg/tbtables/tbcscal.x b/pkg/tbtables/tbcscal.x new file mode 100644 index 00000000..35b2bcf3 --- /dev/null +++ b/pkg/tbtables/tbcscal.x @@ -0,0 +1,75 @@ +include +include "tbtables.h" + +# This routine copies the tscal & tzero values to COL_TSCAL & COL_TZERO. +# +# This routine will return without doing anything if: +# the table type isn't FITS +# the "true" data type is a floating type, or boolean, or text +# the input tscal & tzero are 1 & 0 respectively or are INDEFD. +# +# Unless the data type already is a floating type, it will be changed to +# real or double. If the actual data type in the table file is int, the +# apparent data type will be set to double; otherwise (i.e. short or byte), +# the apparent data type will be set to real. +# +# If the table is open, the TSCALi and TZEROi keywords will be added to +# the header (or updated, if they're already present). +# +# This is the interface routine; tbfscal is lower level. +# +# Phil Hodge, 23-Jun-2000 Subroutine created. + +procedure tbcscal (tp, cp, tscal, tzero) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +double tscal # i: scale factor for column +double tzero # i: zero offset for column +#-- +int tdtype # "true" data type (we expect short or int) +int dtype # "apparent" data type +bool modify # true if either tscal or tzero differs from default +errchk tbfscal + +begin + if (TB_TYPE(tp) != TBL_TYPE_FITS) + return # scaling parameters can't be used + + dtype = COL_DTYPE(cp) + tdtype = COL_TDTYPE(cp) + + # Scaling is only appropriate if the true data type in the table + # file is an integer type. + if (tdtype == TBL_TY_REAL || tdtype == TBL_TY_DOUBLE || + tdtype == TBL_TY_BOOL || tdtype < 0) { + return + } + + modify = false # initial value + + if (tscal != 1.d0 && !IS_INDEFD(tscal)) { + COL_TSCAL(cp) = tscal + modify = true + } + + if (tzero != 1.d0 && !IS_INDEFD(tzero)) { + COL_TZERO(cp) = tzero + modify = true + } + + if (!modify) + return # nothing to do + + # Change the data type to a floating type, if it isn't already. + if (dtype != TBL_TY_REAL && dtype != TBL_TY_DOUBLE) { + if (tdtype == TBL_TY_INT) + COL_DTYPE(cp) = TBL_TY_DOUBLE + else + COL_DTYPE(cp) = TBL_TY_REAL + } + + # Write these values to keywords TSCALi and TZEROi. + if (TB_IS_OPEN(tp)) + call tbfscal (tp, cp) +end diff --git a/pkg/tbtables/tbctpe.x b/pkg/tbtables/tbctpe.x new file mode 100644 index 00000000..0f717fe8 --- /dev/null +++ b/pkg/tbtables/tbctpe.x @@ -0,0 +1,103 @@ +include +include "tbtables.h" + +# tbctpe -- copy from template +# This procedure copies various table parameters (but not all) from a +# template table to a table which is being initialized but has not yet +# been created. Then, for each column in the template table, this +# procedure creates a column descriptor for the new table and copies +# information from the column descriptor for the template to that of +# the new table. +# +# The table type is normally inherited from the template table. The +# one exception to this is that if the new table has the extension +# ".fits", the user has specified the type, and we don't override it. +# For an input text table, the subtype is also copied to the output table. +# +# Important parameters which are not copied from the template are the +# number of rows TB_NROWS, the number of user parameters TB_NPAR, and +# TB_MAXCOLS. The latter must have been set by the calling routine +# (tbtopn) which allocates the array of pointers to column descriptors. +# NOTE: This procedure must be called before explicitly defining any new +# column, before setting any parameter, and before opening (creating) the +# table. +# +# Phil Hodge, 8-Oct-1987 Take most parameters from template; don't realloc. +# Phil Hodge, 7-Feb-1992 Add option for text table type. +# Phil Hodge, 11-May-1994 For text table, don't allocate comment buffer. +# Phil Hodge, 23-Dec-1994 Check for CDF or FITS file. +# Phil Hodge, 30-Sep-1997 For template table, use tbpsta & tbcnum instead of +# TB_NCOLS, TB_COLINFO, TB_ROWLEN, and TB_COLUSED. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE. +# Phil Hodge, 15-Jun-1999 Copy subtype for text table. + +procedure tbctpe (tp, template) + +pointer tp # i: pointer to descriptor of new table +pointer template # i: pointer to descriptor of template table +#-- +pointer icp, ocp # pointers to column descriptors +int k # loop index +int colnum # column number, a loop index +int offset # for recomputing COL_OFFSET +long tbtbod() +int tbpsta(), tbcnum() +errchk calloc + +begin + # Copy the table type from the template, unless either the + # table or the template has a file type of FITS. + if (TB_TYPE(tp) != TBL_TYPE_FITS && + TB_TYPE(template) != TBL_TYPE_FITS) + TB_TYPE(tp) = TB_TYPE(template) # copy from template + + # Copy the subtype, if the input is a text table. + if (TB_TYPE(template) == TBL_TYPE_TEXT) + TB_SUBTYPE(tp) = TB_SUBTYPE(template) + + TB_NCOLS(tp) = tbpsta (template, TBL_NCOLS) + TB_MAXPAR(tp) = TB_MAXPAR(template) + TB_ALLROWS(tp) = TB_ALLROWS(template) + TB_COLUSED(tp) = tbpsta (template, TBL_ROWLEN_CHAR_USED) + TB_ROWLEN(tp) = tbpsta (template, TBL_ROWLEN_CHAR) + + TB_BOD(tp) = tbtbod (TB_MAXPAR(tp), TB_MAXCOLS(tp)) + + # Create a descriptor for each column, and copy values. + # icp is a column pointer in template, and + # ocp is a column pointer in tp. + offset = 0 # only needed if column selector used + do colnum = 1, tbpsta (template, TBL_NCOLS) { + icp = tbcnum (template, colnum) + call calloc (ocp, LEN_COLSTRUCT, TY_STRUCT) + TB_COLINFO(tp,colnum) = ocp + + # Copy the contents of the column descriptor. + do k = 1, LEN_COLSTRUCT + Memi[ocp+k-1] = Memi[icp+k-1] + + # Update column number and offset if a column selector was used. + if (TB_COLUMN_SELECT(template) == YES) { + COL_NUMBER(ocp) = colnum + COL_OFFSET(ocp) = offset + offset = offset + COL_LEN(ocp) + } + } + + # COL_OFFSET must be given reasonable values in case the template + # table is of type "text" but the type of the new table will be + # changed to something else. If the type is still "text" when + # tbtcre is called, COL_OFFSET will be overwritten at that time + # by a pointer to memory for the column data. + if (TB_TYPE(template) == TBL_TYPE_TEXT || + TB_TYPE(template) == TBL_TYPE_FITS) { + offset = 0 + do colnum = 1, TB_NCOLS(tp) { + ocp = tbcnum (tp, colnum) + COL_OFFSET(ocp) = offset + offset = offset + COL_LEN(ocp) + } + TB_ROWLEN(tp) = offset + TB_COLUSED(tp) = offset + } +end diff --git a/pkg/tbtables/tbcwcd.x b/pkg/tbtables/tbcwcd.x new file mode 100644 index 00000000..da1d669a --- /dev/null +++ b/pkg/tbtables/tbcwcd.x @@ -0,0 +1,117 @@ +include +include +include "tbtables.h" + +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbcwcd -- write column descriptor +# This procedure writes the column descriptor into the table file. +# +# Note that it is assumed that SZ_COLNAME is larger than SZ_CD_COLNAME, etc. +# +# Phil Hodge, 3-Feb-1992 Add check for text table type. +# Phil Hodge, 21-Jun-1995 Modify for FITS tables +# Phil Hodge, 5-Mar-1998 Include tp in call to tbcnum. +# Phil Hodge, 14-Apr-1998 Change calling sequence; +# change SZ_COLSTRUCT to SZ_COLDEF; +# EOS may be absent in table, to allow one more char. + +procedure tbcwcd (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +pointer sp +pointer coldef # column descriptor read from table +pointer temp # scratch for strings +long offset # location of column descriptor in table file +int colnum # column number + +errchk seek, write + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT) + return # nothing to do + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfwcd (tp, cp) + return + } + + call smark (sp) + call salloc (coldef, LEN_COLDEF, TY_STRUCT) + + # This assumes SZ_COLUNITS & SZ_COLFMT are no longer than SZ_COLNAME. + call salloc (temp, SZ_COLNAME, TY_CHAR) + + # Copy the column descriptor from memory into the buffer that + # we'll write to the file. + CD_COL_NUMBER(coldef) = COL_NUMBER(cp) + CD_COL_OFFSET(coldef) = COL_OFFSET(cp) + CD_COL_LEN(coldef) = COL_LEN(cp) + CD_COL_DTYPE(coldef) = COL_DTYPE(cp) + + colnum = COL_NUMBER(cp) + offset = SZ_SIZINFO + + TB_MAXPAR(tp) * SZ_PACKED_REC + + (colnum-1) * SZ_COLDEF + 1 + + call strpak (COL_NAME(cp), Memc[temp], SZ_COLNAME) + call tbbncp0 (Memc[temp], CD_COL_NAME(coldef), SZ_CD_COLNAME/SZB_CHAR) + + call strpak (COL_UNITS(cp), Memc[temp], SZ_COLNAME) + call tbbncp0 (Memc[temp], CD_COL_UNITS(coldef), SZ_CD_COLUNITS/SZB_CHAR) + + call strcpy (COL_FMT(cp), Memc[temp], SZ_COLNAME) + + # skip over the leading '%' in the print format + call strpak (Memc[temp+1], Memc[temp+1], SZ_COLNAME-1) + call tbbncp0 (Memc[temp+1], CD_COL_FMT(coldef), SZ_CD_COLFMT/SZB_CHAR) + + if (SZ_INT == SZ_INT32) { + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), Memi[coldef], SZ_COLDEF) + + } else { + # Write first four members of the struct. + call ipak32 (Memi[coldef], Memi[coldef], 4 * SZ_INT) + call write (TB_FILE(tp), Memi[coldef], 4 * SZ_INT32) + + call aclrc (Memc[temp], SZ_COLNAME) + call strpak (COL_NAME(cp), Memc[temp], SZ_CD_COLNAME) + call write (TB_FILE(tp), Memc[temp], SZ_CD_COLNAME/SZB_CHAR) + + call aclrc (Memc[temp], SZ_COLNAME) + call strpak (COL_UNITS(cp), Memc[temp], SZ_CD_COLUNITS) + call write (TB_FILE(tp), Memc[temp], SZ_CD_COLUNITS/SZB_CHAR) + + call aclrc (Memc[temp], SZ_COLNAME) + call strcpy (COL_FMT(cp), Memc[temp], SZ_COLNAME) + call strpak (Memc[temp+1], Memc[temp+1], SZ_CD_COLFMT) + call write (TB_FILE(tp), Memc[temp+1], SZ_CD_COLFMT/SZB_CHAR) + } + + call sfree (sp) +end + +# tbbncp0 -- string copy +# This routine just copies ncopy characters to the output string. It is +# used because some of the strings to be copied are macros that would not +# allow using a subscript. +# +# Note that exactly ncopy characters are copied, regardless of whether +# there's an EOS or not. Note that this routine does not add an EOS after +# copying ncopy elements; this distinguishes tbbncp0 from tbbncp1. + +procedure tbbncp0 (in, out, ncopy) + +char in[ARB] # i: input string +char out[ARB] # o: output string +int ncopy # i: number of char to copy to out +#-- +int k + +begin + do k = 1, ncopy + out[k] = in[k] +end diff --git a/pkg/tbtables/tbdsav.x b/pkg/tbtables/tbdsav.x new file mode 100644 index 00000000..a501811b --- /dev/null +++ b/pkg/tbtables/tbdsav.x @@ -0,0 +1,76 @@ +include "tbtables.h" + +# This file contains three routines (tbdsav, tbdres, tbdfre) for saving +# and possibly restoring the size information contained in a table +# descriptor. If some routine needs to change the size of some portion +# of a table (e.g. when adding a new column), then tbdsav should be called +# prior to modifying the table descriptor. In the event of an error while +# the table is being rewritten, then tbdres should be called to restore +# the size info before calling erract. If there is no error, then tbdfre +# would be called to deallocate the memory allocated by tbdsav. +# +# Phil Hodge, 25-Apr-1989 Subroutines created. + +# tbdsav -- save table descriptor +# This routine saves those values of a table descriptor having to do +# with the sizes of various portions of a table. + +procedure tbdsav (tp, tp_save) + +pointer tp # i: pointer to table descriptor +pointer tp_save # o: pointer to space for saving size info +#-- + +begin + call malloc (tp_save, LEN_TBLSTRUCT, TY_STRUCT) + + TB_TYPE(tp_save) = TB_TYPE(tp) + TB_NPAR(tp_save) = TB_NPAR(tp) + TB_MAXPAR(tp_save) = TB_MAXPAR(tp) + TB_NROWS(tp_save) = TB_NROWS(tp) + TB_ALLROWS(tp_save) = TB_ALLROWS(tp) + TB_NCOLS(tp_save) = TB_NCOLS(tp) + TB_MAXCOLS(tp_save) = TB_MAXCOLS(tp) + TB_COLUSED(tp_save) = TB_COLUSED(tp) + TB_ROWLEN(tp_save) = TB_ROWLEN(tp) + TB_BOD(tp_save) = TB_BOD(tp) + TB_IOMODE(tp_save) = TB_IOMODE(tp) +end + +# tbdres -- restore table descriptor +# This routine restores those values of a table descriptor having to do +# with the sizes of various portions of a table. Memory that was allocated +# by tbdsav is deallocated. + +procedure tbdres (tp, tp_save) + +pointer tp # i: pointer to table descriptor +pointer tp_save # io: pointer to space for saving size info +#-- + +begin + TB_TYPE(tp) = TB_TYPE(tp_save) + TB_NPAR(tp) = TB_NPAR(tp_save) + TB_MAXPAR(tp) = TB_MAXPAR(tp_save) + TB_NROWS(tp) = TB_NROWS(tp_save) + TB_ALLROWS(tp) = TB_ALLROWS(tp_save) + TB_NCOLS(tp) = TB_NCOLS(tp_save) + TB_MAXCOLS(tp) = TB_MAXCOLS(tp_save) + TB_COLUSED(tp) = TB_COLUSED(tp_save) + TB_ROWLEN(tp) = TB_ROWLEN(tp_save) + TB_BOD(tp) = TB_BOD(tp_save) + TB_IOMODE(tp) = TB_IOMODE(tp_save) + + call tbdfre (tp_save) # free tp_save +end + +# tbdfre -- free scratch space +# This routine deallocates the memory that was allocated by tbdsav. + +procedure tbdfre (tp_save) + +pointer tp_save # o: pointer to space for saving size info + +begin + call mfree (tp_save, TY_STRUCT) +end diff --git a/pkg/tbtables/tbegp.x b/pkg/tbtables/tbegp.x new file mode 100644 index 00000000..5f93e46f --- /dev/null +++ b/pkg/tbtables/tbegp.x @@ -0,0 +1,123 @@ +include # for unpacking strings in tbegpt +include "tbtables.h" + +# tbegp[tbirds] -- primitive get element +# This procedure reads one element (i.e. row, column) from a table. +# No type conversion is performed, and there is no checking for INDEF +# values. Character strings will be unpacked by tbegpt, however. +# +# Phil Hodge, 15-Sep-1987 Subroutine created. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 13-Sep-1994 In tbegpt, use tbeszt for length of string to read. + +procedure tbegpb (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +bool buffer # o: buffer to receive value +#-- +int read() +errchk seek, read + +begin + call seek (TB_FILE(tp), offset) + if (read (TB_FILE(tp), buffer, SZ_BOOL) < SZ_BOOL) + call error (1, "tbegpb: unexpected end of file") +end + +procedure tbegpd (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +double buffer # o: buffer to receive value +#-- +int read() +errchk seek, read + +begin + call seek (TB_FILE(tp), offset) + if (read (TB_FILE(tp), buffer, SZ_DOUBLE) < SZ_DOUBLE) + call error (1, "tbegpd: unexpected end of file") +end + +procedure tbegpr (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +real buffer # o: buffer to receive value +#-- +int read() +errchk seek, read + +begin + call seek (TB_FILE(tp), offset) + if (read (TB_FILE(tp), buffer, SZ_REAL) < SZ_REAL) + call error (1, "tbegpr: unexpected end of file") +end + +procedure tbegpi (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +int buffer # o: buffer to receive value +#-- +int read() +errchk seek, read + +begin + call seek (TB_FILE(tp), offset) + if (read (TB_FILE(tp), buffer, SZ_INT32) < SZ_INT32) + call error (1, "tbegpi: unexpected end of file") + if (SZ_INT != SZ_INT32) + call iupk32 (buffer, buffer, 1) +end + +procedure tbegps (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +short buffer # o: buffer to receive value +#-- +int read() +errchk seek, read + +begin + call seek (TB_FILE(tp), offset) + if (read (TB_FILE(tp), buffer, SZ_SHORT) < SZ_SHORT) + call error (1, "tbegps: unexpected end of file") +end + +procedure tbegpt (tp, cptr, offset, rownum, buffer, maxch) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +char buffer[ARB] # o: buffer to receive value +int maxch # i: max number of char to read +#-- +char cbuf[SZ_LINE] # buffer for reading from table +int nchar # number of char to read +int read() +int tbeszt() +errchk seek, read + +begin + nchar = min (tbeszt (cptr), SZ_LINE) + call seek (TB_FILE(tp), offset) + if (read (TB_FILE(tp), cbuf, nchar) < nchar) + call error (1, "tbegpt: unexpected end of file") + # It may be that no EOS was read from the entry in the table. + cbuf[nchar+1] = EOS + call strupk (cbuf, buffer, maxch) +end diff --git a/pkg/tbtables/tbegt.x b/pkg/tbtables/tbegt.x new file mode 100644 index 00000000..f9c97cc0 --- /dev/null +++ b/pkg/tbtables/tbegt.x @@ -0,0 +1,489 @@ +include # for MAX_INT, MAX_SHORT, and MAX_REAL +include +include "tbtables.h" +include "tblerr.h" + +# tbegt[tbirds] -- get a single element +# These routines read a single element from a table. The value is +# read by a "primitive get element" (tbegp[]) routine into a buffer +# of the same data type as the column in the table, and that value is +# assigned to the output buffer. +# +# Phil Hodge, 17-Sep-1987 Subroutine created. +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 31-Mar-1993 Include short datatype; in tbegtb, for types other +# than boolean, change test from "if (buf == YES)" to "if (buf != NO)". +# Phil Hodge, 4-Nov-1993 Include check on row number less than one; +# call sscan as a subroutine, not a function. +# Phil Hodge, 29-Jul-1994 Change calling sequence of tbeoff. +# Phil Hodge, 9-Jun-1995 Modify for FITS tables. +# Phil Hodge, 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge, 2-Mar-1998 Map selected row number to actual row number. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. + +procedure tbegtd (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +double buffer # o: buffer for value to be gotten +#-- +int rownum # actual row number +long offset # offset in char to location for reading +int dtype # data type of column +int nret +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +real rbuf +int ibuf +short sbuf +bool bbuf +long tbeoff() +int tbfagd() +int nscan() +errchk tbsirow, tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, tbfagd, tbzgtd + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzgtd (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + nret = tbfagd (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegpr (tp, cptr, offset, rownum, rbuf) + if (IS_INDEFR(rbuf)) + buffer = INDEFD + else + buffer = rbuf + case TBL_TY_DOUBLE: + call tbegpd (tp, cptr, offset, rownum, buffer) + if (TBL_IS_INDEFD (buffer)) + buffer = INDEFD + case TBL_TY_INT: + call tbegpi (tp, cptr, offset, rownum, ibuf) + if (IS_INDEFI(ibuf)) + buffer = INDEFD + else + buffer = ibuf + case TBL_TY_SHORT: + call tbegps (tp, cptr, offset, rownum, sbuf) + if (IS_INDEFS(sbuf)) + buffer = INDEFD + else + buffer = sbuf + case TBL_TY_BOOL: + call tbegpb (tp, cptr, offset, rownum, bbuf) + if (bbuf) + buffer = double (YES) + else + buffer = double (NO) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call tbegpt (tp, cptr, offset, rownum, cbuf, SZ_FNAME) + call sscan (cbuf) + call gargd (buffer) + if (nscan() < 1) + buffer = INDEFD + } else { + call error (ER_TBCOLBADTYP, + "tbegtd: bad data type; table or memory corrupted?") + } + } +end + +procedure tbegtr (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +real buffer # o: buffer for value to be gotten +#-- +int rownum # actual row number +long offset # offset in char to location for reading +int dtype # data type of column +int nret +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +int ibuf +short sbuf +bool bbuf +long tbeoff() +int tbfagr() +int nscan() +errchk tbsirow, tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, tbfagr, tbzgtr + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzgtr (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + nret = tbfagr (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegpr (tp, cptr, offset, rownum, buffer) + case TBL_TY_DOUBLE: + call tbegpd (tp, cptr, offset, rownum, dbuf) + if (TBL_IS_INDEFD (dbuf) || abs (dbuf) > MAX_REAL) + buffer = INDEFR + else + buffer = dbuf + case TBL_TY_INT: + call tbegpi (tp, cptr, offset, rownum, ibuf) + if (IS_INDEFI(ibuf)) + buffer = INDEFR + else + buffer = ibuf + case TBL_TY_SHORT: + call tbegps (tp, cptr, offset, rownum, sbuf) + if (IS_INDEFS(sbuf)) + buffer = INDEFR + else + buffer = sbuf + case TBL_TY_BOOL: + call tbegpb (tp, cptr, offset, rownum, bbuf) + if (bbuf) + buffer = real (YES) + else + buffer = real (NO) + default: + if (dtype < 0 || dtype == TY_CHAR) { + buffer = INDEFR + call tbegpt (tp, cptr, offset, rownum, cbuf, SZ_FNAME) + call sscan (cbuf) + call gargr (buffer) + if (nscan() < 1) + buffer = INDEFR + } else { + call error (ER_TBCOLBADTYP, + "tbegtr: bad data type; table or memory corrupted?") + } + } +end + +procedure tbegti (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +int buffer # o: buffer for value to be gotten +#-- +int rownum # actual row number +long offset # offset in char to location for reading +int dtype # data type of column +int nret +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +short sbuf +bool bbuf +long tbeoff() +int tbfagi() +int nscan() +errchk tbsirow, tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, tbfagi, tbzgti + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzgti (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + nret = tbfagi (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegpr (tp, cptr, offset, rownum, rbuf) + if (IS_INDEFR(rbuf) || abs (rbuf) > MAX_INT) + buffer = INDEFI + else + buffer = nint (rbuf) + case TBL_TY_DOUBLE: + call tbegpd (tp, cptr, offset, rownum, dbuf) + if (TBL_IS_INDEFD (dbuf) || abs (dbuf) > MAX_INT) + buffer = INDEFI + else + buffer = nint (dbuf) + case TBL_TY_INT: + call tbegpi (tp, cptr, offset, rownum, buffer) + case TBL_TY_SHORT: + call tbegps (tp, cptr, offset, rownum, sbuf) + if (IS_INDEFS(sbuf)) + buffer = INDEFI + else + buffer = sbuf + case TBL_TY_BOOL: + call tbegpb (tp, cptr, offset, rownum, bbuf) + if (bbuf) + buffer = YES + else + buffer = NO + default: + if (dtype < 0 || dtype == TY_CHAR) { + call tbegpt (tp, cptr, offset, rownum, cbuf, SZ_FNAME) + call sscan (cbuf) + call gargd (dbuf) + if (nscan() < 1) + buffer = INDEFI + else if (IS_INDEFD(dbuf) || abs (dbuf) > MAX_INT) + buffer = INDEFI + else + buffer = nint (dbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbegti: bad data type; table or memory corrupted?") + } + } +end + +procedure tbegts (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +short buffer # o: buffer for value to be gotten +#-- +int rownum # actual row number +long offset # offset in char to location for reading +int dtype # data type of column +int nret +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +int ibuf +bool bbuf +long tbeoff() +int tbfags() +int nscan() +errchk tbsirow, tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, tbfags, tbzgts + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzgts (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + nret = tbfags (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegpr (tp, cptr, offset, rownum, rbuf) + if (IS_INDEFR(rbuf) || (abs (rbuf) > MAX_SHORT)) + buffer = INDEFS + else + buffer = nint (rbuf) + case TBL_TY_DOUBLE: + call tbegpd (tp, cptr, offset, rownum, dbuf) + if (TBL_IS_INDEFD (dbuf) || abs (dbuf) > MAX_SHORT) + buffer = INDEFS + else + buffer = nint (dbuf) + case TBL_TY_INT: + call tbegpi (tp, cptr, offset, rownum, ibuf) + if (IS_INDEFI(ibuf) || (abs (ibuf) > MAX_SHORT)) + buffer = INDEFS + else + buffer = ibuf + case TBL_TY_SHORT: + call tbegps (tp, cptr, offset, rownum, buffer) + case TBL_TY_BOOL: + call tbegpb (tp, cptr, offset, rownum, bbuf) + if (bbuf) + buffer = YES + else + buffer = NO + default: + if (dtype < 0 || dtype == TY_CHAR) { + call tbegpt (tp, cptr, offset, rownum, cbuf, SZ_FNAME) + call sscan (cbuf) + call gargd (dbuf) + if (nscan() < 1) + buffer = INDEFS + else if (IS_INDEFD(dbuf) || abs (dbuf) > MAX_SHORT) + buffer = INDEFS + else + buffer = nint (dbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbegts: bad data type; table or memory corrupted?") + } + } +end + +procedure tbegtb (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +bool buffer # o: buffer for value to be gotten +#-- +int rownum # actual row number +long offset # offset in char to location for reading +int dtype # data type of column +int nret +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +int ibuf +short sbuf +long tbeoff() +int tbfagb() +int nscan() +errchk tbsirow, tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, tbfagb, tbzgtb + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzgtb (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + nret = tbfagb (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegpr (tp, cptr, offset, rownum, rbuf) + if (IS_INDEFR(rbuf) || (nint (rbuf) == NO)) + buffer = false + else + buffer = true + case TBL_TY_DOUBLE: + call tbegpd (tp, cptr, offset, rownum, dbuf) + if (TBL_IS_INDEFD (dbuf) || (nint (dbuf) == NO)) + buffer = false + else + buffer = true + case TBL_TY_INT: + call tbegpi (tp, cptr, offset, rownum, ibuf) + if (IS_INDEFI(ibuf) || (ibuf == NO)) + buffer = false + else + buffer = true + case TBL_TY_SHORT: + call tbegps (tp, cptr, offset, rownum, sbuf) + if (IS_INDEFS(sbuf) || (sbuf == NO)) + buffer = false + else + buffer = true + case TBL_TY_BOOL: + call tbegpb (tp, cptr, offset, rownum, buffer) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call tbegpt (tp, cptr, offset, rownum, cbuf, SZ_FNAME) + call sscan (cbuf) + call gargb (buffer) + if (nscan() < 1) + buffer = false + } else { + call error (ER_TBCOLBADTYP, + "tbegtb: bad data type; table or memory corrupted?") + } + } +end + +procedure tbegtt (tp, cptr, selrow, buffer, maxch) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +char buffer[ARB] # o: buffer for value to be gotten +int maxch # i: max number of char in output string +#-- +int rownum # actual row number +long offset # offset in char to location for reading +int dtype # data type of column +int nret +# buffers for copying elements of various data types +double dbuf +real rbuf +int ibuf +short sbuf +bool bbuf +long tbeoff() +int tbfagt() +errchk tbsirow, tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, tbfagt, tbzgtt + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzgtt (tp, cptr, rownum, buffer, maxch) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + nret = tbfagt (tp, cptr, rownum, buffer, maxch, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegpr (tp, cptr, offset, rownum, rbuf) + call sprintf (buffer, maxch, COL_FMT(cptr)) + call pargr (rbuf) + case TBL_TY_DOUBLE: + call tbegpd (tp, cptr, offset, rownum, dbuf) + if (TBL_IS_INDEFD (dbuf)) { + call strcpy ("INDEF", buffer, maxch) + } else { + call sprintf (buffer, maxch, COL_FMT(cptr)) + call pargd (dbuf) + } + case TBL_TY_INT: + call tbegpi (tp, cptr, offset, rownum, ibuf) + call sprintf (buffer, maxch, COL_FMT(cptr)) + call pargi (ibuf) + case TBL_TY_SHORT: + call tbegps (tp, cptr, offset, rownum, sbuf) + call sprintf (buffer, maxch, COL_FMT(cptr)) + call pargs (sbuf) + case TBL_TY_BOOL: + call tbegpb (tp, cptr, offset, rownum, bbuf) + call sprintf (buffer, maxch, COL_FMT(cptr)) + call pargb (bbuf) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call tbegpt (tp, cptr, offset, rownum, buffer, maxch) + } else { + call error (ER_TBCOLBADTYP, + "tbegtt: bad data type; table or memory corrupted?") + } + } +end diff --git a/pkg/tbtables/tbeoff.x b/pkg/tbtables/tbeoff.x new file mode 100644 index 00000000..4f39a98b --- /dev/null +++ b/pkg/tbtables/tbeoff.x @@ -0,0 +1,60 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbeoff -- get offset to an element +# This function returns the offset to an element (a specific row and +# column) in a table. +# +# Phil Hodge, 14-Sep-1987 Function created. +# Phil Hodge, 28-Jul-1994 Add elnum to calling sequence. + +long procedure tbeoff (tp, cptr, rownum, elnum) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int rownum # i: row number +int elnum # i: element number +#-- +long offset # the offset in char +int sz_element # size of one element (if entry is an array) +int tbeszt() + +begin + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + offset = TB_BOD(tp) + (rownum-1) * TB_ROWLEN(tp) + + COL_OFFSET(cptr) + + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + offset = TB_BOD(tp) + COL_OFFSET(cptr) * TB_ALLROWS(tp) + + (rownum-1) * COL_LEN(cptr) + + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + return (0) # offset is meaningless + + else + call error (ER_TBCORRUPTED, + "tbeoff: bad table type; table or memory corrupted?") + + if (elnum > 1) { + # Not the first element. First get the size of one element. + switch (COL_DTYPE(cptr)) { + case TBL_TY_REAL: + sz_element = SZ_REAL + case TBL_TY_DOUBLE: + sz_element = SZ_DOUBLE + case TBL_TY_INT: + sz_element = SZ_INT32 + case TBL_TY_SHORT: + sz_element = SZ_SHORT + case TBL_TY_BOOL: + sz_element = SZ_BOOL + default: + sz_element = tbeszt (cptr) # character type + } + + offset = offset + (elnum-1) * sz_element + } + + return (offset) +end diff --git a/pkg/tbtables/tbepp.x b/pkg/tbtables/tbepp.x new file mode 100644 index 00000000..69cd0b51 --- /dev/null +++ b/pkg/tbtables/tbepp.x @@ -0,0 +1,109 @@ +include # for packing strings in tbeppt +include "tbtables.h" + +# tbepp[tbirds] -- primitive put element +# This procedure writes one element (i.e. row, column) into a table. +# No type conversion is performed, and the location in the output file +# must already exist (i.e. must not be beyond the EOF). Character +# strings will be packed by tbeptt, however. +# +# Phil Hodge, 15-Sep-1987 Subroutine created. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 13-Sep-1994 In tbegpt, use tbeszt for length of string to write. + +procedure tbeppb (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +bool buffer # i: buffer containing value +#-- +errchk seek, write + +begin + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, SZ_BOOL) +end + +procedure tbeppd (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +double buffer # i: buffer containing value +#-- +errchk seek, write + +begin + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, SZ_DOUBLE) +end + +procedure tbeppr (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +real buffer # i: buffer containing value +#-- +errchk seek, write + +begin + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, SZ_REAL) +end + +procedure tbeppi (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +int buffer # i: buffer containing value +#-- +errchk seek, write + +begin + call seek (TB_FILE(tp), offset) + if (SZ_INT != SZ_INT32) + call ipak32 (buffer, buffer, 1) + call write (TB_FILE(tp), buffer, SZ_INT32) +end + +procedure tbepps (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +short buffer # i: buffer containing value +#-- +errchk seek, write + +begin + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, SZ_SHORT) +end + +procedure tbeppt (tp, cptr, offset, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +long offset # i: offset in char to location for reading +int rownum # i: row number +char buffer[ARB] # i: buffer containing value +#-- +char cbuf[SZ_LINE] # buffer for packed string +int nchar # number of char to write +int tbeszt() +errchk seek, write + +begin + nchar = min (tbeszt (cptr), SZ_LINE) + call strpak (buffer, cbuf, SZ_LINE) # pack the string + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), cbuf, nchar) +end diff --git a/pkg/tbtables/tbept.x b/pkg/tbtables/tbept.x new file mode 100644 index 00000000..1bba1abb --- /dev/null +++ b/pkg/tbtables/tbept.x @@ -0,0 +1,504 @@ +include # for MAX_INT, MAX_SHORT, and MAX_REAL +include +include "tbtables.h" +include "tblerr.h" + +# tbept[tbirds] -- put a single element +# These routines write a single element into a table. The input value +# is assigned to a buffer of the same data type as the column in the +# table, and then the value is put into the table with a "primitive +# put element" (tbepp[]) routine. +# +# Phil Hodge, 17-Sep-1987 Subroutine created. +# Phil Hodge, 7-Mar-1988 Check nscan() in tbeptt +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 Call sscan as a subroutine, not a function. +# Phil Hodge, 29-Jul-1994 Change calling sequence of tbeoff. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 14-Jun-1995 Modify for FITS tables. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 3-Mar-1998 Modify to allow for row selector. +# Phil Hodge, 5-Feb-1999 Set TB_MODIFIED to true. + +procedure tbeptd (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +double buffer # i: value to be put +#-- +int rownum # actual row number +long offset # offset in char to location for writing +int dtype # data type of column +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +int ibuf +short sbuf +bool bbuf +long tbeoff() +errchk tbswer, tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, tbfapd, tbzptd + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer (tp, selrow, rownum) + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzptd (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfapd (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + if (IS_INDEFD (buffer) || abs (buffer) > MAX_REAL) + rbuf = INDEFR + else + rbuf = buffer + call tbeppr (tp, cptr, offset, rownum, rbuf) + case TBL_TY_DOUBLE: + if (IS_INDEFD (buffer)) + dbuf = TBL_INDEFD + else + dbuf = buffer + call tbeppd (tp, cptr, offset, rownum, dbuf) + case TBL_TY_INT: + if (IS_INDEFD (buffer) || abs (buffer) > MAX_INT) + ibuf = INDEFI + else + ibuf = nint (buffer) + call tbeppi (tp, cptr, offset, rownum, ibuf) + case TBL_TY_SHORT: + if (IS_INDEFD (buffer) || abs (buffer) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = nint (buffer) + call tbepps (tp, cptr, offset, rownum, sbuf) + case TBL_TY_BOOL: + if (IS_INDEFD (buffer) || abs (buffer) > MAX_INT) + bbuf = false + else if (nint (buffer) == NO) + bbuf = false + else + bbuf = true + call tbeppb (tp, cptr, offset, rownum, bbuf) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call sprintf (cbuf, SZ_FNAME, "%-25.17g") + call pargd (buffer) + call tbeppt (tp, cptr, offset, rownum, cbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbeptd: bad data type; table or memory corrupted?") + } + } +end + +procedure tbeptr (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +real buffer # i: value to be put +#-- +int rownum # actual row number +long offset # offset in char to location for writing +int dtype # data type of column +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +int ibuf +short sbuf +bool bbuf +long tbeoff() +errchk tbswer, tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, tbfapr, tbzptr + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer (tp, selrow, rownum) + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzptr (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfapr (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbeppr (tp, cptr, offset, rownum, buffer) + case TBL_TY_DOUBLE: + if (IS_INDEF (buffer)) + dbuf = TBL_INDEFD + else + dbuf = buffer + call tbeppd (tp, cptr, offset, rownum, dbuf) + case TBL_TY_INT: + if (IS_INDEF (buffer) || abs (buffer) > MAX_INT) + ibuf = INDEFI + else + ibuf = nint (buffer) + call tbeppi (tp, cptr, offset, rownum, ibuf) + case TBL_TY_SHORT: + if (IS_INDEF (buffer) || abs (buffer) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = nint (buffer) + call tbepps (tp, cptr, offset, rownum, sbuf) + case TBL_TY_BOOL: + if (IS_INDEF (buffer) || abs (buffer) > MAX_INT) + bbuf = false + else if (nint (buffer) == NO) + bbuf = false + else + bbuf = true + call tbeppb (tp, cptr, offset, rownum, bbuf) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call sprintf (cbuf, SZ_FNAME, "%-15.7g") + call pargr (buffer) + call tbeppt (tp, cptr, offset, rownum, cbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbeptr: bad data type; table or memory corrupted?") + } + } +end + +procedure tbepti (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +int buffer # i: value to be put +#-- +int rownum # actual row number +long offset # offset in char to location for writing +int dtype # data type of column +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +short sbuf +bool bbuf +long tbeoff() +errchk tbswer, tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, tbfapi, tbzpti + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer (tp, selrow, rownum) + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzpti (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfapi (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + if (IS_INDEFI (buffer)) + rbuf = INDEFR + else + rbuf = buffer + call tbeppr (tp, cptr, offset, rownum, rbuf) + case TBL_TY_DOUBLE: + if (IS_INDEFI (buffer)) + dbuf = TBL_INDEFD + else + dbuf = buffer + call tbeppd (tp, cptr, offset, rownum, dbuf) + case TBL_TY_INT: + call tbeppi (tp, cptr, offset, rownum, buffer) + case TBL_TY_SHORT: + if (IS_INDEFI (buffer) || abs (buffer) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = buffer + call tbepps (tp, cptr, offset, rownum, sbuf) + case TBL_TY_BOOL: + if (IS_INDEFI (buffer) || (buffer == NO)) + bbuf = false + else + bbuf = true + call tbeppb (tp, cptr, offset, rownum, bbuf) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call sprintf (cbuf, SZ_FNAME, "%-11d") + call pargi (buffer) + call tbeppt (tp, cptr, offset, rownum, cbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbepti: bad data type; table or memory corrupted?") + } + } +end + +procedure tbepts (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +short buffer # i: value to be put +#-- +int rownum # actual row number +long offset # offset in char to location for writing +int dtype # data type of column +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +int ibuf +bool bbuf +long tbeoff() +errchk tbswer, tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, tbfaps, tbzpts + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer (tp, selrow, rownum) + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzpts (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfaps (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + if (IS_INDEFS (buffer)) + rbuf = INDEFR + else + rbuf = buffer + call tbeppr (tp, cptr, offset, rownum, rbuf) + case TBL_TY_DOUBLE: + if (IS_INDEFS (buffer)) + dbuf = TBL_INDEFD + else + dbuf = buffer + call tbeppd (tp, cptr, offset, rownum, dbuf) + case TBL_TY_INT: + if (IS_INDEFS (buffer)) + ibuf = INDEFI + else + ibuf = buffer + call tbeppi (tp, cptr, offset, rownum, ibuf) + case TBL_TY_SHORT: + call tbepps (tp, cptr, offset, rownum, buffer) + case TBL_TY_BOOL: + if (IS_INDEFS (buffer) || (buffer == NO)) + bbuf = false + else + bbuf = true + call tbeppb (tp, cptr, offset, rownum, bbuf) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call sprintf (cbuf, SZ_FNAME, "%-11d") + call pargs (buffer) + call tbeppt (tp, cptr, offset, rownum, cbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbepts: bad data type; table or memory corrupted?") + } + } +end + +procedure tbeptb (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +bool buffer # i: value to be put +#-- +int rownum # actual row number +long offset # offset in char to location for writing +int dtype # data type of column +# buffers for copying elements of various data types +char cbuf[SZ_FNAME] +double dbuf +real rbuf +int ibuf +short sbuf +long tbeoff() +errchk tbswer, tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, tbfapb, tbzptb + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer (tp, selrow, rownum) + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzptb (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfapb (tp, cptr, rownum, buffer, 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + if (buffer) + rbuf = real (YES) + else + rbuf = real (NO) + call tbeppr (tp, cptr, offset, rownum, rbuf) + case TBL_TY_DOUBLE: + if (buffer) + dbuf = double (YES) + else + dbuf = double (NO) + call tbeppd (tp, cptr, offset, rownum, dbuf) + case TBL_TY_INT: + if (buffer) + ibuf = YES + else + ibuf = NO + call tbeppi (tp, cptr, offset, rownum, ibuf) + case TBL_TY_SHORT: + if (buffer) + sbuf = YES + else + sbuf = NO + call tbepps (tp, cptr, offset, rownum, sbuf) + case TBL_TY_BOOL: + call tbeppb (tp, cptr, offset, rownum, buffer) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call sprintf (cbuf, SZ_FNAME, "%-3b") + call pargb (buffer) + call tbeppt (tp, cptr, offset, rownum, cbuf) + } else { + call error (ER_TBCOLBADTYP, + "tbeptb: bad data type; table or memory corrupted?") + } + } +end + +procedure tbeptt (tp, cptr, selrow, buffer) + +pointer tp # i: pointer to table descriptor +pointer cptr # i: pointer to column descriptor +int selrow # i: row number (or selected row number) +char buffer[ARB] # i: value to be put +#-- +int rownum # actual row number +long offset # offset in char to location for writing +int dtype # data type of column +# buffers for copying elements of various data types +double dbuf +real rbuf +int ibuf +short sbuf +bool bbuf +long tbeoff() +int nscan(), strlen() +errchk tbswer, tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, tbfapt, tbzptt + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer (tp, selrow, rownum) + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + call tbzptt (tp, cptr, rownum, buffer) + return + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfapt (tp, cptr, rownum, buffer, strlen(buffer), 1, 1) + return + } + + offset = tbeoff (tp, cptr, rownum, 1) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call sscan (buffer) + call gargr (rbuf) + if (nscan() < 1) + rbuf = INDEFR + call tbeppr (tp, cptr, offset, rownum, rbuf) + case TBL_TY_DOUBLE: + call sscan (buffer) + call gargd (dbuf) + if (nscan() < 1) + dbuf = TBL_INDEFD + else if (IS_INDEFD (dbuf)) + dbuf = TBL_INDEFD + call tbeppd (tp, cptr, offset, rownum, dbuf) + case TBL_TY_INT: + call sscan (buffer) + call gargi (ibuf) + if (nscan() < 1) + ibuf = INDEFI + call tbeppi (tp, cptr, offset, rownum, ibuf) + case TBL_TY_SHORT: + call sscan (buffer) + call gargs (sbuf) + if (nscan() < 1) + sbuf = INDEFS + call tbepps (tp, cptr, offset, rownum, sbuf) + case TBL_TY_BOOL: + call sscan (buffer) + call gargb (bbuf) + if (nscan() < 1) + bbuf = false + call tbeppb (tp, cptr, offset, rownum, bbuf) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call tbeppt (tp, cptr, offset, rownum, buffer) + } else { + call error (ER_TBCOLBADTYP, + "tbeptt: bad data type; table or memory corrupted?") + } + } +end diff --git a/pkg/tbtables/tbeszt.x b/pkg/tbtables/tbeszt.x new file mode 100644 index 00000000..f7fc0ff3 --- /dev/null +++ b/pkg/tbtables/tbeszt.x @@ -0,0 +1,24 @@ +include # needed for SZB_CHAR +include "tbtables.h" + +# tbeszt -- length of char element +# This routine returns the amount of space (unit = char) taken up in a +# table file by a character string. This may be different from the length +# of the string as would be returned by the strlen function, say, because +# the element in the table is packed, and the space is rounded up to a +# multiple of SZB_CHAR bytes. +# +# Phil Hodge, 28-Jul-1994 Function created. +# Phil Hodge, 31-Oct-1994 Check for data type = TY_CHAR. + +int procedure tbeszt (cptr) + +pointer cptr # i: pointer to column descriptor +#-- + +begin + if (COL_DTYPE(cptr) == TY_CHAR) # old notation + return (COL_LEN(cptr)) + else + return ((-COL_DTYPE(cptr) + SZB_CHAR-1) / SZB_CHAR) +end diff --git a/pkg/tbtables/tbfag.x b/pkg/tbtables/tbfag.x new file mode 100644 index 00000000..c80cf0f3 --- /dev/null +++ b/pkg/tbtables/tbfag.x @@ -0,0 +1,494 @@ +include +include "tbtables.h" + +# tbfag[tbirds] -- get an array of elements from a FITS table +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. +# Phil Hodge, 18-Jun-1998 Use fsgcfl instead of fsgcl to get boolean. +# Phil Hodge, 19-Mar-1999 Don't try to get nelem elements if there are +# not that many in the array, starting at first; get nret instead. +# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length. + +# tbfagd -- get double-precision elements + +int procedure tbfagd (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +double buffer[ARB] # o: buffer for values to be gotten +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer cbuf # for getting string +bool bbuf # for getting boolean +bool flagvals # set to true if the value is undefined +int i, j # loop indexes +int status # zero is OK +double nulval # INDEFD +bool anyf # set to true if any value is undefined +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nscan() +errchk tbferr + +begin + status = 0 + + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_LINE, TY_CHAR) + j = first + do i = 1, nret { + call fsgcvs (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, "", Memc[cbuf], SZ_LINE, anyf, status) + call sscan (Memc[cbuf]) + call gargd (buffer[i]) + if (nscan() < 1) + buffer[i] = INDEFD + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nret { + call fsgcfl (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + bbuf, flagvals, anyf, status) + if (flagvals) + buffer[i] = INDEFD + else if (bbuf) + buffer[i] = 1.d0 + else + buffer[i] = 0.d0 + j = j + 1 + } + + } else { + + # FITSIO should be able to do any other type conversion. + nulval = INDEFD + call fsgcvd (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nret, + nulval, buffer, anyf, status) + } + + if (status != 0) + call tbferr (status) + + return (nret) +end + +# tbfagr -- get single-precision elements + +int procedure tbfagr (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +real buffer[ARB] # o: buffer for values to be gotten +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer cbuf # for getting string +bool bbuf # for getting boolean +bool flagvals # set to true if the value is undefined +int i, j # loop indexes +int status # zero is OK +real nulval # INDEFR +bool anyf # set to true if any value is undefined +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nscan() +errchk tbferr + +begin + status = 0 + + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_LINE, TY_CHAR) + j = first + do i = 1, nret { + call fsgcvs (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, "", Memc[cbuf], SZ_LINE, anyf, status) + call sscan (Memc[cbuf]) + call gargr (buffer[i]) + if (nscan() < 1) + buffer[i] = INDEFR + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nret { + call fsgcfl (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + bbuf, flagvals, anyf, status) + if (flagvals) + buffer[i] = INDEFR + else if (bbuf) + buffer[i] = 1. + else + buffer[i] = 0. + j = j + 1 + } + + } else { + + nulval = INDEFR + call fsgcve (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nret, + nulval, buffer, anyf, status) + } + + if (status != 0) + call tbferr (status) + + return (nret) +end + +# tbfagi -- get an integer element + +int procedure tbfagi (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +int buffer[ARB] # o: buffer for values to be gotten +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer cbuf # for getting string +bool bbuf # for getting boolean +bool flagvals # set to true if the value is undefined +int i, j # loop indexes +int status # zero is OK +int nulval # INDEFI +bool anyf # set to true if any value is undefined +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nscan() +errchk tbferr + +begin + status = 0 + + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_LINE, TY_CHAR) + j = first + do i = 1, nret { + call fsgcvs (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, "", Memc[cbuf], SZ_LINE, anyf, status) + call sscan (Memc[cbuf]) + call gargi (buffer[i]) + if (nscan() < 1) + buffer[i] = INDEFI + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nret { + call fsgcfl (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + bbuf, flagvals, anyf, status) + if (flagvals) + buffer[i] = INDEFI + else if (bbuf) + buffer[i] = 1 + else + buffer[i] = 0 + j = j + 1 + } + + } else { + + nulval = INDEFI + call fsgcvj (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nret, + nulval, buffer, anyf, status) + } + + if (status != 0) + call tbferr (status) + + return (nret) +end + +# tbfags -- get short integer elements + +int procedure tbfags (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +short buffer[ARB] # o: buffer for values to be gotten +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer cbuf # for getting string +bool bbuf # for getting boolean +bool flagvals # set to true if the value is undefined +int i, j # loop indexes +int status # zero is OK +short nulval # INDEFS +bool anyf # set to true if any value is undefined +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nscan() +errchk tbferr + +begin + status = 0 + + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_LINE, TY_CHAR) + j = first + do i = 1, nret { + call fsgcvs (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, "", Memc[cbuf], SZ_LINE, anyf, status) + call sscan (Memc[cbuf]) + call gargs (buffer[i]) + if (nscan() < 1) + buffer[i] = INDEFS + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nret { + call fsgcfl (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + bbuf, flagvals, anyf, status) + if (flagvals) + buffer[i] = INDEFS + else if (bbuf) + buffer[i] = 1 + else + buffer[i] = 0 + j = j + 1 + } + + } else { + + nulval = INDEFS + call fsgcvi (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nret, + nulval, buffer, anyf, status) + } + + if (status != 0) + call tbferr (status) + + return (nret) +end + +# tbfagb -- get boolean elements + +int procedure tbfagb (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +bool buffer[ARB] # o: buffer for values to be gotten +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer cbuf # for getting string +pointer flags # scratch for array of null flags +double dbuf +double nulval # INDEFD +int i, j # loop indexes +int status # zero is OK +bool anyf # set to true if any value is undefined +int ntotal # total number of elements in array +int nret # actual number of elements to read +bool streq() +errchk tbferr + +begin + status = 0 + + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_LINE, TY_CHAR) + j = first + do i = 1, nret { + call fsgcvs (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, "", Memc[cbuf], SZ_LINE, anyf, status) + call strlwr (Memc[cbuf]) + if (streq (Memc[cbuf], "yes") || streq (Memc[cbuf], "y") || + streq (Memc[cbuf], "true") || streq (Memc[cbuf], "t")) + buffer[i] = true + else + buffer[i] = false + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + call smark (sp) + call salloc (flags, nret, TY_CHAR) + do i = 1, nret + buffer[i] = false + call fsgcfl (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nret, + buffer, Memc[flags], anyf, status) + # We can't actually use Memc[flags] because bool has no INDEF. + call sfree (sp) + + } else { + + nulval = INDEFD + j = first + do i = 1, nret { + call fsgcvd (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, nulval, dbuf, anyf, status) + if (anyf) + buffer[i] = false + else + buffer[i] = (dbuf != 0.d0) + j = j + 1 + } + } + + if (status != 0) + call tbferr (status) + + return (nret) +end + +# tbfagt -- get text-string elements + +int procedure tbfagt (tp, cp, rownum, cbuf, maxch, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +char cbuf[maxch,ARB] # o: buffer for values to be gotten +int maxch # i: max number of char in output string +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +int status # zero is OK +int i, j # loop indexes +bool anyf # set to true if any value is undefined +int ntotal # total number of elements in array +int nret # actual number of elements to read +# The following are for getting non-text type values and converting to text +double dbuf +double dnulval # INDEFD +real rbuf +real rnulval # INDEFR +int ibuf +int inulval # INDEFI +short sbuf +short snulval # INDEFS +bool bbuf +bool flagvals # set to true if the value is undefined +errchk tbferr + +begin + status = 0 + + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + + if (COL_DTYPE(cp) < 0) { # text-string column? + + call fsgcvs (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nret, + "", cbuf, maxch, anyf, status) + + } else { + + # Not a text-string column. Get the value and sprintf it. + + j = first + + switch (COL_DTYPE(cp)) { + case TBL_TY_DOUBLE: + dnulval = INDEFD + do i = 1, nret { + call fsgcvd (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, dnulval, dbuf, anyf, status) + call sprintf (cbuf[1,i], maxch, COL_FMT(cp)) + call pargd (dbuf) + j = j + 1 + } + case TBL_TY_REAL: + rnulval = INDEFR + do i = 1, nret { + call fsgcve (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, rnulval, rbuf, anyf, status) + call sprintf (cbuf[1,i], maxch, COL_FMT(cp)) + call pargr (rbuf) + j = j + 1 + } + case TBL_TY_INT: + inulval = INDEFI + do i = 1, nret { + call fsgcvj (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, inulval, ibuf, anyf, status) + call sprintf (cbuf[1,i], maxch, COL_FMT(cp)) + call pargi (ibuf) + j = j + 1 + } + case TBL_TY_SHORT: + snulval = INDEFS + do i = 1, nret { + call fsgcvi (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, snulval, sbuf, anyf, status) + call sprintf (cbuf[1,i], maxch, COL_FMT(cp)) + call pargs (sbuf) + j = j + 1 + } + case TBL_TY_BOOL: + do i = 1, nret { + call fsgcfl (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + bbuf, flagvals, anyf, status) + if (flagvals) { + call strcpy ("INDEF", cbuf[1,i], maxch) + } else { + call sprintf (cbuf[1,i], maxch, COL_FMT(cp)) + call pargb (bbuf) + } + j = j + 1 + } + default: + call error (1, "bad data type in table") + } + } + if (status != 0) + call tbferr (status) + + return (nret) +end diff --git a/pkg/tbtables/tbfanp.x b/pkg/tbtables/tbfanp.x new file mode 100644 index 00000000..1455a397 --- /dev/null +++ b/pkg/tbtables/tbfanp.x @@ -0,0 +1,161 @@ +include +include +include "tbtables.h" + +define SZ_FITS_REC 80 # size of a FITS header record + +# tbfanp -- add new parameter to FITS table +# +# Phil Hodge, 24-Jul-1995 Subroutine created. +# Phil Hodge, 20-Jul-1998 For blank keyword, call fsprec. + +procedure tbfanp (tp, keyword, dtype, str, parnum) + +pointer tp # i: pointer to table descriptor +char keyword[SZ_KEYWORD] # i: keyword for the parameter +int dtype # i: data type +char str[ARB] # i: string containing the value of the param. +int parnum # o: number of the parameter in the table +#-- +pointer sp +pointer fitsrec # scratch for FITS output record +pointer value # scratch for first "word" in input str +pointer blanks # scratch for blank fill +char ukey[SZ_KEYWORD] # keyword in upper case +int status # used for fitsio +int keysadd # returned by fsghsp and ignored +int vlen # length of string +int i +int strlen() +int ip, ip2, nchar, ival, ctoi(), ctowrd() +bool streq() +errchk tbferr + +begin + status = 0 + + call strcpy (keyword, ukey, SZ_KEYWORD) + call strupr (ukey) + do i = strlen (ukey), 1, -1 { # trim trailing blanks + if (IS_WHITE(ukey[i])) + ukey[i] = EOS + else + break + } + + if (streq (ukey, "HISTORY")) { + + call fsphis (TB_FILE(tp), str, status) + + } else if (streq (ukey, "COMMENT")) { + + call fspcom (TB_FILE(tp), str, status) + + } else if (ukey[1] == EOS) { # blank keyword + + call smark (sp) + call salloc (fitsrec, SZ_FITS_REC, TY_CHAR) + call sprintf (Memc[fitsrec], SZ_FITS_REC, " %s") + call pargstr (str) + call fsprec (TB_FILE(tp), Memc[fitsrec], status) + call sfree (sp) + + } else { + + call smark (sp) + call salloc (fitsrec, SZ_FITS_REC, TY_CHAR) + call salloc (value, SZ_FITS_REC, TY_CHAR) + + # Extract one "word". + ip = 1 + nchar = ctowrd (str, ip, Memc[value], SZ_FITS_REC) + while (str[ip] == ' ') + ip = ip + 1 + + if (dtype == TY_CHAR) { + + # Check whether the value is quoted. If so, then Memc[value] + # already contains the value, and there's no comment. + if (str[1] != '"' && str[1] != '\'') { + call strcpy (str, Memc[value], SZ_FITS_REC) + ip = strlen (str) + 1 # str[ip] = EOS, so no comment + } + + # Pad value with blanks if it's smaller than eight characters. + vlen = strlen (Memc[value]) + if (vlen < 8) { + do i = vlen+1, 8 + Memc[value+i-1] = ' ' + Memc[value+8] = EOS + } + + # Format the info into the buffer. + call sprintf (Memc[fitsrec], SZ_FITS_REC, "%-8s= '%s'") + call pargstr (ukey) + call pargstr (Memc[value]) + vlen = strlen (Memc[fitsrec]) + if (vlen < 30) { + do i = vlen+1, 30 + Memc[fitsrec+i-1] = ' ' + Memc[fitsrec+30] = EOS + } + call strcat (" / ", Memc[fitsrec], SZ_FITS_REC) + if (str[ip] != EOS) # append comment + call strcat (str[ip], Memc[fitsrec], SZ_FITS_REC) + + } else if (dtype == TY_BOOL) { + + call strlwr (Memc[value]) + ip2 = 1 + nchar = ctoi (Memc[value], ip2, ival) + if (streq (Memc[value], "t") || streq (Memc[value], "true") || + streq (Memc[value], "yes") || ival == 1) { + call sprintf (Memc[fitsrec], SZ_FITS_REC, + "%-8s= T / ") + call pargstr (ukey) + } else { + call sprintf (Memc[fitsrec], SZ_FITS_REC, + "%-8s= F / ") + call pargstr (ukey) + } + if (str[ip] != EOS) # append comment + call strcat (str[ip], Memc[fitsrec], SZ_FITS_REC) + + } else { + + vlen = strlen (Memc[value]) + if (vlen < 21) { + # Right justify at column 30. + call salloc (blanks, 21-vlen, TY_CHAR) + do i = 1, 21-vlen + Memc[blanks+i-1] = ' ' + Memc[blanks+21-vlen] = EOS + call sprintf (Memc[fitsrec], SZ_FITS_REC, "%-8s=%s%s / ") + call pargstr (ukey) + call pargstr (Memc[blanks]) + call pargstr (Memc[value]) + } else { + call sprintf (Memc[fitsrec], SZ_FITS_REC, "%-8s=%s / ") + call pargstr (ukey) + call pargstr (Memc[value]) + } + if (str[ip] != EOS) # append comment + call strcat (str[ip], Memc[fitsrec], SZ_FITS_REC) + } + + # Add the record to the FITS file. + call fsprec (TB_FILE(tp), Memc[fitsrec], status) + + call sfree (sp) + } + + if (status != 0) + call tbferr (status) + + # Get the number of header parameters, and assume that that + # is the number of the parameter we just added to the header. + call fsghsp (TB_FILE(tp), parnum, keysadd, status) + if (status != 0) + call tbferr (status) + TB_NPAR(tp) = parnum +end diff --git a/pkg/tbtables/tbfap.x b/pkg/tbtables/tbfap.x new file mode 100644 index 00000000..a837418f --- /dev/null +++ b/pkg/tbtables/tbfap.x @@ -0,0 +1,557 @@ +include "tbtables.h" + +# tbfap[tbirds] -- put an array of elements to a FITS table +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 29-Jul-1997 Call tbfwer to create new rows and set to indef. +# Phil Hodge, 3-Mar-1998 Remove calls to tbfwer, since tbswer is called +# in higher-level routines. +# Phil Hodge, 19-Mar-1999 In tbfapt, there was a missing "j = j + 1" in +# the section for column data type short. +# Phil Hodge, 27-Aug-2002 In tbfapt, include an explicit test for INDEF, +# rather than relying on 'nscan() < 1'. + +# tbfapd -- put double-precision elements + +procedure tbfapd (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +double buffer[ARB] # i: buffer for values to be written +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +pointer cbuf # for writing to a string +bool bbuf +bool anyf # true if any input value is INDEF +int status # zero is OK +int i, j +errchk tbferr + +begin + status = 0 + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + j = first + do i = 1, nelem { + if (IS_INDEFD(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call sprintf (Memc[cbuf], SZ_FNAME, "%-25.16g") + call pargd (buffer[i]) + call fspcls (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + Memc[cbuf], SZ_FNAME, status) + } + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nelem { + if (IS_INDEFD(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + bbuf = (buffer[i] != 0.d0) + call fspcll (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, bbuf, status) + } + j = j + 1 + } + + } else { + + # FITSIO should be able to do any other type conversion. + + # Check for INDEF values. + anyf = false + do i = 1, nelem { + if (IS_INDEFD(buffer[i])) { + anyf = true + break + } + } + + if (anyf) { + # Check each element as we go. + j = first + do i = 1, nelem { + if (IS_INDEFD(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcld (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, buffer[i], status) + } + j = j + 1 + } + } else { + # No INDEFs; write the entire array. + call fspcld (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nelem, + buffer, status) + } + } + + if (status != 0) + call tbferr (status) + + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) +end + +# tbfapr -- put single-precision elements + +procedure tbfapr (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +real buffer[ARB] # i: buffer for values to be written +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +pointer cbuf # for writing to a string +bool bbuf +bool anyf # true if any input value is INDEF +int status # zero is OK +int i, j +errchk tbferr + +begin + status = 0 + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + j = first + do i = 1, nelem { + if (IS_INDEFR(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call sprintf (Memc[cbuf], SZ_FNAME, "%-15.7g") + call pargr (buffer[i]) + call fspcls (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + Memc[cbuf], SZ_FNAME, status) + } + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nelem { + if (IS_INDEFR(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + bbuf = (buffer[i] != 0.) + call fspcll (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, bbuf, status) + } + j = j + 1 + } + + } else { + + # Check for INDEF values. + anyf = false + do i = 1, nelem { + if (IS_INDEFR(buffer[i])) { + anyf = true + break + } + } + + if (anyf) { + j = first + do i = 1, nelem { + if (IS_INDEFR(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcle (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, buffer[i], status) + } + j = j + 1 + } + } else { + call fspcle (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nelem, + buffer, status) + } + } + + if (status != 0) + call tbferr (status) + + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) +end + +# tbfapi -- put an integer element + +procedure tbfapi (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +int buffer[ARB] # i: buffer for values to be written +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +pointer cbuf # for writing to a string +bool bbuf +bool anyf # true if any input value is INDEF +int status # zero is OK +int i, j +errchk tbferr + +begin + status = 0 + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + j = first + do i = 1, nelem { + if (IS_INDEFI(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call sprintf (Memc[cbuf], SZ_FNAME, "%-10d") + call pargi (buffer[i]) + call fspcls (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + Memc[cbuf], SZ_FNAME, status) + } + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nelem { + if (IS_INDEFI(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + bbuf = (buffer[i] != 0) + call fspcll (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, bbuf, status) + } + j = j + 1 + } + + } else { + + # Check for INDEF values. + anyf = false + do i = 1, nelem { + if (IS_INDEFI(buffer[i])) { + anyf = true + break + } + } + + if (anyf) { + j = first + do i = 1, nelem { + if (IS_INDEFI(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspclj (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, buffer[i], status) + } + j = j + 1 + } + } else { + call fspclj (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nelem, + buffer, status) + } + } + + if (status != 0) + call tbferr (status) + + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) +end + +# tbfaps -- put short integer elements + +procedure tbfaps (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +short buffer[ARB] # i: buffer for values to be written +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +pointer cbuf # for writing to a string +bool bbuf +bool anyf # true if any input value is INDEF +int status # zero is OK +int i, j +errchk tbferr + +begin + status = 0 + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + j = first + do i = 1, nelem { + if (IS_INDEFS(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call sprintf (Memc[cbuf], SZ_FNAME, "%-10d") + call pargs (buffer[i]) + call fspcls (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + Memc[cbuf], SZ_FNAME, status) + } + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + j = first + do i = 1, nelem { + if (IS_INDEFS(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + bbuf = (buffer[i] != 0) + call fspcll (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, bbuf, status) + } + j = j + 1 + } + + } else { + + # Check for INDEF values. + anyf = false + do i = 1, nelem { + if (IS_INDEFS(buffer[i])) { + anyf = true + break + } + } + + if (anyf) { + j = first + do i = 1, nelem { + if (IS_INDEFS(buffer[i])) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcli (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, buffer[i], status) + } + j = j + 1 + } + } else { + call fspcli (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nelem, + buffer, status) + } + } + + if (status != 0) + call tbferr (status) + + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) +end + +# tbfapb -- put boolean elements + +procedure tbfapb (tp, cp, rownum, buffer, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +bool buffer[ARB] # i: buffer for values to be written +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +pointer cbuf # for writing to a string +double dbuf +int status # zero is OK +int i, j +errchk tbferr + +begin + status = 0 + + if (COL_DTYPE(cp) < 0) { # text string + + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + j = first + do i = 1, nelem { + if (buffer[i]) + call strcpy ("yes", Memc[cbuf], SZ_FNAME) + else + call strcpy ("no", Memc[cbuf], SZ_FNAME) + call fspcls (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + Memc[cbuf], SZ_FNAME, status) + j = j + 1 + } + call sfree (sp) + + } else if (COL_DTYPE(cp) == TBL_TY_BOOL) { + + call fspcll (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nelem, + buffer, status) + + } else { + + # FITSIO should be able to do any other type conversion. + j = first + do i = 1, nelem { + if (buffer[i]) + dbuf = 1.d0 + else + dbuf = 0.d0 + call fspcld (TB_FILE(tp), COL_NUMBER(cp), rownum, j, 1, + dbuf, status) + j = j + 1 + } + } + + if (status != 0) + call tbferr (status) + + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) +end + +# tbfapt -- put text-string elements + +procedure tbfapt (tp, cp, rownum, cbuf, maxch, first, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +char cbuf[maxch,ARB] # i: buffer for values to be written +int maxch # i: max number of char in input string +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +int status # zero is OK +int i, j # loop indexes +int nscan() + +# The following are for putting non-text type values +double dbuf +real rbuf +int ibuf +short sbuf +bool bbuf + +errchk tbferr + +begin + status = 0 + + if (COL_DTYPE(cp) < 0) { + + call fspcls (TB_FILE(tp), COL_NUMBER(cp), rownum, first, nelem, + cbuf, maxch, status) + + } else { + + j = first # initial value for loop on i + + switch (COL_DTYPE(cp)) { + case TBL_TY_REAL: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargr (rbuf) + if (nscan() < 1 || IS_INDEF(rbuf)) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcle (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, rbuf, status) + } + j = j + 1 + } + case TBL_TY_DOUBLE: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargd (dbuf) + if (nscan() < 1 || IS_INDEFD(dbuf)) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcld (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, dbuf, status) + } + j = j + 1 + } + case TBL_TY_INT: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargi (ibuf) + if (nscan() < 1 || IS_INDEFI(ibuf)) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspclj (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, ibuf, status) + } + j = j + 1 + } + case TBL_TY_SHORT: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargs (sbuf) + if (nscan() < 1 || IS_INDEFS(sbuf)) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcli (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, sbuf, status) + } + j = j + 1 + } + case TBL_TY_BOOL: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargb (bbuf) + if (nscan() < 1) { + call fspclu (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, status) + } else { + call fspcll (TB_FILE(tp), COL_NUMBER(cp), rownum, + j, 1, bbuf, status) + } + j = j + 1 + } + default: + call error (1, "bad data type in table") + } + } + + if (status != 0) + call tbferr (status) + + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) +end diff --git a/pkg/tbtables/tbfcal.x b/pkg/tbtables/tbfcal.x new file mode 100644 index 00000000..51c380ee --- /dev/null +++ b/pkg/tbtables/tbfcal.x @@ -0,0 +1,113 @@ +include # for IS_WHITE +include +include "tbtables.h" + +# tbfcal -- copy all header parameters for FITS table +# All header parameters are copied from the input to the output table, +# both of which must be open. This version should be used when either +# the input or output table is in a FITS file. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 13-Nov-1995 Change type of tbfres from bool to int. +# Phil Hodge, 14-Aug-1997 Don't clobber EXTVER if it's already present. + +procedure tbfcal (itp, otp) + +pointer itp # i: pointer to descriptor of input table +pointer otp # i: pointer to descriptor of output table +#-- +pointer sp +pointer value # buffer for header record for parameter +pointer comment # scratch for comment string +pointer extname # buffer for copying extname +char keyword[SZ_KEYWORD] # parameter name +int dtype # data type of parameter +int i +int ip + +# buffers for copying the value +double dval +real rval +int ival +bool bval + +bool streq() +int tbhgti() +int tbfres() +errchk tbferr, tbhgnp, tbhgti, tbhgtt + +begin + call smark (sp) + call salloc (value, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_FNAME, TY_CHAR) + call salloc (extname, SZ_LINE, TY_CHAR) + + # Copy each parameter except for the reserved keywords, + # such as XTENSION, TTYPEn. + do i = 1, TB_NPAR(itp) { + + # Get Nth keyword and value from the input table. + call tbhgnp (itp, i, keyword, dtype, Memc[value]) + + if (tbfres (keyword) == YES) # ignore reserved keywords + next + + # Don't clobber EXTNAME or EXTVER if they're already present in + # the output. + if (streq (keyword, "EXTNAME")) { + ifnoerr (call tbhgtt (otp, "EXTNAME", Memc[extname], SZ_LINE)) + next + } + if (streq (keyword, "EXTVER")) { + ifnoerr (ip = tbhgti (otp, "EXTVER")) # use ip as scratch + next + } + + # Read the value into an appropriate buffer, and add it + # to the output table header. + switch (dtype) { + case TY_REAL: + dval = INDEFD + call sscan (Memc[value]) + call gargd (dval) + rval = dval + call tbhadr (otp, keyword, rval) + case TY_DOUBLE: + dval = INDEFD + call sscan (Memc[value]) + call gargd (dval) + call tbhadd (otp, keyword, dval) + case TY_INT: + ival = INDEFI + call sscan (Memc[value]) + call gargi (ival) + call tbhadi (otp, keyword, ival) + case TY_CHAR: + call tbhadt (otp, keyword, Memc[value]) + case TY_BOOL: + ip = 0 + while (IS_WHITE(Memc[value+ip])) + ip = ip + 1 + if (Memc[value+ip] == 'T' || Memc[value+ip] == 't') { + bval = true + } else if (Memc[value+ip] == 'F' || Memc[value+ip] == 'f') { + bval = false + } else { + # Read 1 or 0 for true or false respectively. + ival = NO + call sscan (Memc[value+ip]) + call gargi (ival) + bval = (ival != NO) + } + call tbhadb (otp, keyword, bval) + default: + call error (1, "tbhcal: bad data type") + } + + # Copy the comment from input to output. + call tbhgcm (itp, keyword, Memc[comment], SZ_FNAME) + call tbhpcm (otp, keyword, Memc[comment]) + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfchp.x b/pkg/tbtables/tbfchp.x new file mode 100644 index 00000000..b88153d4 --- /dev/null +++ b/pkg/tbtables/tbfchp.x @@ -0,0 +1,27 @@ +include "tbtables.h" + +# tbfchp -- chop rows off the end of a FITS table +# This routine deletes rows at the end of a table. +# +# Phil Hodge, 6-Mar-1998 Subroutine created. + +procedure tbfchp (tp, ndel) + +pointer tp # i: pointer to table descriptor +int ndel # i: number of rows to be deleted +#-- +int nrows # number of rows in the table before deleting +int status +errchk tbferr + +begin + nrows = TB_NROWS(tp) + + status = 0 + call fsdrow (TB_FILE(tp), max (1, nrows-ndel+1), ndel, status) + if (status > 0) + call tbferr (status) + + # Change the value of TB_NROWS. + TB_NROWS(tp) = max (0, nrows - ndel) +end diff --git a/pkg/tbtables/tbfckn.x b/pkg/tbtables/tbfckn.x new file mode 100644 index 00000000..cf5e94f7 --- /dev/null +++ b/pkg/tbtables/tbfckn.x @@ -0,0 +1,69 @@ +include +include "tbtables.h" + +# tbfckn -- change keyword name for FITS table +# This routine changes the name of a keyword without changing either +# the data type, value, or comment. +# +# Phil Hodge, 22-May-1996 Subroutine created. + +procedure tbfckn (tp, oldkey, parnum, newkey) + +pointer tp # i: pointer to table descriptor +char oldkey[ARB] # i: current keyword name +int parnum # i: number of current keyword +char newkey[ARB] # i: new keyword name +#-- +pointer sp +pointer par # buffer for parameter record +char uc_oldkey[SZ_KEYWORD] # old keyword converted to upper case +char uc_newkey[SZ_KEYWORD] +int status +int k +int i +int len, strlen() +errchk tbffkw, tbferr + +begin + status = 0 + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call strcpy (oldkey, uc_oldkey, SZ_KEYWORD) + call strcpy (newkey, uc_newkey, SZ_KEYWORD) + call strupr (uc_oldkey) + call strupr (uc_newkey) + + if (parnum > 0) { # current parameter was specified by number + + k = parnum + + } else { # current parameter was specified by name + + call tbffkw (tp, uc_oldkey, k) # find old keyword + + if (k <= 0) { + call sprintf (Memc[par], SZ_PARREC, + "tbhckn: keyword `%s' not found") + call pargstr (oldkey) + call error (1, Memc[par]) + } + } + + call fsgrec (TB_FILE(tp), k, Memc[par], status) + if (status != 0) + call tbferr (status) + + len = strlen (newkey) + do i = 1, len # replace old with new + Memc[par+i-1] = uc_newkey[i] + do i = len+1, SZ_KEYWORD + Memc[par+i-1] = ' ' + + call fsmrec (TB_FILE(tp), k, Memc[par], status) + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfclo.x b/pkg/tbtables/tbfclo.x new file mode 100644 index 00000000..1b2abf58 --- /dev/null +++ b/pkg/tbtables/tbfclo.x @@ -0,0 +1,28 @@ +include +include "tbtables.h" + +# tbfclo -- close a table in a FITS file +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 1-Jun-1999 Set both TB_FILE and TB_FILE2 to 0. + +procedure tbfclo (tp) + +pointer tp # i: pointer to table descriptor +#-- +int status +errchk tbferr + +begin + if (TB_FILE(tp) == 0) + return + + # Close the file, and free the unit number. + status = 0 + call fsclos (TB_FILE(tp), status) + call fsfiou (TB_FILE(tp), status) + if (status != 0) + call tbferr (status) + TB_FILE(tp) = 0 + TB_FILE2(tp) = 0 +end diff --git a/pkg/tbtables/tbfdef.x b/pkg/tbtables/tbfdef.x new file mode 100644 index 00000000..9f4630ab --- /dev/null +++ b/pkg/tbtables/tbfdef.x @@ -0,0 +1,198 @@ +include +include "tbtables.h" +include "tblfits.h" # defines FITS_INDEFI and FITS_INDEFS + +# tbfdef -- write new column in FITS table +# This routine creates a new column in a FITS table, writing the header +# keywords and also the INDEF data values. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 23-Apr-1997 Add option for FITS ASCII table. +# Phil Hodge, 12-Mar-1999 Change the sizes of ttype, tform and tunit +# from SZ_FNAME to SZ_FTTYPE, SZ_FTFORM and SZ_FTUNIT respectively, +# and change the size of tdisp to SZ_COLFMT. +# Phil Hodge, 7-Jun-1999 Use TB_SUBTYPE instead of TB_HDUTYPE. + +procedure tbfdef (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to descriptor for new column +#-- +pointer sp +pointer keyword # for keyword name (TDISPn) +pointer tdisp # for print format +pointer ttype, tform, tunit # for values of header keywords +int dtype, nelem # data type and array length +int colnum # column number +int row # loop index for row number +int ival # undefined value for int, short, bool +char dtype_c # data type: 'D', 'E', 'J', 'I', 'L, 'A' +int lenfmt # width needed for printing value +int status # zero is OK +errchk tbferr, tbfptf, tbftfo + +begin + status = 0 + + call smark (sp) + call salloc (keyword, SZ_FNAME, TY_CHAR) + call salloc (tdisp, SZ_COLFMT, TY_CHAR) + call salloc (ttype, SZ_FTTYPE, TY_CHAR) + call salloc (tform, SZ_FTFORM, TY_CHAR) + call salloc (tunit, SZ_FTUNIT, TY_CHAR) + + # Get column information. + call tbcinf (cp, + colnum, Memc[ttype], Memc[tunit], Memc[tdisp], + dtype, nelem, lenfmt) + + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) { # ASCII table + + # Create TFORM string to specify format and data type. + call tbftfo (dtype, lenfmt, Memc[tdisp], Memc[tform], SZ_FTFORM) + + } else if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE) { # binary table + + # Create TFORM string for BINTABLE. + switch (dtype) { + case TY_DOUBLE: + dtype_c = 'D' + case TY_REAL: + dtype_c = 'E' + case TY_INT: + dtype_c = 'J' + case TY_SHORT: + dtype_c = 'I' + case TY_BOOL: + dtype_c = 'L' + default: + dtype_c = 'A' + } + if (dtype > 0) { + call sprintf (Memc[tform], SZ_FNAME, "%d%c") + call pargi (nelem) + call pargc (dtype_c) + } else if (nelem > 1) { # array of char strings + call sprintf (Memc[tform], SZ_FNAME, "%d%c%d") + call pargi (-dtype * nelem) # FITSIO special convention + call pargc (dtype_c) + call pargi (-dtype) + } else { # character string + call sprintf (Memc[tform], SZ_FNAME, "%d%c") + call pargi (-dtype) + call pargc (dtype_c) + } + + } else { + call error (1, "tbfdef: invalid HDU type") + } + + # Create new column. + call fsicol (TB_FILE(tp), colnum, Memc[ttype], Memc[tform], status) + if (status != 0) + call tbferr (status) + + # Create TUNIT string, and add to header. + call sprintf (Memc[keyword], SZ_FNAME, "TUNIT%d") + call pargi (colnum) + call fspkys (TB_FILE(tp), Memc[keyword], + Memc[tunit], "column units", status) + if (status != 0) + call tbferr (status) + + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) { # ASCII table + + # Add TNULL (an *) to header. + call sprintf (Memc[keyword], SZ_FNAME, "TNULL%d") + call pargi (colnum) + call fspkys (TB_FILE(tp), Memc[keyword], + "*", "undefined value for column", status) + if (status != 0) + call tbferr (status) + + } else if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE) { # binary table + + # Create TDISP string, and add to header. + call sprintf (Memc[keyword], SZ_FNAME, "TDISP%d") + call pargi (colnum) + call tbfptf (Memc[tdisp], Memc[tdisp], SZ_COLFMT) # in-place + call fspkys (TB_FILE(tp), Memc[keyword], + Memc[tdisp], "display format", status) + if (status != 0) + call tbferr (status) + + # Add TNULL to header. + if (dtype == TY_INT || dtype == TY_SHORT) { + + call sprintf (Memc[keyword], SZ_FNAME, "TNULL%d") + call pargi (colnum) + if (dtype == TY_INT) + ival = FITS_INDEFI + else if (dtype == TY_SHORT) + ival = FITS_INDEFS + call fspkyj (TB_FILE(tp), Memc[keyword], + ival, "undefined value for column", status) + if (status != 0) + call tbferr (status) + } + } + + call fsrdef (TB_FILE(tp), status) # shouldn't be necessary + + # Fill the new column with INDEF. + do row = 1, TB_NROWS(tp) { + call fspclu (TB_FILE(tp), colnum, row, 1, nelem, status) + if (status != 0) + call tbferr (status) + } + + call sfree (sp) +end + +procedure tbftfo (dtype, lenfmt, tdisp, tform, maxch) + +int dtype # i: data type of column +int lenfmt # i: width needed for printing value +char tdisp[ARB] # i: display format (could be SPP style) +char tform[maxch] # o: TFORM for ASCII table column +int maxch # i: size of tform string +#-- +bool badfmt # bad print format? +errchk tbfptf + +begin + badfmt = false + + switch (dtype) { + case TY_DOUBLE: + call tbfptf (tdisp, tform, maxch) + if (tform[1] == 'E') { + tform[1] = 'D' + } else if (tform[1] == 'G') { + tform[1] = 'D' + } else if (tform[1] == 'F') { + call error (1, + "Use E format for double precision in FITS ASCII table") + } + badfmt = (tform[1] != 'D') + case TY_REAL: + call tbfptf (tdisp, tform, maxch) + if (tform[1] == 'G') + tform[1] = 'E' + if (tform[1] != 'E' && tform[1] != 'F') + badfmt = true + case TY_INT, TY_SHORT: + call sprintf (tform, maxch, "I%d") + call pargi (lenfmt) + case TY_BOOL: + call error (1, "Boolean column not supported in FITS ASCII table") + default: + call sprintf (tform, maxch, "A%d") + call pargi (lenfmt) + } + + if (badfmt) { + call error (1, + "Use simple Fortran format for new column in FITS ASCII table") + } +end diff --git a/pkg/tbtables/tbfdel.x b/pkg/tbtables/tbfdel.x new file mode 100644 index 00000000..822590d8 --- /dev/null +++ b/pkg/tbtables/tbfdel.x @@ -0,0 +1,31 @@ +include "tbtables.h" + +# tbfdel -- delete FITS table +# This routine deletes the current HDU in a FITS file, closes the FITS +# file, and frees the memory allocated by the table I/O routines. +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfdel (tp) + +pointer tp # io: pointer to table descriptor +#-- +int status # zero is OK +int hdutype # type of next HDU (ignored) +errchk tbferr + +begin + status = 0 + + # Delete the current HDU. + call fsdhdu (TB_FILE(tp), hdutype, status) + + if (status != 0) + call tbferr (status) + + # Close the FITS file. This sets TB_FILE to NULL. + call tbfclo (tp) + + # Free memory. + call tbtclo (tp) +end diff --git a/pkg/tbtables/tbferr.x b/pkg/tbtables/tbferr.x new file mode 100644 index 00000000..4895d9b1 --- /dev/null +++ b/pkg/tbtables/tbferr.x @@ -0,0 +1,38 @@ +# tbferr -- get FITSIO error message and call error +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbferr (status) + +int status # i: FITSIO error number; zero is OK +#-- +pointer sp +pointer errmess # for error message +pointer mess2 # for additional error messages +bool done + +begin + if (status == 0) + return + + call smark (sp) + call salloc (errmess, SZ_LINE, TY_CHAR) + call salloc (mess2, SZ_LINE, TY_CHAR) + + # Get the oldest error message. + call fsgmsg (Memc[errmess]) + + # Get more recent messages, if any. + done = false + while (!done) { + call fsgmsg (Memc[mess2]) + if (Memc[mess2] == EOS) { + done = true + } else { + call strcat (" ", Memc[errmess], SZ_LINE) + call strcat (Memc[mess2], Memc[errmess], SZ_LINE) + } + } + + call error (status, Memc[errmess]) +end diff --git a/pkg/tbtables/tbffkw.x b/pkg/tbtables/tbffkw.x new file mode 100644 index 00000000..7410fb23 --- /dev/null +++ b/pkg/tbtables/tbffkw.x @@ -0,0 +1,47 @@ +include +include "tbtables.h" +define SZ_FITS_REC 81 # size of buffer for a FITS header record + +# tbffkw -- find keyword number +# This routine finds a header record for a given keyword. If the keyword +# is found the number of the parameter in the table will be returned; +# otherwise, the number will be set to zero. The search begins with the +# first keyword and includes special keywords such as NAXIS. +# +# Phil Hodge, 22-Jan-1996 Subroutine created. + +procedure tbffkw (tp, keyword, parnum) + +pointer tp # i: Pointer to table descriptor +char keyword[SZ_KEYWORD] # i: Keyword to be found +int parnum # o: Parameter number or zero if not found +#-- +pointer sp +pointer par # buffer for header record for parameter +int status # error return code from fitsio +int k # loop index +char uckey[SZ_KEYWORD] # keyword converted to upper case +bool tbhkeq() +errchk tbferr + +begin + call smark (sp) + call salloc (par, SZ_FITS_REC, TY_CHAR) + + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + + do k = 1, TB_NPAR(tp) { + # Read parameter record. + call fsgrec (TB_FILE(tp), k, Memc[par], status) + if (status != 0) + call tbferr (status) + if (tbhkeq (uckey, Memc[par])) { # keywords equal? + parnum = k + call sfree (sp) + return # keyword has been found + } + } + parnum = 0 # keyword not found + call sfree (sp) +end diff --git a/pkg/tbtables/tbffmt.x b/pkg/tbtables/tbffmt.x new file mode 100644 index 00000000..ba56aad3 --- /dev/null +++ b/pkg/tbtables/tbffmt.x @@ -0,0 +1,58 @@ +include "tbtables.h" +include "tblfits.h" # defines FITS_KEYWORD_MISSING + +# tbffmt -- change print format +# This procedure replaces the print format for a column in a FITS table. +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbffmt (tp, cp, colfmt) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to a column descriptor +char colfmt[ARB] # i: print format for column +#-- +pointer sp +pointer keyword # scratch for keyword name +pointer dummy # for current value, if keyword already exists +pointer comment # for comment string +pointer pformat # print format converted to Fortran style +int status # zero is OK +errchk tbfptf, tbferr + +begin + call smark (sp) + call salloc (keyword, SZ_FNAME, TY_CHAR) + call salloc (dummy, SZ_FNAME, TY_CHAR) + call salloc (comment, SZ_FNAME, TY_CHAR) + call salloc (pformat, SZ_FNAME, TY_CHAR) + + # Convert print format to Fortran. + call tbfptf (colfmt, Memc[pformat], SZ_FNAME) + + call sprintf (Memc[keyword], SZ_FNAME, "TDISP%d") + call pargi (COL_NUMBER(cp)) + + status = 0 + + # Get the comment, if the keyword already exists. + call fsgkys (TB_FILE(tp), Memc[keyword], + Memc[dummy], Memc[comment], status) + if (status != 0) { + if (status == FITS_KEYWORD_MISSING) { + status = 0 + call ftcmsg() + call fsukys (TB_FILE(tp), Memc[keyword], colfmt, + "print format for column", status) + } + } else { + # Modify existing keyword value, leaving comment unchanged. + call fsmkys (TB_FILE(tp), Memc[keyword], colfmt, + Memc[comment], status) + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbffnd.x b/pkg/tbtables/tbffnd.x new file mode 100644 index 00000000..3b90b80a --- /dev/null +++ b/pkg/tbtables/tbffnd.x @@ -0,0 +1,180 @@ +include "tbtables.h" +include "tblfits.h" # for FITS_END_OF_FILE + +# tbffnd -- find table in FITS file +# This routine finds an existing table in a FITS file. +# The function value will be the extension number (0 = primary header) +# if the table was found; otherwise, EOF will be returned. +# +# The extension may have been specified by extension number, name (EXTNAME), +# version number (EXTVER), or some combination. Not specifying any extension +# at all is interpreted to mean extension number one (the first after the +# primary header/data unit). +# +# Phil Hodge, 2-Feb-1996 Subroutine created +# Phil Hodge, 20-May-1996 If no extension specified, only check first one. +# Phil Hodge, 1-Jun-1999 Use TB_FILE instead of fd. +# Phil Hodge, 26-Apr-2002 Allow opening any type of extension. + +int procedure tbffnd (tp, extname, maxch, extver, hdutype) + +pointer tp # i: pointer to table descriptor +char extname[maxch] # o: actual EXTNAME read from header, or "" +int maxch # i: size of extname +int extver # o: EXTVER from header, or -1 +int hdutype # o: type of HDU +#-- +pointer sp +pointer comment # for comment for keyword or for error message +pointer t_extname # for extension name in table header +pointer u_extname # for user-specified extension name +pointer save # a copy of EXTNAME from header, to preserve case +int hdu # HDU number in user-interface numbering convention +int t_extver # extension version number from table header +int u_extver # user-specified extension version number +int t_hdutype # type of current HDU in file +int status # zero is OK +bool foundit # true if we have found the table in the file +bool streq(), strne() +errchk tbferr + +begin + extname[1] = EOS # initial values + extver = -1 + status = 0 + + hdu = TB_HDU(tp) + + # Was no extension specified by number, version, or name? + # If so, assume the first extension was intended. + if (TB_HDU(tp) < 0 && TB_EXTVER(tp) < 0 && streq (TB_EXTNAME(tp), "")) + hdu = 1 # first after primary HDU + + if (hdu == 0) { + + # Move to the primary HDU (should be there already, actually). + call fsmahd (TB_FILE(tp), hdu+1, t_hdutype, status) + if (status != 0) + call tbferr (status) + + hdutype = t_hdutype # note: not a table! + + return (0) + } + + call smark (sp) + call salloc (t_extname, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + if (hdu > 0) { + + # The extension was specified by number. + + # Go to the specified HDU number. (Add one to the HDU number to + # conform to the numbering convention in the FITSIO interface.) + call fsmahd (TB_FILE(tp), hdu+1, t_hdutype, status) + if (status != 0) + call tbferr (status) + + # Get EXTNAME from header, if it is present. + call fsgkys (TB_FILE(tp), "EXTNAME", Memc[t_extname], + Memc[comment], status) + if (status == 0) { + call strcpy (Memc[t_extname], extname, maxch) + } else { + status = 0 + call ftcmsg() + } + + # Get EXTVER from header, if present. + call fsgkyj (TB_FILE(tp), "EXTVER", t_extver, Memc[comment], status) + if (status == 0) { + extver = t_extver + } else { + status = 0 + call ftcmsg() + } + + hdutype = t_hdutype + + call sfree (sp) + return (hdu) + } + + # Search for the table that matches whatever was specified. + + call salloc (u_extname, SZ_LINE, TY_CHAR) + call salloc (save, SZ_LINE, TY_CHAR) + + # User-specified values. + call strcpy (TB_EXTNAME(tp), Memc[u_extname], SZ_LINE) + call strlwr (Memc[u_extname]) # for case insensitive comparison + u_extver = TB_EXTVER(tp) + + # Assign initial values, in case we're not searching on these. + Memc[save] = EOS + t_extver = -1 + + hdu = 0 # incremented in loop + foundit = false + while (!foundit) { + + # Move forward one HDU. + hdu = hdu + 1 + call fsmahd (TB_FILE(tp), hdu+1, t_hdutype, status) + if (status == FITS_END_OF_FILE) { + call ftcmsg() + # The table was not found. + call sfree (sp) + return (EOF) + } else if (status != 0) { # some other error + call tbferr (status) + } + + # Is this the right extension? + + if (Memc[u_extname] != EOS) { + + # EXTNAME was specified. + call fsgkys (TB_FILE(tp), "EXTNAME", Memc[t_extname], + Memc[comment], status) + if (status != 0) { # EXTNAME not found. + status = 0 + call ftcmsg() + next + } else { + # Does EXTNAME match? (case insensitive comparison) + # Save t_extname to preserve case. + call strcpy (Memc[t_extname], Memc[save], SZ_LINE) + call strlwr (Memc[t_extname]) + if (strne (Memc[t_extname], Memc[u_extname])) + next # EXTNAME does not match + } + } + + if (u_extver > 0) { + + # EXTVER was specified. + call fsgkyj (TB_FILE(tp), "EXTVER", t_extver, + Memc[comment], status) + if (status != 0) { + # EXTVER not found in current header. + status = 0 + call ftcmsg() + next + } else if (t_extver != u_extver) { + next # EXTVER does not match + } + } + + # We get here only if all tests succeeded. + # Save info that we read from the header. + call strcpy (Memc[save], extname, maxch) + extver = t_extver + hdutype = t_hdutype + foundit = true + } + + call sfree (sp) + return (hdu) # user-interface numbering convention +end diff --git a/pkg/tbtables/tbfgcm.x b/pkg/tbtables/tbfgcm.x new file mode 100644 index 00000000..22e483ad --- /dev/null +++ b/pkg/tbtables/tbfgcm.x @@ -0,0 +1,50 @@ +include +include "tbtables.h" + +# tbfgcm -- get a comment for a FITS header parameter +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfgcm (tp, keyword, comment, maxch) + +pointer tp # i: pointer to table descriptor +char keyword[SZ_KEYWORD] # i: keyword to be found +char comment[ARB] # o: comment string for keyword +int maxch # i: max size of comment +#-- +pointer sp +pointer value # scratch for value (ignored) +pointer cmt # scratch for comment; also for error message +int status # zero is OK +bool streq() +errchk tbferr + +begin + call smark (sp) + call salloc (value, SZ_LINE, TY_CHAR) + call salloc (cmt, SZ_LINE, TY_CHAR) + + # Check for history or comment. + call strcpy (keyword, Memc[value], SZ_LINE) # temp + call strupr (Memc[value]) + if (streq (Memc[value], "HISTORY") || + streq (Memc[value], "COMMENT") || + streq (Memc[value], " ") || keyword[1] == EOS) { + + comment[1] = EOS + call sfree (sp) + return + } + + status = 0 + + # Get the value and comment. + call fsgkey (TB_FILE(tp), keyword, Memc[value], Memc[cmt], status) + + if (status != 0) + call tbferr (status) + + call strcpy (Memc[cmt], comment, maxch) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfgnp.x b/pkg/tbtables/tbfgnp.x new file mode 100644 index 00000000..b506eb40 --- /dev/null +++ b/pkg/tbtables/tbfgnp.x @@ -0,0 +1,160 @@ +include # for SQUOTE, ESCAPE, etc +include +include "tbtables.h" + +define LOCN_BEGIN 11 # location of beginning of keyword value +define LOCN_END 30 # location of end of keyword value + +# tbfgnp -- get Nth parameter from FITS table +# Get the keyword and value string of header parameter number parnum. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 27-Nov-1995 Add comment to calling sequence. + +procedure tbfgnp (tp, parnum, keyword, dtype, str, comment, maxch) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be gotten +char keyword[SZ_KEYWORD] # o: keyword for the parameter +int dtype # o: data type (TY_CHAR, etc) +char str[maxch] # o: string to contain the value of the param. +char comment[maxch] # o: string to contain comment, if any +int maxch # i: max size of str +#-- +pointer sp +pointer rec # scratch for header record +pointer value # scratch for value +pointer cmt # scratch for comment +int i, j # loop indexes +int status # zero is OK +int strlen() +bool tbhisc() +errchk tbferr + +begin + call smark (sp) + call salloc (rec, SZ_LINE, TY_CHAR) + call salloc (value, SZ_LINE, TY_CHAR) + call salloc (cmt, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the Nth header record. + call fsgrec (TB_FILE(tp), parnum, Memc[rec], status) + + if (status != 0) + call tbferr (status) + + # Copy the keyword to output and append EOS. + do i = 1, SZ_KEYWORD { + if (Memc[rec+i-1] == BLANK) { # stop at first blank + keyword[i] = EOS + break + } + keyword[i] = Memc[rec+i-1] + } + keyword[SZ_KEYWORD+1] = EOS + + # Parse the value and comment. + call fspsvc (Memc[rec], Memc[value], Memc[cmt], status) + + # The FITSIO interface puts the contents of a HISTORY or COMMENT + # record in the comment portion, but I prefer it to be the value. + if (tbhisc (keyword)) { + + call strcpy (Memc[cmt], Memc[value], maxch) + Memc[cmt] = EOS + + # Remove equal sign, quotes, and /, if they are present. + j = strlen (Memc[value]) + i = 0 # i is zero indexed + while (Memc[value+i] == BLANK) + i = i + 1 + if (Memc[value+i] == '=') + Memc[value+i] = BLANK # replace '=' with blank + while (Memc[value+i] == BLANK) + i = i + 1 + if (Memc[value+i] == SQUOTE) { + Memc[value+i] = BLANK # replace quote with blank + while (i < j) { # look for trailing quote + if (Memc[value+i] == SQUOTE) { + if (Memc[value+i-1] != ESCAPE) { + Memc[value+i] = EOS + break + } + } + i = i + 1 + } + } + } + + # Check for (and remove) quotes enclosing the value. + if (Memc[value] == SQUOTE) { + j = strlen (Memc[value]) + Memc[value+j-1] = EOS # clobber close quote + do i = 1, j-1 # shift left one character + Memc[value+i-1] = Memc[value+i] + } + + # Trim trailing blanks from keyword value. + do i = strlen (Memc[value]), 1, -1 { + if (Memc[value+i-1] == BLANK) + Memc[value+i-1] = EOS + else + break + } + + # Trim trailing blanks from comment. + do i = strlen (Memc[cmt]), 1, -1 { + if (Memc[cmt+i-1] == BLANK) + Memc[cmt+i-1] = EOS + else + break + } + + # Copy the value and comment to output. + call strcpy (Memc[value], str, maxch) + call strcpy (Memc[cmt], comment, maxch) + + # Determine the data type. + + call strupr (Memc[rec]) + do i = 1, SZ_LINE { + # Fill out the buffer from the comment on (or from EOS). + if (Memc[rec+i-1] == '/' || Memc[rec+i-1] == EOS) { + do j = i, SZ_LINE + Memc[rec+j-1] = EOS + break + } + } + + if (tbhisc (keyword)) { + + dtype = TY_CHAR + + } else if (Memc[rec+LOCN_BEGIN-1] == SQUOTE) { + + dtype = TY_CHAR + + } else if (Memc[rec+LOCN_END-1] == 'T' || + Memc[rec+LOCN_END-1] == 'F') { + + dtype = TY_BOOL + + } else { + + dtype = TY_INT # may be reset below + do i = LOCN_BEGIN, LOCN_END { + if (Memc[rec+i-1] == EOS) + break + if (Memc[rec+i-1] == '.' || + Memc[rec+i-1] == 'E' || Memc[rec+i-1] == 'D') { + dtype = TY_DOUBLE + break + } + } + # We should also check whether there's an imaginary part. + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfhdl.x b/pkg/tbtables/tbfhdl.x new file mode 100644 index 00000000..df3377c7 --- /dev/null +++ b/pkg/tbtables/tbfhdl.x @@ -0,0 +1,27 @@ +include "tbtables.h" + +# tbfhdl -- delete a header keyword from a FITS table +# This routine deletes one header keyword (by number) from the current HDU +# in a FITS file. +# +# Phil Hodge, 3-Oct-1995 Subroutine created + +procedure tbfhdl (tp, parnum) + +pointer tp # io: pointer to table descriptor +int parnum # i: number of the parameter to be deleted +#-- +int status # zero is OK +errchk tbferr + +begin + status = 0 + + # Delete the keyword. + call ftdrec (TB_FILE(tp), parnum, status) + + if (status != 0) + call tbferr (status) + + TB_NPAR(tp) = TB_NPAR(tp) - 1 +end diff --git a/pkg/tbtables/tbfhg.x b/pkg/tbtables/tbfhg.x new file mode 100644 index 00000000..4799909a --- /dev/null +++ b/pkg/tbtables/tbfhg.x @@ -0,0 +1,241 @@ +include +include "tbtables.h" + +# Get a parameter from a FITS table header. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 14-Aug-1997 In tbfhgt, allocate local buffer. +# Phil Hodge, 5-Aug-1999 In tbfhgt, for history or comment, copy the +# comment field to output, rather than the value field. + +# tbfhgd -- get double-precision header parameter + +procedure tbfhgd (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +double value # o: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for getting the comment +int status # zero is OK +int ip, junk, ctod() +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the value as a string. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + if (status != 0) + call tbferr (status) + + ip = 1 + if (Memc[sval] == '\'') + ip = 2 # skip over the quote + else if (Memc[sval] == 'T') + Memc[sval] = '1' + else if (Memc[sval] == 'F') + Memc[sval] = '0' + + value = INDEFD + junk = ctod (Memc[sval], ip, value) + + call sfree (sp) +end + +# tbfhgr -- get single-precision header parameter + +procedure tbfhgr (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +real value # o: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for getting the comment +int status # zero is OK +int ip, junk, ctor() +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the value as a string. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + if (status != 0) + call tbferr (status) + + ip = 1 + if (Memc[sval] == '\'') + ip = 2 # skip over the quote + else if (Memc[sval] == 'T') + Memc[sval] = '1' + else if (Memc[sval] == 'F') + Memc[sval] = '0' + + value = INDEFR + junk = ctor (Memc[sval], ip, value) + + call sfree (sp) +end + +# tbfhgi -- get integer header parameter + +procedure tbfhgi (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +int value # o: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for getting the comment +double dval +int status # zero is OK +int ip, junk, ctod() +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the value as a string. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + if (status != 0) + call tbferr (status) + + ip = 1 + if (Memc[sval] == '\'') + ip = 2 # skip over the quote + else if (Memc[sval] == 'T') + Memc[sval] = '1' + else if (Memc[sval] == 'F') + Memc[sval] = '0' + + dval = INDEFD + junk = ctod (Memc[sval], ip, dval) + if (IS_INDEFD(dval)) + value = INDEFI + else + value = nint (dval) + + call sfree (sp) +end + +# tbfhgb -- get Boolean header parameter +# If the header keyword is not T or F, then zero is interpreted as false, +# and any other numerical value is true. + +procedure tbfhgb (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +bool value # o: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for getting the comment +double dval +int status # zero is OK +int ip, junk, ctod() +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the value as a string. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + if (status != 0) + call tbferr (status) + + call strupr (Memc[sval]) + + ip = 1 + if (Memc[sval] == '\'') + ip = 2 # skip over the quote + + if (Memc[sval+ip-1] == 'T') { + value = true + call sfree (sp) + return + } else if (Memc[sval+ip-1] == 'F') { + value = false + call sfree (sp) + return + } + + dval = INDEFD + junk = ctod (Memc[sval], ip, dval) + if (IS_INDEFD(dval)) + value = false + else if (nint (dval) == 0) + value = false + else + value = true + + call sfree (sp) +end + +# tbfhgt -- get text-string header parameter + +procedure tbfhgt (tp, keyword, text, maxch) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +char text[ARB] # o: value of parameter +int maxch # i: maximum number of characters to get +#-- +pointer sp +pointer temp # for getting the value +pointer comment # for getting the comment +int i +int status # zero is OK +int strlen() +bool tbhisc() +errchk tbferr + +begin + call smark (sp) + call salloc (temp, max (maxch, SZ_FNAME), TY_CHAR) + call salloc (comment, SZ_FNAME, TY_CHAR) + + status = 0 + + call fsgkys (TB_FILE(tp), keyword, Memc[temp], Memc[comment], status) + if (status != 0) + call tbferr (status) + + # For COMMENT and HISTORY keywords, FITSIO returns the value in + # the comment argument rather than the value argument. + if (tbhisc (keyword)) + call strcpy (Memc[comment], Memc[temp], SZ_FNAME) + + # Trim trailing blanks. + do i = strlen (Memc[temp]), 1, -1 { + if (Memc[temp+i-1] == ' ') + Memc[temp+i-1] = EOS + else + break + } + call strcpy (Memc[temp], text, maxch) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfhp.x b/pkg/tbtables/tbfhp.x new file mode 100644 index 00000000..2bd834b1 --- /dev/null +++ b/pkg/tbtables/tbfhp.x @@ -0,0 +1,330 @@ +include +include +include "tbtables.h" +include "tblfits.h" # defines FITS_KEYWORD_MISSING + +# These specify the precision to be used for writing floating-point keywords. +# The fact that they're negative is a flag to CFITSIO to use g format. +define NDECIMALS_SINGLE (-7) +define NDECIMALS_DOUBLE (-15) + +# Put a parameter into a FITS table header. If the keyword already +# exists, it will be updated; otherwise, it will be added. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 20-Feb-1997 Change decimals of output in tbfhpd and tbfhpr: +# in tbfhpd change 15 to 14; in tbfhpr change 7 to 6. +# Phil Hodge, 14-Jan-1998 Change decimals of output in tbfhpd and tbfhpr +# for new keywords, 15 to 14 and 7 to 6 respectively. +# Phil Hodge, 20-Jul-1998 In tbfhpt, include explicit test for history, +# comment, or blank, and use appropriate fitsio routine. +# Phil Hodge, 29-Aug-2000 Change 14 and 6 in tbfhpd and tbfhpr respectively +# to -15 and -7, so cfitsio will use g format. +# Phil Hodge, 29-Jan-2002 In tbfhpt, for keyword = blank, sprintf only eight +# spaces before the value, to agree with cfitsio. + +# tbfhpd -- put double-precision header parameter + +procedure tbfhpd (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +double value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +bool bval +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + call sprintf (Memc[sval], SZ_LINE, "%-25.15g") + call pargd (value) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else if (Memc[sval] == 'T' || Memc[sval] == 'F') { + bval = (value != 0.d0) + call fsmkyl (TB_FILE(tp), keyword, bval, Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkyd (TB_FILE(tp), keyword, value, NDECIMALS_DOUBLE, + Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkyd (TB_FILE(tp), keyword, value, NDECIMALS_DOUBLE, + "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpr -- put single-precision header parameter + +procedure tbfhpr (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +real value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +bool bval +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + call sprintf (Memc[sval], SZ_LINE, "%-15.7g") + call pargr (value) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else if (Memc[sval] == 'T' || Memc[sval] == 'F') { + bval = (value != 0.) + call fsmkyl (TB_FILE(tp), keyword, bval, Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkye (TB_FILE(tp), keyword, value, NDECIMALS_SINGLE, + Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkye (TB_FILE(tp), keyword, value, NDECIMALS_SINGLE, + "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpi -- put integer header parameter + +procedure tbfhpi (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +int value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +bool bval +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + call sprintf (Memc[sval], SZ_LINE, "%-10d") + call pargi (value) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else if (Memc[sval] == 'T' || Memc[sval] == 'F') { + bval = (value != 0) + call fsmkyl (TB_FILE(tp), keyword, bval, Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkyj (TB_FILE(tp), keyword, value, Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkyj (TB_FILE(tp), keyword, value, "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpb -- put Boolean header parameter + +procedure tbfhpb (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +bool value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + if (value) + call strcpy ("TRUE", Memc[sval], SZ_LINE) + else + call strcpy ("FALSE", Memc[sval], SZ_LINE) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkyl (TB_FILE(tp), keyword, value, Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkyl (TB_FILE(tp), keyword, value, "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpt -- put text-string header parameter + +procedure tbfhpt (tp, keyword, text) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +char text[ARB] # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +char uckey[SZ_KEYWORD] # keyword converted to upper case +bool iscomment # true if the keyword is history, comment, or blank +int k # loop index +int status # zero is OK +int strlen() +bool streq() +errchk tbferr + +begin + status = 0 + + # Convert to upper case and trim trailing blanks. + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + do k = strlen (uckey), 1, -1 { + if (IS_WHITE(uckey[k])) + uckey[k] = EOS + else + break + } + + # If the keyword is history or comment, add a new keyword record. + if (streq (uckey, "HISTORY")) { + iscomment = true + call fsphis (TB_FILE(tp), text, status) + } else if (streq (uckey, "COMMENT")) { + iscomment = true + call fspcom (TB_FILE(tp), text, status) + } else if (uckey[1] == EOS) { + iscomment = true + call smark (sp) + call salloc (comment, SZ_PARREC, TY_CHAR) + call sprintf (Memc[comment], SZ_PARREC, " %s") + call pargstr (text) + call fsprec (TB_FILE(tp), Memc[comment], status) + call sfree (sp) + } else { + iscomment = false + } + if (iscomment) { + if (status != 0) + call tbferr (status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + return + } + + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + # Get current value to see if the keyword already exists. + call fsgkys (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + # Modify existing keyword value, leaving comment unchanged. + call fsmkys (TB_FILE(tp), keyword, text, Memc[comment], status) + } else if (status == FITS_KEYWORD_MISSING) { + status = 0 + call ftcmsg() + call fspkys (TB_FILE(tp), keyword, text, "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfhp_f.x b/pkg/tbtables/tbfhp_f.x new file mode 100644 index 00000000..79cd2089 --- /dev/null +++ b/pkg/tbtables/tbfhp_f.x @@ -0,0 +1,334 @@ +include +include +include "tbtables.h" +include "tblfits.h" # defines FITS_KEYWORD_MISSING + +# These specify the precision to be used for writing floating-point keywords. +# The number of significant figures is actually one more than these values. +define NDECIMALS_SINGLE 6 +define NDECIMALS_DOUBLE 14 + +# Put a parameter into a FITS table header. If the keyword already +# exists, it will be updated; otherwise, it will be added. +# +# NOTE: This file contains the same subroutines as tbfhp.x. This +# version should be compiled instead of tbfhp.x when the SPP version +# of FITSIO is used. The difference is that tbfhpd and tbfhpr in +# tbfhp.x pass negative values for the number of decimal places for +# the keyword value, which is interpreted by CFITSIO to mean that +# g format should be used to format the value; this is not supported +# by SPP/Fortran FITSIO. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 20-Feb-1997 Change decimals of output in tbfhpd and tbfhpr: +# in tbfhpd change 15 to 14; in tbfhpr change 7 to 6. +# Phil Hodge, 14-Jan-1998 Change decimals of output in tbfhpd and tbfhpr +# for new keywords, 15 to 14 and 7 to 6 respectively. +# Phil Hodge, 20-Jul-1998 In tbfhpt, include explicit test for history, +# comment, or blank, and use appropriate fitsio routine. + +# tbfhpd -- put double-precision header parameter + +procedure tbfhpd (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +double value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +bool bval +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + call sprintf (Memc[sval], SZ_LINE, "%-25.15g") + call pargd (value) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else if (Memc[sval] == 'T' || Memc[sval] == 'F') { + bval = (value != 0.d0) + call fsmkyl (TB_FILE(tp), keyword, bval, Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkyd (TB_FILE(tp), keyword, value, NDECIMALS_DOUBLE, + Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkyd (TB_FILE(tp), keyword, value, NDECIMALS_DOUBLE, + "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpr -- put single-precision header parameter + +procedure tbfhpr (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +real value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +bool bval +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + call sprintf (Memc[sval], SZ_LINE, "%-15.7g") + call pargr (value) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else if (Memc[sval] == 'T' || Memc[sval] == 'F') { + bval = (value != 0.) + call fsmkyl (TB_FILE(tp), keyword, bval, Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkye (TB_FILE(tp), keyword, value, NDECIMALS_SINGLE, + Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkye (TB_FILE(tp), keyword, value, NDECIMALS_SINGLE, + "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpi -- put integer header parameter + +procedure tbfhpi (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +int value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +bool bval +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + call sprintf (Memc[sval], SZ_LINE, "%-10d") + call pargi (value) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else if (Memc[sval] == 'T' || Memc[sval] == 'F') { + bval = (value != 0) + call fsmkyl (TB_FILE(tp), keyword, bval, Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkyj (TB_FILE(tp), keyword, value, Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkyj (TB_FILE(tp), keyword, value, "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpb -- put Boolean header parameter + +procedure tbfhpb (tp, keyword, value) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +bool value # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +int status # zero is OK +errchk tbferr + +begin + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + status = 0 + + # Get the current value to see if the keyword already exists, + # and if so, to check the data type. + call fsgkey (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + + # Modify existing keyword value, leaving comment unchanged. + if (Memc[sval] == '\'') { + if (value) + call strcpy ("TRUE", Memc[sval], SZ_LINE) + else + call strcpy ("FALSE", Memc[sval], SZ_LINE) + call fsmkys (TB_FILE(tp), keyword, Memc[sval], + Memc[comment], status) + } else { + # FITSIO should be able to handle other type conversions. + call fsmkyl (TB_FILE(tp), keyword, value, Memc[comment], status) + } + + } else if (status == FITS_KEYWORD_MISSING) { + + status = 0 + call ftcmsg() + call fspkyl (TB_FILE(tp), keyword, value, "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end + +# tbfhpt -- put text-string header parameter + +procedure tbfhpt (tp, keyword, text) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to put +char text[ARB] # i: value of parameter +#-- +pointer sp +pointer sval # for getting the value as a string +pointer comment # for comment string +char uckey[SZ_KEYWORD] # keyword converted to upper case +bool iscomment # true if the keyword is history, comment, or blank +int k # loop index +int status # zero is OK +int strlen() +bool streq() +errchk tbferr + +begin + status = 0 + + # Convert to upper case and trim trailing blanks. + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + do k = strlen (uckey), 1, -1 { + if (IS_WHITE(uckey[k])) + uckey[k] = EOS + else + break + } + + # If the keyword is history or comment, add a new keyword record. + if (streq (uckey, "HISTORY")) { + iscomment = true + call fsphis (TB_FILE(tp), text, status) + } else if (streq (uckey, "COMMENT")) { + iscomment = true + call fspcom (TB_FILE(tp), text, status) + } else if (uckey[1] == EOS) { + iscomment = true + call smark (sp) + call salloc (comment, SZ_PARREC, TY_CHAR) + call sprintf (Memc[comment], SZ_PARREC, " %s") + call pargstr (text) + call fsprec (TB_FILE(tp), Memc[comment], status) + call sfree (sp) + } else { + iscomment = false + } + if (iscomment) { + if (status != 0) + call tbferr (status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + return + } + + call smark (sp) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + # Get current value to see if the keyword already exists. + call fsgkys (TB_FILE(tp), keyword, Memc[sval], Memc[comment], status) + + if (status == 0) { + # Modify existing keyword value, leaving comment unchanged. + call fsmkys (TB_FILE(tp), keyword, text, Memc[comment], status) + } else if (status == FITS_KEYWORD_MISSING) { + status = 0 + call ftcmsg() + call fspkys (TB_FILE(tp), keyword, text, "", status) + TB_NPAR(tp) = TB_NPAR(tp) + 1 + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfiga.x b/pkg/tbtables/tbfiga.x new file mode 100644 index 00000000..cdcea1a5 --- /dev/null +++ b/pkg/tbtables/tbfiga.x @@ -0,0 +1,57 @@ +include "tbtables.h" + +# This file contains tbfiga and tbfisa for getting or setting the TDIM +# keyword in a FITS file. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length. + +# tbfiga -- get dimension of array and length of each axis + +procedure tbfiga (tp, cp, ndim, axlen, maxdim) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int ndim # o: dimension of array +int axlen[maxdim] # o: length of each axis +int maxdim # i: size of axlen array +#-- +int status # zero is OK +errchk tbferr + +begin + if (!TB_IS_OPEN(tp)) { + ndim = 1 + axlen[1] = COL_NELEM(cp) + return + } + + status = 0 + + call fsgtdm (TB_FILE(tp), COL_NUMBER(cp), maxdim, ndim, axlen, status) + if (status != 0) + call tbferr (status) +end + +# tbfisa -- set dimension of array and length of each axis + +procedure tbfisa (tp, cp, ndim, axlen) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int ndim # i: dimension of array +int axlen[ARB] # i: length of each axis +#-- +int status # zero is OK +errchk tbferr + +begin + if (!TB_IS_OPEN(tp)) + return + + status = 0 + + call fsptdm (TB_FILE(tp), COL_NUMBER(cp), ndim, axlen, status) + if (status != 0) + call tbferr (status) +end diff --git a/pkg/tbtables/tbfnam.x b/pkg/tbtables/tbfnam.x new file mode 100644 index 00000000..f4a6b8ad --- /dev/null +++ b/pkg/tbtables/tbfnam.x @@ -0,0 +1,53 @@ +include "tbtables.h" +include "tblfits.h" # defines FITS_KEYWORD_MISSING + +# tbfnam -- change column name +# This procedure replaces the column name in a FITS table. +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfnam (tp, cp, colname) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +char colname[ARB] # i: new column name +#-- +pointer sp +pointer keyword # scratch for keyword name +pointer dummy # for current value, if keyword already exists +pointer comment # for comment string +int status # zero is OK +errchk tbferr + +begin + call smark (sp) + call salloc (keyword, SZ_FNAME, TY_CHAR) + call salloc (dummy, SZ_FNAME, TY_CHAR) + call salloc (comment, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[keyword], SZ_FNAME, "TTYPE%d") + call pargi (COL_NUMBER(cp)) + + status = 0 + + # Get the comment, if the keyword already exists. + call fsgkys (TB_FILE(tp), Memc[keyword], + Memc[dummy], Memc[comment], status) + if (status != 0) { + if (status == FITS_KEYWORD_MISSING) { + status = 0 + call ftcmsg() + call fsukys (TB_FILE(tp), Memc[keyword], colname, + "column name", status) + } + } else { + # Modify existing keyword value, leaving comment unchanged. + call fsmkys (TB_FILE(tp), Memc[keyword], colname, + Memc[comment], status) + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfnew.x b/pkg/tbtables/tbfnew.x new file mode 100644 index 00000000..227bae58 --- /dev/null +++ b/pkg/tbtables/tbfnew.x @@ -0,0 +1,436 @@ +# This file contains tbfnew and tbfroot. + +include +include "tbtables.h" +include "tblfits.h" # defines SZ_FTTYPE, FITS_INDEFI, FITS_ORIGIN, etc + +# tbfnew -- create a new FITS table +# If the FITS file doesn't exist it will be created. If it does exist +# a new BINTABLE extension will be created at the end of the file (or +# one will be replaced, if overwrite=yes). +# +# Note that the TABLE extension (ASCII) is not supported. +# +# The unit number used by the FITSIO interface is gotten and assigned to +# what would be the fd file number for ordinary iraf I/O. +# +# If an EXTNAME was included in the file name (i.e. root.fits[extname]), +# that name will be used for the value of EXTNAME in the new extension. +# added to the header of the new extension. +# If an extension number was explicitly given in the file name, then +# the number must match the actual number of the extension to be created. +# It is not necessary to specify either a name or a number. +# +# If overwrite = YES was specified, an existing extension will be searched +# for and deleted, then the new table will be written in its place. +# +# On input to this routine, TB_HDU is either an explicit number or a flag +# (as is the case for tbfopn). On output, the number of the newly created +# extension will be assigned to TB_HDU. +# +# If we're creating a new FITS file, an NEXTEND keyword with a value of 1 +# will be added to the primary header. If we're appending a new extension +# to an existing FITS file, NEXTEND will be added or updated in the primary +# header if the primary data unit is null (i.e. NAXIS = 0). If overwrite=yes, +# then NEXTEND will not be modified, and it will not be added if it is not +# already present. +# +# Note that in calls to fsmahd, the HDU number is given as a number plus one. +# This is to emphasize the different numbering convention between FITSIO and +# the stsdas tables package. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 2-Feb-1996 Use tbffnd to find table in file; allow overwrite. +# Phil Hodge, 10-Apr-1997 Write FILENAME to PHU if new file (call tbfroot). +# Phil Hodge, 29-Jul-1997 Set nrows to zero instead of one. +# Phil Hodge, 14-Aug-1997 Set EXTEND = T in PHU if appending a new extension. +# Phil Hodge, 5-Mar-1998 fnroot and fnextn are functions, not subroutines. +# Phil Hodge, 5-Mar-1999 Move 'TB_FILE(tp) = fd' to after fsopen or fsinit. +# Phil Hodge, 12-Mar-1999 When 'TB_FILE(tp) = fd' was moved, it was to a +# point that was too far down; move it to the points immediately after +# the calls to fsopen and fsinit. +# Phil Hodge, 22-Mar-1999 Use TB_OS_FILENAME(tp) instead of TB_NAME(tp) as +# the name of the file to open. +# Change macro names SZ_FITS_TTYPE, SZ_FITS_TFORM and SZ_FITS_TUNIT +# to SZ_FTTYPE, SZ_FTFORM and SZ_FTUNIT respectively. +# Phil Hodge, 1-Jun-1999 Use both TB_FILE and TB_FILE2; +# fd is a two-element array, eight-byte aligned. +# Phil Hodge, 7-Jun-1999 Set TB_SUBTYPE instead of TB_HDUTYPE. +# Phil Hodge, 8-Sep-1999 Update NEXTEND in the primary header. +# Phil Hodge, 23-Jun-2000 Use COL_TDTYPE instead of COL_DTYPE, and add +# COL_TSCAL & COL_TZERO to the header if COL_TDTYPE != COL_DTYPE. + +procedure tbfnew (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer sp +pointer errmess +pointer ttype, tform, tunit # for arrays to be passed to fsibin +pointer extname # for extension name, if any +pointer tdisp # for print format +pointer keyword # for keyword name (e.g. TDISPn) +pointer filename # name without directory prefix +pointer comment # returned by fsgkyj and ignored +pointer cp # pointer to a column descriptor +int blocksize +int bitpix, naxis, naxes[2] +bool simple, extend +int status # zero is OK +int hdu # HDU number (zero is primary header) +int fd[2] # unit number for FITS file; cfitsio pointer +double dfd # to force alignment of fd +#equivalence (fd, dfd) # to force alignment of fd +int hdutype # type of current HDU +int extver # value of EXTVER from existing header, or -1 +int ncols # number of columns, but min of 1 (for allocating space) +int nrows # dummy number of rows +int nfields # number of columns to define +int vsize # size of area for variable-length data (zero) +int i +int ival # undefined value for int, short, bool +int ttype0, tform0, tunit0 # offsets into 2-D char arrays +int tdtype # "true" data type, i.e. not scaled by tscal, tzero +char dtype_c # data type char: 'D', 'E', 'J', 'I', 'L', 'A' +int nelem # array length +bool append # append new hdu at end of file? +bool done +pointer tbcnum() +int access() +int tbpsta(), tbcigi() +int tbffnd() +errchk tbffnd, tbfptf, tbferr + +begin + status = 0 + + append = true # reset if overwrite = yes + nfields = tbpsta (tp, TBL_NCOLS) + ncols = max (nfields, 1) + + call smark (sp) + call salloc (ttype, (SZ_FTTYPE+1) * ncols, TY_CHAR) + call salloc (tform, (SZ_FTFORM+1) * ncols, TY_CHAR) + call salloc (tunit, (SZ_FTUNIT+1) * ncols, TY_CHAR) + call salloc (extname, SZ_LINE, TY_CHAR) + call salloc (keyword, SZ_FNAME, TY_CHAR) + call salloc (tdisp, SZ_FNAME, TY_CHAR) + + # Get a unit number. + # This call does nothing if linked with CFITSIO. In that case, + # fd is output from fsopen or fsinit, and fd is actually a C pointer. + fd[2] = 0 # not needed for four-byte C pointers + call fsgiou (fd, status) + if (status != 0) + call tbferr (status) + + # See if the FITS file already exists. + if (access (TB_NAME(tp), 0, 0) == YES) { + + # Open the file read/write. + call fsopen (fd, TB_OS_FILENAME(tp), 1, blocksize, status) + if (status != 0) + call tbferr (status) + + TB_FILE(tp) = fd[1] + TB_FILE2(tp) = fd[2] + + # If overwrite=yes, find the specified extension and delete it. + # Then move to the previous hdu and set a flag (append=false) + # indicating that the hdu to be created should be inserted + # following that hdu. + if (TB_OVERWRITE(tp) == YES) { + + hdu = tbffnd (tp, Memc[extname], SZ_LINE, extver, hdutype) + if (hdu == EOF) { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "table not found in FITS file `%s'") + call pargstr (TB_NAME(tp)) + call error (status, Memc[errmess]) + } else { + call fsdhdu (fd, hdutype, status) + if (status != 0) + call tbferr (status) + # move to previous hdu, fitsio number (hdu-1) + 1 + call fsmahd (fd, hdu, hdutype, status) + if (status != 0) + call tbferr (status) + append = false + } + + } else { + + # Go to the primary header and make sure EXTEND = T. + call fsmahd (fd, 1, hdutype, status) # phdu + extend = true + call fsukyl (fd, "EXTEND", + extend, "There may be standard extensions", status) + if (status != 0) + call tbferr (status) + + # Find out how many extensions there currently are in the file. + done = false + hdu = 0 # incremented in the loop + while (!done) { + # Move forward one HDU. + hdu = hdu + 1 + call fsmahd (fd, hdu+1, hdutype, status) + if (status != 0) { # we've reached EOF + status = 0 + call ftcmsg() + done = true + } + } + # Return to the primary header, and update NEXTEND to the + # value it should be after we add a new extension. + call fsmahd (fd, 1, hdutype, status) + # check that the primary header is _just_ a header + call malloc (comment, SZ_FNAME, TY_CHAR) + call fsgkyj (fd, "NAXIS", naxis, Memc[comment], status) + call mfree (comment, TY_CHAR) + if (naxis == 0) { + call fsukyj (fd, "NEXTEND", + hdu, "number of extensions in file", status) + if (status != 0) + call tbferr (status) + } + + # Move back to the last existing HDU in the file; + # hdu is the number of the extension that we'll add later. + call fsmahd (fd, (hdu-1)+1, hdutype, status) + if (status != 0) + call tbferr (status) + } + + # Zero or -1 mean append at end of file. + if (TB_HDU(tp) <= 0) + TB_HDU(tp) = hdu # user-interface convention + + # Note that hdu is the last existing extension and is one indexed, + # while TB_HDU is the number of the new extension and is currently + # zero indexed. + + # If an HDU number was specified, it ought to agree with + # what we've found. + if (TB_HDU(tp) != hdu) { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "extension %d was specified, but %s currently has %d extensions") + call pargi (TB_HDU(tp)) + call pargstr (TB_NAME(tp)) + call pargi (hdu-1) + call error (status, Memc[errmess]) + } + + } else { + + # Create a new FITS file. + blocksize = 2880 + + if (TB_HDU(tp) <= 1) { + TB_HDU(tp) = 1 # user interface numbering + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "extension number in new FITS file (%s) can't be greater than one") + call pargstr (TB_NAME(tp)) + call error (1, Memc[errmess]) + } + + call fsinit (fd, TB_OS_FILENAME(tp), blocksize, status) + if (status != 0) + call tbferr (status) + + TB_FILE(tp) = fd[1] + TB_FILE2(tp) = fd[2] + + # Create the primary header unit (with no data). + simple = true + bitpix = 16 + naxis = 0 + naxes[1] = 0 + extend = true + call fsphpr (fd, simple, bitpix, naxis, naxes, + 0, 1, extend, status) + if (status != 0) + call tbferr (status) + + # Add the ORIGIN keyword to the primary header. + call fspkys (fd, "ORIGIN", FITS_ORIGIN, FITS_ORIGIN_CMT, status) + if (status != 0) + call tbferr (status) + + # Add the FILENAME keyword to the primary header. + call salloc (filename, SZ_FNAME, TY_CHAR) + call tbfroot (TB_NAME(tp), Memc[filename], SZ_FNAME) + call fspkys (fd, "FILENAME", Memc[filename], "name of file", status) + if (status != 0) + call tbferr (status) + + # Since this is a new file, set NEXTEND to one. + call fspkyj (fd, "NEXTEND", + 1, "number of extensions in file", status) + if (status != 0) + call tbferr (status) + } + + # Create a new empty HDU following the last extension that we + # have accessed. We skip this for now if overwrite = yes. + if (append) { + call fscrhd (fd, status) + if (status != 0) + call tbferr (status) + } + + TB_SUBTYPE(tp) = TBL_SUBTYPE_BINTABLE + + # Create a BINTABLE extension, not ASCII table, and write + # the required header keywords for this extension. + + # First fill the arrays of column names, etc. + ttype0 = 0 + tform0 = 0 + tunit0 = 0 + do i = 1, nfields { + cp = tbcnum (tp, i) + tdtype = COL_TDTYPE(cp) # "true" data type + nelem = tbcigi (cp, TBL_COL_LENDATA) + switch (tdtype) { # get TFORM code + case TY_DOUBLE: + dtype_c = 'D' + case TY_REAL: + dtype_c = 'E' + case TY_INT: + dtype_c = 'J' + case TY_SHORT: + dtype_c = 'I' + case TY_BOOL: + dtype_c = 'L' + default: + dtype_c = 'A' + } + call tbcigt (cp, TBL_COL_NAME, Memc[ttype+ttype0], SZ_FTTYPE) + call tbcigt (cp, TBL_COL_UNITS, Memc[tunit+tunit0], SZ_FTUNIT) + if (tdtype > 0) { + call sprintf (Memc[tform+tform0], SZ_FTFORM, "%d%c") + call pargi (nelem) + call pargc (dtype_c) + } else if (nelem > 1) { # array of char strings + call sprintf (Memc[tform+tform0], SZ_FTFORM, "%d%c%d") + call pargi (-tdtype * nelem) # FITSIO special convention + call pargc (dtype_c) + call pargi (-tdtype) + } else { # character string + call sprintf (Memc[tform+tform0], SZ_FTFORM, "%d%c") + call pargi (-tdtype) + call pargc (dtype_c) + } + ttype0 = ttype0 + SZ_FTTYPE + 1 # +1 for EOS + tform0 = tform0 + SZ_FTFORM + 1 + tunit0 = tunit0 + SZ_FTUNIT + 1 + } + nrows = 0 + vsize = 0 + + if (append) { + # Write required keywords in newly appended hdu. + call fsphbn (fd, nrows, nfields, Memc[ttype], Memc[tform], + Memc[tunit], TB_EXTNAME(tp), vsize, status) + } else { # insert + # Insert an hdu following the current one, and write keywords + # that define a binary table extension. + call fsibin (fd, nrows, nfields, Memc[ttype], Memc[tform], + Memc[tunit], TB_EXTNAME(tp), vsize, status) + } + if (status != 0) + call tbferr (status) + + # Add version number to header, if it was specified. + if (TB_EXTVER(tp) > 0) { + call fspkyj (fd, "EXTVER", + TB_EXTVER(tp), "extension version number", status) + if (status != 0) + call tbferr (status) + } + + # Write the display format and undefined value keywords. + do i = 1, nfields { + + cp = tbcnum (tp, i) + tdtype = COL_TDTYPE(cp) + + call sprintf (Memc[keyword], SZ_FNAME, "TDISP%d") + call pargi (i) + call tbcigt (cp, TBL_COL_FMT, Memc[tdisp], SZ_FNAME) + call tbfptf (Memc[tdisp], Memc[tdisp], SZ_FNAME) + call fspkys (fd, Memc[keyword], Memc[tdisp], "display format", + status) + if (status != 0) + call tbferr (status) + + # Create TNULL string, and add to header. + if (tdtype == TY_INT || tdtype == TY_SHORT) { + + call sprintf (Memc[keyword], SZ_FNAME, "TNULL%d") + call pargi (i) + if (tdtype == TY_INT) + ival = FITS_INDEFI + else if (tdtype == TY_SHORT) + ival = FITS_INDEFS + call fspkyj (fd, Memc[keyword], + ival, "undefined value for column", status) + if (status != 0) + call tbferr (status) + } + + # Add scaling parameters to header, if the true data type + # is not the same as the apparent data type. + if (tdtype != COL_DTYPE(cp)) { + + call sprintf (Memc[keyword], SZ_FNAME, "TSCAL%d") + call pargi (i) + call fspkyd (fd, Memc[keyword], + COL_TSCAL(cp), 14, "scale factor for column", status) + if (status != 0) + call tbferr (status) + + call sprintf (Memc[keyword], SZ_FNAME, "TZERO%d") + call pargi (i) + call fspkyd (fd, Memc[keyword], + COL_TZERO(cp), 14, "zero offset for column", status) + if (status != 0) + call tbferr (status) + } + } + + call fsrdef (fd, status) # shouldn't be needed + + call sfree (sp) +end + +procedure tbfroot (fullname, fname, maxch) + +char fullname[ARB] # i: full file name, possibly including directory +char fname[maxch] # o: root+extension, no directory prefix +int maxch # i: allocated size of fname +#-- +pointer sp +pointer extn # scratch +int nchar, fnroot(), fnextn() +errchk fnroot, fnextn + +begin + call smark (sp) + call salloc (extn, maxch, TY_CHAR) + + nchar = fnroot (fullname, fname, maxch) # extract root + nchar = fnextn (fullname, Memc[extn], maxch) # extract extension + + if (Memc[extn] != EOS) { + call strcat (".", fname, maxch) + call strcat (Memc[extn], fname, maxch) # append extension + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfnit.x b/pkg/tbtables/tbfnit.x new file mode 100644 index 00000000..707b0ec8 --- /dev/null +++ b/pkg/tbtables/tbfnit.x @@ -0,0 +1,53 @@ +include "tbtables.h" +include "tblfits.h" # defines FITS_KEYWORD_MISSING + +# tbfnit -- change column units +# This procedure replaces the column units in a FITS table. +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfnit (tp, cp, colunits) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to a column descriptor +char colunits[ARB] # i: column units +#-- +pointer sp +pointer keyword # scratch for keyword name +pointer dummy # for current value, if keyword already exists +pointer comment # for comment string +int status # zero is OK +errchk tbferr + +begin + call smark (sp) + call salloc (keyword, SZ_FNAME, TY_CHAR) + call salloc (dummy, SZ_FNAME, TY_CHAR) + call salloc (comment, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[keyword], SZ_FNAME, "TUNIT%d") + call pargi (COL_NUMBER(cp)) + + status = 0 + + # Get the comment, if the keyword already exists. + call fsgkys (TB_FILE(tp), Memc[keyword], + Memc[dummy], Memc[comment], status) + if (status != 0) { + if (status == FITS_KEYWORD_MISSING) { + status = 0 + call ftcmsg() + call fsukys (TB_FILE(tp), Memc[keyword], colunits, + "column units", status) + } + } else { + # Modify existing keyword value, leaving comment unchanged. + call fsmkys (TB_FILE(tp), Memc[keyword], colunits, + Memc[comment], status) + } + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfnll.x b/pkg/tbtables/tbfnll.x new file mode 100644 index 00000000..14abbf98 --- /dev/null +++ b/pkg/tbtables/tbfnll.x @@ -0,0 +1,42 @@ +include +include "tbtables.h" + +# tbfnll -- set elements to undefined in a FITS table +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfnll (tp, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +int firstrow # i: first row to be set to INDEF +int lastrow # i: last row to be set to INDEF +#-- +pointer cp # pointer to column descriptor +int row1, row2 # firstrow, lastrow truncated to 1, nrows +int row, col # loop indexes for row and column numbers +int nelem # number of elements for a column +int status # zero is OK +pointer tbcnum() +int tbcigi() +errchk tbferr + +begin + status = 0 + + row1 = max (1, firstrow) + row2 = min (TB_NROWS(tp), lastrow) + + do row = row1, row2 { + + do col = 1, TB_NCOLS(tp) { + + cp = tbcnum (tp, col) + + nelem = tbcigi (cp, TBL_COL_LENDATA) + + call fspclu (TB_FILE(tp), col, row, 1, nelem, status) + if (status != 0) + call tbferr (status) + } + } +end diff --git a/pkg/tbtables/tbfopn.x b/pkg/tbtables/tbfopn.x new file mode 100644 index 00000000..2d1a505d --- /dev/null +++ b/pkg/tbtables/tbfopn.x @@ -0,0 +1,127 @@ +include +include "tbtables.h" +include "tblfits.h" # for FITS_END_OF_FILE + +# tbfopn -- open FITS file and table +# This routine opens an existing table in a FITS file. +# +# The unit number used by the FITSIO interface is gotten and assigned to +# what would be the fd file number for ordinary iraf I/O. +# +# If the HDU was specified by name in the input file name +# (i.e. root.fits[extname]), the extension with that value of EXTNAME +# will be found in the FITS file. +# If the HDU was specified by number, that extension will be opened +# if it has XTENSION = 'TABLE' or 'BINTABLE'. +# If the extension was not specified in the file name (i.e. extname="", +# extver=-1, hdu=-1), the first extension of type TABLE or BINTABLE will be +# opened, and TB_HDU will be assigned the number of that extension. +# +# If the HDU was given as zero, the primary header will be opened, and +# the numbers of rows and columns will be set to zero. This gives access +# to the primary header keywords. It will be an error, though, to try to +# read or write table data, since the primary HDU cannot be a table. +# +# NOTE: +# On entry to this routine, TB_HDU is either a flag (-1) or a specific +# extension number, using the numbering convention of the user interface, +# where the primary HDU is zero. On successful exit from this routine, +# TB_HDU will be the actual extension number, using the same numbering +# convention. +# +# Phil Hodge, 6-Jul-1995 Subroutine created. +# Phil Hodge, 2-Feb-1996 Use tbffnd to find table in file. +# Phil Hodge, 15-May-1998 If error opening the file, call fsfiou and +# set TB_FILE(tp) to NULL before calling tbferr. +# Phil Hodge, 5-Mar-1999 Move 'TB_FILE(tp) = fd' to after the call to fsopen. +# Phil Hodge, 22-Mar-1999 Use TB_OS_FILENAME(tp) instead of TB_NAME(tp) as +# the name of the file to open. +# Phil Hodge, 1-Jun-1999 Use both TB_FILE and TB_FILE2; +# fd is a two-element array, eight-byte aligned. +# Phil Hodge, 7-Jun-1999 Set TB_SUBTYPE instead of TB_HDUTYPE. + +procedure tbfopn (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer sp +pointer extname # for value of EXTNAME from table header +pointer errmess # scratch for error message +int blocksize +int status # zero is OK +int hdu # HDU number +int extver # extension version number +int hdutype # type of HDU +int fd[2] # unit number for FITS file; cfitsio pointer +double dfd # to force alignment of fd +#equivalence (fd, dfd) # to force alignment of fd +int tbffnd() +bool strne() +errchk tbffnd, tbferr + +begin + call smark (sp) + call salloc (extname, SZ_LINE, TY_CHAR) + + status = 0 + + # Get a unit number. + # This call does nothing if linked with CFITSIO. In that case, + # fd is output from fsopen, and fd is actually a C pointer. + fd[2] = 0 # not needed for four-byte C pointers + call fsgiou (fd, status) + + # Open the FITS file. + blocksize = 2880 + if (TB_IOMODE(tp) == READ_ONLY) { + call fsopen (fd, TB_OS_FILENAME(tp), 0, blocksize, status) + } else if (TB_IOMODE(tp) == READ_WRITE) { + call fsopen (fd, TB_OS_FILENAME(tp), 1, blocksize, status) + } else { + call fsfiou (fd, status) + TB_FILE(tp) = 0 + TB_FILE2(tp) = 0 + call error (1, "tbfopn: invalid iomode") + } + if (status != 0) { + call fsfiou (fd, status) + TB_FILE(tp) = 0 + TB_FILE2(tp) = 0 + call tbferr (status) + } + TB_FILE(tp) = fd[1] + TB_FILE2(tp) = fd[2] + + # Find the specified extension in the file. + hdu = tbffnd (tp, Memc[extname], SZ_LINE, extver, hdutype) + if (hdu == EOF) { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "table not found in FITS file `%s'") + call pargstr (TB_NAME(tp)) + call error (status, Memc[errmess]) + } + + # Update values in table descriptor. + + if (TB_HDU(tp) < 0) + TB_HDU(tp) = hdu + + # Update EXTNAME from header to get correct case. + if (strne (TB_EXTNAME(tp), "")) + call strcpy (Memc[extname], TB_EXTNAME(tp), SZ_LINE) + + if (extver > 0) + TB_EXTVER(tp) = extver + + if (hdutype == TBL_FITS_BINARY) + TB_SUBTYPE(tp) = TBL_SUBTYPE_BINTABLE + else if (hdutype == TBL_FITS_ASCII) + TB_SUBTYPE(tp) = TBL_SUBTYPE_ASCII + else if (hdutype == TBL_FITS_IMAGE) # primary header + TB_SUBTYPE(tp) = TBL_SUBTYPE_IMAGE + else + TB_SUBTYPE(tp) = TBL_SUBTYPE_UNKNOWN + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfpcm.x b/pkg/tbtables/tbfpcm.x new file mode 100644 index 00000000..db96671c --- /dev/null +++ b/pkg/tbtables/tbfpcm.x @@ -0,0 +1,27 @@ +include "tbtables.h" + +# tbfpcm -- add a comment to a FITS header parameter +# This adds a comment to a header parameter, or replaces one that is +# already there. It is an error if the header parameter is not found. +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfpcm (tp, keyword, comment) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: keyword to be found +char comment[ARB] # i: comment string for keyword +#-- +int status # 0 is OK +errchk tbferr + +begin + if (comment[1] == EOS) + return + + status = 0 + + call fsmcom (TB_FILE(tp), keyword, comment, status) + if (status != 0) + call tbferr (status) +end diff --git a/pkg/tbtables/tbfpnp.x b/pkg/tbtables/tbfpnp.x new file mode 100644 index 00000000..96093bef --- /dev/null +++ b/pkg/tbtables/tbfpnp.x @@ -0,0 +1,146 @@ +include # for IS_WHITE +include +include "tbtables.h" + +# tbfpnp -- put Nth parameter to a FITS table header +# Put the keyword and value string of header parameter number parnum, +# which must already exist. The data type may be changed as well. +# If the keyword name of the current parnum in the table is the same as +# the replacement keyword, any existing comment will be preserved. +# +# Phil Hodge, 27-Nov-1995 Subroutine created + +procedure tbfpnp (tp, parnum, keyword, dtype, str) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be put +char keyword[SZ_KEYWORD] # i: keyword for the parameter +int dtype # i: data type (TY_CHAR, etc) +char str[ARB] # i: string containing the value of the param. +#-- +pointer sp +pointer rec # scratch for header record to be written +pointer strval # copy of str, without leading & trailing blanks +pointer oldrec # buffer for current value +pointer cmt # buffer for current comment +char ukkey[SZ_KEYWORD] # keyword name in upper case +char oldkey[SZ_KEYWORD] # current name of keyword number parnum +int odtype # data type of current keyword number parnum +double dval # for reformatting str, if too long +int i # loop index +int lenval # number of char in value string +int status # zero is OK +bool iscomm # true if keyword is history or comment +int ip, ctod() +int strlen() +bool streq() +bool tbhisc() +errchk tbferr + +begin + call smark (sp) + call salloc (rec, SZ_LINE, TY_CHAR) + call salloc (strval, SZ_LINE, TY_CHAR) + call salloc (oldrec, SZ_LINE, TY_CHAR) + + # Copy the keyword to scratch and convert to upper case. + call strcpy (keyword, ukkey, SZ_KEYWORD) + call strupr (ukkey) + + # Copy str to scratch, deleting leading and trailing whitespace. + + # Skip leading blanks in scr. + i = 1 + while (IS_WHITE(str[i])) + i = i + 1 + + call strcpy (str[i], Memc[strval], SZ_LINE) + + # Delete trailing blanks in strval. + i = strlen (Memc[strval]) + while (IS_WHITE(Memc[strval+i-1]) && i > 0) { + Memc[strval+i-1] = EOS + i = i - 1 + } + lenval = i # number of char in value string + + iscomm = tbhisc (keyword) # is the keyword history or comment? + + # The format depends on the data type. + if (dtype == TY_CHAR) { + + if (iscomm) { + # No quotes for history or comment. + call sprintf (Memc[rec], SZ_LINE, "%-8s %s") + call pargstr (ukkey) + call pargstr (Memc[strval]) + } else if (lenval < 8) { + call sprintf (Memc[rec], SZ_LINE, "%-8s= '%-8s' / ") + call pargstr (ukkey) + call pargstr (Memc[strval]) + } else if (lenval < 18) { + call sprintf (Memc[rec], SZ_LINE, "%-8s= '%-s'%31t / ") + call pargstr (ukkey) + call pargstr (Memc[strval]) + } else { + call sprintf (Memc[rec], SZ_LINE, "%-8s= '%s' / ") + call pargstr (ukkey) + call pargstr (Memc[strval]) + } + + } else if (dtype == TY_BOOL) { + + call strlwr (Memc[strval]) + if (streq (Memc[strval], "yes") || streq (Memc[strval], "y") || + streq (Memc[strval], "true") || streq (Memc[strval], "t") || + streq (Memc[strval], "1")) { + call sprintf (Memc[rec], SZ_LINE, + "%-8s= T / ") + call pargstr (ukkey) + } else { + call sprintf (Memc[rec], SZ_LINE, + "%-8s= F / ") + call pargstr (ukkey) + } + + } else { + + if (lenval <= 20) { + call sprintf (Memc[rec], SZ_LINE, "%-8s= %20s / ") + call pargstr (ukkey) + call pargstr (Memc[strval]) + } else { + # Value is too long. Reformat it. + ip = 1 + if (ctod (Memc[strval], ip, dval) < 1) + dval = 0.d0 + call sprintf (Memc[rec], SZ_LINE, "%-8s= %20g / ") + call pargstr (ukkey) + call pargd (dval) + } + } + + # If the old record contains a comment, concatenate it to the + # parameter record. Ignore if keyword is history or comment. + if (!iscomm) { + # Read the current value to see if the keywords are the same, + # and if so, to get the comment. + call salloc (cmt, SZ_LINE, TY_CHAR) + call tbfgnp (tp, parnum, oldkey, odtype, + Memc[oldrec], Memc[cmt], SZ_LINE) + if (streq (ukkey, oldkey)) { + if (Memc[cmt] != EOS) + call strcat (Memc[cmt], Memc[rec], SZ_LINE) + } + } + + status = 0 + + # Clobber the Nth header record. + call fsmrec (TB_FILE(tp), parnum, Memc[rec], status) + + if (status != 0) + call tbferr (status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfpri.x b/pkg/tbtables/tbfpri.x new file mode 100644 index 00000000..9e931a10 --- /dev/null +++ b/pkg/tbtables/tbfpri.x @@ -0,0 +1,181 @@ +include +include "tblerr.h" + +# tbfpri -- copy primary header +# This routine may copy the primary header of an input FITS file to +# an output FITS file. The input header will only be copied under the +# following circumstances: +# +# The output file does not already exist. +# The intable and outtable file names imply they are FITS files +# (i.e. the filename extensions are ".fits", ".fit", or "%%f"). +# The primary header/data unit of the input file has a null data +# portion (i.e. NAXIS = 0). +# +# If the input primary header was in fact copied, creating the output +# file, copied will be set to YES; otherwise, copied will be NO. +# +# Phil Hodge, 18-Jan-1999 Subroutine created. +# Phil Hodge, 8-Apr-1999 Call vfn_expand_ldir to get host OS file names. +# Phil Hodge, 12-Apr-1999 Call tbttyp to get file type; +# remove table type from calling sequence of tbparse. +# Phil Hodge, 1-Jun-1999 Declare ifd & ofd as two-element arrays. + +procedure tbfpri (intable, outtable, copied) + +char intable[ARB] # i: name of FITS file to be copied +char outtable[ARB] # i: name of new FITS file +int copied # o: YES if input header was copied to output +#-- +pointer sp +pointer ifname, ofname # input & output file names +pointer os_infile, os_outfile # host operating system file names +pointer fname, extn # for discarding directory from output file name +pointer dummy # misc ignored strings +pointer intbl, cnv, url +int ifd[2] # C pointer for input (template) FITS file +int ofd[2] # C pointer for output FITS file +# These variables and equivalence statements are used to force 8-byte +# alignment of ifd and ofd. +#double d_ifd, d_ofd +#equivalence (ifd, d_ifd) +#equivalence (ofd, d_ofd) +int naxis # NAXIS from primary header of input +int status # zero is OK +int itype, otype # file type based on filename extension +int hdu # HDU number (ignored) +int exists # YES if the file exists +int blocksize +int nchar +int morekeys # extra space (none) in primary header +int fnroot(), fnextn(), tbparse(), tbttyp(), vot_to_fits() +int access(), strncmp() +bool is_votable() +errchk tbferr, tbparse, tbttyp, vfn_expand_ldir + +begin + call smark (sp) + call salloc (ifname, SZ_FNAME, TY_CHAR) + call salloc (ofname, SZ_FNAME, TY_CHAR) + call salloc (intbl, SZ_PATHNAME, TY_CHAR) + call salloc (cnv, SZ_PATHNAME, TY_CHAR) + call salloc (url, SZ_PATHNAME, TY_CHAR) + call salloc (dummy, SZ_FNAME, TY_CHAR) + call salloc (os_infile, SZ_FNAME, TY_CHAR) + call salloc (os_outfile, SZ_FNAME, TY_CHAR) + + # Get name of output file; i.e. strip off any extension name or + # number, row & column selectors. + nchar = tbparse (outtable, Memc[ofname], Memc[dummy], SZ_FNAME, hdu) + + # Get file type, and check whether output file already exists. + otype = tbttyp (Memc[ofname], exists) + + # Convert from iraf virtual file name to actual file name. + call vfn_expand_ldir (Memc[ofname], Memc[os_outfile], SZ_FNAME) + + if (exists == YES || otype != TBL_TYPE_FITS) { + copied = NO + call sfree (sp) + return + } + + + # Check if we're opening a URL, and whether it is already cached. + call aclrc (Memc[cnv], SZ_PATHNAME) + call aclrc (Memc[intbl], SZ_PATHNAME) + if (strncmp ("http:", intable, 5) == 0) { + call strcpy (intable, Memc[url], SZ_PATHNAME) + call fcname ("cache$", Memc[url], "f", Memc[intbl], SZ_PATHNAME) + call strcpy (Memc[intbl], Memc[cnv], SZ_PATHNAME) + call strcat (".fits", Memc[cnv], SZ_PATHNAME) + + if (access (Memc[cnv], 0, 0) == NO) { + call fcadd ("cache$", Memc[url], "", Memc[intbl], SZ_PATHNAME) + if (access (Memc[cnv],0,0) == YES && is_votable (Memc[cnv])) { + if (vot_to_fits (Memc[intbl], Memc[intbl]) != OK) { + call error (ER_TBCONVERT, + "tbtopn: cannot convert table format") + } + } + } else + call strcpy (Memc[cnv], Memc[intbl], SZ_PATHNAME) + } else + call strcpy (intable, Memc[intbl], SZ_PATHNAME) + + + # Get name of input file, and get file type. + nchar = tbparse (Memc[intbl], Memc[ifname], Memc[dummy], SZ_FNAME, hdu) + call vfn_expand_ldir (Memc[ifname], Memc[os_infile], SZ_FNAME) + + itype = tbttyp (Memc[ifname], exists) # exists for input is ignored + + # Only relevant for FITS tables. + if (itype != TBL_TYPE_FITS) { + copied = NO + call sfree (sp) + return + } + + status = 0 + ifd[2] = 0 # not needed for four-byte C pointers + ofd[2] = 0 + + # Get a unit number for the input file, and open the file. + call fsgiou (ifd, status) + blocksize = 2880 + call fsopen (ifd, Memc[os_infile], 0, blocksize, status) + if (status != 0) { + call fsfiou (ifd, status) + call tbferr (status) + } + + # Check whether the primary header/data unit contains a data portion. + # We'll only copy the primary header if there's no data. + + call fsgkyj (ifd, "NAXIS", naxis, Memc[dummy], status) + if (status != 0) + call tbferr (status) + + if (naxis == 0) { # no data portion + + # Open the output file. + call fsgiou (ofd, status) + call fsinit (ofd, Memc[os_outfile], blocksize, status) + if (status != 0) + call tbferr (status) + + # Copy the primary header. + morekeys = 0 + call fscopy (ifd, ofd, morekeys, status) + if (status != 0) + call tbferr (status) + + # Extract root and extension (discarding directory). + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (extn, SZ_FNAME, TY_CHAR) + nchar = fnroot (Memc[os_outfile], Memc[fname], SZ_FNAME) + nchar = fnextn (Memc[os_outfile], Memc[extn], SZ_FNAME) + call strcat (".", Memc[fname], SZ_FNAME) + call strcat (Memc[extn], Memc[fname], SZ_FNAME) + call fsukys (ofd, "FILENAME", Memc[fname], "name of file", status) + if (status != 0) + call tbferr (status) + + call fsclos (ofd, status) + call fsfiou (ofd, status) + + copied = YES + + } else { + + # Input header will not be copied because the primary HDU + # does contain a data portion. + copied = NO + } + + call fsclos (ifd, status) + call fsfiou (ifd, status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfptf.x b/pkg/tbtables/tbfptf.x new file mode 100644 index 00000000..b4be451d --- /dev/null +++ b/pkg/tbtables/tbfptf.x @@ -0,0 +1,95 @@ +# tbfptf -- change format from SPP to Fortran +# This is similar to tbbptf except that the output should be legal Fortran. +# The input and output may be the same string. +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfptf (sppfmt, ftnfmt, maxch) + +char sppfmt[ARB] # i: print format in SPP style +char ftnfmt[ARB] # o: print format in Fortran style +int maxch # i: max size of ftnfmt +#-- +pointer sp +pointer fmt # scratch for Fortran format +pointer numpart # copy of numerical portion of print format +char sppcode # SPP format code +char fcode # Fortran format code +int fmtlen # length of string sppfmt +int index # position of character in format string +int w, d # as in w.d +int ip, ctoi() + +string sppchr "fgdeHhMmbsxo" +string ftnchr "FGIEFFFFLAZO" + +int strlen(), stridx() + +begin + call smark (sp) + call salloc (fmt, SZ_FNAME, TY_CHAR) + call salloc (numpart, SZ_FNAME, TY_CHAR) + + fmtlen = strlen (sppfmt) + + # Copy numerical portion to numpart. Ignore any minus sign (which + # means left justify the value). + if (sppfmt[2] == '-') + call strcpy (sppfmt[3], Memc[numpart], fmtlen-3) + else + call strcpy (sppfmt[2], Memc[numpart], fmtlen-2) + + # Get fortran format code corresponding to spp format code. + sppcode = sppfmt[fmtlen] + index = stridx (sppcode, sppchr) + if (index == 0) { + call sprintf (Memc[fmt], SZ_FNAME, "bad print format `%s'") + call pargstr (sppfmt) + call error (1, Memc[fmt]) + } else { + fcode = ftnchr[index] + } + + # Extract numerical parts (w.d). + ip = 1 + if (ctoi (Memc[numpart], ip, w) < 0) + w = 0 + if (Memc[numpart+ip-1] == '.') { + ip = ip + 1 + if (ctoi (Memc[numpart], ip, d) < 0) + d = 0 + } + + # Construct Fortran format. + if (sppfmt[fmtlen] == 'H' || sppfmt[fmtlen] == 'h') { + # Use F format instead of H.MSd, so increase w and d. + w = w + 4 + d = d + 4 + call sprintf (Memc[fmt], SZ_FNAME, "%c%d.%d") # e.g. F12.5 + call pargc (fcode) + call pargi (w) + call pargi (d) + } else if (sppfmt[fmtlen] == 'M' || sppfmt[fmtlen] == 'm') { + w = w + 2 + d = d + 2 + call sprintf (Memc[fmt], SZ_FNAME, "%c%d.%d") + call pargc (fcode) + call pargi (w) + call pargi (d) + } else if (Memc[numpart] == '0' && + (sppcode == 'd' || sppcode == 'o' || sppcode == 'x')) { + call sprintf (Memc[fmt], SZ_FNAME, "%c%d.%d") # e.g. I4.4 + call pargc (fcode) + call pargi (w) + call pargi (w) + } else { + # Append numerical portion from SPP format without modification. + Memc[fmt] = fcode + Memc[fmt+1] = EOS + call strcat (Memc[numpart], Memc[fmt], SZ_FNAME) + } + + call strcpy (Memc[fmt], ftnfmt, maxch) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfrcd.x b/pkg/tbtables/tbfrcd.x new file mode 100644 index 00000000..894dbc19 --- /dev/null +++ b/pkg/tbtables/tbfrcd.x @@ -0,0 +1,262 @@ +include +include "tbtables.h" +include "tblfits.h" + +# tbfrcd -- read all column descriptors +# For a FITS table, this routine reads the information describing all +# columns, and it assigns values to the column descriptors. Memory +# for the column descriptors is assumed to already have been allocated. +# (This is called by tbuopn.) +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 14-Apr-1998 Use strcpy instead of strpak or tbcftp for +# column name, units, and print format. +# Phil Hodge, 7-Jun-1999 Use TB_SUBTYPE instead of TB_HDUTYPE. +# Phil Hodge, 5-Aug-1999 Rewrite so that it reads all column info +# in one call, not just the info for a single column; +# in tbfcd3, assign COL_NELEM. +# Phil Hodge, 23-Jun-2000 The first character of TSCALi & TZEROi was being +# truncated. Assign values to COL_TDTYPE, COL_TSCAL, COL_TZERO; +# change default values of tscal & tzero to 1. & 0. respectively. + +procedure tbfrcd (tp, cp, ncols) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: pointers to column descriptors +int ncols # i: number of columns in cp array +#-- +pointer sp +pointer ttype # scratch for column name +pointer tform # scratch for column format +pointer tunit # scratch for column unit +pointer tdisp # scratch for display format +pointer tscal, tzero # parameters for scaling from integer to floating +errchk tbfcd1, tbfcd2, tbfcd3 + +begin + if (ncols < 1) + return + + call smark (sp) + call salloc (ttype, (SZ_FTTYPE+1)*ncols, TY_CHAR) + call salloc (tform, (SZ_FTFORM+1)*ncols, TY_CHAR) + call salloc (tunit, (SZ_FTUNIT+1)*ncols, TY_CHAR) + call salloc (tdisp, (SZ_FTTYPE+1)*ncols, TY_CHAR) + call salloc (tscal, ncols, TY_DOUBLE) + call salloc (tzero, ncols, TY_DOUBLE) + + # Initialize these arrays to null or indef. + call tbfcd1 (Memc[ttype], Memc[tform], Memc[tunit], Memc[tdisp], + Memd[tscal], Memd[tzero], ncols) + + # Read each keyword in the header, and assign values to these + # arrays as keywords are found. + call tbfcd2 (tp, + Memc[ttype], Memc[tform], Memc[tunit], Memc[tdisp], + Memd[tscal], Memd[tzero], ncols) + + # Loop over columns, interpret info from these arrays, and + # assign to column descriptors. + call tbfcd3 (tp, cp, + Memc[ttype], Memc[tform], Memc[tunit], Memc[tdisp], + Memd[tscal], Memd[tzero], ncols) + + call sfree (sp) +end + +# This routine initializes the array values to null or INDEFD. + +procedure tbfcd1 (ttype, tform, tunit, tdisp, + tscal, tzero, ncols) + +char ttype[SZ_FTTYPE,ncols] # o: will be initialized to null +char tform[SZ_FTFORM,ncols] # o: will be initialized to null +char tunit[SZ_FTUNIT,ncols] # o: will be initialized to null +char tdisp[SZ_FTTYPE,ncols] # o: will be initialized to null +double tscal[ncols] # o: will be initialized to 1. +double tzero[ncols] # o: will be initialized to 0. +int ncols # i: size of arrays +#-- +int col + +begin + do col = 1, ncols { + ttype[1,col] = EOS + tform[1,col] = EOS + tunit[1,col] = EOS + tdisp[1,col] = EOS + tscal[col] = 1.d0 + tzero[col] = 0.d0 + } +end + +# This routine reads each header record, checks whether the keyword is one +# of the those that define a column, and if so, extracts the information +# to the appropriate output array. + +procedure tbfcd2 (tp, + ttype, tform, tunit, tdisp, + tscal, tzero, ncols) + +pointer tp # i: pointer to table descriptor +char ttype[SZ_FTTYPE,ncols] # o: will be assigned if keyword found +char tform[SZ_FTFORM,ncols] # o: will be assigned if keyword found +char tunit[SZ_FTUNIT,ncols] # o: will be assigned if keyword found +char tdisp[SZ_FTTYPE,ncols] # o: will be assigned if keyword found +double tscal[ncols] # o: will be assigned if keyword found +double tzero[ncols] # o: will be assigned if keyword found +int ncols # i: size of arrays +#-- +pointer sp +pointer buf # scratch for header record +pointer value # scratch for keyword value +pointer comment # scratch for comment for keyword +double x # tscal or tzero +int parnum # loop index for keyword number +int col # column number, read from keyword name +int ip, ctoi(), ctod() +int strncmp(), strlen() +int status # = 0 is OK +errchk tbferr + +begin + status = 0 + + call smark (sp) + call salloc (buf, SZ_FNAME, TY_CHAR) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (comment, SZ_FNAME, TY_CHAR) + + # Read each keyword in the header. + do parnum = 1, TB_NPAR(tp) { + + # Read the record as a string. + call fsgrec (TB_FILE(tp), parnum, Memc[buf], status) + if (status != 0) + call tbferr (status) + + if (Memc[buf] != 'T') + next + + ip = 6 # first character of the column number + if (ctoi (Memc[buf], ip, col) < 1) + next + + # Reject keywords such as "TTYPE5X". + if (Memc[buf+ip-1] != ' ' && Memc[buf+ip-1] != '=') + next + + # Extract the value. + call fspsvc (Memc[buf], Memc[value], Memc[comment], status) + if (status != 0) + call tbferr (status) + + # Trim trailing and leading blanks and single quotes. + ip = strlen (Memc[value]) - 1 # zero indexed + while (Memc[value+ip] == ' ' || Memc[value+ip] == '\'') { + Memc[value+ip] = EOS + ip = ip - 1 + } + ip = 0 + while (Memc[value+ip] == ' ' || Memc[value+ip] == '\'') + ip = ip + 1 + + # Check to see whether this is one of the keywords that we need, + # and if so, copy the value to the output array. + if (strncmp (Memc[buf], "TTYPE", 5) == 0) { + call strcpy (Memc[value+ip], ttype[1,col], SZ_FTTYPE) + + } else if (strncmp (Memc[buf], "TFORM", 5) == 0) { + call strcpy (Memc[value+ip], tform[1,col], SZ_FTFORM) + + } else if (strncmp (Memc[buf], "TUNIT", 5) == 0) { + call strcpy (Memc[value+ip], tunit[1,col], SZ_FTUNIT) + + } else if (strncmp (Memc[buf], "TDISP", 5) == 0) { + call strcpy (Memc[value+ip], tdisp[1,col], SZ_FTTYPE) + + } else if (strncmp (Memc[buf], "TSCAL", 5) == 0) { + ip = 1 + if (ctod (Memc[value], ip, x) < 1) + call error (1, "can't interpret TSCAL keyword") + tscal[col] = x + + } else if (strncmp (Memc[buf], "TZERO", 5) == 0) { + ip = 1 + if (ctod (Memc[value], ip, x) < 1) + call error (1, "can't interpret TZERO keyword") + tzero[col] = x + } + } + + call sfree (sp) +end + +# This routine interprets the contents of the ttype, etc, arrays +# and assigns values to the column descriptors. + +procedure tbfcd3 (tp, cp, + ttype, tform, tunit, tdisp, + tscal, tzero, ncols) + +pointer tp # i: pointer to table descriptor +pointer cp[ncols] # i: pointers to column descriptors +char ttype[SZ_FTTYPE,ncols] # i: array of column names +char tform[SZ_FTFORM,ncols] # i: array that defines data types +char tunit[SZ_FTUNIT,ncols] # i: array of column units +char tdisp[SZ_FTTYPE,ncols] # i: array of print formats +double tscal[ncols] # i: array of tscal values +double tzero[ncols] # i: array of tzero values +int ncols # i: size of arrays +#-- +char pform[SZ_COLFMT] # print format for column +int col # loop index for column number +errchk tbftya, tbftyb + +begin + do col = 1, ncols { + + # If there's no column name, assign a default. + if (ttype[1,col] == EOS) { + call sprintf (ttype[1,col], SZ_FTTYPE, "c%d") + call pargi (col) + } + + if (tform[1,col] == EOS) + call error (1, "TFORM not specified; this keyword is required") + + # Determine the data type, print format and array length. + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) { + + call tbftya (tform[1,col], tdisp[1,col], + tscal[col], tzero[col], + COL_TDTYPE(cp[col]), COL_DTYPE(cp[col]), + pform, SZ_COLFMT, COL_LEN(cp[col])) + COL_NELEM(cp[col]) = 1 # does not support arrays + + } else if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE) { + + call tbftyb (tform[1,col], tdisp[1,col], + tscal[col], tzero[col], + COL_TDTYPE(cp[col]), COL_DTYPE(cp[col]), + pform, SZ_COLFMT, + COL_NELEM(cp[col]), COL_LEN(cp[col])) + + } else { + + call error (1, "tbfrcd: invalid HDU type") + } + + # Assign values to column descriptor. + + COL_NUMBER(cp[col]) = col + COL_OFFSET(cp[col]) = 0 # meaningless + + COL_TSCAL(cp[col]) = tscal[col] + COL_TZERO(cp[col]) = tzero[col] + + call strcpy (ttype[1,col], COL_NAME(cp[col]), SZ_COLNAME) + call strcpy (tunit[1,col], COL_UNITS(cp[col]), SZ_COLUNITS) + call strcpy (pform, COL_FMT(cp[col]), SZ_COLFMT) + } +end diff --git a/pkg/tbtables/tbfres.x b/pkg/tbtables/tbfres.x new file mode 100644 index 00000000..d626457d --- /dev/null +++ b/pkg/tbtables/tbfres.x @@ -0,0 +1,58 @@ +include + +# tbfres -- is the keyword a FITS reserved keyword? +# If the input keyword is "NAXIS", "TTYPEn", etc, this routine returns YES; +# otherwise NO is returned. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 13-Nov-1995 Change type from bool to int. + +int procedure tbfres (keyword) + +char keyword[ARB] # i: name of parameter +#-- +char uckey[SZ_KEYWORD] # keyword converted to upper case +int strncmp() +bool streq() + +begin + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + + if (streq (uckey, "XTENSION")) + return (YES) + else if (streq (uckey, "BITPIX")) + return (YES) + else if (strncmp (uckey, "NAXIS", 5) == 0) + return (YES) + else if (streq (uckey, "PCOUNT")) + return (YES) + else if (streq (uckey, "GCOUNT")) + return (YES) + else if (streq (uckey, "TFIELDS")) + return (YES) + else if (streq (uckey, "END")) + return (YES) + else if (strncmp (uckey, "TBCOL", 5) == 0) + return (YES) + else if (strncmp (uckey, "TFORM", 5) == 0) + return (YES) + else if (strncmp (uckey, "TTYPE", 5) == 0) + return (YES) + else if (strncmp (uckey, "TUNIT", 5) == 0) + return (YES) + else if (strncmp (uckey, "TSCAL", 5) == 0) + return (YES) + else if (strncmp (uckey, "TZERO", 5) == 0) + return (YES) + else if (strncmp (uckey, "TNULL", 5) == 0) + return (YES) + else if (strncmp (uckey, "TDISP", 5) == 0) + return (YES) + else if (strncmp (uckey, "TDIM", 4) == 0) + return (YES) + else if (streq (uckey, "THEAP")) + return (YES) + + return (NO) +end diff --git a/pkg/tbtables/tbfrsi.x b/pkg/tbtables/tbfrsi.x new file mode 100644 index 00000000..8137d633 --- /dev/null +++ b/pkg/tbtables/tbfrsi.x @@ -0,0 +1,70 @@ +include # for SZB_CHAR +include +include "tbtables.h" + +# tbfrsi -- read size info +# This routine reads NAXIS2 (number of rows) and TFIELDS (number of columns) +# from a FITS file and saves the values in the table descriptor. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 2-Feb-1996 Check whether current HDU is a table. +# Phil Hodge, 7-Jun-1999 Use TB_SUBTYPE instead of TB_HDUTYPE. +# Phil Hodge, 29-Mar-2001 Assign NAXIS1 / 2 to TB_ROWLEN and TB_COLUSED. + +procedure tbfrsi (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer sp +pointer comment # comment from FITS file +int status # used for fitsio +int keysexist # number of header keywords +int keysadd # space available for new header keywords +int naxis1 # row length in bytes +errchk tbferr + +begin + status = 0 + + call smark (sp) + call salloc (comment, SZ_LINE, TY_CHAR) + + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE || + TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) { + + call fsgkyj (TB_FILE(tp), "NAXIS1", + naxis1, Memc[comment], status) + if (status != 0) + call tbferr (status) + + call fsgkyj (TB_FILE(tp), "NAXIS2", + TB_NROWS(tp), Memc[comment], status) + if (status != 0) + call tbferr (status) + + call fsgkyj (TB_FILE(tp), "TFIELDS", + TB_NCOLS(tp), Memc[comment], status) + if (status != 0) + call tbferr (status) + + } else { + + # The current extension (or primary HDU) is not a table. + naxis1 = 0 + TB_NROWS(tp) = 0 + TB_NCOLS(tp) = 0 + } + + call fsghsp (TB_FILE(tp), keysexist, keysadd, status) + if (status != 0) + call tbferr (status) + + TB_ROWLEN(tp) = (naxis1 + SZB_CHAR-1) / SZB_CHAR + TB_COLUSED(tp) = TB_ROWLEN(tp) + TB_MAXCOLS(tp) = TB_NCOLS(tp) + TB_NPAR(tp) = keysexist + TB_MAXPAR(tp) = keysexist + keysadd + TB_BOD(tp) = 0 + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfscal.x b/pkg/tbtables/tbfscal.x new file mode 100644 index 00000000..62724671 --- /dev/null +++ b/pkg/tbtables/tbfscal.x @@ -0,0 +1,47 @@ +include "tbtables.h" + +# This routine adds (or updates) the TSCALi and TZEROi keywords, +# if they differ from the default values of 1 and 0 respectively. +# +# Phil Hodge, 23-Jun-2000 Subroutine created. + +procedure tbfscal (tp, cp) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +#-- +pointer sp +pointer keyword # for keyword name +int i # column number +int status + +begin + call smark (sp) + call salloc (keyword, SZ_FNAME, TY_CHAR) + + i = COL_NUMBER(cp) + status = 0 # initial value + + if (COL_TSCAL(cp) != 1.d0) { + call sprintf (Memc[keyword], SZ_FNAME, "TSCAL%d") + call pargi (i) + call fsukyd (TB_FILE(tp), Memc[keyword], + COL_TSCAL(cp), 14, "scale factor for column", status) + if (status != 0) + call tbferr (status) + } + + if (COL_TZERO(cp) != 0.d0) { + call sprintf (Memc[keyword], SZ_FNAME, "TZERO%d") + call pargi (i) + call fsukyd (TB_FILE(tp), Memc[keyword], + COL_TZERO(cp), 14, "zero offset for column", status) + if (status != 0) + call tbferr (status) + } + + # Make sure the fitsio interface knows about these keywords. + call fsrdef (TB_FILE(tp), status) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfsft.x b/pkg/tbtables/tbfsft.x new file mode 100644 index 00000000..9709251e --- /dev/null +++ b/pkg/tbtables/tbfsft.x @@ -0,0 +1,84 @@ +include "tbtables.h" + +# tbfsft -- shift rows in a FITS table +# Shift one or more rows down (to leave a gap in the table) or up (to +# delete rows). The range of rows that is shifted is from FIRST to +# the last row in the table. Shift down if SHIFT > 0, or shift up if +# SHIFT < 0. SHIFT is the number of rows by which to shift. +# +# Rows that are exposed by the shift are NOT set to indef. The total +# number of rows TB_NROWS(tp) will be reduced if SHIFT < 0, and it will +# be increased if SHIFT > 0. +# +# NOTE: This routine must not be used if a row selector is in effect. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 6-Mar-1998 Error check tbferr instead of tbfnll. + +procedure tbfsft (tp, first, shift) + +pointer tp # i: pointer to table descriptor +int first # i: first row to be moved +int shift # i: shift by this many rows +#-- +int abs_shift # absolute value of shift +int row1 # first row of a range to be copied +int nrows # number of rows written to table +int j, k # loop indexes +int status +errchk tbrcpy, tbferr + +begin + nrows = TB_NROWS(tp) + abs_shift = abs (shift) + + if (first > nrows) + return + + if (shift < 0) { + + # Shift to smaller rows, overwriting rows starting with FIRST. + k = first + do j = first + abs_shift, nrows { + call tbrcpy (tp, tp, j, k) # copy row j to row k + k = k + 1 + } + # Delete rows at end. + status = 0 + call fsdrow (TB_FILE(tp), nrows-abs_shift+1, abs_shift, status) + if (status > 0) + call tbferr (status) + + # Change the value of TB_NROWS. + TB_NROWS(tp) = max (0, nrows - abs_shift) + + } else { # shift down + + row1 = nrows - shift + 1 + + if (row1 >= first) { + + # First copy the block of rows that are to be put beyond + # the current EOF; with each call in this loop we are + # writing the next row beyond EOF. + k = nrows + 1 + do j = row1, nrows { + call tbrcpy (tp, tp, j, k) + k = k + 1 + } + + k = nrows + do j = nrows - shift, first, -1 { + call tbrcpy (tp, tp, j, k) + k = k - 1 + } + } else { + # The entire block is to be shifted beyond current EOF. + k = first + shift + do j = first, nrows { + call tbrcpy (tp, tp, j, k) + k = k + 1 + } + } + } +end diff --git a/pkg/tbtables/tbfsiz.x b/pkg/tbtables/tbfsiz.x new file mode 100644 index 00000000..d9c77101 --- /dev/null +++ b/pkg/tbtables/tbfsiz.x @@ -0,0 +1,50 @@ +include # for SZB_CHAR +include "tbtables.h" + +# tbfsiz -- get FITSIO buffer size +# This function returns the buffer size (SPP char) that CFITSIO has +# available for the current table. +# +# The buffer size is 25*2880 bytes (currently) if only one table is open +# (see NIOBUF and IOBUFLEN in fitsio2.h). +# See the CFITSIO documentation for further information. +# +# Phil Hodge, 25-May-2000 Function created. + +int procedure tbfsiz (tp) + +pointer tp # i: pointer to table struct +#-- +pointer sp +pointer comment # ignored +int rowlen # length of row (NAXIS1), then convert to char +int maxrows # max number of rows that fit in cfitsio buffers +int status +int bufsize # the function value, the buffer size +errchk tbferr + +begin + call smark (sp) + call salloc (comment, SZ_FNAME, TY_CHAR) + + # Get the row length in bytes. + call fsgkyj (TB_FILE(tp), "NAXIS1", + rowlen, Memc[comment], status) + if (status != 0) + call tbferr (status) + call sfree (sp) + + rowlen = rowlen / SZB_CHAR # convert bytes to char + + status = 0 + call fsgrsz (TB_FILE(tp), maxrows, status) + if (status != 0) + call tbferr (status) + + if (rowlen > 1) + bufsize = rowlen * maxrows + else + bufsize = maxrows + + return (bufsize) +end diff --git a/pkg/tbtables/tbftya.x b/pkg/tbtables/tbftya.x new file mode 100644 index 00000000..7dc458be --- /dev/null +++ b/pkg/tbtables/tbftya.x @@ -0,0 +1,94 @@ +include # for SZB_CHAR +include "tbtables.h" + +# tbftya -- determine data type from tform +# This is for an ascii table; use tbftyb for a binary table. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 23-Jun-2000 Add tdtype to calling sequence; compare tscal & +# tzero with 1. & 0. instead of INDEFD to see if they're defined. + +procedure tbftya (tform, tdisp, tscal, tzero, + tdtype, dtype, pformat, maxch, len) + +char tform[ARB] # i: TFORM from FITS file +char tdisp[ARB] # i: TDISP from FITS file +double tscal, tzero # i: scaling parameters, or 1 & 0 if not defined +int tdtype # o: true data type in FITS table (e.g. integer) +int dtype # o: data type to use for table interface +char pformat[maxch] # o: spp print format +int maxch # i: size of print format string +int len # o: size of element +#-- +pointer sp +pointer tform_lc # tform in lower case +pointer spp_fmt # format (tdisp or tform) converted to spp +pointer errmess # scratch for error message +int temp # string length; value returned by tbbadf and ignored +int lenfmt # width of print format +int ip, ctoi() + +begin + call smark (sp) + call salloc (tform_lc, SZ_FNAME, TY_CHAR) + call salloc (spp_fmt, SZ_FNAME, TY_CHAR) + + call strcpy (tform, Memc[tform_lc], SZ_FNAME) + call strlwr (Memc[tform_lc]) + + if (Memc[tform_lc] == 'a') { # character + ip = 2 + if (ctoi (Memc[tform_lc], ip, temp) < 1) + dtype = -1 + else + dtype = -temp + len = (temp + SZB_CHAR-1) / SZB_CHAR * SZ_CHAR + } else if (Memc[tform_lc] == 'd') { # double precision + dtype = TBL_TY_DOUBLE + len = SZ_DOUBLE + } else if (Memc[tform_lc] == 'e') { # single precision + dtype = TBL_TY_REAL + len = SZ_REAL + } else if (Memc[tform_lc] == 'f') { # single precision + dtype = TBL_TY_REAL + len = SZ_REAL + } else if (Memc[tform_lc] == 'i') { # 32-bit integer + dtype = TBL_TY_INT + len = SZ_INT32 + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "unrecognized TFORM: `%s'") + call pargstr (tform) + call error (1, Memc[errmess]) + } + + # Convert print format from Fortran to SPP. + if (tdisp[1] == EOS) + call tbbftp (tform, pformat) + else + call tbbftp (tdisp, pformat) + + tdtype = dtype + + # If either scaling parameter is defined, promote the data type + # from integer to floating point. Note that only dtype is modified; + # tdtype is the actual data type of the data in the FITS table. + if (tscal != 1.d0 || tzero != 0.d0) { + if (dtype == TBL_TY_INT) { + ip = 2 + if (ctoi (pformat, ip, lenfmt) < 1) { + dtype = TBL_TY_DOUBLE + len = SZ_DOUBLE + } else if (lenfmt <= 7) { # 6 digits plus sign or decimal + dtype = TBL_TY_REAL + len = SZ_REAL + } else { + dtype = TBL_TY_DOUBLE + len = SZ_DOUBLE + } + } + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbftyb.x b/pkg/tbtables/tbftyb.x new file mode 100644 index 00000000..011087ff --- /dev/null +++ b/pkg/tbtables/tbftyb.x @@ -0,0 +1,116 @@ +include # for SZB_CHAR +include "tbtables.h" + +# tbftyb -- determine data type from tform +# This is for a binary table; use tbftya for an ascii table. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 23-Jun-2000 Add tdtype to calling sequence; compare tscal & +# tzero with 1. & 0. instead of INDEFD to see if they're defined. + +procedure tbftyb (tform, tdisp, tscal, tzero, + tdtype, dtype, pformat, maxch, nelem, len) + +char tform[ARB] # i: TFORM from FITS file +char tdisp[ARB] # i: TDISP from FITS file +double tscal, tzero # i: scaling parameters, or 1 & 0 if not defined +int tdtype # o: true data type in FITS table (e.g. integer) +int dtype # o: data type to use for table interface +char pformat[maxch] # o: spp print format +int maxch # i: size of print format string +int nelem # o: number of elements in array +int len # o: nelem * size of one element +#-- +pointer sp +pointer tform_lc # tform in lower case +pointer errmess # scratch for error message +int rpt # repeat count +int lenstring # size of string +int ip, ctoi() + +begin + call smark (sp) + call salloc (tform_lc, SZ_FNAME, TY_CHAR) + + call strcpy (tform, Memc[tform_lc], SZ_FNAME) + call strlwr (Memc[tform_lc]) + + # Assign a default; this is only used for char string. + lenstring = 1 + + # Read repeat count. + ip = 1 + if (ctoi (Memc[tform_lc], ip, rpt) < 1) + rpt = 1 + + nelem = rpt + + if (Memc[tform_lc+ip-1] == 'a') { # character + # Single element has tform wA, but FITSIO supports rAw as well. + ip = ip + 1 # skip past 'a' and check for a number + if (ctoi (Memc[tform_lc], ip, lenstring) < 1) + lenstring = rpt + dtype = -lenstring + nelem = rpt / lenstring + len = (lenstring + SZB_CHAR-1) / SZB_CHAR * SZ_CHAR + len = nelem * len + } else if (Memc[tform_lc+ip-1] == 'b') { # unsigned byte + dtype = TBL_TY_SHORT + len = nelem * SZ_SHORT + } else if (Memc[tform_lc+ip-1] == 'c') { # complex; use double + dtype = TBL_TY_DOUBLE + len = nelem * SZ_DOUBLE + } else if (Memc[tform_lc+ip-1] == 'd') { # double precision + dtype = TBL_TY_DOUBLE + len = nelem * SZ_DOUBLE + } else if (Memc[tform_lc+ip-1] == 'e') { # single precision + dtype = TBL_TY_REAL + len = nelem * SZ_REAL + } else if (Memc[tform_lc+ip-1] == 'i') { # 16-bit integer + dtype = TBL_TY_SHORT + len = nelem * SZ_SHORT + } else if (Memc[tform_lc+ip-1] == 'j') { # 32-bit integer + dtype = TBL_TY_INT + len = nelem * SZ_INT32 + } else if (Memc[tform_lc+ip-1] == 'l') { # logical + dtype = TBL_TY_BOOL + len = nelem * SZ_BOOL + } else if (Memc[tform_lc+ip-1] == 'm') { # complex double prec + call error (1, "can't handle complex double precision") + } else if (Memc[tform_lc+ip-1] == 'p') { # variable length +# call error (1, "can't handle variable length arrays") + ; + } else if (Memc[tform_lc+ip-1] == 'x') { # bit + dtype = TBL_TY_SHORT + len = nelem * SZ_SHORT + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "unrecognized TFORM: `%s'") + call pargstr (tform) + call error (1, Memc[errmess]) + } + + tdtype = dtype + + # If either scaling parameter is defined, promote the data type + # from integer to floating point. Note that only dtype is modified; + # tdtype is the actual data type of the data in the FITS table. + if (tscal != 1.d0 || tzero != 0.d0) { + if (dtype == TBL_TY_SHORT) { + dtype = TBL_TY_REAL + len = nelem * SZ_REAL + } else if (dtype == TBL_TY_INT) { + dtype = TBL_TY_DOUBLE + len = nelem * SZ_DOUBLE + } + } + + # Assign default print format or convert format from Fortran to SPP. + if (tdisp[1] == NULL) # not specified + call tbbadf ("", dtype, lenstring, pformat, maxch) + else + call tbbftp (tdisp, pformat) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfudf.x b/pkg/tbtables/tbfudf.x new file mode 100644 index 00000000..b8083d9f --- /dev/null +++ b/pkg/tbtables/tbfudf.x @@ -0,0 +1,33 @@ +include +include "tbtables.h" + +# tbfudf -- set elements to undefined in a FITS table +# +# Phil Hodge, 6-Jul-1995 Subroutine created + +procedure tbfudf (tp, cp, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +int numcols # i: number of columns +int rownum # i: row number +#-- +int nelem # number of elements for a column +int i # loop index +int status # zero is OK +int tbcigi() +errchk tbferr + +begin + status = 0 + + do i = 1, numcols { + + nelem = tbcigi (cp[i], TBL_COL_LENDATA) + + call fspclu (TB_FILE(tp), COL_NUMBER(cp[i]), rownum, + 1, nelem, status) + if (status != 0) + call tbferr (status) + } +end diff --git a/pkg/tbtables/tbfwcd.x b/pkg/tbtables/tbfwcd.x new file mode 100644 index 00000000..0953e2ee --- /dev/null +++ b/pkg/tbtables/tbfwcd.x @@ -0,0 +1,38 @@ +include +include "tbtables.h" + +# tbfwcd -- write column descriptor to FITS table +# This routine updates the column name, units, and print format. +# If the true data type of the column (i.e. in the table) differs from +# the apparent data type, then TSCALi and/or TZEROi will be updated. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 23-Jun-2000 Call tbfscal. + +procedure tbfwcd (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +pointer sp +pointer value # for new value of name, units, format +errchk tbfnam, tbfnit, tbffmt, tbfscal + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + + call tbcigt (cp, TBL_COL_NAME, Memc[value], SZ_FNAME) + call tbfnam (tp, cp, Memc[value]) + + call tbcigt (cp, TBL_COL_UNITS, Memc[value], SZ_FNAME) + call tbfnit (tp, cp, Memc[value]) + + call tbcigt (cp, TBL_COL_FMT, Memc[value], SZ_FNAME) + call tbffmt (tp, cp, Memc[value]) + + # Update TSCALi and/or TZEROi if the current column uses scaling. + call tbfscal (tp, cp) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfwer.x b/pkg/tbtables/tbfwer.x new file mode 100644 index 00000000..2b18cc87 --- /dev/null +++ b/pkg/tbtables/tbfwer.x @@ -0,0 +1,139 @@ +include # for SZB_CHAR +include +include "tbtables.h" +include "tblfits.h" # defines FITS_TNULL_NOT_SET + +# tbfwer -- write empty rows to end of FITS table +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 3-Jun-1996 Remove call to fsirow. +# Phil Hodge, 23-Apr-1997 Add TNULL to header for FITS ASCII table. +# Phil Hodge, 29-Jul-1997 Call fsirow to create new rows. +# Phil Hodge, 7-Jun-1999 Use TB_SUBTYPE instead of TB_HDUTYPE. +# Phil Hodge, 25-Aug-2000 Delete the call to fsirow. +# Phil Hodge, 12-Sep-2000 Use TB_INDEF for a row of undefined values. + +procedure tbfwer (tp, nrows, new_nrows) + +pointer tp # i: pointer to table descriptor +int nrows # i: number of rows on entry to this routine +int new_nrows # i: number of rows after calling this routine +#-- +pointer sp +pointer keyword # for TNULL keyword +pointer cp # pointer to one column descriptor +int row, col # row and column numbers +int nelem # number of elements, if column is array type +int dtype # data type of column (needed to set TNULL) +int ival # undefined value +int status # zero is OK +# +pointer comment # for getting NAXIS1 +int nbytes # value of NAXIS1 (length of a row, in bytes) +int nchar # number of char elements in nbytes +# +pointer tbcnum() +int tbcigi() +errchk tbferr + +begin + if (new_nrows <= nrows) + return # nothing to do + + call smark (sp) + call salloc (keyword, SZ_FNAME, TY_CHAR) + + status = 0 + + if (TB_INDEF_IS_CURRENT(tp)) { + + # Write the INDEF record to all the new rows. + do row = nrows+1, new_nrows { + call fsptbb (TB_FILE(tp), row, 1, TB_ROWLEN(tp), + Memc[TB_INDEF(tp)], status) + if (status != 0) + call tbferr (status) + } + + } else { + + # We don't have a valid INDEF record yet, so explictly write + # the undefined values for one row, then read that into TB_INDEF. + + row = nrows + 1 + do col = 1, TB_NCOLS(tp) { # loop over columns + + cp = tbcnum (tp, col) + nelem = tbcigi (cp, TBL_COL_LENDATA) + + call fspclu (TB_FILE(tp), col, row, 1, nelem, status) + + if (status == FITS_TNULL_NOT_SET) { + + status = 0 + call ftcmsg() + + # Create TNULL string, and add to header. + + call sprintf (Memc[keyword], SZ_FNAME, "TNULL%d") + call pargi (col) + + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) { + + # TNULL = "*" + call fspkys (TB_FILE(tp), Memc[keyword], + "*", "undefined value for column", status) + + } else if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE) { + + dtype = tbcigi (cp, TBL_COL_DATATYPE) + if (dtype == TY_INT || dtype == TY_SHORT) { + if (dtype == TY_INT) + ival = FITS_INDEFI + else if (dtype == TY_SHORT) + ival = FITS_INDEFS + call fspkyj (TB_FILE(tp), Memc[keyword], + ival, "undefined value for column", status) + } # else don't do anything + } + # try again + call fsrdef (TB_FILE(tp), status) + call fspclu (TB_FILE(tp), col, row, 1, nelem, status) + } + if (status != 0) + call tbferr (status) + } + + # Allocate memory for TB_INDEF, and read the record that we just + # wrote, reading into TB_INDEF. + + call salloc (comment, SZ_FNAME, TY_CHAR) + call fsrdef (TB_FILE(tp), status) + call fsgkyj (TB_FILE(tp), "NAXIS1", nbytes, Memc[comment], status) + if (status != 0) + call tbferr (status) + + TB_ROWLEN(tp) = nbytes # note: this is the number of BYTES + + # round up + nchar = (nbytes + SZB_CHAR-1) / (SZB_CHAR) + call realloc (TB_INDEF(tp), nchar, TY_CHAR) + call fsgtbb (TB_FILE(tp), row, 1, TB_ROWLEN(tp), + Memc[TB_INDEF(tp)), status) + if (status != 0) + call tbferr (status) + + TB_INDEF_IS_CURRENT(tp) = true + + # Now that we have the INDEF record in TB_INDEF, write it to + # all the other new rows. + do row = nrows+2, new_nrows { + call fsptbb (TB_FILE(tp), row, 1, TB_ROWLEN(tp), + Memc[TB_INDEF(tp)], status) + if (status != 0) + call tbferr (status) + } + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbfwsi.x b/pkg/tbtables/tbfwsi.x new file mode 100644 index 00000000..985eb27c --- /dev/null +++ b/pkg/tbtables/tbfwsi.x @@ -0,0 +1,33 @@ +include +include "tbtables.h" + +# tbfwsi -- write size info +# If the current HDU is a table, this routine writes the number of rows and +# the number of columns as FITS keywords NAXIS2 and TFIELDS respectively. +# +# Phil Hodge, 6-Jul-1995 Subroutine created +# Phil Hodge, 2-Feb-1996 Check that current HDU is a table. +# Phil Hodge, 7-Jun-1999 Use TB_SUBTYPE instead of TB_HDUTYPE. + +procedure tbfwsi (tp) + +pointer tp # i: pointer to table descriptor +#-- +int status # zero is OK +errchk tbferr + +begin + status = 0 + + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_BINTABLE || + TB_SUBTYPE(tp) == TBL_SUBTYPE_ASCII) { + + call fsmkyj (TB_FILE(tp), "NAXIS2", TB_NROWS(tp), "", status) + if (status != 0) + call tbferr (status) + + call fsmkyj (TB_FILE(tp), "TFIELDS", TB_NCOLS(tp), "", status) + if (status != 0) + call tbferr (status) + } +end diff --git a/pkg/tbtables/tbfxff.c b/pkg/tbtables/tbfxff.c new file mode 100644 index 00000000..39098489 --- /dev/null +++ b/pkg/tbtables/tbfxff.c @@ -0,0 +1,795 @@ +# include +# include "cfitsio/fitsio.h" /* CFITSIO include file */ +# include "fitsio_spp.h" /* sizes of SPP strings and Fortran FITSIO */ +# include "underscore.h" /* appends underscore, if needed */ + +/* These are buffers for character string values. The sizes are defined + in fitsio.h. +*/ +static char c_filename[FLEN_FILENAME+1]; +static char c_keyword[FLEN_KEYWORD+1]; +static char c_card[FLEN_CARD+1]; +static char c_value[FLEN_VALUE+1]; +static char c_comment[FLEN_COMMENT+1]; +static char c_message[FLEN_ERRMSG+1]; + +static void strpak (short *, char *, int); +static void strupk (char *, short *, int); + +/* This file tbfxff.c contains the interface between the SPP FITSIO calls + and the CFITSIO functions. + + Most subroutines begin with fs, but two of them (ftcmsg and ftdrec) + begin with ft. + + These function names, in upper case and ending in "_U", will be + converted to similar lower case names by underscore.h. The + resulting names will either end in "_" or not, depending on whether + NO_UNDERSCORE has been defined (see tables$lib/mkpkg.inc). + + Phil Hodge, 22-Mar-1999 File created. + Phil Hodge, 8-Apr-1999 Change FLEN_KEYWORD to FLEN_VALUE in fsukys. + Phil Hodge, 7-Sep-1999 Add fsukyj. + Phil Hodge, 25-May-2000 Add fsgrsz (fits_get_rowsize). + Phil Hodge, 23-Jun-2000 Add fsukyd. + Phil Hodge, 12-Sep-2000 Add fsgtbb and fsptbb. +*/ + +void FTDREC_U (fitsfile **fptr, int *keypos, int *status) { + + ffdrec (*fptr, *keypos, status); +} + +void FTCMSG_U() { + + ffcmsg(); +} + +void FSGIOU_U (fitsfile **fptr, int *status) { + ; +} + +void FSFIOU_U (fitsfile **fptr, int *status) { + ; +} + +void FSCLOS_U (fitsfile **fptr, int *status) { + + ffclos (*fptr, status); +} + +void FSCOPY_U (fitsfile **infptr, fitsfile **outfptr, int *morekeys, + int *status) { + + ffcopy (*infptr, *outfptr, *morekeys, status); +} + +void FSCRHD_U (fitsfile **fptr, int *status) { + + ffcrhd (*fptr, status); +} + +void FSDHDU_U (fitsfile **fptr, int *hdutyp, int *status) { + + ffdhdu (*fptr, hdutyp, status); +} + +void FSDROW_U (fitsfile **fptr, int *frow, int *nrows, int *status) { + + ffdrow (*fptr, (long)*frow, (long)*nrows, status); +} + +/* read bytes */ +void FSGTBB_U (fitsfile **fptr, int *frow, int *felem, int *nbytes, + short array[], int *status) { + + ffgtbb (*fptr, (long)*frow, (long)*felem, (long)*nbytes, + (unsigned char *)array, status); +} + +/* write bytes */ +void FSPTBB_U (fitsfile **fptr, int *frow, int *felem, int *nbytes, + short array[], int *status) { + + ffptbb (*fptr, (long)*frow, (long)*felem, (long)*nbytes, + (unsigned char *)array, status); +} + +/* NOTE: This is deprecated; use fsgcfl instead. See next function. ### */ + +void FSGCL_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int lray[], int *status) { + + char nulval = 0; + int anynul; + int i; + char *larray; /* really an array of logical values, not a string */ + + larray = calloc (*nelem, sizeof(char)); + + ffgcvl (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + nulval, larray, &anynul, status); + + for (i = 0; i < *nelem; i++) + lray[i] = larray[i]; + + free (larray); +} + +void FSGCFL_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int lray[], int flgval[], int *anynul, int *status) { + + int i; + /* These two are really arrays of logical values, not strings. */ + char *larray; + char *nularray; + + larray = calloc (*nelem, sizeof(char)); + nularray = calloc (*nelem, sizeof(char)); + + ffgcfl (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, nularray, anynul, status); + + for (i = 0; i < *nelem; i++) { + lray[i] = larray[i]; + flgval[i] = nularray[i]; + } + + free (larray); + free (nularray); +} + +void FSGCVD_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + double *nulval, double array[], int *anynul, int *status) { + + ffgcvd (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + *nulval, array, anynul, status); +} + +void FSGCVE_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + float *nulval, float array[], int *anynul, int *status) { + + ffgcve (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + *nulval, array, anynul, status); +} + +void FSGCVI_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short *nulval, short array[], int *anynul, int *status) { + + ffgcvi (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + *nulval, array, anynul, status); +} + +void FSGCVJ_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int *nulval, int array[], int *anynul, int *status) { + + long *larray; + int i; + + larray = calloc (*nelem, sizeof(long)); + + ffgcvj (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + (long)*nulval, larray, anynul, status); + + for (i = 0; i < *nelem; i++) + array[i] = larray[i]; + + free (larray); +} + +void FSGCVS_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short nulval[], short array[], int *dim1, + int *anynul, int *status) { + + char **larray; + char *lnulval; + int i, j; /* j is the index for array */ + + /* Note that the local variable for nulval has length dim1. */ + lnulval = calloc (*dim1+1, sizeof(char)); + larray = calloc (*nelem, sizeof(char*)); + + for (i = 0; i < *nelem; i++) + larray[i] = calloc (*dim1+1, sizeof(char)); + + strpak (nulval, lnulval, *dim1); + + ffgcvs (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + lnulval, larray, anynul, status); + + j = 0; + for (i = 0; i < *nelem; i++) { + strupk (larray[i], &array[j], *dim1); + free (larray[i]); + j += (*dim1 + 1); /* array is 2-D */ + } + + free (lnulval); + free (larray); +} + +void FSGHSP_U (fitsfile **fptr, int *nexist, int *nmore, int *status) { + + ffghsp (*fptr, nexist, nmore, status); +} + +void FSGKEY_U (fitsfile **fptr, short sppkey[], + short sppvalue[], short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkey (*fptr, c_keyword, c_value, c_comment, status); + + if (*status == 0) { + strupk (c_value, sppvalue, FLEN_VALUE); + strupk (c_comment, sppcomm, FLEN_COMMENT); + } +} + +void FSGKYD_U (fitsfile **fptr, short sppkey[], double *value, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkyd (*fptr, c_keyword, value, c_comment, status); + + if (status == 0) + strupk (c_comment, sppcomm, FLEN_COMMENT); +} + +void FSGKYJ_U (fitsfile **fptr, short sppkey[], int *value, + short sppcomm[], int *status) { + + long lvalue; + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkyj (*fptr, c_keyword, &lvalue, c_comment, status); + *value = (int)lvalue; + + if (status == 0) + strupk (c_comment, sppcomm, FLEN_COMMENT); +} + +void FSGKYS_U (fitsfile **fptr, short sppkey[], short sppvalue[], + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkys (*fptr, c_keyword, c_value, c_comment, status); + + if (*status == 0) { + strupk (c_value, sppvalue, FLEN_VALUE); + strupk (c_comment, sppcomm, FLEN_COMMENT); + } +} + +void FSGMSG_U (short sppmsg[]) { + + int i; + + i = ffgmsg (c_message); + if (i > 0) + strupk (c_message, sppmsg, FLEN_ERRMSG); + else + sppmsg[0] = 0; +} + +void FSGREC_U (fitsfile **fptr, int *nrec, short spprecord[], int *status) { + + ffgrec (*fptr, *nrec, c_card, status); + + if (*status == 0) + strupk (c_card, spprecord, FLEN_CARD); +} + +void FSGRSZ_U (fitsfile **fptr, int *maxrows, int *status) { + + long ndata; + + ffgrsz (*fptr, &ndata, status); + *maxrows = (int)ndata; +} + +void FSGTDM_U (fitsfile **fptr, int *colnum, int *maxdim, + int *naxis, int naxes[], int *status) { + + long *axlen; + int i; + + axlen = calloc (*maxdim, sizeof(long)); + + ffgtdm (*fptr, *colnum, *maxdim, naxis, axlen, status); + + if (*status == 0) { + for (i = 0; i < *naxis; i++) + naxes[i] = axlen[i]; + } + + free (axlen); +} + +void FSIBIN_U (fitsfile **fptr, int *nrows, int *nfields, + short sppttype[], short spptform[], short spptunit[], + short sppextnam[], int *pcount, int *status) { + + char **ttype, **tform, **tunit; + char *extnam; + int i; + int j1 = 0, j2 = 0, j3 = 0; + + ttype = calloc (*nfields, sizeof(char*)); + tform = calloc (*nfields, sizeof(char*)); + tunit = calloc (*nfields, sizeof(char*)); + + extnam = calloc (FLEN_VALUE+1, sizeof(char)); + strpak (sppextnam, extnam, FLEN_VALUE); + + for (i = 0; i < *nfields; i++) { + + ttype[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tform[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tunit[i] = calloc (FLEN_VALUE+1, sizeof(char)); + + strpak (&sppttype[j1], ttype[i], SZ_FTTYPE); + strpak (&spptform[j2], tform[i], SZ_FTFORM); + strpak (&spptunit[j3], tunit[i], SZ_FTUNIT); + + j1 += SZ_FTTYPE+1; + j2 += SZ_FTFORM+1; + j3 += SZ_FTUNIT+1; + } + + ffibin (*fptr, (long)*nrows, *nfields, + ttype, tform, tunit, + extnam, (long)*pcount, status); + + free (extnam); + for (i = 0; i < *nfields; i++) { + free (ttype[i]); + free (tform[i]); + free (tunit[i]); + } + free (ttype); + free (tform); + free (tunit); +} + +void FSICOL_U (fitsfile **fptr, int *colnum, + short sppttype[], short spptform[], int *status) { + + char *ttype, *tform; + + ttype = calloc (SZ_FTTYPE+1, sizeof(char*)); + tform = calloc (SZ_FTFORM+1, sizeof(char*)); + strpak (sppttype, ttype, SZ_FTTYPE); + strpak (spptform, tform, SZ_FTFORM); + + fficol (*fptr, *colnum, ttype, tform, status); + + free (ttype); + free (tform); +} + +void FSINIT_U (fitsfile **fptr, short sppname[], + int *blocksize, int *status) { + + strpak (sppname, c_filename, FLEN_FILENAME); + ffinit (fptr, c_filename, status); +} + +void FSIROW_U (fitsfile **fptr, int *frow, int *nrows, int *status) { + + ffirow (*fptr, (long)*frow, (long)*nrows, status); +} + +void FSMAHD_U (fitsfile **fptr, int *hdunum, int *exttype, int *status) { + + ffmahd (*fptr, *hdunum, exttype, status); +} + +void FSMCOM_U (fitsfile **fptr, short sppkey[], short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmcom (*fptr, c_keyword, c_comment, status); +} + +void FSMKYD_U (fitsfile **fptr, short sppkey[], double *dval, + int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkyd (*fptr, c_keyword, *dval, *decim, c_comment, status); +} + +void FSMKYE_U (fitsfile **fptr, short sppkey[], float *rval, + int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkye (*fptr, c_keyword, *rval, *decim, c_comment, status); +} + +void FSMKYJ_U (fitsfile **fptr, short sppkey[], int *intval, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkyj (*fptr, c_keyword, (long)*intval, c_comment, status); +} + +void FSMKYL_U (fitsfile **fptr, short sppkey[], int *logval, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkyl (*fptr, c_keyword, *logval, c_comment, status); +} + +void FSMKYS_U (fitsfile **fptr, short sppkey[], short sppvalue[], + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppvalue, c_value, FLEN_VALUE); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkys (*fptr, c_keyword, c_value, c_comment, status); +} + +void FSMREC_U (fitsfile **fptr, int *nkey, short sppcard[], int *status) { + + strpak (sppcard, c_card, FLEN_CARD); + + ffmrec (*fptr, *nkey, c_card, status); +} + +void FSOPEN_U (fitsfile **fptr, short sppname[], int *iomode, + int *blocksize, int *status) { + + strpak (sppname, c_filename, FLEN_FILENAME); + + ffopen (fptr, c_filename, *iomode, status); +} + +void FSPCLD_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + double array[], int *status) { + + ffpcld (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + array, status); +} + +void FSPCLE_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + float array[], int *status) { + + ffpcle (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + array, status); +} + +void FSPCLI_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short array[], int *status) { + + ffpcli (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + array, status); +} + +void FSPCLJ_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int array[], int *status) { + + long *larray; + int i; + + larray = calloc (*nelem, sizeof(long)); + + for (i = 0; i < *nelem; i++) + larray[i] = array[i]; + + ffpclj (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, status); + + free (larray); +} + +void FSPCLL_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int array[], int *status) { + + char *larray; + int i; + + larray = calloc (*nelem, sizeof(char)); + + for (i = 0; i < *nelem; i++) + larray[i] = array[i]; + + ffpcll (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, status); + + free (larray); +} + +void FSPCLS_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short array[], int *dim1, int *status) { + + char **larray; + int i, j; /* j is the index for array */ + + larray = calloc (*nelem, sizeof(char*)); + + j = 0; + for (i = 0; i < *nelem; i++) { + larray[i] = calloc (*dim1+1, sizeof(char)); + strpak (&array[j], larray[i], *dim1); + j += (*dim1 + 1); /* array is 2-D */ + } + + ffpcls (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, status); + + for (i = 0; i < *nelem; i++) + free (larray[i]); + + free (larray); +} + +void FSPCLU_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int *status) { + + ffpclu (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, status); +} + +void FSPCOM_U (fitsfile **fptr, short sppcomm[], int *status) { + + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpcom (*fptr, c_comment, status); +} + +void FSPHBN_U (fitsfile **fptr, int *nrows, int *nfields, + short sppttype[], short spptform[], short spptunit[], + short sppextnam[], int *pcount, int *status) { + + char **ttype, **tform, **tunit; + char *extnam; + int i; + int j1 = 0, j2 = 0, j3 = 0; + + ttype = calloc (*nfields, sizeof(char*)); + tform = calloc (*nfields, sizeof(char*)); + tunit = calloc (*nfields, sizeof(char*)); + + extnam = calloc (FLEN_VALUE+1, sizeof(char)); + strpak (sppextnam, extnam, FLEN_VALUE); + + for (i = 0; i < *nfields; i++) { + + ttype[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tform[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tunit[i] = calloc (FLEN_VALUE+1, sizeof(char)); + + strpak (&sppttype[j1], ttype[i], SZ_FTTYPE); + strpak (&spptform[j2], tform[i], SZ_FTFORM); + strpak (&spptunit[j3], tunit[i], SZ_FTUNIT); + + j1 += SZ_FTTYPE+1; + j2 += SZ_FTFORM+1; + j3 += SZ_FTUNIT+1; + } + + ffphbn (*fptr, (long)*nrows, *nfields, + ttype, tform, tunit, + extnam, (long)*pcount, status); + + free (extnam); + for (i = 0; i < *nfields; i++) { + free (ttype[i]); + free (tform[i]); + free (tunit[i]); + } + free (ttype); + free (tform); + free (tunit); +} + +void FSPHIS_U (fitsfile **fptr, short sppcomm[], int *status) { + + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffphis (*fptr, c_comment, status); +} + +void FSPHPR_U (fitsfile **fptr, int *simple, int *bitpix, + int *naxis, long naxes[], long *pcount, long *gcount, + int *extend, int *status) { + + long *axlen; + int i; + + axlen = calloc (*naxis, sizeof(long)); + + for (i = 0; i < *naxis; i++) + axlen[i] = naxes[i]; + + ffphpr (*fptr, *simple, *bitpix, *naxis, axlen, + (long)*pcount, (long)*gcount, *extend, status); + + free (axlen); +} + +void FSPKYD_U (fitsfile **fptr, short sppkey[], + double *dval, int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkyd (*fptr, c_keyword, *dval, *decim, c_comment, status); +} + +void FSPKYE_U (fitsfile **fptr, short sppkey[], + float *rval, int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkye (*fptr, c_keyword, *rval, *decim, c_comment, status); +} + +void FSPKYJ_U (fitsfile **fptr, short sppkey[], int *value, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkyj (*fptr, c_keyword, (long)*value, c_comment, status); +} + +void FSPKYL_U (fitsfile **fptr, short sppkey[], + int *logval, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkyl (*fptr, c_keyword, *logval, c_comment, status); +} + +void FSPKYS_U (fitsfile **fptr, short sppkey[], short sppvalue[], + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppvalue, c_value, FLEN_VALUE); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkys (*fptr, c_keyword, c_value, c_comment, status); +} + +void FSPREC_U (fitsfile **fptr, short sppcard[], int *status) { + + strpak (sppcard, c_card, FLEN_CARD); + + ffprec (*fptr, c_card, status); +} + +void FSPSVC_U (short sppcard[], + short sppvalue[], short sppcomm[], int *status) { + + strpak (sppcard, c_card, FLEN_CARD); + + ffpsvc (c_card, c_value, c_comment, status); + + if (*status == 0) { + strupk (c_value, sppvalue, FLEN_VALUE); + strupk (c_comment, sppcomm, FLEN_COMMENT); + } +} + +void FSPTDM_U (fitsfile **fptr, int *colnum, + int *naxis, int naxes[], int *status) { + + long *axlen; + int i; + + axlen = calloc (*naxis, sizeof(long)); + + for (i = 0; i < *naxis; i++) + axlen[i] = naxes[i]; + + ffptdm (*fptr, *colnum, *naxis, axlen, status); + + free (axlen); +} + +void FSRDEF_U (fitsfile **fptr, int *status) { + + ffrdef (*fptr, status); +} + +void FSUKYD_U (fitsfile **fptr, short sppkey[], + double *dval, int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukyd (*fptr, c_keyword, *dval, *decim, c_comment, status); +} + +void FSUKYJ_U (fitsfile **fptr, short sppkey[], int *value, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukyj (*fptr, c_keyword, (long)*value, c_comment, status); +} + +void FSUKYL_U (fitsfile **fptr, short sppkey[], int *logval, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukyl (*fptr, c_keyword, *logval, c_comment, status); +} + +void FSUKYS_U (fitsfile **fptr, short sppkey[], + short sppvalue[], short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppvalue, c_value, FLEN_VALUE); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukys (*fptr, c_keyword, c_value, c_comment, status); +} + +static void strpak (short *in, char *out, int maxch) { + + int i = 0; + + while (in[i] != 0 && i < maxch) { + out[i] = in[i]; + i++; + } + out[i] = '\0'; +} + +static void strupk (char *in, short *out, int maxch) { + + int i = 0; + + while (in[i] != '\0' && i < maxch) { + out[i] = in[i]; + i++; + } + out[i] = 0; +} diff --git a/pkg/tbtables/tbhad.x b/pkg/tbtables/tbhad.x new file mode 100644 index 00000000..2ca4d038 --- /dev/null +++ b/pkg/tbtables/tbhad.x @@ -0,0 +1,232 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Add a keyword and value into the table header. If the keyword already +# exists the value will be replaced; otherwise, a new keyword will be added. +# +# Phil Hodge, 7-Aug-1987 Subroutine created. +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 21-Jul-1992 Change format in tbhadd to %25.16g. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 14-Jun-1995 Modify for FITS tables. + +# tbhadd -- add double header parameter + +procedure tbhadd (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +double value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() +errchk tbhfkw, tbhpnp, tbhanp, tbfhpd + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhadd: can't put numeric parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpd (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + dtype = TY_DOUBLE + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call sprintf (Memc[par], SZ_PARREC, "%-25.16g") + call pargd (value) + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + else + call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param. + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhadr -- add real header parameter + +procedure tbhadr (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +real value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() +errchk tbhfkw, tbhpnp, tbhanp, tbfhpr + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhadr: can't put numeric parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpr (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + dtype = TY_REAL + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call sprintf (Memc[par], SZ_PARREC, "%-15.7g") + call pargr (value) + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + else + call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param. + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhadi -- add integer header parameter + +procedure tbhadi (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +int value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() +errchk tbhfkw, tbhpnp, tbhanp, tbfhpi + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhadi: can't put numeric parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpi (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + dtype = TY_INT + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call sprintf (Memc[par], SZ_PARREC, "%-11d") + call pargi (value) + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + else + call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param. + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhadb -- add Boolean header parameter + +procedure tbhadb (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +bool value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +int dtype # data type +int parnum # parameter number (> 0 if found) +int intval # buffer for writing value into string +bool tbhisc() +errchk tbhfkw, tbhpnp, tbhanp, tbfhpb + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhadb: can't put Boolean parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpb (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + dtype = TY_BOOL + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + if (value) + intval = YES + else + intval = NO + call sprintf (Memc[par], SZ_PARREC, "%-11d") + call pargi (intval) + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + else + call tbhanp (tp, keyword, dtype, Memc[par], parnum) # add new param. + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhadt -- add character header parameter + +procedure tbhadt (tp, keyword, text) + +pointer tp # i: Pointer to table descriptor +char keyword[ARB] # i: Name of parameter +char text[ARB] # i: Value of parameter +#-- +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() # true if keyword is comment or history +errchk tbhfkw, tbhpnp, tbhanp, tbfhpt + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpt (tp, keyword, text) + TB_MODIFIED(tp) = true + return + } + + dtype = TY_CHAR + + if (tbhisc (keyword)) { # comment or history? + call tbhanp (tp, keyword, dtype, text, parnum) # then add new + } else { + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) + call tbhpnp (tp, parnum, keyword, dtype, text) # put Nth param. + else + call tbhanp (tp, keyword, dtype, text, parnum) # add new param. + } + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbhanp.x b/pkg/tbtables/tbhanp.x new file mode 100644 index 00000000..daf46ff3 --- /dev/null +++ b/pkg/tbtables/tbhanp.x @@ -0,0 +1,118 @@ +include # defines IS_WHITE +include +include "tbtables.h" + +# tbhanp -- add new parameter +# This procedure writes a new user parameter to the table; the number +# of the new parameter is returned. The data type may be TY_CHAR (for a +# string), TY_REAL, TY_DOUBLE, TY_INT, or TY_BOOL. +# The table will be rewritten if necessary in order to increase the amount +# of space allocated for user parameters. +# +# TB_MODIFIED is set by this routine. +# +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 14-Feb-1992 Add option for text table type. +# Phil Hodge, 22-Apr-1994 For text table, append to comment buffer. +# Phil Hodge, 6-Mar-1995 Erase space in table before writing new parameter. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 24-Jul-1995 Modify for FITS tables. +# Phil Hodge, 7-Jun-1999 Call tbzkey instead of tbbcmt for text table. +# Frank Valdes, 20-Nov-2003 Quote strings in text, strip trailing spaces, and +# capitalize keywords to be consistent with tbhpnp. + +procedure tbhanp (tp, keyword, dtype, str, parnum) + +pointer tp # i: pointer to table descriptor +char keyword[SZ_KEYWORD] # i: keyword for the parameter +int dtype # i: data type +char str[ARB] # i: string containing the value of the param. +int parnum # o: number of the parameter in the table +#-- +pointer sp +pointer text_str # scratch +pointer word # value (extracted from str) of parameter +pointer comment # comment string, if any, from str +int maxpar # increased value of TB_MAXPAR +int i +int ip, nchar, ctowrd(), strlen() +errchk tbtchs, tbfanp, tbhpnp, tbhwpr, tbhpcm, tbzkey + +begin + call smark (sp) + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + + call salloc (text_str, SZ_LINE, TY_CHAR) + + # Construct "#k keyword = value", and add to keyword list. + call sprintf (Memc[text_str], SZ_LINE, "#k %-8s = ") + call pargstr (keyword) + call strupr (Memc[text_str+3]) + if (dtype == TY_CHAR) { + call strcat ("'", Memc[text_str], SZ_LINE) + call strcat (str, Memc[text_str], SZ_LINE) + i = text_str + strlen (Memc[text_str]) - 1 + for (; IS_WHITE(Memc[i]); i=i-1) + Memc[i] = EOS + call strcat ("'", Memc[text_str], SZ_LINE) + } else + call strcat (str, Memc[text_str], SZ_LINE) + call tbzkey (tp, Memc[text_str], 0) + parnum = TB_NPAR(tp) + + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + + call tbfanp (tp, keyword, dtype, str, parnum) + + } else { + + call salloc (text_str, SZ_PARREC, TY_CHAR) + call salloc (word, SZ_PARREC, TY_CHAR) + call salloc (comment, SZ_PARREC, TY_CHAR) + do i = 0, SZ_PARREC-1 + Memc[text_str+i] = ' ' + Memc[text_str+SZ_PARREC] = EOS + + # Extract value and comment from str. + if (dtype == TY_CHAR) { + i = 1 + while (IS_WHITE(str[i])) + i = i + 1 + if (str[i] == '"' || str[i] == '\'') { + ip = 1 + nchar = ctowrd (str, ip, Memc[word], SZ_PARREC) + i = ip + while (IS_WHITE(str[i])) + i = i + 1 + call strcpy (str[i], Memc[comment], SZ_PARREC) + } else { + call strcpy (str[i], Memc[word], SZ_PARREC) + Memc[comment] = EOS # no comment + } + } else { + ip = 1 + nchar = ctowrd (str, ip, Memc[word], SZ_PARREC) + i = ip + while (IS_WHITE(str[i])) + i = i + 1 + call strcpy (str[i], Memc[comment], SZ_PARREC) + } + + if (TB_NPAR(tp) >= TB_MAXPAR(tp)) { + maxpar = TB_MAXPAR(tp) + DEFMAXPAR + call tbtchs (tp, maxpar, -1, -1, -1) # change size + } + parnum = TB_NPAR(tp) + 1 + TB_NPAR(tp) = parnum + + # Blank out the space and then put the Nth parameter. + call tbhwpr (tp, parnum, Memc[text_str]) + call tbhpnp (tp, parnum, keyword, dtype, Memc[word]) + call tbhpcm (tp, keyword, Memc[comment]) # append comment + } + + TB_MODIFIED(tp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhcal.x b/pkg/tbtables/tbhcal.x new file mode 100644 index 00000000..e0a78477 --- /dev/null +++ b/pkg/tbtables/tbhcal.x @@ -0,0 +1,140 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbhcal -- copy all header parameters +# All header (i.e. user) parameters are copied from the input to the +# output table, both of which must be open. This would normally be used +# for a recently created output table which would not have any parameters. +# If there are header parameter(s) in the output table (except for history +# or comments) that have the same keyword names as parameters in the input +# table, the records from the input replace those in the output. +# +# Phil Hodge, 31-Aug-1987 Subroutine created. +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 30-Jan-1992 Modify for text tables (copy comment buffer). +# Phil Hodge, 22-Apr-1994 Call tbbcmt to append comment buffer. +# Phil Hodge, 11-May-1994 Simplify text table section, and dereference +# pointer TB_COMMENT in call to tbbcmt. +# Phil Hodge, 6-Mar-1995 Also copy comment. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true for text table. +# Phil Hodge, 14-Jun-1995 Modify for FITS tables. +# Phil Hodge, 30-Jan-1996 Set TB_MODIFIED to true. +# Phil Hodge, 7-Jun-1999 Copy parameters for a text table. + +procedure tbhcal (itp, otp) + +pointer itp # i: pointer to descriptor of input table +pointer otp # i: pointer to descriptor of output table +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer comment # scratch for comment string +pointer key # scratch for keyword names +pointer pnum # scratch for parameter number +char keyword[SZ_KEYWORD] # parameter name +int dtype # data type of parameter (ignored) +int parnum # parameter number +int j # loop index for par number in input table +int k # loop index for par number in output table +int numout # initial number of par in output table +int allout # total number of parameters for output table +int num_noncomment # number of non-comment parameters +int key_offset # an offset for keyword names in scratch array +int strncmp() +bool tbhisc() +errchk tbtchs, tbbcmt, tbfcal, tbhgnp, tbhpnp, tbhanp, tbhrpr, tbhwpr + +begin + if ( ! TB_IS_OPEN(otp) ) + call error (1, "tbhcal: output table is not open yet") + if (TB_READONLY(otp)) + call error (ER_TBREADONLY, + "tbhcal: can't write to table; it's readonly") + + if (TB_TYPE(itp) == TBL_TYPE_FITS || TB_TYPE(otp) == TBL_TYPE_FITS) { + call tbfcal (itp, otp) + TB_MODIFIED(otp) = true + return + } + + if (TB_TYPE(otp) == TBL_TYPE_TEXT) { + # For a text table we also copy the comment buffer, but only + # if there's an input comment buffer. + if (TB_COMMENT(itp) != NULL) + call tbbcmt (otp, Memc[TB_COMMENT(itp)]) + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call salloc (comment, SZ_PARREC, TY_CHAR) + + # This will be zero if it's a new table. + numout = TB_NPAR(otp) + + # Do we need more space for header parameters in the output table? + allout = numout + TB_NPAR(itp) + if (allout > TB_MAXPAR(otp)) + call tbtchs (otp, allout+DEFMAXPAR, -1, -1, -1) + + # Are there already some parameters in the output table? + if (numout > 0) { + + call salloc (key, numout*SZ_KEYWORD, TY_CHAR) + call salloc (pnum, numout, TY_INT) + + # Make a list of all non-comment keywords in output table. + num_noncomment = 0 # initial values + key_offset = key + do k = 1, numout { + # Get Nth parameter from output table (we just need + # the keyword name). + call tbhgnp (otp, k, keyword, dtype, Memc[par]) + if ( ! tbhisc (keyword) ) { + # Not a comment, so add it to the list. + num_noncomment = num_noncomment + 1 + call strcpy (keyword, Memc[key_offset], SZ_KEYWORD) + key_offset = key_offset + SZ_KEYWORD + Memi[pnum+num_noncomment-1] = k # param number + } + } + # Copy each input parameter. + do j = 1, TB_NPAR(itp) { + # Get Nth parameter and its comment from the input table. + call tbhgnp (itp, j, keyword, dtype, Memc[par]) + call tbhgcm (itp, keyword, Memc[comment], SZ_PARREC) + parnum = 0 # initial values + key_offset = key + do k = 1, num_noncomment { + if (strncmp (keyword, Memc[key_offset], SZ_KEYWORD) == 0) { + parnum = Memi[pnum+k-1] # found it + break + } else { + key_offset = key_offset + SZ_KEYWORD + } + } + if (parnum > 0) + # It's already present in output table; put Nth parameter. + call tbhpnp (otp, parnum, keyword, dtype, Memc[par]) + else + # Add new parameter; the output parnum is ignored. + call tbhanp (otp, keyword, dtype, Memc[par], parnum) + + # Append the comment. + call tbhpcm (otp, keyword, Memc[comment]) + } + + } else { + + # No parameters in output table yet; copy every parameter. + do j = 1, TB_NPAR(itp) { + call tbhrpr (itp, j, Memc[par]) + call tbhwpr (otp, j, Memc[par]) + } + TB_NPAR(otp) = TB_NPAR(itp) + } + + TB_MODIFIED(otp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhckn.x b/pkg/tbtables/tbhckn.x new file mode 100644 index 00000000..ed8ffcb8 --- /dev/null +++ b/pkg/tbtables/tbhckn.x @@ -0,0 +1,87 @@ +include # IS_LOWER, TO_UPPER +include +include "tbtables.h" + +# tbhckn -- change keyword name +# This routine changes the name of a keyword without changing either +# the data type, value, or comment. +# +# The current keyword can be specified either by name or number, +# but not both. +# +# Phil Hodge, 22-May-1996 Subroutine created. +# Phil Hodge, 7-Jun-1999 Handle text tables. + +procedure tbhckn (tp, oldkey, parnum, newkey) + +pointer tp # i: pointer to table descriptor +char oldkey[ARB] # i: current keyword name +int parnum # i: number of current keyword +char newkey[ARB] # i: new keyword name +#-- +pointer sp +pointer par # buffer for parameter record +char uc_oldkey[SZ_KEYWORD] # old keyword converted to upper case +char uc_newkey[SZ_KEYWORD] +int i, k +bool foundit # true if oldkey found in table +int len, strlen() +bool tbhkeq() +errchk tbhrpr, tbhwpr, tbfckn + +begin + len = strlen (newkey) + if (len > SZ_KEYWORD) + call error (1, "tbhckn: new keyword name is too long") + + if (oldkey[1] != EOS && parnum > 0) + call error (1, "tbhckn: may not specify both name and number") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfckn (tp, oldkey, parnum, newkey) + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call strcpy (oldkey, uc_oldkey, SZ_KEYWORD) + call strcpy (newkey, uc_newkey, SZ_KEYWORD) + call strupr (uc_oldkey) + call strupr (uc_newkey) + + if (parnum > 0) { # current parameter was specified by number + + k = parnum + call tbhrpr (tp, k, Memc[par]) # read parameter record + + } else { # current parameter was specified by name + + foundit = false + do k = 1, TB_NPAR(tp) { + + call tbhrpr (tp, k, Memc[par]) # read parameter record + + if (tbhkeq (uc_oldkey, Memc[par])) { # keywords equal? + foundit = true + break + } + } + + if (!foundit) { + call sprintf (Memc[par], SZ_PARREC, + "tbhckn: keyword `%s' not found") + call pargstr (oldkey) + call error (1, Memc[par]) + } + } + + do i = 1, len # replace old keyword + Memc[par+i-1] = uc_newkey[i] + do i = len+1, SZ_KEYWORD + Memc[par+i-1] = ' ' + + call tbhwpr (tp, k, Memc[par]) # write parameter record + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhdel.x b/pkg/tbtables/tbhdel.x new file mode 100644 index 00000000..3f9764af --- /dev/null +++ b/pkg/tbtables/tbhdel.x @@ -0,0 +1,70 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbhdel -- delete Nth parameter +# Delete a header parameter by overwriting with subsequent records and +# decrementing the number of parameter records TB_NPAR(tp) by one. +# The parameter is specified by number rather than by name so a history +# or comment record can be deleted. +# If the parameter number is out of range, this routine simply returns. +# +# Phil Hodge, 16-Mar-1988 Subroutine created. +# Phil Hodge, 14-Feb-1992 Add option for text table type. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 3-Oct-1995 Modify for FITS tables. +# Phil Hodge, 7-Jun-1999 Modify for text tables. + +procedure tbhdel (tp, parnum) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be deleted +#-- +pointer sp +pointer str # scratch for a parameter record +int k # loop index for copying keyword +errchk tbfhdl, tbhrpr, tbhwpr + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "table is readonly") + + TB_MODIFIED(tp) = true + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + if (TB_KEYLIST_PTR(tp) != NULL && + parnum >= 1 && parnum <= TB_NPAR(tp)) { + call mfree (TB_KEYWORD(tp,parnum), TY_CHAR) + do k = parnum, TB_NPAR(tp)-1 + TB_KEYWORD(tp,k) = TB_KEYWORD(tp,k+1) + k = TB_NPAR(tp) + TB_KEYWORD(tp,k) = NULL + TB_NPAR(tp) = TB_NPAR(tp) - 1 + } + return + } + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhdl (tp, parnum) + return + } + + if (parnum == TB_NPAR(tp)) { + + TB_NPAR(tp) = TB_NPAR(tp) - 1 + + } else if (parnum >= 1 && parnum < TB_NPAR(tp)) { + + call smark (sp) + call salloc (str, SZ_PARREC, TY_CHAR) + + do k = parnum, TB_NPAR(tp)-1 { + # Read next parameter record, and overwrite current one. + call tbhrpr (tp, k+1, Memc[str]) + call tbhwpr (tp, k, Memc[str]) + } + + TB_NPAR(tp) = TB_NPAR(tp) - 1 + call sfree (sp) + } +end diff --git a/pkg/tbtables/tbhfcm.x b/pkg/tbtables/tbhfcm.x new file mode 100644 index 00000000..7dfdc22f --- /dev/null +++ b/pkg/tbtables/tbhfcm.x @@ -0,0 +1,56 @@ +include # defines IS_WHITE +include + +# tbhfcm -- find a comment in a header parameter string +# This locates the comment, if present, in a text string containing a +# header parameter. +# The returned value of index will be zero if no comment was found. +# If a comment was found, par[index] will be the first character of +# the comment. +# The input string should be the complete parameter record; that is, +# it includes the keyword name, data type, value, and optional comment. +# +# Phil Hodge, 6-Mar-1995 Subroutine created. +# Phil Hodge, 12-May-1995 Check for both ' and " as string delimiter. + +procedure tbhfcm (par, index) + +char par[ARB] # i: string containing header parameter +int index # o: index of beginning of comment, or zero +#-- +pointer sp +pointer word # scratch for the parameter value +int ip, nchar, ctowrd() +int strlen() + +begin + index = 0 # initial value + + if (strlen (par) < START_OF_VALUE) + return + + # If a parameter of type text does not begin with a quote, + # it doesn't have an associated comment. + if (par[LOCN_DTYPE] == 't') { + if (par[START_OF_VALUE] != '"' && par[START_OF_VALUE] != '\'') + return + } + + call smark (sp) + call salloc (word, SZ_PARREC, TY_CHAR) + + # Skip over the value. + ip = START_OF_VALUE + nchar = ctowrd (par, ip, Memc[word], SZ_PARREC) + + # Check whether anything follows the value. Skip whitespace. + while (IS_WHITE(par[ip])) + ip = ip + 1 + + # If there is a comment, set index to the first character + # of the comment. + if (par[ip] != EOS) + index = ip + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhfkr.x b/pkg/tbtables/tbhfkr.x new file mode 100644 index 00000000..5609d139 --- /dev/null +++ b/pkg/tbtables/tbhfkr.x @@ -0,0 +1,58 @@ +include +include "tbtables.h" + +# tbhfkr -- find keyword for reading +# Find a header record for a given keyword. If the keyword is found +# the string containing the value and the number of the parameter in +# the table will be returned; otherwise, the number will be set to zero. +# The difference between this routine and tbhfkw (find keyword for writing) +# is that the latter does not return the datatype or value string. +# The output string str should be SZ_PARREC in length. +# The keyword search begins with the first keyword. +# +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 9-Mar-1995 Ignore comment; trim trailing blanks from value. +# Phil Hodge, 12-May-1995 Check for both ' and " as string delimiter. +# Phil Hodge, 1-Nov-1996 Replace most of code with a call to tbhgnp. + +procedure tbhfkr (tp, keyword, dtype, str, parnum) + +pointer tp # i: pointer to table descriptor +char keyword[SZ_KEYWORD] # i: keyword to be found +int dtype # o: data type (TY_CHAR, etc) +char str[SZ_PARREC] # o: the string containing the value +int parnum # o: parameter number or zero if not found +#-- +pointer sp +pointer par # buffer for parameter record +char uckey[SZ_KEYWORD] # keyword converted to upper case +char keywordk[SZ_KEYWORD] # Kth keyword name +int dtypek # data type of Kth keyword +int k # loop index +bool streq() +errchk tbhgnp + +begin + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + + do k = 1, TB_NPAR(tp) { + + call tbhgnp (tp, k, keywordk, dtypek, Memc[par]) + + if (streq (uckey, keywordk)) { # keywords equal? + + dtype = dtypek + call strcpy (Memc[par], str, SZ_PARREC) + parnum = k + + call sfree (sp) + return # keyword has been found + } + } + parnum = 0 # keyword not found + call sfree (sp) +end diff --git a/pkg/tbtables/tbhfkw.x b/pkg/tbtables/tbhfkw.x new file mode 100644 index 00000000..45901859 --- /dev/null +++ b/pkg/tbtables/tbhfkw.x @@ -0,0 +1,46 @@ +include +include "tbtables.h" + +# tbhfkw -- find keyword for writing +# Find a "header" record for a given keyword. If the keyword is found +# the number of the parameter in the table will be returned; otherwise, +# the number will be set to zero. The search begins with the first keyword. +# +# Phil Hodge, 22-Jan-1996 Modify for FITS tables. + +procedure tbhfkw (tp, keyword, parnum) + +pointer tp # i: Pointer to table descriptor +char keyword[SZ_KEYWORD] # i: Keyword to be found +int parnum # o: Parameter number or zero if not found +#-- +pointer sp +pointer par # buffer for header record for parameter +int k # loop index +char uckey[SZ_KEYWORD] # keyword converted to upper case +bool tbhkeq() +errchk tbhrpr + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbffkw (tp, keyword, parnum) + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + + do k = 1, TB_NPAR(tp) { + call tbhrpr (tp, k, Memc[par]) # read parameter record + if (tbhkeq (uckey, Memc[par])) { # keywords equal? + parnum = k + call sfree (sp) + return # keyword has been found + } + } + parnum = 0 # keyword not found + call sfree (sp) +end diff --git a/pkg/tbtables/tbhgcm.x b/pkg/tbtables/tbhgcm.x new file mode 100644 index 00000000..64b34948 --- /dev/null +++ b/pkg/tbtables/tbhgcm.x @@ -0,0 +1,75 @@ +include +include "tbtables.h" + +# tbhgcm -- get a comment from a header parameter +# This reads the comment from a header parameter. It is an error if +# the keyword is not found, but there need not be an associated comment. +# Trailing blanks are removed from the comment. +# +# Phil Hodge, 6-Mar-1995 Subroutine created. +# Phil Hodge, 8-Jun-1995 Modify for FITS tables. +# Phil Hodge, 7-Jun-1999 Handle text tables. + +procedure tbhgcm (tp, keyword, comment, maxch) + +pointer tp # i: pointer to table descriptor +char keyword[SZ_KEYWORD] # i: keyword to be found +char comment[ARB] # o: comment string for keyword +int maxch # i: max size of comment +#-- +pointer sp +pointer errmsg # scratch for possible error message +pointer str # scratch for string read from header +int parnum # number of the parameter +int index # location of comment within string +int i +int strlen() +bool tbhisc() + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfgcm (tp, keyword, comment, maxch) + return + } + + # We don't read a comment from a comment. + if (tbhisc (keyword)) { + comment[1] = EOS + return + } + + call smark (sp) + call salloc (str, SZ_PARREC, TY_CHAR) + + # Find the keyword in the header. + call tbhfkw (tp, keyword, parnum) + if (parnum < 1) { + call salloc (errmsg, SZ_FNAME, TY_CHAR) + call sprintf (Memc[errmsg], SZ_FNAME, + "tbhgcm: keyword `%s' not found in table `%s'") + call pargstr (keyword) + call pargstr (TB_NAME(tp)) + call error (1, Memc[errmsg]) + } + + # Read the string containing keyword, datatype, value. + call tbhrpr (tp, parnum, Memc[str]) + + # Search for a comment. + call tbhfcm (Memc[str], index) + + if (index > 0) + call strcpy (Memc[str+index-1], comment, maxch) + else + comment[1] = EOS # no comment + + # Trim trailing blanks. + do i = strlen (comment), 1, -1 { + if (comment[i] == ' ') + comment[i] = EOS + else + break + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhgnp.x b/pkg/tbtables/tbhgnp.x new file mode 100644 index 00000000..58f3f921 --- /dev/null +++ b/pkg/tbtables/tbhgnp.x @@ -0,0 +1,115 @@ +include # for IS_WHITE +include +include "tbtables.h" + +# tbhgnp -- get Nth parameter +# Get the keyword and value string of header parameter number parnum. +# The string str should be SZ_PARREC in length, although not that much +# will be used since only the value will be copied to str. +# A keyword may not contain embedded blanks. +# If the parameter has an associated comment string, that string will +# not be returned; use tbhgcm to get the comment. +# Trailing blanks will be trimmed from the parameter value. +# +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 9-Mar-1995 Ignore comment; trim trailing blanks from value. +# Phil Hodge, 12-May-1995 Check for both ' and " as string delimiter. +# Phil Hodge, 8-Jun-1995 Modify for FITS tables. +# Phil Hodge, 27-Nov-1995 Add cmt to calling sequence of tbfgnp. + +procedure tbhgnp (tp, parnum, keyword, dtype, str) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be gotten +char keyword[SZ_KEYWORD] # o: keyword for the parameter +int dtype # o: data type (TY_CHAR, etc) +char str[SZ_PARREC] # o: string containing the value of the param. +#-- +pointer sp +pointer par # buffer for parameter record +pointer cmt # scratch for comment from FITS record +int k # loop index for copying keyword +int ip # loop indices for copying value +int char_type # data type as a letter (t, b, i, r, d) +int index # location of comment in string +int nchar, ctowrd() +int strlen() +errchk tbhrpr + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call smark (sp) + call salloc (cmt, SZ_PARREC, TY_CHAR) # thrown away + call tbfgnp (tp, parnum, keyword, dtype, str, Memc[cmt], SZ_PARREC) + call sfree (sp) + return + } + + if (parnum < 1 || parnum > TB_NPAR(tp)) { + keyword[1] = EOS + dtype = 0 + str[1] = EOS + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call tbhrpr (tp, parnum, Memc[par]) # read parameter record + + # Copy the keyword to output and append EOS. + do k = 1, SZ_KEYWORD { + if (Memc[par+k-1] == ' ') { # stop at first blank + keyword[k] = EOS + break + } + keyword[k] = Memc[par+k-1] + } + keyword[SZ_KEYWORD+1] = EOS + + char_type = Memc[par+LOCN_DTYPE-1] # data type + switch (char_type) { + case 'r': + dtype = TY_REAL + case 'i': + dtype = TY_INT + case 'd': + dtype = TY_DOUBLE + case 'b': + dtype = TY_BOOL + default: + dtype = TY_CHAR + } + + # Find the comment, if any. + call tbhfcm (Memc[par], index) + + # If there is a comment, chop it off. + if (index > 0) { + # Backspace over whitespace. + while (index > START_OF_VALUE) { + if (IS_WHITE(Memc[par+index-2])) # element is [index-1] + index = index - 1 + else + break + } + Memc[par+index-1] = EOS + } + + # Copy the portion of the record containing the value to output. + ip = START_OF_VALUE + if (Memc[par+ip-1] == '"' || Memc[par+ip-1] == '\'') + nchar = ctowrd (Memc[par], ip, str, SZ_PARREC) + else + call strcpy (Memc[par+ip-1], str, SZ_PARREC) + + # Trim trailing blanks. + do ip = strlen (str), 1, -1 { + if (str[ip] == ' ') + str[ip] = EOS + else + break + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhgt.x b/pkg/tbtables/tbhgt.x new file mode 100644 index 00000000..d7ebe759 --- /dev/null +++ b/pkg/tbtables/tbhgt.x @@ -0,0 +1,244 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Get a parameter from the table header. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 22-Jan-1993 Change "== INDEFD" to "IS_INDEFD". +# Phil Hodge, 15-Dec-1994 Allow converting from text string parameter. +# Phil Hodge, 30-Mar-1995 Include keyword name in error message. +# Phil Hodge, 8-Jun-1995 Modify for FITS tables. +# Phil Hodge, 7-Jun-1999 In tbhgtb, check for "yes", "y", "no", "n", +# "true", "t", "false", "f" if a numerical value was not +# found and data type is text. + +# tbhgtb -- get Boolean header parameter +# Get a parameter from the table header. This is for data type bool. + +bool procedure tbhgtb (tp, keyword) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if keyword was found) +double dblval # buffer for reading value from string +bool bval # buffer for value +int nscan() +bool streq() +errchk tbhfkr, tbfhgb + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhgb (tp, keyword, bval) + return (bval) + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call tbhfkr (tp, keyword, dtype, Memc[par], parnum) # find keyword + if (parnum > 0) { + dblval = INDEFD + call sscan (Memc[par]) + call gargd (dblval) # read the value as a double + if (nscan() < 1 && dtype == TY_CHAR) { + call strlwr (Memc[par]) + if (streq (Memc[par], "yes") || streq (Memc[par], "y") || + streq (Memc[par], "true") || streq (Memc[par], "t")) { + dblval = double(YES) + } else if (streq (Memc[par], "no") || streq (Memc[par], "n") || + streq (Memc[par], "false") || streq (Memc[par], "f")) { + dblval = double(NO) + } + } + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhgtb: table header parameter `%s' not found") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + call sfree (sp) + + if (IS_INDEFD (dblval)) + return (false) + else if (nint(dblval) == YES) + return (true) + else + return (false) +end + + +# tbhgtd -- get double header parameter +# Get a parameter from the table header. This is for data type double. + +double procedure tbhgtd (tp, keyword) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if keyword was found) +double dblval # buffer for reading value from string +errchk tbhfkr, tbfhgd + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhgd (tp, keyword, dblval) + return (dblval) + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call tbhfkr (tp, keyword, dtype, Memc[par], parnum) # find keyword + if (parnum > 0) { + dblval = INDEFD + call sscan (Memc[par]) + call gargd (dblval) + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhgtd: table header parameter `%s' not found") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + call sfree (sp) + + return (dblval) +end + + +# tbhgti -- get integer header parameter +# Get a parameter from the table header. This is for data type int. + +int procedure tbhgti (tp, keyword) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if keyword was found) +double dblval # buffer for reading value from string +int ival +errchk tbhfkr, tbfhgi + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhgi (tp, keyword, ival) + return (ival) + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call tbhfkr (tp, keyword, dtype, Memc[par], parnum) # find keyword + if (parnum > 0) { + dblval = INDEFD + call sscan (Memc[par]) + call gargd (dblval) # read the value as a double + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhgti: table header parameter `%s' not found") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + call sfree (sp) + + if (IS_INDEFD (dblval)) + return (INDEFI) + else + return (nint(dblval)) +end + + +# tbhgtr -- get real header parameter +# Get a parameter from the table header. This is for data type real. + +real procedure tbhgtr (tp, keyword) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter to get +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if keyword was found) +real realval # buffer for reading value from string +errchk tbhfkr, tbfhgr + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhgr (tp, keyword, realval) + return (realval) + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call tbhfkr (tp, keyword, dtype, Memc[par], parnum) # find keyword + if (parnum > 0) { + realval = INDEFR + call sscan (Memc[par]) + call gargr (realval) + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhgtr: table header parameter `%s' not found") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + call sfree (sp) + + return (realval) +end + + +# tbhgtt -- get character header parameter +# Get a parameter from the table header. This is for character data type. + +procedure tbhgtt (tp, keyword, text, maxch) + +pointer tp # i: pointer to table descriptor +char keyword[ARB] # i: name of parameter +char text[ARB] # o: value of parameter +int maxch # i: maximum number of characters to get +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if keyword was found) +errchk tbhfkr, tbfhgt + +begin + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhgt (tp, keyword, text, maxch) + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + call tbhfkr (tp, keyword, dtype, Memc[par], parnum) # find keyword + if (parnum > 0) { + call strcpy (Memc[par], text, maxch) + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhgtt: table header parameter `%s' not found") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + call sfree (sp) +end diff --git a/pkg/tbtables/tbhisc.x b/pkg/tbtables/tbhisc.x new file mode 100644 index 00000000..7e6baee1 --- /dev/null +++ b/pkg/tbtables/tbhisc.x @@ -0,0 +1,35 @@ +include +include + +# tbhisc -- is the keyword a comment? +# If the input keyword is blank or is "history" or "comment" then this +# procedure returns true. Actual blanks and tabs are both considered +# to be blank, and the search for non-blank characters ends with EOS +# or with the end of the keyword. + +bool procedure tbhisc (keyword) + +char keyword[ARB] # Name of parameter + +char uckey[SZ_KEYWORD] # keyword converted to upper case +int k # loop index +bool streq() + +begin + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + + if (streq (uckey, "HISTORY")) + return (true) + else if (streq (uckey, "COMMENT")) + return (true) + else { + do k = 1, SZ_KEYWORD { + if (uckey[k] == EOS) + return (true) + else if (!IS_WHITE(uckey[k])) + return (false) + } + return (true) + } +end diff --git a/pkg/tbtables/tbhkeq.x b/pkg/tbtables/tbhkeq.x new file mode 100644 index 00000000..c77c27e3 --- /dev/null +++ b/pkg/tbtables/tbhkeq.x @@ -0,0 +1,30 @@ +include + +# tbhkeq -- keywords equal? +# This procedure compares an SPP string (i.e. one terminated with an EOS) +# with the keyword at the beginning of a parameter record. Such a keyword +# is padded on the right with blanks rather than being terminated with EOS. +# There must not be any embedded blanks in the keyword. + +# Phil Hodge, 10-Jul-91 Remove unnecessary ELSE before last IF statement. + +bool procedure tbhkeq (sppstr, parrec) + +char sppstr[SZ_KEYWORD] # i: string terminated with EOS +char parrec[SZ_PARREC] # i: parameter record; keyword is blank padded +#-- +int k + +begin + do k = 1, SZ_KEYWORD { + if (sppstr[k] == EOS) { + if (parrec[k] == ' ') + return (true) + else + return (false) + } + if (sppstr[k] != parrec[k]) + return (false) + } + return (true) +end diff --git a/pkg/tbtables/tbhpcm.x b/pkg/tbtables/tbhpcm.x new file mode 100644 index 00000000..a8c6d890 --- /dev/null +++ b/pkg/tbtables/tbhpcm.x @@ -0,0 +1,117 @@ +include # for IS_WHITE +include +include "tbtables.h" + +# tbhpcm -- add a comment to a header parameter +# This adds a comment to a header parameter, or replaces one that is +# already there. It is an error if the header parameter is not found. +# Nothing is done if the table is of type text; we can't find the +# keyword in the header because there is no header. If the keyword +# is HISTORY, COMMENT, or blank, this routine returns without adding +# anything and without error. +# +# Phil Hodge, 6-Mar-1995 Subroutine created. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 12-May-1995 Change string delimiter from " to '. +# Phil Hodge, 14-Jun-1995 Modify for FITS tables. +# Phil Hodge, 7-Jun-1999 Handle text tables. + +procedure tbhpcm (tp, keyword, comment) + +pointer tp # i: pointer to table descriptor +char keyword[SZ_KEYWORD] # i: keyword to be found +char comment[ARB] # i: comment string for keyword +#-- +pointer sp +pointer str # scratch for string read from header +pointer value # scratch for the string value +pointer errmsg # scratch for possible error message +int parnum # number of the parameter +int ip, nchar, ctowrd() +int strlen() +bool tbhisc() +errchk tbfpcm, tbhfkw, tbhrpr, tbhwpr + +begin + if (comment[1] == EOS) + return + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfpcm (tp, keyword, comment) + TB_MODIFIED(tp) = true + return + } + + # We don't add a comment to a comment. + if (tbhisc (keyword)) + return + + call smark (sp) + call salloc (str, SZ_PARREC, TY_CHAR) + call salloc (value, SZ_PARREC, TY_CHAR) + + # Find the keyword in the header. + call tbhfkw (tp, keyword, parnum) + if (parnum < 1) { + call salloc (errmsg, SZ_FNAME, TY_CHAR) + call sprintf (Memc[errmsg], SZ_FNAME, + "tbhpcm: keyword `%s' not found in table `%s'") + call pargstr (keyword) + call pargstr (TB_NAME(tp)) + call error (1, Memc[errmsg]) + } + + # Read the string containing keyword, datatype, value. + call tbhrpr (tp, parnum, Memc[str]) + + # If the data type is text, we'll either use ctowrd or take the + # entire string as the current value, depending on whether it's + # already enclosed in quotes. + if (Memc[str+LOCN_DTYPE-1] == 't') { # type is text string? + + if (Memc[str+START_OF_VALUE-1] == '"' || + Memc[str+START_OF_VALUE-1] == '\'') { + + # It's enclosed in quotes, so use ctowrd to get current value. + ip = START_OF_VALUE + nchar = ctowrd (Memc[str], ip, Memc[value], SZ_PARREC) + + } else { + + # If the value is already so long that we can't even enclose + # it in quotes, quit now. + if (strlen (Memc[str]) > SZ_PARREC-2) { + call sfree (sp) + return + } + + # Save the value. + call strcpy (Memc[str+START_OF_VALUE-1], Memc[value], SZ_PARREC) + } + + # Enclose the value in quotes, and copy it and the comment to str. + Memc[str+START_OF_VALUE-1] = EOS # truncate after dtype + call strcat ("'", Memc[str], SZ_PARREC) + call strcat (Memc[value], Memc[str], SZ_PARREC) + call strcat ("' ", Memc[str], SZ_PARREC) + call strcat (comment, Memc[str], SZ_PARREC) + + } else { # numeric datatype + + # Save the value. + ip = START_OF_VALUE + nchar = ctowrd (Memc[str], ip, Memc[value], SZ_PARREC) + + Memc[str+START_OF_VALUE-1] = EOS # truncate + call strcat (Memc[value], Memc[str], SZ_PARREC) + call strcat (" ", Memc[str], SZ_PARREC) + call strcat (comment, Memc[str], SZ_PARREC) + } + + # Write the string back into the table. + call tbhwpr (tp, parnum, Memc[str]) + + TB_MODIFIED(tp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhpnp.x b/pkg/tbtables/tbhpnp.x new file mode 100644 index 00000000..e6a53cea --- /dev/null +++ b/pkg/tbtables/tbhpnp.x @@ -0,0 +1,179 @@ +include # for IS_WHITE +include +include "tbtables.h" + +# tbhpnp -- put Nth parameter +# Write the keyword and value string of parameter number parnum. +# A keyword may not contain embedded blanks. +# +# Trailing whitespace will be ignored when writing the +# value (str) to the table. If the keyword is HISTORY, COMMENT, or +# blank, the value will be written without enclosing quotes, and no +# comment may be appended. If the parameter is of type text, and the +# string is not too long, it will be enclosed in double quotes before +# being written to the table. (If it is too long, no quotes will be +# used, and therefore no comment may be appended.) If the parameter is +# already present in the table, and if there is an associated comment, +# the comment will be preserved. If the buffer is not long enough to +# contain both the string value and comment, the comment will be silently +# truncated. +# +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 6-Mar-1995 Preserve comment when writing existing parameter; +# enclose string in quotes if parameter is of type text; +# ignore leading and trailing whitespace. +# Phil Hodge, 12-May-1995 Change string delimiter from " to '. +# Phil Hodge, 27-Nov-1995 Modify for FITS tables. +# Phil Hodge, 30-Jan-1996 Set TB_MODIFIED to true. +# Phil Hodge, 2-Jul-1998 Set value to 1 or 0 for boolean parameter. +# Frank Valdes, 29-Nov-2003 Don't eliminate leading whitespace in text. + +procedure tbhpnp (tp, parnum, keyword, dtype, str) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be put +char keyword[SZ_KEYWORD] # i: keyword for the parameter +int dtype # i: data type (TY_CHAR, etc) +char str[ARB] # i: string containing the value of the param. +#-- +pointer sp +pointer str2 # copy of str, without leading & trailing blanks +pointer par # buffer for parameter record +pointer oldpar # buffer for existing parameter record, if any +char uckey[SZ_KEYWORD] # keyword converted to upper case +int k # loop index for copying keyword +int char_type # data type as a letter (t, b, i, r, d) +int index # location of comment in string +int strlen(), strncmp() +bool streq() +bool tbhisc() +errchk tbfpnp, tbhwpr, tbhrpr + +begin + if (parnum < 1 || parnum > TB_MAXPAR(tp)) + call error (1, "tbhpnp: parnum out of range") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfpnp (tp, parnum, keyword, dtype, str) + TB_MODIFIED(tp) = true + return + } + + call smark (sp) + call salloc (str2, SZ_PARREC, TY_CHAR) + call salloc (par, SZ_PARREC, TY_CHAR) + call salloc (oldpar, SZ_PARREC, TY_CHAR) + + # We must have an upper case keyword. + call strcpy (keyword, uckey, SZ_KEYWORD) + call strupr (uckey) + + # Copy str to scratch, deleting trailing whitespace. + + call strcpy (str, Memc[str2], SZ_PARREC) + + # Delete trailing blanks in scr2. + k = strlen (Memc[str2]) + while (IS_WHITE(Memc[str2+k-1]) && k > 0) { + Memc[str2+k-1] = EOS + k = k - 1 + } + + # Fill the beginning portion of the output buffer with blanks. + # This includes the keyword portion (which must be padded with + # blanks) but also includes the datatype. Put the EOS at the + # point where the string value would start. + do k = 1, START_OF_VALUE-1 { + Memc[par+k-1] = ' ' + Memc[oldpar+k-1] = ' ' + } + Memc[par+START_OF_VALUE-1] = EOS + Memc[oldpar+START_OF_VALUE-1] = EOS + + # Read the current value, if the parameter already exists, + # and make sure we really do have the parameter. + if (parnum <= TB_NPAR(tp)) + call tbhrpr (tp, parnum, Memc[oldpar]) + if (strncmp (uckey, Memc[oldpar], strlen (uckey)) != 0) + Memc[oldpar] = EOS # nope; it's a new parameter + + # Copy the upper-case keyword (but not the EOS) to the output buffer. + do k = 1, SZ_KEYWORD { + if (uckey[k] == EOS) { + break + } + Memc[par+k-1] = uckey[k] + } + + switch (dtype) { + case TY_REAL: + char_type = 'r' + case TY_INT: + char_type = 'i' + case TY_DOUBLE: + char_type = 'd' + case TY_BOOL: + char_type = 'b' + default: + char_type = 't' + } + Memc[par+LOCN_DTYPE-1] = char_type # data type (char const) + + Memc[par+LOCN_DTYPE] = EOS # so we can use strcat + + # Copy the string containing the value to the output buffer. + if (char_type == 't') { + + # Check whether we have enough space to add quotes. + # The total space available for the parameter value is + # SZ_PARREC - START_OF_VALUE + 1. + if (strlen (Memc[str2]) > SZ_PARREC - START_OF_VALUE - 1 || + tbhisc (keyword)) { + + # Just append the value. Set index to zero, implying that + # there's no existing comment, because we can't write one + # if there are no enclosing quotes. + call strcat (Memc[str2], Memc[par], SZ_PARREC) + index = 0 # no comment allowed + + } else { + + # Enclose in quotes. + call strcat ("'", Memc[par], SZ_PARREC) + call strcat (Memc[str2], Memc[par], SZ_PARREC) + call strcat ("'", Memc[par], SZ_PARREC) + + # Find the comment, if there is one, in the existing parameter. + call tbhfcm (Memc[oldpar], index) + } + + } else if (dtype == TY_BOOL) { + + call strlwr (Memc[str2]) + if (streq (Memc[str2], "1") || + streq (Memc[str2], "yes") || streq (Memc[str2], "y") || + streq (Memc[str2], "true") || streq (Memc[str2], "t")) + call strcat ("1", Memc[par], SZ_PARREC) + else + call strcat ("0", Memc[par], SZ_PARREC) + call tbhfcm (Memc[oldpar], index) # find comment + + } else { + + call strcat (Memc[str2], Memc[par], SZ_PARREC) + call tbhfcm (Memc[oldpar], index) # find comment + } + + if (index > 0) { + # A comment was found; concatenate it to the parameter record. + call strcat (" ", Memc[par], SZ_PARREC) + call strcat (Memc[oldpar+index-1], Memc[par], SZ_PARREC) + } + + # Write the parameter record to the table. + call tbhwpr (tp, parnum, Memc[par]) + + TB_MODIFIED(tp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbhpt.x b/pkg/tbtables/tbhpt.x new file mode 100644 index 00000000..82a0bb10 --- /dev/null +++ b/pkg/tbtables/tbhpt.x @@ -0,0 +1,268 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Put a keyword and value into the table header. It is an error (except +# for FITS tables) if the keyword does not already exist. +# +# Phil Hodge, 7-Aug-1987 Do not allow adding new parameter. +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 9-Mar-1989 Change dtype from char to int. +# Phil Hodge, 21-Jul-1992 Change format in tbhptd to %25.16g. +# Phil Hodge, 30-Mar-1995 Include keyword name in error message. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 13-Jun-1995 Modify for FITS tables. + +# tbhptd -- put double header parameter + +procedure tbhptd (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +double value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() +errchk tbhfkw, tbhpnp, tbfhpd + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhptd: may not put numeric parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpd (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) { + dtype = TY_DOUBLE + call sprintf (Memc[par], SZ_PARREC, "%-25.16g") + call pargd (value) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhptd: `%s' not found; use tbhadd to add new parameter") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhptr -- put real header parameter + +procedure tbhptr (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +real value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() +errchk tbhfkw, tbhpnp, tbfhpr + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhptr: may not put numeric parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpr (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) { + dtype = TY_REAL + call sprintf (Memc[par], SZ_PARREC, "%-15.7g") + call pargr (value) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhptr: `%s' not found; use tbhadr to add new parameter") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhpti -- put integer header parameter + +procedure tbhpti (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +int value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() +errchk tbhfkw, tbhpnp, tbfhpi + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhpti: may not put numeric parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpi (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) { + dtype = TY_INT + call sprintf (Memc[par], SZ_PARREC, "%-11d") + call pargi (value) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhpti: `%s' not found; use tbhadi to add new parameter") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +procedure tbhptb (tp, keyword, value) + +pointer tp # i: Pointer to table descriptor +bool value # i: Value of parameter +char keyword[ARB] # i: Name of parameter +#-- +pointer sp +pointer par # buffer for header record for parameter +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if found) +int intval # buffer for writing value into string +bool tbhisc() +errchk tbhfkw, tbhpnp, tbfhpb + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (tbhisc (keyword)) + call error (ER_TBDTYPECONFLICT, + "tbhptb: may not put Boolean parameter as comment or history") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpb (tp, keyword, value) + TB_MODIFIED(tp) = true + return + } + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) { + dtype = TY_BOOL + if (value) + intval = YES + else + intval = NO + call sprintf (Memc[par], SZ_PARREC, "%-11d") + call pargi (intval) + call tbhpnp (tp, parnum, keyword, dtype, Memc[par]) # put Nth param. + } else { + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhptb: `%s' not found; use tbhadb to add new parameter") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + + TB_MODIFIED(tp) = true + + call sfree (sp) +end + +# tbhptt -- put character header parameter + +procedure tbhptt (tp, keyword, text) + +pointer tp # i: Pointer to table descriptor +char keyword[ARB] # i: Name of parameter +char text[ARB] # i: Value of parameter +#-- +pointer sp +pointer errmess # scratch for possible error message +int dtype # data type +int parnum # parameter number (> 0 if found) +bool tbhisc() # true if keyword is comment or history +errchk tbhfkw, tbhpnp, tbfhpt + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfhpt (tp, keyword, text) + TB_MODIFIED(tp) = true + return + } + + dtype = TY_CHAR + + if (tbhisc (keyword)) { # comment or history? + call error (ER_TBMUSTADD, + "use tbhadt, not tbhptt, to add new comment or history") + } else { + call tbhfkw (tp, keyword, parnum) # find keyword + if (parnum > 0) { + call tbhpnp (tp, parnum, keyword, dtype, text) # put Nth param. + } else { + call smark (sp) + call salloc (errmess, SZ_LINE, TY_CHAR) + call sprintf (Memc[errmess], SZ_LINE, + "tbhptt: `%s' not found; use tbhadt to add new parameter") + call pargstr (keyword) + call error (ER_TBPARNOTFND, Memc[errmess]) + } + } + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbhrpr.x b/pkg/tbtables/tbhrpr.x new file mode 100644 index 00000000..48b5f97d --- /dev/null +++ b/pkg/tbtables/tbhrpr.x @@ -0,0 +1,140 @@ +include +include # for IS_WHITE, IS_LOWER, TO_UPPER +include +include "tbtables.h" + +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbhrpr -- read parameter record +# This procedure reads a packed header parameter record, unpacks it, and +# returns the record containing keyword and value. +# +# Phil Hodge, 14-Feb-1992 Add option for text table type. +# Phil Hodge, 25-Apr-1994 Set str to "" for text table. +# Phil Hodge, 10-Jun-1999 Handle text tables. +# Phil Hodge, 10-May-2000 For text tables, check for history or comment +# when determining the data type. + +procedure tbhrpr (tp, parnum, str) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be gotten +char str[SZ_PARREC] # o: string containing the keyword and value +#-- +pointer sp +pointer par # scratch for reading the keyword +pointer word # value extracted from str +int i, ip, op # loop indexes +int maxch # length of keyword string +bool done +int datatype # data type of parameter +int width, prec, fcode # returned by tbbwrd and ignored +int tbbwrd() +int stat +long locn # location for reading in file +int ch # a character in the string +int read(), strlen() +bool streq() +errchk seek, read + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + + if (parnum < 1 || parnum > TB_NPAR(tp)) { + str[1] = EOS + return + } + + maxch = max (strlen (Memc[TB_KEYWORD(tp,parnum)]), SZ_PARREC) + call smark (sp) + call salloc (par, maxch, TY_CHAR) + + call strcpy (Memc[TB_KEYWORD(tp,parnum)], Memc[par], maxch) + + # Copy out the keyword, converting to upper case. + ip = 3 # zero indexed + while (IS_WHITE(Memc[par+ip])) + ip = ip + 1 + op = 1 + done = false + while (!done) { + ch = Memc[par+ip] + if (IS_LOWER(ch)) { + str[op] = TO_UPPER(ch) + } else if (IS_WHITE(ch) || ch == '=' || ch == EOS) { + str[op] = ' ' + done = true + } else { + str[op] = ch + } + op = op + 1 + if (op > SZ_KEYWORD) + done = true + if (!done) + ip = ip + 1 + } + # We're done with op after the following, but we still need ip. + do i = op, SZ_KEYWORD + str[i] = ' ' # pad keyword with blanks + str[SZ_KEYWORD+1] = EOS + + # Have we truncated the keyword? + if (!IS_WHITE(ch) && ch != '=') { + # Skip over the rest of the keyword in the input string. + done = false + while (!done) { + ch = Memc[par+ip] + if (IS_WHITE(ch) || ch == '=') { + done = true + } else if (ch == EOS) { # a blank value + call strcat ("t", str, SZ_PARREC) + call sfree (sp) + return + } else { + ip = ip + 1 + } + } + } + + # Skip over any intervening whitespace, allowing for one '='. + while (IS_WHITE(Memc[par+ip])) + ip = ip + 1 + if (Memc[par+ip] == '=') + ip = ip + 1 + while (IS_WHITE(Memc[par+ip])) + ip = ip + 1 + + # Now ip (zero indexed) is the beginning of the value. + # Determine the data type. + call salloc (word, maxch, TY_CHAR) + i = ip + 1 # one indexed + if (streq (str, "HISTORY ") || streq (str, "COMMENT ")) { + datatype = TY_CHAR + } else if (tbbwrd (Memc[par], i, Memc[word], maxch, + width, prec, datatype, fcode) < 1) { + datatype = TY_CHAR + } + + # Append the data type code and the value. + if (datatype == TY_DOUBLE) + call strcat ("d", str, SZ_PARREC) + else if (datatype == TY_INT) + call strcat ("i", str, SZ_PARREC) + else if (datatype == TY_BOOL) + call strcat ("b", str, SZ_PARREC) + else + call strcat ("t", str, SZ_PARREC) + + call strcat (Memc[par+ip], str, SZ_PARREC) + + call sfree (sp) + + } else { + + locn = SZ_PACKED_REC * (parnum - 1) + SZ_SIZINFO + 1 + + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), str, SZ_PACKED_REC) + call strupk (str, str, SZ_PARREC) + } +end diff --git a/pkg/tbtables/tbhwpr.x b/pkg/tbtables/tbhwpr.x new file mode 100644 index 00000000..ea2da0b9 --- /dev/null +++ b/pkg/tbtables/tbhwpr.x @@ -0,0 +1,103 @@ +include +include # for IS_WHITE, IS_LOWER, TO_UPPER +include +include "tbtables.h" + +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbhwpr -- write parameter record +# This procedure takes as input a string containing a header parameter record +# (keyword and value), packs it, and writes the packed string to the table. +# +# This routine supports STSDAS format tables and text tables, but not FITS +# tables. +# +# For text tables, the input string can be in one of two formats, STSDAS +# table format or text table format. STSDAS format is: +# keyword tvalue comment +# where t is a data type code. t is the ninth character, and the value +# begins with the tenth character. +# Text table format is nearly free format, except that it must begin with +# "#k " or "#K ": +# #k keyword = value comment +# +# Phil Hodge, 14-Feb-1992 Add option for text table type. +# Phil Hodge, 22-Apr-1994 For text table, append to comment buffer. +# Phil Hodge, 7-Jun-1999 Call tbzkey instead of tbbcmt for text table. + +procedure tbhwpr (tp, parnum, str) + +pointer tp # i: pointer to table descriptor +int parnum # i: number of the parameter to be written +char str[ARB] # i: string containing the keyword and value +#-- +pointer sp +pointer par # for reformatting, or for a packed copy of str +int maxch # size of str, plus extra space +int ip, op # loop indexes +int ch # a character in the keyword +bool done +long locn # location for reading in file +int strlen(), strncmp() +errchk seek, write, tbzkey + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + + # Allow extra space, for "#k " and two spaces around "=". + maxch = max (SZ_FNAME, strlen (str) + 5) + call smark (sp) + call salloc (par, maxch, TY_CHAR) + + # Add to list of keywords in memory. + + if (strncmp (str, "#k ", 3) == 0 || strncmp (str, "#K ", 3) == 0) { + + # str is already in text table format, but make sure the + # keyword is upper case. + call strcpy (str, Memc[par], maxch) + ip = 3 # zero indexed + while (IS_WHITE(Memc[par+ip])) + ip = ip + 1 + done = false + while (!done) { + ch = Memc[par+ip] + if (IS_LOWER(ch)) + Memc[par+ip] = TO_UPPER(ch) + if (IS_WHITE(ch) || ch == '=' || ch == EOS) + done = true + } + + } else { + + # STSDAS format; prepend "#k ", and replace the data type + # code with " = ". + call strcpy ("#k ", Memc[par], maxch) + op = strlen (Memc[par]) # zero indexed + do ip = 1, SZ_KEYWORD { + Memc[par+op] = str[ip] + op = op + 1 + } + Memc[par+op] = EOS + call strcat (" = ", Memc[par], maxch) + call strcat (str[START_OF_VALUE], Memc[par], maxch) + } + + call tbzkey (tp, Memc[par], parnum) + call sfree (sp) + + } else { + + call smark (sp) + call salloc (par, SZ_PARREC, TY_CHAR) + + locn = SZ_PACKED_REC * (parnum - 1) + SZ_SIZINFO + 1 + + call seek (TB_FILE(tp), locn) + call strpak (str, Memc[par], SZ_PARREC) + call write (TB_FILE(tp), Memc[par], SZ_PACKED_REC) + call flush (TB_FILE(tp)) + + call sfree (sp) + } +end diff --git a/pkg/tbtables/tblerr.h b/pkg/tbtables/tblerr.h new file mode 100644 index 00000000..9b0b10f2 --- /dev/null +++ b/pkg/tbtables/tblerr.h @@ -0,0 +1,31 @@ +# tblerr.h -- error codes for table I/O routines +# +# Phil Hodge, 30-Sep-1987 Change numbers and reorganize. +# Phil Hodge, 2-Jun-1989 Remove 4867 from error numbers. +# Phil Hodge, 22-Oct-2004 Add ER_BYTESWAPPED. + +define ER_TBNAMTOOLONG 01 # file name (incl extension) is too long +define ER_TBBADMODE 02 # I/O mode is not supported for a table +define ER_TBREADONLY 03 # attempt to modify a readonly table + +define ER_TBTOOLATE 31 # too late, table is already open +define ER_TBNOTOPEN 32 # table must be open for this option +define ER_TBBADOPTION 33 # invalid option for tbpset +define ER_TBUNKPARAM 34 # unknown parameter for tbpsta + +define ER_TBCOLEXISTS 41 # column already exists +define ER_TBBADTYPE 42 # invalid data type for a table column + +define ER_TBBEYONDEOF 51 # requested row is beyond EOF + +define ER_TBPARNOTFND 61 # header parameter not found +define ER_TBMUSTADD 62 # new parameter must be added, not put +define ER_TBDTYPECONFLICT 63 # can't put numeric parameter as comment + +define ER_TBCORRUPTED 81 # table or memory is corrupted +define ER_TBCOLBADTYP 82 # bad data type (memory corrupted?) +define ER_TBFILEMPTY 83 # table data file is empty +define ER_TBCINFMISSING 84 # EOF while reading column info +define ER_BYTESWAPPED 85 # table appears to be byte-swapped + +define ER_TBCONVERT 91 # table cannot be converted diff --git a/pkg/tbtables/tblfits.h b/pkg/tbtables/tblfits.h new file mode 100644 index 00000000..1e79ce56 --- /dev/null +++ b/pkg/tbtables/tblfits.h @@ -0,0 +1,25 @@ +# These definitions are for FITS BINTABLEs and the FITSIO interface. + +# These are values for the ORIGIN keyword to be added to new FITS files. +define FITS_ORIGIN "STScI-STSDAS/TABLES" +define FITS_ORIGIN_CMT "Tables version 2002-02-22" + +# These are the three possible values of hdutype (as returned by fsmahd, +# for example). +define TBL_FITS_IMAGE 0 # FITS IMAGE extension or primary HDU +define TBL_FITS_ASCII 1 # FITS ASCII table +define TBL_FITS_BINARY 2 # FITS BINTABLE + +# For defining 2-D char arrays. (values and names changed 1999 Mar 10 by PEH) +define SZ_FTTYPE 70 # size of character string for column name +define SZ_FTFORM 70 # size of character string for column format +define SZ_FTUNIT 70 # size of character string for column units + +# Undefined values for FITS BINTABLE. +define FITS_INDEFI (-2147483647) +define FITS_INDEFS (-32767) + +# Error return codes. +define FITS_END_OF_FILE 107 +define FITS_KEYWORD_MISSING 202 +define FITS_TNULL_NOT_SET 314 diff --git a/pkg/tbtables/tbltext.h b/pkg/tbtables/tbltext.h new file mode 100644 index 00000000..f870bb76 --- /dev/null +++ b/pkg/tbtables/tbltext.h @@ -0,0 +1,13 @@ +# These definitions are for text tables. + +define SZ_TEXTBUF (4096 + SZ_LINE) # size of input buffer + +# These are possible values for the line type as read by tbzlin: +define DATA_LINE 1 # column data +define COMMENT_LINE 2 # a comment (blank or beginning with #) +define KEYWORD_LINE 3 # a keyword (#k keyword = value) +define COLDEF_LINE 4 # explicit column definition (#c name etc.) + +# This is the initial size (and the increment in size) for the array of +# pointers to header keywords. +define INCR_N_KEYWORDS 128 diff --git a/pkg/tbtables/tbnopen.x b/pkg/tbtables/tbnopen.x new file mode 100644 index 00000000..3c2ab128 --- /dev/null +++ b/pkg/tbtables/tbnopen.x @@ -0,0 +1,241 @@ +# Table name template package, copied from the image template package imt.x. +# +# tnt = tbnopen (template) +# tnt = tbnopenp (clparam) +# tbnclose (tnt) +# nchars|EOF = tbnget (tnt, table, maxch) +# len = tbnlen (tnt) +# tbnrew (tnt) +# +# Phil Hodge, 8-Sep-1995 Copied from imt.x, names changed. + +define SZ_FNT 512 +define CH_DELIM 20B # used to flag brackets + +# TBNOPENP -- Open a table name template obtained as the string value of a CL +# parameter. + +pointer procedure tbnopenp (param) + +char param[ARB] # i: CL parameter with string value template +#-- +pointer sp, template, tnt +pointer tbnopen() +errchk clgstr + +begin + call smark (sp) + call salloc (template, SZ_LINE, TY_CHAR) + + call clgstr (param, Memc[template], SZ_LINE) + tnt = tbnopen (Memc[template]) + + call sfree (sp) + return (tnt) +end + +# TBNOPEN -- Open a table name template. + +pointer procedure tbnopen (template) + +char template[ARB] # i: table name template +#-- +int sort, level, ip, ch +pointer sp, listp, fnt, op +define output {Memc[op]=$1;op=op+1} +int fntopnb(), strlen() + +begin + call smark (sp) + call salloc (fnt, strlen(template)*12/10 + SZ_FNT, TY_CHAR) + + # Sorting is disabled as input and output templates, derived from the + # same database but with string editing used to modify the output list, + # may be sorted differently as sorting is performed upon the edited + # output list. + + sort = NO + + op = fnt + for (ip=1; template[ip] != EOS; ip=ip+1) { + ch = template[ip] + + if (ch == '[') { + if (ip > 1 && template[ip-1] == '!') { + # ![ -- Pass a [ to FNT (character class notation). + Memc[op-1] = '[' + + } else if (ip > 1 && template[ip-1] == '\\') { + # \[ -- The [ is part of the filename. Pass it on as an + # escape sequence to get by the FNT. + + output ('[') + + } else { + # [ -- Unescaped [. This marks the beginning of an + # extension name. Output `%%[...]%' and escape all + # pattern matching metacharacters until a comma template + # delimiter is encountered. Note that a comma within [] + # is not a template delimiter. + + output ('%') + output ('%') + output (CH_DELIM) + + level = 0 + for (; template[ip] != EOS; ip=ip+1) { + ch = template[ip] + if (ch == ',') { # , + if (level <= 0) + break # exit loop + else { + output ('\\') + output (ch) + } + } else if (ch == '[') { # [ + output ('\\') + output (ch) + level = level + 1 + } else if (ch == ']') { # ] + output (ch) + level = level - 1 + } else if (ch == '*') { # * + output ('\\') + output (ch) + } else { # normal chars + output (ch) + } + } + output ('%') + ip = ip - 1 + } + + } else if (ch == '@') { + # List file reference. Output the CH_DELIM code before the @ + # to prevent further translations on the table names + # returned from the list file, e.g., "CH_DELIM // @listfile". + + output (CH_DELIM) + output ('/') + output ('/') + output (ch) + + } else { + output (ch) + } + } + + Memc[op] = EOS + + listp = fntopnb (Memc[fnt], sort) + + call sfree (sp) + return (listp) +end + + +# TBNGET -- Get the next table name from the expanded list. +# EOF is returned if there are no more names. + +int procedure tbnget (tnt, outstr, maxch) + +pointer tnt # i: table template descriptor +char outstr[ARB] # o: output string +int maxch # i: max chars out +#-- +int nchars +pointer sp, buf +int fntgfnb(), tbn_mapname() +errchk fntgfnb + +begin + call smark (sp) + call salloc (buf, SZ_PATHNAME, TY_CHAR) + + if (fntgfnb (tnt, Memc[buf], SZ_PATHNAME) == EOF) { + outstr[1] = EOS + call sfree (sp) + return (EOF) + } + + nchars = tbn_mapname (Memc[buf], outstr, maxch) + call sfree (sp) + return (nchars) +end + + +# TBNLEN -- Return the number of table names in the expanded list. + +int procedure tbnlen (tnt) + +pointer tnt # i: table name template descriptor +#-- +int fntlenb() + +begin + return (fntlenb (tnt)) +end + + +# TBNREW -- Rewind the expanded table name list. + +procedure tbnrew (tnt) + +pointer tnt # i: table name template descriptor + +begin + call fntrewb (tnt) +end + + +# TBNCLOSE -- Close a table name template. + +procedure tbnclose (tnt) + +pointer tnt # io: table name template descriptor + +begin + call fntclsb (tnt) +end + + +# TBN_MAPNAME -- Translate the string returned by FNT into a table +# specification suitable for input to the table I/O routines. + +int procedure tbn_mapname (fnt, outstr, maxch) + +char fnt[ARB] # i: FNT string +char outstr[ARB] # o: output string +int maxch + +int ip, op + +begin + op = 1 + for (ip=1; fnt[ip] != EOS; ip=ip+1) { + if (fnt[ip] == '[') { + outstr[op] = '\\' + op = op + 1 + outstr[op] = '[' + op = op + 1 + + } else if (fnt[ip] == CH_DELIM) { + for (ip=ip+1; fnt[ip] != EOS; ip=ip+1) { + outstr[op] = fnt[ip] + op = op + 1 + if (op > maxch) + break + } + break + + } else { + outstr[op] = fnt[ip] + op = op + 1 + if (op > maxch) + break + } + } + + outstr[op] = EOS + return (op - 1) +end diff --git a/pkg/tbtables/tbnparse.x b/pkg/tbtables/tbnparse.x new file mode 100644 index 00000000..1e17bb0e --- /dev/null +++ b/pkg/tbtables/tbnparse.x @@ -0,0 +1,397 @@ +include +include +include + +# tbnparse -- extract different portions of table name +# For a table in a QPOE file, the user may give a table name such as +# stuff.qp[abc], where "stuff.qp" is the file name, and "abc" is the name +# of the QPOE parameter containing the table. +# +# For a FITS file, the user may explicitly specify the extension number, +# or the extension may be given by extension name (the value of the EXTNAME +# keyword) and/or version number (EXTVER). If the extension number was +# given explicitly, neither extension name nor version may be given, and +# they will be set to "" and -1 respectively on output. The numbering +# convention is that the first extension after the primary HDU is number +# one. (This differs from the convention in the FITSIO interface.) +# If the extension was specified by name and/or version rather than number, +# the HDU number will be set to -1. +# The overwrite flag is independent of the other information returned; +# +1 means yes, 0 means no, and -1 means overwrite was not specified. +# +# Phil Hodge, 2-Feb-1996 Subroutine created. +# Phil Hodge, 30-Sep-1997 Add rowselect, colselect, maxchsel to calling seq. +# Phil Hodge, 15-Jun-1998 For STDIN, STDOUT, or text file, set type to text. +# Phil Hodge, 12-Apr-1999 Remove table type from calling sequence. + +int procedure tbnparse (inputname, fname, extname, brackets, maxch, + extver, hdu, overwrite, + rowselect, colselect, maxchsel) + +char inputname[ARB] # i: name as specified by user +char fname[ARB] # o: name of file containing table +char extname[ARB] # o: extension name, or null if none +char brackets[ARB] # o: expression in brackets, or null if none +int maxch # i: size of fname and extname strings +int extver # o: extension version number, if specified +int hdu # o: HDU number for FITS file, if specified +int overwrite # o: YES, NO, or YES-1 --> not specified +char rowselect[ARB] # o: row selector string +char colselect[ARB] # o: column selector string +int maxchsel # i: max size of rowselect and colselect +#-- +int level, ip, op, ch # for extracting file name +pointer sp +pointer tablename # input name without selectors +pointer expr # scratch +int nchar # number of non-blank characters in inputname +int last_char # last character in file name before [ or \[ +int len_name # length of table name, ignoring trailing whitespace +int nbrackets # number of bracket pairs at end of file name +int localmax # size of local string +bool done +int nowhite() +int strlen() +errchk rdselect, tbnexpr + +begin + localmax = max (SZ_LINE, maxch, 2*maxchsel) + + # Check for blank input name. + call smark (sp) + call salloc (tablename, localmax, TY_CHAR) + call salloc (expr, localmax, TY_CHAR) + nchar = nowhite (inputname, Memc[expr], localmax) + if (nchar < 1) { + fname[1] = EOS + extname[1] = EOS + brackets[1] = EOS + rowselect[1] = EOS + colselect[1] = EOS + extver = -1 + hdu = -1 + overwrite = YES - 1 + call sfree (sp) + return (0) + } + + # Extract row and column selector strings, if any. + call rdselect (inputname, Memc[tablename], + rowselect, colselect, maxchsel) + + # Work backwards to find the first [ following the file name. + ip = strlen (Memc[tablename]) + while (IS_WHITE(Memc[tablename+ip-1])) + ip = ip - 1 # ignore trailing whitespace + len_name = ip + last_char = 0 + nbrackets = 0 + done = false + while (!done) { + + if (Memc[tablename+ip-1] == ']') { + + nbrackets = nbrackets + 1 + while (Memc[tablename+ip-1] != '[') { + ip = ip - 1 + if (ip < 1) + call error (1, "tbnparse: unmatched ] in file name") + if (Memc[tablename+ip-1] == ']') + call error (1, "tbnparse: nested brackets not allowed") + } + ip = ip - 1 # back up over the [ + + if (ip < 1) + done = true + else if (Memc[tablename+ip-1] == '\\') + ip = ip - 1 + + if (ip < 1) + done = true + + } else { + + last_char = ip + done = true + } + } + + if (last_char > maxch) + call error (1, "tbnparse: file name is too long") + else if (last_char < 1) + call error (1, "tbnparse: no file name specified") + + # Extract root name. + level = 0 + op = 1 + do ip = 1, last_char { + if (Memc[tablename+ip-1] == '[') + level = level + 1 + else if (Memc[tablename+ip-1] == ']') + level = level - 1 + fname[op] = Memc[tablename+ip-1] + op = op + 1 + } + fname[op] = EOS + if (level != 0) + call error (1, "tbnparse: unmatched bracket in file name") + + # Copy bracketed expression, if any, to output. + brackets[1] = EOS + call strcpy (inputname[last_char+1], brackets, maxch) + + # Extract the expression in brackets, if any. Exclude the brackets. + + level = 0 + ip = last_char + 1 + if (Memc[tablename+ip-1] == '[') + ip = ip + 1 # ignore initial open bracket + op = 1 + for (ch=Memc[tablename+ip-1]; ch != EOS; ch=Memc[tablename+ip-1]) { + if (op > maxch) + call error (1, "tbnparse: name in brackets is too long") + + if (ch == '"') { + if (level == 0) + level = 1 # beginning of a string + else + level = 0 # ending of a string + } + + # Delete or modify characters under certain conditions. + if (ch == '\\' && level == 0) { + ; + } else if (ch == ';' && level == 0) { + Memc[expr+op-1] = ',' # ; --> , + op = op + 1 + } else if (ch == ']' && ip >= len_name) { + ; # ignore final close bracket + } else if (ch == ']' && level == 0) { + # Replace multiple brackets with a comma. + if (Memc[tablename+ip] == '[') { + Memc[expr+op-1] = ',' + op = op + 1 + ip = ip + 1 + } else if (Memc[tablename+ip] == '\\') { + if (Memc[tablename+ip+1] == '[') { + Memc[expr+op-1] = ',' + op = op + 1 + ip = ip + 2 + } else { # but ]\ is probably a syntax error + Memc[expr+op-1] = ch + op = op + 1 + } + } else { + Memc[expr+op-1] = ch + op = op + 1 + } + } else { + Memc[expr+op-1] = ch + op = op + 1 + } + ip = ip + 1 + } + if (level > 0) + call error (1, "tbnparse: unmatched quote in table name") + + Memc[expr+op-1] = EOS + + # Now replace commas with spaces. We do this so we can use + # ctowrd instead of ctotok to get extname values. + for (ip = 1; Memc[expr+ip-1] != EOS; ip = ip + 1) { + if (Memc[expr+ip-1] == ',') + Memc[expr+ip-1] = ' ' + } + + # Parse the expression we just extracted into Memc[expr]. + call tbnexpr (Memc[expr], extname, maxch, extver, hdu, overwrite) + + call sfree (sp) + return (nchar) +end + +define TBN_EXTENSION 1 +define TBN_EXTNAME 2 +define TBN_EXTVER 3 +define TBN_OVERWRITE 4 + +# tbnexpr -- extract information from an expression appended to a table name + +procedure tbnexpr (expr, extname, maxch, extver, hdu, overwrite) + +char expr[ARB] # i: expression extracted from bracket(s) +char extname[ARB] # o: extension name +int maxch # i: max size of extname string +int extver # o: extension version number +int hdu # o: HDU number for FITS file +int overwrite # o: YES, NO, or YES-1 --> not specified +#-- +pointer sp +pointer token # scratch for the value of the token +pointer word # scratch +int t_class # token type +int option # index returned by strdic +int nchar, ip, ip_last, ip2 +int itemp +bool done +int ctotok(), ctoi(), ctowrd(), strdic() +bool streq() + +begin + extname[1] = EOS # initial values + extver = -1 + hdu = -1 + overwrite = YES - 1 + + if (expr[1] == EOS) + return + + call smark (sp) + call salloc (token, SZ_LINE, TY_CHAR) + call salloc (word, SZ_LINE, TY_CHAR) + + ip = 1 + done = false + while (!done) { + + ip_last = ip # save previous ip + t_class = ctotok (expr, ip, Memc[token], SZ_LINE) + + if (t_class == TOK_EOS || t_class == TOK_NEWLINE) { + done = true + + } else if (t_class == TOK_CHARCON) { + call error (1, "unrecognized character in table name") + + } else if (t_class == TOK_NUMBER) { + + # Is this actually an EXTNAME that begins with a number? + if (IS_ALPHA(expr[ip])) { + # Use ctowrd because ctotok would extract only the + # integer portion of e.g. 123xyz. + ip = ip_last # back up + nchar = ctowrd (expr, ip, extname, maxch) + } else { + ip2 = 1 + if (ctoi (Memc[token], ip2, itemp) < 1) + call error (1, "tbnparse: can't read HDU number") + + # If we already have an EXTNAME, assume this number is + # an EXTVER; otherwise, assume it's the extension number. + if (extname[1] != EOS) { + extver = itemp + } else if (extver > 0) { + call error (1, + "tbnparse: ambiguous number in table name") + } else { + hdu = itemp + if (hdu < 0) + call error (1, + "tbnparse: extension number can't be negative") + } + } + + } else if (t_class == TOK_IDENTIFIER) { + + call strcpy (Memc[token], Memc[word], SZ_LINE) + call strlwr (Memc[word]) + option = strdic (Memc[word], Memc[word], SZ_LINE, + "|extension|extname|extver|overwrite") + + if (option == TBN_EXTENSION) { + + if (hdu > 0) + call error (1, "can't specify extension number twice") + + t_class = ctotok (expr, ip, Memc[token], SZ_LINE) + if (Memc[token] != '=') + call error (1, "table name syntax: [extension=]") + if (ctoi (expr, ip, hdu) < 1) + call error (1, "tbnparse: can't read extension number") + if (hdu <= 0) + call error (1, "extension number must be positive") + + } else if (option == TBN_EXTNAME) { + + t_class = ctotok (expr, ip, Memc[token], SZ_LINE) + if (Memc[token] != '=') + call error (1, "table name syntax: [extname=]") + if (ctowrd (expr, ip, extname, maxch) < 1) + call error (1, "tbnparse: missing EXTNAME string") + + } else if (option == TBN_EXTVER) { + + t_class = ctotok (expr, ip, Memc[token], SZ_LINE) + if (Memc[token] != '=') + call error (1, "table name syntax: [extver=]") + if (ctoi (expr, ip, extver) < 1) + call error (1, "tbnparse: invalid EXTVER number") + + } else if (option == TBN_OVERWRITE) { + + # Get the '=' sign, if there is one, else get + or -. + ip2 = ip # save, so we can back up + t_class = ctotok (expr, ip, Memc[token], SZ_LINE) + + if (t_class == TOK_EOS || t_class == TOK_NEWLINE) { + overwrite = YES + done = true + } else if (t_class == TOK_PUNCTUATION) { + # "overwrite", i.e. without a value + overwrite = YES + } else if (streq (Memc[token], "]")) { + overwrite = YES + } else { + if (Memc[token] == '=') + t_class = ctotok (expr, ip, Memc[token], SZ_LINE) + call strcpy (Memc[token], Memc[word], SZ_LINE) + call strlwr (Memc[word]) + option = strdic (Memc[word], Memc[word], SZ_LINE, + "|+|yes|true|-|no|false") + if (option >= 1 && option <= 3) { + overwrite = YES + } else if (option >= 4 && option <= 6) { + overwrite = NO + } else { + overwrite = YES + ip = ip2 # back up + } + } + + } else if (option == 0) { + + # Could be either ambiguous or EXTNAME. + call strcpy (Memc[token], Memc[word], SZ_LINE) + call strlwr (Memc[word]) + if (streq (Memc[word], "e") || + streq (Memc[word], "ex") || + streq (Memc[word], "ext")) { + call strcpy ("`", Memc[word], SZ_LINE) + call strcat (expr, Memc[word], SZ_LINE) + call strcat ("' is ambiguous", Memc[word], SZ_LINE) + call error (1, Memc[word]) + } else { + # Take original value, not lower case copy. + call strcpy (Memc[token], extname, maxch) + } + } + + } else if (t_class == TOK_STRING) { + + call strcpy (Memc[token], extname, maxch) + + } else if (t_class == TOK_PUNCTUATION) { + ; + } else { + call strcpy ("syntax error: `[", Memc[word], SZ_LINE) + call strcat (expr, Memc[word], SZ_LINE) + call strcat ("]'", Memc[word], SZ_LINE) + call error (1, Memc[word]) + } + } + + if (hdu > 0 && overwrite != YES && + (extname[1] != EOS || extver > 0)) + call error (1, + "can't give extension number and EXTNAME or EXTVER") +end diff --git a/pkg/tbtables/tbparse.x b/pkg/tbtables/tbparse.x new file mode 100644 index 00000000..e47db257 --- /dev/null +++ b/pkg/tbtables/tbparse.x @@ -0,0 +1,67 @@ +include +include + +# tbparse -- extract different portions of table name +# For a table in a QPOE file, the user may give a table name such as +# stuff.qp[abc], where "stuff.qp" is the file name, and "abc" is the name +# of the QPOE parameter containing the table. +# +# For a FITS file, the user may give either the extension name (the value +# of the EXTNAME keyword) or the extension number. The convention for +# extension number is that the first extension after the primary HDU is +# number one. This differs from the convention in the FITSIO interface, +# where the primary HDU is number one, so other routines in the table I/O +# interface (tbfopn and tbfnew) will add one to that number. If the +# extension was specified by name rather than number, the HDU number will +# be set to -1. If no extension name or number was specified, the value +# returned as the HDU number will be -1. +# +# If the input name has one or more bracketed expressions at the end of the +# name (extension name, etc, for a FITS file, or row or column selectors), +# the bracketed expressions will be returned in the extname string. Note +# that even if this is just an EXTNAME, the string will include the brackets. +# +# Phil Hodge, 22-Dec-1994 Subroutine created based on qp_parse. +# Phil Hodge, 7-Sep-1995 Allow ".??f" as an extension for a FITS file. +# Phil Hodge, 22-Jan-1996 Allow escaped [ within the file name. +# Phil Hodge, 2-Feb-1996 Move the guts of this routine to tbnparse. +# Phil Hodge, 30-Sep-1997 Change calling sequence of tbnparse. +# Phil Hodge, 12-Apr-1999 Remove type from calling sequence; +# use SZ_FNAME instead of SZ_LINE for local buffers. + +int procedure tbparse (tablename, fname, extname, maxch, hdu) + +char tablename[ARB] # i: name as specified by user +char fname[ARB] # o: name of file containing table +char extname[ARB] # o: CDF name, or null if none +int maxch # i: size of fname and extname strings +int hdu # o: HDU number for FITS file, or -1 if none +#-- +pointer sp +pointer brackets # scratch for expression in brackets +pointer rowselect, colselect # ignored (selector strings) +pointer scratch +int localmax, nchar +int extver, overwrite # ignored +int tbnparse() +errchk tbnparse + +begin + localmax = max (SZ_FNAME, maxch) + + call smark (sp) + call salloc (brackets, localmax, TY_CHAR) + call salloc (scratch, localmax, TY_CHAR) + call salloc (rowselect, SZ_FNAME, TY_CHAR) + call salloc (colselect, SZ_FNAME, TY_CHAR) + + nchar = tbnparse (tablename, fname, Memc[scratch], Memc[brackets], + localmax, extver, hdu, overwrite, + Memc[rowselect], Memc[colselect], SZ_FNAME) + + call strcpy (Memc[brackets], extname, maxch) + + call sfree (sp) + + return (nchar) +end diff --git a/pkg/tbtables/tbpset.x b/pkg/tbtables/tbpset.x new file mode 100644 index 00000000..583f07eb --- /dev/null +++ b/pkg/tbtables/tbpset.x @@ -0,0 +1,109 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +# tbpset -- set parameter +# Set parameters in table descriptor. +# If record length is to be set or increased, the unit is SZ_REAL even +# though internally the unit is SZ_CHAR. +# +# Phil Hodge, 30-Sep-1987 FIO options added. +# Phil Hodge, 15-Nov-1988 Remove option to set buffer size. +# Phil Hodge, 8-Apr-1993 Modify for short by including TBL_ROWLEN_CHAR. +# Phil Hodge, 5-Oct-1995 Include check on file type when setting table type. +# Phil Hodge, 7-Jun-1999 Add table subtype; delete TB_F_TYPE; +# use SZ_FNAME instead of SZ_LINE for error message. +# Phil Hodge, 11-Jul-2003 Return without doing anything when called to +# change the table type of STDOUT or STDERR. + +procedure tbpset (tp, setwhat, value) + +pointer tp # i: pointer to table descriptor +int setwhat # i: specifies what parameter is to be set +int value # i: the value that is to be assigned +#-- +pointer sp, errmess # for possible error message +bool streq() +errchk tbcchg, tbrchg, tbtchs, tbtfst + +begin + switch (setwhat) { + + case (TBL_ROWLEN): # Specify what row length to allocate + call tbcchg (tp, value*SZ_REAL) # unit = SZ_REAL + + case (TBL_ROWLEN_CHAR): # Specify what row length to allocate + call tbcchg (tp, value) # unit = SZ_CHAR + + case (TBL_INCR_ROWLEN): # Increase row length; unit = SZ_REAL + call tbcchg (tp, TB_ROWLEN(tp) + value * SZ_REAL) + + case (TBL_ALLROWS): # Number of rows to allocate + call tbrchg (tp, value) + + case (TBL_INCR_ALLROWS): # Increase allocated number of rows + call tbrchg (tp, TB_ALLROWS(tp) + value) + + case (TBL_WHTYPE): # Specify table type + + if (value != TBL_TYPE_S_ROW && value != TBL_TYPE_S_COL && + value != TBL_TYPE_TEXT && value != TBL_TYPE_FITS) { + call smark (sp) + call salloc (errmess, SZ_FNAME, TY_CHAR) + call sprintf (Memc[errmess], SZ_FNAME, + "tbpset: %d is not a valid table type") + call pargi (value) + call error (1, Memc[errmess]) + } + + if (TB_IS_OPEN(tp)) + call error (ER_TBTOOLATE, + "can't specify table type after opening table") + + # Can't set type of table for FITS file or CDF file. + if (TB_TYPE(tp) == TBL_TYPE_FITS || value == TBL_TYPE_FITS) + return + if (TB_TYPE(tp) == TBL_TYPE_CDF || value == TBL_TYPE_CDF) + return + + # Can't change the type of STDOUT or STDERR. + if (streq (TB_NAME(tp), "STDOUT") || streq (TB_NAME(tp), "STDERR")) + return + + TB_TYPE(tp) = value + + case (TBL_SUBTYPE): # Specify table subtype + + # Can only set subtype for text tables. + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + if (value == TBL_SUBTYPE_SIMPLE) { + TB_SUBTYPE(tp) = TBL_SUBTYPE_SIMPLE + } else if (value == TBL_SUBTYPE_EXPLICIT) { + TB_SUBTYPE(tp) = TBL_SUBTYPE_EXPLICIT + } else { + call smark (sp) + call salloc (errmess, SZ_FNAME, TY_CHAR) + call sprintf (Memc[errmess], SZ_FNAME, + "tbpset: %d is not a valid text table subtype") + call pargi (value) + call error (1, Memc[errmess]) + } + } + + case (TBL_MAXPAR): # "Maximum" number of header parameters + call tbtchs (tp, value, -1, -1, -1) + + case (TBL_MAXCOLS): # "Maximum" number of columns + call tbtchs (tp, -1, value, -1, -1) + + case (TBL_ADVICE): # suggest random or sequential access + if ( ! TB_IS_OPEN(tp) ) + call error (ER_TBNOTOPEN, + "table must be open to set I/O advice") + call tbtfst (tp, F_ADVICE, value) + + default: + call error (ER_TBBADOPTION, "invalid option for tbpset") + } +end diff --git a/pkg/tbtables/tbpsta.x b/pkg/tbtables/tbpsta.x new file mode 100644 index 00000000..18e83423 --- /dev/null +++ b/pkg/tbtables/tbpsta.x @@ -0,0 +1,175 @@ +# This file contains tbpsta, tbtszd, and tbrlen. + +include +include +include "tbtables.h" +include "tblerr.h" + +# tbpsta -- get status of table +# Get integer-valued information about a table which has been opened +# or at least initialized. +# +# Phil Hodge, 30-Sep-1987 FIO options added. +# Phil Hodge, 15-Nov-1988 Remove option to get max buffer size. +# Phil Hodge, 10-Jul-1991 Modify IF statement for TBL_DATA_SIZE. +# Phil Hodge, 8-Apr-1993 Modify for short datatype by including +# TBL_ROWLEN_CHAR and TBL_ROWLEN_CHAR_USED; round up +# for TBL_ROWLEN and TBL_ROWLEN_USED; add TBL_VERSION. +# Phil Hodge, 30-Sep-1997 Return reduced values for nrows or ncols +# if selectors were used. Add tbrlen function, and +# include tbtszd in this file. +# Phil Hodge, 7-Jun-1999 Add table subtype. +# Phil Hodge, 25-May-2000 For buffer size for a FITS table, call tbfsiz. + +int procedure tbpsta (tp, param) + +pointer tp # i: pointer to table descriptor +int param # i: the parameter to be determined. +#-- +int value +int fstati(), tbfsiz(), tbrlen(), tbtszd() +errchk fstati, tbfsiz + +begin + switch (param) { + + case TBL_NROWS: # How many rows have been written? + if (TB_ROW_SELECT(tp) == YES) + value = TB_NSEL_ROWS(tp) + else + value = TB_NROWS(tp) + return (value) + + case TBL_NCOLS: # How many columns have been defined? + if (TB_COLUMN_SELECT(tp) == YES) + value = TB_NSEL_COLS(tp) + else + value = TB_NCOLS(tp) + return (value) + + case TBL_ROWLEN: # row length, unit = SZ_REAL + value = tbrlen (tp, param) + return ((value + SZ_REAL - 1) / SZ_REAL) + + case TBL_ROWLEN_USED: # Length of row used, unit=SZ_REAL + value = tbrlen (tp, param) + return ((value + SZ_REAL - 1) / SZ_REAL) + + case TBL_ROWLEN_CHAR: # row length, unit = SZ_CHAR + value = tbrlen (tp, param) + return (value) + + case TBL_ROWLEN_CHAR_USED: # Length of row used, unit=SZ_CHAR + value = tbrlen (tp, param) + return (value) + + case TBL_ALLROWS: # Number of allocated rows + return (TB_ALLROWS(tp)) + + case TBL_WHTYPE: # What type (row- or column-ordered)? + return (TB_TYPE(tp)) + + case TBL_SUBTYPE: # What subtype of table? + return (TB_SUBTYPE(tp)) + + case TBL_NPAR: # number of user parameters + return (TB_NPAR(tp)) + + case TBL_MAXPAR: # space allocated for user parameters + return (TB_MAXPAR(tp)) + + case TBL_MAXCOLS: # space allocated for column descriptors + return (TB_MAXCOLS(tp)) + + case TBL_VERSION: + # version number (zero indexed) of software that created the table + return (TB_VERSION(tp)) + + case TBL_BUFSIZE: # size of FIO buffer in chars + if ( ! TB_IS_OPEN(tp) ) + call error (ER_TBNOTOPEN, + "table must be open to get buffer size") + if (TB_TYPE(tp) == TBL_TYPE_FITS) + return (tbfsiz (tp)) + else + return (fstati (TB_FILE(tp), F_BUFSIZE)) + + case TBL_DATA_SIZE: # size of data portion of table in chars + if (TB_IS_OPEN(tp)) + return (tbtszd(tp)) + return (0) + + default: + call error (ER_TBUNKPARAM, "unknown parameter for tbpsta") + } +end + +# tbtszd -- get size of data portion +# This function returns the size in chars of the data portion of a table. +# The complete table will be larger than this, as it also contains a record +# of size information, possible header parameters, and possible column +# definitions. +# The size returned is the space used, not allocated. If row and/or column +# selectors are used, the size will be appropriately reduced. + +int procedure tbtszd (tp) + +pointer tp # i: pointer to table descriptor +#-- +int nrows # number of selected rows +int rowlen # row length (selected columns) in chars +int tbrlen() + +begin + if (TB_ROW_SELECT(tp) == YES) + nrows = TB_NSEL_ROWS(tp) # row selection is in effect + else + nrows = TB_NROWS(tp) + + rowlen = tbrlen (tp, TBL_ROWLEN_USED) + + return (nrows * rowlen) +end + +# tbrlen -- get row length +# This function returns the row length in units of SZ_CHAR. +# If a column selector was specified, the row length includes only the +# selected columns, and it is independent of the param argument. +# If no column selector is in effect, the row length returned will be +# either the allocated length or used length, depending on whether the +# param argument is TBL_ROWLEN or TBL_ROWLEN_USED respectively. +# (Values are returned in units of SZ_CHAR regardless of the _CHAR +# suffix in this routine.) + +int procedure tbrlen (tp, param) + +pointer tp # i: pointer to table descriptor +int param # i: either TBL_ROWLEN or TBL_ROWLEN_USED +#-- +pointer cp +int value +int colnum, tcs_column() + +begin + if (TB_COLUMN_SELECT(tp) == YES) { + + # Column selection is in effect. + value = 0 + do colnum = 1, TB_NSEL_COLS(tp) { + cp = tcs_column (TB_SELCOL(tp,colnum)) + value = value + COL_LEN(cp) + } + + } else { + + if (param == TBL_ROWLEN || param == TBL_ROWLEN_CHAR) + value = TB_ROWLEN(tp) + else if (param == TBL_ROWLEN_USED || param == TBL_ROWLEN_CHAR_USED) + value = TB_COLUSED(tp) + else + value = 0 + + } + + return (value) +end diff --git a/pkg/tbtables/tbrchg.x b/pkg/tbtables/tbrchg.x new file mode 100644 index 00000000..6c22be6e --- /dev/null +++ b/pkg/tbtables/tbrchg.x @@ -0,0 +1,25 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrchg -- change allocated number of rows +# For row-ordered tables this procedure does nothing. +# +# Phil Hodge, 6-Feb-1992 Include only section for column ordered. + +procedure tbrchg (tp, allrows) + +pointer tp # Pointer to table descriptor +int allrows # The new value for the allocated number of rows + +errchk tbtchs + +begin + if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + if (TB_IS_OPEN(tp)) { + call tbtchs (tp, -1, -1, -1, allrows) + } else { + TB_ALLROWS(tp) = allrows + } + } +end diff --git a/pkg/tbtables/tbrcmp.x b/pkg/tbtables/tbrcmp.x new file mode 100644 index 00000000..2014a429 --- /dev/null +++ b/pkg/tbtables/tbrcmp.x @@ -0,0 +1,288 @@ +include "tbtables.h" # for TBL_IS_INDEFD +include + +# TBRCMP -- Comparison function used to sort table rows +# +# This procedure returns an integer indicating the order of two rows. +# The value of the integer is set according to the following scheme: +# +# if row1 < row2, order = -1 +# if row1 == row2, order = 0 +# if row1 > row2, order = 1 +# +# The comparison is done on the columns whose pointers are passed in the +# colptr array. The first column in the array is the most significant. +# Subsequent columns are used to break ties in the order of the previous +# columns. Nulls are considered to be larger than any other value. Case is +# ignored in the sort order if fold is set to true. +# +# A column that contains arrays is treated much like an array of columns. +# The arrays of values for the two rows are gotten, and they are compared +# element by element. The first element that does not match determines +# the order. One aspect of this that may not be intuitive is that if one +# array is padded with nulls to make it effectively shorter than the other, +# and the non-null elements all match, the shorter array will be considered +# to be larger, since nulls are larger than any other value. +# +# B.Simon 22-Jan-1990 First Code +# Phil Hodge 22-Jan-1993 Use IS_INDEF instead of == INDEF. +# Phil Hodge 1-Apr-1993 Include short datatype. +# Phil Hodge 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge 18-Jan-1999 Add a section for comparing arrays; +# get boolean as short and check for indef. + +int procedure tbrcmp (tp, numcols, colptr, fold, row1, row2) + +pointer tp # i: Table descriptor +int numcols # i: Number of columns to sort on +pointer colptr[ARB] # i: Array of column descriptors +bool fold # i: Fold upper and lower case when sorting +int row1 # i: Index to first row to compare +int row2 # i: Index to second row to compare +#-- +int datatype # data type of column +int nelem # number of elements in array (or one if scalar) +double dval1, dval2 +int ival1, ival2 +short sval1, sval2 +pointer str1, str2 +real rval1, rval2 + +pointer sp2 # stack pointer for ptr1 & ptr2 +pointer ptr1, ptr2 # pointers to arrays of values +int i # loop index + +int icol, order +pointer sp, cp + +int tbcigi(), strcmp() + +begin + # Allocate dynamic memory for strings + + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Loop over each column until the two rows don't match + + order = 0 + for (icol = 1; icol <= numcols && order == 0; icol = icol + 1) { + cp = colptr[icol] + + datatype = tbcigi (cp, TBL_COL_DATATYPE) + nelem = tbcigi (cp, TBL_COL_LENDATA) + + if (nelem == 1) { + + switch (datatype) { + + case TY_INT,TY_LONG: + call tbegti (tp, cp, row1, ival1) + call tbegti (tp, cp, row2, ival2) + + if (ival1 == ival2) + order = 0 + else if (IS_INDEFI (ival1)) + order = 1 + else if (IS_INDEFI (ival2)) + order = -1 + else if (ival1 > ival2) + order = 1 + else if (ival1 < ival2) + order = -1 + + case TY_SHORT,TY_BOOL: + # note: boolean true --> YES (1), false --> NO (0) + call tbegts (tp, cp, row1, sval1) + call tbegts (tp, cp, row2, sval2) + + if (sval1 == sval2) + order = 0 + else if (IS_INDEFS (sval1)) + order = 1 + else if (IS_INDEFS (sval2)) + order = -1 + else if (sval1 > sval2) + order = 1 + else if (sval1 < sval2) + order = -1 + + case TY_REAL: + call tbegtr (tp, cp, row1, rval1) + call tbegtr (tp, cp, row2, rval2) + + if (rval1 == rval2) + order = 0 + else if (IS_INDEFR (rval1)) + order = 1 + else if (IS_INDEFR (rval2)) + order = -1 + else if (rval1 > rval2) + order = 1 + else if (rval1 < rval2) + order = -1 + + case TY_DOUBLE: + call tbegtd (tp, cp, row1, dval1) + call tbegtd (tp, cp, row2, dval2) + + if (dval1 == dval2) + order = 0 + else if (TBL_IS_INDEFD (dval1)) + order = 1 + else if (TBL_IS_INDEFD (dval2)) + order = -1 + else if (dval1 > dval2) + order = 1 + else if (dval1 < dval2) + order = -1 + + default: + call tbegtt (tp, cp, row1, Memc[str1], SZ_LINE) + call tbegtt (tp, cp, row2, Memc[str2], SZ_LINE) + + if (fold) { + call strlwr (Memc[str1]) + call strlwr (Memc[str2]) + } + + if (Memc[str1] == Memc[str2]) { + order = strcmp (Memc[str1], Memc[str2]) + if (order != 0) + order = sign (1, order) + } else if (Memc[str1] == EOS) { + order = 1 + } else if (Memc[str2] == EOS) { + order = -1 + } else { + order = sign (1, int (Memc[str1] - Memc[str2])) + } + } + + } else { # the current column contains arrays + + call smark (sp2) # just for ptr1 & ptr2 + + switch (datatype) { + + case TY_INT,TY_LONG: + call salloc (ptr1, nelem, TY_INT) + call salloc (ptr2, nelem, TY_INT) + + call tbagti (tp, cp, row1, Memi[ptr1], 1, nelem) + call tbagti (tp, cp, row2, Memi[ptr2], 1, nelem) + + do i = 0, nelem-1 { + if (Memi[ptr1+i] == Memi[ptr2+i]) + order = 0 + else if (IS_INDEFI (Memi[ptr1+i])) + order = 1 + else if (IS_INDEFI (Memi[ptr2+i])) + order = -1 + else if (Memi[ptr1+i] > Memi[ptr2+i]) + order = 1 + else if (Memi[ptr1+i] < Memi[ptr2+i]) + order = -1 + if (order != 0) + break + } + + case TY_SHORT,TY_BOOL: + call salloc (ptr1, nelem, TY_SHORT) + call salloc (ptr2, nelem, TY_SHORT) + + call tbagts (tp, cp, row1, Mems[ptr1], 1, nelem) + call tbagts (tp, cp, row2, Mems[ptr2], 1, nelem) + + do i = 0, nelem-1 { + if (Mems[ptr1+i] == Mems[ptr2+i]) + order = 0 + else if (IS_INDEFS (Mems[ptr1+i])) + order = 1 + else if (IS_INDEFS (Mems[ptr2+i])) + order = -1 + else if (Mems[ptr1+i] > Mems[ptr2+i]) + order = 1 + else if (Mems[ptr1+i] < Mems[ptr2+i]) + order = -1 + if (order != 0) + break + } + + case TY_REAL: + call salloc (ptr1, nelem, TY_REAL) + call salloc (ptr2, nelem, TY_REAL) + + call tbagtr (tp, cp, row1, Memr[ptr1], 1, nelem) + call tbagtr (tp, cp, row2, Memr[ptr2], 1, nelem) + + do i = 0, nelem-1 { + if (Memr[ptr1+i] == Memr[ptr2+i]) + order = 0 + else if (IS_INDEFR (Memr[ptr1+i])) + order = 1 + else if (IS_INDEFR (Memr[ptr2+i])) + order = -1 + else if (Memr[ptr1+i] > Memr[ptr2+i]) + order = 1 + else if (Memr[ptr1+i] < Memr[ptr2+i]) + order = -1 + if (order != 0) + break + } + + case TY_DOUBLE: + call salloc (ptr1, nelem, TY_DOUBLE) + call salloc (ptr2, nelem, TY_DOUBLE) + + call tbagtd (tp, cp, row1, Memd[ptr1], 1, nelem) + call tbagtd (tp, cp, row2, Memd[ptr2], 1, nelem) + + do i = 0, nelem-1 { + if (Memd[ptr1+i] == Memd[ptr2+i]) + order = 0 + else if (TBL_IS_INDEFD (Memd[ptr1+i])) + order = 1 + else if (TBL_IS_INDEFD (Memd[ptr2+i])) + order = -1 + else if (Memd[ptr1+i] > Memd[ptr2+i]) + order = 1 + else if (Memd[ptr1+i] < Memd[ptr2+i]) + order = -1 + if (order != 0) + break + } + + default: + do i = 1, nelem { + call tbagtt (tp, cp, row1, Memc[str1], SZ_LINE, i, i) + call tbagtt (tp, cp, row2, Memc[str2], SZ_LINE, i, i) + + if (fold) { + call strlwr (Memc[str1]) + call strlwr (Memc[str2]) + } + + if (Memc[str1] == Memc[str2]) { + order = strcmp (Memc[str1], Memc[str2]) + if (order != 0) + order = sign (1, order) + } else if (Memc[str1] == EOS) { + order = 1 + } else if (Memc[str2] == EOS) { + order = -1 + } else { + order = sign (1, int (Memc[str1] - Memc[str2])) + } + if (order != 0) + break + } + } + call sfree (sp2) + } + } + + call sfree (sp) + return (order) +end diff --git a/pkg/tbtables/tbrcpy.x b/pkg/tbtables/tbrcpy.x new file mode 100644 index 00000000..755819e8 --- /dev/null +++ b/pkg/tbtables/tbrcpy.x @@ -0,0 +1,125 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrcpy -- copy an entire row +# This procedure copies an entire row from one table to another or +# to another location within the same table. +# +# NOTE: If the input and output tables are not the same file, they +# must have the same column definitions and in the same order. For +# row-ordered tables the allocated row lengths need not be the same. +# The input and output tables do not have to be both row-ordered or +# both column-ordered, however. +# +# Phil Hodge, 17-Sep-1987 Subroutine created. +# Phil Hodge, 13-Mar-1988 Allow different row lengths for input & output. +# Phil Hodge, 30-Jan-1992 Add option for text table type. +# Phil Hodge, 7-Aug-1992 For row-ordered tables, if the output row length is +# longer than the input row length, copy indef buffer +# to the rowbuf buffer. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 29-Jul-1994 Change calling sequence of tbeoff; include short; +# rename sbuf to rowbuf. +# Phil Hodge, 31-Aug-1994 Include type short in text table section. +# Phil Hodge, 2-Dec-1994 Call tbalen after calling tbcnum, not before; +# include test on arrays in text table section. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 20-Jun-1995 Modify for FITS tables. +# Phil Hodge, 11-Dec-1995 Use tbrcsc if not row ordered tables. +# Phil Hodge, 3-Mar-1998 Modify to allow for row and column selectors +# with the input table. + +procedure tbrcpy (itp, otp, iselrow, oselrow) + +pointer itp # i: pointer to descriptor of input table +pointer otp # i: pointer to descriptor of output table +int iselrow # i: row number (selected row) in input table +int oselrow # i: row number (selected row) in output table +#-- +pointer sp +pointer rowbuf # scratch for copying entire row +pointer icp, ocp # pointers to arrays of column descriptors +long ioffset # offset in char to element in input table +long ooffset # offset in char to element in output table +int ilen # if row-ordered, length of input row +int olen # if row-ordered, length of output row +int buflen # length of buffer if both are row-ordered +int irownum # actual row number in input table +int orownum # actual row number in output table +int colnum # loop index for column number +int ncols # number of columns to copy +int i +pointer tbcnum() +long tbxoff() +int read() +int tbpsta() +errchk tbrcsc, tbsirow, tbswer1, seek, read, write + +begin + if (TB_READONLY(otp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + call smark (sp) + + # Both tables row ordered, and no column selector specified? + if (TB_TYPE(itp) == TBL_TYPE_S_ROW && + TB_TYPE(otp) == TBL_TYPE_S_ROW && + TB_COLUMN_SELECT(itp) == NO) { + + call tbsirow (itp, iselrow, irownum) # get irownum + + # Get the actual output row number. If it's larger than the + # current number of rows, add the new rows to the list of + # selected rows. + + # If we're writing at the next row following the last we can + # just write the record (that's why we're calling tbswer1 + # instead of tbswer), but if we're writing beyond that tbswer1 + # will fill in with indef records. + call tbswer1 (otp, oselrow, orownum) + + # Allocate a buffer large enough for either input or output row. + ilen = TB_ROWLEN(itp) # length in char + olen = TB_ROWLEN(otp) + buflen = max (ilen, olen) + call salloc (rowbuf, buflen, TY_CHAR) + + # If the output line is longer than the input line, copy that + # portion of the INDEF buffer to the buffer for copying the row. + do i = ilen, olen-1 # zero indexed + Memc[rowbuf+i] = Memc[TB_INDEF(otp)+i] + + ioffset = tbxoff (itp, irownum) # use actual row number + ooffset = tbxoff (otp, orownum) + call seek (TB_FILE(itp), ioffset) + if (read (TB_FILE(itp), Memc[rowbuf], ilen) < ilen) + call error (1, "tbrcpy: could not read row") + call seek (TB_FILE(otp), ooffset) + call write (TB_FILE(otp), Memc[rowbuf], olen) + + TB_NROWS(otp) = max (orownum, TB_NROWS(otp)) + + } else { + + # Note that if a column selector is in effect, we're only + # copying the selected columns. + ncols = tbpsta (itp, TBL_NCOLS) # can be less than TB_NCOLS + call salloc (icp, ncols, TY_POINTER) + call salloc (ocp, ncols, TY_POINTER) + + # This is where we assume that the columns are in the same + # order in both tables. + do colnum = 1, ncols { + Memi[icp+colnum-1] = tbcnum (itp, colnum) + Memi[ocp+colnum-1] = tbcnum (otp, colnum) + } + + # Copy this row. Some columns may contain arrays. + call tbrcsc (itp, otp, Memi[icp], Memi[ocp], + iselrow, oselrow, ncols) + } + TB_MODIFIED(otp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbrcsc.x b/pkg/tbtables/tbrcsc.x new file mode 100644 index 00000000..91ed2cda --- /dev/null +++ b/pkg/tbtables/tbrcsc.x @@ -0,0 +1,173 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrcsc -- copy selected columns +# This procedure copies specific columns in a row from one table to another +# or to another row within the same table. Elements are copied one at a +# time, and the pointers to descriptors of input and output columns are +# passed in the calling sequence, so the restrictions on similarity of +# input and output tables in tbrcpy do not apply to this routine. +# +# For each column to be copied from the input row, the element is read +# using a "get element" routine (tbegt[]), and then the element is put +# in the output row using a "put element" routine (tbept[]). +# +# Phil Hodge, 1-Oct-1987 Subroutine created. +# Phil Hodge, 30-Jan-1992 Use tbegt? instead of tbegp?. +# Phil Hodge, 1-Apr-1993 Include short datatype. +# Phil Hodge, 23-Aug-1994 Also copy array entries. +# Phil Hodge, 30-Nov-1994 When copying arrays of char, copy one at a time. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 11-Dec-1995 Allocate cbuf only if needed. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 30-Sep-1997 Delete check on irow being beyond end of file, +# because it's checked in tbegt[] or tbagt[], and +# to allow for a row selector. +# Phil Hodge, 18-Jan-1999 Get & put boolean as short, to preserve indef values. +# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length. + +procedure tbrcsc (itp, otp, icp, ocp, irow, orow, ncols) + +pointer itp # i: pointer to descriptor of input table +pointer otp # i: pointer to descriptor of output table +pointer icp[ncols] # i: array of pointers for input columns +pointer ocp[ncols] # i: array of pointers for output columns +int irow # i: row number in input table +int orow # i: row number in output table +int ncols # i: number of columns to be copied +#-- +pointer sp +int k # loop index for column number +int i # loop index for array element +int nget, nput # number of elements in input & output arrays +int dtype # data type of column +# buffers for copying elements of various data types +pointer gbuf # pointer to array of any data type +pointer cbuf # for copying character elements +double dbuf +real rbuf +int ibuf +short sbuf +int tbagtd(), tbagtr(), tbagti(), tbagts(), tbagtt() +errchk tbegtd, tbegtr, tbegti, tbegts, tbegtt, + tbeptd, tbeptr, tbepti, tbepts, tbeptt, + tbagtd, tbagtr, tbagti, tbagts, tbagtt, + tbaptd, tbaptr, tbapti, tbapts, tbaptt +string BAD_DATATYPE "tbrcsc: bad data type; table or memory corrupted?" +string ERR_READ_ARRAY "tbrcsc: can't read array entry" + +begin + if (TB_READONLY(otp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + call smark (sp) + cbuf = NULL # allocated below + + do k = 1, ncols { + dtype = COL_DTYPE(icp[k]) + nget = COL_NELEM(icp[k]) + + if (nget == 1) { + + # Copy a single element. + switch (dtype) { + case TBL_TY_REAL: + call tbegtr (itp, icp[k], irow, rbuf) + call tbeptr (otp, ocp[k], orow, rbuf) + case TBL_TY_DOUBLE: + call tbegtd (itp, icp[k], irow, dbuf) + call tbeptd (otp, ocp[k], orow, dbuf) + case TBL_TY_INT: + call tbegti (itp, icp[k], irow, ibuf) + call tbepti (otp, ocp[k], orow, ibuf) + case TBL_TY_SHORT,TBL_TY_BOOL: + call tbegts (itp, icp[k], irow, sbuf) + call tbepts (otp, ocp[k], orow, sbuf) + default: + if (dtype < 0 || dtype == TBL_TY_CHAR) { + if (cbuf == NULL) + call salloc (cbuf, SZ_LINE, TY_CHAR) + call tbegtt (itp, icp[k], irow, Memc[cbuf], SZ_LINE) + call tbeptt (otp, ocp[k], orow, Memc[cbuf]) + } else { + call error (ER_TBCOLBADTYP, BAD_DATATYPE) + } + } + + } else { # Copy an array. + + if (TB_TYPE(otp) == TBL_TYPE_TEXT || + TB_TYPE(otp) == TBL_TYPE_S_COL) + call error (1, + "Output table type does not support columns of arrays.") + + nput = COL_NELEM(ocp[k]) + if (nget > nput) + call error (1, + "tbrcsc: output array is shorter than input array") + + switch (dtype) { + case TBL_TY_REAL: + + call malloc (gbuf, max (nget, nput), TY_REAL) + do i = nget+1, nput + Memr[gbuf+i-1] = INDEFR + if (tbagtr (itp, icp[k], irow, Memr[gbuf], 1, nget) < nget) + call error (1, ERR_READ_ARRAY) + call tbaptr (otp, ocp[k], orow, Memr[gbuf], 1, nput) + call mfree (gbuf, TY_REAL) + + case TBL_TY_DOUBLE: + + call malloc (gbuf, max (nget, nput), TY_DOUBLE) + do i = nget+1, nput + Memd[gbuf+i-1] = TBL_INDEFD + if (tbagtd (itp, icp[k], irow, Memd[gbuf], 1, nget) < nget) + call error (1, ERR_READ_ARRAY) + call tbaptd (otp, ocp[k], orow, Memd[gbuf], 1, nput) + call mfree (gbuf, TY_DOUBLE) + + case TBL_TY_INT: + + call malloc (gbuf, max (nget, nput), TY_INT) + do i = nget+1, nput + Memi[gbuf+i-1] = INDEFI + if (tbagti (itp, icp[k], irow, Memi[gbuf], 1, nget) < nget) + call error (1, ERR_READ_ARRAY) + call tbapti (otp, ocp[k], orow, Memi[gbuf], 1, nput) + call mfree (gbuf, TY_INT) + + case TBL_TY_SHORT,TBL_TY_BOOL: + + call malloc (gbuf, max (nget, nput), TY_SHORT) + do i = nget+1, nput + Mems[gbuf+i-1] = INDEFS + if (tbagts (itp, icp[k], irow, Mems[gbuf], 1, nget) < nget) + call error (1, ERR_READ_ARRAY) + call tbapts (otp, ocp[k], orow, Mems[gbuf], 1, nput) + call mfree (gbuf, TY_SHORT) + + default: + if (dtype < 0) { + if (cbuf == NULL) + call salloc (cbuf, SZ_LINE, TY_CHAR) + do i = 1, nget { + if (tbagtt (itp, icp[k], irow, + Memc[cbuf], SZ_LINE, i, 1) < 1) + call error (1, ERR_READ_ARRAY) + call tbaptt (otp, ocp[k], orow, + Memc[cbuf], SZ_LINE, i, 1) + } + do i = nget+1, nput + call tbaptt (otp, ocp[k], orow, "", SZ_LINE, i, 1) + } else { + call error (ER_TBCOLBADTYP, BAD_DATATYPE) + } + } + } + } + TB_MODIFIED(otp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbrdel.x b/pkg/tbtables/tbrdel.x new file mode 100644 index 00000000..23796f15 --- /dev/null +++ b/pkg/tbtables/tbrdel.x @@ -0,0 +1,77 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrdel -- delete rows +# This routine deletes a range of rows. +# NOTE: The number of rows TB_NROWS(tp) will be modified by this routine +# if the range of rows to be deleted is within the table. The physical +# disk space occupied by these rows will not be deallocated; the file +# will still be just as large as before. +# +# Phil Hodge, 23-Mar-1988 Subroutine created. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 6-Mar-1998 Modify to allow a row selector, if the rows +# to be deleted are at the end of the table. + +procedure tbrdel (tp, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +int firstrow # i: first row to be deleted +int lastrow # i: last row to be deleted +#-- +int row1 # actual first row to be deleted +int nrows # number of rows written to table +int ndel # number of rows to be deleted +int rst_rownum() +errchk tbxnll, tbynll, tbznll, tbfchp, tbrsft + +begin + if (firstrow < 1 || lastrow < 1) + call error (1, "tbrdel: Row number less than one is invalid.") + + if (firstrow > lastrow) + return + + nrows = TB_NROWS(tp) + + if (TB_ROW_SELECT(tp) == YES) { + + if (lastrow < TB_NSEL_ROWS(tp)) + call error (1, + "Can't delete rows in the middle of a table that uses a row selector.") + + if (firstrow > TB_NSEL_ROWS(tp)) + return # nothing to do + + row1 = rst_rownum (TB_ROWSET(tp), firstrow) + # and row2 = nrows + + if (nrows - row1 > TB_NSEL_ROWS(tp) - firstrow) + call error (1, + "tbrdel: Range of rows to delete includes non-selected rows.") + + ndel = nrows - row1 + 1 + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxnll (tp, max (1, nrows-ndel+1), nrows) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbynll (tp, max (1, nrows-ndel+1), nrows) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + call tbznll (tp, max (1, nrows-ndel+1), nrows) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfchp (tp, ndel) + else + call error (ER_TBCORRUPTED, "tbrdel: invalid table type") + + TB_NROWS(tp) = max (0, nrows - ndel) + + } else { + + ndel = min (nrows, lastrow) - firstrow + 1 + # Shift the rows. + call tbrsft (tp, firstrow, -ndel) + } + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbrgt.x b/pkg/tbtables/tbrgt.x new file mode 100644 index 00000000..466edf76 --- /dev/null +++ b/pkg/tbtables/tbrgt.x @@ -0,0 +1,267 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Read column values from a row. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 5-Feb-1992 Add option for text table type. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 Include check on row number out of range. +# Phil Hodge, 9-Apr-1995 Modify for FITS tables. +# Phil Hodge, 2-Mar-1998 Map selected row number to actual row number. +# Phil Hodge, 18-Jun-1998 Use tbfagi instead of tbfagb to get boolean. +# Phil Hodge, 28-Aug-2002 Use strsearch to check for INDEF in tbrgtt. + +# tbrgtd -- getrow double +# Read column values from a row. This is for data type double. + +procedure tbrgtd (tp, cp, buffer, nullflag, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +double buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int numcols # i: number of columns from which to get values +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # index into buffer & nullflag +int nret # for fits tables +int tbfagd() +errchk tbsirow, tbxrgd, tbyrgd, tbzgtd, tbfagd + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxrgd (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbyrgd (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + do k = 1, numcols { + call tbzgtd (tp, cp[k], rownum, buffer[k]) + nullflag[k] = (IS_INDEFD (buffer[k])) + } + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + do k = 1, numcols { + nret = tbfagd (tp, cp[k], rownum, buffer[k], 1, 1) + nullflag[k] = (IS_INDEFD (buffer[k])) + } + } else { + call error (ER_TBCORRUPTED, "tbrgtd: table type is messed up") + } +end + +# tbrgtr -- getrow real +# Read column values from a row. This is for data type real. + +procedure tbrgtr (tp, cp, buffer, nullflag, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +real buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int numcols # i: number of columns from which to get values +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # index into buffer & nullflag +int nret # for fits tables +int tbfagr() +errchk tbsirow, tbxrgr, tbyrgr, tbzgtr, tbfagr + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxrgr (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbyrgr (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + do k = 1, numcols { + call tbzgtr (tp, cp[k], rownum, buffer[k]) + nullflag[k] = (IS_INDEFR (buffer[k])) + } + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + do k = 1, numcols { + nret = tbfagr (tp, cp[k], rownum, buffer[k], 1, 1) + nullflag[k] = (IS_INDEFR (buffer[k])) + } + } else { + call error (ER_TBCORRUPTED, "tbrgtr: table type is messed up") + } +end + +# tbrgti -- getrow integer +# Read column values from a row. This is for data type integer. + +procedure tbrgti (tp, cp, buffer, nullflag, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +int buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int numcols # i: number of columns from which to get values +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # index into buffer & nullflag +int nret # for fits tables +int tbfagi() +errchk tbsirow, tbxrgi, tbyrgi, tbzgti, tbfagi + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxrgi (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbyrgi (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + do k = 1, numcols { + call tbzgti (tp, cp[k], rownum, buffer[k]) + nullflag[k] = (IS_INDEFI (buffer[k])) + } + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + do k = 1, numcols { + nret = tbfagi (tp, cp[k], rownum, buffer[k], 1, 1) + nullflag[k] = (IS_INDEFI (buffer[k])) + } + } else { + call error (ER_TBCORRUPTED, "tbrgti: table type is messed up") + } +end + +# tbrgts -- getrow short +# Read column values from a row. This is for data type short integer. + +procedure tbrgts (tp, cp, buffer, nullflag, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +short buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int numcols # i: number of columns from which to get values +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # index into buffer & nullflag +int nret # for fits tables +int tbfags() +errchk tbsirow, tbxrgs, tbyrgs, tbzgts, tbfags + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxrgs (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbyrgs (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + do k = 1, numcols { + call tbzgts (tp, cp[k], rownum, buffer[k]) + nullflag[k] = (IS_INDEFS (buffer[k])) + } + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + do k = 1, numcols { + nret = tbfags (tp, cp[k], rownum, buffer[k], 1, 1) + nullflag[k] = (IS_INDEFS (buffer[k])) + } + } else { + call error (ER_TBCORRUPTED, "tbrgts: table type is messed up") + } +end + +# tbrgtb -- getrow Boolean +# This is for data type Boolean. + +procedure tbrgtb (tp, cp, buffer, nullflag, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +bool buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int numcols # i: number of columns from which to get values +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # index into buffer & nullflag +int nret # for fits tables +int ival # for getting from a fits table +int tbfagi() +errchk tbsirow, tbxrgb, tbyrgb, tbzgtb, tbfagi + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxrgb (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbyrgb (tp, cp, buffer, nullflag, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + do k = 1, numcols { + call tbzgtb (tp, cp[k], rownum, buffer[k]) + nullflag[k] = false + } + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + do k = 1, numcols { + nret = tbfagi (tp, cp[k], rownum, ival, 1, 1) + if (IS_INDEFI(ival)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (ival == 1) + nullflag[k] = false + } + } + } else { + call error (ER_TBCORRUPTED, "tbrgtb: table type is messed up") + } +end + +# tbrgtt -- getrow text +# Read column values from a row. This is for character strings. + +procedure tbrgtt (tp, cp, buffer, nullflag, lenstr, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +char buffer[lenstr,ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int lenstr # i: length of each string in array buffer +int numcols # i: number of columns from which to get values +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # index into buffer & nullflag +int nret # for fits tables +int tbfagt() +int strsearch() +errchk tbxrgt, tbyrgt, tbzgtt, tbfagt + +begin + call tbsirow (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + call tbxrgt (tp, cp, buffer, nullflag, + lenstr, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + call tbyrgt (tp, cp, buffer, nullflag, + lenstr, numcols, rownum) + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + do k = 1, numcols { + call tbzgtt (tp, cp[k], rownum, buffer[1,k], lenstr) + nullflag[k] = (buffer[1,k] == EOS || + (strsearch (buffer[1,k], "INDEF") > 0)) + } + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + do k = 1, numcols { + nret = tbfagt (tp, cp[k], rownum, buffer[1,k], lenstr, 1, 1) + nullflag[k] = (buffer[1,k] == EOS || + (strsearch (buffer[1,k], "INDEF") > 0)) + } + } else { + call error (ER_TBCORRUPTED, "tbrgtt: table type is messed up") + } +end diff --git a/pkg/tbtables/tbrnll.x b/pkg/tbtables/tbrnll.x new file mode 100644 index 00000000..2b7ed561 --- /dev/null +++ b/pkg/tbtables/tbrnll.x @@ -0,0 +1,67 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrnll -- set rows to null +# This procedure sets all columns in a range of rows to INDEF. +# If the first row to be deleted is greater than the last row, or if +# the range of rows is outside the allocated size of the table, nothing +# is done. It is not considered an error if the first row is less than +# one or the last row is greater than the number of allocated rows in +# the table. +# +# Phil Hodge, 7-Mar-1988 Subroutine created. +# Phil Hodge, 3-Feb-1992 Add option for text table type. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 21-Jun-1995 Modify for FITS tables. +# Phil Hodge, 3-Mar-1998 Modify to allow for row selector. + +procedure tbrnll (tp, sel_firstrow, sel_lastrow) + +pointer tp # i: pointer to table descriptor +int sel_firstrow # i: first row to be set to INDEF +int sel_lastrow # i: last row to be set to INDEF +#-- +int firstrow, lastrow # range of actual row numbers +int rst_rownum() +errchk rst_rownum, tbxnll, tbynll, tbznll, tbfnll + +begin + if (sel_lastrow < sel_firstrow) + call error (1, "tbrnll: lastrow is less than firstrow") + + if (TB_ROW_SELECT(tp) == YES) { + + if (sel_firstrow > TB_NSEL_ROWS(tp)) + return # nothing to do + firstrow = rst_rownum (TB_ROWSET(tp), sel_firstrow) + + if (sel_lastrow > TB_NSEL_ROWS(tp)) + lastrow = TB_NROWS(tp) # stop at last row + else + lastrow = rst_rownum (TB_ROWSET(tp), sel_lastrow) + + } else { + + firstrow = sel_firstrow + if (firstrow > TB_NROWS(tp)) + return + + lastrow = sel_lastrow + if (lastrow > TB_NROWS(tp)) + lastrow = TB_NROWS(tp) + } + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxnll (tp, firstrow, lastrow) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbynll (tp, firstrow, lastrow) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + call tbznll (tp, firstrow, lastrow) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfnll (tp, firstrow, lastrow) + else + call error (ER_TBCORRUPTED, "tbrnll: table type is messed up") + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbrpt.x b/pkg/tbtables/tbrpt.x new file mode 100644 index 00000000..ee74dba8 --- /dev/null +++ b/pkg/tbtables/tbrpt.x @@ -0,0 +1,248 @@ +include +include "tbtables.h" +include "tblerr.h" + +# Write column values to a row. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 5-Feb-1992 Add option for text table type. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 Include check on row number > 0. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 23-Jun-1995 Modify for FITS tables. +# Phil Hodge, 3-Mar-1998 Call tbswer1, to allow for row selector. + +# tbrptd -- putrow double +# Write column values to a row. This is for data type double. + +procedure tbrptd (tp, cp, buffer, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +double buffer[ARB] # i: array of values to be put into table +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # loop index for column number +errchk tbswer1, tbxrpd, tbyrpd, tbzptd, tbfapd + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + # (But note use of tbswer1, especially for row-ordered table.) + call tbswer1 (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxrpd (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyrpd (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + do k = 1, numcols + call tbzptd (tp, cp[k], rownum, buffer[k]) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + do k = 1, numcols + call tbfapd (tp, cp[k], rownum, buffer[k], 1, 1) + else + call error (ER_TBCORRUPTED, "tbrptd: table type is messed up") + + TB_MODIFIED(tp) = true +end + + +# tbrptr -- putrow real +# Write column values to a row. This is for data type real. + +procedure tbrptr (tp, cp, buffer, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +real buffer[ARB] # i: array of values to be put into table +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # loop index for column number +errchk tbswer1, tbxrpr, tbyrpr, tbzptr, tbfapr + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer1 (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxrpr (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyrpr (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + do k = 1, numcols + call tbzptr (tp, cp[k], rownum, buffer[k]) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + do k = 1, numcols + call tbfapr (tp, cp[k], rownum, buffer[k], 1, 1) + else + call error (ER_TBCORRUPTED, "tbrptr: table type is messed up") + + TB_MODIFIED(tp) = true +end + + +# tbrpti -- putrow integer +# Write column values to a row. This is for data type integer. + +procedure tbrpti (tp, cp, buffer, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +int buffer[ARB] # i: array of values to be put into table +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # loop index for column number +errchk tbswer1, tbxrpi, tbyrpi, tbzpti, tbfapi + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer1 (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxrpi (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyrpi (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + do k = 1, numcols + call tbzpti (tp, cp[k], rownum, buffer[k]) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + do k = 1, numcols + call tbfapi (tp, cp[k], rownum, buffer[k], 1, 1) + else + call error (ER_TBCORRUPTED, "tbrpti: table type is messed up") + + TB_MODIFIED(tp) = true +end + + +# tbrpts -- putrow short +# Write column values to a row. This is for data type short integer. + +procedure tbrpts (tp, cp, buffer, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +short buffer[ARB] # i: array of values to be put into table +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # loop index for column number +errchk tbswer1, tbxrps, tbyrps, tbzpts, tbfaps + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer1 (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxrps (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyrps (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + do k = 1, numcols + call tbzpts (tp, cp[k], rownum, buffer[k]) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + do k = 1, numcols + call tbfaps (tp, cp[k], rownum, buffer[k], 1, 1) + else + call error (ER_TBCORRUPTED, "tbrpts: table type is messed up") + + TB_MODIFIED(tp) = true +end + + +# tbrptb -- putrow Boolean +# This is for data type Boolean. + +procedure tbrptb (tp, cp, buffer, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +bool buffer[ARB] # i: array of values to be put into table +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # loop index for column number +errchk tbswer1, tbxrpb, tbyrpb, tbzptb, tbfapb + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer1 (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxrpb (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyrpb (tp, cp, buffer, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + do k = 1, numcols + call tbzptb (tp, cp[k], rownum, buffer[k]) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + do k = 1, numcols + call tbfapb (tp, cp[k], rownum, buffer[k], 1, 1) + else + call error (ER_TBCORRUPTED, "tbrptb: table type is messed up") + + TB_MODIFIED(tp) = true +end + + +# tbrptt -- putrow text +# Write column values to a row. This is for character strings. + +procedure tbrptt (tp, cp, buffer, lenstr, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer cp[ARB] # i: array of pointers to column descriptors +char buffer[lenstr,ARB] # i: array of values to be put into table +int lenstr # i: length of each string in array buffer +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int k # loop index for column number +errchk tbswer1, tbxrpt, tbyrpt, tbzptt, tbfapt + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + + # If we're writing beyond EOF, write extra rows and update TB_NROWS. + call tbswer1 (tp, selrow, rownum) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxrpt (tp, cp, buffer, lenstr, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyrpt (tp, cp, buffer, lenstr, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + do k = 1, numcols + call tbzptt (tp, cp[k], rownum, buffer[1,k]) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + do k = 1, numcols + call tbfapt (tp, cp[k], rownum, buffer[1,k], lenstr, 1, 1) + else + call error (ER_TBCORRUPTED, "tbrptt: table type is messed up") + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbrsft.x b/pkg/tbtables/tbrsft.x new file mode 100644 index 00000000..0cc4bbcf --- /dev/null +++ b/pkg/tbtables/tbrsft.x @@ -0,0 +1,51 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrsft -- shift rows +# Shift one or more rows down (to leave a gap in the table) or up (to +# delete rows). The range of rows that is shifted is from FIRST to +# the last row in the table. Shift down if SHIFT > 0, or shift up if +# SHIFT < 0. SHIFT is the number of rows by which to shift. +# +# Rows that are exposed by the shift are NOT set to indef. The total +# number of rows TB_NROWS(tp) will NOT be reduced if SHIFT < 0, but +# it will be increased if SHIFT > 0. The calling routine (e.g. tbrdel) +# is responsible for cleaning up such details. +# +# Phil Hodge, 23-Mar-1988 Subroutine created. +# Phil Hodge, 30-Jan-1992 Add option for text table type. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 21-Jun-1995 Modify for FITS tables. +# Phil Hodge, 3-Mar-1998 Error if a row selector is in effect. + +procedure tbrsft (tp, first, shift) + +pointer tp # i: pointer to table descriptor +int first # i: first row to be moved +int shift # i: shift by this many rows +#-- +errchk tbxsft, tbysft, tbzsft, tbfsft + +begin + if (shift == 0) + return + + if (TB_ROW_SELECT(tp) == YES) { + call error (1, + "Can't shift rows in a table with row selector in effect.") + } + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxsft (tp, first, shift) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbysft (tp, first, shift) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + call tbzsft (tp, first, shift) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfsft (tp, first, shift) + else + call error (ER_TBCORRUPTED, "tbrsft: table type is messed up") + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbrswp.x b/pkg/tbtables/tbrswp.x new file mode 100644 index 00000000..ce4eaabd --- /dev/null +++ b/pkg/tbtables/tbrswp.x @@ -0,0 +1,138 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrswp -- swap two rows +# This procedure interchanges two entire rows within a table. +# +# Phil Hodge, 30-Sep-1987 Subroutine created. +# Phil Hodge, 30-Jan-1992 Add option for text table type. +# Phil Hodge, 1-Apr-1993 Include short datatype. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 3-Mar-1998 Modify to allow for row selector. + +procedure tbrswp (tp, selrow1, selrow2) + +pointer tp # i: pointer to table descriptor +int selrow1 # i: first row number (selected row) +int selrow2 # i: second row number (selected row) +#-- +pointer sp +pointer rowbuf1, rowbuf2 # scratch for interchanging entire rows +pointer cptr # pointer to descriptor for column +long offset1 # offset in char to first element +long offset2 # offset in char to second element +int row1, row2 # actual row numbers corresponding to selrow1,2 +int colnum # loop index for column number +int dtype # data type of column +int rowlen # length of row +# buffers for copying single elements +pointer cbuf1, cbuf2 # scratch for character strings +double dbuf1, dbuf2 +real rbuf1, rbuf2 +int ibuf1, ibuf2 +short sbuf1, sbuf2 +bool bbuf1, bbuf2 +pointer tbcnum() +long tbxoff() +int read() +errchk tbegtb, tbegtd, tbegti, tbegts, tbegtr, tbegtt, + tbeptb, tbeptd, tbepti, tbepts, tbeptr, tbeptt, + tbswer, seek, read, write + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "can't write to table; it's readonly") + if (row1 == row2) + return + + call smark (sp) + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + + # If either of the rows is beyond the EOF, fill out the table + # with indef values to include that row number. + if (selrow1 > selrow2) { + call tbswer (tp, selrow1, row1) + call tbswer (tp, selrow2, row2) + } else { + call tbswer (tp, selrow2, row2) + call tbswer (tp, selrow1, row1) + } + + # Read both rows into scratch space, and then write them out again. + rowlen = TB_ROWLEN(tp) # length in char + call salloc (rowbuf1, rowlen, TY_CHAR) + call salloc (rowbuf2, rowlen, TY_CHAR) + + # These are the offsets to the beginnings of the rows. + offset1 = tbxoff (tp, row1) + offset2 = tbxoff (tp, row2) + + # Read both rows. + call seek (TB_FILE(tp), offset1) + if (read (TB_FILE(tp), Memc[rowbuf1], rowlen) < rowlen) + call error (1, "tbrswp: could not read row") + call seek (TB_FILE(tp), offset2) + if (read (TB_FILE(tp), Memc[rowbuf2], rowlen) < rowlen) + call error (1, "tbrswp: could not read row") + + # Write both rows. + call seek (TB_FILE(tp), offset2) + call write (TB_FILE(tp), Memc[rowbuf1], rowlen) + call seek (TB_FILE(tp), offset1) + call write (TB_FILE(tp), Memc[rowbuf2], rowlen) + + } else { + + call salloc (cbuf1, SZ_LINE, TY_CHAR) + call salloc (cbuf2, SZ_LINE, TY_CHAR) + + # Copy each element (i.e. each column in the row) one at a time. + do colnum = 1, TB_NCOLS(tp) { + cptr = tbcnum (tp, colnum) + + dtype = COL_DTYPE(cptr) + switch (dtype) { + case TBL_TY_REAL: + call tbegtr (tp, cptr, selrow1, rbuf1) # get + call tbegtr (tp, cptr, selrow2, rbuf2) # get + call tbeptr (tp, cptr, selrow2, rbuf1) # put + call tbeptr (tp, cptr, selrow1, rbuf2) # put + case TBL_TY_DOUBLE: + call tbegtd (tp, cptr, selrow1, dbuf1) + call tbegtd (tp, cptr, selrow2, dbuf2) + call tbeptd (tp, cptr, selrow2, dbuf1) + call tbeptd (tp, cptr, selrow1, dbuf2) + case TBL_TY_INT: + call tbegti (tp, cptr, selrow1, ibuf1) + call tbegti (tp, cptr, selrow2, ibuf2) + call tbepti (tp, cptr, selrow2, ibuf1) + call tbepti (tp, cptr, selrow1, ibuf2) + case TBL_TY_SHORT: + call tbegts (tp, cptr, selrow1, sbuf1) + call tbegts (tp, cptr, selrow2, sbuf2) + call tbepts (tp, cptr, selrow2, sbuf1) + call tbepts (tp, cptr, selrow1, sbuf2) + case TBL_TY_BOOL: + call tbegtb (tp, cptr, selrow1, bbuf1) + call tbegtb (tp, cptr, selrow2, bbuf2) + call tbeptb (tp, cptr, selrow2, bbuf1) + call tbeptb (tp, cptr, selrow1, bbuf2) + default: + if (dtype < 0 || dtype == TBL_TY_CHAR) { + call tbegtt (tp, cptr, selrow1, Memc[cbuf1], SZ_LINE) + call tbegtt (tp, cptr, selrow2, Memc[cbuf2], SZ_LINE) + call tbeptt (tp, cptr, selrow2, Memc[cbuf1]) + call tbeptt (tp, cptr, selrow1, Memc[cbuf2]) + } else { + call error (ER_TBCOLBADTYP, + "tbrswp: bad data type; table or memory corrupted?") + } + } + } + } + TB_MODIFIED(tp) = true + + call sfree (sp) +end diff --git a/pkg/tbtables/tbrudf.x b/pkg/tbtables/tbrudf.x new file mode 100644 index 00000000..447600de --- /dev/null +++ b/pkg/tbtables/tbrudf.x @@ -0,0 +1,66 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbrudf -- set to undefined +# "Delete" entries in a table by setting each entry to the INDEF value +# appropriate for its datatype. +# +# Phil Hodge, 4-Nov-1993 Include check on valid row number. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 15-Jun-1995 Modify for FITS tables. +# Phil Hodge, 3-Jun-1996 Errchk tbfudf; call tbtwer if beyond EOF. +# Phil Hodge, 3-Mar-1998 Modify to allow for row selector. +# Phil Hodge, 26-Jun-1998 Change test (rownum < 1) to (selrow < 1). + +procedure tbrudf (tp, colptr, numcols, selrow) + +pointer tp # i: pointer to table descriptor +pointer colptr[ARB] # i: array of pointers to column descriptors +int numcols # i: number of columns +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number +int rst_rownum() +errchk rst_rownum, tbswer, tbfudf, tbxudf, tbyudf, tbzudf + +begin + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, + "tbrudf: can't delete entries in readonly table") + + if (selrow < 1) + call error (1, "tbrudf: row number must be > 0") + + # If the row is beyond EOF, write extra rows and update TB_NROWS. + # Then we're done, because the new rows are already INDEF. + if (TB_ROW_SELECT(tp) == YES) { + + if (selrow > TB_NSEL_ROWS(tp)) { + call tbswer (tp, selrow, rownum) + return + } + rownum = rst_rownum (TB_ROWSET(tp), selrow) + + } else { + + rownum = selrow + if (rownum > TB_NROWS(tp)) { + call tbswer (tp, selrow, rownum) + return + } + } + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + call tbxudf (tp, colptr, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) + call tbyudf (tp, colptr, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_TEXT) + call tbzudf (tp, colptr, numcols, rownum) + else if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfudf (tp, colptr, numcols, rownum) + else + call error (ER_TBCORRUPTED, "tbrudf: table type is messed up") + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbscol.x b/pkg/tbtables/tbscol.x new file mode 100644 index 00000000..549706d4 --- /dev/null +++ b/pkg/tbtables/tbscol.x @@ -0,0 +1,32 @@ +include "tbtables.h" + +# If we need to reallocate the space for column selector descriptors, +# this is the amount we will add to the current size. +define INCR_MAX_SELCOLS 20 + +# tbscol -- add a new column to the list of selected columns +# If a column selector is in effect, this routine adds one column to the +# list of selected columns. This would be called primarily when creating +# a new column. +# +# Phil Hodge, 2-Mar-1998 Subroutine created. + +procedure tbscol (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +errchk tcs_addcol + +begin + if (TB_COLUMN_SELECT(tp) == YES) { # column selection is in effect + + if (TB_NSEL_COLS(tp) + 1 > TB_MAX_SELCOLS(tp)) { + TB_MAX_SELCOLS(tp) = TB_NSEL_COLS(tp) + INCR_MAX_SELCOLS + call realloc (TB_SELCOL_PTR(tp), TB_MAX_SELCOLS(tp), TY_POINTER) + } + + call tcs_addcol (tp, cp, + TB_SELCOL(tp,1), TB_NSEL_COLS(tp), TB_MAX_SELCOLS(tp)) + } +end diff --git a/pkg/tbtables/tbsirow.x b/pkg/tbtables/tbsirow.x new file mode 100644 index 00000000..8129df52 --- /dev/null +++ b/pkg/tbtables/tbsirow.x @@ -0,0 +1,36 @@ +include "tbtables.h" +include "tblerr.h" + +# tbsirow -- get actual row number from selected row number +# +# This routine is for translating the selected row number to the actual +# row number for an input table, i.e. for the case where the row number +# may not be greater than the number of rows in the table. + +procedure tbsirow (tp, selrow, rownum) + +pointer tp # i: pointer to table descriptor +int selrow # i: row number (or selected row number) +int rownum # o: actual row number +#-- +int rst_rownum() + +begin + if (selrow < 1) + call error (1, "row number less than one is invalid") + + if (TB_ROW_SELECT(tp) == YES) { + + if (selrow > TB_NSEL_ROWS(tp)) + call error (ER_TBBEYONDEOF, "input row is beyond EOF") + + rownum = rst_rownum (TB_ROWSET(tp), selrow) + + } else { + + if (selrow > TB_NROWS(tp)) + call error (ER_TBBEYONDEOF, "input row is beyond EOF") + + rownum = selrow + } +end diff --git a/pkg/tbtables/tbsopn.x b/pkg/tbtables/tbsopn.x new file mode 100644 index 00000000..3139a297 --- /dev/null +++ b/pkg/tbtables/tbsopn.x @@ -0,0 +1,58 @@ +include +include "tbtables.h" + +# tbsopn -- call the row & column selector routines +# This routine determines the subset of rows and columns that were selected +# by expressions appended to the table name. +# +# Memory is allocated for TB_SELCOL_PTR(tp), which +# should be deallocated when closing the table. Also, rst_free and +# tcs_close should be called to deallocate the row set and descriptors +# that were allocated by tcs_open. +# +# Phil Hodge, 3-Mar-1998 Subroutine created. + +procedure tbsopn (tp, rowselect, colselect) + +pointer tp # i: pointer to table descriptor +char rowselect[ARB] # i: row selector string +char colselect[ARB] # i: column selector string +#-- +pointer trsrows() +int rst_nelem() +errchk trsrows, tcs_open + +begin + if (rowselect[1] != EOS) { + + # This creates a row set and checks each row of the table + # for a match with the row selector string. + TB_ROWSET(tp) = trsrows (tp, rowselect) + + # This is the number of selected rows. + TB_NSEL_ROWS(tp) = rst_nelem (TB_ROWSET(tp)) + + TB_ROW_SELECT(tp) = YES # row selection is in effect + + } else { + + TB_ROW_SELECT(tp) = NO # row selection is not in effect + } + + if (colselect[1] != EOS) { + + # Allocate enough space to select all columns. + TB_MAX_SELCOLS(tp) = TB_NCOLS(tp) + call malloc (TB_SELCOL_PTR(tp), TB_MAX_SELCOLS(tp), TY_POINTER) + + call tcs_open (tp, colselect, + TB_SELCOL(tp,1), TB_NSEL_COLS(tp), TB_MAX_SELCOLS(tp)) + + TB_COLUMN_SELECT(tp) = YES # column selection is in effect + + } else { + + TB_COLUMN_SELECT(tp) = NO # column selection is not in effect + + } +end diff --git a/pkg/tbtables/tbsrow.x b/pkg/tbtables/tbsrow.x new file mode 100644 index 00000000..09ec86b8 --- /dev/null +++ b/pkg/tbtables/tbsrow.x @@ -0,0 +1,61 @@ +include "tbtables.h" + +# tbsrow -- add new rows to row select list +# +# The purpose of this routine is to translate the selected row number to +# an actual row number for a table opened read-write. This would not +# normally be called by itself; use tbswer instead, which itself calls +# this routine. +# +# For the case that selrow is larger than the last currently selected row, +# this routine adds one or more new rows to the list of selected rows, with +# the new row numbers being larger than the current number of rows in the +# table. The number of new rows is selrow minus the current number of +# selected rows. In this case the calling routine should actually write +# rows to the table, possibly just INDEF. +# +# The table itself will not be modified by this routine. +# +# NOTE that if rownum is greater than the current number of rows in the +# table, it is important to write to the extra rows and update TB_NROWS +# before calling any other high-level routines. +# +# Phil Hodge, 3-Mar-1998 Subroutine created. + +procedure tbsrow (tp, selrow, rownum) + +pointer tp # i: pointer to table descriptor +int selrow # i: row number (or selected row number) +int rownum # o: actual row number +#-- +int num_new_rows # number of new rows to add +int rst_rownum(), rst_nelem() +errchk rst_rownum, rst_addtab + +begin + if (selrow < 1) + call error (1, "row number less than one is invalid") + + if (TB_ROW_SELECT(tp) == YES) { + + if (selrow > TB_NSEL_ROWS(tp)) { + + num_new_rows = selrow - TB_NSEL_ROWS(tp) + rownum = TB_NROWS(tp) + num_new_rows + + # Include the new row(s) in the list of "selected" rows. + call rst_addtab (TB_ROWSET(tp), TB_NROWS(tp), num_new_rows) + + # Update the number of selected rows. + TB_NSEL_ROWS(tp) = rst_nelem (TB_ROWSET(tp)) + + } else { + + rownum = rst_rownum (TB_ROWSET(tp), selrow) + } + + } else { + + rownum = selrow + } +end diff --git a/pkg/tbtables/tbswer.x b/pkg/tbtables/tbswer.x new file mode 100644 index 00000000..97d71187 --- /dev/null +++ b/pkg/tbtables/tbswer.x @@ -0,0 +1,69 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbswer -- write empty rows +# The purpose of this routine is to write empty (INDEF) rows beyond the +# current end of file if the specified row is larger than the number of +# rows already written to the table. If the specified row is within the +# range of existing rows, the table itself will not be modified. +# +# For a row-ordered table if rownum > EOF additional records will be written +# to fill out the file to include the specified row. For a column-ordered +# table there are two considerations: if rownum > TB_NROWS and <= TB_ALLROWS +# then only TB_NROWS will be updated, but if rownum > TB_ALLROWS then tbtchs +# is called to rewrite the table and increase the allocated number of rows +# by a default amount. +# When putting a column of values to a table, the appropriate actual argument +# for rownum is the number of the last row to be written. +# This routine may only be called when writing to a table. +# +# Phil Hodge, 4-Mar-1998 Subroutine created based on tbtwer. + +procedure tbswer (tp, selrow, rownum) + +pointer tp # i: pointer to table descriptor +int selrow # i: row number (or selected row number) +int rownum # o: actual row number +#-- +int nrows # number of rows on entry to this routine +errchk tbsrow, tbfwer, tbxwer, tbywer, tbzwer + +begin + # Convert selrow to rownum. If rownum is past EOF and there is a + # row selector in effect, add rows to the list of selected rows. + call tbsrow (tp, selrow, rownum) + + nrows = TB_NROWS(tp) + if (rownum <= nrows) + return # nothing further to do + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + + # Write INDEF record(s) at the end of the table file. + call tbxwer (tp, rownum) + + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + + # Increase the length of columns in the table. + call tbywer (tp, rownum) + + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + + # Increase the size of the buffers for storing column values. + call tbzwer (tp, rownum) + + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + + # Write undefined entries for the new rows. + call tbfwer (tp, nrows, rownum) + + } else { + call error (ER_TBCORRUPTED, + "tbswer: bad table type; table or memory corrupted?") + } + + TB_NROWS(tp) = rownum # update TB_NROWS + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbswer1.x b/pkg/tbtables/tbswer1.x new file mode 100644 index 00000000..edc04459 --- /dev/null +++ b/pkg/tbtables/tbswer1.x @@ -0,0 +1,53 @@ +include +include "tbtables.h" + +# tbswer1 -- write empty rows, maybe + +# This routine is like tbswer with one significant difference. If the row +# to be written (selrow) is equal to the current number of rows plus one, +# and if the table is an stsdas type row-ordered table, then this routine +# does NOT write an INDEF row to the table and does NOT update TB_NROWS. +# This is to improve efficiency for this common case, so that the row +# does not need to be written twice (once INDEF, then the actual data). +# Routines such as tbxap[] may take advantage of this option. +# +# For other cases, this routine just calls tbswer, which does write INDEF +# rows to the table and does update TB_NROWS. +# +# If a row selector is in effect, selrow will be converted to rownum, and +# new rows (if rownum is beyond EOF) will be added to the set of selected +# rows. If there is no row selector, the value of selrow will be assigned +# directly to rownum. +# +# Phil Hodge, 4-Mar-1998 Subroutine created. + +procedure tbswer1 (tp, selrow, rownum) + +pointer tp # i: pointer to table descriptor +int selrow # i: row number (or selected row number) +int rownum # o: actual row number +#-- +errchk tbsrow, tbswer + +begin + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + + if (TB_ROW_SELECT(tp) == YES) { + + if (selrow > TB_NSEL_ROWS(tp) + 1) + call tbswer (tp, selrow, rownum) + else + call tbsrow (tp, selrow, rownum) # TB_NROWS not updated + + } else { + + rownum = selrow + if (rownum > TB_NROWS(tp) + 1) + call tbswer (tp, selrow, rownum) + } + + } else { + + call tbswer (tp, selrow, rownum) + } +end diff --git a/pkg/tbtables/tbtables.h b/pkg/tbtables/tbtables.h new file mode 100644 index 00000000..531b1d10 --- /dev/null +++ b/pkg/tbtables/tbtables.h @@ -0,0 +1,200 @@ +# tbtables.h -- Internal definitions for the table I/O package. + +# Software version number. +# +# Version 0 corresponds to STSDAS and TABLES versions 1.2.3 and earlier. +# The row length was restricted to integral multiples of the size of a +# real number. +# +# Version 1 begins with STSDAS and TABLES version 1.3. Short integer +# datatype was introduced, and character strings were rounded up to a +# multiple of the number of bytes in a char. The row length is allowed +# to be any integral multiple of SZ_CHAR. +# +# Version 2 allows header parameters to have comments. +# This change was made after TABLES version 1.3.3 was released. +# +# Version 3 allows the character strings in column definitions to have +# one more character, and the end-of-string character may be absent. +# 14-Apr-1998 + +define TBL_CURRENT_VERSION 3 + +# Default maximum number of header parameters. The current value is TB_MAXPAR. +define DEFMAXPAR 5 + +# Default maximum number of columns. The current value is TB_MAXCOLS. +define DEFMAXCOLS 5 + +# This section describes the size information record. +define LEN_SIZINFO 12 # unit = SZ_INT32 +define SZ_SIZINFO (LEN_SIZINFO * SZ_INT32) +define S_NPAR $1[1] # Number of header parameters +define S_MAXPAR $1[2] # Max number of header pars +define S_NROWS $1[3] # Number of rows +define S_ALLROWS $1[4] # Number of rows allocated +define S_NCOLS $1[5] # Number of columns defined +define S_MAXCOLS $1[6] # Current max number of columns +define S_COLUSED $1[7] # Chars used by defined columns +define S_ROWLEN $1[8] # Total row length alloc (chars) +define S_TYPE $1[9] # Type (row or column ordered) +define S_VERSION $1[10] # Software version number + +# This is the size of the table-descriptor structure. +define LEN_TBLSTRUCT (39) + +# File descriptor for the table file, or pointer to CFITSIO descriptor for +# FITS files. Note that by including TB_FILE2 there's space for two words. +define TB_FILE Memi[$1] +define TB_FILE2 Memi[$1+1] # second half of pointer + +# Table file name; this can be an IRAF virtual file name. +define TB_NAME_PTR Memi[$1+2] # pointer to table name string +define TB_NAME Memc[TB_NAME_PTR($1)] + +# Table file name converted to a host operating system file name. +# This name is needed for CFITSIO, since that uses host OS I/O. +define TB_OS_FILENAME_PTR Memi[$1+3] # pointer to OS file name string +define TB_OS_FILENAME Memc[TB_OS_FILENAME_PTR($1)] + +# General descriptive information. (R) means relevant only for row-ordered +# tables, (C) is for column-ordered tables, and (F) is for FITS tables. +# For row-ordered tables, TB_ROWLEN is the allocated row length in SPP chars, +# while for FITS tables, TB_ROWLEN is the value of NAXIS1, the length in bytes. +define TB_TYPE Memi[$1+4] # what type of table +define TB_SUBTYPE Memi[$1+5] # subtype of text or FITS table +define TB_NPAR Memi[$1+6] # number of header paramters +define TB_MAXPAR Memi[$1+7] # max number of header paramters +define TB_NROWS Memi[$1+8] # number of rows +define TB_ALLROWS Memi[$1+9] # (C) allocated number of rows +define TB_NCOLS Memi[$1+10] # number of columns +define TB_MAXCOLS Memi[$1+11] # current max number of columns +define TB_COLUSED Memi[$1+12] # (R) chars used by columns +define TB_ROWLEN Memi[$1+13] # (R,F) row length +define TB_VERSION Memi[$1+14] # Software version number +define TB_BOD Meml[$1+15] # L beg of data (in SZ_CHAR) +define TB_IOMODE Memi[$1+16] # I/O mode + +# Flags +define TB_IS_OPEN Memb[$1+17] # Table is open? +define TB_READONLY Memb[$1+18] # I/O mode is read-only? +define TB_MODIFIED Memb[$1+19] # Has table been changed? +define TB_INDEF_IS_CURRENT Memb[$1+20] # (F) TB_INDEF is up-to-date? + +# Pointers. TB_INDEF is used for row-ordered tables and FITS tables. +define TB_INDEF Memi[$1+21] # Pointer to indef record buffer +define TB_COLPTR Memi[$1+22] # Ptr to array of column ptrs + +# These are for tables in FITS files. +define TB_HDU Memi[$1+23] # number of HDU in FITS file +define TB_EXTVER Memi[$1+24] # version number +define TB_OVERWRITE Memi[$1+25] # +1 --> yes, 0 --> no +define TB_CD Memi[$1+26] # returned by cd_open() +define TB_EXTNAME_PTR Memi[$1+27] # pointer to EXTNAME +define TB_EXTNAME Memc[TB_EXTNAME_PTR($1)] + +# These are for row and column selectors. +# TB_ROW_SELECT will be YES if there is a row selector in effect for the +# current table. TB_ROWSET will in this case not be NULL, and the actual +# row number corresponding to a selected row number will be: +# rst_rownum (TB_ROWSET(tp), selected_row) +# TB_COLUMN_SELECT will be YES if there is a column selector in effect for +# the current table. TB_SELCOL(tp,M) will in this case be the selectors +# descriptor of Mth selected column (note: not the same as column descriptor) + +define TB_ROW_SELECT Memi[$1+28] # row selection turned on? +define TB_NSEL_ROWS Memi[$1+29] # number of selected rows +define TB_ROWSET Memi[$1+30] # pointer to row set + +define TB_COLUMN_SELECT Memi[$1+31] # column selection turned on? +define TB_NSEL_COLS Memi[$1+32] # number of selected columns +define TB_MAX_SELCOLS Memi[$1+33] # size of TB_SELCOL_PTR array +define TB_SELCOL_PTR Memi[$1+34] +define TB_SELCOL Memi[TB_SELCOL_PTR($1)+$2-1] + +# These are for text tables. +define TB_COMMENT Memi[$1+35] # pointer to comment string +define TB_SZ_COMMENT Memi[$1+36] # size of comment string +define TB_KEYLIST_PTR Memi[$1+37] # pointer to list of keywords +define TB_KEYWORD Memi[TB_KEYLIST_PTR($1)+$2-1] # ptr to keyword + +# Table file name; this can be an IRAF virtual file name. +define TB_SRC_PTR Memi[$1+38] # pointer to source name string +define TB_SRC Memc[TB_SRC_PTR($1)] + + +# Array of pointers to column information. This array can be reallocated +# to allow more columns; the current size at any time is TB_MAXCOLS. +define TB_COLINFO Memi[TB_COLPTR($1)+$2-1] + + + +# Column information structures. + +# This is the size of the buffer for a column name (i.e. including EOS). +define FULL_SZ_COLNAME (SZ_COLNAME+SZ_CHAR) + +# This structure is for maintaining a column definition in memory. +# The size is for five integers plus three strings, unit = SZ_STRUCT. +# Note that some of these are only meaningful for stsdas format tables, +# and some others are only meaningful for FITS tables. +# COL_LEN is the number of char taken up by one cell in the table, +# the entire array (if the column contains arrays) at one row & column. +# COL_OFFSET is the offset in char from the beginning of a row to +# the beginning of a cell in that row (although it is also used for +# a column ordered table). +# In a FITS table, the true data type in the table may be an integer type +# (byte, short, or int), but with TSCALi and TZEROi keywords to scale the +# values to floating point. In this case, COL_DTYPE will be real or +# double, while COL_TDTYPE will be the integer type, and COL_TSCAL and +# COL_TZERO will be something other than 1 and 0 respectively. +# COL_DTYPE is the apparent data type, the type as seen by the user and +# by most of the routines in this interface. + +define LEN_COLSTRUCT (10 + 3*(FULL_SZ_COLNAME)/SZ_STRUCT) + +define COL_NUMBER Memi[$1] # Column number +define COL_OFFSET Memi[$1+1] # Offset from start of row +define COL_LEN Memi[$1+2] # Chars for one cell +define COL_DTYPE Memi[$1+3] # Data type +define COL_TDTYPE Memi[$1+4] # True data type, in FITS table +define COL_NELEM Memi[$1+5] # Length of array +define COL_TSCAL Memd[P2D($1+6)] # TSCAL, if FITS table +define COL_TZERO Memd[P2D($1+8)] # TZERO, if FITS table +define COL_NAME Memc[P2C($1+10)] +define COL_UNITS Memc[P2C($1+10+ FULL_SZ_COLNAME/SZ_STRUCT)] +define COL_FMT Memc[P2C($1+10+2*FULL_SZ_COLNAME/SZ_STRUCT)] + +# This structure is a copy of the bytes read from or written to an +# stsdas format table (either row or column ordered). +define LEN_COLDEF 16 # unit = SZ_STRUCT +define SZ_COLDEF (LEN_COLDEF * SZ_STRUCT32) + +# Lengths of character strings for column information in an stsdas format +# table. Note that SZ_COLNAME, etc, defined in tbset.h are larger than these. +# Note: These have been increased by one character, so there may not be room +# for an EOS. +define SZ_CD_COLNAME 20 # Size of a column name +define SZ_CD_COLUNITS 20 # Size of string for units +define SZ_CD_COLFMT 8 # Size for print format + +define CD_COL_NUMBER Memi[$1] # Column number +define CD_COL_OFFSET Memi[$1+1] # Offset from start of row +define CD_COL_LEN Memi[$1+2] # Chars for one cell +define CD_COL_DTYPE Memi[$1+3] # Data type +define CD_COL_NAME Memc[P2C($1+4)] # Column name 20 +define CD_COL_UNITS Memc[P2C($1+9)] # Units 20 +define CD_COL_FMT Memc[P2C($1+14)] # Print format 8 + + +# Definitions of data types. These agree with iraf.h at the time of writing. +define TBL_TY_BOOL 1 +define TBL_TY_CHAR 2 +define TBL_TY_SHORT 3 +define TBL_TY_INT 4 +define TBL_TY_REAL 6 +define TBL_TY_DOUBLE 7 + +# Undefined double for tables. This agrees with the pre-IRAF 2.11 INDEFD. +define TBL_INDEFD 1.6d38 +define TBL_IS_INDEFD (($1)==TBL_INDEFD) diff --git a/pkg/tbtables/tbtacc.x b/pkg/tbtables/tbtacc.x new file mode 100644 index 00000000..0370221f --- /dev/null +++ b/pkg/tbtables/tbtacc.x @@ -0,0 +1,40 @@ +include + +# tbtacc -- test for existence of table +# This function returns YES if the table exists, NO if not. +# We attempt to open the specified file read-only as a table using tbtopn. +# If that fails, either the file does not exist or it is not a table (or +# we don't have read access to it), and the value NO is returned as the +# function value. If the open is successful, it exists but still might not +# be a table (it could be a FITS primary header or IMAGE extension). We +# therefore get the table subtype to check for this. If the subtype is +# image, we return NO; otherwise, we return YES. +# (Until 4-Dec-90 we called tbtext and access. The problem with that was +# that it would report YES for any file that existed regardless of whether +# it really was a table.) +# +# Phil Hodge, 25-Aug-1987 Function created. +# Phil Hodge, 4-Dec-1990 Use tbtopn instead of access. +# Phil Hodge, 22-Feb-2002 If tbtopn succeeds, test if subtype is image. + +int procedure tbtacc (tablename) + +char tablename[ARB] # i: the table name +#-- +pointer tp +pointer tbtopn() +int subtype, tbpsta() + +begin + iferr { + tp = tbtopn (tablename, READ_ONLY, NULL) + } then { + return (NO) + } + subtype = tbpsta (tp, TBL_SUBTYPE) + call tbtclo (tp) + if (subtype == TBL_SUBTYPE_IMAGE) + return (NO) + else + return (YES) +end diff --git a/pkg/tbtables/tbtbod.x b/pkg/tbtables/tbtbod.x new file mode 100644 index 00000000..ece8f25a --- /dev/null +++ b/pkg/tbtables/tbtbod.x @@ -0,0 +1,28 @@ +include +include +include "tbtables.h" +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbtbod -- beginning of data +# This function returns the offset (in char) of the first element in the +# data portion of a table relative to the beginning of the file. The offset +# includes a size-information record, maxpar records that may contain user +# parameters, and maxcols records that may contain column descriptors. +# The input arguments maxpar and maxcols would normally be TB_MAXPAR(tp) +# and TB_MAXCOLS(tp). +# +# Phil Hodge, 14-Apr-1998 Change SZ_COLSTRUCT to SZ_COLDEF. + +long procedure tbtbod (maxpar, maxcols) + +int maxpar # i: current maximum number of header parameters +int maxcols # i: current maximum number of columns +#-- +long offset + +begin + offset = SZ_SIZINFO + + maxpar * SZ_PACKED_REC + + maxcols * SZ_COLDEF + 1 + return (offset) +end diff --git a/pkg/tbtables/tbtchs.x b/pkg/tbtables/tbtchs.x new file mode 100644 index 00000000..54ad3a6a --- /dev/null +++ b/pkg/tbtables/tbtchs.x @@ -0,0 +1,176 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +# tbtchs -- change table size +# This procedure changes the size of a table in order to change the +# allocated space for header keywords or column descriptors, or to +# change the allocated row length or column length. If the table is +# open (and not readonly) then it will be physically reorganized by +# copying it to a temporary file, deleting the original table, and then +# renaming the temporary file to the name of the original table. The +# value of tp is not changed. +# +# If an input value is negative then no change will be made to the +# corresponding table parameter. If an input value is non-negative but +# less than the minimum reasonable value then the new value will be set +# to the minimum. +# +# If the table is open the size information record will be rewritten, +# even if nothing needs to be done with regard to changing the table size. +# (This applies only to stsdas format tables, not opened readonly.) +# +# If maxcols is not the same as the current value, the array of pointers +# to column descriptors will be reallocated. +# The value of tb_file might be changed if the table is open. +# +# Phil Hodge, 28-Aug-1987 Use zero to truncate to minimum allowed value. +# Phil Hodge, 8-Oct-1987 TB_COLPTR is of type TY_POINTER. +# Phil Hodge, 26-Apr-1989 Save and restore (if error) size info from tp. +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 30-Mar-1993 Minimum row length is now SZ_CHAR, not SZ_REAL. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 20-Jun-1995 Modify for FITS tables. +# Phil Hodge, 9-Jul-1996 For FITS tables, realloc TB_COLPTR if required. +# Phil Hodge, 7-Jun-1999 Add old_maxpar to calling sequence of tbzsiz; +# OK to call this routine for a readonly table (to realloc buffers). + +procedure tbtchs (tp, maxpar, maxcols, rowlen, allrows) + +pointer tp # i: pointer to table descriptor +int maxpar # i: new value for max number of header keywords +int maxcols # i: new value for maximum number of columns +int rowlen # i: new value for row length +int allrows # i: new value of allocated number of rows +#-- +pointer tp_save # for saving size info from tp +int new_maxpar # New value of max number of header keywords +int new_maxcols # New value of maximum number of columns +int new_rowlen # New value of row length +int new_allrows # New value of allocated number of rows +int old_maxpar # Previous value of max number of keywords +int old_maxcols # Previous value of maximum number of columns +int old_rowlen # Previous value of row length +int old_allrows # Previous value of allocated number of rows +int old_ncols # Previous value of number of columns defined +int old_colused # Previous value of used portion of row +long tbtbod() + +errchk realloc, tbtwsi + +begin + # Update the size info record and flush the file. + if (TB_IS_OPEN(tp) && !TB_READONLY(tp) && + (TB_TYPE(tp) == TBL_TYPE_S_ROW || + TB_TYPE(tp) == TBL_TYPE_S_COL)) { + call tbtwsi (tp) + call flush (TB_FILE(tp)) + } + + # Space allocated for header keywords. + if (maxpar >= 0) + new_maxpar = maxpar + else + new_maxpar = TB_MAXPAR(tp) + new_maxpar = max (new_maxpar, TB_NPAR(tp)) + + # Space allocated for column descriptors. + if (maxcols > 0) + new_maxcols = maxcols + else if (maxcols == 0) + new_maxcols = 1 + else + new_maxcols = TB_MAXCOLS(tp) + new_maxcols = max (1, new_maxcols, TB_NCOLS(tp)) + + # Row length. + if (rowlen > 0) + new_rowlen = rowlen + else if (rowlen == 0) + new_rowlen = SZ_CHAR + else + new_rowlen = TB_ROWLEN(tp) + new_rowlen = max (SZ_CHAR, new_rowlen, TB_COLUSED(tp)) + + if (allrows > 0) + new_allrows = allrows + else if (allrows == 0) + new_allrows = 1 + else + new_allrows = TB_ALLROWS(tp) + new_allrows = max (1, new_allrows, TB_NROWS(tp)) + + # Save current values. + old_maxpar = TB_MAXPAR(tp) + old_maxcols = TB_MAXCOLS(tp) + old_rowlen = TB_ROWLEN(tp) + old_allrows = TB_ALLROWS(tp) + old_ncols = TB_NCOLS(tp) + old_colused = TB_COLUSED(tp) + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + # Maxcols is the only parameter we might need to change. + new_maxpar = old_maxpar + new_rowlen = old_rowlen + new_allrows = old_allrows + } + + # Quit now if we really don't need to do anything. + if ((old_maxpar == new_maxpar) && (old_maxcols == new_maxcols) && + (old_rowlen == new_rowlen) && (old_allrows == new_allrows)) + return + + # Save the size info from tp. If there is an error rewriting the + # table we must restore this info back into tp; otherwise, we just + # free the memory pointed to by tp_save. + call tbdsav (tp, tp_save) + + # Reallocate the array of pointers to column descriptors, and + # assign new values in the table descriptor. + if (new_maxcols != TB_MAXCOLS(tp)) { + call realloc (TB_COLPTR(tp), new_maxcols, TY_POINTER) + TB_MAXCOLS(tp) = new_maxcols + } + TB_MAXPAR(tp) = new_maxpar + TB_ROWLEN(tp) = new_rowlen + TB_ALLROWS(tp) = new_allrows + TB_BOD(tp) = tbtbod (new_maxpar, new_maxcols) + + if (TB_IS_OPEN(tp)) { + + # This is OK even for a readonly file; it just reallocates memory. + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + iferr { + call tbzsiz (tp, old_maxpar, old_allrows) + } then { + call tbdres (tp, tp_save) + call erract (EA_ERROR) + } + } + + if (!TB_READONLY(tp)) { + # Reorganize the data file. + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) { + iferr { + call tbxsiz (tp, old_maxpar, old_maxcols, + old_ncols, old_rowlen, old_colused) + } then { + call tbdres (tp, tp_save) # restore size info + call erract (EA_ERROR) + } + TB_MODIFIED(tp) = true + } else if (TB_TYPE(tp) == TBL_TYPE_S_COL) { + iferr { + call tbysiz (tp, old_maxpar, old_maxcols, + old_ncols, old_allrows) + } then { + call tbdres (tp, tp_save) + call erract (EA_ERROR) + } + TB_MODIFIED(tp) = true + } + } + } + call tbdfre (tp_save) +end diff --git a/pkg/tbtables/tbtclo.x b/pkg/tbtables/tbtclo.x new file mode 100644 index 00000000..4673bf0e --- /dev/null +++ b/pkg/tbtables/tbtclo.x @@ -0,0 +1,91 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbtclo -- close a table +# The files themselves are closed, and memory that was allocated for +# descriptors is released. +# +# Phil Hodge, 8-Oct-1987 TB_COLPTR is of type TY_POINTER. +# Phil Hodge, 16-Nov-1990 Eliminate calls to tbxclo, tbyclo. +# Phil Hodge, 13-Jan-1992 Add option for text table type. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 23-Dec-1994 Deallocate space for table and file or HDU names. +# Phil Hodge, 3-Apr-1995 Check TB_MODIFIED before calling tbtwsi. +# Phil Hodge, 2-Mar-1998 Deallocate memory for row & column selectors. +# Phil Hodge, 22-Mar-1999 Deallocate memory for host OS file name. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE; +# move deallocation of comment buffer to tbzclo. + +procedure tbtclo (tp) + +pointer tp # i: pointer to descriptor of table to be closed +#-- +int colnum # Column number +errchk tbfclo, tbvclo, tbzclo + +begin + if (tp == NULL) + return + + # Text file; write values back to file if not read-only, and + # deallocate buffers for column data. + if (TB_TYPE(tp) == TBL_TYPE_TEXT) + call tbzclo (tp) + + # If the table has been changed, rewrite the current size information. + if (TB_MODIFIED(tp) && TB_FILE(tp) != NULL) + call tbtwsi (tp) + + # Check for FITS file. + if (TB_TYPE(tp) == TBL_TYPE_FITS) + call tbfclo (tp) + + # Close the file itself. + if (TB_FILE(tp) != NULL) + call close (TB_FILE(tp)) + + # Check for CDF file. +# *** + if (TB_TYPE(tp) == TBL_TYPE_CDF) + ; # call qp_close (TB_CD(tp)) + + # Free memory used for row and column selectors. + if (TB_ROW_SELECT(tp) == YES) { + if (TB_ROWSET(tp) != NULL) + call rst_free (TB_ROWSET(tp)) + } + + if (TB_COLUMN_SELECT(tp) == YES) { + if (TB_SELCOL_PTR(tp) != NULL) { + call tcs_close (Memi[TB_SELCOL_PTR(tp)], TB_NSEL_COLS(tp)) + call mfree (TB_SELCOL_PTR(tp), TY_POINTER) + } + } + + # Free memory used for column descriptors. + do colnum = 1, TB_NCOLS(tp) { + if (TB_COLINFO(tp,colnum) != NULL) + call mfree (TB_COLINFO(tp,colnum), TY_STRUCT) + } + # Free memory for the array of pointers to column descriptors. + if (TB_COLPTR(tp) != NULL) + call mfree (TB_COLPTR(tp), TY_POINTER) + + # Free memory for buffer for the indef record (null value for each col) + if (TB_INDEF(tp) != NULL) + call mfree (TB_INDEF(tp), TY_CHAR) + + # Deallocate space for the CDF file or FITS HDU name. + if (TB_EXTNAME_PTR(tp) != NULL) + call mfree (TB_EXTNAME_PTR(tp), TY_CHAR) + + # Deallocate space for the table name. + if (TB_NAME_PTR(tp) != NULL) + call mfree (TB_NAME_PTR(tp), TY_CHAR) + if (TB_OS_FILENAME_PTR(tp) != NULL) + call mfree (TB_OS_FILENAME_PTR(tp), TY_CHAR) + + # Free memory for the table descriptor. + call mfree (tp, TY_STRUCT) +end diff --git a/pkg/tbtables/tbtcpy.x b/pkg/tbtables/tbtcpy.x new file mode 100644 index 00000000..e5235baa --- /dev/null +++ b/pkg/tbtables/tbtcpy.x @@ -0,0 +1,224 @@ +include # for IS_ALNUM +include +include "tbtables.h" + +# tbtcpy -- copy a table +# The filename extension is taken to imply a table type, which may be +# either row-ordered, FITS, or text (or eventually CDF). +# +# If the output is a FITS file and no EXTNAME was given in the outtable +# string, the name of the input table (in brackets and without directory +# prefix) will be appended to outtable as EXTNAME. If the input is also +# a FITS file, however, the input name will not be appended to outtable +# if the keyword EXTNAME is present in the input header (i.e. we would +# rather copy EXTNAME from the input header than override it with just +# a file name). +# +# Phil Hodge, 28-Dec-1989 Open before copying to verify that it is a table. +# Phil Hodge, 14-May-1992 Check for text table; call tbtext only if binary. +# Phil Hodge, 11-Jul-1995 Use fcopy, fcopyo or tbrcpy. +# Phil Hodge, 5-Oct-1995 For FITS output, set extname = input name. +# Phil Hodge, 11-Dec-1995 Use tbrcsc instead of tbrcpy. +# Phil Hodge, 8-May-1997 Don't require explicit extension for FITS input. +# Phil Hodge, 14-Aug-1997 Call tbtwer if output table is FITS. +# Phil Hodge, 30-Sep-1997 Use tbpsta instead of TB_NROWS & TB_NCOLS; +# when appending input table name to be used as the +# EXTNAME for output, use Memc[in] instead of intable. +# Phil Hodge, 15-Jun-1998 Only use fcopy for text input if the entire file +# is to be copied, i.e. no row or column selector. +# Phil Hodge, 16-Apr-1999 Call tbttyp to get file type; +# remove check for STDOUT, since that's done in tbttyp; +# remove table type from calling sequence of tbparse; +# don't try to set type to FITS using tbpset; +# use root_len to skip over input directory prefix for EXTNAME; +# change SZ_LINE to SZ_FNAME. + +procedure tbtcpy (intable, outtable) + +char intable[ARB] # i: name of table to be copied to outtable +char outtable[ARB] # i: name of new table +#-- +pointer sp +pointer in, out # table names without brackets +pointer iextn, oextn # EXTNAME +pointer scratch +pointer itp, otp # pointers to descr for input & output tables +pointer icp, ocp # pointers to arrays of column descriptors +int itype, otype # table types based on extension +int ihdu, ohdu # HDU number, if any (ignored) +int ncols # number of columns +int nrows # number of rows in input table +int row # loop index for row number +int junk +int dotloc # location of last '.' in file name +int root_len # number of char in input directory name +int exists # returned by tbttyp and ignored +int i +bool from_stdin # is intable STDIN? +bool cat_extname # should we append input name to use as EXTNAME? + +pointer tbtopn(), tbcnum() +int strlen() +int fnldir() +int tbparse(), tbttyp() +int tbpsta() +bool streq() +errchk fcopy, fcopyo, tbtopn, tbtcre, tbhcal, tbrcsc, tbparse, tbttyp, tbtwer + +begin + call smark (sp) + call salloc (in, SZ_FNAME, TY_CHAR) + call salloc (out, SZ_FNAME, TY_CHAR) + call salloc (iextn, SZ_FNAME, TY_CHAR) + call salloc (oextn, SZ_FNAME, TY_CHAR) + call salloc (scratch, SZ_FNAME, TY_CHAR) + + # Get the file names and EXTNAMEs or numbers for the tables. + junk = tbparse (intable, Memc[in], Memc[iextn], SZ_FNAME, ihdu) + if (tbparse (outtable, Memc[out], Memc[oextn], SZ_FNAME, ohdu) < 1) + call error (1, "no output name specified") + + # If the input table is a URL, do a dummy open to ensure we convert + # it before processing. +# itp = tbtopn (Memc[in], READ_ONLY, NULL) +# call tbtclo (itp) + + # Get the table type (based on extension, if any, for output table). + itype = tbttyp (Memc[in], exists) + otype = tbttyp (Memc[out], exists) + + # No CDF name for CDF file? + if (Memc[iextn] == EOS && itype == TBL_TYPE_CDF) { + call sprintf (Memc[scratch], SZ_FNAME, + "can't copy entire CDF file `%s'; specify which table") + call pargstr (intable) + call error (1, Memc[scratch]) + } + + from_stdin = streq (intable, "STDIN") + + # Open the input table (but if it's STDIN we'll open it later). + if (!from_stdin) { + itp = tbtopn (intable, READ_ONLY, NULL) + itype = TB_TYPE(itp) # actual table type + } + + # Update output table type, if appropriate. + + if (itype == TBL_TYPE_TEXT) { + + # Check whether the output file name contains an extension. + dotloc = 0 # initial value + do i = strlen (Memc[out]), 1, -1 { + if (Memc[out+i-1] == '.') { # found it + dotloc = i + break + } + if (!IS_ALNUM(Memc[out+i-1])) # stop at first special char + break + } + if (dotloc > 0) { + # Output file name has an extension. Set the table type + # to stsdas format (row) if the extension is ".tab". + if (streq (Memc[out+dotloc], "tab")) { + otype = TBL_TYPE_S_ROW + } else if (otype != TBL_TYPE_FITS) { # don't change FITS + otype = TBL_TYPE_TEXT + } + } else { + otype = TBL_TYPE_TEXT + } + } + + # If we're copying an entire text file to a text file, use fcopy. + if (itype == TBL_TYPE_TEXT && otype == TBL_TYPE_TEXT && + Memc[iextn] == EOS && !from_stdin) { + call tbtclo (itp) + call fcopy (intable, outtable) + call sfree (sp) + return # done + } + + # If we're reading from STDIN, now is the time to open it. + # The reason we didn't open it before is that we weren't sure of + # the output table type; for text output we already used fcopy above. + if (from_stdin) + itp = tbtopn (intable, READ_ONLY, NULL) + + # If the output is a FITS file, and no EXTNAME was given in the + # file name, append the input table name (without directory) + # to use as EXTNAME. If the input is also a FITS file, however, + # the EXTNAME from the input (if present) will be used for output. + # NOTE that we're clobbering the previous contents of Memc[out]. + call strcpy (outtable, Memc[out], SZ_FNAME) + if (otype == TBL_TYPE_FITS && Memc[oextn] == EOS) { + cat_extname = true # may be reset below + if (itype == TBL_TYPE_FITS) { + # Don't append anything if EXTNAME is present in input header. + ifnoerr { + call tbhgtt (itp, "EXTNAME", Memc[scratch], SZ_FNAME) + } then { + cat_extname = false + } + } + if (cat_extname) { + root_len = fnldir (Memc[in], Memc[scratch], SZ_FNAME) + call strcat ("[", Memc[out], SZ_FNAME) + call strcat (Memc[in+root_len], Memc[out], SZ_FNAME) + call strcat ("]", Memc[out], SZ_FNAME) + } + } + + # Open the output table. + otp = tbtopn (Memc[out], NEW_COPY, itp) + + # Override NEW_COPY table type if output type should be row. + if (itype != otype && otype == TBL_TYPE_S_ROW) + call tbpset (otp, TBL_WHTYPE, TBL_TYPE_S_ROW) + + # Create the table file. + call tbtcre (otp) + + # Copy the contents from input to output. + + if (itype != otype || + itype == TBL_TYPE_TEXT || itype == TBL_TYPE_FITS || + Memc[iextn] != EOS) { + + ncols = tbpsta (itp, TBL_NCOLS) + nrows = tbpsta (itp, TBL_NROWS) + + call salloc (icp, ncols, TY_POINTER) + call salloc (ocp, ncols, TY_POINTER) + + do i = 1, ncols { + Memi[icp+i-1] = tbcnum (itp, i) + Memi[ocp+i-1] = tbcnum (otp, i) + } + + call tbhcal (itp, otp) # copy all header parameters + + if (otype == TBL_TYPE_FITS) # fill out the file with INDEF + call tbtwer (otp, nrows) + + do row = 1, nrows # copy all rows + call tbrcsc (itp, otp, Memi[icp], Memi[ocp], row, row, ncols) + + } else { # same type, and neither is FITS + + # Copy the whole file. + call seek (TB_FILE(itp), BOF) + call seek (TB_FILE(otp), BOF) + call fcopyo (TB_FILE(itp), TB_FILE(otp)) + call flush (TB_FILE(otp)) + + # Update the size information in the otp struct. + call tbtrsi (otp) + + } + + call tbtclo (otp) + call tbtclo (itp) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbtcre.x b/pkg/tbtables/tbtcre.x new file mode 100644 index 00000000..3935b9b0 --- /dev/null +++ b/pkg/tbtables/tbtcre.x @@ -0,0 +1,66 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbtcre -- Create a new table +# This routine is called after calling tbtopn for a new table. +# For binary tables, this routine appends the default extension. +# +# Phil Hodge, 14-Aug-1987 Error if table is already open. +# Phil Hodge, 13-Jan-1992 Add option for text table type. +# Phil Hodge, 5-Mar-1993 Deallocate comment buffer if not a text table. +# Phil Hodge, 15-Dec-1994 Table name is now SZ_LINE instead of SZ_FNAME. +# Phil Hodge, 23-Dec-1994 Add option for CDF or FITS file. +# Phil Hodge, 3-Apr-1995 Set TB_MODIFIED to true. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE. +# Phil Hodge, 15-Jun-1999 Reset subtype for stsdas format tables. + +procedure tbtcre (tp) + +pointer tp # Pointer to table descriptor +#-- +errchk tbtext, tbvnew, tbwnew, tbfnew, tbxnew, tbynew, tbznew + +begin + if (TB_IS_OPEN(tp)) + call error (1, "tbtcre: table is already open") + + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { # text file + call tbznew (tp) + + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { # FITS table + call tbfnew (tp) + + } else { + + # For a binary table we need to check that there's an + # extension, and if not, append the default extension. + call tbtext (TB_NAME(tp), TB_NAME(tp), SZ_LINE) + + # Will the table be stored in a CDF file? If it's a CDF file, + # we'll also do the initialization for a row-ordered table. + if (TB_TYPE(tp) == TBL_TYPE_CDF) # common data format + ; # call tbvnew (tp) + + else if (TB_TYPE(tp) == TBL_TYPE_MI) # machine independent + ; # call tbwnew (tp) + else if (TB_TYPE(tp) == TBL_TYPE_S_ROW) # SDAS row-ordered + call tbxnew (tp) + else if (TB_TYPE(tp) == TBL_TYPE_S_COL) # SDAS column-ordered + call tbynew (tp) + else + call error (ER_TBCORRUPTED, "tbtcre: table type is messed up") + + # We don't need this if it's not a text table. + if (TB_COMMENT(tp) != NULL) { + call mfree (TB_COMMENT(tp), TY_CHAR) + TB_SZ_COMMENT(tp) = 0 + } + + # Subtype is not relevant. + TB_SUBTYPE(tp) = TBL_SUBTYPE_UNKNOWN + } + + TB_IS_OPEN(tp) = true + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbtdel.x b/pkg/tbtables/tbtdel.x new file mode 100644 index 00000000..1c180ae3 --- /dev/null +++ b/pkg/tbtables/tbtdel.x @@ -0,0 +1,111 @@ +include +include "tbtables.h" + +# tbtdel -- delete a table +# This procedure deletes a table. The default extension will be appended +# to the table name if no extension is present. +# +# For a FITS file, the HDU specified (or implied by default) in the table +# name will be deleted. The FITS file itself will not be deleted, even if +# all that remains is the primary header. +# +# For a CDF file, the specified table will be deleted. If there are no +# other parameters in the CDF file, the file itself will be deleted. +# +# Phil Hodge, 28-Dec-1989 Open before deleting to verify that it is a table. +# Phil Hodge, 14-May-1992 Don't call tbtext; check for text table. +# Phil Hodge, 14-Jul-1992 When making the previous change, I must have deleted +# the call to error in the case that there was an error +# from tbtopn, so this call has been put back in. +# Phil Hodge, 26-Jun-1995 Modify for FITS file or CDF file. +# Phil Hodge, 16-Apr-1999 Call tbttyp to get file type; +# call tbnparse instead of tbparse; change SZ_LINE to SZ_FNAME; +# delete most references to CDF. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE; +# test on Memc[brackets] instead of Memc[extname] to check +# that a particular FITS extension was specified. + +procedure tbtdel (table) + +char table[ARB] # i: name of table to be deleted +#-- +pointer sp +pointer tname # for table name (and possible error message) +pointer fname # file name +pointer extname # EXTNAME or number for FITS file +pointer brackets, rowsel, colsel # returned by tbnparse and ignored +pointer tp # pointer to table descriptor +int hdu, extver, overwrite # returned by tbnparse and ignored +int ttype, exists # returned by tbttyp; exists is ignored +#*** pointer fl # file list pointer for fields in CDF file +#*** int nparam # number of parameters in CDF file +#*** pointer qp_ofnls() +#*** int qp_lenfnl() +pointer tbtopn() +int tbnparse(), tbttyp() +errchk qp_deletef, tbtopn, tbfdel, tbnparse, tbttyp + +begin + call smark (sp) + call salloc (tname, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (extname, SZ_FNAME, TY_CHAR) + call salloc (brackets, SZ_FNAME, TY_CHAR) + call salloc (rowsel, SZ_FNAME, TY_CHAR) + call salloc (colsel, SZ_FNAME, TY_CHAR) + + # Check whether we have been asked to delete a FITS file without + # any specification of which extension is the table. + if (tbnparse (table, Memc[fname], Memc[extname], Memc[brackets], + SZ_FNAME, extver, hdu, overwrite, + Memc[rowsel], Memc[colsel], SZ_FNAME) < 1) + call error (1, "name of table to delete is blank") + + ttype = tbttyp (Memc[fname], exists) + + # No EXTNAME for FITS file? + if (ttype == TBL_TYPE_FITS && Memc[brackets] == EOS) { + call sprintf (Memc[tname], SZ_FNAME, + "can't delete entire FITS file `%s'; specify extension") + call pargstr (table) + call error (1, Memc[tname]) + } + + # Open the table that is to be deleted. + tp = tbtopn (table, READ_WRITE, NULL) + + # Get the full name of the file, including filename extension. + call strcpy (TB_NAME(tp), Memc[tname], SZ_FNAME) + + # Delete the table. + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + + # Delete the current HDU, and close the table. The FITS file + # itself is not deleted. + call tbfdel (tp) + + } else if (TB_TYPE(tp) == TBL_TYPE_CDF) { + + ; # skip this section until CDF format is defined + + # Here the table is a field within a CDF file. +#*** call qp_deletef (TB_CD(tp), TB_CDF_NAME(tp)) + +#*** fl = qp_ofnls (TB_CD(tp), "") +#*** nparam = qp_lenfnl (fl) # total number of parameters +#*** call qp_cfnl (fl) +#*** call tbtclo (tp) + + # If there's nothing left in the CDF file, delete the file itself. +#*** if (nparam < 1) +#*** call delete (Memc[tname]) + + } else { + + # An ordinary FIO file. + call tbtclo (tp) + call delete (Memc[tname]) + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbtext.x b/pkg/tbtables/tbtext.x new file mode 100644 index 00000000..7a384e28 --- /dev/null +++ b/pkg/tbtables/tbtext.x @@ -0,0 +1,100 @@ +include +include +include "tblerr.h" + +# tbtext -- append default extension +# If the input table name inname already has an extension then inname is +# just copied to the output string outname; otherwise, outname will be +# assigned the input name plus the default extension ".tab". +# The input and output strings may be the same. +# +# An extension is defined by a '.' that is not followed by anything other +# than alphanumeric characters. A file name that ends in '.' is regarded +# as having an extension, and nothing will be appended. +# +# Phil Hodge, 7-Aug-1987 Check whether table name is too long. +# Phil Hodge, 20-Mar-1995 Call tbparse. +# Phil Hodge, 30-Sep-1997 Look for extension in Memc[name] instead of inname. +# Phil Hodge, 15-Jun-1998 Use ttype from tbparse to check for a text file or +# FITS file, and don't append extension in that case. +# Phil Hodge, 12-Apr-1999 Call tbttyp to get file type; +# remove table type from calling sequence of tbparse; +# use strlen(defext) instead of LEN_EXT; +# change SZ_LINE to SZ_FNAME. + +procedure tbtext (inname, outname, maxch) + +char inname[ARB] # i: table name, possibly without extension +char outname[ARB] # o: table name, including extension +int maxch # i: max number of char in inname or outname +#-- +pointer sp +pointer name # pointer to scratch for name +pointer brackets # bracketed expression at end of inname +int hdu # returned by tbparse and ignored +int ttype, exists # returned by tbttyp; exists is ignored +int dotloc # location of last '.' in file name +int k # loop index +bool no_change # true if table name is OK as is +string defext ".tab" # the default extension for a table +int tbttyp() +int strlen(), locva() +int tbparse() +errchk tbparse + +begin + if (strlen(inname) > maxch) + call error (ER_TBNAMTOOLONG, "table name is too long") + + call smark (sp) + call salloc (name, maxch, TY_CHAR) + call salloc (brackets, SZ_FNAME, TY_CHAR) + + # Extract file name from inname in case inname includes a bracketed + # expression. + # The file name is Memc[name], and the extname is Memc[brackets]. + if (tbparse (inname, Memc[name], Memc[brackets], SZ_FNAME, hdu) < 1) + call error (1, "no table name given") + + # Get the table type. + ttype = tbttyp (Memc[name], exists) + + # Check whether we need to append an extension. + no_change = false # initial value + if (ttype == TBL_TYPE_TEXT) { + no_change = true + } else if (ttype == TBL_TYPE_FITS) { + no_change = true + } else { + # Search for a dot that is not followed by '$' or ']'. + dotloc = 0 # initial value + do k = 1, maxch { + if (Memc[name+k-1] == EOS) + break + + if (Memc[name+k-1] == '.') + dotloc = k + else if (!IS_ALNUM(Memc[name+k-1])) + dotloc = 0 # reset following special char + } + if (dotloc > 0) + no_change = true # already has an extension + } + + if (no_change) { + + # Return the unmodified input name. + if (locva (inname) != locva (outname)) + call strcpy (inname, outname, maxch) + + } else { + + # Append default extension if there is room for it. + if (strlen(inname) + strlen(defext) > maxch) + call error (ER_TBNAMTOOLONG, "table name is too long") + call strcat (defext, Memc[name], maxch) + call strcpy (Memc[name], outname, maxch) # copy to output + call strcat (Memc[brackets], outname, maxch) + } + call sfree (sp) +end diff --git a/pkg/tbtables/tbtflu.x b/pkg/tbtables/tbtflu.x new file mode 100644 index 00000000..145c6930 --- /dev/null +++ b/pkg/tbtables/tbtflu.x @@ -0,0 +1,34 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbtflu -- call flush +# This routine writes the size-information record (in case the number of +# rows or columns has changed) and then flushes the fio buffer for the table. +# +# Phil Hodge, 2-Nov-1988 Subroutine created. +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 20-Jun-1995 Add option for FITS tables. + +procedure tbtflu (tp) + +pointer tp # i: pointer to table descriptor +#-- + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT) + return # don't do anything for text file + + if (TB_TYPE(tp) == TBL_TYPE_FITS) + return # don't do anything for FITS file + + if (TB_FILE(tp) == NULL) + call error (ER_TBNOTOPEN, "tbtflu: table is not open") + + if (TB_READONLY(tp)) + call error (ER_TBREADONLY, "tbtflu: table is readonly") + + call tbtwsi (tp) # write size-info record + + call flush (TB_FILE(tp)) +end diff --git a/pkg/tbtables/tbtfst.x b/pkg/tbtables/tbtfst.x new file mode 100644 index 00000000..02add3dc --- /dev/null +++ b/pkg/tbtables/tbtfst.x @@ -0,0 +1,45 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbtfst -- call fseti +# This procedure calls fseti to set F_ADVICE to either RANDOM or SEQUENTIAL +# for a table file. The file is first closed and then reopened because +# the buffer size cannot be changed after the first I/O to a file. (The +# table was read when first opened.) The value of TB_FILE(tp) might be +# changed. The file is reopened either readonly or read/write. +# +# Phil Hodge, 30-Sep-1987 Subroutine created. +# Phil Hodge, 15-Nov-1988 Modify error message. +# Phil Hodge, 5-Oct-1995 Check table type. + +procedure tbtfst (tp, fset_option, fset_value) + +pointer tp # i: pointer to table descriptor +int fset_option # i: specifies what FIO parameter is to be set +int fset_value # i: the value that is to be assigned +#-- +int iomode # I/O mode for reopening the file +int open() + +errchk close, open + +begin + if (TB_FILE(tp) == NULL) + call error (ER_TBNOTOPEN, + "tbtfst: table must be open to set FIO option") + + if (TB_TYPE(tp) != TBL_TYPE_S_ROW && TB_TYPE(tp) != TBL_TYPE_S_COL) + return + + if (TB_READONLY(tp)) { + iomode = READ_ONLY + } else { + call tbtwsi (tp) # update size information record + iomode = READ_WRITE + } + call close (TB_FILE(tp)) + TB_FILE(tp) = open (TB_NAME(tp), iomode, BINARY_FILE) + + call fseti (TB_FILE(tp), fset_option, fset_value) +end diff --git a/pkg/tbtables/tbtnam.x b/pkg/tbtables/tbtnam.x new file mode 100644 index 00000000..2cf68e05 --- /dev/null +++ b/pkg/tbtables/tbtnam.x @@ -0,0 +1,51 @@ +include +include "tbtables.h" +define SZ_SCRATCH 11 + +# tbtnam -- get table name +# Get the name of a table which has been opened or at least initialized. +# +# Phil Hodge, 16-Jun-1995 Modify for FITS tables. +# Phil Hodge, 2-Feb-1996 Option to include TB_HDU or TB_EXTVER. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE. + +procedure tbtnam (tp, tblname, maxch) + +pointer tp # i: pointer to table descriptor +char tblname[ARB] # o: the name of the table +int maxch # i: maximum number of characters in name +#-- +char scratch[SZ_SCRATCH] # scratch for appending EXTVER + +begin + # Use the source name/url if it is present. + if (TB_SRC_PTR(tp) != NULL) { + call strcpy (TB_SRC(tp), tblname, maxch) + return + } + + call strcpy (TB_NAME(tp), tblname, maxch) + + if (TB_TYPE(tp) == TBL_TYPE_FITS || TB_TYPE(tp) == TBL_TYPE_CDF) { + + # This will be non-null only if the user specified a name. + if (TB_EXTNAME(tp) != EOS) { + + call strcat ("[", tblname, maxch) + call strcat (TB_EXTNAME(tp), tblname, maxch) + + if (TB_EXTVER(tp) > 0) { + call sprintf (scratch, SZ_SCRATCH, ",%d") + call pargi (TB_EXTVER(tp)) + call strcat (scratch, tblname, maxch) + } + call strcat ("]", tblname, maxch) + + } else if (TB_HDU(tp) >= 0) { + + call sprintf (scratch, SZ_SCRATCH, "[%d]") + call pargi (TB_HDU(tp)) + call strcat (scratch, tblname, maxch) + } + } +end diff --git a/pkg/tbtables/tbtopn.x b/pkg/tbtables/tbtopn.x new file mode 100644 index 00000000..2547ff01 --- /dev/null +++ b/pkg/tbtables/tbtopn.x @@ -0,0 +1,280 @@ +# This file contains tbtopn and tbtvfn. + +include +include +include +include "tbtables.h" +include "tblerr.h" + +# tbtopn -- Open a table +# For a new table this procedure only creates the table descriptor, +# fills in default values, and creates the array of pointers to column +# descriptors. The table is created later by calling tbtcre. +# For an existing table this procedure creates the descriptors and +# also opens the table. +# +# Phil Hodge, 7-Aug-1987 Include call to tbtext. +# Phil Hodge, 8-Sep-1987 Delete declarations of streq() and strlen(). +# Phil Hodge, 8-Oct-1987 Set TB_MAXCOLS if NEW_COPY. +# Phil Hodge, 7-Mar-1989 Eliminate TB_OFFSET, TB_CURROW. +# Phil Hodge, 29-Jun-1992 Modify for text tables. +# Phil Hodge, 16-Nov-1992 Close TB_FILE here instead of in tbwopn if error. +# Phil Hodge, 8-Apr-1993 Assign a default for TB_VERSION. +# Phil Hodge, 23-Nov-1993 Check for null or blank input table name. +# Phil Hodge, 15-Dec-1994 Allocate SZ_LINE for table name. +# Phil Hodge, 22-Dec-1994 Initialize for CDF or FITS file. +# Phil Hodge, 3-Apr-1995 Assign an initial value for TB_MODIFIED. +# Phil Hodge, 2-Feb-1996 Call tbnparse instead of tbparse. +# Phil Hodge, 29-Apr-1996 Init TB_COLPTR=NULL; close table if error in tbuopn. +# Phil Hodge, 2-Mar-1998 Change calling sequence of tbnparse; +# call tbsopn to select rows and columns; +# reduce size of table name to SZ_FNAME. +# Phil Hodge, 22-Mar-1999 Convert file name to OS file name TB_OS_FILENAME; +# use calloc instead of malloc for tp. +# Phil Hodge, 20-Apr-1999 Call tbttyp to get table type (or file type); +# remove type from calling sequence of tbnparse. +# Phil Hodge, 1-Jun-1999 Initialize both TB_FILE and TB_FILE2 to 0. +# Phil Hodge, 7-Jun-1999 Initialize TB_SUBTYPE, TB_KEYLIST_PTR; +# replace TB_F_TYPE by TB_TYPE; delete TB_HDUTYPE; +# initialize TB_MAXCOLS. +# Phil Hodge, 12-Sep-2000 Initialize TB_INDEF_IS_CURRENT. +# Phil Hodge, 13-Nov-2001 Add file name to error message when the file +# cannot be opened; increase buffer size of errmess. + +pointer procedure tbtopn (tablename, iomode, template) + +char tablename[ARB] # i: the name of the table +int iomode # i: I/O mode +pointer template # i: pointer to template table, or zero +#-- +pointer sp +pointer brackets +pointer errmess # for possible error message +pointer rowselect, colselect # for selector strings +pointer tp # pointer to table descriptor +int exists # true if table file exists +bool crash + +int lstart +char url[SZ_PATHNAME], tblname[SZ_PATHNAME] +char osfn[SZ_PATHNAME], cnvname[SZ_PATHNAME], cosfn[SZ_PATHNAME] + +long tbtbod() +int tbnparse(), tbttyp(), strncmp(), access(), vot_to_fits() +bool streq(), is_votable() + +errchk malloc, tbuopn, tbsopn, tbctpe, tbnparse, tbttyp, vfn_expand_ldir + +begin + call smark (sp) + call salloc (brackets, SZ_FNAME, TY_CHAR) + call salloc (errmess, SZ_LINE, TY_CHAR) + call salloc (rowselect, SZ_LINE, TY_CHAR) + call salloc (colselect, SZ_LINE, TY_CHAR) + + crash = false # initial value + + # If we're given a URL to a file, cache it. + call aclrc (cnvname, SZ_PATHNAME) + if (strncmp ("http:", tablename, 5) == 0) { + call strcpy (tablename, url, SZ_PATHNAME) + if (iomode == NEW_FILE) + call syserr (SYS_FNOWRITEPERM) + + call fcname ("cache$", url, "f", tblname, SZ_PATHNAME) + call strcpy (tblname, cnvname, SZ_PATHNAME) + call strcat (".fits", cnvname, SZ_PATHNAME) + + if (access (cnvname, 0, 0) == NO) { + #call fcadd ("cache$", url, "fits", tblname, SZ_PATHNAME) + call fcadd ("cache$", url, "", tblname, SZ_PATHNAME) + if (access (cnvname,0,0) == YES && is_votable (cnvname)) { + if (vot_to_fits (tblname, tblname) != OK) { + call error (ER_TBCONVERT, + "tbtopn: cannot convert table format") + } + } + } else + call strcpy (cnvname, tblname, SZ_PATHNAME) + + } else if (strncmp ("file://", tablename, 7) == 0) { + lstart = 8 + if (strncmp ("file://localhost", tablename, 16) == 0) + lstart = 17 + else if (strncmp ("file:///localhost", tablename, 17) == 0) + lstart = 18 + + # Strip file:// prefix from the URI. + call strcpy (tablename[lstart], tblname, SZ_PATHNAME) + + call fcname ("cache$", tablename[lstart], "f", tblname, SZ_PATHNAME) + call strcpy (tblname, cnvname, SZ_PATHNAME) + call strcat (".fits", cnvname, SZ_PATHNAME) + + if (access (cnvname, 0, 0) == NO) { + call fcadd ("cache$", tablename[lstart], "fits", tblname, + SZ_PATHNAME) + if (access (cnvname,0,0) == YES && is_votable (cnvname)) { + if (vot_to_fits (tblname, tblname) != OK) { + call error (ER_TBCONVERT, + "tbtopn: cannot convert table format") + } + } + } else + call strcpy (cnvname, tblname, SZ_PATHNAME) + + } else if (is_votable (tablename)) { + call fcname ("cache$", tablename, "f", tblname, SZ_PATHNAME) + call strcpy (tblname, cnvname, SZ_PATHNAME) + call strcat (".fits", cnvname, SZ_PATHNAME) + + if (access (cnvname, 0, 0) == NO) { + call fcadd ("cache$", tablename, "fits", tblname, SZ_PATHNAME) + if (access (cnvname,0,0) == YES && is_votable (cnvname)) { + if (vot_to_fits (tblname, cnvname) != OK) { + call error (ER_TBCONVERT, + "tbtopn: cannot convert table format") + } + } + } else + call strcpy (cnvname, tblname, SZ_PATHNAME) + + } else { + # Nothing to do, just use it and hope it's a format we know about. + call strcpy (tablename, tblname, SZ_PATHNAME) + } + + + # Allocate space for the table descriptor and for the table name. + # The TB_EXTNAME is the name of the table within a CDF file, + # or it can be the EXTNAME in a FITS file. + call calloc (tp, LEN_TBLSTRUCT, TY_STRUCT) + call malloc (TB_NAME_PTR(tp), SZ_FNAME, TY_CHAR) + call malloc (TB_OS_FILENAME_PTR(tp), SZ_FNAME, TY_CHAR) + call malloc (TB_EXTNAME_PTR(tp), SZ_FNAME, TY_CHAR) + if (cnvname[1] != EOS) { + call malloc (TB_SRC_PTR(tp), SZ_FNAME, TY_CHAR) + call strcpy (tablename, TB_SRC(tp), SZ_FNAME) + } + + # Parse the table name, copying the file name to TB_NAME and + # extracting information from the bracketed expression (if any) + # to get TB_EXTNAME, etc. + if (tbnparse (tblname, TB_NAME(tp), TB_EXTNAME(tp), Memc[brackets], + SZ_FNAME, TB_EXTVER(tp), TB_HDU(tp), TB_OVERWRITE(tp), + Memc[rowselect], Memc[colselect], SZ_LINE) < 1) { + crash = true + call strcpy ("tbtopn: Table name is null or blank.", + Memc[errmess], SZ_LINE) + } + # Convert from iraf virtual file name to actual file name. + call vfn_expand_ldir (TB_NAME(tp), TB_OS_FILENAME(tp), SZ_FNAME) + + # Get the table type. If the file doesn't exist, this is a guess + # based on the filename extension. For a FITS table in an existing + # file, this is the file type; if an extension was specified, we're + # not checking that yet. + TB_TYPE(tp) = tbttyp (TB_NAME(tp), exists) + + TB_IOMODE(tp) = iomode + TB_READONLY(tp) = (iomode == READ_ONLY) + + if (iomode != READ_ONLY && iomode != READ_WRITE && + (Memc[rowselect] != EOS || Memc[colselect] != EOS)) { + crash = true + call strcpy ( +"tbtopn: Row and column selectors may only be used with existing tables.", + Memc[errmess], SZ_LINE) + } + + if (crash) { + call mfree (TB_EXTNAME_PTR(tp), TY_CHAR) + call mfree (TB_NAME_PTR(tp), TY_CHAR) + call mfree (TB_OS_FILENAME_PTR(tp), TY_CHAR) + call mfree (tp, TY_STRUCT) + call error (1, Memc[errmess]) + } + + # Default values; these may be changed below. + TB_NPAR(tp) = 0 + TB_MAXPAR(tp) = DEFMAXPAR + TB_NROWS(tp) = 0 + TB_ALLROWS(tp) = 100 + TB_NCOLS(tp) = 0 + TB_MAXCOLS(tp) = DEFMAXCOLS + TB_COLUSED(tp) = 0 + TB_ROWLEN(tp) = 0 + + TB_ROW_SELECT(tp) = NO + TB_NSEL_ROWS(tp) = 0 + TB_ROWSET(tp) = NULL + + TB_COLUMN_SELECT(tp) = NO + TB_NSEL_COLS(tp) = 0 + TB_SELCOL_PTR(tp) = NULL + + TB_IS_OPEN(tp) = false + TB_MODIFIED(tp) = false + TB_INDEF_IS_CURRENT(tp) = false + TB_FILE(tp) = 0 + TB_FILE2(tp) = 0 + TB_INDEF(tp) = NULL + TB_COLPTR(tp) = NULL + TB_CD(tp) = NULL + TB_SUBTYPE(tp) = TBL_SUBTYPE_UNKNOWN + TB_COMMENT(tp) = NULL + TB_KEYLIST_PTR(tp) = NULL + TB_VERSION(tp) = TBL_CURRENT_VERSION + + if ((iomode == READ_ONLY) || (iomode == READ_WRITE)) { + + if (exists != YES) { # set by tbttyp + call sprintf (Memc[errmess], SZ_LINE, + "Table `%s' does not exist or cannot be opened.") + call pargstr (TB_OS_FILENAME(tp)) + call mfree (TB_EXTNAME_PTR(tp), TY_CHAR) + call mfree (TB_NAME_PTR(tp), TY_CHAR) + call mfree (TB_OS_FILENAME_PTR(tp), TY_CHAR) + call mfree (tp, TY_STRUCT) + call error (1, Memc[errmess]) + } + + # Open the table. This allocates space for the TB_COLPTR array. + iferr { + call tbuopn (tp) + } then { + call tbtclo (tp) + call erract (EA_ERROR) + } + + # Select rows and columns (if specified). + call tbsopn (tp, Memc[rowselect], Memc[colselect]) + + } else if ((iomode == NEW_FILE) || (iomode == NEW_COPY) || + (iomode == TEMP_FILE)) { + # Allocate space for the array of pointers to column descriptors. + if (iomode == NEW_COPY) + TB_MAXCOLS(tp) = TB_MAXCOLS(template) + call malloc (TB_COLPTR(tp), TB_MAXCOLS(tp), TY_POINTER) + TB_BOD(tp) = tbtbod (TB_MAXPAR(tp), TB_MAXCOLS(tp)) + # Copy column descriptors from template table. + if (iomode == NEW_COPY) { + TB_IOMODE(tp) = NEW_FILE + call tbctpe (tp, template) # copy from template + } + # Write to standard output if the name is STDOUT. Note that + # this overrides the type from the template, if NEW_COPY. + if (streq (TB_NAME(tp), "STDOUT") || streq (TB_NAME(tp), "STDERR")) + TB_TYPE(tp) = TBL_TYPE_TEXT + } else { + call mfree (TB_EXTNAME_PTR(tp), TY_CHAR) + call mfree (TB_NAME_PTR(tp), TY_CHAR) + call mfree (TB_OS_FILENAME_PTR(tp), TY_CHAR) + call mfree (tp, TY_STRUCT) + call error (ER_TBBADMODE, + "tbtopn: the specified I/O mode is not supported for a table") + } + + call sfree (sp) + return (tp) +end diff --git a/pkg/tbtables/tbtopns.x b/pkg/tbtables/tbtopns.x new file mode 100644 index 00000000..d73263f5 --- /dev/null +++ b/pkg/tbtables/tbtopns.x @@ -0,0 +1,298 @@ +include # defines SZB_CHAR +include +include +include "tbtables.h" +include "tblerr.h" + +# size of packed par record; used by tbcrcd2 +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) + +# These routines are for converting tables between various machine formats. +# The high-level routine is tbtopns, which calls either the normal tbtopn +# or tbtopn2. The latter swaps bytes in the integer portions of the +# size-information record and column descriptors. +# +# Phil Hodge, 7-Oct-1989 Subroutines created. +# Phil Hodge, 6-Feb-1992 Add text for text table type. +# Phil Hodge, 8-Apr-1993 Assign a value for TB_VERSION. +# Phil Hodge, 15-Dec-1994 Table name is now SZ_LINE instead of SZ_FNAME. +# Phil Hodge, 27-Nov-1995 Assign values for TB_MODIFIED, etc., in tbtopn2; +# rename tbwopn2 to tbuopn2. +# Phil Hodge, 2-Feb-1996 Assign initial values to TB_EXTVER, etc. +# Phil Hodge, 29-Apr-1996 Init TB_COLPTR=NULL; close table if error in tbuopn. +# Phil Hodge, 2-Mar-1998 Initialize TB_ROW_SELECT(tp) = NO, etc. +# Phil Hodge, 14-Apr-1998 Change tbcrcd2 to agree with modified tbcrcd. +# Phil Hodge, 22-Mar-1999 Convert file name to OS file name TB_OS_FILENAME; +# use calloc instead of malloc for tp; +# size of strings is SZ_FNAME instead of SZ_LINE. +# Phil Hodge, 1-Jun-1999 Initialize both TB_FILE and TB_FILE2 to 0. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE; +# replace TB_HDUTYPE by TB_SUBTYPE; +# when allocating TB_COLPTR, the type is TY_POINTER, not TY_INT. +# Phil Hodge, 23-Jun-2000 In tbcrcd2, assign default values to +# COL_TDTYPE, COL_TSCAL, COL_TZERO. +# Phil Hodge, 12-Sep-2000 Initialize TB_INDEF_IS_CURRENT. + +# tbtopns -- open table & optionally swap bytes +# This routine opens an existing table read-only. If byte_swap is NO, +# we just call tbtopn; if byte_swap = YES we open the table file and +# swap bytes in the integer values, the size-info record and parts of +# the column descriptors. + +procedure tbtopns (tablename, byte_swap, tp, fd) + +char tablename[ARB] # i: the name of the table +int byte_swap # i: YES if we need to swap bytes +pointer tp # o: pointer to table descriptor +int fd # o: fd number for table file +#-- +pointer tbtopn(), tbtopn2() +errchk tbtopn, tbtopn2 + +begin + if (byte_swap == YES) + tp = tbtopn2 (tablename) + else + tp = tbtopn (tablename, READ_ONLY, NULL) + + fd = TB_FILE(tp) +end + + +# tbtopn2 -- open a table +# Open an existing table read-only, and byte-swap the integer values in +# the size-information record and the column descriptors. + +pointer procedure tbtopn2 (tablename) + +char tablename[ARB] # i: the name of the table +#-- +pointer tp # pointer to table descriptor +pointer sp +pointer name # scratch for table name including extension +pointer message # scratch for error message +int access() +errchk tbtext, malloc, tbuopn2 + +begin + call smark (sp) + call salloc (name, SZ_FNAME, TY_CHAR) + call tbtext (tablename, Memc[name], SZ_FNAME) + + if (access (Memc[name], 0, TEXT_FILE) == YES) { + call smark (sp) + call salloc (message, SZ_FNAME, TY_CHAR) + call sprintf (Memc[message], SZ_FNAME, "`%s' is not a binary table") + call pargstr (Memc[name]) + call error (1, Memc[message]) + } + + # Allocate space for the table descriptor and the table name. + call calloc (tp, LEN_TBLSTRUCT, TY_STRUCT) + call malloc (TB_NAME_PTR(tp), SZ_FNAME, TY_CHAR) + call malloc (TB_OS_FILENAME_PTR(tp), SZ_FNAME, TY_CHAR) + TB_OS_FILENAME(tp) = EOS # not used (only used for CFITSIO) + TB_EXTNAME_PTR(tp) = NULL + + # Fill in some initial values. + call strcpy (Memc[name], TB_NAME(tp), SZ_FNAME) + call sfree (sp) + TB_IOMODE(tp) = READ_ONLY + TB_READONLY(tp) = true + + TB_TYPE(tp) = TBL_TYPE_S_ROW # column is OK, too + TB_SUBTYPE(tp) = TBL_SUBTYPE_UNKNOWN + + # Default values; some may be changed below. + TB_TYPE(tp) = TBL_TYPE_S_ROW + TB_NPAR(tp) = 0 + TB_MAXPAR(tp) = DEFMAXPAR + TB_NROWS(tp) = 0 + TB_ALLROWS(tp) = 0 + TB_NCOLS(tp) = 0 + TB_COLUSED(tp) = 0 + TB_ROWLEN(tp) = 0 + + TB_ROW_SELECT(tp) = NO + TB_NSEL_ROWS(tp) = 0 + TB_ROWSET(tp) = NULL + + TB_COLUMN_SELECT(tp) = NO + TB_NSEL_COLS(tp) = 0 + TB_SELCOL_PTR(tp) = NULL + + TB_IS_OPEN(tp) = false + TB_MODIFIED(tp) = false + TB_INDEF_IS_CURRENT(tp) = false + TB_FILE(tp) = 0 + TB_FILE2(tp) = 0 + TB_INDEF(tp) = NULL + TB_COLPTR(tp) = NULL + TB_HDU(tp) = -1 + TB_EXTVER(tp) = -1 + TB_OVERWRITE(tp) = -1 + TB_CD(tp) = NULL + TB_COMMENT(tp) = NULL + TB_VERSION(tp) = TBL_CURRENT_VERSION + + # Open the table. This allocates space for the TB_COLPTR array. + iferr { + call tbuopn2 (tp) + } then { + call tbtclo (tp) + call erract (EA_ERROR) + } + TB_IS_OPEN(tp) = true + + return (tp) +end + + +# tbuopn2 -- open old table +# This is like tbuopn except that it swaps bytes and the indef record +# is not created. + +procedure tbuopn2 (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer colptr # pointer to column descriptor +int colnum # column number (a loop index) +int open() +errchk open, malloc, tbtrsi2, tbcrcd2 + +begin + # Open the file + TB_FILE(tp) = open (TB_NAME(tp), TB_IOMODE(tp), BINARY_FILE) + + call tbtrsi2 (tp) # read size info & swap bytes + + # Allocate space for the array of pointers to column descriptors. + call malloc (TB_COLPTR(tp), TB_MAXCOLS(tp), TY_POINTER) + + # Create column descriptors & read contents from table. + do colnum = 1, TB_NCOLS(tp) { + call malloc (colptr, LEN_COLSTRUCT, TY_STRUCT) + TB_COLINFO(tp,colnum) = colptr + # read column descriptor & swap bytes + call tbcrcd2 (tp, colptr, colnum) + } +end + + +# tbtrsi2 -- read size info +# This is like tbtrsi except that it swaps bytes. + +procedure tbtrsi2 (tp) + +pointer tp # Pointer to table descriptor +#-- +int sizinfo[LEN_SIZINFO] # Size information record +long tbtbod() +int read() +errchk seek, read + +begin + call seek (TB_FILE(tp), BOF) + if (read (TB_FILE(tp), sizinfo, SZ_SIZINFO) == EOF) + call error (ER_TBFILEMPTY, "table data file is empty") + if (SZ_INT != SZ_INT32) + call iupk32 (sizinfo, sizinfo, SZ_SIZINFO) + + # Swap bytes in the size information record. + call bswap4 (sizinfo, 1, sizinfo, 1, SZ_SIZINFO*SZB_CHAR) + + TB_TYPE(tp) = S_TYPE(sizinfo) + if ((TB_TYPE(tp) != TBL_TYPE_S_ROW) && + (TB_TYPE(tp) != TBL_TYPE_S_COL)) + call error (ER_TBCORRUPTED, "unknown table type") + + TB_NPAR(tp) = S_NPAR(sizinfo) + TB_MAXPAR(tp) = S_MAXPAR(sizinfo) + TB_NROWS(tp) = S_NROWS(sizinfo) + TB_ALLROWS(tp) = S_ALLROWS(sizinfo) + TB_NCOLS(tp) = S_NCOLS(sizinfo) + TB_MAXCOLS(tp) = S_MAXCOLS(sizinfo) + TB_COLUSED(tp) = S_COLUSED(sizinfo) + TB_ROWLEN(tp) = S_ROWLEN(sizinfo) + TB_VERSION(tp) = S_VERSION(sizinfo) + + TB_BOD(tp) = tbtbod (TB_MAXPAR(tp), TB_MAXCOLS(tp)) +end + + +# tbcrcd2 -- read column descriptor +# This is like tbcrcd except that it swaps bytes in the integer portion +# of the column descriptor. + +procedure tbcrcd2 (tp, cp, colnum) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int colnum # i: column number +#-- +pointer sp +pointer coldef # column descriptor read from table +pointer pformat # scratch for print format +long offset # location of column descriptor in table file +int stat # status from read operation +int read() + +errchk seek, read + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT || TB_TYPE(tp) == TBL_TYPE_FITS) + call error (1, "tbcrcd: internal error") + + call smark (sp) + call salloc (coldef, LEN_COLDEF, TY_STRUCT) + call salloc (pformat, SZ_COLFMT, TY_CHAR) + + offset = SZ_SIZINFO + + TB_MAXPAR(tp) * SZ_PACKED_REC + + (colnum-1) * SZ_COLDEF + 1 + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), Memi[coldef], SZ_COLDEF) + if (stat == EOF) + call error (ER_TBCINFMISSING, + "tbcrcd: EOF while reading column info for table") + if (SZ_INT != SZ_INT32) + call iupk32 (Memi[coldef], Memi[coldef], SZ_COLDEF) + + # Swap bytes in the first four longwords. + call bswap4 (Memi[coldef], 1, Memi[coldef], 1, 4*SZ_INT32*SZB_CHAR) + + # Check for and correct data type TY_CHAR. + if (COL_DTYPE(cp) == TY_CHAR) + COL_DTYPE(cp) = -COL_LEN(cp) * SZB_CHAR + + # Copy the column definition that we just read from the file into + # the column descriptor in memory. + COL_NUMBER(cp) = CD_COL_NUMBER(coldef) + COL_OFFSET(cp) = CD_COL_OFFSET(coldef) + COL_LEN(cp) = CD_COL_LEN(coldef) + COL_DTYPE(cp) = CD_COL_DTYPE(coldef) + + # COL_TDTYPE, COL_TSCAL, COL_TZERO are only needed for FITS tables. + COL_TDTYPE(cp) = COL_DTYPE(cp) + COL_TSCAL(cp) = 1.d0 + COL_TZERO(cp) = 0.d0 + + call tbbncp1 (CD_COL_NAME(coldef), COL_NAME(cp), + SZ_CD_COLNAME / SZB_CHAR) + call strupk (COL_NAME(cp), COL_NAME(cp), SZ_COLNAME) + + call tbbncp1 (CD_COL_UNITS(coldef), COL_UNITS(cp), + SZ_CD_COLUNITS / SZB_CHAR) + call strupk (COL_UNITS(cp), COL_UNITS(cp), SZ_COLUNITS) + + # include a leading '%' in the print format + # (tbbncp1 is in tbcrcd.x) + Memc[pformat] = '%' + call tbbncp1 (CD_COL_FMT(coldef), Memc[pformat+1], + SZ_CD_COLFMT / SZB_CHAR) + call strupk (Memc[pformat+1], Memc[pformat+1], SZ_COLFMT-1) + call strcpy (Memc[pformat], COL_FMT(cp), SZ_COLFMT) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbtren.x b/pkg/tbtables/tbtren.x new file mode 100644 index 00000000..808a3cbc --- /dev/null +++ b/pkg/tbtables/tbtren.x @@ -0,0 +1,28 @@ +include +include "tbtables.h" + +# tbtren -- rename a table +# This procedure renames a table from inname to outname. The default +# extension will be appended if an extension is not present and the input +# file is a binary table. If intable is a text file, no extension will be +# appended to outtable. +# +# Phil Hodge, 28-Dec-1989 Open before renaming to verify that it is a table. +# Phil Hodge, 14-May-1992 Check for text table; call tbtext only if binary. +# Phil Hodge, 26-Jun-1995 Modify for FITS file or CDF file. + +procedure tbtren (intable, outtable) + +char intable[ARB] # i: name of table to be renamed to outtable +char outtable[ARB] # i: new name of table +#-- +errchk tbtcpy, tbtdel + +begin + # For the time being, use tbtcpy and tbtdel. After the CDF + # interface is available, copy code from tbtcpy and tbtdel + # to here so we don't open the input table twice. + + call tbtcpy (intable, outtable) + call tbtdel (intable) +end diff --git a/pkg/tbtables/tbtrsi.x b/pkg/tbtables/tbtrsi.x new file mode 100644 index 00000000..02a2651c --- /dev/null +++ b/pkg/tbtables/tbtrsi.x @@ -0,0 +1,74 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +define DEF_ALLROWS 100 # initial number of "rows" for text file + +# tbtrsi -- read size info +# This procedure reads the size information record from a table and +# saves the values in the table descriptor. +# +# Phil Hodge, 15-Oct-1987 Seek BOF instead of 1. +# Phil Hodge, 10-Nov-1987 Check table type to see if it is valid. +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 5-Apr-1993 Also read version number. +# Phil Hodge, 8-Jun-1995 Modify for FITS file. +# Phil Hodge, 7-Jun-1999 For text tables, don't set TB_ALLROWS, +# TB_MAXCOLS, TB_MAXPAR, or TB_NPAR. +# Phil Hodge, 22-Oct-2004 Check for byte-swapped size information record, +# in order to give a more informative error message. + +procedure tbtrsi (tp) + +pointer tp # Pointer to table descriptor +#-- +int sizinfo[LEN_SIZINFO] # Size information record +long tbtbod() +int read() +errchk seek, read, tbfrsi + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + TB_BOD(tp) = 0 + return + } + + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + # Get number of rows and column in FITS table. + call tbfrsi (tp) + return + } + + call seek (TB_FILE(tp), BOF) + if (read (TB_FILE(tp), sizinfo, SZ_SIZINFO) == EOF) + call error (ER_TBFILEMPTY, "table data file is empty") + if (SZ_INT != SZ_INT32) + call iupk32 (sizinfo, sizinfo, SZ_SIZINFO) + + TB_TYPE(tp) = S_TYPE(sizinfo) + if ((TB_TYPE(tp) != TBL_TYPE_S_ROW) && + (TB_TYPE(tp) != TBL_TYPE_S_COL)) { + # Check whether sizinfo is just byte swapped. + call bswap4 (sizinfo, 1, sizinfo, 1, SZ_SIZINFO*SZB_CHAR) + if ((S_TYPE(sizinfo) == TBL_TYPE_S_ROW) || + (S_TYPE(sizinfo) == TBL_TYPE_S_COL)) { + call error (ER_BYTESWAPPED, + "can't open table, it appears to be byte-swapped") + } else { + call error (ER_TBCORRUPTED, "unknown table type") + } + } + + TB_NPAR(tp) = S_NPAR(sizinfo) + TB_MAXPAR(tp) = S_MAXPAR(sizinfo) + TB_NROWS(tp) = S_NROWS(sizinfo) + TB_ALLROWS(tp) = S_ALLROWS(sizinfo) + TB_NCOLS(tp) = S_NCOLS(sizinfo) + TB_MAXCOLS(tp) = S_MAXCOLS(sizinfo) + TB_COLUSED(tp) = S_COLUSED(sizinfo) + TB_ROWLEN(tp) = S_ROWLEN(sizinfo) + TB_VERSION(tp) = S_VERSION(sizinfo) + + TB_BOD(tp) = tbtbod (TB_MAXPAR(tp), TB_MAXCOLS(tp)) +end diff --git a/pkg/tbtables/tbtscd.x b/pkg/tbtables/tbtscd.x new file mode 100644 index 00000000..3c57c8ac --- /dev/null +++ b/pkg/tbtables/tbtscd.x @@ -0,0 +1,58 @@ +include +include +include "tbtables.h" +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbtscd -- copy to change size; column descriptors +# This routine copies the column-descriptor portion of one table to another. +# Old_ncols is the number of columns defined in the input table. +# This is called by either tbxscp or tbyscp. +# +# Phil Hodge, 1-Apr-1993 Change cbuf from TY_STRUCT to TY_CHAR. +# Phil Hodge, 14-Apr-1998 Change SZ_COLSTRUCT to SZ_COLDEF. + +procedure tbtscd (tp, oldfd, newfd, old_maxpar, old_ncols) + +pointer tp # i: pointer to table descriptor +int oldfd, newfd # i: channel numbers for input & output tables +int old_maxpar # i: previous maximum number of user parameters +int old_ncols # i: previous number of columns +#-- +pointer sp +pointer cbuf # column-descriptor buffer +long oldoff, newoff # offsets from start of old & new files +int cbufsiz # size of buffer pointed to by cbuf +int k # loop index +int stat +char zero +int read() +errchk seek, read, write + +begin + # Create buffer for I/O + call smark (sp) + cbufsiz = SZ_COLDEF # unit = SZ_CHAR + call salloc (cbuf, cbufsiz, TY_CHAR) + + # Copy each column descriptor to the temporary file. + oldoff = SZ_SIZINFO + old_maxpar * SZ_PACKED_REC + 1 + newoff = SZ_SIZINFO + TB_MAXPAR(tp) * SZ_PACKED_REC + 1 + do k = 1, old_ncols { + call seek (oldfd, oldoff) + call seek (newfd, newoff) + stat = read (oldfd, Memc[cbuf], SZ_COLDEF) + call write (newfd, Memc[cbuf], SZ_COLDEF) + oldoff = oldoff + SZ_COLDEF + newoff = newoff + SZ_COLDEF + } + # Fill out the rest of the space for column descriptors. + zero = 0 + call amovkc (zero, Memc[cbuf], SZ_COLDEF) + do k = old_ncols+1, TB_MAXCOLS(tp) { + call seek (newfd, newoff) + call write (newfd, Memc[cbuf], SZ_COLDEF) + newoff = newoff + SZ_COLDEF + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbtscu.x b/pkg/tbtables/tbtscu.x new file mode 100644 index 00000000..8483aa44 --- /dev/null +++ b/pkg/tbtables/tbtscu.x @@ -0,0 +1,63 @@ +include +include +include "tbtables.h" +define SZ_PACKED_REC (SZ_PARREC/SZB_CHAR) # size of packed par record + +# tbtscu -- copy to change size; user parameters +# This routine copies the user-parameter portion of one table to another. +# Old_maxpar and TB_MAXPAR(tp) specify the sizes of the user-parameter areas +# in the input and output tables respectively. Either of these may be the +# larger. +# This is called by either tbxscp or tbyscp. + +procedure tbtscu (tp, oldfd, newfd, old_maxpar) + +pointer tp # i: pointer to table descriptor +int oldfd, newfd # i: channel numbers for input & output tables +int old_maxpar # i: previous maximum number of user parameters +#-- +pointer sp +pointer pbuf # buffer for user parameters +pointer blank # buffer for extra (blank) user param records +long oldoff, newoff # offsets from start of old & new files +int pbufsiz # size of buffer pointed to by pbuf +int k # loop index +int n_copy # number of user-parameter records to copy +int stat +int read() +errchk seek, read, write + +begin + # Create buffer for I/O + call smark (sp) + pbufsiz = SZ_PACKED_REC # unit = SZ_CHAR + call salloc (pbuf, pbufsiz, TY_CHAR) + + n_copy = min (old_maxpar, TB_MAXPAR(tp)) + + # Copy each user parameter to the temporary file. + oldoff = SZ_SIZINFO + 1 # initial values + newoff = SZ_SIZINFO + 1 + do k = 1, n_copy { + call seek (oldfd, oldoff) + call seek (newfd, newoff) + stat = read (oldfd, Memc[pbuf], SZ_PACKED_REC) + call write (newfd, Memc[pbuf], SZ_PACKED_REC) + oldoff = oldoff + SZ_PACKED_REC + newoff = newoff + SZ_PACKED_REC + } + # Fill out the rest of the space (if any) for user parameters. + if (TB_MAXPAR(tp) > n_copy) { + call salloc (blank, SZ_PARREC, TY_CHAR) + do k = 1, SZ_PARREC + Memc[blank+k-1] = ' ' + call strpak (Memc[blank], Memc[pbuf], SZ_PARREC) + do k = n_copy+1, TB_MAXPAR(tp) { + call seek (newfd, newoff) + call write (newfd, Memc[pbuf], SZ_PACKED_REC) + newoff = newoff + SZ_PACKED_REC + } + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbtsrt.x b/pkg/tbtables/tbtsrt.x new file mode 100644 index 00000000..8052852f --- /dev/null +++ b/pkg/tbtables/tbtsrt.x @@ -0,0 +1,70 @@ +# TBTSRT -- Sort a table on multiple columns +# +# This procedure rearranges an array of row indices into sorted order. +# The array of row indices must be created before calling this procedure. +# Null elements will be last in the sort order. Boolean false is less +# than true in the sort order. If character strings are being sorted, +# case can be ignored by setting fold to true. +# +# B.Simon 22-Jan-90 First Code + +procedure tbtsrt (tp, numcols, colptr, fold, nindex, index) + +pointer tp # i: Table descriptor +int numcols # i: Number of columns to sort on +pointer colptr[ARB] # i: Array of column descriptors +bool fold # i: Fold upper and lower case when sorting +int nindex # i: Number of rows +int index[ARB] # io: Array of row indices in sorted order +#-- +common /savcmp/ sv_tp, sv_colptr, sv_numcols, sv_fold +bool sv_fold +int sv_numcols +pointer sv_tp, sv_colptr + +int icol + +int tbqcmp() +extern tbqcmp + +begin + # Fill common block used to pass info to comparison routine + + call malloc (sv_colptr, numcols, TY_INT) + + sv_tp = tp + sv_fold = fold + sv_numcols = numcols + do icol = 1, numcols + Memi[sv_colptr+icol-1] = colptr[icol] + + # Call quicksort routine + + call qsort (index, nindex, tbqcmp) + + # Free memory + + call mfree (sv_colptr, TY_INT) + +end + +# TBQCMP -- Interface to comparison routine + +int procedure tbqcmp (row1, row2) + +int row1 # i: Index to first row to compare +int row2 # i: Index to second row to compare +#-- +common /savcmp/ sv_tp, sv_colptr, sv_numcols, sv_fold +bool sv_fold +int sv_numcols +pointer sv_tp, sv_colptr + +int order +int tbrcmp() + +begin + order = tbrcmp (sv_tp, sv_numcols, Memi[sv_colptr], + sv_fold, row1, row2) + return (order) +end diff --git a/pkg/tbtables/tbttyp.x b/pkg/tbtables/tbttyp.x new file mode 100644 index 00000000..5f861522 --- /dev/null +++ b/pkg/tbtables/tbttyp.x @@ -0,0 +1,262 @@ +include # defines NEWLINE +include # defines SZB_CHAR +include +include "tbtables.h" + +define TBL_EXTNS "|tab|fits|fit|fxb|txt|dat|cat|tmp|" +define SZ_FITS_BLOCK 2880 # one FITS block + +# This function returns the table type. A flag is also returned in the +# calling sequence to indicate whether the file exists or not. If the +# file cannot be opened read-only, it is presumed not to exist. If the +# table name is null, a value of zero will be returned for the table type. +# +# For a nonexistent file, the type is based on the file name. For a file +# that does exist, the type can be incorrect if the file is not really a +# table (e.g. an image pixel file); for the definitive table type, open +# the table read-only and use the function tbpsta (tp, TBL_WHTYPE). +# +# The function fstdfile is used to check for STDIN, STDOUT, etc. If the +# file name is one of these, the table type is set to TBL_TYPE_TEXT, and +# exists is set to YES. +# +# If the file does exist, the beginning of the file (up to 2880 bytes) +# is read, and the contents are compared with what is expected for a +# FITS file or an STSDAS format binary table. In the case of a FITS +# file, only the first block is checked, not the table extension itself, +# so in this case we're really checking file type rather than table type. +# +# To check for a FITS file, the first three 80-byte records are compared +# with what is required, SIMPLE, BITPIX, and NAXIS (see actual strings +# for values, including trailing blanks). In addition, there must not be +# any newline characters (ASCII 0x0A) within the first 2880 bytes. +# +# If the file is not FITS, it is then compared with STSDAS format. The +# beginning of the record that was read to check for FITS is copied to a +# local buffer that is equivalenced to an integer array. The ninth +# element of that array is the table type, 11 for row-ordered and 12 for +# column-ordered. If that element is neither 11 nor 12, the size-info +# record will be byte-swapped (into a scratch array) to check for the +# possibility that the table is STSDAS format but was created on a +# machine with different byte order. If the byte-swapped value is either +# 11 or 12, the table type will be set accordingly; that is, the fact that +# the table is byte swapped is not taken to be an error (this can be +# handled later by e.g. tbtrsi). +# +# If the file is neither FITS nor STSDAS format, it is assumed to be a +# text file. This will therefore be misleading if this function is called +# for a binary file that is not a table. +# +# If the file does not exist, the table type is decided based on the +# filename extension. If the extension is ".fits", ".fit", ".fxb", or "??f", +# the type is set to fits (TBL_TYPE_FITS). If the extension does not +# match one of those patterns, the table is assumed to be a row-ordered +# STSDAS format table (TBL_TYPE_S_ROW). Since the file doesn't exist, +# however, we really can't tell what it will end up being. +# +# Phil Hodge, 16-Apr-1999 Function created. +# Phil Hodge, 22-Oct-2004 Check for byte-swapped size information record. +# +# Frank Valdes, 18-Aug-2007: Various changes to better control types and +# extensions. + +int procedure tbttyp (tablename, exists) + +char tablename[ARB] # i: name of the file containing the table +int exists # o: YES if the file can be opened +#-- +pointer sp +pointer buf # for reading from the file +int ttype # table type +int i # loop index +int fd +int nread, nelem # chars to read, number actually read +int open(), read() +int j, k, len, strlen(), strncmp(), strdic() +int ofd, fstdfile() # to check for STDIN, STDOUT, etc.; ofd is ignored +bool streq() + +pointer fname # file name without trailing brackets +int extname, hdu, dummy # returned by tbparse and ignored +pointer tbtopn(), tp +int tbparse() + +# These are used for checking for a FITS file. +int len_simple, len_bitpix, len_naxis # lengths of strings +string simple_t "SIMPLE = T" +string simple_f "SIMPLE = F" +string bitpix "BITPIX = " +string naxis "NAXIS = " +# 123456789012345678901234567890 + +# These are used for checking for an STSDAS binary table. +int i_sizinfo[LEN_SIZINFO] # size information record +char c_sizinfo[SZ_SIZINFO * 8] +char cache[SZ_FNAME], src[SZ_FNAME], extn[SZ_FNAME] + + +#equivalence (i_sizinfo[1], c_sizinfo[1]) +int b_sizinfo[LEN_SIZINFO] # byte-swapped size information record + +int envgets() +errchk open, read, tbparse + +begin + # initial values + exists = YES + # zero is a flag to indicate we don't know the type yet + ttype = 0 + + if (fstdfile (tablename, ofd) == YES) + return (TBL_TYPE_TEXT) + + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (extname, SZ_FNAME, TY_CHAR) + + # Brackets on end of tablename? Remove them. + len = strlen (tablename) + if (len < 1) { + exists = NO + return (ttype) # zero, indeterminate type + } + if (tablename[len] == ']') { + dummy = tbparse (tablename, Memc[fname], Memc[extname], SZ_FNAME, + hdu) + } else { + call strcpy (tablename, Memc[fname], SZ_FNAME) + } + + # Make sure we've cached the file. + # Delete a cached version of the file. +if (1<0) { + if (strncmp ("http://", Memc[fname], 7) == 0) { + if (envgets ("cache", cache, SZ_FNAME) > 0) { + call fclookup (cache, Memc[fname], src, extn, SZ_FNAME) + if (src[1] != EOS) { + tp = tbtopn (Memc[fname], READ_ONLY, NULL) + call tbtclo (tp) + + ttype = TBL_TYPE_FITS + call sfree (sp) + return (ttype) + } + } + } +} + + # From now on we'll use Memc[fname] as the file name. + iferr { + fd = open (Memc[fname], READ_ONLY, BINARY_FILE) + } then { + exists = NO + } + + if (exists == YES) { + + # Read the beginning of the file to decide what type it is. + + call salloc (buf, SZ_FITS_BLOCK, TY_CHAR) + + nread = SZ_FITS_BLOCK / SZB_CHAR + nelem = read (fd, Memc[buf], nread) + call close (fd) + + # Copy the beginning to a local buffer so we can extract integer + # values. This will be used if we need to check for stsdas format. + # We need to copy this out because we're going to modify the + # buffer (unpack it). + do i = 1, SZ_SIZINFO + c_sizinfo[i] = Memc[buf+i-1] + + if (nelem == EOF) # empty file + ttype = TBL_TYPE_TEXT + + if (nelem == nread) { # did we read entire block? + + call strupk (Memc[buf], Memc[buf], SZ_FITS_BLOCK) + + # It could be FITS; check the first three "cards." + + len_simple = strlen (simple_t) + len_bitpix = strlen (bitpix) + len_naxis = strlen (naxis) + if ((strncmp (simple_t, Memc[buf], len_simple) == 0 || + strncmp (simple_f, Memc[buf], len_simple) == 0) && + strncmp (bitpix, Memc[buf+80], len_bitpix) == 0 && + strncmp (naxis, Memc[buf+160], len_naxis) == 0) { + ttype = TBL_TYPE_FITS + } + + # But if there are any newlines, it's not a FITS file. + do i = 0, nelem-1 { + if (Memc[buf+i] == NEWLINE) { + ttype = 0 + break + } + } + } + + if (ttype == 0 && nelem >= SZ_SIZINFO) { + + # It could be an STSDAS format binary table. If so, + # it begins with a size information record, and we can + # check the table type and software version number. + + # Check the part of the size information buffer that + # specifies table type. + if (SZ_INT != SZ_INT32) + call iupk32 (i_sizinfo, i_sizinfo, LEN_SIZINFO) + if (S_TYPE(i_sizinfo) == TBL_TYPE_S_ROW) { + ttype = TBL_TYPE_S_ROW + } else if (S_TYPE(i_sizinfo) == TBL_TYPE_S_COL) { + ttype = TBL_TYPE_S_COL + } else { + # Check whether i_sizinfo is byte swapped. If so, set + # the table type if it matches row or column. Note that + # this is not considered an error (at this point). + call bswap4 (i_sizinfo, 1, b_sizinfo, 1, + SZ_SIZINFO*SZB_CHAR) + if (S_TYPE(b_sizinfo) == TBL_TYPE_S_ROW) + ttype = TBL_TYPE_S_ROW + if (S_TYPE(b_sizinfo) == TBL_TYPE_S_COL) + ttype = TBL_TYPE_S_COL + } + + # Reset table type to unknown if the version is not reasonable. + if (S_VERSION(i_sizinfo) < 0) + ttype = 0 +# disable this test for the time being: +# if (S_VERSION(i_sizinfo) > TBL_CURRENT_VERSION) +# ttype = 0 + } + + if (ttype == 0) + ttype = TBL_TYPE_TEXT # default + + } else { # exists = NO + + # Check the filename extension. + call zfnbrk (Memc[fname], j, k) + j = 0 + if (Memc[fname+k] != EOS) { + j = strdic (Memc[fname+k], Memc[extname], SZ_FNAME, TBL_EXTNS) + if (!streq (Memc[fname+k], Memc[extname])) + j = 0 + } + + switch (j) { + case 1: + ttype = TBL_TYPE_S_ROW + case 2, 3, 4: + ttype = TBL_TYPE_FITS + case 5, 6, 7, 8: + ttype = TBL_TYPE_TEXT + default: + ttype = TBL_TYPE_TEXT + } + } + + call sfree (sp) + return (ttype) +end diff --git a/pkg/tbtables/tbtwer.x b/pkg/tbtables/tbtwer.x new file mode 100644 index 00000000..c2f41002 --- /dev/null +++ b/pkg/tbtables/tbtwer.x @@ -0,0 +1,41 @@ +include "tbtables.h" + +# tbtwer -- write empty rows +# The purpose of this routine is to write empty (INDEF) rows beyond the +# current end of file if the specified row is larger than the number of +# rows already written to the table. If the specified row is within the +# range of existing rows, the table itself will not be modified. +# +# If there is a row selector and selrow is larger than the current upper +# limit to the selected rows, then one or more new rows will be written to +# the end of the table, these new rows will be included in the list of +# selected rows, and TB_NROWS will be updated. The number of new, empty +# rows to be added after the current end of file is selrow minus the +# current number of selected rows. +# +# When putting a column of values to a table, the appropriate actual argument +# for rownum is the number of the last row to be written. +# +# This routine may only be called when writing to a table. +# +# Phil Hodge, 17-Sep-1987 Subroutine created. +# Phil Hodge, 8-Mar-1988 Change name in error mess from tbeoff to tbtwer. +# Phil Hodge, 14-Jan-1992 Add option for text table type; +# call tbtchs directly instead of through tbytsz. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 21-Jun-1995 Modify for FITS tables; set TB_MODIFIED to true. +# Phil Hodge, 3-Mar-1998 Replace with a call to tbswer. + +procedure tbtwer (tp, selrow) + +pointer tp # i: pointer to table descriptor +int selrow # i: row number (or selected row number) +#-- +int rownum # actual row number (ignored) +errchk tbswer + +begin + # Write empty rows to the end of the table, + # and add new rows to the list of selected rows. + call tbswer (tp, selrow, rownum) +end diff --git a/pkg/tbtables/tbtwsi.x b/pkg/tbtables/tbtwsi.x new file mode 100644 index 00000000..a3f1fd55 --- /dev/null +++ b/pkg/tbtables/tbtwsi.x @@ -0,0 +1,55 @@ +include +include "tbtables.h" + +# tbtwsi -- write size info +# This procedure writes the size information record into a table. +# NOTE: If the table is row-ordered TB_ALLROWS(tp) will be set to +# TB_NROWS(tp). +# If the table was opened read-write, the version number may be +# increased, since the current version number is written, rather than +# the version originally read from the table. +# +# Phil Hodge, 15-Oct-1987 Seek BOF instead of 1. +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 5-Apr-1993 Add version number. +# Phil Hodge, 8-Jun-1995 Modify for FITS file. + +procedure tbtwsi (tp) + +pointer tp # i: pointer to table descriptor +#-- +int sizinfo[LEN_SIZINFO] # Size information record +errchk seek, write, tbfwsi + +begin + if (TB_TYPE(tp) == TBL_TYPE_TEXT) + return + + # For a table in a FITS file we need to update the number of rows. + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfwsi (tp) + return + } + + call amovki (0, sizinfo, LEN_SIZINFO) # initialize buffer to zero + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW) + TB_ALLROWS(tp) = TB_NROWS(tp) # appropriate if row-ordered + + S_TYPE(sizinfo) = TB_TYPE(tp) + S_NPAR(sizinfo) = TB_NPAR(tp) + S_MAXPAR(sizinfo) = TB_MAXPAR(tp) + S_NROWS(sizinfo) = TB_NROWS(tp) + S_ALLROWS(sizinfo) = TB_ALLROWS(tp) + S_NCOLS(sizinfo) = TB_NCOLS(tp) + S_MAXCOLS(sizinfo) = TB_MAXCOLS(tp) + S_COLUSED(sizinfo) = TB_COLUSED(tp) + S_ROWLEN(sizinfo) = TB_ROWLEN(tp) + S_VERSION(sizinfo) = TBL_CURRENT_VERSION + + # Write first record of table. + call seek (TB_FILE(tp), BOF) + if (SZ_INT != SZ_INT32) + call ipak32 (sizinfo, sizinfo, SZ_SIZINFO) + call write (TB_FILE(tp), sizinfo, SZ_SIZINFO) +end diff --git a/pkg/tbtables/tbuopn.x b/pkg/tbtables/tbuopn.x new file mode 100644 index 00000000..4fb36ad6 --- /dev/null +++ b/pkg/tbtables/tbuopn.x @@ -0,0 +1,103 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +# tbuopn -- open existing table +# This routine opens an existing table file. +# For binary tables the default extension is appended. +# For each column, create a descriptor and read column info from +# the table. Also create the indef record buffer. For text tables +# the contents are read into memory. +# This version is for either row or column ordered SDAS tables +# or for text files. +# (Renamed from tbwopn.) +# +# Phil Hodge, 26-Feb-1988 Close table file if error in tbtrsi +# Phil Hodge, 7-Mar-1989 Eliminate TB_MODSIZE. +# Phil Hodge, 16-Nov-1990 Use local variable instead of TB_FILE(tp) when +# opening table file so TB_FILE(tp) will still be NULL in case of error. +# Phil Hodge, 14-Jan-1992 Add option for text table type. +# Phil Hodge, 16-Nov-1992 Close TB_FILE in tbtopn instead of here if error. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 20-Sep-1994 Don't allocate an INDEF buffer if readonly. +# Phil Hodge, 15-Dec-1994 Table name is now SZ_LINE instead of SZ_FNAME. +# Phil Hodge, 23-Dec-1994 Add option for CDF or FITS file. +# Phil Hodge, 14-Apr-1998 Change calling sequence of tbcrcd. +# Phil Hodge, 7-Jun-1999 Replace TB_F_TYPE by TB_TYPE; +# when allocating TB_COLPTR, the type is TY_POINTER, not TY_INT. +# Phil Hodge, 3-Aug-1999 For FITS table, get all column info in one call. + +procedure tbuopn (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer colptr # pointer to column descriptor +int colnum # column number (a loop index) +int fd # fd for table file +int open() +errchk open, calloc, malloc, tbtext, tbtrsi, tbcrcd, tbfopn, tbfrcd, tbzopn + +begin + # Open the file. + if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + fd = open (TB_NAME(tp), TB_IOMODE(tp), TEXT_FILE) + TB_FILE(tp) = fd + + } else if (TB_TYPE(tp) == TBL_TYPE_FITS) { + # Table in a FITS file. + call tbfopn (tp) + + } else if (TB_TYPE(tp) == TBL_TYPE_CDF) { + # Table in a CDF file. + ; # call tbvopn (tp) + + } else { + # For a binary table we need to check that there's an + # extension, and if not, append the default extension. + call tbtext (TB_NAME(tp), TB_NAME(tp), SZ_LINE) + fd = open (TB_NAME(tp), TB_IOMODE(tp), BINARY_FILE) + TB_FILE(tp) = fd + } + + TB_IS_OPEN(tp) = true + + # Read size information from table. + call tbtrsi (tp) + + # Allocate space for the array of pointers to column descriptors. + call malloc (TB_COLPTR(tp), TB_MAXCOLS(tp), TY_POINTER) + + # Create column descriptors. + # (For a text table, TB_NCOLS will still be zero.) + do colnum = 1, TB_NCOLS(tp) { + call malloc (colptr, LEN_COLSTRUCT, TY_STRUCT) + TB_COLINFO(tp,colnum) = colptr + } + + # Read column descriptors from the table. + if (TB_TYPE(tp) == TBL_TYPE_FITS) { + call tbfrcd (tp, TB_COLINFO(tp,1), TB_NCOLS(tp)) + } else { + do colnum = 1, TB_NCOLS(tp) { + colptr = TB_COLINFO(tp,colnum) + call tbcrcd (tp, colptr, colnum) + } + } + + if (TB_TYPE(tp) == TBL_TYPE_S_ROW && !TB_READONLY(tp)) { + + # Allocate space for indef record. + call calloc (TB_INDEF(tp), TB_ROWLEN(tp), TY_CHAR) + # Assign the appropriate indef value in the indef record buffer. + do colnum = 1, TB_NCOLS(tp) { + colptr = TB_COLINFO(tp,colnum) + call tbbnll (tp, colptr) + } + + } else if (TB_TYPE(tp) == TBL_TYPE_TEXT) { + + # Read the contents of the file into memory. + call tbzopn (tp) + } +end diff --git a/pkg/tbtables/tbxag.x b/pkg/tbtables/tbxag.x new file mode 100644 index 00000000..e6a57043 --- /dev/null +++ b/pkg/tbtables/tbxag.x @@ -0,0 +1,649 @@ +include # for MAX_INT, MAX_SHORT, and MAX_REAL +include +include "tbtables.h" + +# This file contains tbxag[tbirds] as well as tbxgpt for getting an +# array of elements from a row ordered table. +# +# Phil Hodge, 12-Sep-1994 Subroutines created. +# Phil Hodge, 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length. + +int procedure tbxagd (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +double buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer buf # scratch for local string buffer +real rbuf +int ibuf +short sbuf +bool bbuf +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nchar # number of char to read +int i # loop index +int read(), nscan() +long tbeoff() +string CANNOTREAD "tbagtd: unexpected end of file" +errchk seek, read, tbxgpt + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + offset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), offset) + + if (dtype == TBL_TY_DOUBLE) { + + nchar = nret * SZ_DOUBLE + if (read (TB_FILE(tp), buffer, nchar) < nchar) + call error (1, CANNOTREAD) + do i = 1, nret { + if (TBL_IS_INDEFD (buffer[i])) + buffer[i] = INDEFD + } + + } else { + + switch (dtype) { + case TBL_TY_REAL: + do i = 1, nret { + if (read (TB_FILE(tp), rbuf, SZ_REAL) < SZ_REAL) + call error (1, CANNOTREAD) + if (IS_INDEFR(rbuf)) + buffer[i] = INDEFD + else + buffer[i] = rbuf + } + case TBL_TY_INT: + do i = 1, nret { + if (read (TB_FILE(tp), ibuf, SZ_INT32) < SZ_INT32) + call error (1, CANNOTREAD) + if (SZ_INT != SZ_INT32) + call iupk32 (ibuf, ibuf, 1) + if (IS_INDEFI(ibuf)) + buffer[i] = INDEFD + else + buffer[i] = ibuf + } + case TBL_TY_SHORT: + do i = 1, nret { + if (read (TB_FILE(tp), sbuf, SZ_SHORT) < SZ_SHORT) + call error (1, CANNOTREAD) + if (IS_INDEFS(sbuf)) + buffer[i] = INDEFD + else + buffer[i] = sbuf + } + case TBL_TY_BOOL: + do i = 1, nret { + if (read (TB_FILE(tp), bbuf, SZ_BOOL) < SZ_BOOL) + call error (1, CANNOTREAD) + if (bbuf) + buffer[i] = double(YES) + else + buffer[i] = double(NO) + } + default: + if (dtype > 0 && dtype != TBL_TY_CHAR) + call error (1, "tbagtd: bad data type") + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + do i = 1, nret { + offset = tbeoff (tp, cp, row, first+i-1) + call tbxgpt (tp, cp, offset, Memc[buf], SZ_LINE, 1) + call sscan (Memc[buf]) + call gargd (buffer[i]) + if (nscan() < 1) + buffer[i] = INDEFD + } + call sfree (sp) + } + } + + return (nret) +end + +int procedure tbxagr (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +real buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer buf # scratch for local string buffer +double dbuf +int ibuf +short sbuf +bool bbuf +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nchar # number of char to read +int i # loop index +int read(), nscan() +long tbeoff() +string CANNOTREAD "tbagtr: unexpected end of file" +errchk seek, read, tbxgpt + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + offset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), offset) + + if (dtype == TBL_TY_REAL) { + + nchar = nret * SZ_REAL + if (read (TB_FILE(tp), buffer, nchar) < nchar) + call error (1, CANNOTREAD) + + } else { + + switch (dtype) { + case TBL_TY_DOUBLE: + do i = 1, nret { + if (read (TB_FILE(tp), dbuf, SZ_DOUBLE) < SZ_DOUBLE) + call error (1, CANNOTREAD) + if (TBL_IS_INDEFD (dbuf)) + buffer[i] = INDEFR + else + buffer[i] = dbuf + } + case TBL_TY_INT: + do i = 1, nret { + if (read (TB_FILE(tp), ibuf, SZ_INT32) < SZ_INT32) + call error (1, CANNOTREAD) + if (SZ_INT != SZ_INT32) + call iupk32 (ibuf, ibuf, 1) + if (IS_INDEFI(ibuf)) + buffer[i] = INDEFR + else + buffer[i] = ibuf + } + case TBL_TY_SHORT: + do i = 1, nret { + if (read (TB_FILE(tp), sbuf, SZ_SHORT) < SZ_SHORT) + call error (1, CANNOTREAD) + if (IS_INDEFS(sbuf)) + buffer[i] = INDEFR + else + buffer[i] = sbuf + } + case TBL_TY_BOOL: + do i = 1, nret { + if (read (TB_FILE(tp), bbuf, SZ_BOOL) < SZ_BOOL) + call error (1, CANNOTREAD) + if (bbuf) + buffer[i] = real(YES) + else + buffer[i] = real(NO) + } + default: + if (dtype > 0 && dtype != TBL_TY_CHAR) + call error (1, "tbagtr: bad data type") + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + do i = 1, nret { + offset = tbeoff (tp, cp, row, first+i-1) + call tbxgpt (tp, cp, offset, Memc[buf], SZ_LINE, 1) + call sscan (Memc[buf]) + call gargd (dbuf) + if (nscan() < 1) + buffer[i] = INDEFR + else if (abs (dbuf) > MAX_REAL) + buffer[i] = INDEFR + else + buffer[i] = dbuf + } + call sfree (sp) + } + } + + return (nret) +end + +int procedure tbxagi (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +int buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer buf # scratch for local string buffer +double dbuf +real rbuf +short sbuf +bool bbuf +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nchar # number of char to read +int i # loop index +int read(), nscan() +long tbeoff() +string CANNOTREAD "tbagti: unexpected end of file" +errchk seek, read, tbxgpt + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + offset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), offset) + + if (dtype == TBL_TY_INT) { + + nchar = nret * SZ_INT32 + if (read (TB_FILE(tp), buffer, nchar) < nchar) + call error (1, CANNOTREAD) + + } else { + + switch (dtype) { + case TBL_TY_DOUBLE: + do i = 1, nret { + if (read (TB_FILE(tp), dbuf, SZ_DOUBLE) < SZ_DOUBLE) + call error (1, CANNOTREAD) + if (TBL_IS_INDEFD (dbuf) || abs (dbuf) > MAX_INT) + buffer[i] = INDEFI + else + buffer[i] = nint (dbuf) + } + case TBL_TY_REAL: + do i = 1, nret { + if (read (TB_FILE(tp), rbuf, SZ_REAL) < SZ_REAL) + call error (1, CANNOTREAD) + if (IS_INDEFR(rbuf) || abs (rbuf) > MAX_INT) + buffer[i] = INDEFI + else + buffer[i] = nint (rbuf) + } + case TBL_TY_SHORT: + do i = 1, nret { + if (read (TB_FILE(tp), sbuf, SZ_SHORT) < SZ_SHORT) + call error (1, CANNOTREAD) + if (IS_INDEFS(sbuf)) + buffer[i] = INDEFI + else + buffer[i] = sbuf + } + case TBL_TY_BOOL: + do i = 1, nret { + if (read (TB_FILE(tp), bbuf, SZ_BOOL) < SZ_BOOL) + call error (1, CANNOTREAD) + if (bbuf) + buffer[i] = YES + else + buffer[i] = NO + } + default: + if (dtype > 0 && dtype != TBL_TY_CHAR) + call error (1, "tbagti: bad data type") + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + do i = 1, nret { + offset = tbeoff (tp, cp, row, first+i-1) + call tbxgpt (tp, cp, offset, Memc[buf], SZ_LINE, 1) + call sscan (Memc[buf]) + call gargd (dbuf) + if (nscan() < 1 || abs (dbuf) > MAX_INT) + buffer[i] = INDEFI + else + buffer[i] = nint (dbuf) + } + call sfree (sp) + } + } + + return (nret) +end + +int procedure tbxags (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +short buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer buf # scratch for local string buffer +double dbuf +real rbuf +int ibuf +bool bbuf +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nchar # number of char to read +int i # loop index +int read(), nscan() +long tbeoff() +string CANNOTREAD "tbagts: unexpected end of file" +errchk seek, read, tbxgpt + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + offset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), offset) + + if (dtype == TBL_TY_SHORT) { + + nchar = nret * SZ_SHORT + if (read (TB_FILE(tp), buffer, nchar) < nchar) + call error (1, CANNOTREAD) + + } else { + + switch (dtype) { + case TBL_TY_DOUBLE: + do i = 1, nret { + if (read (TB_FILE(tp), dbuf, SZ_DOUBLE) < SZ_DOUBLE) + call error (1, CANNOTREAD) + if (TBL_IS_INDEFD (dbuf) || abs (dbuf) > MAX_SHORT) + buffer[i] = INDEFS + else + buffer[i] = nint (dbuf) + } + case TBL_TY_REAL: + do i = 1, nret { + if (read (TB_FILE(tp), rbuf, SZ_REAL) < SZ_REAL) + call error (1, CANNOTREAD) + if (IS_INDEFR(rbuf) || abs (rbuf) > MAX_SHORT) + buffer[i] = INDEFS + else + buffer[i] = nint (rbuf) + } + case TBL_TY_INT: + do i = 1, nret { + if (read (TB_FILE(tp), ibuf, SZ_INT32) < SZ_INT32) + call error (1, CANNOTREAD) + if (SZ_INT != SZ_INT32) + call iupk32 (ibuf, ibuf, 1) + if (IS_INDEFI(ibuf) || abs (ibuf) > MAX_SHORT) + buffer[i] = INDEFS + else + buffer[i] = ibuf + } + case TBL_TY_BOOL: + do i = 1, nret { + if (read (TB_FILE(tp), bbuf, SZ_BOOL) < SZ_BOOL) + call error (1, CANNOTREAD) + if (bbuf) + buffer[i] = YES + else + buffer[i] = NO + } + default: + if (dtype > 0 && dtype != TBL_TY_CHAR) + call error (1, "tbagts: bad data type") + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + do i = 1, nret { + offset = tbeoff (tp, cp, row, first+i-1) + call tbxgpt (tp, cp, offset, Memc[buf], SZ_LINE, 1) + call sscan (Memc[buf]) + call gargd (dbuf) + if (nscan() < 1 || abs (dbuf) > MAX_SHORT) + buffer[i] = INDEFS + else + buffer[i] = nint (dbuf) + } + call sfree (sp) + } + } + + return (nret) +end + +int procedure tbxagb (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +bool buffer[ARB] # o: values read from table +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer buf # scratch for local string buffer +double dbuf +real rbuf +int ibuf +short sbuf +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int nret # actual number of elements to read +int nchar # number of char to read +int i # loop index +int read(), nscan() +long tbeoff() +string CANNOTREAD "tbagtb: unexpected end of file" +errchk seek, read, tbxgpt + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + offset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), offset) + + if (dtype == TBL_TY_BOOL) { + + nchar = nret * SZ_BOOL + if (read (TB_FILE(tp), buffer, nchar) < nchar) + call error (1, CANNOTREAD) + + } else { + + switch (dtype) { + case TBL_TY_DOUBLE: + do i = 1, nret { + if (read (TB_FILE(tp), dbuf, SZ_DOUBLE) < SZ_DOUBLE) + call error (1, CANNOTREAD) + if (TBL_IS_INDEFD (dbuf)) + buffer[i] = false + else + buffer[i] = (dbuf != double(NO)) + } + case TBL_TY_REAL: + do i = 1, nret { + if (read (TB_FILE(tp), rbuf, SZ_REAL) < SZ_REAL) + call error (1, CANNOTREAD) + if (IS_INDEFR(rbuf)) + buffer[i] = false + else + buffer[i] = (rbuf != real(NO)) + } + case TBL_TY_INT: + do i = 1, nret { + if (read (TB_FILE(tp), ibuf, SZ_INT32) < SZ_INT32) + call error (1, CANNOTREAD) + if (SZ_INT != SZ_INT32) + call iupk32 (ibuf, ibuf, 1) + if (IS_INDEFI(ibuf)) + buffer[i] = false + else + buffer[i] = (ibuf != NO) + } + case TBL_TY_SHORT: + do i = 1, nret { + if (read (TB_FILE(tp), sbuf, SZ_SHORT) < SZ_SHORT) + call error (1, CANNOTREAD) + if (IS_INDEFS(sbuf)) + buffer[i] = false + else + buffer[i] = (sbuf != NO) + } + default: + if (dtype > 0 && dtype != TBL_TY_CHAR) + call error (1, "tbagtb: bad data type") + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + do i = 1, nret { + offset = tbeoff (tp, cp, row, first+i-1) + call tbxgpt (tp, cp, offset, Memc[buf], SZ_LINE, 1) + call sscan (Memc[buf]) + call gargb (buffer[i]) + if (nscan() < 1) + buffer[i] = false + } + call sfree (sp) + } + } + + return (nret) +end + +int procedure tbxagt (tp, cp, row, cbuf, maxch, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +char cbuf[maxch,ARB] # o: values read from table +int maxch # i: size of first dimension of cbuf +int first # i: number of first array element to read +int nelem # i: maximum number of elements to read +#-- +pointer sp +pointer buf # scratch for local string buffer +double dbuf +real rbuf +int ibuf +short sbuf +bool bbuf +char pformat[SZ_COLFMT] # print format for column +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int nret # actual number of elements to read +int i # loop index +int read() +long tbeoff() +string CANNOTREAD "tbagtt: unexpected end of file" +errchk seek, read, tbxgpt + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + nret = min (nelem, ntotal-first+1) + offset = tbeoff (tp, cp, row, first) + + if (dtype < 0 || dtype == TBL_TY_CHAR) { + + call tbxgpt (tp, cp, offset, cbuf[1,1], maxch, nret) + + } else { + + call smark (sp) + call salloc (buf, SZ_LINE+maxch, TY_CHAR) + call tbcigt (cp, TBL_COL_FMT, pformat, SZ_COLFMT) + + call seek (TB_FILE(tp), offset) + + do i = 1, nret { + + switch (dtype) { + case TBL_TY_REAL: + if (read (TB_FILE(tp), rbuf, SZ_REAL) < SZ_REAL) + call error (1, CANNOTREAD) + call sprintf (Memc[buf], SZ_LINE+maxch, pformat) + call pargr (rbuf) + case TBL_TY_DOUBLE: + if (read (TB_FILE(tp), dbuf, SZ_DOUBLE) < SZ_DOUBLE) + call error (1, CANNOTREAD) + if (TBL_IS_INDEFD (dbuf)) { + call strcpy ("INDEF", Memc[buf], SZ_LINE) + } else { + call sprintf (Memc[buf], SZ_LINE+maxch, pformat) + call pargd (dbuf) + } + case TBL_TY_INT: + if (read (TB_FILE(tp), ibuf, SZ_INT32) < SZ_INT32) + call error (1, CANNOTREAD) + if (SZ_INT != SZ_INT32) + call iupk32 (ibuf, ibuf, 1) + call sprintf (Memc[buf], SZ_LINE+maxch, pformat) + call pargi (ibuf) + case TBL_TY_SHORT: + if (read (TB_FILE(tp), sbuf, SZ_SHORT) < SZ_SHORT) + call error (1, CANNOTREAD) + call sprintf (Memc[buf], SZ_LINE+maxch, pformat) + call pargs (sbuf) + case TBL_TY_BOOL: + if (read (TB_FILE(tp), bbuf, SZ_BOOL) < SZ_BOOL) + call error (1, CANNOTREAD) + call sprintf (Memc[buf], SZ_LINE+maxch, pformat) + call pargb (bbuf) + default: + call error (1, "tbagtt: bad data type") + } + + call strcpy (Memc[buf], cbuf[1,i], maxch) + } + + call sfree (sp) + } + + return (nret) +end + +# tbxgpt -- array get primitive text + +procedure tbxgpt (tp, cp, offset, cbuf, maxch, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +long offset # i: offset in char to first location +char cbuf[maxch,nelem] # o: buffer to receive values +int maxch # i: size of each element of array +int nelem # i: number of elements to get +#-- +char buffer[SZ_LINE] # buffer for reading from table +long eoffset # offset to location for reading +int nchar # size of each element in table +int i +int read(), tbeszt() +errchk seek, read + +begin + nchar = min (tbeszt (cp), SZ_LINE) # size of each element + eoffset = offset # an initial value + + do i = 1, nelem { # do for each element + + call seek (TB_FILE(tp), eoffset) + if (read (TB_FILE(tp), buffer, nchar) < nchar) + call error (1, "tbxgpt: unexpected end of file") + + # It may be that no EOS was read from the element in the table. + buffer[nchar+1] = EOS + call strupk (buffer, cbuf[1,i], maxch) + + eoffset = eoffset + nchar + } +end diff --git a/pkg/tbtables/tbxap.x b/pkg/tbtables/tbxap.x new file mode 100644 index 00000000..ae2307f9 --- /dev/null +++ b/pkg/tbtables/tbxap.x @@ -0,0 +1,807 @@ +include # for MAX_INT, MAX_SHORT, and MAX_REAL +include +include "tbtables.h" +include "tblerr.h" + +# This file contains tbxap[tbirds] as well as tbxppt for writing an +# array of elements into a row ordered table. +# +# Phil Hodge, 12-Sep-1994 Subroutines created. +# Phil Hodge, 15-Dec-1994 Allocate cbuf instead of using static memory. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 4-Mar-1998 Remove calls to tbtwer. +# Phil Hodge, 5-Aug-1999 Use COL_NELEM instead of tbalen to get array length. +# Phil Hodge, 7-Feb-2000 In tbxapt, update TB_NROWS after calling tbxwer. +# Phil Hodge, 28-Apr-2000 Call tbxwer when writing to TB_NROWS+1, if the +# data type is not the same as in the column. + +procedure tbxapd (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +double buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +long eoffset # offset from BOF to element to put +long roffset # offset from BOF +long offset # offset of element from beginning of row +int rowlen # length of a row in char +int dtype # data type of column +int ntotal # total number of elements in array +int nchar # number of char to write (= nelem * SZ_DOUBLE) +int i +bool some_indef # true if there are any INDEF elements in buffer +pointer cbuf # scratch for character buffer +double dbuf +real rbuf # buffer for writing single precision elements +int ibuf +short sbuf +bool bbuf +long tbeoff(), tbxoff() +errchk seek, write, tbxppt, tbxwer + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + if (ntotal < first+nelem-1) + call error (1, "tbaptd: attempt to put too many elements") + nchar = nelem * SZ_DOUBLE + + if (row == TB_NROWS(tp)+1 && dtype == TBL_TY_DOUBLE) { + + # We're writing the next row after the last. + + rowlen = TB_ROWLEN(tp) + roffset = tbxoff (tp, row) # from BOF to beginning of row + offset = COL_OFFSET(cp) # from beginning of row + + call seek (TB_FILE(tp), roffset) + if (offset > 0) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], offset) + + # Search for INDEF values in buffer, first checking the last + # element because INDEF is more likely to be found at the end. + some_indef = false # initial value + if (IS_INDEFD (buffer[nelem])) { + some_indef = true + } else { + do i = 1, nelem-1 { + if (IS_INDEFD (buffer[i])) { + some_indef = true + break + } + } + } + if (some_indef) { + do i = 1, nelem { + if (IS_INDEFD (buffer[i])) + dbuf = TBL_INDEFD + else + dbuf = buffer[i] + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + } else { + call write (TB_FILE(tp), buffer, nchar) + } + + call seek (TB_FILE(tp), roffset+offset+nchar) + if (offset+nchar < rowlen) { + call write (TB_FILE(tp), Memc[TB_INDEF(tp)+offset+nchar], + rowlen-(offset+nchar)) + } + + TB_NROWS(tp) = row + + } else { + + # row > TB_NROWS was taken care of by tbswer1. + if (row == TB_NROWS(tp) + 1) { + call tbxwer (tp, row) + TB_NROWS(tp) = row + } + + # Get the offset from BOF to first element to put, and go there. + eoffset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), eoffset) + + dtype = COL_DTYPE(cp) + switch (dtype) { + case TBL_TY_REAL: + do i = 1, nelem { # put each element individually + if (IS_INDEFD (buffer[i]) || abs (buffer[i]) > MAX_REAL) + rbuf = INDEFR + else + rbuf = buffer[i] + call write (TB_FILE(tp), rbuf, SZ_REAL) + } + case TBL_TY_DOUBLE: + some_indef = false # initial value + if (IS_INDEFD (buffer[nelem])) { + some_indef = true + } else { + do i = 1, nelem-1 { + if (IS_INDEFD (buffer[i])) { + some_indef = true + break + } + } + } + if (some_indef) { + do i = 1, nelem { + if (IS_INDEFD (buffer[i])) + dbuf = TBL_INDEFD + else + dbuf = buffer[i] + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + } else { + call write (TB_FILE(tp), buffer, nchar) + } + case TBL_TY_INT: + do i = 1, nelem { + if (IS_INDEFD (buffer[i]) || abs (buffer[i]) > MAX_INT) + ibuf = INDEFI + else + ibuf = nint (buffer[i]) + if (SZ_INT != SZ_INT32) + call ipak32 (ibuf, ibuf, 1) + call write (TB_FILE(tp), ibuf, SZ_INT32) + } + case TBL_TY_SHORT: + do i = 1, nelem { + if (IS_INDEFD (buffer[i]) || abs (buffer[i]) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = nint (buffer[i]) + call write (TB_FILE(tp), sbuf, SZ_SHORT) + } + case TBL_TY_BOOL: + do i = 1, nelem { + if (IS_INDEFD (buffer[i])) + bbuf = false + else + bbuf = (buffer[i] != double(NO)) + call write (TB_FILE(tp), bbuf, SZ_BOOL) + } + default: + if (dtype < 0 || dtype == TY_CHAR) { + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + do i = 1, nelem { + eoffset = tbeoff (tp, cp, row, first+i-1) + call sprintf (Memc[cbuf], SZ_FNAME, "%.16g") + call pargd (buffer[i]) + call tbxppt (tp, cp, eoffset, Memc[cbuf], SZ_FNAME, 1) + } + call sfree (sp) + } else { + call error (ER_TBCOLBADTYP, + "tbaptd: bad data type; table or memory corrupted?") + } + } + } +end + +procedure tbxapr (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +real buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +long eoffset # offset from BOF to element to put +long roffset # offset from BOF +long offset # offset of element from beginning of row +int rowlen # length of a row in char +int dtype # data type of column +int ntotal # total number of elements in array +int nchar # number of char to write (= nelem * SZ_REAL) +int i +pointer cbuf # scratch for character buffer +double dbuf # buffer for writing double precision elements +int ibuf +short sbuf +bool bbuf +long tbeoff(), tbxoff() +errchk seek, write, tbxppt, tbxwer + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + if (ntotal < first+nelem-1) + call error (1, "tbaptr: attempt to put too many elements") + nchar = nelem * SZ_REAL + + if (row == TB_NROWS(tp)+1 && dtype == TBL_TY_REAL) { + + # We're writing the next row after the last. + + rowlen = TB_ROWLEN(tp) + roffset = tbxoff (tp, row) # from BOF to beginning of row + offset = COL_OFFSET(cp) # from beginning of row + + call seek (TB_FILE(tp), roffset) + if (offset > 0) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], offset) + call write (TB_FILE(tp), buffer, nchar) + call seek (TB_FILE(tp), roffset+offset+nchar) + if (offset+nchar < rowlen) { + call write (TB_FILE(tp), Memc[TB_INDEF(tp)+offset+nchar], + rowlen-(offset+nchar)) + } + + TB_NROWS(tp) = row + + } else { + + # row > TB_NROWS was taken care of by tbswer1. + if (row == TB_NROWS(tp) + 1) { + call tbxwer (tp, row) + TB_NROWS(tp) = row + } + + # Get the offset from BOF to first element to put, and go there. + eoffset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), eoffset) + + dtype = COL_DTYPE(cp) + switch (dtype) { + case TBL_TY_REAL: + call write (TB_FILE(tp), buffer, nelem * SZ_REAL) + case TBL_TY_DOUBLE: + do i = 1, nelem { # put each element individually + if (IS_INDEFR (buffer[i])) + dbuf = TBL_INDEFD + else + dbuf = buffer[i] + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + case TBL_TY_INT: + do i = 1, nelem { + if (IS_INDEFR (buffer[i]) || abs (buffer[i]) > MAX_INT) + ibuf = INDEFI + else + ibuf = nint (buffer[i]) + if (SZ_INT != SZ_INT32) + call ipak32 (ibuf, ibuf, 1) + call write (TB_FILE(tp), ibuf, SZ_INT32) + } + case TBL_TY_SHORT: + do i = 1, nelem { + if (IS_INDEFR (buffer[i]) || abs (buffer[i]) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = nint (buffer[i]) + call write (TB_FILE(tp), sbuf, SZ_SHORT) + } + case TBL_TY_BOOL: + do i = 1, nelem { + if (IS_INDEFR (buffer[i])) + bbuf = false + else + bbuf = (buffer[i] != real(NO)) + call write (TB_FILE(tp), bbuf, SZ_BOOL) + } + default: + if (dtype < 0 || dtype == TY_CHAR) { + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + do i = 1, nelem { + eoffset = tbeoff (tp, cp, row, first+i-1) + call sprintf (Memc[cbuf], SZ_FNAME, "%.7g") + call pargr (buffer[i]) + call tbxppt (tp, cp, eoffset, Memc[cbuf], SZ_FNAME, 1) + } + call sfree (sp) + } else { + call error (ER_TBCOLBADTYP, + "tbaptr: bad data type; table or memory corrupted?") + } + } + } +end + +procedure tbxapi (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +int buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +long eoffset # offset from BOF to element to put +long roffset # offset from BOF +long offset # offset of element from beginning of row +int rowlen # length of a row in char +int dtype # data type of column +int ntotal # total number of elements in array +int nchar # number of char to write (= nelem * SZ_INT32) +int i +pointer cbuf # scratch for character buffer +double dbuf # buffer for writing double precision elements +real rbuf +short sbuf +bool bbuf +long tbeoff(), tbxoff() +errchk seek, write, tbxppt, tbxwer + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + if (ntotal < first+nelem-1) + call error (1, "tbapti: attempt to put too many elements") + nchar = nelem * SZ_INT32 + + if (row == TB_NROWS(tp)+1 && dtype == TBL_TY_INT) { + + # We're writing the next row after the last. + + rowlen = TB_ROWLEN(tp) + roffset = tbxoff (tp, row) # from BOF to beginning of row + offset = COL_OFFSET(cp) # from beginning of row + + call seek (TB_FILE(tp), roffset) + if (offset > 0) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], offset) + call write (TB_FILE(tp), buffer, nchar) + call seek (TB_FILE(tp), roffset+offset+nchar) + if (offset+nchar < rowlen) { + call write (TB_FILE(tp), Memc[TB_INDEF(tp)+offset+nchar], + rowlen-(offset+nchar)) + } + + TB_NROWS(tp) = row + + } else { + + # row > TB_NROWS was taken care of by tbswer1. + if (row == TB_NROWS(tp) + 1) { + call tbxwer (tp, row) + TB_NROWS(tp) = row + } + + # Get the offset from BOF to first element to put, and go there. + eoffset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), eoffset) + + dtype = COL_DTYPE(cp) + switch (dtype) { + case TBL_TY_REAL: + do i = 1, nelem { # put each element individually + if (IS_INDEFI (buffer[i])) + rbuf = INDEFR + else + rbuf = buffer[i] + call write (TB_FILE(tp), rbuf, SZ_REAL) + } + case TBL_TY_DOUBLE: + do i = 1, nelem { # put each element individually + if (IS_INDEFI (buffer[i])) + dbuf = TBL_INDEFD + else + dbuf = buffer[i] + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + case TBL_TY_INT: + call write (TB_FILE(tp), buffer, nelem * SZ_INT32) + case TBL_TY_SHORT: + do i = 1, nelem { + if (IS_INDEFI (buffer[i]) || abs (buffer[i]) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = buffer[i] + call write (TB_FILE(tp), sbuf, SZ_SHORT) + } + case TBL_TY_BOOL: + do i = 1, nelem { + if (IS_INDEFI (buffer[i])) + bbuf = false + else + bbuf = (buffer[i] != NO) + call write (TB_FILE(tp), bbuf, SZ_BOOL) + } + default: + if (dtype < 0 || dtype == TY_CHAR) { + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + do i = 1, nelem { + eoffset = tbeoff (tp, cp, row, first+i-1) + call sprintf (Memc[cbuf], SZ_FNAME, "%d") + call pargi (buffer[i]) + call tbxppt (tp, cp, eoffset, Memc[cbuf], SZ_FNAME, 1) + } + call sfree (sp) + } else { + call error (ER_TBCOLBADTYP, + "tbapti: bad data type; table or memory corrupted?") + } + } + } +end + +procedure tbxaps (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +short buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +long eoffset # offset from BOF to element to put +long roffset # offset from BOF +long offset # offset of element from beginning of row +int rowlen # length of a row in char +int dtype # data type of column +int ntotal # total number of elements in array +int nchar # number of char to write (= nelem * SZ_SHORT) +int i +pointer cbuf # scratch for character buffer +double dbuf # buffer for writing double precision elements +real rbuf +int ibuf +bool bbuf +long tbeoff(), tbxoff() +errchk seek, write, tbxppt, tbxwer + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + if (ntotal < first+nelem-1) + call error (1, "tbapts: attempt to put too many elements") + nchar = nelem * SZ_SHORT + + if (row == TB_NROWS(tp)+1 && dtype == TBL_TY_SHORT) { + + # We're writing the next row after the last. + + rowlen = TB_ROWLEN(tp) + roffset = tbxoff (tp, row) # from BOF to beginning of row + offset = COL_OFFSET(cp) # from beginning of row + + call seek (TB_FILE(tp), roffset) + if (offset > 0) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], offset) + call write (TB_FILE(tp), buffer, nchar) + call seek (TB_FILE(tp), roffset+offset+nchar) + if (offset+nchar < rowlen) { + call write (TB_FILE(tp), Memc[TB_INDEF(tp)+offset+nchar], + rowlen-(offset+nchar)) + } + + TB_NROWS(tp) = row + + } else { + + # row > TB_NROWS was taken care of by tbswer1. + if (row == TB_NROWS(tp) + 1) { + call tbxwer (tp, row) + TB_NROWS(tp) = row + } + + # Get the offset from BOF to first element to put, and go there. + eoffset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), eoffset) + + dtype = COL_DTYPE(cp) + switch (dtype) { + case TBL_TY_REAL: + do i = 1, nelem { # put each element individually + if (IS_INDEFS (buffer[i])) + rbuf = INDEFR + else + rbuf = buffer[i] + call write (TB_FILE(tp), rbuf, SZ_REAL) + } + case TBL_TY_DOUBLE: + do i = 1, nelem { # put each element individually + if (IS_INDEFS (buffer[i])) + dbuf = TBL_INDEFD + else + dbuf = buffer[i] + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + case TBL_TY_INT: + do i = 1, nelem { + if (IS_INDEFS (buffer[i])) + ibuf = INDEFI + else + ibuf = buffer[i] + if (SZ_INT != SZ_INT32) + call ipak32 (ibuf, ibuf, 1) + call write (TB_FILE(tp), ibuf, SZ_INT32) + } + case TBL_TY_SHORT: + call write (TB_FILE(tp), buffer, nelem * SZ_SHORT) + case TBL_TY_BOOL: + do i = 1, nelem { + if (IS_INDEFS (buffer[i])) + bbuf = false + else + bbuf = (buffer[i] != NO) + call write (TB_FILE(tp), bbuf, SZ_BOOL) + } + default: + if (dtype < 0 || dtype == TY_CHAR) { + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + do i = 1, nelem { + eoffset = tbeoff (tp, cp, row, first+i-1) + call sprintf (Memc[cbuf], SZ_FNAME, "%d") + call pargs (buffer[i]) + call tbxppt (tp, cp, eoffset, Memc[cbuf], SZ_FNAME, 1) + } + call sfree (sp) + } else { + call error (ER_TBCOLBADTYP, + "tbapts: bad data type; table or memory corrupted?") + } + } + } +end + +procedure tbxapb (tp, cp, row, buffer, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +bool buffer[ARB] # i: values to write to table +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +pointer sp +long eoffset # offset from BOF to element to put +long roffset # offset from BOF +long offset # offset of element from beginning of row +int rowlen # length of a row in char +int dtype # data type of column +int ntotal # total number of elements in array +int nchar # number of char to write (= nelem * SZ_BOOL) +int i +pointer cbuf # scratch for character buffer +double dbuf # buffer for writing double precision elements +real rbuf +int ibuf +short sbuf +long tbeoff(), tbxoff() +errchk seek, write, tbxppt, tbxwer + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + if (ntotal < first+nelem-1) + call error (1, "tbaptb: attempt to put too many elements") + nchar = nelem * SZ_BOOL + + if (row == TB_NROWS(tp)+1 && dtype == TBL_TY_BOOL) { + + # We're writing the next row after the last. + + rowlen = TB_ROWLEN(tp) + roffset = tbxoff (tp, row) # from BOF to beginning of row + offset = COL_OFFSET(cp) # from beginning of row + + call seek (TB_FILE(tp), roffset) + if (offset > 0) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], offset) + call write (TB_FILE(tp), buffer, nchar) + call seek (TB_FILE(tp), roffset+offset+nchar) + if (offset+nchar < rowlen) { + call write (TB_FILE(tp), Memc[TB_INDEF(tp)+offset+nchar], + rowlen-(offset+nchar)) + } + + TB_NROWS(tp) = row + + } else { + + # row > TB_NROWS was taken care of by tbswer1. + if (row == TB_NROWS(tp) + 1) { + call tbxwer (tp, row) + TB_NROWS(tp) = row + } + + # Get the offset from BOF to first element to put, and go there. + eoffset = tbeoff (tp, cp, row, first) + call seek (TB_FILE(tp), eoffset) + + dtype = COL_DTYPE(cp) + switch (dtype) { + case TBL_TY_REAL: + do i = 1, nelem { # put each element individually + if (buffer[i]) + rbuf = real(YES) + else + rbuf = real(NO) + call write (TB_FILE(tp), rbuf, SZ_REAL) + } + case TBL_TY_DOUBLE: + do i = 1, nelem { # put each element individually + if (buffer[i]) + dbuf = double(YES) + else + dbuf = double(NO) + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + case TBL_TY_INT: + do i = 1, nelem { + if (buffer[i]) + ibuf = YES + else + ibuf = NO + if (SZ_INT != SZ_INT32) + call ipak32 (ibuf, ibuf, 1) + call write (TB_FILE(tp), ibuf, SZ_INT32) + } + case TBL_TY_SHORT: + do i = 1, nelem { + if (buffer[i]) + sbuf = YES + else + sbuf = NO + call write (TB_FILE(tp), sbuf, SZ_SHORT) + } + case TBL_TY_BOOL: + call write (TB_FILE(tp), buffer, nelem * SZ_BOOL) + default: + if (dtype < 0 || dtype == TY_CHAR) { + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + do i = 1, nelem { + eoffset = tbeoff (tp, cp, row, first+i-1) + call sprintf (Memc[cbuf], SZ_FNAME, "%-3b") + call pargb (buffer[i]) + call tbxppt (tp, cp, eoffset, Memc[cbuf], SZ_FNAME, 1) + } + call sfree (sp) + } else { + call error (ER_TBCOLBADTYP, + "tbaptb: bad data type; table or memory corrupted?") + } + } + } +end + +procedure tbxapt (tp, cp, row, cbuf, maxch, first, nelem) + +pointer tp # i: pointer to table struct +pointer cp # i: pointer to column struct +int row # i: row number +char cbuf[maxch,ARB] # i: values to write to table +int maxch # i: size of first dimension of cbuf +int first # i: number of first array element to write +int nelem # i: maximum number of elements to write +#-- +long offset # offset of first element in entry +int dtype # data type of column +int ntotal # total number of elements in array +int i +double dbuf # buffer for writing double precision elements +real rbuf +int ibuf +short sbuf +bool bbuf +int nscan() +long tbeoff() +errchk tbxppt, tbxwer + +begin + dtype = COL_DTYPE(cp) + ntotal = COL_NELEM(cp) + if (ntotal < first+nelem-1) + call error (1, "tbaptt: attempt to put too many elements") + + if (row > TB_NROWS(tp)) { + call tbxwer (tp, row) + TB_NROWS(tp) = row + } + + offset = tbeoff (tp, cp, row, first) + + if (dtype < 0 || dtype == TBL_TY_CHAR) { + + call tbxppt (tp, cp, offset, cbuf, maxch, nelem) + + } else { + + call seek (TB_FILE(tp), offset) + + dtype = COL_DTYPE(cp) + switch (dtype) { + case TBL_TY_REAL: + do i = 1, nelem { # put each element individually + call sscan (cbuf[1,i]) + call gargd (dbuf) + if (nscan() < 1) + rbuf = TBL_INDEFD + else if (IS_INDEFD (dbuf) || abs (dbuf) > MAX_REAL) + rbuf = INDEFR + else + rbuf = dbuf + call write (TB_FILE(tp), rbuf, SZ_REAL) + } + case TBL_TY_DOUBLE: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargd (dbuf) + if (nscan() < 1) + dbuf = TBL_INDEFD + else if (IS_INDEFD (dbuf)) + dbuf = TBL_INDEFD + call write (TB_FILE(tp), dbuf, SZ_DOUBLE) + } + case TBL_TY_INT: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargd (dbuf) + if (nscan() < 1 || abs (dbuf) > MAX_INT) + ibuf = INDEFI + else + ibuf = nint (dbuf) + if (SZ_INT != SZ_INT32) + call ipak32 (ibuf, ibuf, 1) + call write (TB_FILE(tp), ibuf, SZ_INT32) + } + case TBL_TY_SHORT: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargd (dbuf) + if (nscan() < 1 || abs (dbuf) > MAX_SHORT) + sbuf = INDEFS + else + sbuf = nint (dbuf) + call write (TB_FILE(tp), sbuf, SZ_SHORT) + } + case TBL_TY_BOOL: + do i = 1, nelem { + call sscan (cbuf[1,i]) + call gargb (bbuf) + if (nscan() < 1) + bbuf = false + call write (TB_FILE(tp), bbuf, SZ_BOOL) + } + } + } +end + +# tbxppt -- primitive put array text + +procedure tbxppt (tp, cp, offset, cbuf, maxch, nelem) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +long offset # i: offset in char to first location +char cbuf[maxch,nelem] # i: buffer containing values +int maxch # i: size of each element of array +int nelem # i: number of elements to put +#-- +char buffer[SZ_LINE] # buffer for packed string +long eoffset # location in char for writing +int nchar # number of char to write +int i +int tbeszt() +errchk seek, write + +begin + nchar = min (tbeszt (cp), SZ_LINE) # size of each element + eoffset = offset # an initial value + + do i = 1, nelem { # do for each element + + call strpak (cbuf[1,i], buffer, SZ_LINE) # pack the string + + call seek (TB_FILE(tp), eoffset) + call write (TB_FILE(tp), buffer, nchar) + + eoffset = eoffset + nchar + } +end diff --git a/pkg/tbtables/tbxcg.x b/pkg/tbtables/tbxcg.x new file mode 100644 index 00000000..8bb609e9 --- /dev/null +++ b/pkg/tbtables/tbxcg.x @@ -0,0 +1,723 @@ +include +include +include "tbtables.h" +include "tblerr.h" + +# tbxcgb -- X getcol Boolean +# Read values for one column from a range of rows. This is for data type +# Boolean and row-oriented SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 22-Jan-1993 Use IS_INDEF instead of == INDEF. +# Phil Hodge, 31-Mar-1993 Include short datatype; in tbxcgb, for types other +# than boolean, change test from "if (buf == YES)" to "if (buf != NO)". +# Phil Hodge, 3-Sep-1993 Change declaration of locn in tbxcgr to long; +# Phil Hodge, 4-Nov-1993 Call sscan as a subroutine, not a function. +# Phil Hodge, 14-Sep-1994 Use tbeszt for length of string. +# Phil Hodge, 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. +# Phil Hodge, 27-Aug-2002 In tbxcgi and tbxcgs, include an explicit test +# for INDEF, rather than relying on a test on abs (dblbuf). + +procedure tbxcgb (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +bool buffer[ARB] # o: buffer for values +bool nullflag[ARB] # o: true if element is undefined in table +int firstrow # i: first row from which to get values +int lastrow # i: last row from which to get values +#-- +long locn # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int rowlen # Record length (chars) +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +int read(), nscan() +int tbeszt() +errchk seek, read + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(realbuf) != NO) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(dblbuf) != NO) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (intbuf != NO) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (shortbuf != NO) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), buffer[k], SZ_BOOL) + nullflag[k] = false + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), charbuf, nchar) + call strupk (charbuf, charbuf, SZ_LINE) + if (charbuf[1] != EOS) { + call sscan (charbuf) + call gargb (buffer[k]) + if (nscan() < 1) { + buffer[k] = false + nullflag[k] = true + } else { + nullflag[k] = false + } + } else { + buffer[k] = false + nullflag[k] = true + } + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtb: invalid data type") + } + } +end + + +# tbxcgd -- X getcol double +# Read values for one column from a range of rows. This is for data type +# double precision and row-ordered SDAS tables. + +procedure tbxcgd (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +double buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long locn # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int rowlen # Record length (chars) +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of a string in table file +# buffers for reading values of various types +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +int read(), nscan() +int tbeszt() +errchk seek, read + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = realbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), buffer[k], SZ_DOUBLE) + if (TBL_IS_INDEFD (buffer[k])) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = real(YES) + else + buffer[k] = real(NO) + nullflag[k] = false + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), charbuf, nchar) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (buffer[k]) + if (nscan() < 1) + buffer[k] = INDEFD + nullflag[k] = IS_INDEFD (buffer[k]) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtd: invalid data type") + } + } +end + + +# tbxcgr -- X getcol real +# Read values for one column from a range of rows. This is for data type real +# and row-ordered SDAS tables. + +procedure tbxcgr (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +real buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +int k # Index in arrays buffer & nullflag +long locn # Location (chars) for reading in table +int rowlen # Record length (chars) +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +int read(), nscan() +int tbeszt() +errchk seek, read + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), buffer[k], SZ_REAL) + nullflag[k] = IS_INDEFR (buffer[k]) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = dblbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = real(YES) + else + buffer[k] = real(NO) + nullflag[k] = false + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), charbuf, nchar) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargr (buffer[k]) + if (nscan() < 1) + buffer[k] = INDEFR + nullflag[k] = IS_INDEFR (buffer[k]) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtr: invalid data type") + } + } +end + + +# tbxcgi -- X getcol integer +# Read values for one column from a range of rows. This is for data type +# integer and row-ordered SDAS tables. + +procedure tbxcgi (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +int buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long locn # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int rowlen # Record length (chars) +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +int read(), nscan() +int tbeszt() +errchk seek, read + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), buffer[k], SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (buffer[k], buffer[k], 1) + nullflag[k] = IS_INDEFI (buffer[k]) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), charbuf, nchar) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFI (buffer[k]) + } + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgti: invalid data type") + } + } +end + + +# tbxcgs -- X getcol short +# Read values for one column from a range of rows. This is for data type +# short integer and row-ordered SDAS tables. + +procedure tbxcgs (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +short buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long locn # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int rowlen # Record length (chars) +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +int read(), nscan() +int tbeszt() +errchk seek, read + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_SHORT) { + buffer[k] = INDEFS + } else { + buffer[k] = nint (realbuf) + } + nullflag[k] = IS_INDEFS (buffer[k]) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFS (buffer[k]) + } + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf) || abs (intbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = IS_INDEFS (buffer[k]) + } + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), buffer[k], SZ_SHORT) + nullflag[k] = IS_INDEFS (buffer[k]) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), charbuf, nchar) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFS (buffer[k]) + } + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgts: invalid data type") + } + } +end + + +# tbxcgt -- X getcol text +# Read values for one column from a range of rows. This is for character +# strings and row-ordered SDAS tables. + +procedure tbxcgt (tp, colptr, buffer, nullflag, lenstring, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +char buffer[lenstring,ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int lenstring # The number of char in each element of buffer +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long locn # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int numchar # Number of characters to copy string to string +int rowlen # Record length (chars) +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +int read() +int tbeszt() +errchk seek, read, sprintf + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargr (realbuf) + nullflag[k] = IS_INDEFR (realbuf) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + call strcpy ("INDEF", buffer[1,k], lenstring) + nullflag[k] = true + } else { + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargd (dblbuf) + nullflag[k] = false + } + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargi (intbuf) + nullflag[k] = IS_INDEFI (intbuf) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargs (shortbuf) + nullflag[k] = IS_INDEFS (shortbuf) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargb (boolbuf) + nullflag[k] = false + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + stat = read (TB_FILE(tp), charbuf, nchar) + numchar = min (lenstring, SZB_CHAR*nchar) + call strupk (charbuf, buffer[1,k], numchar) + nullflag[k] = (buffer[1,k] == EOS) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtt: invalid data type") + } + } +end diff --git a/pkg/tbtables/tbxcp.x b/pkg/tbtables/tbxcp.x new file mode 100644 index 00000000..7e21d452 --- /dev/null +++ b/pkg/tbtables/tbxcp.x @@ -0,0 +1,621 @@ +include # for MAX_INT and MAX_SHORT +include "tbtables.h" +include "tblerr.h" + +# tbxcpb -- X putcol Boolean +# Write values for one column to a range of rows. This is for data type +# Boolean and row-ordered SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 tbxcpt: call sscan as a subroutine, not a function. +# Phil Hodge, 14-Sep-1994 Use tbeszt for length of string; in tbxcpt, use +# gargd (dblbuf) and then nint for int & short. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 3-Mar-1998 Remove call to tbxwsk. +# Phil Hodge, 27-Aug-2002 In tbxcpi and tbxcps, include an explicit test +# for INDEF, rather than relying on a test on abs (dblbuf). + +procedure tbxcpb (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +bool buffer[ARB] # i: buffer for values +int firstrow # i: first row into which to put values +int lastrow # i: last row into which to put values +#-- +long locn # Location (chars) for reading in table +int k # Index in output array buffer +int rowlen # Record length (chars) +int datatype # Data type of element in table +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +int tbeszt() +errchk seek, write + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (buffer[k]) + realbuf = real(YES) + else + realbuf = real(NO) + call write (TB_FILE(tp), realbuf, SZ_REAL) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (buffer[k]) + dblbuf = double(YES) + else + dblbuf = double(NO) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (buffer[k]) + intbuf = YES + else + intbuf = NO + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (buffer[k]) + shortbuf = YES + else + shortbuf = NO + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call write (TB_FILE(tp), buffer[k], SZ_BOOL) + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sprintf (charbuf, SZ_LINE, "%-3b") + call pargb (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, nchar) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptb: invalid data type") + } + } +end + + +# tbxcpd -- X putcol double +# Write values for one column to a range of rows. This is for data type +# double precision and row-ordered SDAS tables. + +procedure tbxcpd (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +double buffer[ARB] # i: buffer for values +int firstrow # i: first row into which to put values +int lastrow # i: last row into which to put values +#-- +long locn # Location (chars) for reading in table +int k # Index in output array buffer +int rowlen # Record length (chars) +int datatype # Data type of element in table +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +int tbeszt() +errchk seek, write + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFD (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFD (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFD (buffer[k]) || nint(buffer[k]) == NO) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sprintf (charbuf, SZ_LINE, "%-25.17g") + call pargd (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, nchar) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptd: invalid data type") + } + } +end + + +# tbxcpr -- X putcol real +# Write values for one column to a range of rows. This is for data type real +# and row-ordered SDAS tables. + +procedure tbxcpr (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +real buffer[ARB] # i: buffer for values +int firstrow # i: first row into which to put values +int lastrow # i: last row into which to put values +#-- +long locn # Location (chars) for reading in table +int k # Index in output array buffer +int rowlen # Record length (chars) +int datatype # Data type of element in table +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf # Buffer for writing double-precision values +int intbuf # Buffer for writing integer values +short shortbuf +bool boolbuf # Buffer for writing Boolean values +char charbuf[SZ_LINE] # Buffer for writing character values +int tbeszt() +errchk seek, write + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call write (TB_FILE(tp), buffer[k], SZ_REAL) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFR (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFR (buffer[k]) || nint(buffer[k]) == NO) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sprintf (charbuf, SZ_LINE, "%-15.7g") + call pargr (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, nchar) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptr: invalid data type") + } + } +end + + +# tbxcpi -- X putcol integer +# Write values for one column to a range of rows. This is for data type +# integer and row-ordered SDAS tables. + +procedure tbxcpi (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +int buffer[ARB] # i: buffer for values +int firstrow # i: first row into which to put values +int lastrow # i: last row into which to put values +#-- +long locn # Location (chars) for reading in table +int k # Index in output array buffer +int rowlen # Record length (chars) +int datatype # Data type of element in table +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf # Buffer for writing double-precision values +real realbuf # Buffer for writing real values +short shortbuf +bool boolbuf # Buffer for writing Boolean values +char charbuf[SZ_LINE] # Buffer for writing character values +int tbeszt() +errchk seek, write + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFI (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFI (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (SZ_INT != SZ_INT32) + call ipak32 (buffer[k], buffer[k], 1) + call write (TB_FILE(tp), buffer[k], SZ_INT32) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFI (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = buffer[k] + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFI (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargi (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, nchar) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcpti: invalid data type") + } + } +end + + +# tbxcps -- X putcol short +# Write values for one column to a range of rows. This is for data type +# short integer and row-ordered SDAS tables. + +procedure tbxcps (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +short buffer[ARB] # i: buffer for values +int firstrow # i: first row into which to put values +int lastrow # i: last row into which to put values +#-- +long locn # Location (chars) for reading in table +int k # Index in output array buffer +int rowlen # Record length (chars) +int datatype # Data type of element in table +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +int tbeszt() +errchk seek, write + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFS (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFS (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFS (buffer[k])) + intbuf = INDEFI + else + intbuf = buffer[k] + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call write (TB_FILE(tp), buffer[k], SZ_SHORT) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + if (IS_INDEFS (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargs (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, nchar) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcpts: invalid data type") + } + } +end + + +# tbxcpt -- X putcol text +# Write values for one column to a range of rows. This is for character +# strings and row-ordered SDAS tables. + +procedure tbxcpt (tp, colptr, buffer, lenstring, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr # i: pointer to descriptor of the column +char buffer[lenstring,ARB] # i: buffer for values +int lenstring # i: number of char in each element of buffer +int firstrow # i: first row into which to put values +int lastrow # i: last row into which to put values +#-- +long locn # Location (chars) for reading in table +int k # Index in output array buffer +int rowlen # Record length (chars) +int datatype # Data type of element in table +int nchar # Size of a string in table file +# buffers for reading values of various types +double dblbuf # Buffer for reading double-precision values +real realbuf # Buffer for reading real values +int intbuf # Buffer for reading integer values +short shortbuf +bool boolbuf # Buffer for reading Boolean values +char charbuf[SZ_LINE] # Buffer for reading character values +int nscan() +int tbeszt() +errchk seek, write + +begin + rowlen = TB_ROWLEN(tp) + datatype = COL_DTYPE(colptr) + locn = (firstrow-1) * rowlen + TB_BOD(tp) + COL_OFFSET(colptr) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sscan (buffer[1,k]) + call gargr (realbuf) + if (nscan() < 1) + realbuf = INDEFR + call write (TB_FILE(tp), realbuf, SZ_REAL) + locn = locn + rowlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1) + dblbuf = TBL_INDEFD + else if (IS_INDEFD (dblbuf)) + dblbuf = TBL_INDEFD + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + locn = locn + rowlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + intbuf = INDEFI + } else { + intbuf = nint (dblbuf) + } + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + locn = locn + rowlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + shortbuf = INDEFS + } else { + shortbuf = nint (dblbuf) + } + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + locn = locn + rowlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call sscan (buffer[1,k]) + call gargb (boolbuf) + if (nscan() < 1) + boolbuf = false + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + locn = locn + rowlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr) + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), locn) + call strpak (buffer[1,k], charbuf, lenstring) + call write (TB_FILE(tp), charbuf, nchar) + locn = locn + rowlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptt: invalid data type") + } + } +end diff --git a/pkg/tbtables/tbxncn.x b/pkg/tbtables/tbxncn.x new file mode 100644 index 00000000..69a650f7 --- /dev/null +++ b/pkg/tbtables/tbxncn.x @@ -0,0 +1,31 @@ +include "tbtables.h" + +# tbxncn -- new column null +# Write INDEF values for each new column in each existing row of a table. +# This is called after defining new columns in an open table, but only if +# it contains some rows and the record length did not have to be increased. +# +# Phil Hodge, 30-Mar-1993 indef_rec is now TY_CHAR rather than TY_REAL. + +procedure tbxncn (tp, old_colused, indef_rec) + +pointer tp # i: Pointer to table descriptor +int old_colused # i: Previous value of TB_COLUSED (unit=SZ_CHAR) +char indef_rec[ARB] # i: INDEF record buffer +#-- +long locn # Location (chars) for writing in table +int start # Location in INDEF record of values to write +int k # Loop index +int num_chars # Number of chars to write as INDEF + +begin + num_chars = TB_COLUSED(tp) - old_colused + + start = old_colused + 1 # unit = SZ_CHAR + locn = TB_BOD(tp) + old_colused # incremented in loop + do k = 1, TB_NROWS(tp) { + call seek (TB_FILE(tp), locn) + call write (TB_FILE(tp), indef_rec[start], num_chars) + locn = locn + TB_ROWLEN(tp) + } +end diff --git a/pkg/tbtables/tbxnew.x b/pkg/tbtables/tbxnew.x new file mode 100644 index 00000000..bf9f5f0c --- /dev/null +++ b/pkg/tbtables/tbxnew.x @@ -0,0 +1,71 @@ +include +include "tbtables.h" + +# tbxnew -- X create new table +# Allocate space for indef record buffer, write record for size information, +# and write each column descriptor (if any) to table. +# +# Phil Hodge, 7-Mar-1989 Eliminate TB_MODSIZE. +# Phil Hodge, 16-Nov-1990 Use temporary variable instead of TB_FILE(tp) when +# opening table file so TB_FILE(tp) will still be NULL in case of error. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 15-Apr-1998 Change calling sequence of tbcwcd. + +procedure tbxnew (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer colptr +pointer sp +pointer pstr # buffer for dummy space for user parameters +pointer colinfo # buffer for dummy space for extra column descr +int k # loop index +int parnum # parameter number (dummy values for "header") +int colnum # column number +int fd # fd for table file +int open() +errchk tbtwsi, tbhwpr, tbcwcd, open, calloc + +begin + call smark (sp) + # Allocate space for dummy parameter & column descriptor records. + call salloc (pstr, SZ_PARREC, TY_CHAR) + call salloc (colinfo, LEN_COLSTRUCT, TY_STRUCT) + + if (TB_ROWLEN(tp) < 0) + TB_ROWLEN(tp) = DEFMAXCOLS + + # Open the file. This was split into two lines so that if the open + # fails, TB_FILE(tp) will be unchanged (should be NULL). + fd = open (TB_NAME(tp), TB_IOMODE(tp), BINARY_FILE) + TB_FILE(tp) = fd + + # Write size information to table. + call tbtwsi (tp) + + # Write blank records for user parameters to fill out allocated space + do k = 1, SZ_PARREC + Memc[pstr+k-1] = ' ' + Memc[pstr+SZ_PARREC] = EOS + do parnum = 1, TB_MAXPAR(tp) + call tbhwpr (tp, parnum, Memc[pstr]) + + # Allocate space for indef record. + call calloc (TB_INDEF(tp), TB_ROWLEN(tp), TY_CHAR) + + # Write each column descriptor to table. + do colnum = 1, TB_NCOLS(tp) { # ncols may still be zero + colptr = TB_COLINFO(tp,colnum) + call tbcwcd (tp, colptr) # write column descr + call tbbnll (tp, colptr) # assign indef value in indef record + } + + # Write dummy records for column descriptors to fill out allocated space + call amovki (0, Memi[colinfo], LEN_COLSTRUCT) # Zero buffer + do colnum = TB_NCOLS(tp)+1, TB_MAXCOLS(tp) { + COL_NUMBER(colinfo) = colnum + call tbcwcd (tp, colinfo) # write dummy descriptor + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbxnll.x b/pkg/tbtables/tbxnll.x new file mode 100644 index 00000000..aaa833fb --- /dev/null +++ b/pkg/tbtables/tbxnll.x @@ -0,0 +1,34 @@ +include "tbtables.h" + +# tbxnll -- X set rows to null +# This procedure sets all columns in a range of rows to INDEF. +# If the first row to be deleted is greater than the last row, or if +# the range of rows is outside the allocated size of the table, nothing +# is done. It is not considered an error if the first row is less than +# one or the last row is greater than the number of allocated rows in +# the table. +# +# Phil Hodge, 7-Mar-1988 Subroutine created. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. + +procedure tbxnll (tp, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +int firstrow # i: first row to be set to INDEF +int lastrow # i: last row to be set to INDEF +#-- +int row1, row2 # firstrow, lastrow truncated to 1, nrows +int row # loop index for row number +long tbxoff() # function returning offset to beginning of row +errchk seek, write + +begin + row1 = max (1, firstrow) + row2 = min (TB_NROWS(tp), lastrow) + + # Write the indef record at each row to be set to INDEF. + do row = row1, row2 { + call seek (TB_FILE(tp), tbxoff (tp, row)) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], TB_ROWLEN(tp)) + } +end diff --git a/pkg/tbtables/tbxoff.x b/pkg/tbtables/tbxoff.x new file mode 100644 index 00000000..f851b2d8 --- /dev/null +++ b/pkg/tbtables/tbxoff.x @@ -0,0 +1,19 @@ +include "tbtables.h" + +# tbxoff -- X row offset +# This function returns the offset in char from the beginning of the +# table data file to the beginning of a row in the table. +# Note that the offset is to the beginning, not to a specific column. +# This is for row-ordered tables. + +long procedure tbxoff (tp, rownum) + +pointer tp # Pointer to table descriptor +int rownum # The row number + +long offset # offset to beginning of row + +begin + offset = TB_BOD(tp) + (rownum - 1) * TB_ROWLEN(tp) + return (offset) +end diff --git a/pkg/tbtables/tbxrg.x b/pkg/tbtables/tbxrg.x new file mode 100644 index 00000000..83e89a67 --- /dev/null +++ b/pkg/tbtables/tbxrg.x @@ -0,0 +1,601 @@ +include # for MAX_INT, MAX_SHORT and SZB_CHAR +include +include "tbtables.h" +include "tblerr.h" + +# tbxrgb -- X getrow Boolean +# Read column values from a row. This is for data type Boolean and +# row-ordered SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 7-Mar-1989 Eliminate TB_OFFSET, TB_CURROW. +# Phil Hodge, 22-Jan-1993 Use IS_INDEF instead of == INDEF. +# Phil Hodge, 31-Mar-1993 Include short datatype; in tbxrgb, for types other +# than boolean, change test from "if (buf == YES)" to "if (buf != NO)". +# Phil Hodge, 4-Nov-1993 Delete check on row number beyond EOF; +# call sscan as a subroutine, not a function. +# Phil Hodge, 14-Sep-1994 Use tbeszt for length of string. +# Phil Hodge, 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. +# Phil Hodge, 27-Aug-2002 In tbxrgi and tbxrgs, include an explicit test +# for INDEF, rather than relying on a test on abs (dblbuf). + +procedure tbxrgb (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +bool buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +long tbxoff() +int tbeszt() +int read(), nscan() +errchk seek, read + +begin + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(realbuf) != NO) + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(dblbuf) != NO) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (intbuf != NO) + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (shortbuf != NO) + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), buffer[k], SZ_BOOL) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + if (charbuf[1] != EOS) { + call sscan (charbuf) + call gargb (buffer[k]) + if (nscan() < 1) { + buffer[k] = false + nullflag[k] = true + } else { + nullflag[k] = false + } + } else { + buffer[k] = false + nullflag[k] = true + } + } else { + call error (ER_TBCOLBADTYP, "tbrgtb: invalid data type") + } + } + } +end + + +# tbxrgd -- X getrow double +# Read column values from a row. This is for data type double and +# row-ordered SDAS tables. + +procedure tbxrgd (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +double buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbxoff() +int tbeszt() +int read(), nscan() +errchk seek, read + +begin + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = realbuf + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = dblbuf + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = double(YES) + else + buffer[k] = double(NO) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (buffer[k]) + if (nscan() < 1) + buffer[k] = INDEFD + nullflag[k] = IS_INDEFD (buffer[k]) + } else { + call error (ER_TBCOLBADTYP, "tbrgtd: invalid data type") + } + } + } +end + + +# tbxrgr -- X getrow real +# Read column values from a row. This is for data type real and +# row-ordered SDAS tables. + +procedure tbxrgr (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +real buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +# buffers for reading values of various types +double dblbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbxoff() +int tbeszt() +int read(), nscan() +errchk seek, read + +begin + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), buffer[k], SZ_REAL) + nullflag[k] = IS_INDEFR (buffer[k]) + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = dblbuf + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = real(YES) + else + buffer[k] = real(NO) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargr (buffer[k]) + if (nscan() < 1) + buffer[k] = INDEFR + nullflag[k] = IS_INDEFR (buffer[k]) + } else { + call error (ER_TBCOLBADTYP, "tbrgtr: invalid data type") + } + } + } +end + + +# tbxrgi -- X getrow integer +# Read column values from a row. This is for data type integer and +# row-ordered SDAS tables. + +procedure tbxrgi (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +int buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +# buffers for reading values of various types +double dblbuf +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbxoff() +int tbeszt() +int read(), nscan() +errchk seek, read + +begin + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + if (datatype < 0) + datatype = TY_CHAR + offset = roffset + COL_OFFSET(colptr[k]) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), buffer[k], SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (buffer[k], buffer[k], 1) + nullflag[k] = IS_INDEFI (buffer[k]) + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + } else { + call error (ER_TBCOLBADTYP, "tbrgti: invalid data type") + } + } + } +end + + +# tbxrgs -- X getrow short +# Read column values from a row. This is for data type short integer and +# row-ordered SDAS tables. + +procedure tbxrgs (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +short buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbxoff() +int tbeszt() +int read(), nscan() +errchk seek, read + +begin + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + if (datatype < 0) + datatype = TY_CHAR + offset = roffset + COL_OFFSET(colptr[k]) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf) || abs (intbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), buffer[k], SZ_SHORT) + nullflag[k] = IS_INDEFS (buffer[k]) + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFS (buffer[k]) + } + } else { + call error (ER_TBCOLBADTYP, "tbrgts: invalid data type") + } + } + } +end + + +# tbxrgt -- X getrow text +# Read column values from a row. This is for character strings and +# row-oriented SDAS tables. + +procedure tbxrgt (tp, colptr, buffer, nullflag, lenstring, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +char buffer[lenstring,numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int lenstring # Length of each string in array buffer +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +int nchar # Size of string in table file +int numchar # Number of characters to copy string to string +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +# buffers for reading values of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbxoff() +int tbeszt() +int read() +errchk seek, read, sprintf + +begin + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargr (realbuf) + nullflag[k] = IS_INDEFR (realbuf) + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + call strcpy ("INDEF", buffer[1,k], lenstring) + nullflag[k] = true + } else { + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargd (dblbuf) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargi (intbuf) + nullflag[k] = IS_INDEFI (intbuf) + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargs (shortbuf) + nullflag[k] = IS_INDEFS (shortbuf) + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargb (boolbuf) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + nchar = tbeszt (colptr[k]) + stat = read (TB_FILE(tp), charbuf, nchar) + numchar = min (lenstring, SZB_CHAR*nchar) + call strupk (charbuf, buffer[1,k], numchar) + nullflag[k] = (buffer[1,k] == EOS) + } else { + call error (ER_TBCOLBADTYP, "tbrgtt: invalid data type") + } + } + } +end diff --git a/pkg/tbtables/tbxrp.x b/pkg/tbtables/tbxrp.x new file mode 100644 index 00000000..b28a0b92 --- /dev/null +++ b/pkg/tbtables/tbxrp.x @@ -0,0 +1,964 @@ +include # for MAX_INT and MAX_SHORT +include "tbtables.h" +include "tblerr.h" + +# Write column values into a row. Values from more than one column may be +# written in one call. These routines are for row-ordered tables. +# This file contains the tbxrp[tbirds] routines plus tbbcpy. +# +# Phil Hodge, 10-Nov-1987 Pass Memi instead of Memr to tbbeqd. +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 7-Mar-1989 Eliminate TB_OFFSET, TB_CURROW, TB_MODSIZE. +# Phil Hodge, 26-Jun-1989 Use tbbcpy to copy to indef record buffer, which +# was too large by the factor SZ_REAL. +# Phil Hodge, 30-Mar-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 tbxrpt: call sscan as a subroutine, not a function. +# Phil Hodge, 14-Sep-1994 Use tbeszt for length of string; in tbxrpt, use +# gargd (dblbuf) and then nint for int & short. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 4-Mar-1998 Remove call to tbxwsk, use tbxwer & tbxoff instead. +# Phil Hodge, 27-Aug-2002 In tbxrpi and tbxrps, include an explicit test +# for INDEF, rather than relying on a test on abs (dblbuf). + +# tbxrpb -- X putrow Boolean + +procedure tbxrpb (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +bool buffer[numcols] # i: array of values to be put into table +int numcols # i: number of columns +int rownum # i: row number; may be beyond end of file +#-- +int k # Loop index +int datatype # Data type of element in table +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +pointer sp, eofbuf +int nrows, rowlen +double dblbuf # Buffer used when type conversion is needed +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] # Buffer for character columns +long tbxoff() +int tbeszt() +errchk tbxwer, seek, write + +begin + nrows = TB_NROWS(tp) + + if (rownum == nrows+1) { + + # Write at EOF. + rowlen = TB_ROWLEN(tp) # unit = SZ_CHAR + call smark (sp) + call salloc (eofbuf, rowlen, TY_CHAR) + call amovc (Memc[TB_INDEF(tp)], Memc[eofbuf], rowlen) + do k = 1, numcols { + + datatype = COL_DTYPE(colptr[k]) + # This offset is from beginning of record in units of SZ_CHAR. + offset = COL_OFFSET(colptr[k]) + + switch (datatype) { + case TY_REAL: + if (buffer[k]) + call tbbeqr (real(YES), Memc[eofbuf+offset]) + else + call tbbeqr (real(NO), Memc[eofbuf+offset]) + case TY_DOUBLE: + if (buffer[k]) + call tbbeqd (double(YES), Memc[eofbuf+offset]) + else + call tbbeqd (double(NO), Memc[eofbuf+offset]) + case TY_INT: + if (buffer[k]) + call tbbeqi (YES, Memc[eofbuf+offset]) + else + call tbbeqi (NO, Memc[eofbuf+offset]) + case TY_SHORT: + if (buffer[k]) + shortbuf = YES + else + shortbuf = NO + call tbbeqs (shortbuf, Memc[eofbuf+offset]) + case TY_BOOL: + call tbbeqb (buffer[k], Memc[eofbuf+offset]) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-3b") + call pargb (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call tbbcpy (charbuf, Memc[eofbuf+offset], + tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptb: bad data type; table or memory corrupted?") + } + } + } + # This is the offset (unit=SZ_CHAR) to the beginning of the row. + roffset = tbxoff (tp, rownum) + call seek (TB_FILE(tp), roffset) + call write (TB_FILE(tp), Memc[eofbuf], rowlen) + TB_NROWS(tp) = rownum + call sfree (sp) + + } else { + + # If we are seeking beyond EOF, write fill records. + if (rownum > TB_NROWS(tp)) { + call tbxwer (tp, rownum) + TB_NROWS(tp) = rownum + } + + # Get the offset to the row to which we will write. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) # unit = SZ_CHAR + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (buffer[k]) + realbuf = real(YES) + else + realbuf = real(NO) + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (buffer[k]) + dblbuf = double(YES) + else + dblbuf = double(NO) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (buffer[k]) + intbuf = YES + else + intbuf = NO + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + if (buffer[k]) + shortbuf = YES + else + shortbuf = NO + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + call write (TB_FILE(tp), buffer[k], SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-3b") + call pargb (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptb: bad data type; table or memory corrupted?") + } + } + } + } +end + + +# tbxrpd -- X putrow double +# Write column values to a row. This is for data type double and +# row-ordered SDAS tables. + +procedure tbxrpd (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +double buffer[numcols] # i: array of values to be put into table +int numcols # i: number of columns +int rownum # i: row number; may be beyond end of file +#-- +int k # Loop index +int datatype # Data type of element in table +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +pointer sp, eofbuf +int nrows, rowlen +double dblbuf # Buffer used when type conversion is needed +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] # Buffer for character columns +long tbxoff() +int tbeszt() +errchk tbxwer, seek, write + +begin + nrows = TB_NROWS(tp) + + if (rownum == nrows+1) { + + # Write at EOF. + rowlen = TB_ROWLEN(tp) + call smark (sp) + call salloc (eofbuf, rowlen, TY_CHAR) + call amovc (Memc[TB_INDEF(tp)], Memc[eofbuf], rowlen) + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + # This offset is from beginning of record in units of SZ_CHAR. + offset = COL_OFFSET(colptr[k]) + + switch (datatype) { + case TY_REAL: + if (IS_INDEFD (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call tbbeqr (realbuf, Memc[eofbuf+offset]) + case TY_DOUBLE: + if (IS_INDEFD (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call tbbeqd (dblbuf, Memc[eofbuf+offset]) + case TY_INT: + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + call tbbeqi (intbuf, Memc[eofbuf+offset]) + case TY_SHORT: + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call tbbeqs (shortbuf, Memc[eofbuf+offset]) + case TY_BOOL: + if (IS_INDEFD (buffer[k]) || (nint(buffer[k]) == NO)) + call tbbeqb (false, Memc[eofbuf+offset]) + else + call tbbeqb (true, Memc[eofbuf+offset]) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-25.16g") + call pargd (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call tbbcpy (charbuf, Memc[eofbuf+offset], + tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptd: bad data type; table or memory corrupted?") + } + } + } + # This is the offset (unit=SZ_CHAR) to the beginning of the row. + roffset = tbxoff (tp, rownum) + call seek (TB_FILE(tp), roffset) + call write (TB_FILE(tp), Memc[eofbuf], rowlen) + TB_NROWS(tp) = rownum + call sfree (sp) + + } else { + + # If we are seeking beyond EOF, write fill records. + if (rownum > TB_NROWS(tp)) { + call tbxwer (tp, rownum) + TB_NROWS(tp) = rownum + } + + # Get the offset to the row to which we will write. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) # unit = SZ_CHAR + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (IS_INDEFD (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFD (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + if (IS_INDEFD (buffer[k]) || (nint(buffer[k]) == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-25.17g") + call pargd (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptd: bad data type; table or memory corrupted?") + } + } + } + } +end + + +# tbxrpr -- X putrow real +# Write column values to a row. This is for data type real and +# row-ordered SDAS tables. + +procedure tbxrpr (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +real buffer[numcols] # i: array of values to be put into table +int numcols # i: number of columns +int rownum # i: row number; may be beyond end of file +#-- +int k # Loop index +int datatype # Data type of element in table +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +pointer sp, eofbuf +int nrows, rowlen +double dblbuf # Buffer used when type conversion is needed +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] # Buffer for character columns +long tbxoff() +int tbeszt() +errchk tbxwer, seek, write + +begin + nrows = TB_NROWS(tp) + + if (rownum == nrows+1) { + + # Write at EOF. + rowlen = TB_ROWLEN(tp) + call smark (sp) + call salloc (eofbuf, rowlen, TY_CHAR) + call amovc (Memc[TB_INDEF(tp)], Memc[eofbuf], rowlen) + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + # This offset is from beginning of record in units of SZ_CHAR. + offset = COL_OFFSET(colptr[k]) + + switch (datatype) { + case TY_REAL: + call tbbeqr (buffer[k], Memc[eofbuf+offset]) + case TY_DOUBLE: + if (IS_INDEFR (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call tbbeqd (dblbuf, Memc[eofbuf+offset]) + case TY_INT: + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + call tbbeqi (intbuf, Memc[eofbuf+offset]) + case TY_SHORT: + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call tbbeqs (shortbuf, Memc[eofbuf+offset]) + case TY_BOOL: + if (IS_INDEFR (buffer[k]) || (nint(buffer[k]) == NO)) + call tbbeqb (false, Memc[eofbuf+offset]) + else + call tbbeqb (true, Memc[eofbuf+offset]) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-15.7g") + call pargr (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call tbbcpy (charbuf, Memc[eofbuf+offset], + tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptr: bad data type; table or memory corrupted?") + } + } + } + # This is the offset (unit=SZ_CHAR) to the beginning of the row. + roffset = tbxoff (tp, rownum) + call seek (TB_FILE(tp), roffset) + call write (TB_FILE(tp), Memc[eofbuf], rowlen) + TB_NROWS(tp) = rownum + call sfree (sp) + + } else { + + # If we are seeking beyond EOF, write fill records. + if (rownum > TB_NROWS(tp)) { + call tbxwer (tp, rownum) + TB_NROWS(tp) = rownum + } + + # Get the offset to the row to which we will write. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) # unit = SZ_CHAR + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + call write (TB_FILE(tp), buffer[k], SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFR (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + if (IS_INDEFR (buffer[k]) || (nint(buffer[k]) == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-15.7g") + call pargr (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptr: bad data type; table or memory corrupted?") + } + } + } + } +end + + +# tbxrpi -- X putrow integer +# Write column values to a row. This is for data type integer and +# row-ordered SDAS tables. + +procedure tbxrpi (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +int buffer[numcols] # i: array of values to be put into table +int numcols # i: number of columns +int rownum # i: row number; may be beyond end of file +#-- +int k # Loop index +int datatype # Data type of element in table +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +pointer sp, eofbuf +int nrows, rowlen +double dblbuf # Buffer used when type conversion is needed +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] # Buffer for character columns +long tbxoff() +int tbeszt() +errchk tbxwer, seek, write + +begin + nrows = TB_NROWS(tp) + + if (rownum == nrows+1) { + + # Write at EOF. + rowlen = TB_ROWLEN(tp) + call smark (sp) + call salloc (eofbuf, rowlen, TY_CHAR) + call amovc (Memc[TB_INDEF(tp)], Memc[eofbuf], rowlen) + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + # This offset is from beginning of record in units of SZ_CHAR. + offset = COL_OFFSET(colptr[k]) + + switch (datatype) { + case TY_REAL: + if (IS_INDEFI (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call tbbeqr (realbuf, Memc[eofbuf+offset]) + case TY_DOUBLE: + if (IS_INDEFI (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call tbbeqd (dblbuf, Memc[eofbuf+offset]) + case TY_INT: + call tbbeqi (buffer[k], Memc[eofbuf+offset]) + case TY_SHORT: + if (IS_INDEFI (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = buffer[k] + call tbbeqs (shortbuf, Memc[eofbuf+offset]) + case TY_BOOL: + if (IS_INDEFI (buffer[k]) || (buffer[k] == NO)) + call tbbeqb (false, Memc[eofbuf+offset]) + else + call tbbeqb (true, Memc[eofbuf+offset]) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargi (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call tbbcpy (charbuf, Memc[eofbuf+offset], + tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrpti: bad data type; table or memory corrupted?") + } + } + } + # This is the offset (unit=SZ_CHAR) to the beginning of the row. + roffset = tbxoff (tp, rownum) + call seek (TB_FILE(tp), roffset) + call write (TB_FILE(tp), Memc[eofbuf], rowlen) + TB_NROWS(tp) = rownum + call sfree (sp) + + } else { + + # If we are seeking beyond EOF, write fill records. + if (rownum > TB_NROWS(tp)) { + call tbxwer (tp, rownum) + TB_NROWS(tp) = rownum + } + + # Get the offset to the row to which we will write. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) # unit = SZ_CHAR + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (IS_INDEFI (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFI (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (SZ_INT != SZ_INT32) + call ipak32 (buffer[k], buffer[k], 1) + call write (TB_FILE(tp), buffer[k], SZ_INT32) + case TY_SHORT: + if (IS_INDEFI (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = buffer[k] + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + if (IS_INDEFI (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargi (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrpti: bad data type; table or memory corrupted?") + } + } + } + } +end + + +# tbxrps -- X putrow short integer +# Write column values to a row. This is for data type short integer and +# row-ordered SDAS tables. + +procedure tbxrps (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +short buffer[numcols] # i: array of values to be put into table +int numcols # i: number of columns +int rownum # i: row number; may be beyond end of file +#-- +int k # Loop index +int datatype # Data type of element in table +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +pointer sp, eofbuf +int nrows, rowlen +double dblbuf # Buffer used when type conversion is needed +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] # Buffer for character columns +long tbxoff() +int tbeszt() +errchk tbxwer, seek, write + +begin + nrows = TB_NROWS(tp) + + if (rownum == nrows+1) { + + # Write at EOF. + rowlen = TB_ROWLEN(tp) + call smark (sp) + call salloc (eofbuf, rowlen, TY_CHAR) + call amovc (Memc[TB_INDEF(tp)], Memc[eofbuf], rowlen) + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + # This offset is from beginning of record in units of SZ_CHAR. + offset = COL_OFFSET(colptr[k]) + + switch (datatype) { + case TY_REAL: + if (IS_INDEFS (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call tbbeqr (realbuf, Memc[eofbuf+offset]) + case TY_DOUBLE: + if (IS_INDEFS (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call tbbeqd (dblbuf, Memc[eofbuf+offset]) + case TY_INT: + if (IS_INDEFS (buffer[k])) + intbuf = INDEFI + else + intbuf = buffer[k] + call tbbeqi (intbuf, Memc[eofbuf+offset]) + case TY_SHORT: + call tbbeqs (buffer[k], Memc[eofbuf+offset]) + case TY_BOOL: + if (IS_INDEFS (buffer[k]) || (buffer[k] == NO)) + call tbbeqb (false, Memc[eofbuf+offset]) + else + call tbbeqb (true, Memc[eofbuf+offset]) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargs (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call tbbcpy (charbuf, Memc[eofbuf+offset], + tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrpts: bad data type; table or memory corrupted?") + } + } + } + # This is the offset (unit=SZ_CHAR) to the beginning of the row. + roffset = tbxoff (tp, rownum) + call seek (TB_FILE(tp), roffset) + call write (TB_FILE(tp), Memc[eofbuf], rowlen) + TB_NROWS(tp) = rownum + call sfree (sp) + + } else { + + # If we are seeking beyond EOF, write fill records. + if (rownum > TB_NROWS(tp)) { + call tbxwer (tp, rownum) + TB_NROWS(tp) = rownum + } + + # Get the offset to the row to which we will write. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) # unit = SZ_CHAR + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (IS_INDEFS (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFS (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (IS_INDEFS (buffer[k])) + intbuf = INDEFI + else + intbuf = buffer[k] + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + call write (TB_FILE(tp), buffer[k], SZ_SHORT) + case TY_BOOL: + if (IS_INDEFS (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargs (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrpts: bad data type; table or memory corrupted?") + } + } + } + } +end + + +# tbxrpt -- X putrow text +# Write column values to a row. This is for character strings and +# row-ordered SDAS tables. + +procedure tbxrpt (tp, colptr, buffer, lenstring, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +char buffer[lenstring, numcols] # i: array of values to be put +int lenstring # i: length of each string in array buffer +int numcols # i: number of columns +int rownum # i: row number; may be beyond end of file +#-- +int k # Loop index +int datatype # Data type of element in table +long roffset # Offset of beginning of row from BOF +long offset # Offset of column entry from BOF +pointer sp, eofbuf +int nrows, rowlen +double dblbuf # Buffer used when type conversion is needed +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] # Buffer for character columns +long tbxoff() +int tbeszt() +int nscan() +errchk tbxwer, seek, write + +begin + nrows = TB_NROWS(tp) + + if (rownum == nrows+1) { + + # Write at EOF. + rowlen = TB_ROWLEN(tp) + call smark (sp) + call salloc (eofbuf, rowlen, TY_CHAR) + call amovc (Memc[TB_INDEF(tp)], Memc[eofbuf], rowlen) + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + # This offset is from beginning of record in units of SZ_CHAR. + offset = COL_OFFSET(colptr[k]) + + switch (datatype) { + case TY_REAL: + call sscan (buffer[1,k]) + call gargr (realbuf) + if (nscan() < 1) + realbuf = INDEFR + call tbbeqr (realbuf, Memc[eofbuf+offset]) + case TY_DOUBLE: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1) + dblbuf = TBL_INDEFD + else if (IS_INDEFD (dblbuf)) + dblbuf = TBL_INDEFD + call tbbeqd (dblbuf, Memc[eofbuf+offset]) + case TY_INT: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + intbuf = INDEFI + } else { + intbuf = nint (dblbuf) + } + call tbbeqi (intbuf, Memc[eofbuf+offset]) + case TY_SHORT: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + shortbuf = INDEFS + } else { + shortbuf = nint (dblbuf) + } + call tbbeqs (shortbuf, Memc[eofbuf+offset]) + case TY_BOOL: + call sscan (buffer[1,k]) + call gargb (boolbuf) + if (nscan() < 1) + boolbuf = false + call tbbeqb (boolbuf, Memc[eofbuf+offset]) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call strpak (buffer[1,k], charbuf, SZ_LINE) + call tbbcpy (charbuf, Memc[eofbuf+offset], + tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptt: bad data type; table or memory corrupted?") + } + } + } + # This is the offset (unit=SZ_CHAR) to the beginning of the row. + roffset = tbxoff (tp, rownum) + call seek (TB_FILE(tp), roffset) + call write (TB_FILE(tp), Memc[eofbuf], rowlen) + TB_NROWS(tp) = rownum + call sfree (sp) + + } else { + + # If we are seeking beyond EOF, write fill records. + if (rownum > TB_NROWS(tp)) { + call tbxwer (tp, rownum) + TB_NROWS(tp) = rownum + } + + # Get the offset to the row to which we will write. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = roffset + COL_OFFSET(colptr[k]) # unit = SZ_CHAR + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + call sscan (buffer[1,k]) + call gargr (realbuf) + if (nscan() < 1) + realbuf = INDEFR + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1) + dblbuf = TBL_INDEFD + else if (IS_INDEFD (dblbuf)) + dblbuf = TBL_INDEFD + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + intbuf = INDEFI + } else { + intbuf = nint (dblbuf) + } + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + shortbuf = INDEFS + } else { + shortbuf = nint (dblbuf) + } + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + call sscan (buffer[1,k]) + call gargb (boolbuf) + if (nscan() < 1) + boolbuf = false + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call strpak (buffer[1,k], charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, tbeszt (colptr[k])) + } else { + call error (ER_TBCOLBADTYP, + "tbrptt: bad data type; table or memory corrupted?") + } + } + } + } +end + +# tbbcpy -- string copy +# This routine differs from strcpy in that nothing will be written beyond +# maxch in the output string. In particular, if the input string has maxch +# characters before the EOS, the output string will NOT have an EOS. + +procedure tbbcpy (in, out, maxch) + +char in[ARB] # i: input string +char out[ARB] # o: output string +int maxch # i: maximum number of char to assign in output +#-- +int k + +begin + do k = 1, maxch { + out[k] = in[k] + if (in[k] == EOS) + break + } +end diff --git a/pkg/tbtables/tbxscp.x b/pkg/tbtables/tbxscp.x new file mode 100644 index 00000000..77c38091 --- /dev/null +++ b/pkg/tbtables/tbxscp.x @@ -0,0 +1,77 @@ +include "tbtables.h" + +# tbxscp -- X copy to change size +# This routine copies the contents of one table to another for the purpose +# of changing the size of the user-parameter space, the space for column +# descriptors, and/or the row or column length of the table itself. +# Old_maxpar, etc describe the characteristics of the input file, +# while TB_MAXPAR(tp), etc describe the output file. +# This is called by tbxsiz. +# +# Phil Hodge, 19-Jan-1990 Replace TB_ROWLEN(tp) by TB_ROWLEN(tp)/SZ_REAL +# in call to amovr. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. + +procedure tbxscp (tp, oldfd, newfd, old_maxpar, + old_maxcols, old_ncols, old_rowlen, old_colused) + +pointer tp # i: pointer to table descriptor +int oldfd, newfd # i: channel numbers for input & output tables +int old_maxpar # i: previous maximum number of user parameters +int old_maxcols # i: previous value for maximum number of columns +int old_ncols # i: previous number of columns +int old_rowlen # i: row length (=record length) in original table +int old_colused # i: previous number of char used in row +#-- +pointer sp +pointer sbuf # size info buffer +pointer rbuf # buffer for copying table (row buffer) +char zero # for amovkc +long oldoff, newoff # offsets from start of old & new files +int sbufsiz # size of buffer pointed to by sbuf +int rbufsiz # size of buffer pointed to by rbuf +int k # loop index +int stat +long tbtbod() +int read() +errchk seek, read, write + +begin + # Create buffers for I/O + call smark (sp) + sbufsiz = SZ_SIZINFO # unit = SZ_CHAR + rbufsiz = max (TB_ROWLEN(tp), old_rowlen) # unit = SZ_CHAR + call salloc (sbuf, sbufsiz, TY_CHAR) + call salloc (rbuf, rbufsiz, TY_CHAR) + + # Copy the indef record to the row buffer. + # bug fix 1/19/90 PEH; changed to ty_char 3/30/93 PEH + call amovc (Memc[TB_INDEF(tp)], Memc[rbuf], TB_ROWLEN(tp)) + + # Write dummy size info record. + zero = 0 + call amovkc (zero, Memc[sbuf], SZ_SIZINFO) + newoff = 1 + call seek (newfd, newoff) + call write (newfd, Memc[sbuf], SZ_SIZINFO) + + # Copy each user parameter to the temporary file. + call tbtscu (tp, oldfd, newfd, old_maxpar) + + # Copy each column descriptor to the temporary file. + call tbtscd (tp, oldfd, newfd, old_maxpar, old_ncols) + + # Copy each row of the table to the temporary file. + # Note that only old_colused char of input record are read. + oldoff = tbtbod (old_maxpar, old_maxcols) + newoff = tbtbod (TB_MAXPAR(tp), TB_MAXCOLS(tp)) + do k = 1, TB_NROWS(tp) { + call seek (oldfd, oldoff) + call seek (newfd, newoff) + stat = read (oldfd, Memc[rbuf], old_colused) + call write (newfd, Memc[rbuf], TB_ROWLEN(tp)) + oldoff = oldoff + old_rowlen + newoff = newoff + TB_ROWLEN(tp) + } + call sfree (sp) +end diff --git a/pkg/tbtables/tbxsft.x b/pkg/tbtables/tbxsft.x new file mode 100644 index 00000000..5d414736 --- /dev/null +++ b/pkg/tbtables/tbxsft.x @@ -0,0 +1,76 @@ +include "tbtables.h" + +# tbxsft -- X shift rows +# Shift one or more rows down (to leave a gap in the table) or up (to +# delete rows). The range of rows that is shifted is from FIRST to +# the last row in the table. Shift down if SHIFT > 0, or shift up if +# SHIFT < 0. SHIFT is the number of rows by which to shift. +# +# If SHIFT > 0 rows that are exposed by the shift are NOT set to indef. +# If SHIFT < 0 rows at the end WILL be set to indef, and the number +# of rows TB_NROWS(tp) will be reduced. +# +# Phil Hodge, 23-Mar-1988 Subroutine created. + +procedure tbxsft (tp, first, shift) + +pointer tp # i: pointer to table descriptor +int first # i: first row to be moved +int shift # i: shift by this many rows +#-- +int abs_shift # absolute value of shift +int row1 # first row of a range to be copied +int nrows # number of rows written to table +int j, k # loop indexes + +begin + nrows = TB_NROWS(tp) + abs_shift = abs (shift) + + if (first > nrows) + return + + if (shift < 0) { + + # Shift up, overwriting rows starting with FIRST. + k = first + do j = first + abs_shift, nrows { + call tbrcpy (tp, tp, j, k) # copy row j to row k + k = k + 1 + } + # Set rows at end to indef. + call tbxnll (tp, nrows-abs_shift+1, nrows) + + # Change the value of TB_NROWS. + TB_NROWS(tp) = max (0, nrows - abs_shift) + + } else { # shift down + + row1 = nrows - shift + 1 + + if (row1 >= first) { + + # First copy the block of rows that are to be put beyond + # the current EOF; with each call in this loop we are + # writing the next row beyond EOF. + k = nrows + 1 + do j = row1, nrows { + call tbrcpy (tp, tp, j, k) + k = k + 1 + } + + k = nrows + do j = nrows - shift, first, -1 { + call tbrcpy (tp, tp, j, k) + k = k - 1 + } + } else { + # The entire block is to be shifted beyond current EOF. + k = first + shift + do j = first, nrows { + call tbrcpy (tp, tp, j, k) + k = k + 1 + } + } + } +end diff --git a/pkg/tbtables/tbxsiz.x b/pkg/tbtables/tbxsiz.x new file mode 100644 index 00000000..bf74d467 --- /dev/null +++ b/pkg/tbtables/tbxsiz.x @@ -0,0 +1,87 @@ +include +include "tbtables.h" + +# tbxsiz -- X increase size +# Increase either the record size or the space for column descriptors +# for a table. If only the record size needs to be increased and no +# rows have yet been written to the table, this routine does nothing. +# Increasing the record size and/or space is done by copying the table +# data file to a temporary file, deleting the original table, and +# then renaming the temporary file to the name of the original table. +# The INDEF record buffer is copied to a local scratch buffer and then +# used for the I/O, so when this procedure returns, all existing rows should +# have the correct INDEF values set for the new columns. +# If the new row length is not the same as the previous value, the INDEF +# record buffer will be reallocated. +# The table must be open when this procedure is called. +# +# NOTE that the file channel number TB_FILE(tp) may be changed by this +# procedure. The values of TB_ROWLEN, TB_MAXPAR, TB_MAXCOLS and TB_BOD +# are assumed to have been updated by a calling routine (e.g. tbcdef). +# +# Phil Hodge, 28-Aug-1987 Flush file buffer after calling tbtwsi. +# Phil Hodge, 6-Nov-1987 Put temporary file in tmp. +# Phil Hodge, 24-Mar-1988 Save and restore FIO buffer size. +# Phil Hodge, 7-Mar-1989 Eliminate TB_CURROW. +# Phil Hodge, 1-May-1989 Realloc the INDEF record buffer. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. + +procedure tbxsiz (tp, old_maxpar, old_maxcols, + old_ncols, old_rowlen, old_colused) + +pointer tp # i: pointer to table descriptor +int old_maxpar # i: previous max number of user parameters +int old_maxcols # i: previous value for max number of columns +int old_ncols # i: previous number of columns +int old_rowlen # i: row length (=record len) in original table +int old_colused # i: previous number of char used in row +#-- +int iomode # I/O mode for reopening the table +int oldfd, newfd # channel numbers for old & new table files +int bufsize # save and restore FIO buffer size +char temp_file[SZ_FNAME] # name of temporary file for table data +int open(), fstati() +errchk realloc, tbtwsi, tbxscp, mktemp, open, close, delete, rename, flush + +begin + # Reallocate indef record if necessary. + if (TB_ROWLEN(tp) > old_rowlen) + call realloc (TB_INDEF(tp), TB_ROWLEN(tp), TY_CHAR) + + # First check whether we really have to do anything. + if ( (TB_NROWS(tp) <= 0) && (TB_MAXPAR(tp) == old_maxpar) && + (TB_MAXCOLS(tp) == old_maxcols) ) + return + + oldfd = TB_FILE(tp) + bufsize = fstati (oldfd, F_BUFSIZE) + + call mktemp ("tmp$tbl", temp_file, SZ_FNAME) + newfd = open (temp_file, NEW_FILE, BINARY_FILE) + + # Copy the contents of the table to the temporary file. + call tbxscp (tp, oldfd, newfd, old_maxpar, + old_maxcols, old_ncols, old_rowlen, old_colused) + + call close (oldfd) + call close (newfd) + + # Delete the original table that was too small, and rename the + # temporary table to the same name as the original. + call delete (TB_NAME(tp)) + call rename (temp_file, TB_NAME(tp)) + + # Reopen the new table. + if (TB_IOMODE(tp) == NEW_FILE) + iomode = READ_WRITE + else + iomode = TB_IOMODE(tp) + TB_FILE(tp) = open (TB_NAME(tp), iomode, BINARY_FILE) + + # Restore whatever buffer size the old table had. + call fseti (TB_FILE(tp), F_BUFSIZE, bufsize) + + # Update the size information record in the new table. + call tbtwsi (tp) # write size information + call flush (TB_FILE(tp)) +end diff --git a/pkg/tbtables/tbxudf.x b/pkg/tbtables/tbxudf.x new file mode 100644 index 00000000..2f09dc7b --- /dev/null +++ b/pkg/tbtables/tbxudf.x @@ -0,0 +1,37 @@ +include "tbtables.h" + +# tbxudf -- X set to undefined +# "Delete" entries in a table by setting each entry to the +# INDEF value appropriate for its datatype. +# This version is for row-ordered SDAS tables. +# +# Phil Hodge, 7-Mar-1989 Eliminate TB_OFFSET. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 3-Mar-1998 Remove call to tbxwsk, use tbxoff instead. + +procedure tbxudf (tp, colptr, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +int numcols # i: number of columns +int rownum # i: row number +#-- +int k # loop index +int coloffset # offset of column within row +long roffset # offset to beginning of row +long offset # for writing INDEF values in table data file +long tbxoff() +errchk seek, write + +begin + # Get the offset to the row in which we are to delete entries. + roffset = tbxoff (tp, rownum) + + do k = 1, numcols { + coloffset = COL_OFFSET(colptr[k]) + offset = roffset + coloffset + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), Memc[TB_INDEF(tp) + coloffset], + COL_LEN(colptr[k])) + } +end diff --git a/pkg/tbtables/tbxwer.x b/pkg/tbtables/tbxwer.x new file mode 100644 index 00000000..bb06e9c1 --- /dev/null +++ b/pkg/tbtables/tbxwer.x @@ -0,0 +1,37 @@ +include "tbtables.h" + +# tbxwer -- write empty rows +# The purpose of this routine is to write empty (INDEF) rows beyond the +# current end of file for a row-ordered table, if the specified row is +# larger than the number of rows already written to the table. If the +# specified row is within the range of existing rows, the table itself +# will not be modified. +# +# Note that TB_NROWS will not be updated. +# +# Phil Hodge, 4-Mar-1998 Subroutine created, extracted from tbtwer. + +procedure tbxwer (tp, rownum) + +pointer tp # i: pointer to table descriptor +int rownum # i: (actual) row number in table +#-- +long locn # location for writing (at EOF) +int k # loop index +int nrows # number of rows on entry to this routine +int rowlen # record length +errchk seek, write + +begin + nrows = TB_NROWS(tp) + if (rownum <= nrows) + return # nothing to do + + rowlen = TB_ROWLEN(tp) + locn = TB_BOD(tp) + nrows * rowlen # this is the end of file + do k = nrows+1, rownum { + call seek (TB_FILE(tp), locn) + call write (TB_FILE(tp), Memc[TB_INDEF(tp)], rowlen) + locn = locn + rowlen + } +end diff --git a/pkg/tbtables/tbxwnc.x b/pkg/tbtables/tbxwnc.x new file mode 100644 index 00000000..40997389 --- /dev/null +++ b/pkg/tbtables/tbxwnc.x @@ -0,0 +1,37 @@ +include "tbtables.h" + +# tbxwnc -- X write new columns +# Write new column descriptors into a row-ordered table. +# The table must have already been reorganized (if necessary) to make +# sufficient space for column descriptors or row length. +# +# Phil Hodge, 1-May-1989 Change calling sequence; don't call tbxsiz. +# Phil Hodge, 30-Mar-1993 TB_INDEF is now TY_CHAR rather than TY_REAL. +# Phil Hodge, 14-Apr-1998 Change calling sequence of tbcwcd. + +procedure tbxwnc (tp, colptr, numcols, old_colused) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: pointers to descriptors for new columns +int numcols # i: number of new columns +int old_colused # i: previous value of TB_COLUSED +#-- +pointer cp # Pointer to a specific column +int k # Loop index +errchk tbxncn, tbcwcd + +begin + # Assign appropriate indef values in indef record. + do k = 1, numcols + call tbbnll (tp, colptr[k]) + + # Write descriptors of new columns to table. + do k = 1, numcols { + cp = colptr[k] + call tbcwcd (tp, cp) + } + + # Assign indef values for each new column in each existing row. + if (TB_NROWS(tp) > 0) + call tbxncn (tp, old_colused, Memc[TB_INDEF(tp)]) +end diff --git a/pkg/tbtables/tbycg.x b/pkg/tbtables/tbycg.x new file mode 100644 index 00000000..9ea0a468 --- /dev/null +++ b/pkg/tbtables/tbycg.x @@ -0,0 +1,735 @@ +include # for MAX_INT, MAX_SHORT and SZB_CHAR +include +include "tbtables.h" +include "tblerr.h" + +# tbycgb -- Y getcol Boolean +# Read values for one column from a range of rows. This is for data type +# Boolean and column-ordered SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 22-Jan-1993 Use IS_INDEF instead of == INDEF. +# Phil Hodge, 1-Apr-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 Call sscan as a subroutine, not a function. +# Phil Hodge, 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. +# Phil Hodge, 27-Aug-2002 In tbycgi and tbycgs, include an explicit test +# for INDEF, rather than relying on a test on abs (dblbuf). + +procedure tbycgb (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +bool buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long offset # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int nrows # Number of rows to read +int datatype # Data type of element in table +int dlen # Number of char in one data element +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + nrows = lastrow - firstrow + 1 + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(realbuf) != NO) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(dblbuf) != NO) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (intbuf != NO) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (shortbuf != NO) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_BOOL: + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), buffer, nrows*SZ_BOOL) + do k = 1, nrows + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), charbuf, dlen) + call strupk (charbuf, charbuf, SZ_LINE) + if (charbuf[1] != EOS) { + call sscan (charbuf) + call gargb (buffer[k]) + if (nscan() < 1) { + buffer[k] = false + nullflag[k] = true + } else { + nullflag[k] = false + } + } else { + buffer[k] = false + nullflag[k] = true + } + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtb: invalid data type") + } + } +end + + +# tbycgd -- Y getcol double +# Read values for one column from a range of rows. This is for data type +# double precision and column-ordered SDAS tables. + +procedure tbycgd (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +double buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long offset # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int nrows # Number of rows to read +int datatype # Data type of element in table +int dlen # Number of char in one data element +int stat # OK or an error reading row +# buffers for copying elements of various types +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + nrows = lastrow - firstrow + 1 + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = realbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_DOUBLE: + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), buffer, nrows*SZ_DOUBLE) + do k = 1, nrows { + if (TBL_IS_INDEFD (buffer[k])) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + nullflag[k] = false + } + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = real(YES) + else + buffer[k] = real(NO) + nullflag[k] = false + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), charbuf, dlen) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (buffer[k]) + if (nscan() < 1) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + nullflag[k] = IS_INDEFD (buffer[k]) + } + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtd: invalid data type") + } + } +end + + +# tbycgr -- Y getcol real +# Read values for one column from a range of rows. This is for data type real +# and column-ordered SDAS tables. + +procedure tbycgr (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +real buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long offset # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int nrows # Number of rows to read +int datatype # Data type of element in table +int dlen # Number of char in one data element +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + nrows = lastrow - firstrow + 1 + + switch (datatype) { + case TY_REAL: + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), buffer, nrows*SZ_REAL) + do k = 1, nrows + nullflag[k] = IS_INDEFR (buffer[k]) + + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = dblbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = real(YES) + else + buffer[k] = real(NO) + nullflag[k] = false + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), charbuf, dlen) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargr (buffer[k]) + if (nscan() < 1) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + nullflag[k] = IS_INDEFR (buffer[k]) + } + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtr: invalid data type") + } + } +end + + +# tbycgi -- Y getcol integer +# Read values for one column from a range of rows. This is for data type +# integer and column-ordered SDAS tables. + +procedure tbycgi (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +int buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long offset # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int nrows # Number of rows to read +int datatype # Data type of element in table +int dlen # Number of char in one data element +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + nrows = lastrow - firstrow + 1 + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = IS_INDEFI (buffer[k]) + } + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_INT: + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), buffer, nrows*SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (buffer, buffer, nrows) + do k = 1, nrows + nullflag[k] = IS_INDEFI (buffer[k]) + + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), charbuf, dlen) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFI (buffer[k]) + } + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgti: invalid data type") + } + } +end + + +# tbycgs -- Y getcol short +# Read values for one column from a range of rows. This is for data type +# short integer and column-ordered SDAS tables. + +procedure tbycgs (tp, colptr, buffer, nullflag, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +short buffer[ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long offset # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int nrows # Number of rows to read +int datatype # Data type of element in table +int dlen # Number of char in one data element +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + nrows = lastrow - firstrow + 1 + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf) || abs (intbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + offset = offset + dlen + } + + case TY_SHORT: + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), buffer, nrows*SZ_SHORT) + do k = 1, nrows + nullflag[k] = IS_INDEFS (buffer[k]) + + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), charbuf, dlen) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFS (buffer[k]) + } + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcgts: invalid data type") + } + } +end + + +# tbycgt -- Y getcol text +# Read values for one column from a range of rows. This is for character +# strings and column-ordered SDAS tables. + +procedure tbycgt (tp, colptr, buffer, nullflag, lenstring, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +char buffer[lenstring,ARB] # Buffer for values +bool nullflag[ARB] # True if element is undefined in table +int lenstring # The number of char in each element of buffer +int firstrow # Number of first row from which to get values +int lastrow # Number of last row from which to get values +#-- +long offset # Location (chars) for reading in table +int k # Index in arrays buffer & nullflag +int row # Row number (loop index) +int numchar # Number of characters to copy string to string +int nrows # Number of rows to read +int datatype # Data type of element in table +int dlen # Number of char in one data element +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read() +errchk seek, read, sprintf + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + nrows = lastrow - firstrow + 1 + + switch (datatype) { + case TY_REAL: + k = 1 + do row = firstrow, lastrow { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargr (realbuf) + nullflag[k] = IS_INDEFR (realbuf) + offset = offset + dlen + k = k + 1 + } + case TY_DOUBLE: + k = 1 + do row = firstrow, lastrow { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + call strcpy ("INDEF", buffer[1,k], lenstring) + nullflag[k] = true + } else { + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargd (dblbuf) + nullflag[k] = false + } + offset = offset + dlen + k = k + 1 + } + case TY_INT: + k = 1 + do row = firstrow, lastrow { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargi (intbuf) + nullflag[k] = IS_INDEFI (intbuf) + offset = offset + dlen + k = k + 1 + } + case TY_SHORT: + k = 1 + do row = firstrow, lastrow { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargs (shortbuf) + nullflag[k] = IS_INDEFS (shortbuf) + offset = offset + dlen + k = k + 1 + } + case TY_BOOL: + k = 1 + do row = firstrow, lastrow { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr)) + call pargb (boolbuf) + nullflag[k] = false + offset = offset + dlen + k = k + 1 + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + k = 1 + do row = firstrow, lastrow { + call seek (TB_FILE(tp), offset) + stat = read (TB_FILE(tp), charbuf, dlen) + numchar = min (lenstring, SZB_CHAR*dlen) + call strupk (charbuf, buffer[1,k], numchar) + nullflag[k] = (buffer[1,k] == EOS) + offset = offset + dlen + k = k + 1 + } + } else { + call error (ER_TBCOLBADTYP, "tbcgtt: invalid data type") + } + } +end diff --git a/pkg/tbtables/tbycp.x b/pkg/tbtables/tbycp.x new file mode 100644 index 00000000..23c81711 --- /dev/null +++ b/pkg/tbtables/tbycp.x @@ -0,0 +1,594 @@ +include # for MAX_INT and MAX_SHORT +include "tbtables.h" +include "tblerr.h" + +# tbycpb -- Y putcol Boolean +# Write values for one column to a range of rows. This is for data type +# Boolean and column-ordered SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 4-Nov-1993 tbycpt: call sscan as a subroutine, not a function. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 5-Mar-1998 Remove nrows from tbycpd and tbycpt; +# remove calls to tbytsz, and don't update TB_NROWS, +# as these are taken care of at a higher level. + +procedure tbycpb (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +bool buffer[ARB] # Buffer for values +int firstrow # Number of first row into which to put values +int lastrow # Number of last row into which to put values +#-- +long offset # Location (chars) for reading in table +int k # Index in output array buffer +int nrows # Number of rows to write +int datatype # Data type of element in table +int dlen # Number of char for one element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write, sprintf + +begin + nrows = lastrow - firstrow + 1 + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + if (buffer[k]) + realbuf = real(YES) + else + realbuf = real(NO) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), realbuf, SZ_REAL) + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + if (buffer[k]) + dblbuf = double(YES) + else + dblbuf = double(NO) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + if (buffer[k]) + intbuf = YES + else + intbuf = NO + call seek (TB_FILE(tp), offset) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + if (buffer[k]) + shortbuf = YES + else + shortbuf = NO + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + offset = offset + dlen + } + case TY_BOOL: + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, nrows*SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call sprintf (charbuf, SZ_LINE, "%-3b") + call pargb (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), charbuf, dlen) + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptb: invalid data type") + } + } +end + + +# tbycpd -- Y putcol double +# Write values for one column to a range of rows. This is for data type +# double precision and column-ordered SDAS tables. + +procedure tbycpd (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +double buffer[ARB] # Buffer for values +int firstrow # Number of first row into which to put values +int lastrow # Number of last row into which to put values +#-- +long offset # Location (chars) for reading in table +int k # Index in output array buffer +int datatype # Data type of element in table +int dlen # Number of char for one element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write, sprintf + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFD (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), realbuf, SZ_REAL) + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFD (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + call seek (TB_FILE(tp), offset) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFD (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFD (buffer[k]) || (nint (buffer[k]) == NO)) + boolbuf = false + else + boolbuf = true + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call sprintf (charbuf, SZ_LINE, "%-25.17g") + call pargd (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), charbuf, dlen) + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptd: invalid data type") + } + } +end + + +# tbycpr -- Y putcol real +# Write values for one column to a range of rows. This is for data type real +# and column-ordered SDAS tables. + +procedure tbycpr (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +real buffer[ARB] # Buffer for values +int firstrow # Number of first row into which to put values +int lastrow # Number of last row into which to put values +#-- +long offset # Location (chars) for reading in table +int k # Index in output array buffer +int nrows # Number of rows to write +int datatype # Data type of element in table +int dlen # Number of char for one element in table +# buffers for copying elements of various types +double dblbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write, sprintf + +begin + nrows = lastrow - firstrow + 1 + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + + switch (datatype) { + case TY_REAL: + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, nrows*SZ_REAL) + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFR (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_INT)) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + call seek (TB_FILE(tp), offset) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFR (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFR (buffer[k]) || (nint (buffer[k]) == NO)) + boolbuf = false + else + boolbuf = true + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call sprintf (charbuf, SZ_LINE, "%-15.7g") + call pargr (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), charbuf, dlen) + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptr: invalid data type") + } + } +end + + +# tbycpi -- Y putcol integer +# Write values for one column to a range of rows. This is for data type +# integer and column-ordered SDAS tables. + +procedure tbycpi (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +int buffer[ARB] # Buffer for values +int firstrow # Number of first row into which to put values +int lastrow # Number of last row into which to put values +#-- +long offset # Location (chars) for reading in table +int k # Index in output array buffer +int nrows # Number of rows to write +int datatype # Data type of element in table +int dlen # Number of char for one element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write, sprintf + +begin + nrows = lastrow - firstrow + 1 + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFI (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), realbuf, SZ_REAL) + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFI (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + offset = offset + dlen + } + case TY_INT: + call seek (TB_FILE(tp), offset) + if (SZ_INT != SZ_INT32) + call ipak32 (buffer, buffer, nrows) + call write (TB_FILE(tp), buffer, nrows*SZ_INT32) + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFI (buffer[k]) || (abs (buffer[k]) > MAX_SHORT)) + shortbuf = INDEFS + else + shortbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFI (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargi (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), charbuf, dlen) + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcpti: invalid data type") + } + } +end + + +# tbycps -- Y putcol short +# Write values for one column to a range of rows. This is for data type +# short integer and column-ordered SDAS tables. + +procedure tbycps (tp, colptr, buffer, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +short buffer[ARB] # Buffer for values +int firstrow # Number of first row into which to put values +int lastrow # Number of last row into which to put values +#-- +long offset # Location (chars) for reading in table +int k # Index in output array buffer +int nrows # Number of rows to write +int datatype # Data type of element in table +int dlen # Number of char for one element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write, sprintf + +begin + nrows = lastrow - firstrow + 1 + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFS (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), realbuf, SZ_REAL) + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFS (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFS (buffer[k])) + intbuf = INDEFI + else + intbuf = buffer[k] + call seek (TB_FILE(tp), offset) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + offset = offset + dlen + } + case TY_SHORT: + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), buffer, nrows*SZ_SHORT) + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + if (IS_INDEFS (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargs (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), charbuf, dlen) + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcpts: invalid data type") + } + } +end + + +# tbycpt -- Y putcol text +# Write values for one column to a range of rows. This is for character +# strings and column-ordered SDAS tables. + +procedure tbycpt (tp, colptr, buffer, lenstring, firstrow, lastrow) + +pointer tp # Pointer to table descriptor +pointer colptr # Pointer to descriptor of the column +char buffer[lenstring,ARB] # Buffer for values +int lenstring # The number of char in each element of buffer +int firstrow # Number of first row into which to put values +int lastrow # Number of last row into which to put values +#-- +long offset # Location (chars) for reading in table +int k # Index in output array buffer +int datatype # Data type of element in table +int dlen # Number of char for one element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int nscan() +errchk seek, write + +begin + datatype = COL_DTYPE(colptr) + dlen = COL_LEN(colptr) + offset = tbyoff (tp, colptr, firstrow) + + switch (datatype) { + case TY_REAL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + call sscan (buffer[1,k]) + call gargr (realbuf) + if (nscan() < 1) + realbuf = INDEFR + call write (TB_FILE(tp), realbuf, SZ_REAL) + offset = offset + dlen + } + case TY_DOUBLE: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1) + dblbuf = TBL_INDEFD + else if (IS_INDEFD (dblbuf)) + dblbuf = TBL_INDEFD + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + offset = offset + dlen + } + case TY_INT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + call sscan (buffer[1,k]) + call gargi (intbuf) + if (nscan() < 1) + intbuf = INDEFI + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + offset = offset + dlen + } + case TY_SHORT: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + call sscan (buffer[1,k]) + call gargs (shortbuf) + if (nscan() < 1) + shortbuf = INDEFS + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + offset = offset + dlen + } + case TY_BOOL: + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + call sscan (buffer[1,k]) + call gargb (boolbuf) + if (nscan() < 1) + boolbuf = false + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + offset = offset + dlen + } + default: + if (datatype < 0 || datatype == TY_CHAR) { + do k = 1, lastrow-firstrow+1 { + call seek (TB_FILE(tp), offset) + call strpak (buffer[1,k], charbuf, lenstring) + call write (TB_FILE(tp), charbuf, dlen) + offset = offset + dlen + } + } else { + call error (ER_TBCOLBADTYP, "tbcptt: invalid data type") + } + } +end diff --git a/pkg/tbtables/tbyncn.x b/pkg/tbtables/tbyncn.x new file mode 100644 index 00000000..485d637d --- /dev/null +++ b/pkg/tbtables/tbyncn.x @@ -0,0 +1,24 @@ +include "tbtables.h" + +# tbyncn -- Y new column null +# Write INDEF values for each new column in each row of a table. +# This is called after defining new columns in an open table. + +procedure tbyncn (tp, colptr, numcols) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to descr of new columns +int numcols # The number of new columns + +int fd # identifies the file for the table data +int firstrow # the first row to be set to indef +int lastrow # the last row to be set to indef +errchk tbyscn + +begin + firstrow = 1 + lastrow = TB_ALLROWS(tp) + fd = TB_FILE(tp) + # set columns to null + call tbyscn (tp, fd, colptr, numcols, firstrow, lastrow) +end diff --git a/pkg/tbtables/tbynew.x b/pkg/tbtables/tbynew.x new file mode 100644 index 00000000..6f5d7f30 --- /dev/null +++ b/pkg/tbtables/tbynew.x @@ -0,0 +1,81 @@ +include +include "tbtables.h" + +define DEFNUMROWS 100 + +# tbynew -- Y create new table +# Allocate space for indef record buffer, write record for size information, +# and write each column descriptor (if any) to table. +# This version is for column-ordered SDAS tables. The differences between +# this and tbxnew are that this does not allocate an indef record, a +# default number of allocated rows is assigned if none has been specified, +# and indef values are written to all columns of all allocated rows. +# +# Phil Hodge, 7-Mar-1989 Eliminate TB_MODSIZE. +# Phil Hodge, 16-Nov-1990 Use temporary variable instead of TB_FILE(tp) when +# opening table file so TB_FILE(tp) will still be NULL in case of error. +# Phil Hodge, 15-Apr-1998 Change calling sequence of tbcwcd. + +procedure tbynew (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer colptr +pointer sp +pointer pstr # buffer for dummy space for user parameters +pointer colinfo # buffer for dummy space for extra column descr +int k # loop index +int parnum # parameter number (dummy values for "header") +int colnum # column number +int fd # fd for table file +int open() +errchk tbtwsi, tbhwpr, tbyncn, tbcwcd, open + +begin + call smark (sp) + # Allocate space for dummy parameter & column descriptor records. + call salloc (pstr, SZ_PARREC, TY_CHAR) + call salloc (colinfo, LEN_COLSTRUCT, TY_INT) + + if (TB_ALLROWS(tp) <= 0) + TB_ALLROWS(tp) = DEFNUMROWS + + # Open the file. This was split into two lines so that if the open + # fails, TB_FILE(tp) will be unchanged (should be NULL). + fd = open (TB_NAME(tp), TB_IOMODE(tp), BINARY_FILE) + TB_FILE(tp) = fd + + # Write size information to table. + call tbtwsi (tp) + + # Write blank records for user parameters to fill out allocated space + do k = 1, SZ_PARREC + Memc[pstr+k-1] = ' ' + Memc[pstr+SZ_PARREC] = EOS + do parnum = 1, TB_MAXPAR(tp) + call tbhwpr (tp, parnum, Memc[pstr]) + + # We don't need an indef record for a column-ordered table. + TB_INDEF(tp) = NULL + + # Write each column descriptor to table. + do colnum = 1, TB_NCOLS(tp) { # ncols may still be zero + colptr = TB_COLINFO(tp,colnum) + call tbcwcd (tp, colptr) + } + # Write dummy records for column descriptors to fill out allocated space + call amovki (0, Memi[colinfo], LEN_COLSTRUCT) # Zero buffer + do colnum = TB_NCOLS(tp)+1, TB_MAXCOLS(tp) { + COL_NUMBER(colinfo) = colnum + call tbcwcd (tp, colinfo) # write dummy descriptor + } + + # Because the table is column-ordered, we must write indef values + # to each row of each column. + do colnum = 1, TB_NCOLS(tp) { # ncols may still be zero + colptr = TB_COLINFO(tp,colnum) + call tbyncn (tp, colptr, 1) + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbynll.x b/pkg/tbtables/tbynll.x new file mode 100644 index 00000000..eb7eadc3 --- /dev/null +++ b/pkg/tbtables/tbynll.x @@ -0,0 +1,39 @@ +include "tbtables.h" + +# tbynll -- Y set rows to null +# This procedure sets all columns in a range of rows to INDEF. +# If the first row to be deleted is greater than the last row, or if +# the range of rows is outside the allocated size of the table, nothing +# is done. It is not considered an error if the first row is less than +# one or the last row is greater than the number of allocated rows in +# the table. +# +# Phil Hodge, 7-Mar-1988 Subroutine created. + +procedure tbynll (tp, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +int firstrow # i: first row to be set to INDEF +int lastrow # i: last row to be set to INDEF +#-- +pointer sp +pointer colptr # scratch for array of column pointers +int row1, row2 # firstrow, lastrow truncated to 1, nrows +int k # loop index for column number +pointer tbcnum() +errchk tbyscn + +begin + row1 = max (1, firstrow) + row2 = min (TB_ALLROWS(tp), lastrow) + + if (row1 > row2) + return + + call smark (sp) + call salloc (colptr, TB_NCOLS(tp), TY_INT) + do k = 1, TB_NCOLS(tp) + Memi[colptr+k-1] = tbcnum (tp, k) + call tbyscn (tp, TB_FILE(tp), Memi[colptr], TB_NCOLS(tp), row1, row2) + call sfree (sp) +end diff --git a/pkg/tbtables/tbyoff.x b/pkg/tbtables/tbyoff.x new file mode 100644 index 00000000..c7c33513 --- /dev/null +++ b/pkg/tbtables/tbyoff.x @@ -0,0 +1,20 @@ +include "tbtables.h" + +# tbyoff -- Y column offset +# This function returns the offset in char from the beginning of the +# table data file to a specific element in the table. +# This is for column-ordered tables. + +long procedure tbyoff (tp, cp, rownum) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: the row number + +long offset + +begin + offset = TB_BOD(tp) + COL_OFFSET(cp) * TB_ALLROWS(tp) + + (rownum-1) * COL_LEN(cp) + return (offset) +end diff --git a/pkg/tbtables/tbyrg.x b/pkg/tbtables/tbyrg.x new file mode 100644 index 00000000..e9c92836 --- /dev/null +++ b/pkg/tbtables/tbyrg.x @@ -0,0 +1,569 @@ +include # for MAX_INT, MAX_SHORT and SZB_CHAR +include +include "tbtables.h" +include "tblerr.h" + +# tbyrgb -- Y getrow Boolean +# Read column values from a row. This is for data type Boolean and +# column-ordered SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 22-Jan-1993 Use IS_INDEF instead of == INDEF. +# Phil Hodge, 1-Apr-1993 Include short datatype; in tbyrgb, for types other +# than boolean, change test from "if (buf == YES)" to "if (buf != NO)". +# Phil Hodge, 4-Nov-1993 Delete check on row number beyond EOF; +# call sscan as a subroutine, not a function. +# Phil Hodge, 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. +# Phil Hodge, 27-Aug-2002 In tbyrgi and tbyrgs, include an explicit test +# for INDEF, rather than relying on a test on abs (dblbuf). + +procedure tbyrgb (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +bool buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(realbuf) != NO) + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (nint(dblbuf) != NO) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (intbuf != NO) + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = false + nullflag[k] = true + } else { + buffer[k] = (shortbuf != NO) + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), buffer[k], SZ_BOOL) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + if (charbuf[1] != EOS) { + call sscan (charbuf) + call gargb (buffer[k]) + if (nscan() < 1) { + buffer[k] = false + nullflag[k] = true + } else { + nullflag[k] = false + } + } else { + buffer[k] = false + nullflag[k] = true + } + } else { + call error (ER_TBCOLBADTYP, "tbrgtb: invalid data type") + } + } + } +end + + +# tbyrgd -- Y getrow double +# Read column values from a row. This is for data type double and +# column-ordered SDAS tables. + +procedure tbyrgd (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +double buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +# buffers for copying elements of various types +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = realbuf + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), buffer[k], SZ_DOUBLE) + if (TBL_IS_INDEFD (buffer[k])) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFD + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = double(YES) + else + buffer[k] = double(NO) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (buffer[k]) + if (nscan() < 1) + buffer[k] = INDEFD + nullflag[k] = IS_INDEFD (buffer[k]) + } else { + call error (ER_TBCOLBADTYP, "tbrgtd: invalid data type") + } + } + } +end + + +# tbyrgr -- Y getrow real +# Read column values from a row. This is for data type real and +# column-ordered SDAS tables. + +procedure tbyrgr (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +real buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), buffer[k], SZ_REAL) + nullflag[k] = IS_INDEFR (buffer[k]) + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = dblbuf + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = false + } + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFR + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = real(YES) + else + buffer[k] = real(NO) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargr (buffer[k]) + if (nscan() < 1) + buffer[k] = INDEFR + nullflag[k] = IS_INDEFR (buffer[k]) + } else { + call error (ER_TBCOLBADTYP, "tbrgtr: invalid data type") + } + } + } +end + + +# tbyrgi -- Y getrow integer +# Read column values from a row. This is for data type integer and +# column-ordered SDAS tables. + +procedure tbyrgi (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +int buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), buffer[k], SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (buffer[k], buffer[k], 1) + nullflag[k] = IS_INDEFI (buffer[k]) + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + if (IS_INDEFS (shortbuf)) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = shortbuf + nullflag[k] = false + } + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_INT) { + buffer[k] = INDEFI + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFI (buffer[k]) + } + } else { + call error (ER_TBCOLBADTYP, "tbrgti: invalid data type") + } + } + } +end + + +# tbyrgs -- Y getrow short +# Read column values from a row. This is for data type short integer and +# column-ordered SDAS tables. + +procedure tbyrgs (tp, colptr, buffer, nullflag, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +short buffer[numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +int stat # OK or an error reading row +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read(), nscan() +errchk seek, read + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + if (IS_INDEFR (realbuf) || abs (realbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (realbuf) + nullflag[k] = false + } + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf) || abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + if (IS_INDEFI (intbuf) || abs (intbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = intbuf + nullflag[k] = IS_INDEFS (buffer[k]) + } + case TY_SHORT: + stat = read (TB_FILE(tp), buffer[k], SZ_SHORT) + nullflag[k] = IS_INDEFS (buffer[k]) + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + if (boolbuf) + buffer[k] = YES + else + buffer[k] = NO + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + stat = read (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + call strupk (charbuf, charbuf, SZ_LINE) + call sscan (charbuf) + call gargd (dblbuf) + if (nscan() < 1 || IS_INDEFD(dblbuf) || + abs (dblbuf) > MAX_SHORT) { + buffer[k] = INDEFS + nullflag[k] = true + } else { + buffer[k] = nint (dblbuf) + nullflag[k] = IS_INDEFS (buffer[k]) + } + } else { + call error (ER_TBCOLBADTYP, "tbrgts: invalid data type") + } + } + } +end + + +# tbyrgt -- Y getrow text +# Read column values from a row. This is for character strings and +# column-ordered SDAS tables. + +procedure tbyrgt (tp, colptr, buffer, nullflag, lenstring, numcols, rownum) + +pointer tp # Pointer to table descriptor +pointer colptr[numcols] # Array of pointers to column descriptors +char buffer[lenstring,numcols] # Buffer for values +bool nullflag[numcols] # Array of flags: true ==> element is undefined +int lenstring # Length of each string in array buffer +int numcols # Number of columns from which to get values +int rownum # Row number +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +int dlen # Number of char for one element in table +int stat # OK or an error reading row +int numchar # Number of characters to copy string to string +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int read() +errchk seek, read, sprintf + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + stat = read (TB_FILE(tp), realbuf, SZ_REAL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargr (realbuf) + nullflag[k] = IS_INDEFR (realbuf) + case TY_DOUBLE: + stat = read (TB_FILE(tp), dblbuf, SZ_DOUBLE) + if (TBL_IS_INDEFD (dblbuf)) { + call strcpy ("INDEF", buffer[1,k], lenstring) + nullflag[k] = true + } else { + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargd (dblbuf) + nullflag[k] = false + } + case TY_INT: + stat = read (TB_FILE(tp), intbuf, SZ_INT32) + if (SZ_INT != SZ_INT32) + call iupk32 (intbuf, intbuf, 1) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargi (intbuf) + nullflag[k] = IS_INDEFI (intbuf) + case TY_SHORT: + stat = read (TB_FILE(tp), shortbuf, SZ_SHORT) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargs (shortbuf) + nullflag[k] = IS_INDEFS (shortbuf) + case TY_BOOL: + stat = read (TB_FILE(tp), boolbuf, SZ_BOOL) + call sprintf (buffer[1,k], lenstring, COL_FMT(colptr[k])) + call pargb (boolbuf) + nullflag[k] = false + default: + if (datatype < 0 || datatype == TY_CHAR) { + dlen = COL_LEN(colptr[k]) + stat = read (TB_FILE(tp), charbuf, dlen) + numchar = min (lenstring, SZB_CHAR*dlen) + call strupk (charbuf, buffer[1,k], numchar) + nullflag[k] = (buffer[1,k] == EOS) + } else { + call error (ER_TBCOLBADTYP, "tbrgtt: invalid data type") + } + } + } +end diff --git a/pkg/tbtables/tbyrp.x b/pkg/tbtables/tbyrp.x new file mode 100644 index 00000000..ecb4d9c1 --- /dev/null +++ b/pkg/tbtables/tbyrp.x @@ -0,0 +1,455 @@ +include # for MAX_INT and MAX_SHORT +include "tbtables.h" +include "tblerr.h" + +# tbyrpb -- Y putrow Boolean +# Write column values to a row. This is for data type Boolean and +# column-ordered SDAS tables. +# +# Phil Hodge, 28-Dec-1987 Different data types combined into one file. +# Phil Hodge, 6-Mar-1989 Allow COL_DTYPE < 0 for character columns. +# Phil Hodge, 7-Mar-1989 Eliminate TB_MODSIZE. +# Phil Hodge, 1-Apr-1993 Include short datatype. +# Phil Hodge, 4-Nov-1993 tbyrpt: call sscan as a subroutine, not a function. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. +# Phil Hodge, 5-Mar-1998 Remove calls to tbytsz, and don't update TB_NROWS, +# as these are taken care of at a higher level. + +procedure tbyrpb (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: Pointer to table descriptor +pointer colptr[numcols] # i: Array of pointers to column descriptors +bool buffer[numcols] # i: Array of values to be put into table +int numcols # i: Number of columns +int rownum # i: Row number; may be beyond end of file +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (buffer[k]) + realbuf = real(YES) + else + realbuf = real(NO) + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (buffer[k]) + dblbuf = double(YES) + else + dblbuf = double(NO) + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (buffer[k]) + intbuf = YES + else + intbuf = NO + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + if (buffer[k]) + shortbuf = YES + else + shortbuf = NO + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + call write (TB_FILE(tp), buffer[k], SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-3b") + call pargb (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + } else { + call error (ER_TBCOLBADTYP, "tbrptb: invalid data type") + } + } + } +end + + +# tbyrpd -- Y putrow double +# Write column values to a row. This is for data type double and +# column-ordered SDAS tables. + +procedure tbyrpd (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: Pointer to table descriptor +pointer colptr[numcols] # i: Array of pointers to column descriptors +double buffer[numcols] # i: Array of values to be put into table +int numcols # i: Number of columns +int rownum # i: Row number; may be beyond end of file +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (IS_INDEFD (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFD (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (IS_INDEFD (buffer[k]) || abs (buffer[k]) > MAX_INT) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + if (IS_INDEFD (buffer[k]) || abs (buffer[k]) > MAX_SHORT) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + if (IS_INDEFD (buffer[k]) || abs (buffer[k]) > MAX_INT) + boolbuf = false + else + boolbuf = (nint(buffer[k]) != NO) + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-25.17g") + call pargd (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + } else { + call error (ER_TBCOLBADTYP, "tbrptd: invalid data type") + } + } + } +end + + +# tbyrpr -- Y putrow real +# Write column values to a row. This is for data type real and +# column-ordered SDAS tables. + +procedure tbyrpr (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: Pointer to table descriptor +pointer colptr[numcols] # i: Array of pointers to column descriptors +real buffer[numcols] # i: Array of values to be put into table +int numcols # i: Number of columns +int rownum # i: Row number; may be beyond end of file +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +# buffers for copying elements of various types +double dblbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + call write (TB_FILE(tp), buffer[k], SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFR(buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (IS_INDEFR(buffer[k]) || abs (buffer[k]) > MAX_INT) + intbuf = INDEFI + else + intbuf = nint (buffer[k]) + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + if (IS_INDEFR(buffer[k]) || abs (buffer[k]) > MAX_SHORT) + shortbuf = INDEFS + else + shortbuf = nint (buffer[k]) + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + if (IS_INDEFR (buffer[k]) || abs (buffer[k]) > MAX_INT) + boolbuf = false + else + boolbuf = (nint(buffer[k]) != NO) + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-15.7g") + call pargr (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + } else { + call error (ER_TBCOLBADTYP, "tbrptr: invalid data type") + } + } + } +end + + +# tbyrpi -- Y putrow integer +# Write column values to a row. This is for data type integer and +# column-ordered SDAS tables. + +procedure tbyrpi (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: Pointer to table descriptor +pointer colptr[numcols] # i: Array of pointers to column descriptors +int buffer[numcols] # i: Array of values to be put into table +int numcols # i: Number of columns +int rownum # i: Row number; may be beyond end of file +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (IS_INDEFI (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFI (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (SZ_INT != SZ_INT32) + call ipak32 (buffer[k], buffer[k], 1) + call write (TB_FILE(tp), buffer[k], SZ_INT32) + case TY_SHORT: + if (IS_INDEFI (buffer[k]) || abs (buffer[k]) > MAX_SHORT) + shortbuf = INDEFS + else + shortbuf = buffer[k] + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + if (IS_INDEFI (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargi (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + } else { + call error (ER_TBCOLBADTYP, "tbrpti: invalid data type") + } + } + } +end + + +# tbyrps -- Y putrow short +# Write column values to a row. This is for data type short integer and +# column-ordered SDAS tables. + +procedure tbyrps (tp, colptr, buffer, numcols, rownum) + +pointer tp # i: Pointer to table descriptor +pointer colptr[numcols] # i: Array of pointers to column descriptors +short buffer[numcols] # i: Array of values to be put into table +int numcols # i: Number of columns +int rownum # i: Row number; may be beyond end of file +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + if (IS_INDEFS (buffer[k])) + realbuf = INDEFR + else + realbuf = buffer[k] + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + if (IS_INDEFS (buffer[k])) + dblbuf = TBL_INDEFD + else + dblbuf = buffer[k] + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + if (IS_INDEFS (buffer[k])) + intbuf = INDEFI + else + intbuf = buffer[k] + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + call write (TB_FILE(tp), buffer[k], SZ_SHORT) + case TY_BOOL: + if (IS_INDEFS (buffer[k]) || (buffer[k] == NO)) + boolbuf = false + else + boolbuf = true + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call sprintf (charbuf, SZ_LINE, "%-11d") + call pargs (buffer[k]) + call strpak (charbuf, charbuf, SZ_LINE) + call write (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + } else { + call error (ER_TBCOLBADTYP, "tbrpts: invalid data type") + } + } + } +end + + +# tbyrpt -- Y putrow text +# Write column values to a row. This is for character strings and +# column-ordered SDAS tables. + +procedure tbyrpt (tp, colptr, buffer, lenstring, numcols, rownum) + +pointer tp # i: Pointer to table descriptor +pointer colptr[numcols] # i: Array of pointers to column descriptors +char buffer[lenstring, numcols] # i: Array of values to be put into table +int lenstring # i: Length of each string in array buffer +int numcols # i: Number of columns +int rownum # i: Row number; may be beyond end of file +#-- +long offset # Offset of column entry from BOF +int k # Loop index +int datatype # Data type of element in table +# buffers for copying elements of various types +double dblbuf +real realbuf +int intbuf +short shortbuf +bool boolbuf +char charbuf[SZ_LINE] +long tbyoff() +int nscan() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + call seek (TB_FILE(tp), offset) + switch (datatype) { + case TY_REAL: + call sscan (buffer[1,k]) + call gargr (realbuf) + if (nscan() < 1) + realbuf = INDEFR + call write (TB_FILE(tp), realbuf, SZ_REAL) + case TY_DOUBLE: + call sscan (buffer[1,k]) + call gargd (dblbuf) + if (nscan() < 1) + dblbuf = TBL_INDEFD + else if (IS_INDEFD (dblbuf)) + dblbuf = TBL_INDEFD + call write (TB_FILE(tp), dblbuf, SZ_DOUBLE) + case TY_INT: + call sscan (buffer[1,k]) + call gargi (intbuf) + if (nscan() < 1) + intbuf = INDEFI + if (SZ_INT != SZ_INT32) + call ipak32 (intbuf, intbuf, 1) + call write (TB_FILE(tp), intbuf, SZ_INT32) + case TY_SHORT: + call sscan (buffer[1,k]) + call gargs (shortbuf) + if (nscan() < 1) + shortbuf = INDEFS + call write (TB_FILE(tp), shortbuf, SZ_SHORT) + case TY_BOOL: + call sscan (buffer[1,k]) + call gargb (boolbuf) + if (nscan() < 1) + boolbuf = false + call write (TB_FILE(tp), boolbuf, SZ_BOOL) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call strpak (buffer[1,k], charbuf, lenstring) + call write (TB_FILE(tp), charbuf, COL_LEN(colptr[k])) + } else { + call error (ER_TBCOLBADTYP, "tbrptt: invalid data type") + } + } + } +end diff --git a/pkg/tbtables/tbyscn.x b/pkg/tbtables/tbyscn.x new file mode 100644 index 00000000..27e277ba --- /dev/null +++ b/pkg/tbtables/tbyscn.x @@ -0,0 +1,86 @@ +include "tbtables.h" + +# tbyscn -- Y set columns to null +# Write INDEF values for specified columns in a range of rows in a table. +# Note: This routine assumes that EOS = 0 (or SZB_CHAR=1) because the buffer +# for setting char values to indef is not packed. +# +# Phil Hodge, 1-Apr-1993 Include short datatype. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. + +procedure tbyscn (tp, fd, colptr, numcols, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to descr of new columns +int fd # i: identifies the data file for a table +int numcols # i: the number of new columns +int firstrow # i: the first row to be set to indef +int lastrow # i: the last row to be set to indef + +pointer sp +pointer charbuf # Scratch for character string column +long offset # Location (chars) for writing in table +int j, k # Loop indexes +int datatype # Data type of a column +int dlen # Number of char in an element of the table +short sbuf +bool boolbuf # Buffer for writing Boolean values +long tbyoff() +errchk seek, write + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + if (datatype < 0) + datatype = TY_CHAR + dlen = COL_LEN(colptr[k]) + offset = tbyoff (tp, colptr[k], firstrow) + switch (datatype) { + case TY_REAL: + do j = 1, lastrow-firstrow+1 { + call seek (fd, offset) + call write (fd, INDEFR, dlen) + offset = offset + dlen + } + case TY_DOUBLE: + do j = 1, lastrow-firstrow+1 { + call seek (fd, offset) + call write (fd, TBL_INDEFD, dlen) + offset = offset + dlen + } + case TY_INT: + do j = 1, lastrow-firstrow+1 { + call seek (fd, offset) + call write (fd, INDEFI, dlen) + offset = offset + dlen + } + case TY_SHORT: + # We need this because INDEFS in the call to WRITE would be + # interpreted as an integer rather than as a short int. + sbuf = INDEFS + do j = 1, lastrow-firstrow+1 { + call seek (fd, offset) + call write (fd, sbuf, dlen) + offset = offset + dlen + } + case TY_BOOL: + boolbuf = false + do j = 1, lastrow-firstrow+1 { + call seek (fd, offset) + call write (fd, boolbuf, dlen) + offset = offset + dlen + } + case TY_CHAR: + call smark (sp) + call salloc (charbuf, dlen, TY_CHAR) + do j = 1, dlen + Memc[charbuf+j-1] = EOS # N.B. this assumes EOS = 0 + do j = 1, lastrow-firstrow+1 { + call seek (fd, offset) + call write (fd, Memc[charbuf], dlen) + offset = offset + dlen + } + call sfree (sp) + } + } +end diff --git a/pkg/tbtables/tbyscp.x b/pkg/tbtables/tbyscp.x new file mode 100644 index 00000000..1572ce67 --- /dev/null +++ b/pkg/tbtables/tbyscp.x @@ -0,0 +1,91 @@ +include "tbtables.h" + +# tbyscp -- Y copy to change size +# This routine copies the contents of one table to another for the purpose +# of changing the size of the user-parameter space, the space for column +# descriptors, and/or the row or column length of the table itself. +# Old_maxpar, etc describe the characteristics of the input file, +# while TB_MAXPAR(tp), etc describe the output file. +# This is called by tbysiz. + +procedure tbyscp (tp, oldfd, newfd, old_maxpar, + old_maxcols, old_ncols, old_allrows) + +pointer tp # Pointer to table descriptor +int oldfd, newfd # Channel numbers for input & output tables +int old_maxpar # Previous maximum number of user parameters +int old_maxcols # Previous value for maximum number of columns +int old_ncols # Previous number of columns +int old_allrows # Previous number of allocated rows + +pointer cp # pointer to a column descriptor +pointer sp +pointer sbuf # size info buffer +pointer dbuf # buffer for copying table (data buffer) +pointer extrabuf # buffer for filling out rest of column +long oldoff, newoff # offsets from start of old & new files +int new_allrows # = TB_ALLROWS(tp) +int sbufsiz # size of buffer pointed to by sbuf +int dbufsiz # size of buffer pointed to by dbuf +int extrasiz # size of buffer pointer to by extrabuf +int j, k # loop indexes +int dlen # number of char in an element +int stat +pointer tbcnum() +long tbtbod() +int read() +errchk seek, read, write + +begin + new_allrows = TB_ALLROWS(tp) + + # Create buffers for I/O + call smark (sp) + sbufsiz = LEN_SIZINFO # unit = SZ_INT32 + dbufsiz = min (new_allrows, old_allrows) # unit = SZ_CHAR + extrasiz = new_allrows - old_allrows + call salloc (sbuf, sbufsiz, TY_INT) + call salloc (dbuf, dbufsiz, TY_CHAR) + if (new_allrows > old_allrows) + call salloc (extrabuf, extrasiz, TY_CHAR) + + # Write dummy size info record. + call amovki (0, Memi[sbuf], LEN_SIZINFO) + newoff = 1 + call seek (newfd, newoff) + if (SZ_INT != SZ_INT32) + call ipak32 (Memi[sbuf], Memi[sbuf], SZ_SIZINFO) + call write (newfd, Memi[sbuf], SZ_SIZINFO) + + # Copy each user parameter to the temporary file. + call tbtscu (tp, oldfd, newfd, old_maxpar) + + # Copy each column descriptor to the temporary file. + call tbtscd (tp, oldfd, newfd, old_maxpar, old_ncols) + + # Copy each column of the table to the temporary file. + oldoff = tbtbod (old_maxpar, old_maxcols) + newoff = tbtbod (TB_MAXPAR(tp), TB_MAXCOLS(tp)) + do k = 1, old_ncols { + cp = tbcnum (tp, k) + dlen = COL_LEN(cp) + do j = 1, dlen { + call seek (oldfd, oldoff) + call seek (newfd, newoff) + stat = read (oldfd, Memc[dbuf], dbufsiz) + call write (newfd, Memc[dbuf], dbufsiz) + oldoff = oldoff + dbufsiz + newoff = newoff + dbufsiz + } + # Fill out the rest of the current column with dummy values. + if (new_allrows > old_allrows) { + do j = 1, dlen { + call seek (newfd, newoff) + call write (newfd, Memc[extrabuf], extrasiz) + newoff = newoff + extrasiz + } + } + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbysft.x b/pkg/tbtables/tbysft.x new file mode 100644 index 00000000..53c479bf --- /dev/null +++ b/pkg/tbtables/tbysft.x @@ -0,0 +1,211 @@ +include "tbtables.h" +include "tblerr.h" + +# tbysft -- Y shift rows +# Shift one or more rows down (to leave a gap in the table) or up (to +# delete rows). The range of rows that is shifted is from FIRST to +# the last row in the table. Shift down if SHIFT > 0, or shift up if +# SHIFT < 0. SHIFT is the number of rows by which to shift. +# +# If SHIFT > 0 rows that are exposed by the shift are NOT set to indef. +# If SHIFT < 0 rows at the end WILL be set to indef. +# In either case the number of rows TB_NROWS(tp) will be updated. +# +# Phil Hodge, 23-Mar-1988 Subroutine created. +# Phil Hodge, 1-Apr-1993 Include short datatype; errchk tbegp[] & tbepp[]. +# Phil Hodge, 29-Jul-1994 Change calling sequence of tbeoff. +# Phil Hodge, 5-Mar-1998 Replace tbytsz by tbywer. + +procedure tbysft (tp, first, shift) + +pointer tp # i: pointer to table descriptor +int first # i: first row to be affected by the shift +int shift # i: shift by this many rows +#-- +pointer cptr # pointer to a column descriptor +pointer v # pointer to array of values +pointer vj # pointer which is incremented in loop +int abs_shift # absolute value of shift +int row1, row2 # range of rows to be copied +int nrows # number of rows written to table +int nvals # number of values in scratch array +int dtype # data type of a column +int col_width # space in char for an element in table +int col # loop index for column number +int k # loop index +long i_offset # offset in char to a table element +long o_offset # offset in char to a table element +long tbeoff() +pointer tbcnum() +errchk tbegpb, tbegpd, tbegpi, tbegps, tbegpr, tbegpt, + tbeppb, tbeppd, tbeppi, tbepps, tbeppr, tbeppt, + tbywer + +begin + nrows = TB_NROWS(tp) + + # Make sure there are enough rows allocated in the table. + if (first > nrows) { + if (shift > 0) + call tbywer (tp, shift+first-1) + return # nothing else to do + } else { + call tbywer (tp, shift+nrows) + } + + + # First consider the case of deleting all rows starting with FIRST. + if (nrows + shift < first) { + call tbynll (tp, first, nrows) # set to INDEF + TB_NROWS(tp) = max (0, first-1) + return + } + + if (shift > 0) + TB_NROWS(tp) = TB_NROWS(tp) + shift + + abs_shift = abs (shift) + + # Rows row1:row2 will be copied to row1+shift:row2+shift. + if (shift < 0) { + row1 = first + abs_shift + row2 = nrows + } else { + row1 = first + row2 = nrows + } + nvals = row2 - row1 + 1 + + do col = 1, TB_NCOLS(tp) { + + cptr = tbcnum (tp, col) + dtype = COL_DTYPE(cptr) + col_width = COL_LEN(cptr) + + switch (dtype) { + case TY_REAL: + call malloc (v, nvals, TY_REAL) + vj = v # incremented in loop + i_offset = tbeoff (tp, cptr, row1, 1) + do k = row1, row2 { + call tbegpr (tp, cptr, i_offset, k, Memr[vj]) # get + vj = vj + 1 + i_offset = i_offset + col_width + } + vj = v # incremented in loop + o_offset = tbeoff (tp, cptr, row1+shift, 1) + do k = row1+shift, row2+shift { + call tbeppr (tp, cptr, o_offset, k, Memr[vj]) # put + vj = vj + 1 + o_offset = o_offset + col_width + } + call mfree (v, TY_REAL) + + case TY_DOUBLE: + call malloc (v, nvals, TY_DOUBLE) + vj = v + i_offset = tbeoff (tp, cptr, row1, 1) + do k = row1, row2 { + call tbegpd (tp, cptr, i_offset, k, Memd[vj]) + vj = vj + 1 + i_offset = i_offset + col_width + } + vj = v + o_offset = tbeoff (tp, cptr, row1+shift, 1) + do k = row1+shift, row2+shift { + call tbeppd (tp, cptr, o_offset, k, Memd[vj]) + vj = vj + 1 + o_offset = o_offset + col_width + } + call mfree (v, TY_DOUBLE) + + case TY_INT: + call malloc (v, nvals, TY_INT) + vj = v + i_offset = tbeoff (tp, cptr, row1, 1) + do k = row1, row2 { + call tbegpi (tp, cptr, i_offset, k, Memi[vj]) + vj = vj + 1 + i_offset = i_offset + col_width + } + vj = v + o_offset = tbeoff (tp, cptr, row1+shift, 1) + do k = row1+shift, row2+shift { + call tbeppi (tp, cptr, o_offset, k, Memi[vj]) + vj = vj + 1 + o_offset = o_offset + col_width + } + call mfree (v, TY_INT) + + case TY_SHORT: + call malloc (v, nvals, TY_SHORT) + vj = v + i_offset = tbeoff (tp, cptr, row1, 1) + do k = row1, row2 { + call tbegps (tp, cptr, i_offset, k, Mems[vj]) + vj = vj + 1 + i_offset = i_offset + col_width + } + vj = v + o_offset = tbeoff (tp, cptr, row1+shift, 1) + do k = row1+shift, row2+shift { + call tbepps (tp, cptr, o_offset, k, Mems[vj]) + vj = vj + 1 + o_offset = o_offset + col_width + } + call mfree (v, TY_SHORT) + + case TY_BOOL: + call malloc (v, nvals, TY_BOOL) + vj = v + i_offset = tbeoff (tp, cptr, row1, 1) + do k = row1, row2 { + call tbegpb (tp, cptr, i_offset, k, Memb[vj]) + vj = vj + 1 + i_offset = i_offset + col_width + } + vj = v + o_offset = tbeoff (tp, cptr, row1+shift, 1) + do k = row1+shift, row2+shift { + call tbeppb (tp, cptr, o_offset, k, Memb[vj]) + vj = vj + 1 + o_offset = o_offset + col_width + } + call mfree (v, TY_BOOL) + + default: + if (dtype >= 0 && dtype != TY_CHAR) + call error (ER_TBCOLBADTYP, + "tbysft: table or memory corrupted?") + call malloc (v, SZ_LINE, TY_CHAR) + if (shift < 0) { + i_offset = tbeoff (tp, cptr, row1, 1) + o_offset = tbeoff (tp, cptr, row1-abs_shift, 1) + do k = row1, row2 { + call tbegpt (tp, cptr, i_offset, k, Memc[v], SZ_LINE) + call tbeppt (tp, cptr, o_offset, k, Memc[v]) + i_offset = i_offset + col_width + o_offset = o_offset + col_width + } + } else { + i_offset = tbeoff (tp, cptr, row2, 1) + o_offset = tbeoff (tp, cptr, row2+shift, 1) + # (actually, it's the offsets that count; k is ignored) + do k = row2+shift, row1+shift, -1 { + call tbegpt (tp, cptr, i_offset, k, Memc[v], SZ_LINE) + call tbeppt (tp, cptr, o_offset, k, Memc[v]) + i_offset = i_offset - col_width + o_offset = o_offset - col_width + } + } + call mfree (v, TY_CHAR) + } + } + + # If rows were deleted, set the extra rows at end to indef, + # and change the value of TB_NROWS(tp). + if (shift < 0) { + call tbynll (tp, nrows-abs_shift+1, nrows) + TB_NROWS(tp) = max (0, nrows - abs_shift) + } +end diff --git a/pkg/tbtables/tbysiz.x b/pkg/tbtables/tbysiz.x new file mode 100644 index 00000000..a5791258 --- /dev/null +++ b/pkg/tbtables/tbysiz.x @@ -0,0 +1,93 @@ +include +include "tbtables.h" + +# tbysiz -- Y increase size +# Change the space for column descriptors and/or the allocated number +# of rows. This is done by copying the table data file to a temporary +# file, deleting the original table, and then renaming the temporary file +# to the name of the original table. +# The table must be open when this procedure is called. +# +# NOTE that the file channel number TB_FILE(tp) may be changed by this +# procedure. The values of TB_MAXCOLS, TB_ALLROWS and TB_COLUSED are +# assumed to have been updated by a calling routine (e.g. tbcdef). +# +# Phil Hodge, 28-Aug-1987 Flush file buffer after calling tbtwsi. +# Phil Hodge, 6-Nov-1987 Put temporary file in tmp. +# Phil Hodge, 24-Mar-1988 Save and restore FIO buffer size. +# Phil Hodge, 7-Mar-1989 Eliminate TB_CURROW. + +procedure tbysiz (tp, old_maxpar, old_maxcols, + old_ncols, old_allrows) + +pointer tp # i: pointer to table descriptor +int old_maxpar # i: previous value for max number of parmeters +int old_maxcols # i: previous value for max number of columns +int old_ncols # i: previous number of columns +int old_allrows # i: previous value of allocated number of rows + +pointer sp +pointer colptr # scratch for array of column pointers +int k +int new_allrows # = TB_ALLROWS(tp) +int iomode # I/O mode for reopening the table +int oldfd, newfd # Channel numbers for old & new table files +int bufsize # save and restore FIO buffer size +char temp_file[SZ_FNAME] # Name of temporary file for table data +pointer tbcnum() +int open(), fstati() +errchk tbtwsi, tbyscp, mktemp, open, close, delete, rename, tbyscn, flush + +begin + # First check whether we really have to do anything. + if ((TB_MAXPAR(tp) == old_maxpar) && (TB_MAXCOLS(tp) == old_maxcols) && + ((TB_ALLROWS(tp) == old_allrows) || (old_ncols == 0))) + return + + oldfd = TB_FILE(tp) + if (oldfd == NULL) + return + bufsize = fstati (oldfd, F_BUFSIZE) + + new_allrows = TB_ALLROWS(tp) + + call mktemp ("tmp$tbl", temp_file, SZ_FNAME) + newfd = open (temp_file, NEW_FILE, BINARY_FILE) + + # Copy the contents of the table to the temporary file. + call tbyscp (tp, oldfd, newfd, old_maxpar, + old_maxcols, old_ncols, old_allrows) + + # For each existing column, set all new rows to indef. + if ((new_allrows > old_allrows) && (old_ncols > 0)) { + call smark (sp) + call salloc (colptr, old_ncols, TY_INT) + do k = 1, old_ncols + Memi[colptr+k-1] = tbcnum (tp, k) + call tbyscn (tp, newfd, Memi[colptr], old_ncols, + old_allrows+1, new_allrows) + call sfree (sp) + } + + call close (oldfd) + call close (newfd) + + # Delete the original table, and rename the temporary table to + # the same name as the original. + call delete (TB_NAME(tp)) + call rename (temp_file, TB_NAME(tp)) + + # Reopen the new table. + if (TB_IOMODE(tp) == NEW_FILE) + iomode = READ_WRITE + else + iomode = TB_IOMODE(tp) + TB_FILE(tp) = open (TB_NAME(tp), iomode, BINARY_FILE) + + # Restore whatever buffer size the old table had. + call fseti (TB_FILE(tp), F_BUFSIZE, bufsize) + + # Update the size information record in the new table. + call tbtwsi (tp) # write size information + call flush (TB_FILE(tp)) +end diff --git a/pkg/tbtables/tbyudf.x b/pkg/tbtables/tbyudf.x new file mode 100644 index 00000000..affe4a6d --- /dev/null +++ b/pkg/tbtables/tbyudf.x @@ -0,0 +1,71 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbyudf -- Y set to undefined +# "Delete" entries in a table by setting each entry to the INDEF value +# appropriate for its datatype. +# Note: This routine assumes that EOS = 0 (or SZB_CHAR = 1) because the +# buffer for setting char values to indef is not packed. +# This version is for column-ordered SDAS tables. +# +# Phil Hodge, 9-Mar-1989 Allow data type to be -n for char. +# Phil Hodge, 1-Apr-1993 Include short datatype. +# Phil Hodge, 2-Jun-1997 Replace INDEFD with TBL_INDEFD. + +procedure tbyudf (tp, colptr, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: array of pointers to column descriptors +int numcols # i: number of columns +int rownum # i: row number +#-- +pointer sp +pointer charbuf # Scratch for character string column +long offset # Location (chars) for writing in table +int j, k # Loop indexes +int datatype # Data type of a column +int dlen # Number of char in an element of the table +short sbuf # buffer for short datatype +bool boolbuf # Buffer for writing Boolean values +long tbyoff() + +begin + do k = 1, numcols { + datatype = COL_DTYPE(colptr[k]) + dlen = COL_LEN(colptr[k]) + offset = tbyoff (tp, colptr[k], rownum) + switch (datatype) { + case TY_REAL: + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), INDEFR, dlen) + case TY_DOUBLE: + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), TBL_INDEFD, dlen) + case TY_INT: + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), INDEFI, dlen) + case TY_SHORT: + sbuf = INDEFS + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), sbuf, dlen) + case TY_BOOL: + boolbuf = false + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), boolbuf, dlen) + default: + if (datatype < 0 || datatype == TY_CHAR) { + call smark (sp) + call salloc (charbuf, dlen, TY_CHAR) + do j = 1, dlen + Memc[charbuf+j-1] = EOS # this assumes EOS = 0 + call seek (TB_FILE(tp), offset) + call write (TB_FILE(tp), Memc[charbuf], dlen) + call sfree (sp) + } else { + call error (ER_TBCOLBADTYP, + "tbyudf: invalid datatype; table corrupted?") + } + } + } +end diff --git a/pkg/tbtables/tbywer.x b/pkg/tbtables/tbywer.x new file mode 100644 index 00000000..6c3585b1 --- /dev/null +++ b/pkg/tbtables/tbywer.x @@ -0,0 +1,32 @@ +include "tbtables.h" + +define FRAC_INCR 1.2 # fractional increase in allrows +define DEFNUMROWS 100 # minimum increase in allrows + +# tbywer -- write empty rows +# The purpose of this routine is to allocate more space for rows for a +# column-ordered table. If the specified row is within the range of +# existing rows, the table itself will not be modified. +# +# If rownum is greater than TB_ALLROWS then tbtchs will be called to +# rewrite the table and increase the allocated number of rows by a default +# amount. +# +# Note that TB_NROWS will not be updated. +# +# Phil Hodge, 4-Mar-1998 Subroutine created, extracted from tbtwer. + +procedure tbywer (tp, rownum) + +pointer tp # i: pointer to table descriptor +int rownum # i: (actual) row number in table +#-- +int allrows # allocated number of rows +errchk tbtchs + +begin + if (rownum > TB_ALLROWS(tp)) { + allrows = rownum * FRAC_INCR + DEFNUMROWS + call tbtchs (tp, -1, -1, -1, allrows) # change table size + } +end diff --git a/pkg/tbtables/tbywnc.x b/pkg/tbtables/tbywnc.x new file mode 100644 index 00000000..7831af2d --- /dev/null +++ b/pkg/tbtables/tbywnc.x @@ -0,0 +1,31 @@ +include "tbtables.h" + +# tbywnc -- Y write new column +# Write new column descriptors into a column-ordered table. +# The table must have already been reorganized (if necessary) to make +# sufficient space for column descriptors or row length. +# +# Phil Hodge, 1-May-1989 Change calling sequence; don't call tbysiz. +# Phil Hodge, 14-Apr-1998 Change calling sequence of tbcwcd; +# change LEN_COLSTRUCT to LEN_COLDEF. + +procedure tbywnc (tp, colptr, numcols) + +pointer tp # i: pointer to table descriptor +pointer colptr[numcols] # i: pointers to descriptors for new columns +int numcols # i: number of new columns +#-- +pointer cp # Pointer to a specific column +int k # Loop index +errchk tbcwcd, tbyncn + +begin + # Write descriptors of new columns to table. + do k = 1, numcols { + cp = colptr[k] + call tbcwcd (tp, cp) + } + + # Assign indef values for each new column and all allocated rows. + call tbyncn (tp, colptr, numcols) +end diff --git a/pkg/tbtables/tbzadd.x b/pkg/tbtables/tbzadd.x new file mode 100644 index 00000000..5e66b768 --- /dev/null +++ b/pkg/tbtables/tbzadd.x @@ -0,0 +1,61 @@ +include # for SZB_CHAR +include +include "tbtables.h" + +# tbzadd -- add new column for text file +# Allocate a buffer for a new column for a text file, and assign indef values. +# If the data type is not valid for text tables, the type will be changed. +# +# Phil Hodge, 14-Jan-1992 Subroutine created. +# Phil Hodge, 31-Mar-1993 Include check for short datatype. + +procedure tbzadd (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +int allrows # number of allocated rows +int row_1 # row number minus one +int lenstr # length of each string in a string column +int size # total number of char in a string column +errchk malloc, calloc + +begin + allrows = TB_ALLROWS(tp) + + # Make sure the data type is valid for text tables. + if (COL_DTYPE(cp) == TBL_TY_REAL) + COL_DTYPE(cp) = TBL_TY_DOUBLE + else if (COL_DTYPE(cp) == TBL_TY_SHORT) + COL_DTYPE(cp) = TBL_TY_INT + else if (COL_DTYPE(cp) == TBL_TY_BOOL) + COL_DTYPE(cp) = -8 + else if (COL_DTYPE(cp) == TY_CHAR) + # Old notation: TY_CHAR instead of -N. + COL_DTYPE(cp) = -COL_LEN(cp) * SZB_CHAR + + COL_OFFSET(cp) = NULL # initial null pointer + + # Allocate memory for column values. + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + + call malloc (COL_OFFSET(cp), allrows, TY_DOUBLE) + do row_1 = 0, allrows-1 # zero indexed + Memd[COL_OFFSET(cp) + row_1] = INDEFD + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + + call malloc (COL_OFFSET(cp), allrows, TY_INT) + do row_1 = 0, allrows-1 + Memi[COL_OFFSET(cp) + row_1] = INDEFI + + } else if (COL_DTYPE(cp) < 0) { # string + + lenstr = -COL_DTYPE(cp) + 1 # add one for EOS + size = lenstr * allrows + call calloc (COL_OFFSET(cp), size, TY_CHAR) + + } else { + call error (1, "tbzadd: invalid data type") + } +end diff --git a/pkg/tbtables/tbzcg.x b/pkg/tbtables/tbzcg.x new file mode 100644 index 00000000..e819a0e9 --- /dev/null +++ b/pkg/tbtables/tbzcg.x @@ -0,0 +1,163 @@ +include "tbtables.h" + +# tbzcg[tbirds] -- get values from a column +# This procedure gets elements from an internal buffer corresponding +# to a value in a text file. +# +# Phil Hodge, 3-Feb-1992 Subroutines created. +# Phil Hodge, 31-Mar-1993 Include short datatype. + +procedure tbzcgb (tp, cp, buffer, nullflag, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +bool buffer[ARB] # o: buffer for values to be gotten +bool nullflag[ARB] # o: true if element is undefined in table +int firstrow # i: number of first row to get +int lastrow # i: number of last row to get +#-- +int row # loop index for row number +int k # index into buffer & nullflag +errchk tbzgtb + +begin + k = 1 + do row = firstrow, lastrow { + call tbzgtb (tp, cp, row, buffer[k]) + nullflag[k] = false + k = k + 1 + } +end + +procedure tbzcgd (tp, cp, buffer, nullflag, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +double buffer[ARB] # o: buffer for values to be gotten +bool nullflag[ARB] # o: true if element is undefined in table +int firstrow # i: number of first row to get +int lastrow # i: number of last row to get +#-- +int row # loop index for row number +int k # index into buffer & nullflag +errchk tbzgtd + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + k = 1 + do row = firstrow, lastrow { + buffer[k] = Memd[COL_OFFSET(cp) + row - 1] + nullflag[k] = (IS_INDEFD (buffer[k])) + k = k + 1 + } + + } else { + k = 1 + do row = firstrow, lastrow { + call tbzgtd (tp, cp, row, buffer[k]) + nullflag[k] = (IS_INDEFD (buffer[k])) + k = k + 1 + } + } +end + +procedure tbzcgr (tp, cp, buffer, nullflag, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +real buffer[ARB] # o: buffer for values to be gotten +bool nullflag[ARB] # o: true if element is undefined in table +int firstrow # i: number of first row to get +int lastrow # i: number of last row to get +#-- +int row # loop index for row number +int k # index into buffer & nullflag +errchk tbzgtr + +begin + k = 1 + do row = firstrow, lastrow { + call tbzgtr (tp, cp, row, buffer[k]) + nullflag[k] = (IS_INDEFR (buffer[k])) + k = k + 1 + } +end + +procedure tbzcgi (tp, cp, buffer, nullflag, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int buffer[ARB] # o: buffer for values to be gotten +bool nullflag[ARB] # o: true if element is undefined in table +int firstrow # i: number of first row to get +int lastrow # i: number of last row to get +#-- +int row # loop index for row number +int k # index into buffer & nullflag +errchk tbzgti + +begin + if (COL_DTYPE(cp) == TBL_TY_INT) { + k = 1 + do row = firstrow, lastrow { + buffer[k] = Memi[COL_OFFSET(cp) + row - 1] + nullflag[k] = (IS_INDEFI (buffer[k])) + k = k + 1 + } + + } else { + k = 1 + do row = firstrow, lastrow { + call tbzgti (tp, cp, row, buffer[k]) + nullflag[k] = (IS_INDEFI (buffer[k])) + k = k + 1 + } + } +end + +procedure tbzcgs (tp, cp, buffer, nullflag, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +short buffer[ARB] # o: buffer for values to be gotten +bool nullflag[ARB] # o: true if element is undefined in table +int firstrow # i: number of first row to get +int lastrow # i: number of last row to get +#-- +int row # loop index for row number +int k # index into buffer & nullflag +errchk tbzgts + +begin + k = 1 + do row = firstrow, lastrow { + call tbzgts (tp, cp, row, buffer[k]) + nullflag[k] = (IS_INDEFS (buffer[k])) + k = k + 1 + } +end + +procedure tbzcgt (tp, cp, buffer, nullflag, lenstr, + firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +char buffer[lenstr,ARB] # o: buffer for values to be gotten +bool nullflag[ARB] # o: true if element is undefined in table +int lenstr # i: size of each element +int firstrow # i: number of first row to get +int lastrow # i: number of last row to get +#-- +int row # loop index for row number +int k # index into buffer & nullflag +bool streq() +errchk tbzgtt + +begin + k = 1 + do row = firstrow, lastrow { + call tbzgtt (tp, cp, row, buffer[1,k], lenstr) + nullflag[k] = (buffer[1,k] == EOS || streq (buffer[1,k], "INDEF")) + k = k + 1 + } +end diff --git a/pkg/tbtables/tbzclo.x b/pkg/tbtables/tbzclo.x new file mode 100644 index 00000000..673c9c81 --- /dev/null +++ b/pkg/tbtables/tbzclo.x @@ -0,0 +1,59 @@ +include +include "tbtables.h" + +# tbzclo -- do some cleaning up for a text file +# The table data are written back from memory into the text file, +# and the buffers for storing column data and keywords are deallocated. +# +# Phil Hodge, 14-Jan-1992 Subroutine created. +# Phil Hodge, 3-Apr-1995 Check TB_MODIFIED before calling tbzwrt. +# Phil Hodge, 7-Jun-1999 Deallocate keyword list; +# deallocate comment buffer here instead of in tbtclo. + +procedure tbzclo (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer cp # pointer to column descriptor +int colnum # column number +int key # keyword number + +begin + # Write the data to the file, and close the file. + if (TB_MODIFIED(tp) && TB_IOMODE(tp) != READ_ONLY) + call tbzwrt (tp) + + # Deallocate memory for column values. + do colnum = TB_NCOLS(tp), 1, -1 { + + cp = TB_COLINFO(tp,colnum) + + # The pointer to the column values is stored in COL_OFFSET(cp). + if (COL_OFFSET(cp) != NULL) { + + if (COL_DTYPE(cp) == TY_DOUBLE) + call mfree (COL_OFFSET(cp), TY_DOUBLE) + + else if (COL_DTYPE(cp) == TY_INT) + call mfree (COL_OFFSET(cp), TY_INT) + + else # string + call mfree (COL_OFFSET(cp), TY_CHAR) + } + } + + # Deallocate comment buffer. + if (TB_COMMENT(tp) != NULL) { + call mfree (TB_COMMENT(tp), TY_CHAR) + TB_COMMENT(tp) = NULL + } + + # Deallocate memory for keywords. + if (TB_KEYLIST_PTR(tp) != NULL) { + do key = TB_NPAR(tp), 1, -1 { + if (TB_KEYWORD(tp,key) != NULL) + call mfree (TB_KEYWORD(tp,key), TY_CHAR) + } + call mfree (TB_KEYLIST_PTR(tp), TY_POINTER) + } +end diff --git a/pkg/tbtables/tbzcol.x b/pkg/tbtables/tbzcol.x new file mode 100644 index 00000000..01e29e41 --- /dev/null +++ b/pkg/tbtables/tbzcol.x @@ -0,0 +1,120 @@ +include # for IS_DIGIT +include +include "tbtables.h" + +# tbzcol -- create columns +# This routine looks at the values on the first input line of a text file, +# interprets the values as to data type, assigns a print format for each +# column, and creates a column descriptor. +# Since the input buffer contains the first line of the text file, we +# check in this routine to see if the file is really an SDAS format (GEIS) +# image header rather than a text table. +# The datatype value returned by tbbwrd may be TY_DOUBLE, TY_INT, or TY_CHAR; +# however, TY_CHAR will be changed to -N. + +# Phil Hodge, 15-Jan-1992 Subroutine created. +# Phil Hodge, 7-Aug-1992 Remove most code that is already done in tbbwrd. +# Phil Hodge, 7-Jun-1994 For text string, don't increase width. +# Phil Hodge, 7-Jun-1999 Don't realloc TB_COLPTR, done in tbcadd instead. + +procedure tbzcol (tp, buf, wid, prec, fmt_code) + +pointer tp # i: pointer to table descriptor +char buf[ARB] # i: buffer containing line from file +pointer wid # o: pointer to array of values of width +pointer prec # o: pointer to array of (width - precision) +pointer fmt_code # o: pointer to array of format codes +#-- +pointer sp +pointer word # scratch for a word from the line +pointer cp # pointer to column descriptor +char cname[SZ_COLNAME] # column name +char units[SZ_COLUNITS] # column units (null) +char pform[SZ_COLFMT] # print format +int colnum # column number +int maxcols # current maximum number of columns +int ip # for ctowrd +int ip_start # ip before calling ctowrd +int word_width # width of extracted word (value of ctowrd) +int width # full width of column (incl whitespace) +int precision # precision for printing +int datatype # data type of current word (from tbbwrd) +int fcode # format code returned by tbbwrd +bool done # loop-termination flag +int tbbwrd(), strncmp() +errchk realloc, tbcadd + +begin + # First check whether we have an SDAS format image header. + if (strncmp ("SIMPLE = ", buf, 10) == 0) + call error (1, "file is an image header, not a table") + + call smark (sp) + call salloc (word, SZ_LINE, TY_CHAR) + + # Allocate buffers for column widths, precision, and format codes. + maxcols = TB_MAXCOLS(tp) + call malloc (wid, maxcols, TY_INT) + call malloc (prec, maxcols, TY_INT) + call malloc (fmt_code, maxcols, TY_CHAR) + + colnum = 0 # initial values + ip = 1 + done = false + pform[1] = EOS # not set by this routine + units[1] = EOS + + # Do for each word in the string. + while ( !done ) { + + ip_start = ip + word_width = tbbwrd (buf, ip, Memc[word], SZ_LINE, + width, precision, datatype, fcode) + + if (word_width < 1) { + done = true # we're past the last word + + } else if (Memc[word] == ',') { + ; # ignore commas in first line + } else { + colnum = colnum + 1 + call sprintf (cname, SZ_COLNAME, "c%d") + call pargi (colnum) + + # This is to allow the user to increase the width by adding + # extra space in the first row. Subtract one for columns + # after the first because we're going to print a space + # between each column. + if (colnum > 1) + width = max (width, ip - ip_start - 1) + else + width = max (width, ip - ip_start) + + # For a character string set the data type to -N. + # Changed by PEH on 1994 June 6; the width used to be + # increased by 20 to allow extra space. + if (datatype == TY_CHAR) + datatype = -min (width, SZ_LINE) + + # Allocate a descriptor for the column, update TB_MAXCOLS(tp), + # and allocate & initialize a buffer for storing values. + call tbcadd (tp, cp, cname, units, pform, datatype, 1, 1) + + # Reallocate space for column widths and precision. + if (colnum > maxcols) { + maxcols = TB_MAXCOLS(tp) + call realloc (wid, maxcols, TY_INT) + call realloc (prec, maxcols, TY_INT) + call realloc (fmt_code, maxcols, TY_CHAR) + } + + # Save values of width, precision and format code. The latter + # is really only used (by tbzopn) for h, m, and g formats. + Memi[wid+colnum-1] = width + Memi[prec+colnum-1] = precision + Memc[fmt_code+colnum-1] = fcode + } + } + + call sfree (sp) +end diff --git a/pkg/tbtables/tbzcp.x b/pkg/tbtables/tbzcp.x new file mode 100644 index 00000000..6157d18a --- /dev/null +++ b/pkg/tbtables/tbzcp.x @@ -0,0 +1,149 @@ +include "tbtables.h" + +# tbzcp[tbirds] -- put values into a column +# This procedure puts elements into an internal buffer corresponding +# to values in a text file. +# +# Phil Hodge, 3-Feb-1992 Subroutines created. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 4-Mar-1998 Remove calls to tbtwer. +# Phil Hodge, 5-Mar-1998 In tbzcpt, remove lenstr from call to tbzptt. + +procedure tbzcpb (tp, cp, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +bool buffer[ARB] # i: buffer containing values to be put +int firstrow # i: number of first row to put +int lastrow # i: number of last row to put +#-- +int row # loop index for row number +int k # index into buffer +errchk tbzptb + +begin + k = 1 + do row = firstrow, lastrow { + call tbzptb (tp, cp, row, buffer[k]) + k = k + 1 + } +end + +procedure tbzcpd (tp, cp, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +double buffer[ARB] # i: buffer containing values to be put +int firstrow # i: number of first row to put +int lastrow # i: number of last row to put +#-- +int row # loop index for row number +int k # index into buffer +errchk tbzptd + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + k = 1 + do row = firstrow, lastrow { + Memd[COL_OFFSET(cp) + row - 1] = buffer[k] + k = k + 1 + } + + } else { + k = 1 + do row = firstrow, lastrow { + call tbzptd (tp, cp, row, buffer[k]) + k = k + 1 + } + } +end + +procedure tbzcpr (tp, cp, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +real buffer[ARB] # i: buffer containing values to be put +int firstrow # i: number of first row to put +int lastrow # i: number of last row to put +#-- +int row # loop index for row number +int k # index into buffer +errchk tbzptr + +begin + k = 1 + do row = firstrow, lastrow { + call tbzptr (tp, cp, row, buffer[k]) + k = k + 1 + } +end + +procedure tbzcpi (tp, cp, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int buffer[ARB] # i: buffer containing values to be put +int firstrow # i: number of first row to put +int lastrow # i: number of last row to put +#-- +int row # loop index for row number +int k # index into buffer +errchk tbzpti + +begin + if (COL_DTYPE(cp) == TBL_TY_INT) { + k = 1 + do row = firstrow, lastrow { + Memi[COL_OFFSET(cp) + row - 1] = buffer[k] + k = k + 1 + } + + } else { + k = 1 + do row = firstrow, lastrow { + call tbzpti (tp, cp, row, buffer[k]) + k = k + 1 + } + } +end + +procedure tbzcps (tp, cp, buffer, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +short buffer[ARB] # i: buffer containing values to be put +int firstrow # i: number of first row to put +int lastrow # i: number of last row to put +#-- +int row # loop index for row number +int k # index into buffer +errchk tbzpts + +begin + k = 1 + do row = firstrow, lastrow { + call tbzpts (tp, cp, row, buffer[k]) + k = k + 1 + } +end + +procedure tbzcpt (tp, cp, buffer, lenstr, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +char buffer[lenstr,ARB] # i: buffer containing values to be put +int lenstr # i: size of each element +int firstrow # i: number of first row to put +int lastrow # i: number of last row to put +#-- +int row # loop index for row number +int k # index into buffer +errchk tbzptt + +begin + k = 1 + do row = firstrow, lastrow { + call tbzptt (tp, cp, row, buffer[1,k]) + k = k + 1 + } +end diff --git a/pkg/tbtables/tbzd2t.x b/pkg/tbtables/tbzd2t.x new file mode 100644 index 00000000..63160cd7 --- /dev/null +++ b/pkg/tbtables/tbzd2t.x @@ -0,0 +1,75 @@ +include # for MAX_DIGITS, NDIGITS_DP and SZB_CHAR +include "tbtables.h" + +# tbzd2t -- convert column of type double to text +# When reading a text table into memory, if non-numeric text is found in +# a column of type double, this routine may be called to convert the +# data type to text. +# +# Phil Hodge, 7-Jun-1994 Subroutine created. +# Phil Hodge, 10-Aug-1994 Update COL_LEN. + +procedure tbzd2t (tp, cp, width, precision, fmt_code) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int width # i: the maximum width for this column +int precision # i: the precision for writing this column +char fmt_code # i: format code for print format +#-- +pointer sp +pointer pform # scratch for print format for this column +pointer new # pointer to new memory for column data +int wid, prec # width & precision, modified for print format +int row # row number +int op # offset in new char array +errchk calloc + +begin + call smark (sp) + call salloc (pform, SZ_FNAME, TY_CHAR) + + # Assign the print format for writing previous values into + # the text strings. Left justify. + Memc[pform] = '%' + Memc[pform+1] = '-' + + wid = min (width, MAX_DIGITS) + prec = precision + if (fmt_code == 'g') + prec = max (prec, wid-2) # maximum precision + prec = min (prec, NDIGITS_DP) + call sprintf (Memc[pform+2], SZ_FNAME-2, "%d.%d%c") + call pargi (wid) + call pargi (prec) + call pargc (fmt_code) + + # Allocate memory for the array of strings. Note that we use + # width rather than wid. + call calloc (new, (width+1) * TB_ALLROWS(tp), TY_CHAR) + + op = 0 # initial value + + # Copy each row. + do row = 1, TB_NROWS(tp) { + + if (IS_INDEFD(Memd[COL_OFFSET(cp)+row-1])) { + Memc[new+op] = EOS + } else { + call sprintf (Memc[new+op], width, Memc[pform]) + call pargd (Memd[COL_OFFSET(cp) + row - 1]) + } + + op = op + width + 1 # add one for EOS + } + + # Free the old memory, and save the new pointer. + call mfree (COL_OFFSET(cp), TY_DOUBLE) + COL_OFFSET(cp) = new + + # Specify the new data type and width. + COL_DTYPE(cp) = -width + COL_LEN(cp) = (width + SZB_CHAR-1) / SZB_CHAR + + call sfree (sp) +end diff --git a/pkg/tbtables/tbzgt.x b/pkg/tbtables/tbzgt.x new file mode 100644 index 00000000..63b421d9 --- /dev/null +++ b/pkg/tbtables/tbzgt.x @@ -0,0 +1,235 @@ +include # for MAX_INT and MAX_SHORT +include +include "tbtables.h" + +# tbzgt[tbirds] -- get a single element +# This procedure gets a single element from an internal buffer corresponding +# to a value in a text file. +# +# Phil Hodge, 14-Jan-1992 Subroutines created. +# Phil Hodge, 10-Feb-1993 Change "NO" to "false" in tbzgtb. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 12-Aug-1993 Use ctol instead of ctoi to allow leading "+" sign. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. + +procedure tbzgtb (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +bool buffer # o: buffer for value to be gotten +#-- +pointer sp +pointer cbuf # buffer for copying character elements +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc +int ctowrd() +bool streq() + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + buffer = (nint (Memd[COL_OFFSET(cp) + rownum - 1]) != NO) + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + buffer = (Memi[COL_OFFSET(cp) + rownum - 1] != NO) + + } else { # string + call smark (sp) + call salloc (cbuf, SZ_FNAME, TY_CHAR) + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = (rownum - 1) * lenstr + 1 + if (ctowrd (Memc[COL_OFFSET(cp)], ip, Memc[cbuf], SZ_FNAME) < 1) { + buffer = false # bug fix 10-Feb-1993 PEH + } else { + call strlwr (Memc[cbuf]) + buffer = streq (Memc[cbuf], "yes") || + streq (Memc[cbuf], "true") + } + call sfree (sp) + } +end + +procedure tbzgtd (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +double buffer # o: buffer for value to be gotten +#-- +int ival # buffer for integer value +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc +int ctod() + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + buffer = Memd[COL_OFFSET(cp) + rownum - 1] + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + ival = Memi[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFI(ival)) + buffer = INDEFD + else + buffer = ival + + } else { # string + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = (rownum - 1) * lenstr + 1 + if (ctod (Memc[COL_OFFSET(cp)], ip, buffer) < 1) + buffer = INDEFD + } +end + +procedure tbzgtr (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +real buffer # o: buffer for value to be gotten +#-- +double dval # buffer for double precision +int ival # buffer for integer value +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc +int ctor() + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + dval = Memd[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFD(dval)) + buffer = INDEFR + else + buffer = dval + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + ival = Memi[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFI(ival)) + buffer = INDEFR + else + buffer = ival + + } else { # string + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = (rownum - 1) * lenstr + 1 + if (ctor (Memc[COL_OFFSET(cp)], ip, buffer) < 1) + buffer = INDEFR + } +end + +procedure tbzgti (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +int buffer # o: buffer for value to be gotten +#-- +double dval # buffer for double precision +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc +long lval # so we can use ctol +int ctol() + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + dval = Memd[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFD(dval) || (abs (dval) > MAX_INT)) + buffer = INDEFI + else + buffer = nint (dval) + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + buffer = Memi[COL_OFFSET(cp) + rownum - 1] + + } else { # string + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = (rownum - 1) * lenstr + 1 + if (ctol (Memc[COL_OFFSET(cp)], ip, lval) > 0) + buffer = lval + else + buffer = INDEFI +#*** if (ctoi (Memc[COL_OFFSET(cp)], ip, buffer) < 1) +#*** buffer = INDEFI + } +end + +procedure tbzgts (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +short buffer # o: buffer for value to be gotten +#-- +double dval # buffer for double precision +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc +int ival +long lval # so we can use ctol +int ctol() + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + dval = Memd[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFD(dval) || (abs (dval) > MAX_SHORT)) + buffer = INDEFS + else + buffer = nint (dval) + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + ival = Memi[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFI(ival) || (abs (ival) > MAX_SHORT)) + buffer = INDEFS + else + buffer = ival + + } else { # string + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = (rownum - 1) * lenstr + 1 + if (ctol (Memc[COL_OFFSET(cp)], ip, lval) > 0) { + if (abs (lval) > MAX_SHORT) + buffer = INDEFS + else + buffer = lval + } else { + buffer = INDEFS + } + } +end + +procedure tbzgtt (tp, cp, rownum, buffer, maxch) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +char buffer[ARB] # o: buffer for value to be gotten +int maxch # i: size of buffer +#-- +double dval # buffer for double precision +int ival # buffer for integer value +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + dval = Memd[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFD(dval)) { + call strcpy ("INDEF", buffer, maxch) + } else { + call sprintf (buffer, maxch, COL_FMT(cp)) + call pargd (dval) + } + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + ival = Memi[COL_OFFSET(cp) + rownum - 1] + if (IS_INDEFI(ival)) { + call strcpy ("INDEF", buffer, maxch) + } else { + call sprintf (buffer, maxch, COL_FMT(cp)) + call pargi (ival) + } + + } else { # string + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = (rownum - 1) * lenstr + call strcpy (Memc[COL_OFFSET(cp) + ip], buffer, maxch) + } +end diff --git a/pkg/tbtables/tbzi2d.x b/pkg/tbtables/tbzi2d.x new file mode 100644 index 00000000..fb7466bd --- /dev/null +++ b/pkg/tbtables/tbzi2d.x @@ -0,0 +1,41 @@ +include "tbtables.h" + +# tbzi2d -- convert integer column to double +# When reading a text table into memory, if a floating-point value is +# found in a column of type integer, this routine may be called to convert +# the data type to double precision. +# +# Phil Hodge, 7-Jun-1994 Subroutine created. +# Phil Hodge, 10-Aug-1994 Update COL_LEN. + +procedure tbzi2d (tp, cp) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +#-- +pointer new # pointer to new memory for column data +int row # row number +errchk malloc + +begin + # Allocate memory for the array of doubles. + call malloc (new, TB_ALLROWS(tp), TY_DOUBLE) + + # Copy each row. + do row = 1, TB_NROWS(tp) { + + if (IS_INDEFI(Memi[COL_OFFSET(cp)+row-1])) { + Memd[new+row-1] = INDEFD + } else { + Memd[new+row-1] = Memi[COL_OFFSET(cp) + row - 1] + } + } + + # Free the old memory, and save the new pointer. + call mfree (COL_OFFSET(cp), TY_INT) + COL_OFFSET(cp) = new + + # Specify the new data type and length. + COL_DTYPE(cp) = TBL_TY_DOUBLE + COL_LEN(cp) = SZ_DOUBLE +end diff --git a/pkg/tbtables/tbzi2t.x b/pkg/tbtables/tbzi2t.x new file mode 100644 index 00000000..5ce65996 --- /dev/null +++ b/pkg/tbtables/tbzi2t.x @@ -0,0 +1,49 @@ +include # for SZB_CHAR +include "tbtables.h" + +# tbzi2t -- convert integer column to text +# When reading a text table into memory, if non-numeric text is found in +# a column of type integer, this routine may be called to convert the +# data type to text. +# +# Phil Hodge, 7-Jun-1994 Subroutine created. +# Phil Hodge, 10-Aug-1994 Update COL_LEN. + +procedure tbzi2t (tp, cp, width) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int width # i: the maximum width for this column +#-- +pointer new # pointer to new memory for column data +int row # row number +int op # offset in new char array +errchk calloc + +begin + # Allocate memory for the array of strings. + call calloc (new, (width+1) * TB_ALLROWS(tp), TY_CHAR) + + op = 0 # initial value + + # Copy each row. + do row = 1, TB_NROWS(tp) { + + if (IS_INDEFI(Memi[COL_OFFSET(cp)+row-1])) { + Memc[new+op] = EOS + } else { + call sprintf (Memc[new+op], width, "%d") + call pargi (Memi[COL_OFFSET(cp) + row - 1]) + } + + op = op + width + 1 # add one for EOS + } + + # Free the old memory, and save the new pointer. + call mfree (COL_OFFSET(cp), TY_INT) + COL_OFFSET(cp) = new + + # Specify the new data type and width. + COL_DTYPE(cp) = -width + COL_LEN(cp) = (width + SZB_CHAR-1) / SZB_CHAR +end diff --git a/pkg/tbtables/tbzkey.x b/pkg/tbtables/tbzkey.x new file mode 100644 index 00000000..e619bfc7 --- /dev/null +++ b/pkg/tbtables/tbzkey.x @@ -0,0 +1,70 @@ +include "tbtables.h" +include "tbltext.h" + +# tbzkey -- append to list of keywords +# This routine takes a line of text containing a keyword definition for +# a text table, allocates memory for a new keyword entry, and adds it to +# the list of keywords. +# +# The input string (str) must begin with "#k " or "#K "; this is not +# checked here. +# +# The parnum argument can either be zero or a specific keyword number. +# parnum = 0 means that the string contains a new keyword which is to be +# appended at the end of the current list of keywords; TB_NPAR will be +# incremented in this case. If parnum is greater than zero, it is the +# number of a keyword that is to be replaced, so it must be within the +# range of existing keywords; however, parnum = TB_NPAR + 1 is allowed, +# and it just means append a new keyword. +# +# If the keyword buffer is not long enough it will be reallocated. + +# Phil Hodge, 7-Jun-1999 Subroutine created. + +procedure tbzkey (tp, str, parnum) + +pointer tp # i: pointer to table descriptor +char str[ARB] # i: string containing keyword definition +int parnum # i: parameter number, or zero to append a new one +#-- +int keynum # = parnum or TB_NPAR + 1 +int in_len # length of input string +int strlen() +errchk tbtchs + +begin + if (str[1] == EOS) + return + + if (parnum > 0) { + if (parnum > TB_NPAR(tp) + 1) + call error (1, "tbzkey: keyword number is out of range") + keynum = parnum # write a specific one + } else { + keynum = TB_NPAR(tp) + 1 # append a new one + } + + # Allocate or reallocate the array of keywords, if necessary. + if (TB_KEYLIST_PTR(tp) == NULL || keynum > TB_MAXPAR(tp)) + call tbtchs (tp, TB_NPAR(tp) + INCR_N_KEYWORDS, -1, -1, -1) + + # If we're replacing an existing keyword, free the previous memory. + if (keynum <= TB_NPAR(tp)) { + if (TB_KEYWORD(tp,keynum) != NULL) + call mfree (TB_KEYWORD(tp,keynum), TY_CHAR) + } + + # Allocate space for a new entry, and copy the input string. + in_len = strlen (str) + call malloc (TB_KEYWORD(tp,keynum), in_len, TY_CHAR) + call strcpy (str, Memc[TB_KEYWORD(tp,keynum)], in_len) + + # chop off newline, if present + if (str[in_len] == '\n') + Memc[TB_KEYWORD(tp,keynum)+in_len-1] = EOS + + if (keynum > TB_NPAR(tp)) + TB_NPAR(tp) = keynum + + TB_MODIFIED(tp) = true +end diff --git a/pkg/tbtables/tbzlin.x b/pkg/tbtables/tbzlin.x new file mode 100644 index 00000000..7ab68e94 --- /dev/null +++ b/pkg/tbtables/tbzlin.x @@ -0,0 +1,190 @@ +include +include +include "tbltext.h" + +# tbzlin -- get next line from text file +# This routine calls getlline (get long line) to get a line from a text file. +# The line_type indicates what type of line (comment, data, etc) was read. +# If the input line is data rather than a comment, the returned line will +# be terminated by EOS rather than by '\n'. If the line is a comment, the +# entire line (including newline) is returned. In the case of in-line +# comments, if there are non-whitespace characters preceding the '#' they +# will be returned, and the '#' will be replaced by EOS. A '#' which is +# enclosed in quotes (single or double) or preceded by '\' will not be +# counted as a comment character. A newline terminates the string regardless +# of what precedes or follows it; a newline within a string is an error, +# though. The function value is the number of characters preceding the EOS, +# or EOF is returned when the end of file is reached. +# +# The buffer is scanned to be sure it contains a '\n'. If not, we haven't +# read the entire line (i.e. it's longer than maxch); we regard that as +# a serious error. +# +# Phil Hodge, 6-Feb-1992 Function created. +# Phil Hodge, 19-Jan-1995 Allow continuation lines. +# Phil Hodge, 26-Dec-1995 Errchk getlline. +# Phil Hodge, 21-Apr-1999 Change error message if newline not found; +# allow last line of file to not have a newline. +# Phil Hodge, 7-Jun-1999 Change last argument from comment flag (bool) +# to line type (int); add line, and increment. + +int procedure tbzlin (fd, buf, maxch, line, line_type) + +int fd # i: fd for the file +char buf[ARB] # o: buffer for the line that was read +int maxch # i: size of line buffer +int line # io: incremented each time a line is read from file +int line_type # o: type of line returned in buf +#-- +pointer sp +pointer scratch +char ch # a character from the string which was read +int ip # counter for a character in the string +int nchar # number of char read by getlline +bool done # loop-termination flag +bool at_end # true when we reach the end of the line ('\n') +bool odd_squotes # true if current character is within quoted string +bool odd_dquotes # true if current char is within double quoted string +int getlline(), strlen(), strncmp() +errchk getlline + +begin + line_type = COMMENT_LINE # default + + nchar = getlline (fd, buf, maxch) + if (nchar == EOF) + return (EOF) # end of file reached + line = line + 1 + + # Check for special cases. + + done = false + if (strncmp (buf, "#k ", 3) == 0 || + strncmp (buf, "#K ", 3) == 0) { + line_type = KEYWORD_LINE + done = true + } else if ((strncmp (buf, "#c ", 3) == 0 || + strncmp (buf, "#C ", 3) == 0) && nchar > 4) { + # the test on nchar is because a column name must be specified + line_type = COLDEF_LINE + done = true + } + if (done) { + if (buf[nchar] == NEWLINE) { + buf[nchar] = EOS + nchar = nchar - 1 + } + return (nchar) + } + + # Blank up through maxch? Treat it as a comment. + ip = 1 + while (IS_WHITE(buf[ip]) && ip < maxch) # skip whitespace + ip = ip + 1 + if (ip >= maxch) + line_type = COMMENT_LINE + else if (buf[ip] == NEWLINE || buf[ip] == '#' || buf[ip] == EOS) + line_type = COMMENT_LINE + else + line_type = DATA_LINE + + # If there's no newline, and if this is not the last line of the + # file, we haven't read the entire line (i.e. it's longer than the + # buffer size). + # Also check whether the newline has been escaped, in which case + # we need to read further lines and concatenate them. + done = false + while (!done) { + ip = strlen (buf) + if (buf[ip] != NEWLINE) { + # The last line of the file need not have a newline. + call smark (sp) + call salloc (scratch, 2*SZ_LINE, TY_CHAR) + nchar = getlline (fd, Memc[scratch], 2*SZ_LINE) + if (nchar != EOF) { + call error (1, + "Unknown table type, or line too long for text file.") + } + call sfree (sp) + break + } + done = true # may be reset below + if (ip > 1) { + if (buf[ip-1] == ESCAPE) { # newline is escaped + done = false + # Read another line, clobbering the '\' and newline. + ip = ip - 1 # now points to the '\' + nchar = getlline (fd, buf[ip], maxch-ip) + line = line + 1 + + if (line_type == COMMENT_LINE) { + # Remove comment character from continuation line. + while (IS_WHITE(buf[ip]) && ip < maxch) + ip = ip + 1 + if (buf[ip] == '#') + buf[ip] = ' ' + } + } + } + } + + if (line_type != COMMENT_LINE) { + + # The current line is not a comment or blank; + # replace '\n' or '#' by EOS. + + # Skip leading whitespace and check whether the first character + # begins a quoted string. + ip = 1 + while (IS_WHITE(buf[ip]) && ip < maxch) + ip = ip + 1 + if (buf[ip] == SQUOTE) + odd_squotes = true + else + odd_squotes = false + if (buf[ip] == DQUOTE) + odd_dquotes = true + else + odd_dquotes = false + + ip = ip + 1 + at_end = false + while ( !at_end ) { + ch = buf[ip] + # Check for end of buffer or newline or in-line comment. + if (ch == NEWLINE) { + buf[ip] = EOS + at_end = true + } else if (ch == SQUOTE) { + # Toggle flag for in/out of quoted string. + odd_squotes = !odd_squotes + ip = ip + 1 + } else if (ch == DQUOTE) { + odd_dquotes = !odd_dquotes + ip = ip + 1 + } else if (ch == '#') { + # '#' is not a comment if it's in a quoted string + if (odd_squotes || odd_dquotes) { + ip = ip + 1 + # ... or if it's escaped. + } else if (buf[ip-1] == ESCAPE) { + ip = ip + 1 + } else { # it's an in-line comment + buf[ip] = EOS + at_end = true + } + } else if (ch == EOS) { + at_end = true + } else if (ip >= maxch) { # end of buffer reached + at_end = true # (can't get here) + buf[maxch+1] = EOS + } else { + ip = ip + 1 + } + } + if (odd_squotes || odd_dquotes) + call error (1, "tbzlin: newline within string") + nchar = ip - 1 + } + return (nchar) +end diff --git a/pkg/tbtables/tbzmem.x b/pkg/tbtables/tbzmem.x new file mode 100644 index 00000000..833b3b8e --- /dev/null +++ b/pkg/tbtables/tbzmem.x @@ -0,0 +1,300 @@ +include +include +include "tbtables.h" + +define NUM_EXTRA 1000 # number of extra "rows" when reallocating + +# This file contains tbzmem, tbzmex, and tbzpbt. + +# tbzmem -- read values from string +# This routine reads the values out of a line from a text file and puts +# them into memory. +# The variable wid is an array (one element for each column) giving the +# width of each column in the input file. This width will be used to set +# the print format; both the width and precision are affected. The value +# for each column is updated by this routine whenever the width is greater +# than the value from previous rows. +# The variable line is passed to this routine only for possible use in +# error messages. +# +# The allocated number of rows (i.e. the size of the internal buffers for +# values read from the text file) will be increased if necessary. + +# Phil Hodge, 15-Jan-1992 Subroutine created. +# Phil Hodge, 7-Aug-1992 Add fcode to calling sequence for tbbwrd. +# Phil Hodge, 6-Dec-1992 Add line to calling sequence for error messages. +# Phil Hodge, 7-Jun-1994 If different data type from first row, change type; +# include fmt_code in calling sequence; possibly update +# format code (e.g. 'g' to 'h') for type double. +# Phil Hodge, 30-Apr-1996 Replace call to tbzptt with tbzpbt (in this file). +# Phil Hodge, 7-Jun-1999 tbzmex added, based on tbzmem; +# in tbzpbt, call tbtchs instead of tbzsiz. + +procedure tbzmem (tp, buf, row, line, wid, prec, fmt_code) + +pointer tp # i: pointer to table descriptor +char buf[ARB] # i: buffer containing line from file +int row # i: row number +int line # i: line number in input file +int wid[ARB] # io: width of each column +int prec[ARB] # io: precision of each column +char fmt_code[ARB] # io: format code +#-- +pointer sp +pointer word # scratch for a word from the line +pointer message # scratch for possible error message +pointer cp # pointer to column descriptor +int colnum # column number +int ip # for ctowrd +int word_width # value returned by ctowrd (called by tbbwrd) +int width # actual width of current word +int precision # actual precision of current word +int datatype # data type of current word +int fcode # format code from tbbwrd +bool done # loop-termination flag +int strncmp(), tbbwrd() +errchk tbzpbt + +begin + call smark (sp) + call salloc (word, SZ_LINE, TY_CHAR) + + colnum = 0 # initial values + ip = 1 + done = false + + # Do for each word in the string. + while ( !done ) { + + word_width = tbbwrd (buf, ip, Memc[word], SZ_LINE, + width, precision, datatype, fcode) + +call eprintf ("tbzmem: word_width=%d colnum=%d NCOLS=%d\n") + call pargi (word_width) ; call pargi (colnum) ; call pargi (TB_NCOLS(tp)) + if (word_width > 0) { + + colnum = colnum + 1 + + if (colnum > TB_NCOLS(tp)) { + call salloc (message, SZ_LINE, TY_CHAR) + call sprintf (Memc[message], SZ_LINE, + "column found in line %d that was not defined in first row") + call pargi (line) + call error (1, Memc[message]) + } + + # Check whether the current word is too long. + if (width > SZ_LINE-1) { + call salloc (message, SZ_LINE, TY_CHAR) + call sprintf (Memc[message], SZ_LINE, + "string in line %d is too long for a table; the maximum is %s") + call pargi (line) + call pargi (SZ_LINE-1) + call error (1, Memc[message]) + } + + # Update values of width and prec gotten from previous rows. + wid[colnum] = max (wid[colnum], width) + prec[colnum] = max (prec[colnum], precision) + + # A comma after whitespace means a column value is not given. + if (Memc[word] != ',') { + + # Check whether current word is consistent with + # the data type of the column. + cp = TB_COLINFO(tp,colnum) + if (COL_DTYPE(cp) < 0) { # string; check length + + if (width > -COL_DTYPE(cp)) + # Allocated width is too small; increase it. + call tbzt2t (tp, cp, wid[colnum]) + + } else if (datatype == TY_CHAR) { + + # Change data type to text. + if (COL_DTYPE(cp) == TY_DOUBLE) + call tbzd2t (tp, cp, wid[colnum], + prec[colnum], fmt_code[colnum]) + else if (COL_DTYPE(cp) == TY_INT) + call tbzi2t (tp, cp, wid[colnum]) + + # Change the code for print format. + fmt_code[colnum] = 's' + + } else if (COL_DTYPE(cp) == TBL_TY_INT && + datatype == TY_DOUBLE) { + + # Change data type to double. (but INDEF is numeric) + if (strncmp (Memc[word], "INDEF", 5) != 0) + call tbzi2d (tp, cp) + + } + + # Possibly update the format code: d --> g --> m --> h + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + if (fcode == 'h') { + if (fmt_code[colnum] == 'g') + prec[colnum] = + max (precision, prec[colnum]-6, 1) + fmt_code[colnum] = fcode + } else if (fcode == 'm' && fmt_code[colnum] != 'h') { + if (fmt_code[colnum] == 'g') + prec[colnum] = + max (precision, prec[colnum]-4, 1) + fmt_code[colnum] = fcode + } else if (fcode == 'g' && fmt_code[colnum] == 'd') { + fmt_code[colnum] = fcode + } + } + + # Save the value in the buffer for this column. + call tbzpbt (tp, cp, row, Memc[word]) + } + + # If a comma was used as a separator, skip over it. + if (Memc[word+word_width] == ',') + ip = ip + 1 + } else { + done = true # we're past the last word + } + } + + call sfree (sp) +end + +# tbzmex -- read values from string +# This routine reads the values out of a line from a text file and puts +# them into memory. +# +# This version is for tables with explicit column definitions. +# +# The variable line is passed to this routine only for possible use in +# error messages. + +procedure tbzmex (tp, buf, row, line) + +pointer tp # i: pointer to table descriptor +char buf[ARB] # i: buffer containing line from file +int row # i: row number +int line # i: line number in input file +#-- +pointer sp +pointer word # scratch for a word from the line +pointer message # scratch for possible error message +pointer cp # pointer to column descriptor +int colnum # column number +bool done # loop-termination flag +# word_width is returned by ctowrd and will count the enclosing quotes, +# if there are any, while len is the actual length of the column entry +int word_width, len, strlen() +int ip, ctowrd() +bool strne() +errchk tbzpbt + +begin + call smark (sp) + call salloc (word, SZ_LINE, TY_CHAR) + + colnum = 0 # initial values + ip = 1 + done = false + + # Do for each word in the string. + while ( !done ) { + + word_width = ctowrd (buf, ip, Memc[word], SZ_LINE) + + if (word_width > 0) { + + len = strlen (Memc[word]) + + colnum = colnum + 1 + + if (colnum > TB_NCOLS(tp)) { + call salloc (message, SZ_LINE, TY_CHAR) + call sprintf (Memc[message], SZ_LINE, + "column was found that was not explicitly defined (line %d)") + call pargi (line) + call error (1, Memc[message]) + } + + # Check whether the current word is too long. + if (len > SZ_LINE-1) { + call salloc (message, SZ_LINE, TY_CHAR) + call sprintf (Memc[message], SZ_LINE, + "string in line %d is too long for a table; the maximum is %s") + call pargi (line) + call pargi (SZ_LINE-1) + call error (1, Memc[message]) + } + + # A comma after whitespace means a column value was not given. + if (strne (Memc[word], ',')) { + + # Check whether current word is consistent with + # the data type of the column. + cp = TB_COLINFO(tp,colnum) + + # If a comma was used as a separator, trim it. + if (COL_DTYPE(cp) > 0 && Memc[word+len-1] == ',') + Memc[word+len-1] = EOS + + # Save the value in the buffer for this column. + call tbzpbt (tp, cp, row, Memc[word]) + } + + } else { + done = true # we're past the last word + } + } + + call sfree (sp) +end + +# tbzpbt -- copy text string into internal buffer +# This routine is based on tbzptt. The latter calls tbtwer to ensure +# that the buffers are large enough (i.e. TB_ALLROWS >= rownum) and to +# update TB_NROWS. We want to avoid tbtwer because it sets TB_MODIFIED +# to true. tbzpbt reallocates the buffers if rownum > TB_ALLROWS, and +# it updates TB_NROWS if appropriate. + +procedure tbzpbt (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +char buffer[ARB] # i: value to be put +#-- +int lenstr # length of a string table element +int ip # offset to a string in Memc +long lval # so we can use ctol +int ctod(), ctol() +errchk tbtchs + +begin + # Increase the size of buffers for storing column values, if necessary. + # (TB_MAXPAR remains unchanged.) + if (rownum > TB_ALLROWS(tp)) + call tbtchs (tp, -1, -1, -1, rownum + NUM_EXTRA) + + # If we're writing beyond EOF, update TB_NROWS. + TB_NROWS(tp) = max (TB_NROWS(tp), rownum) + + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + ip = 1 + if (ctod (buffer, ip, Memd[COL_OFFSET(cp) + rownum - 1]) < 1) + Memd[COL_OFFSET(cp) + rownum - 1] = INDEFD + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + ip = 1 + if (ctol (buffer, ip, lval) > 0) + Memi[COL_OFFSET(cp) + rownum - 1] = lval + else + Memi[COL_OFFSET(cp) + rownum - 1] = INDEFI + + } else { # string + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + call strcpy (buffer, Memc[COL_OFFSET(cp) + ip], lenstr) + } +end diff --git a/pkg/tbtables/tbznew.x b/pkg/tbtables/tbznew.x new file mode 100644 index 00000000..21798ad9 --- /dev/null +++ b/pkg/tbtables/tbznew.x @@ -0,0 +1,50 @@ +include "tbtables.h" +include "tbltext.h" + +# tbznew -- Create a new table +# This opens the file for a new table of type text file. +# It also allocates memory for each column for storing the column values +# while the table is open. +# +# Phil Hodge, 14-Jan-1992 Subroutine created. +# Phil Hodge, 5-Mar-1993 Check if comment buffer is already allocated. +# Phil Hodge, 7-Jun-1999 Allocate space for the list of keywords. + +procedure tbznew (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer cp # pointer to a column descriptor +int colnum # column number +int fd # fd for table file +int open() +errchk open, tbzadd + +begin + # This was split into two lines so that if the open fails, + # TB_FILE(tp) will be unchanged (should be NULL). + fd = open (TB_NAME(tp), TB_IOMODE(tp), TEXT_FILE) + TB_FILE(tp) = fd + + # If a size hasn't been set for the number of rows, assign a default. + if (TB_ALLROWS(tp) < 1) + TB_ALLROWS(tp) = 100 # default value + + # Allocate memory for each column. + do colnum = 1, TB_NCOLS(tp) { + cp = TB_COLINFO(tp,colnum) + call tbzadd (tp, cp) + } + + # Allocate space for the list of keywords. + if (TB_MAXPAR(tp) <= 0) + TB_MAXPAR(tp) = INCR_N_KEYWORDS + call calloc (TB_KEYLIST_PTR(tp), TB_MAXPAR(tp), TY_POINTER) + + # Allocate space for the comment buffer. + if (TB_COMMENT(tp) == NULL) { + call calloc (TB_COMMENT(tp), SZ_LINE, TY_CHAR) + TB_SZ_COMMENT(tp) = SZ_LINE + Memc[TB_COMMENT(tp)] = EOS + } +end diff --git a/pkg/tbtables/tbznll.x b/pkg/tbtables/tbznll.x new file mode 100644 index 00000000..2f45b88d --- /dev/null +++ b/pkg/tbtables/tbznll.x @@ -0,0 +1,56 @@ +include "tbtables.h" +include "tblerr.h" + +# tbznll -- set rows to null +# This procedure sets all columns in a range of rows to INDEF. +# If the first row to be deleted is greater than the last row, or if +# the range of rows is outside the allocated size of the table, nothing +# is done. It is not considered an error if the first row is less than +# one or the last row is greater than the number of allocated rows in +# the table. +# +# Phil Hodge, 3-Feb-1992 Subroutine created. + +procedure tbznll (tp, firstrow, lastrow) + +pointer tp # i: pointer to table descriptor +int firstrow # i: first row to be set to INDEF +int lastrow # i: last row to be set to INDEF +#-- +pointer cp # pointer to a column descriptor +int row1, row2 # firstrow, lastrow truncated to 1, nrows +int row # loop index for row number +int col # loop index for column number +int datatype # data type of a column +int lenstr # length of a string table element +int ip # offset to a string in Memc +pointer tbcnum() + +begin + row1 = max (1, firstrow) + row2 = min (TB_ALLROWS(tp), lastrow) + + # Set each column value in each row to INDEF. + do col = 1, TB_NCOLS(tp) { + cp = tbcnum (tp, col) + datatype = COL_DTYPE(cp) + + if (datatype == TBL_TY_DOUBLE) { + do row = row1, row2 + Memd[COL_OFFSET(cp) + row - 1] = INDEFD + + } else if (datatype == TBL_TY_INT) { + do row = row1, row2 + Memi[COL_OFFSET(cp) + row - 1] = INDEFI + + } else if (datatype < 0) { + do row = row1, row2 { + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (row - 1) * (lenstr + 1) # including EOS + Memc[COL_OFFSET(cp) + ip] = EOS + } + } else { + call error (ER_TBCOLBADTYP, "tbznll: bad datatype") + } + } +end diff --git a/pkg/tbtables/tbzopn.x b/pkg/tbtables/tbzopn.x new file mode 100644 index 00000000..32a05949 --- /dev/null +++ b/pkg/tbtables/tbzopn.x @@ -0,0 +1,70 @@ +include +include "tbtables.h" +include "tbltext.h" + +# tbzopn -- read an existing text file into memory +# +# Phil Hodge, 14-Jan-1992 Subroutine created. +# Phil Hodge, 6-Dec-1992 Pass line to tbzmem for possible error message. +# Phil hodge, 7-Jun-1994 Pass Memc[fmt_code] to tbzmem. +# Phil Hodge, 10-Aug-1994 Update COL_LEN. +# Phil Hodge, 3-Apr-1995 Use tbcfpt instead of tbcfmt. +# Phil Hodge, 26-Dec-1995 Errchk tbtwer. +# Phil Hodge, 30-Apr-1996 Remove call to tbtwer. +# Phil Hodge, 14-Apr-1998 Use strcpy instead of tbcftp for print format. +# Phil Hodge, 21-Apr-1999 Increase the maximum line length from 1024 to 4096. +# Phil Hodge, 7-Jun-1999 Rewrite, checking for text table subtype. +# Phil Hodge, 29-Mar-2001 Assign a value to TB_ROWLEN and TB_COLUSED. + +procedure tbzopn (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer sp +pointer buf # buffer for input line +int line # counter for line number in input file +int line_type # type of line read by tbzlin +int subtype # text table subtype +int col +int rowlen +pointer cp # pointer to column descriptor +pointer tbcnum() +errchk tbzsub, tbzrds, tbzrdx + +begin + call smark (sp) + call salloc (buf, SZ_TEXTBUF, TY_CHAR) + + line = 0 # incremented later + + # Allocate space for the list of keywords. + if (TB_MAXPAR(tp) <= 0) + TB_MAXPAR(tp) = INCR_N_KEYWORDS + call calloc (TB_KEYLIST_PTR(tp), TB_MAXPAR(tp), TY_POINTER) + + # Allocate space for the comment buffer. + call malloc (TB_COMMENT(tp), SZ_TEXTBUF, TY_CHAR) + TB_SZ_COMMENT(tp) = SZ_TEXTBUF + Memc[TB_COMMENT(tp)] = EOS + + # Determine the subtype of this text table. + call tbzsub (tp, Memc[buf], SZ_TEXTBUF, line, line_type, subtype) + TB_SUBTYPE(tp) = subtype + + # Read the file into memory. + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_SIMPLE) + call tbzrds (tp, Memc[buf], line, line_type) + else if (TB_SUBTYPE(tp) == TBL_SUBTYPE_EXPLICIT) + call tbzrdx (tp, Memc[buf], line, line_type) + + # Compute row length (but not used, except for tbpsta). + rowlen = 0 + do col = 1, TB_NCOLS(tp) { + cp = tbcnum (tp, col) + rowlen = rowlen + COL_LEN(cp) + } + TB_ROWLEN(tp) = rowlen + TB_COLUSED(tp) = rowlen + + call sfree (sp) +end diff --git a/pkg/tbtables/tbzpt.x b/pkg/tbtables/tbzpt.x new file mode 100644 index 00000000..982d5900 --- /dev/null +++ b/pkg/tbtables/tbzpt.x @@ -0,0 +1,219 @@ +include "tbtables.h" + +# tbzpt[tbirds] -- put a single element +# This procedure puts a single element into an internal buffer corresponding +# to a value in a text file. +# +# Phil Hodge, 14-Jan-1992 Subroutines created. +# Phil Hodge, 31-Mar-1993 Include short datatype. +# Phil Hodge, 12-Aug-1993 Use ctol instead of ctoi to allow leading "+" sign. +# Phil Hodge, 4-Mar-1998 Remove calls to tbtwer. + +procedure tbzptb (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +bool buffer # i: value to be put +#-- +int lenstr # length of a string table element +int ip # offset to a string in Memc + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + if (buffer) + Memd[COL_OFFSET(cp) + rownum - 1] = YES + else + Memd[COL_OFFSET(cp) + rownum - 1] = NO + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + if (buffer) + Memi[COL_OFFSET(cp) + rownum - 1] = YES + else + Memi[COL_OFFSET(cp) + rownum - 1] = NO + + } else { # string + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + if (buffer) + call strcpy ("yes", Memc[COL_OFFSET(cp) + ip], lenstr) + else + call strcpy ("no", Memc[COL_OFFSET(cp) + ip], lenstr) + } +end + +procedure tbzptd (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +double buffer # i: value to be put +#-- +char cbuf[SZ_FNAME] # buffer for character elements +int lenstr # length of a string table element +int ip # offset to a string in Memc + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + Memd[COL_OFFSET(cp) + rownum - 1] = buffer + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + if (IS_INDEFD(buffer)) + Memi[COL_OFFSET(cp) + rownum - 1] = INDEFI + else + Memi[COL_OFFSET(cp) + rownum - 1] = nint (buffer) + + } else { # string + if (IS_INDEFD(buffer)) { + call strcpy ("INDEF", cbuf, SZ_FNAME) + } else { + call sprintf (cbuf, SZ_FNAME, "%.16g") + call pargd (buffer) + } + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + call strcpy (cbuf, Memc[COL_OFFSET(cp) + ip], lenstr) + } +end + +procedure tbzptr (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +real buffer # i: value to be put +#-- +char cbuf[SZ_FNAME] # buffer for character elements +int lenstr # length of a string table element +int ip # offset to a string in Memc + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + if (IS_INDEF(buffer)) + Memd[COL_OFFSET(cp) + rownum - 1] = INDEFD + else + Memd[COL_OFFSET(cp) + rownum - 1] = buffer + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + if (IS_INDEF(buffer)) + Memi[COL_OFFSET(cp) + rownum - 1] = INDEFI + else + Memi[COL_OFFSET(cp) + rownum - 1] = nint (buffer) + + } else { # string + if (IS_INDEF(buffer)) { + call strcpy ("INDEF", cbuf, SZ_FNAME) + } else { + call sprintf (cbuf, SZ_FNAME, "%.6g") + call pargr (buffer) + } + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + call strcpy (cbuf, Memc[COL_OFFSET(cp) + ip], lenstr) + } +end + +procedure tbzpti (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +int buffer # i: value to be put +#-- +char cbuf[SZ_FNAME] # buffer for character elements +int lenstr # length of a string table element +int ip # offset to a string in Memc + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + if (IS_INDEFI(buffer)) + Memd[COL_OFFSET(cp) + rownum - 1] = INDEFD + else + Memd[COL_OFFSET(cp) + rownum - 1] = buffer + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + Memi[COL_OFFSET(cp) + rownum - 1] = buffer + + } else { # string + if (IS_INDEFI(buffer)) { + call strcpy ("INDEF", cbuf, SZ_FNAME) + } else { + call sprintf (cbuf, SZ_FNAME, "%d") + call pargi (buffer) + } + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + call strcpy (cbuf, Memc[COL_OFFSET(cp) + ip], lenstr) + } +end + +procedure tbzpts (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +short buffer # i: value to be put +#-- +char cbuf[SZ_FNAME] # buffer for character elements +int lenstr # length of a string table element +int ip # offset to a string in Memc + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + if (IS_INDEFS(buffer)) + Memd[COL_OFFSET(cp) + rownum - 1] = INDEFD + else + Memd[COL_OFFSET(cp) + rownum - 1] = buffer + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + if (IS_INDEFS(buffer)) + Memi[COL_OFFSET(cp) + rownum - 1] = INDEFI + else + Memi[COL_OFFSET(cp) + rownum - 1] = buffer + + } else { # string + if (IS_INDEFS(buffer)) { + call strcpy ("INDEF", cbuf, SZ_FNAME) + } else { + call sprintf (cbuf, SZ_FNAME, "%d") + call pargs (buffer) + } + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + call strcpy (cbuf, Memc[COL_OFFSET(cp) + ip], lenstr) + } +end + +procedure tbzptt (tp, cp, rownum, buffer) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int rownum # i: row number +char buffer[ARB] # i: value to be put +#-- +int lenstr # length of a string table element +int ip # offset to a string in Memc +long lval # so we can use ctol +int ctod(), ctol() + +begin + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + ip = 1 + if (ctod (buffer, ip, Memd[COL_OFFSET(cp) + rownum - 1]) < 1) + Memd[COL_OFFSET(cp) + rownum - 1] = INDEFD + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + ip = 1 + if (ctol (buffer, ip, lval) > 0) + Memi[COL_OFFSET(cp) + rownum - 1] = lval + else + Memi[COL_OFFSET(cp) + rownum - 1] = INDEFI +#*** if (ctoi (buffer, ip, Memi[COL_OFFSET(cp) + rownum - 1]) < 1) +#*** Memi[COL_OFFSET(cp) + rownum - 1] = INDEFI + + } else { # string + lenstr = -COL_DTYPE(cp) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + call strcpy (buffer, Memc[COL_OFFSET(cp) + ip], lenstr) + } +end diff --git a/pkg/tbtables/tbzrds.x b/pkg/tbtables/tbzrds.x new file mode 100644 index 00000000..16cbd977 --- /dev/null +++ b/pkg/tbtables/tbzrds.x @@ -0,0 +1,162 @@ +include # for MAX_DIGITS, NDIGITS_DP and SZB_CHAR +include +include "tbtables.h" +include "tbltext.h" + +define MAX_WIDTH_INT 11 # maximum width of integer field + +# tbzrds -- read a (simple) text file into memory +# +# When the first non-comment line is read, tbzcol is called to figure out +# the data types, to get initial info about precision, and to create columns +# and allocate memory for column values. +# +# The input buffer buf will likely already contain the first data line of +# the file when this routine is called. (If not, buf will have been set +# to EOS.) This is because the beginning of the file is read to determine +# whether it is a simple text table or one with explicit column definitions. +# +# For each data line (including the first), tbzmem is called to read values +# into memory. It updates the column widths in case values are wider than in +# the first row. tbzmem also reallocates buffers, if necessary, and updates +# the number of rows. +# +# The print format is set by this routine, and maximum values are set +# for the widths of double precision and integer columns. COL_LEN is +# also set here, since columns are defined based on values in the first +# row, and the data type or width of a character column can change after +# the first row. +# +# This version is for simple text tables. The version that is appropriate +# for a table with explicit column definitions is tbzrdx. +# +# Phil Hodge, 7-Jun-1999 Subroutine created, based on tbzopn. +# Phil Hodge, 5-Aug-1999 Assign COL_NELEM = 1. + +procedure tbzrds (tp, buf, line, line_type) + +pointer tp # i: pointer to table descriptor +char buf[ARB] # io: buffer for input line +int line # io: line number in input file +int line_type # io: type of line read by tbzlin +#-- +pointer sp +pointer wid # pointer to array of values of width +pointer prec # pointer to array of values of precision +pointer fmt_code # pointer to array of format codes +pointer cp # pointer to column descriptor +char pform[SZ_COLFMT] # print format +int fd # fd for the file +int width # width of field for printing +int precision # for print format +int row # row number (can be from more than one line) +int colnum # column number +bool first # is current line the first non-comment line? +bool done +int nchar, tbzlin() # reads a line from the file +errchk tbcfmt, tbzlin, tbzcol, tbzmem, tbzkey + +begin + call smark (sp) + + # Read the file into memory. + fd = TB_FILE(tp) + first = true + row = 0 + + done = false + + # If the input buffer is empty, read the first line. + if (buf[1] == EOS) { + nchar = tbzlin (fd, buf, SZ_TEXTBUF, line, line_type) + if (nchar == EOF) + done = true + } + + while (!done) { + + if (line_type == COMMENT_LINE) { + + call tbbcmt (tp, buf) # append to comment buffer + + } else if (line_type == KEYWORD_LINE) { + + call tbzkey (tp, buf, 0) # append to list of keywords + + } else if (line_type == COLDEF_LINE) { + + call error (1, + "tbtopn: column definitions must precede all data lines") + + } else if (line_type == DATA_LINE) { + + row = row + 1 + + if (first) { + # Get initial column definitions from first row. + call tbzcol (tp, buf, wid, prec, fmt_code) + first = false + } + + # Read data into memory. + call tbzmem (tp, buf, row, line, + Memi[wid], Memi[prec], Memc[fmt_code]) + } else { + call error (1, "tbzrds: internal error") + } + + # Read the next line. + nchar = tbzlin (fd, buf, SZ_TEXTBUF, line, line_type) + if (nchar == EOF) + done = true + } + + # Set print formats and data lengths. + pform[1] = '%' + do colnum = 1, TB_NCOLS(tp) { + cp = TB_COLINFO(tp,colnum) + + width = Memi[wid+colnum-1] + + # The format code fmt_code is used for double because it could + # be g or h or m, but it is ignored for int and char. + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + width = min (width, MAX_DIGITS) + precision = Memi[prec+colnum-1] + if (Memc[fmt_code+colnum-1] == 'g') + precision = max (precision, width-2) # maximum precision + precision = min (precision, NDIGITS_DP) + call sprintf (pform[2], SZ_COLFMT-1, "%d.%d%c") + call pargi (width) + call pargi (precision) + call pargc (Memc[fmt_code+colnum-1]) + + COL_LEN(cp) = SZ_DOUBLE + + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + width = min (width, MAX_WIDTH_INT) + call sprintf (pform[2], SZ_COLFMT-1, "%dd") + call pargi (width) + + COL_LEN(cp) = SZ_INT32 + + } else { # character string + call sprintf (pform[2], SZ_COLFMT-1, "-%ds") + call pargi (width) + + COL_LEN(cp) = (width + SZB_CHAR-1) / SZB_CHAR + } + + # Set the print format for this column. + call strcpy (pform, COL_FMT(cp), SZ_COLFMT) + + COL_NELEM(cp) = 1 # ascii tables do not support arrays + } + + # Free memory allocated by tbzcol. + call mfree (fmt_code, TY_CHAR) + call mfree (prec, TY_INT) + call mfree (wid, TY_INT) + + call sfree (sp) +end diff --git a/pkg/tbtables/tbzrdx.x b/pkg/tbtables/tbzrdx.x new file mode 100644 index 00000000..aa8d13a4 --- /dev/null +++ b/pkg/tbtables/tbzrdx.x @@ -0,0 +1,135 @@ +include +include "tbtables.h" +include "tbltext.h" + +# tbzrdx -- read an explicit-column-definitions text file into memory +# +# The input buffer buf will likely already contain a line from the input +# file, perhaps a column definition. (If not, buf will have been set +# to EOS.) This is because the beginning of the file is read to determine +# whether it is a simple text table or one with explicit column definitions. +# +# A new column will be created for each line of the file that contains +# an explicit column definition (i.e. each line beginning with "#c "). +# +# For each data line, tbzmex is called to read values into memory. tbzmex +# reallocates buffers, if necessary, and updates the number of rows. +# +# This version is for text tables with explicit column definitions. The +# version that is appropriate for a simple text table is tbzrds. +# +# Phil Hodge, 7-Jun-1999 Subroutine created, based on tbzopn. +# Phil Hodge, 24-Sep-1999 In tbbecd, call tbztyp instead of tbbtyp. + +procedure tbzrdx (tp, buf, line, line_type) + +pointer tp # i: pointer to table descriptor +char buf[ARB] # io: buffer for input line +int line # io: line number in input file +int line_type # io: type of line read by tbzlin +#-- +pointer cp # pointer to column descriptor +char colname[SZ_COLNAME] # column name (read from buffer) +int datatype # data type code for a column +char colfmt[SZ_COLFMT] # print format for a column +char colunits[SZ_COLUNITS] # units for a column +int fd # fd for the file +int row # row number (can be from more than one line) +bool data_read # has a line of data been read? +bool done +int nchar, tbzlin() # reads a line from the file +errchk tbzlin, tbzmex, tbbecd, tbcadd, tbzkey + +begin + fd = TB_FILE(tp) + row = 0 + data_read = false + + done = false + + # If the input buffer is empty, read the first line. + if (buf[1] == EOS) { + nchar = tbzlin (fd, buf, SZ_TEXTBUF, line, line_type) + if (nchar == EOF) + done = true + } + + while (!done) { + + if (line_type == COMMENT_LINE) { + + call tbbcmt (tp, buf) # append to comment buffer + + } else if (line_type == KEYWORD_LINE) { + + call tbzkey (tp, buf, 0) # append to list of keywords + + } else if (line_type == COLDEF_LINE) { + + if (data_read) { + call error (1, + "tbtopn: column definitions must precede all data lines") + } + + # Interpret column definition, and create a new column. + call tbbecd (buf, colname, datatype, colfmt, colunits) + call tbcadd (tp, cp, colname, colunits, colfmt, datatype, 1, 1) + + } else if (line_type == DATA_LINE) { + + data_read = true + row = row + 1 + + # Read data into memory. + call tbzmex (tp, buf, row, line) + + } else { + call error (1, "tbzrdx: internal error") + } + + # Read the next line. + nchar = tbzlin (fd, buf, SZ_TEXTBUF, line, line_type) + if (nchar == EOF) + done = true + } +end + +# tbbecd -- read column definition from buffer +# This routine skips over "#c ", then reads the column name, data type, +# print format, and units from the input buffer. Only the column name +# is required; the default data type is double. + +procedure tbbecd (buf, colname, datatype, colfmt, colunits) + +char buf[ARB] # i: buffer containing column definition +char colname[SZ_COLNAME] # o: column name +int datatype # o: data type code for column +char colfmt[SZ_COLFMT] # o: print format for column +char colunits[SZ_COLUNITS] # o: units for column +#-- +char chdtype[SZ_COLNAME] # scratch for data type extracted from buffer +int ip, ctowrd() +errchk tbbftp, tbztyp + +begin + ip = 4 # skip over "#c " + if (ctowrd (buf, ip, colname, SZ_COLNAME) < 1) + call error (1, "could not read column name") + + if (ctowrd (buf, ip, chdtype, SZ_COLNAME) < 1) { + call strcpy ("d", chdtype, SZ_COLNAME) # default is double + colfmt[1] = EOS + colunits[1] = EOS + } else if (ctowrd (buf, ip, colfmt, SZ_COLFMT) < 1) { + colfmt[1] = EOS + colunits[1] = EOS + } else if (ctowrd (buf, ip, colunits, SZ_COLUNITS) < 1) { + colunits[1] = EOS + } + + # Convert the format from Fortran style to SPP style. + call tbbftp (colfmt, colfmt) + + # Convert the data type to an integer code. + call tbztyp (chdtype, datatype) +end diff --git a/pkg/tbtables/tbzsft.x b/pkg/tbtables/tbzsft.x new file mode 100644 index 00000000..a0b1407d --- /dev/null +++ b/pkg/tbtables/tbzsft.x @@ -0,0 +1,146 @@ +include "tbtables.h" +include "tblerr.h" + +# tbzsft -- Z shift rows +# Shift one or more rows down (to leave a gap in the table) or up (to +# delete rows). The range of rows that is shifted is from FIRST to +# the last row in the table. Shift down if SHIFT > 0, or shift up if +# SHIFT < 0. SHIFT is the number of rows by which to shift. +# +# If SHIFT > 0 rows that are exposed by the shift are NOT set to indef. +# If SHIFT < 0 rows at the end WILL be set to indef. +# In either case the number of rows TB_NROWS(tp) will be updated. +# +# Phil Hodge, 31-Jan-1992 Subroutine created. + +procedure tbzsft (tp, first, shift) + +pointer tp # i: pointer to table descriptor +int first # i: first row to be affected by the shift +int shift # i: shift by this many rows +#-- +pointer cptr # pointer to a column descriptor +pointer v # pointer to array of values +int abs_shift # absolute value of shift +int row1, row2 # range of rows to be copied +int nrows # number of rows written to table +int dtype # data type of a column +int col # loop index for column number +int ip, op # loop indexes +pointer tbcnum() + +begin + nrows = TB_NROWS(tp) + + # Make sure there are enough rows allocated in the table. + if (first > nrows) { + if (shift > 0) { + row2 = shift + first - 1 + if (row2 > TB_ALLROWS(tp)) { + call tbtchs (tp, -1, -1, -1, row2) + } + } + return # nothing else to do + } else { + row2 = shift + nrows + if (row2 > TB_ALLROWS(tp)) { + call tbtchs (tp, -1, -1, -1, row2) + } + } + + if (shift == 0) + return + + # Consider the case of deleting all rows starting with FIRST. + if (nrows + shift < first) { + call tbznll (tp, first, nrows) + TB_NROWS(tp) = max (0, first-1) + return + } + + if (shift > 0) + TB_NROWS(tp) = TB_NROWS(tp) + shift + + abs_shift = abs (shift) + + # Rows row1:row2 will be copied to row1+shift:row2+shift. + if (shift < 0) + row1 = first + abs_shift + else + row1 = first + row2 = nrows + + do col = 1, TB_NCOLS(tp) { + + cptr = tbcnum (tp, col) + dtype = COL_DTYPE(cptr) + v = COL_OFFSET(cptr) # pointer to column values + + if (dtype == TBL_TY_DOUBLE) { + + if (shift < 0) { + op = first + do ip = row1, row2 { + Memd[v+op-1] = Memd[v+ip-1] + op = op + 1 + } + + } else { # shift > 0 + op = nrows + shift + do ip = row2, row1, -1 { + Memd[v+op-1] = Memd[v+ip-1] + op = op - 1 + } + } + + } else if (dtype == TBL_TY_INT) { + + if (shift < 0) { + op = first + do ip = row1, row2 { + Memi[v+op-1] = Memi[v+ip-1] + op = op + 1 + } + + } else { # shift > 0 + op = nrows + shift + do ip = row2, row1, -1 { + Memi[v+op-1] = Memi[v+ip-1] + op = op - 1 + } + } + + } else if (dtype < 0 || dtype == TBL_TY_CHAR) { + + call malloc (v, SZ_LINE, TY_CHAR) + if (shift < 0) { + op = first + do ip = row1, row2 { + call tbegtt (tp, cptr, ip, Memc[v], SZ_LINE) + call tbeptt (tp, cptr, op, Memc[v]) + op = op + 1 + } + + } else { # shift > 0 + op = nrows + shift + do ip = row2, row1, -1 { + call tbegtt (tp, cptr, ip, Memc[v], SZ_LINE) + call tbeptt (tp, cptr, op, Memc[v]) + op = op - 1 + } + } + call mfree (v, TY_CHAR) + + } else { + call error (ER_TBCOLBADTYP, + "tbzsft: table or memory corrupted?") + } + } + + # If rows were deleted, set the extra rows at end to indef, + # and change the value of TB_NROWS(tp). + if (shift < 0) { + call tbznll (tp, nrows-abs_shift+1, nrows) + TB_NROWS(tp) = max (0, nrows - abs_shift) + } +end diff --git a/pkg/tbtables/tbzsiz.x b/pkg/tbtables/tbzsiz.x new file mode 100644 index 00000000..2d233ce8 --- /dev/null +++ b/pkg/tbtables/tbzsiz.x @@ -0,0 +1,74 @@ +include "tbtables.h" + +# tbzsiz -- increase size of internal buffers for text file +# The table must be open when this procedure is called. +# Note that TB_MAXPAR and TB_ALLROWS should be assigned before calling +# this routine. +# +# Phil Hodge, 14-Jan-1992 Subroutine created. +# Phil Hodge, 7-Jun-1999 Add old_maxpar to calling sequence; +# reallocate TB_KEYLIST_PTR. + +procedure tbzsiz (tp, old_maxpar, old_allrows) + +pointer tp # i: pointer to table descriptor +int old_maxpar # i: previous value of max number of parameters +int old_allrows # i: previous value of allocated number of rows +#-- +pointer cp # pointer to column descriptor +int dtype # column data type +int new_allrows # new value of allocated number of rows +int oldsize, newsize # old & new lengths of char buffer +int lenstr # length of each string in string column +int row_1 # row number minus one +int colnum # loop index for column number +int k # loop index +errchk realloc + +begin + # Allocate or reallocate the array of pointers to keywords. + if (TB_KEYLIST_PTR(tp) == NULL) { + call calloc (TB_KEYLIST_PTR(tp), TB_MAXPAR(tp), TY_POINTER) + } else if (TB_MAXPAR(tp) > old_maxpar) { + call realloc (TB_KEYLIST_PTR(tp), TB_MAXPAR(tp), TY_POINTER) + do k = old_maxpar + 1, TB_MAXPAR(tp) + TB_KEYWORD(tp,k) = NULL + } + + # Check whether we need to do anything further. + + new_allrows = TB_ALLROWS(tp) + + if (new_allrows <= old_allrows) + return + + # Reallocate buffers and assign indef values for new rows. + do colnum = 1, TB_NCOLS(tp) { + cp = TB_COLINFO(tp,colnum) + + dtype = COL_DTYPE(cp) + if (dtype == TBL_TY_DOUBLE) { + + call realloc (COL_OFFSET(cp), new_allrows, TY_DOUBLE) + do row_1 = old_allrows, new_allrows-1 # zero indexed + Memd[COL_OFFSET(cp) + row_1] = INDEFD + + } else if (dtype == TBL_TY_INT) { + + call realloc (COL_OFFSET(cp), new_allrows, TY_INT) + do row_1 = old_allrows, new_allrows-1 + Memi[COL_OFFSET(cp) + row_1] = INDEFI + + } else { # string + + lenstr = -dtype + 1 # one for EOS + oldsize = lenstr * old_allrows + newsize = lenstr * new_allrows + call realloc (COL_OFFSET(cp), newsize, TY_CHAR) + + do k = oldsize, newsize-1 # zero indexed + Memc[COL_OFFSET(cp) + k] = EOS + + } + } +end diff --git a/pkg/tbtables/tbzsub.x b/pkg/tbtables/tbzsub.x new file mode 100644 index 00000000..2162a14b --- /dev/null +++ b/pkg/tbtables/tbzsub.x @@ -0,0 +1,54 @@ +include # for subtype codes +include "tbtables.h" +include "tbltext.h" + +# tbzsub -- determine text table subtype +# +# Phil Hodge, 7-Jun-1999 Subroutine created. + +procedure tbzsub (tp, buf, maxch, line, line_type, subtype) + +pointer tp # i: pointer to table info structure +char buf[ARB] # o: buffer for the line that was read +int maxch # i: size of line buffer +int line # io: line number in input file +int line_type # o: type of line read by tbzlin +int subtype # o: subtype of text table +#-- +int fd # fd for the file +bool read_enough # true if we have read enough to determine the subtype +int nchar, tbzlin() +errchk tbzlin + +begin + fd = TB_FILE(tp) + read_enough = false + subtype = TBL_SUBTYPE_UNKNOWN + + while (!read_enough) { + + nchar = tbzlin (fd, buf, maxch, line, line_type) + + if (nchar == EOF) { + subtype = TBL_SUBTYPE_SIMPLE + read_enough = true + buf[1] = EOS + + } else if (line_type == COLDEF_LINE) { + subtype = TBL_SUBTYPE_EXPLICIT + read_enough = true + + } else if (line_type == KEYWORD_LINE) { + call tbzkey (tp, buf, 0) # append to list of keywords + buf[1] = EOS # done with this line + + } else if (line_type == COMMENT_LINE) { + call tbbcmt (tp, buf) # append to comment buffer + buf[1] = EOS # done with this line + + } else { # data + subtype = TBL_SUBTYPE_SIMPLE + read_enough = true + } + } +end diff --git a/pkg/tbtables/tbzt2t.x b/pkg/tbtables/tbzt2t.x new file mode 100644 index 00000000..0087fcf9 --- /dev/null +++ b/pkg/tbtables/tbzt2t.x @@ -0,0 +1,60 @@ +include "tbtables.h" + +# tbzt2t -- increase column width +# When reading a text table into memory, if the word in a column of type +# text is longer than the allocated space, this routine may be called to +# increase the column width. +# +# Phil Hodge, 7-Jun-1994 Subroutine created. + +procedure tbzt2t (tp, cp, width) + +pointer tp # i: pointer to table descriptor +pointer cp # i: pointer to column descriptor +int width # i: the new max width for this column +#-- +pointer sp +pointer message # scratch for possible error message +pointer new # pointer to new memory for column data +int oldwidth # previous value of column width +int row # row number +int ip, op # offsets in char array +errchk calloc + +begin + oldwidth = -COL_DTYPE(cp) + + if (width <= oldwidth) + return # it's OK as is + + if (width > SZ_LINE-1) { + call smark (sp) + call salloc (message, SZ_LINE, TY_CHAR) + call sprintf (Memc[message], SZ_LINE, + "string is too long for a table; the maximum is %s") + call pargi (SZ_LINE-1) + call error (1, Memc[message]) + } + + # Allocate memory for the new, wider, array of strings. + # (add one to width for EOS) + call calloc (new, (width+1) * TB_ALLROWS(tp), TY_CHAR) + + ip = 0 # initial values + op = 0 + + do row = 1, TB_NROWS(tp) { + + call strcpy (Memc[COL_OFFSET(cp)+ip], Memc[new+op], width) + + ip = ip + oldwidth + 1 # add one for EOS + op = op + width + 1 + } + + # Free the old memory, and save the new pointer. + call mfree (COL_OFFSET(cp), TY_CHAR) + COL_OFFSET(cp) = new + + # Specify the new data type. + COL_DTYPE(cp) = -width +end diff --git a/pkg/tbtables/tbztyp.x b/pkg/tbtables/tbztyp.x new file mode 100644 index 00000000..09d3ad33 --- /dev/null +++ b/pkg/tbtables/tbztyp.x @@ -0,0 +1,27 @@ +include "tblerr.h" + +define SZ_SH_STR 21 # local buffer size + +# Convert a data type expressed as a character string to an integer. +# This version is for text tables, so the data type is coerced if +# necessary into one of the types supported for text tables. +# +# Phil Hodge, 24-Sep-1999 Subroutine created. + +procedure tbztyp (chdtype, datatype) + +char chdtype[ARB] # i: data type expressed as a string +int datatype # o: data type expressed as an int +#-- +errchk tbbtyp + +begin + call tbbtyp (chdtype, datatype) + + if (datatype == TY_REAL) + datatype = TY_DOUBLE + else if (datatype == TY_SHORT) + datatype = TY_INT + else if (datatype == TY_BOOL) + datatype = -8 # character*8 +end diff --git a/pkg/tbtables/tbzudf.x b/pkg/tbtables/tbzudf.x new file mode 100644 index 00000000..a3339610 --- /dev/null +++ b/pkg/tbtables/tbzudf.x @@ -0,0 +1,43 @@ +include +include "tbtables.h" +include "tblerr.h" + +# tbzudf -- set to undefined +# "Delete" entries in a table by setting each entry in the internal +# memory for the column to the INDEF value appropriate for its datatype. +# This version is for text tables. +# +# Phil Hodge, 3-Feb-1992 Subroutine created. + +procedure tbzudf (tp, cp, numcols, rownum) + +pointer tp # i: pointer to table descriptor +pointer cp[numcols] # i: array of pointers to column descriptors +int numcols # i: number of columns +int rownum # i: row number +#-- +int k # Loop index +int datatype # Data type of a column +int lenstr # length of a string table element +int ip # offset to a string in Memc + +begin + do k = 1, numcols { + + datatype = COL_DTYPE(cp[k]) + + if (datatype == TBL_TY_DOUBLE) { + Memd[COL_OFFSET(cp[k]) + rownum - 1] = INDEFD + + } else if (datatype == TBL_TY_INT) { + Memi[COL_OFFSET(cp[k]) + rownum - 1] = INDEFI + + } else if (datatype < 0) { + lenstr = -COL_DTYPE(cp[k]) # not including EOS + ip = (rownum - 1) * (lenstr + 1) # including EOS + Memc[COL_OFFSET(cp[k]) + ip] = EOS + } else { + call error (ER_TBCOLBADTYP, "tbzudf: bad datatype") + } + } +end diff --git a/pkg/tbtables/tbzwer.x b/pkg/tbtables/tbzwer.x new file mode 100644 index 00000000..4ac46540 --- /dev/null +++ b/pkg/tbtables/tbzwer.x @@ -0,0 +1,34 @@ +include "tbtables.h" + +define NUM_EXTRA 1000 # number of extra "rows" to add for text file + +# tbzwer -- write empty rows +# The purpose of this routine is to allocate more space for rows for a +# text table. If the specified row is within the range of +# existing rows, the table itself will not be modified. +# +# If rownum is greater than TB_NROWS but less than TB_ALLROWS, then only +# TB_NROWS will be updated. If rownum is greater than TB_ALLROWS, then +# tbzsiz will be called to reallocate space for the table columns. +# +# Phil Hodge, 4-Mar-1998 Subroutine created, extracted from tbtwer. +# Phil Hodge, 7-Jun-1999 Add TB_MAXPAR(tp) to calling sequence of tbzsiz. + +procedure tbzwer (tp, rownum) + +pointer tp # i: pointer to table descriptor +int rownum # i: (actual) row number in table +#-- +int old_allrows # current allocated number of rows +errchk tbzsiz + +begin + if (rownum > TB_ALLROWS(tp)) { + old_allrows = TB_ALLROWS(tp) + TB_ALLROWS(tp) = rownum + NUM_EXTRA + call tbzsiz (tp, TB_MAXPAR(tp), old_allrows) + } + + if (rownum > TB_NROWS(tp)) + TB_NROWS(tp) = rownum +end diff --git a/pkg/tbtables/tbzwrt.x b/pkg/tbtables/tbzwrt.x new file mode 100644 index 00000000..dcb19da4 --- /dev/null +++ b/pkg/tbtables/tbzwrt.x @@ -0,0 +1,257 @@ +include +include +include "tbtables.h" +include "tbltext.h" + +define COLWIDTH 10 # width for holding print format for a column + +# tbzwrt -- write data values to a text file +# The table data are written from memory to a temporary file, the original +# text table is deleted, and then the temp file is renamed to the name +# of the original text table. The file is closed by this routine, and +# TB_FILE(tp) is set to NULL. If the output file is STDOUT or STDERR, +# however, the data are just written to that fd. +# A string will be enclosed in quotes if the string contains a blank or tab +# or if it begins with a number or plus or minus. The latter is necessary +# in case the table rows are reordered, putting this string in the first +# row, because without quotes it would appear to be a numeric column. +# +# If no change has been made to the table, this routine returns without +# doing anything. +# +# Phil Hodge, 25-Mar-1992 Subroutine created. +# Phil Hodge, 20-Jul-1992 Don't quote string just because it begins with digit. +# Phil Hodge, 25-Nov-1994 Don't quote if only leading or trailing blanks. +# Phil Hodge, 2-Dec-1994 Include test on pform longer than SZ_OBUF. +# Phil Hodge, 3-Apr-1995 Check TB_MODIFIED. +# Phil Hodge, 2-Jan-1996 Quote blank strings; write INDEFI for undefined int. +# Phil Hodge, 14-Apr-1998 Use COL_FMT directly, instead of calling tbcftg. +# Phil Hodge, 12-Apr-1999 Check for STDERR, in addition to STDOUT. +# Phil Hodge, 21-Apr-1999 Print each column one at a time, rather than +# using one fprintf with all the print formats concatenated; +# this is to avoid the line length limit imposed by SZ_OBUF. +# Phil Hodge, 15-Jun-1999 Modify for table with explicit column definitions. + +procedure tbzwrt (tp) + +pointer tp # i: pointer to table descriptor +#-- +pointer sp +pointer temp # scratch for name of temporary table +pointer cbuf # buffer for output string +pointer colname # for comparing column name with "c" +pointer cp # pointer to column descriptor +int fd # fd for temporary table +int key # loop index for keyword number +int row_1 # row number minus one +int ncols # number of columns +int colnum # column number +int lenstr # length of a string table element +int ip # offset for extracting a string in Memc +int i # loop index +int istart, iend # limits on i when looking for embedded blanks +bool to_stdout # is output file STDOUT? +bool quote # whitespace in string? then enclose in quotes +char blank # ' ', as an argument to stridx +int stridx() +int strlen(), open() +bool streq() + +begin + if (!TB_MODIFIED(tp)) + return + + blank = ' ' + + call smark (sp) + call salloc (temp, SZ_FNAME, TY_CHAR) + call salloc (cbuf, SZ_LINE, TY_CHAR) + + ncols = TB_NCOLS(tp) + + # If the output file is STDOUT or STDERR, we just write to it. + if (streq (TB_NAME(tp), "STDOUT")) { + to_stdout = true + fd = STDOUT + } else if (streq (TB_NAME(tp), "STDERR")) { + to_stdout = true + fd = STDERR + } else { + to_stdout = false + # Create temporary table (text file). + call mktemp ("tmp$texttbl", Memc[temp], SZ_FNAME) + fd = open (Memc[temp], NEW_FILE, TEXT_FILE) + } + + # Check whether the table has been "converted" from simple format + # to explicit, by setting a column name or units. If any column + # name differs from "c" (case insensitive; any N, not just the + # current column number), or if units have been specified for any + # column, the table subtype will be reset to explicit column def. + if (TB_SUBTYPE(tp) != TBL_SUBTYPE_EXPLICIT) { + call salloc (colname, SZ_COLNAME, TY_CHAR) + do colnum = 1, TB_NCOLS(tp) { + cp = TB_COLINFO(tp,colnum) + if (COL_UNITS(cp) != EOS) { + TB_SUBTYPE(tp) = TBL_SUBTYPE_EXPLICIT + break + } + call strcpy (COL_NAME(cp), Memc[colname], SZ_COLNAME) + call strlwr (Memc[colname]) + if (Memc[colname] != 'c') { + TB_SUBTYPE(tp) = TBL_SUBTYPE_EXPLICIT + break + } else if (Memc[colname+1] == EOS || Memc[colname+1] == '0') { + # A column name for a simple text table is never just "c" + # without a number, and the number never begins with "0". + TB_SUBTYPE(tp) = TBL_SUBTYPE_EXPLICIT + break + } else { + do i = 2, SZ_COLNAME { + if (Memc[colname+i-1] == EOS) + break + if (!IS_DIGIT(Memc[colname+i-1])) { + TB_SUBTYPE(tp) = TBL_SUBTYPE_EXPLICIT + break + } + } + } + } + } + + # If the table has explicit column definitions, write them. + if (TB_SUBTYPE(tp) == TBL_SUBTYPE_EXPLICIT) { + + do colnum = 1, TB_NCOLS(tp) { + + cp = TB_COLINFO(tp,colnum) + + call fprintf (fd, "#c ") + + quote = (stridx (blank, COL_NAME(cp)) > 0) + if (quote) { + call fprintf (fd, "\"%s\"") + } else { + call fprintf (fd, "%s") + } + call pargstr (COL_NAME(cp)) + + if (COL_DTYPE(cp) == TBL_TY_DOUBLE) { + call fprintf (fd, " d") + } else if (COL_DTYPE(cp) == TBL_TY_INT) { + call fprintf (fd, " i") + } else if (COL_DTYPE(cp) < 0) { + call fprintf (fd, " ch*%d") + call pargi (-COL_DTYPE(cp)) + } else { + call fprintf (fd, " ch*1024") + } + + call fprintf (fd, " %s") + call pargstr (COL_FMT(cp)) + + quote = (stridx (blank, COL_UNITS(cp)) > 0) + if (quote) { + call fprintf (fd, " \"%s\"") + } else { + call fprintf (fd, " %s") + } + call pargstr (COL_UNITS(cp)) + call fprintf (fd, "\n") + } + } + + # If there are keywords, write them. + if (TB_KEYLIST_PTR(tp) != NULL) { + do key = 1, TB_NPAR(tp) { + call fprintf (fd, "%s\n") + call pargstr (Memc[TB_KEYWORD(tp,key)]) + } + } + + # Write the comment buffer to the output file. + if (TB_COMMENT(tp) != NULL) { + if (Memc[TB_COMMENT(tp)] != EOS) + call putline (fd, Memc[TB_COMMENT(tp)]) + } + + # Print each row to the file. + do row_1 = 0, TB_NROWS(tp) - 1 { # zero indexed + + # Print each column in the current row. + do colnum = 1, ncols { + + cp = TB_COLINFO(tp,colnum) + + if (colnum > 1) # separator between columns + call fprintf (fd, " ") + + call fprintf (fd, COL_FMT(cp)) # use this format + + # Now call the appropriate parg routine. + if (COL_DTYPE(cp) == TY_DOUBLE) { + + call pargd (Memd[COL_OFFSET(cp) + row_1]) + + } else if (COL_DTYPE(cp) == TY_INT) { + + if (IS_INDEFI (Memi[COL_OFFSET(cp) + row_1])) + call pargstr ("INDEFI") + else + call pargi (Memi[COL_OFFSET(cp) + row_1]) + + } else { # string + + lenstr = -COL_DTYPE(cp) + 1 # one for EOS + ip = row_1 * lenstr # offset to element + + # Check for embedded whitespace. + quote = false # initial value + + # istart and iend are zero indexed + istart = 0 + while (IS_WHITE(Memc[COL_OFFSET(cp)+ip+istart])) + istart = istart + 1 # skip leading blanks + iend = strlen (Memc[COL_OFFSET(cp)+ip]) - 1 + if (istart > iend) + quote = true # null or all blank + while (iend > istart && + IS_WHITE(Memc[COL_OFFSET(cp)+ip+iend])) { + iend = iend - 1 # skip trailing blanks + } + + do i = istart, iend { # zero indexed + if (IS_WHITE(Memc[COL_OFFSET(cp)+ip+i])) { + quote = true + break + } + } + + if (quote) { + Memc[cbuf] = '"' + Memc[cbuf+1] = EOS + call strcat (Memc[COL_OFFSET(cp)+ip], Memc[cbuf], + SZ_LINE) + call strcat ("\"", Memc[cbuf], SZ_LINE) + call pargstr (Memc[cbuf]) + } else { + call pargstr (Memc[COL_OFFSET(cp)+ip]) + } + } + } + call fprintf (fd, "\n") + } + + call close (fd) + + if (!to_stdout) { + # Close and delete the original text table, and rename the + # new (temporary) file back to the name of the original. + call close (TB_FILE(tp)) + call delete (TB_NAME(tp)) + call rename (Memc[temp], TB_NAME(tp)) + } + TB_FILE(tp) = NULL # to indicate that it's closed + + call sfree (sp) +end diff --git a/pkg/tbtables/underscore.h b/pkg/tbtables/underscore.h new file mode 100644 index 00000000..1dd514c2 --- /dev/null +++ b/pkg/tbtables/underscore.h @@ -0,0 +1,137 @@ +/* This file is used by tbfxff.c. */ + +# if defined(NO_UNDERSCORE) +# define FTDREC_U ftdrec +# define FTCMSG_U ftcmsg +# define FSGIOU_U fsgiou +# define FSFIOU_U fsfiou +# define FSCLOS_U fsclos +# define FSCOPY_U fscopy +# define FSCRHD_U fscrhd +# define FSDHDU_U fsdhdu +# define FSDROW_U fsdrow +# define FSGTBB_U fsgtbb +# define FSPTBB_U fsptbb +# define FSFIOU_U fsfiou +# define FSGCL_U fsgcl +# define FSGCFL_U fsgcfl +# define FSGCVD_U fsgcvd +# define FSGCVE_U fsgcve +# define FSGCVI_U fsgcvi +# define FSGCVJ_U fsgcvj +# define FSGCVS_U fsgcvs +# define FSGHSP_U fsghsp +# define FSGIOU_U fsgiou +# define FSGKEY_U fsgkey +# define FSGKYD_U fsgkyd +# define FSGKYJ_U fsgkyj +# define FSGKYS_U fsgkys +# define FSGMSG_U fsgmsg +# define FSGREC_U fsgrec +# define FSGRSZ_U fsgrsz +# define FSGTDM_U fsgtdm +# define FSIBIN_U fsibin +# define FSICOL_U fsicol +# define FSINIT_U fsinit +# define FSIROW_U fsirow +# define FSMAHD_U fsmahd +# define FSMCOM_U fsmcom +# define FSMKYD_U fsmkyd +# define FSMKYE_U fsmkye +# define FSMKYJ_U fsmkyj +# define FSMKYL_U fsmkyl +# define FSMKYS_U fsmkys +# define FSMREC_U fsmrec +# define FSOPEN_U fsopen +# define FSPCLD_U fspcld +# define FSPCLE_U fspcle +# define FSPCLI_U fspcli +# define FSPCLJ_U fspclj +# define FSPCLL_U fspcll +# define FSPCLS_U fspcls +# define FSPCLU_U fspclu +# define FSPCOM_U fspcom +# define FSPHBN_U fsphbn +# define FSPHIS_U fsphis +# define FSPHPR_U fsphpr +# define FSPKYD_U fspkyd +# define FSPKYE_U fspkye +# define FSPKYJ_U fspkyj +# define FSPKYL_U fspkyl +# define FSPKYS_U fspkys +# define FSPREC_U fsprec +# define FSPSVC_U fspsvc +# define FSPTDM_U fsptdm +# define FSRDEF_U fsrdef +# define FSUKYD_U fsukyd +# define FSUKYJ_U fsukyj +# define FSUKYL_U fsukyl +# define FSUKYS_U fsukys +# else +# define FTDREC_U ftdrec_ +# define FTCMSG_U ftcmsg_ +# define FSGIOU_U fsgiou_ +# define FSFIOU_U fsfiou_ +# define FSCLOS_U fsclos_ +# define FSCOPY_U fscopy_ +# define FSCRHD_U fscrhd_ +# define FSDHDU_U fsdhdu_ +# define FSDROW_U fsdrow_ +# define FSGTBB_U fsgtbb_ +# define FSPTBB_U fsptbb_ +# define FSFIOU_U fsfiou_ +# define FSGCL_U fsgcl_ +# define FSGCFL_U fsgcfl_ +# define FSGCVD_U fsgcvd_ +# define FSGCVE_U fsgcve_ +# define FSGCVI_U fsgcvi_ +# define FSGCVJ_U fsgcvj_ +# define FSGCVS_U fsgcvs_ +# define FSGHSP_U fsghsp_ +# define FSGIOU_U fsgiou_ +# define FSGKEY_U fsgkey_ +# define FSGKYD_U fsgkyd_ +# define FSGKYJ_U fsgkyj_ +# define FSGKYS_U fsgkys_ +# define FSGMSG_U fsgmsg_ +# define FSGREC_U fsgrec_ +# define FSGRSZ_U fsgrsz_ +# define FSGTDM_U fsgtdm_ +# define FSIBIN_U fsibin_ +# define FSICOL_U fsicol_ +# define FSINIT_U fsinit_ +# define FSIROW_U fsirow_ +# define FSMAHD_U fsmahd_ +# define FSMCOM_U fsmcom_ +# define FSMKYD_U fsmkyd_ +# define FSMKYE_U fsmkye_ +# define FSMKYJ_U fsmkyj_ +# define FSMKYL_U fsmkyl_ +# define FSMKYS_U fsmkys_ +# define FSMREC_U fsmrec_ +# define FSOPEN_U fsopen_ +# define FSPCLD_U fspcld_ +# define FSPCLE_U fspcle_ +# define FSPCLI_U fspcli_ +# define FSPCLJ_U fspclj_ +# define FSPCLL_U fspcll_ +# define FSPCLS_U fspcls_ +# define FSPCLU_U fspclu_ +# define FSPCOM_U fspcom_ +# define FSPHBN_U fsphbn_ +# define FSPHIS_U fsphis_ +# define FSPHPR_U fsphpr_ +# define FSPKYD_U fspkyd_ +# define FSPKYE_U fspkye_ +# define FSPKYJ_U fspkyj_ +# define FSPKYL_U fspkyl_ +# define FSPKYS_U fspkys_ +# define FSPREC_U fsprec_ +# define FSPSVC_U fspsvc_ +# define FSPTDM_U fsptdm_ +# define FSRDEF_U fsrdef_ +# define FSUKYD_U fsukyd_ +# define FSUKYJ_U fsukyj_ +# define FSUKYL_U fsukyl_ +# define FSUKYS_U fsukys_ +# endif -- cgit